1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
10 cMS$ATTRIBUTES C :: proc_proc
13 include 'COMMON.IOUNITS'
14 double precision energia(0:max_ene),energia1(0:max_ene+1)
20 include 'COMMON.FFIELD'
21 include 'COMMON.DERIV'
22 include 'COMMON.INTERACT'
23 include 'COMMON.SBRIDGE'
24 include 'COMMON.CHAIN'
25 include 'COMMON.SHIELD'
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.
53 C write(iout,*) "shield_mode",shield_mode,ethetacnstr
54 if (shield_mode.eq.1) then
56 else if (shield_mode.eq.2) then
59 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
61 C Calculate excluded-volume interaction energy between peptide groups
64 call escp(evdw2,evdw2_14)
66 c Calculate the bond-stretching energy
69 c write (iout,*) "estr",estr
71 C Calculate the disulfide-bridge and other energy and the contributions
72 C from other distance constraints.
73 cd print *,'Calling EHPB'
75 cd print *,'EHPB exitted succesfully.'
77 C Calculate the virtual-bond-angle energy.
79 call ebend(ebe,ethetacnstr)
80 cd print *,'Bend energy finished.'
82 C Calculate the SC local energy.
85 cd print *,'SCLOC energy finished.'
87 C Calculate the virtual-bond torsional energy.
89 cd print *,'nterm=',nterm
90 call etor(etors,edihcnstr,fact(1))
92 C 6/23/01 Calculate double-torsional energy
94 call etor_d(etors_d,fact(2))
96 C 21/5/07 Calculate local sicdechain correlation energy
98 call eback_sc_corr(esccor)
100 if (wliptran.gt.0) then
101 call Eliptransfer(eliptran)
105 C 12/1/95 Multi-body terms
109 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
110 & .or. wturn6.gt.0.0d0) then
111 c print *,"calling multibody_eello"
112 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
113 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
114 c print *,ecorr,ecorr5,ecorr6,eturn6
121 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
122 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
124 if (nsaxs.gt.0 .and. saxs_mode.eq.0) then
125 call e_saxs(Esaxs_constr)
126 c write (iout,*) "From Esaxs: Esaxs_constr",Esaxs_constr
127 else if (nsaxs.gt.0 .and. saxs_mode.gt.0) then
128 call e_saxsC(Esaxs_constr)
129 c write (iout,*) "From EsaxsC: Esaxs_constr",Esaxs_constr
133 c write(iout,*) "TEST_ENE",constr_homology
134 if (constr_homology.ge.1) then
135 call e_modeller(ehomology_constr)
137 ehomology_constr=0.0d0
139 c write(iout,*) "TEST_ENE",ehomology_constr
142 c write (iout,*) "ft(6)",fact(6),wliptran,eliptran
144 if (shield_mode.gt.0) then
145 etot=fact(1)*wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
147 & +fact(1)*wvdwpp*evdw1
148 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
149 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
150 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
151 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
152 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
153 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
154 & +wliptran*eliptran+wsaxs*esaxs_constr
156 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
158 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
159 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
160 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
161 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
162 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
163 & +wbond*estr+wsccor*fact(1)*esccor+ehomology_constr
164 & +wliptran*eliptran+wsaxs*esaxs_constr
167 if (shield_mode.gt.0) then
168 etot=fact(1)wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
169 & +welec*fact(1)*(ees+evdw1)
170 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
171 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
172 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
173 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
174 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
175 & +wbond*estr+wsccor*fact(1)*esccor+ehomology_constr
176 & +wliptran*eliptran+wsaxs*esaxs_constr
178 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
179 & +welec*fact(1)*(ees+evdw1)
180 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
181 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
182 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
183 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
184 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
185 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
186 & +wliptran*eliptran+wsaxs*esaxs_constr
193 energia(2)=evdw2-evdw2_14
210 energia(8)=eello_turn3
211 energia(9)=eello_turn4
220 energia(20)=edihcnstr
221 energia(24)=ehomology_constr
223 energia(25)=Esaxs_constr
224 c energia(24)=ethetacnstr
229 if (isnan(etot).ne.0) energia(0)=1.0d+99
231 if (isnan(etot)) energia(0)=1.0d+99
236 idumm=proc_proc(etot,i)
238 call proc_proc(etot,i)
240 if(i.eq.1)energia(0)=1.0d+99
247 C Sum up the components of the Cartesian gradient.
252 if (shield_mode.eq.0) then
253 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
254 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
256 & wstrain*ghpbc(j,i)+
257 & wcorr*fact(3)*gradcorr(j,i)+
258 & wel_loc*fact(2)*gel_loc(j,i)+
259 & wturn3*fact(2)*gcorr3_turn(j,i)+
260 & wturn4*fact(3)*gcorr4_turn(j,i)+
261 & wcorr5*fact(4)*gradcorr5(j,i)+
262 & wcorr6*fact(5)*gradcorr6(j,i)+
263 & wturn6*fact(5)*gcorr6_turn(j,i)+
264 & wsccor*fact(2)*gsccorc(j,i)
265 & +wliptran*gliptranc(j,i)
266 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
268 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
269 & wsccor*fact(2)*gsccorx(j,i)
270 & +wliptran*gliptranx(j,i)
272 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)
273 & +fact(1)*wscp*gvdwc_scp(j,i)+
274 & welec*fact(1)*gelc(j,i)+fact(1)*wvdwpp*gvdwpp(j,i)+
276 & wstrain*ghpbc(j,i)+
277 & wcorr*fact(3)*gradcorr(j,i)+
278 & wel_loc*fact(2)*gel_loc(j,i)+
279 & wturn3*fact(2)*gcorr3_turn(j,i)+
280 & wturn4*fact(3)*gcorr4_turn(j,i)+
281 & wcorr5*fact(4)*gradcorr5(j,i)+
282 & wcorr6*fact(5)*gradcorr6(j,i)+
283 & wturn6*fact(5)*gcorr6_turn(j,i)+
284 & wsccor*fact(2)*gsccorc(j,i)
285 & +wliptran*gliptranc(j,i)
286 & +welec*gshieldc(j,i)
287 & +welec*gshieldc_loc(j,i)
288 & +wcorr*gshieldc_ec(j,i)
289 & +wcorr*gshieldc_loc_ec(j,i)
290 & +wturn3*gshieldc_t3(j,i)
291 & +wturn3*gshieldc_loc_t3(j,i)
292 & +wturn4*gshieldc_t4(j,i)
293 & +wturn4*gshieldc_loc_t4(j,i)
294 & +wel_loc*gshieldc_ll(j,i)
295 & +wel_loc*gshieldc_loc_ll(j,i)
297 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)
298 & +fact(1)*wscp*gradx_scp(j,i)+
300 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
301 & wsccor*fact(2)*gsccorx(j,i)
302 & +wliptran*gliptranx(j,i)
303 & +welec*gshieldx(j,i)
304 & +wcorr*gshieldx_ec(j,i)
305 & +wturn3*gshieldx_t3(j,i)
306 & +wturn4*gshieldx_t4(j,i)
307 & +wel_loc*gshieldx_ll(j,i)
315 if (shield_mode.eq.0) then
316 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
317 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
319 & wcorr*fact(3)*gradcorr(j,i)+
320 & wel_loc*fact(2)*gel_loc(j,i)+
321 & wturn3*fact(2)*gcorr3_turn(j,i)+
322 & wturn4*fact(3)*gcorr4_turn(j,i)+
323 & wcorr5*fact(4)*gradcorr5(j,i)+
324 & wcorr6*fact(5)*gradcorr6(j,i)+
325 & wturn6*fact(5)*gcorr6_turn(j,i)+
326 & wsccor*fact(2)*gsccorc(j,i)
327 & +wliptran*gliptranc(j,i)
328 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
330 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
331 & wsccor*fact(1)*gsccorx(j,i)
332 & +wliptran*gliptranx(j,i)
334 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)+
335 & fact(1)*wscp*gvdwc_scp(j,i)+
336 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
338 & wcorr*fact(3)*gradcorr(j,i)+
339 & wel_loc*fact(2)*gel_loc(j,i)+
340 & wturn3*fact(2)*gcorr3_turn(j,i)+
341 & wturn4*fact(3)*gcorr4_turn(j,i)+
342 & wcorr5*fact(4)*gradcorr5(j,i)+
343 & wcorr6*fact(5)*gradcorr6(j,i)+
344 & wturn6*fact(5)*gcorr6_turn(j,i)+
345 & wsccor*fact(2)*gsccorc(j,i)
346 & +wliptran*gliptranc(j,i)
347 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)+
348 & fact(1)*wscp*gradx_scp(j,i)+
350 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
351 & wsccor*fact(1)*gsccorx(j,i)
352 & +wliptran*gliptranx(j,i)
360 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
361 & +wcorr5*fact(4)*g_corr5_loc(i)
362 & +wcorr6*fact(5)*g_corr6_loc(i)
363 & +wturn4*fact(3)*gel_loc_turn4(i)
364 & +wturn3*fact(2)*gel_loc_turn3(i)
365 & +wturn6*fact(5)*gel_loc_turn6(i)
366 & +wel_loc*fact(2)*gel_loc_loc(i)
367 c & +wsccor*fact(1)*gsccor_loc(i)
371 if (dyn_ss) call dyn_set_nss
374 C------------------------------------------------------------------------
375 subroutine enerprint(energia,fact)
376 implicit real*8 (a-h,o-z)
378 include 'sizesclu.dat'
379 include 'COMMON.IOUNITS'
380 include 'COMMON.FFIELD'
381 include 'COMMON.SBRIDGE'
382 double precision energia(0:max_ene),fact(6)
384 evdw=energia(1)+fact(6)*energia(21)
386 evdw2=energia(2)+energia(17)
398 eello_turn3=energia(8)
399 eello_turn4=energia(9)
400 eello_turn6=energia(10)
407 edihcnstr=energia(20)
409 ehomology_constr=energia(24)
410 esaxs_constr=energia(25)
411 c ethetacnstr=energia(24)
413 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
415 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
416 & etors_d,wtor_d*fact(2),ehpb,wstrain,
417 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
418 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
419 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
420 & esccor,wsccor*fact(1),edihcnstr,ehomology_constr,
421 & wsaxs*esaxs_constr,ebr*nss,etot
422 10 format (/'Virtual-chain energies:'//
423 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
424 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
425 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
426 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
427 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
428 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
429 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
430 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
431 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
432 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
433 & ' (SS bridges & dist. cnstr.)'/
434 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
435 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
436 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
437 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
438 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
439 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
440 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
441 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
442 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
443 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
444 & 'E_SAXS=',1pE16.6,' (SAXS restraints)'/
445 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
446 & 'ETOT= ',1pE16.6,' (total)')
448 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
449 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
450 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
451 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
452 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
453 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
454 & edihcnstr,ehomology_constr,esaxs_constr*wsaxs,ebr*nss,
456 10 format (/'Virtual-chain energies:'//
457 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
458 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
459 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
460 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
461 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
462 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
463 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
464 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
465 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
466 & ' (SS bridges & dist. cnstr.)'/
467 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
468 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
469 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
470 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
471 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
472 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
473 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
474 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
475 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
476 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
477 & 'E_SAXS=',1pE16.6,' (SAXS restraints)'/
478 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
479 & 'ETOT= ',1pE16.6,' (total)')
483 C-----------------------------------------------------------------------
484 subroutine elj(evdw,evdw_t)
486 C This subroutine calculates the interaction energy of nonbonded side chains
487 C assuming the LJ potential of interaction.
489 implicit real*8 (a-h,o-z)
491 include 'sizesclu.dat'
492 include "DIMENSIONS.COMPAR"
493 parameter (accur=1.0d-10)
496 include 'COMMON.LOCAL'
497 include 'COMMON.CHAIN'
498 include 'COMMON.DERIV'
499 include 'COMMON.INTERACT'
500 include 'COMMON.TORSION'
501 include 'COMMON.SBRIDGE'
502 include 'COMMON.NAMES'
503 include 'COMMON.IOUNITS'
504 include 'COMMON.CONTACTS'
508 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
509 c ROZNICA DODANE Z WHAM
512 c eneps_temp(j,i)=0.0d0
521 if (itypi.eq.ntyp1) cycle
522 itypi1=iabs(itype(i+1))
529 C Calculate SC interaction energy.
532 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
533 cd & 'iend=',iend(i,iint)
534 do j=istart(i,iint),iend(i,iint)
536 if (itypj.eq.ntyp1) cycle
540 C Change 12/1/95 to calculate four-body interactions
541 rij=xj*xj+yj*yj+zj*zj
543 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
544 eps0ij=eps(itypi,itypj)
549 ij=icant(itypi,itypj)
551 c eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
552 c eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
555 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
556 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
557 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
558 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
559 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
560 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
561 if (bb.gt.0.0d0) then
568 C Calculate the components of the gradient in DC and X
570 fac=-rrij*(e1+evdwij)
575 gvdwx(k,i)=gvdwx(k,i)-gg(k)
576 gvdwx(k,j)=gvdwx(k,j)+gg(k)
580 gvdwc(l,k)=gvdwc(l,k)+gg(l)
585 C 12/1/95, revised on 5/20/97
587 C Calculate the contact function. The ith column of the array JCONT will
588 C contain the numbers of atoms that make contacts with the atom I (of numbers
589 C greater than I). The arrays FACONT and GACONT will contain the values of
590 C the contact function and its derivative.
592 C Uncomment next line, if the correlation interactions include EVDW explicitly.
593 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
594 C Uncomment next line, if the correlation interactions are contact function only
595 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
597 sigij=sigma(itypi,itypj)
598 r0ij=rs0(itypi,itypj)
600 C Check whether the SC's are not too far to make a contact.
603 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
604 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
606 if (fcont.gt.0.0D0) then
607 C If the SC-SC distance if close to sigma, apply spline.
608 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
609 cAdam & fcont1,fprimcont1)
610 cAdam fcont1=1.0d0-fcont1
611 cAdam if (fcont1.gt.0.0d0) then
612 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
613 cAdam fcont=fcont*fcont1
615 C Uncomment following 4 lines to have the geometric average of the epsilon0's
616 cga eps0ij=1.0d0/dsqrt(eps0ij)
618 cga gg(k)=gg(k)*eps0ij
620 cga eps0ij=-evdwij*eps0ij
621 C Uncomment for AL's type of SC correlation interactions.
623 num_conti=num_conti+1
625 facont(num_conti,i)=fcont*eps0ij
626 fprimcont=eps0ij*fprimcont/rij
628 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
629 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
630 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
631 C Uncomment following 3 lines for Skolnick's type of SC correlation.
632 gacont(1,num_conti,i)=-fprimcont*xj
633 gacont(2,num_conti,i)=-fprimcont*yj
634 gacont(3,num_conti,i)=-fprimcont*zj
635 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
636 cd write (iout,'(2i3,3f10.5)')
637 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
643 num_cont(i)=num_conti
648 gvdwc(j,i)=expon*gvdwc(j,i)
649 gvdwx(j,i)=expon*gvdwx(j,i)
653 C******************************************************************************
657 C To save time, the factor of EXPON has been extracted from ALL components
658 C of GVDWC and GRADX. Remember to multiply them by this factor before further
661 C******************************************************************************
664 C-----------------------------------------------------------------------------
665 subroutine eljk(evdw,evdw_t)
667 C This subroutine calculates the interaction energy of nonbonded side chains
668 C assuming the LJK potential of interaction.
670 implicit real*8 (a-h,o-z)
672 include 'sizesclu.dat'
673 include "DIMENSIONS.COMPAR"
676 include 'COMMON.LOCAL'
677 include 'COMMON.CHAIN'
678 include 'COMMON.DERIV'
679 include 'COMMON.INTERACT'
680 include 'COMMON.IOUNITS'
681 include 'COMMON.NAMES'
686 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
691 if (itypi.eq.ntyp1) cycle
692 itypi1=iabs(itype(i+1))
697 C Calculate SC interaction energy.
700 do j=istart(i,iint),iend(i,iint)
702 if (itypj.eq.ntyp1) cycle
706 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
708 e_augm=augm(itypi,itypj)*fac_augm
711 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
712 fac=r_shift_inv**expon
716 ij=icant(itypi,itypj)
717 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
718 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
719 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
720 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
721 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
722 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
723 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
724 if (bb.gt.0.0d0) then
731 C Calculate the components of the gradient in DC and X
733 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
738 gvdwx(k,i)=gvdwx(k,i)-gg(k)
739 gvdwx(k,j)=gvdwx(k,j)+gg(k)
743 gvdwc(l,k)=gvdwc(l,k)+gg(l)
753 gvdwc(j,i)=expon*gvdwc(j,i)
754 gvdwx(j,i)=expon*gvdwx(j,i)
760 C-----------------------------------------------------------------------------
761 subroutine ebp(evdw,evdw_t)
763 C This subroutine calculates the interaction energy of nonbonded side chains
764 C assuming the Berne-Pechukas potential of interaction.
766 implicit real*8 (a-h,o-z)
768 include 'sizesclu.dat'
769 include "DIMENSIONS.COMPAR"
772 include 'COMMON.LOCAL'
773 include 'COMMON.CHAIN'
774 include 'COMMON.DERIV'
775 include 'COMMON.NAMES'
776 include 'COMMON.INTERACT'
777 include 'COMMON.IOUNITS'
778 include 'COMMON.CALC'
780 c double precision rrsave(maxdim)
786 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
787 c if (icall.eq.0) then
795 if (itypi.eq.ntyp1) cycle
796 itypi1=iabs(itype(i+1))
800 dxi=dc_norm(1,nres+i)
801 dyi=dc_norm(2,nres+i)
802 dzi=dc_norm(3,nres+i)
803 dsci_inv=vbld_inv(i+nres)
805 C Calculate SC interaction energy.
808 do j=istart(i,iint),iend(i,iint)
811 if (itypj.eq.ntyp1) cycle
812 dscj_inv=vbld_inv(j+nres)
813 chi1=chi(itypi,itypj)
814 chi2=chi(itypj,itypi)
821 alf12=0.5D0*(alf1+alf2)
822 C For diagnostics only!!!
835 dxj=dc_norm(1,nres+j)
836 dyj=dc_norm(2,nres+j)
837 dzj=dc_norm(3,nres+j)
838 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
839 cd if (icall.eq.0) then
845 C Calculate the angle-dependent terms of energy & contributions to derivatives.
847 C Calculate whole angle-dependent part of epsilon and contributions
849 fac=(rrij*sigsq)**expon2
852 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
853 eps2der=evdwij*eps3rt
854 eps3der=evdwij*eps2rt
855 evdwij=evdwij*eps2rt*eps3rt
856 ij=icant(itypi,itypj)
857 aux=eps1*eps2rt**2*eps3rt**2
858 if (bb.gt.0.0d0) then
865 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
867 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
868 cd & restyp(itypi),i,restyp(itypj),j,
869 cd & epsi,sigm,chi1,chi2,chip1,chip2,
870 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
871 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
874 C Calculate gradient components.
875 e1=e1*eps1*eps2rt**2*eps3rt**2
876 fac=-expon*(e1+evdwij)
879 C Calculate radial part of the gradient
883 C Calculate the angular part of the gradient and sum add the contributions
884 C to the appropriate components of the Cartesian gradient.
893 C-----------------------------------------------------------------------------
894 subroutine egb(evdw,evdw_t)
896 C This subroutine calculates the interaction energy of nonbonded side chains
897 C assuming the Gay-Berne potential of interaction.
899 implicit real*8 (a-h,o-z)
901 include 'sizesclu.dat'
902 include "DIMENSIONS.COMPAR"
905 include 'COMMON.LOCAL'
906 include 'COMMON.CHAIN'
907 include 'COMMON.DERIV'
908 include 'COMMON.NAMES'
909 include 'COMMON.INTERACT'
910 include 'COMMON.IOUNITS'
911 include 'COMMON.CALC'
912 include 'COMMON.SBRIDGE'
917 integer xshift,yshift,zshift
918 logical energy_dec /.false./
919 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
923 c if (icall.gt.0) lprn=.true.
927 if (itypi.eq.ntyp1) cycle
928 itypi1=iabs(itype(i+1))
933 if (xi.lt.0) xi=xi+boxxsize
935 if (yi.lt.0) yi=yi+boxysize
937 if (zi.lt.0) zi=zi+boxzsize
938 if ((zi.gt.bordlipbot)
939 &.and.(zi.lt.bordliptop)) then
940 C the energy transfer exist
941 if (zi.lt.buflipbot) then
942 C what fraction I am in
944 & ((zi-bordlipbot)/lipbufthick)
945 C lipbufthick is thickenes of lipid buffore
946 sslipi=sscalelip(fracinbuf)
947 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
948 elseif (zi.gt.bufliptop) then
949 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
950 sslipi=sscalelip(fracinbuf)
951 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
960 dxi=dc_norm(1,nres+i)
961 dyi=dc_norm(2,nres+i)
962 dzi=dc_norm(3,nres+i)
963 dsci_inv=vbld_inv(i+nres)
965 C Calculate SC interaction energy.
968 do j=istart(i,iint),iend(i,iint)
969 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
971 c write(iout,*) "PRZED ZWYKLE", evdwij
972 call dyn_ssbond_ene(i,j,evdwij)
973 c write(iout,*) "PO ZWYKLE", evdwij
976 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
977 & 'evdw',i,j,evdwij,' ss'
978 C triple bond artifac removal
979 do k=j+1,iend(i,iint)
980 C search over all next residues
981 if (dyn_ss_mask(k)) then
982 C check if they are cysteins
983 C write(iout,*) 'k=',k
985 c write(iout,*) "PRZED TRI", evdwij
986 evdwij_przed_tri=evdwij
987 call triple_ssbond_ene(i,j,k,evdwij)
988 c if(evdwij_przed_tri.ne.evdwij) then
989 c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
992 c write(iout,*) "PO TRI", evdwij
993 C call the energy function that removes the artifical triple disulfide
994 C bond the soubroutine is located in ssMD.F
996 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
997 & 'evdw',i,j,evdwij,'tss'
1002 itypj=iabs(itype(j))
1003 if (itypj.eq.ntyp1) cycle
1004 dscj_inv=vbld_inv(j+nres)
1005 sig0ij=sigma(itypi,itypj)
1006 chi1=chi(itypi,itypj)
1007 chi2=chi(itypj,itypi)
1014 alf12=0.5D0*(alf1+alf2)
1015 C For diagnostics only!!!
1029 if (xj.lt.0) xj=xj+boxxsize
1031 if (yj.lt.0) yj=yj+boxysize
1033 if (zj.lt.0) zj=zj+boxzsize
1034 if ((zj.gt.bordlipbot)
1035 &.and.(zj.lt.bordliptop)) then
1036 C the energy transfer exist
1037 if (zj.lt.buflipbot) then
1038 C what fraction I am in
1040 & ((zj-bordlipbot)/lipbufthick)
1041 C lipbufthick is thickenes of lipid buffore
1042 sslipj=sscalelip(fracinbuf)
1043 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1044 elseif (zj.gt.bufliptop) then
1045 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1046 sslipj=sscalelip(fracinbuf)
1047 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1056 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1057 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1058 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1059 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1060 C write(iout,*) "czy jest 0", bb-bb_lip(itypi,itypj),
1061 C & bb-bb_aq(itypi,itypj)
1062 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1070 xj=xj_safe+xshift*boxxsize
1071 yj=yj_safe+yshift*boxysize
1072 zj=zj_safe+zshift*boxzsize
1073 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1074 if(dist_temp.lt.dist_init) then
1084 if (subchap.eq.1) then
1093 dxj=dc_norm(1,nres+j)
1094 dyj=dc_norm(2,nres+j)
1095 dzj=dc_norm(3,nres+j)
1096 c write (iout,*) i,j,xj,yj,zj
1097 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1099 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1100 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1101 if (sss.le.0.0d0) cycle
1102 C Calculate angle-dependent terms of energy and contributions to their
1106 sig=sig0ij*dsqrt(sigsq)
1107 rij_shift=1.0D0/rij-sig+sig0ij
1108 C I hate to put IF's in the loops, but here don't have another choice!!!!
1109 if (rij_shift.le.0.0D0) then
1114 c---------------------------------------------------------------
1115 rij_shift=1.0D0/rij_shift
1116 fac=rij_shift**expon
1119 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1120 eps2der=evdwij*eps3rt
1121 eps3der=evdwij*eps2rt
1122 evdwij=evdwij*eps2rt*eps3rt
1124 evdw=evdw+evdwij*sss
1126 evdw_t=evdw_t+evdwij*sss
1128 ij=icant(itypi,itypj)
1129 aux=eps1*eps2rt**2*eps3rt**2
1130 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1131 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1132 c & aux*e2/eps(itypi,itypj)
1134 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1138 C write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1139 C & restyp(itypi),i,restyp(itypj),j,
1140 C & epsi,sigm,chi1,chi2,chip1,chip2,
1141 C & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1142 C & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1144 write (iout,*) "pratial sum", evdw,evdw_t,e1,e2,fac,aa
1149 C Calculate gradient components.
1150 e1=e1*eps1*eps2rt**2*eps3rt**2
1151 fac=-expon*(e1+evdwij)*rij_shift
1154 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1155 gg_lipi(3)=eps1*(eps2rt*eps2rt)
1156 &*(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
1157 & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
1158 &+faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1159 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1160 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1161 C Calculate the radial part of the gradient
1165 C Calculate angular part of the gradient.
1174 C-----------------------------------------------------------------------------
1175 subroutine egbv(evdw,evdw_t)
1177 C This subroutine calculates the interaction energy of nonbonded side chains
1178 C assuming the Gay-Berne-Vorobjev potential of interaction.
1180 implicit real*8 (a-h,o-z)
1181 include 'DIMENSIONS'
1182 include 'sizesclu.dat'
1183 include "DIMENSIONS.COMPAR"
1184 include 'COMMON.GEO'
1185 include 'COMMON.VAR'
1186 include 'COMMON.LOCAL'
1187 include 'COMMON.CHAIN'
1188 include 'COMMON.DERIV'
1189 include 'COMMON.NAMES'
1190 include 'COMMON.INTERACT'
1191 include 'COMMON.IOUNITS'
1192 include 'COMMON.CALC'
1193 common /srutu/ icall
1197 integer xshift,yshift,zshift
1200 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1203 c if (icall.gt.0) lprn=.true.
1205 do i=iatsc_s,iatsc_e
1206 itypi=iabs(itype(i))
1207 if (itypi.eq.ntyp1) cycle
1208 itypi1=iabs(itype(i+1))
1212 dxi=dc_norm(1,nres+i)
1213 dyi=dc_norm(2,nres+i)
1214 dzi=dc_norm(3,nres+i)
1215 dsci_inv=vbld_inv(i+nres)
1216 C returning the ith atom to box
1218 if (xi.lt.0) xi=xi+boxxsize
1220 if (yi.lt.0) yi=yi+boxysize
1222 if (zi.lt.0) zi=zi+boxzsize
1223 if ((zi.gt.bordlipbot)
1224 &.and.(zi.lt.bordliptop)) then
1225 C the energy transfer exist
1226 if (zi.lt.buflipbot) then
1227 C what fraction I am in
1229 & ((zi-bordlipbot)/lipbufthick)
1230 C lipbufthick is thickenes of lipid buffore
1231 sslipi=sscalelip(fracinbuf)
1232 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1233 elseif (zi.gt.bufliptop) then
1234 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1235 sslipi=sscalelip(fracinbuf)
1236 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1246 C Calculate SC interaction energy.
1248 do iint=1,nint_gr(i)
1249 do j=istart(i,iint),iend(i,iint)
1251 itypj=iabs(itype(j))
1252 if (itypj.eq.ntyp1) cycle
1253 dscj_inv=vbld_inv(j+nres)
1254 sig0ij=sigma(itypi,itypj)
1255 r0ij=r0(itypi,itypj)
1256 chi1=chi(itypi,itypj)
1257 chi2=chi(itypj,itypi)
1264 alf12=0.5D0*(alf1+alf2)
1265 C For diagnostics only!!!
1278 C returning jth atom to box
1280 if (xj.lt.0) xj=xj+boxxsize
1282 if (yj.lt.0) yj=yj+boxysize
1284 if (zj.lt.0) zj=zj+boxzsize
1285 if ((zj.gt.bordlipbot)
1286 &.and.(zj.lt.bordliptop)) then
1287 C the energy transfer exist
1288 if (zj.lt.buflipbot) then
1289 C what fraction I am in
1291 & ((zj-bordlipbot)/lipbufthick)
1292 C lipbufthick is thickenes of lipid buffore
1293 sslipj=sscalelip(fracinbuf)
1294 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1295 elseif (zj.gt.bufliptop) then
1296 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1297 sslipj=sscalelip(fracinbuf)
1298 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1307 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1308 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1309 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1310 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1311 C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
1312 C checking the distance
1313 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1318 C finding the closest
1322 xj=xj_safe+xshift*boxxsize
1323 yj=yj_safe+yshift*boxysize
1324 zj=zj_safe+zshift*boxzsize
1325 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1326 if(dist_temp.lt.dist_init) then
1336 if (subchap.eq.1) then
1345 dxj=dc_norm(1,nres+j)
1346 dyj=dc_norm(2,nres+j)
1347 dzj=dc_norm(3,nres+j)
1348 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1350 C Calculate angle-dependent terms of energy and contributions to their
1354 sig=sig0ij*dsqrt(sigsq)
1355 rij_shift=1.0D0/rij-sig+r0ij
1356 C I hate to put IF's in the loops, but here don't have another choice!!!!
1357 if (rij_shift.le.0.0D0) then
1362 c---------------------------------------------------------------
1363 rij_shift=1.0D0/rij_shift
1364 fac=rij_shift**expon
1367 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1368 eps2der=evdwij*eps3rt
1369 eps3der=evdwij*eps2rt
1370 fac_augm=rrij**expon
1371 e_augm=augm(itypi,itypj)*fac_augm
1372 evdwij=evdwij*eps2rt*eps3rt
1373 if (bb.gt.0.0d0) then
1374 evdw=evdw+evdwij+e_augm
1376 evdw_t=evdw_t+evdwij+e_augm
1378 ij=icant(itypi,itypj)
1379 aux=eps1*eps2rt**2*eps3rt**2
1381 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1382 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1383 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1384 c & restyp(itypi),i,restyp(itypj),j,
1385 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1386 c & chi1,chi2,chip1,chip2,
1387 c & eps1,eps2rt**2,eps3rt**2,
1388 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1392 C Calculate gradient components.
1393 e1=e1*eps1*eps2rt**2*eps3rt**2
1394 fac=-expon*(e1+evdwij)*rij_shift
1396 fac=rij*fac-2*expon*rrij*e_augm
1397 C Calculate the radial part of the gradient
1401 C Calculate angular part of the gradient.
1409 C-----------------------------------------------------------------------------
1410 subroutine sc_angular
1411 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1412 C om12. Called by ebp, egb, and egbv.
1414 include 'COMMON.CALC'
1418 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1419 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1420 om12=dxi*dxj+dyi*dyj+dzi*dzj
1422 C Calculate eps1(om12) and its derivative in om12
1423 faceps1=1.0D0-om12*chiom12
1424 faceps1_inv=1.0D0/faceps1
1425 eps1=dsqrt(faceps1_inv)
1426 C Following variable is eps1*deps1/dom12
1427 eps1_om12=faceps1_inv*chiom12
1428 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1433 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1434 sigsq=1.0D0-facsig*faceps1_inv
1435 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1436 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1437 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1438 C Calculate eps2 and its derivatives in om1, om2, and om12.
1441 chipom12=chip12*om12
1442 facp=1.0D0-om12*chipom12
1444 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1445 C Following variable is the square root of eps2
1446 eps2rt=1.0D0-facp1*facp_inv
1447 C Following three variables are the derivatives of the square root of eps
1448 C in om1, om2, and om12.
1449 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1450 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1451 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1452 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1453 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1454 C Calculate whole angle-dependent part of epsilon and contributions
1455 C to its derivatives
1458 C----------------------------------------------------------------------------
1460 implicit real*8 (a-h,o-z)
1461 include 'DIMENSIONS'
1462 include 'sizesclu.dat'
1463 include 'COMMON.CHAIN'
1464 include 'COMMON.DERIV'
1465 include 'COMMON.CALC'
1466 double precision dcosom1(3),dcosom2(3)
1467 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1468 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1469 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1470 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1472 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1473 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1476 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1479 gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
1480 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1481 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1482 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipi(k)
1483 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1484 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1487 C Calculate the components of the gradient in DC and X
1491 gvdwc(l,k)=gvdwc(l,k)+gg(l)+gg_lipi(l)
1495 gvdwc(l,j)=gvdwc(l,j)+gg_lipj(l)
1499 c------------------------------------------------------------------------------
1500 subroutine vec_and_deriv
1501 implicit real*8 (a-h,o-z)
1502 include 'DIMENSIONS'
1503 include 'sizesclu.dat'
1504 include 'COMMON.IOUNITS'
1505 include 'COMMON.GEO'
1506 include 'COMMON.VAR'
1507 include 'COMMON.LOCAL'
1508 include 'COMMON.CHAIN'
1509 include 'COMMON.VECTORS'
1510 include 'COMMON.DERIV'
1511 include 'COMMON.INTERACT'
1512 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1513 C Compute the local reference systems. For reference system (i), the
1514 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1515 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1517 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1518 if (i.eq.nres-1) then
1519 C Case of the last full residue
1520 C Compute the Z-axis
1521 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1522 costh=dcos(pi-theta(nres))
1523 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1528 C Compute the derivatives of uz
1530 uzder(2,1,1)=-dc_norm(3,i-1)
1531 uzder(3,1,1)= dc_norm(2,i-1)
1532 uzder(1,2,1)= dc_norm(3,i-1)
1534 uzder(3,2,1)=-dc_norm(1,i-1)
1535 uzder(1,3,1)=-dc_norm(2,i-1)
1536 uzder(2,3,1)= dc_norm(1,i-1)
1539 uzder(2,1,2)= dc_norm(3,i)
1540 uzder(3,1,2)=-dc_norm(2,i)
1541 uzder(1,2,2)=-dc_norm(3,i)
1543 uzder(3,2,2)= dc_norm(1,i)
1544 uzder(1,3,2)= dc_norm(2,i)
1545 uzder(2,3,2)=-dc_norm(1,i)
1548 C Compute the Y-axis
1551 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1554 C Compute the derivatives of uy
1557 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1558 & -dc_norm(k,i)*dc_norm(j,i-1)
1559 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1561 uyder(j,j,1)=uyder(j,j,1)-costh
1562 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1567 uygrad(l,k,j,i)=uyder(l,k,j)
1568 uzgrad(l,k,j,i)=uzder(l,k,j)
1572 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1573 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1574 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1575 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1579 C Compute the Z-axis
1580 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1581 costh=dcos(pi-theta(i+2))
1582 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1587 C Compute the derivatives of uz
1589 uzder(2,1,1)=-dc_norm(3,i+1)
1590 uzder(3,1,1)= dc_norm(2,i+1)
1591 uzder(1,2,1)= dc_norm(3,i+1)
1593 uzder(3,2,1)=-dc_norm(1,i+1)
1594 uzder(1,3,1)=-dc_norm(2,i+1)
1595 uzder(2,3,1)= dc_norm(1,i+1)
1598 uzder(2,1,2)= dc_norm(3,i)
1599 uzder(3,1,2)=-dc_norm(2,i)
1600 uzder(1,2,2)=-dc_norm(3,i)
1602 uzder(3,2,2)= dc_norm(1,i)
1603 uzder(1,3,2)= dc_norm(2,i)
1604 uzder(2,3,2)=-dc_norm(1,i)
1607 C Compute the Y-axis
1610 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1613 C Compute the derivatives of uy
1616 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1617 & -dc_norm(k,i)*dc_norm(j,i+1)
1618 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1620 uyder(j,j,1)=uyder(j,j,1)-costh
1621 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1626 uygrad(l,k,j,i)=uyder(l,k,j)
1627 uzgrad(l,k,j,i)=uzder(l,k,j)
1631 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1632 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1633 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1634 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1640 vbld_inv_temp(1)=vbld_inv(i+1)
1641 if (i.lt.nres-1) then
1642 vbld_inv_temp(2)=vbld_inv(i+2)
1644 vbld_inv_temp(2)=vbld_inv(i)
1649 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1650 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1658 C-----------------------------------------------------------------------------
1659 subroutine vec_and_deriv_test
1660 implicit real*8 (a-h,o-z)
1661 include 'DIMENSIONS'
1662 include 'sizesclu.dat'
1663 include 'COMMON.IOUNITS'
1664 include 'COMMON.GEO'
1665 include 'COMMON.VAR'
1666 include 'COMMON.LOCAL'
1667 include 'COMMON.CHAIN'
1668 include 'COMMON.VECTORS'
1669 dimension uyder(3,3,2),uzder(3,3,2)
1670 C Compute the local reference systems. For reference system (i), the
1671 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1672 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1674 if (i.eq.nres-1) then
1675 C Case of the last full residue
1676 C Compute the Z-axis
1677 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1678 costh=dcos(pi-theta(nres))
1679 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1680 c write (iout,*) 'fac',fac,
1681 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1682 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1686 C Compute the derivatives of uz
1688 uzder(2,1,1)=-dc_norm(3,i-1)
1689 uzder(3,1,1)= dc_norm(2,i-1)
1690 uzder(1,2,1)= dc_norm(3,i-1)
1692 uzder(3,2,1)=-dc_norm(1,i-1)
1693 uzder(1,3,1)=-dc_norm(2,i-1)
1694 uzder(2,3,1)= dc_norm(1,i-1)
1697 uzder(2,1,2)= dc_norm(3,i)
1698 uzder(3,1,2)=-dc_norm(2,i)
1699 uzder(1,2,2)=-dc_norm(3,i)
1701 uzder(3,2,2)= dc_norm(1,i)
1702 uzder(1,3,2)= dc_norm(2,i)
1703 uzder(2,3,2)=-dc_norm(1,i)
1705 C Compute the Y-axis
1707 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1710 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1711 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1712 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1714 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1717 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1718 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1721 c write (iout,*) 'facy',facy,
1722 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1723 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1725 uy(k,i)=facy*uy(k,i)
1727 C Compute the derivatives of uy
1730 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1731 & -dc_norm(k,i)*dc_norm(j,i-1)
1732 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1734 c uyder(j,j,1)=uyder(j,j,1)-costh
1735 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1736 uyder(j,j,1)=uyder(j,j,1)
1737 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1738 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1744 uygrad(l,k,j,i)=uyder(l,k,j)
1745 uzgrad(l,k,j,i)=uzder(l,k,j)
1749 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1750 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1751 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1752 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1755 C Compute the Z-axis
1756 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1757 costh=dcos(pi-theta(i+2))
1758 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1759 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1763 C Compute the derivatives of uz
1765 uzder(2,1,1)=-dc_norm(3,i+1)
1766 uzder(3,1,1)= dc_norm(2,i+1)
1767 uzder(1,2,1)= dc_norm(3,i+1)
1769 uzder(3,2,1)=-dc_norm(1,i+1)
1770 uzder(1,3,1)=-dc_norm(2,i+1)
1771 uzder(2,3,1)= dc_norm(1,i+1)
1774 uzder(2,1,2)= dc_norm(3,i)
1775 uzder(3,1,2)=-dc_norm(2,i)
1776 uzder(1,2,2)=-dc_norm(3,i)
1778 uzder(3,2,2)= dc_norm(1,i)
1779 uzder(1,3,2)= dc_norm(2,i)
1780 uzder(2,3,2)=-dc_norm(1,i)
1782 C Compute the Y-axis
1784 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1785 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1786 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1788 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1791 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1792 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1795 c write (iout,*) 'facy',facy,
1796 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1797 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1799 uy(k,i)=facy*uy(k,i)
1801 C Compute the derivatives of uy
1804 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1805 & -dc_norm(k,i)*dc_norm(j,i+1)
1806 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1808 c uyder(j,j,1)=uyder(j,j,1)-costh
1809 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1810 uyder(j,j,1)=uyder(j,j,1)
1811 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1812 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1818 uygrad(l,k,j,i)=uyder(l,k,j)
1819 uzgrad(l,k,j,i)=uzder(l,k,j)
1823 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1824 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1825 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1826 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1833 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1834 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1841 C-----------------------------------------------------------------------------
1842 subroutine check_vecgrad
1843 implicit real*8 (a-h,o-z)
1844 include 'DIMENSIONS'
1845 include 'sizesclu.dat'
1846 include 'COMMON.IOUNITS'
1847 include 'COMMON.GEO'
1848 include 'COMMON.VAR'
1849 include 'COMMON.LOCAL'
1850 include 'COMMON.CHAIN'
1851 include 'COMMON.VECTORS'
1852 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1853 dimension uyt(3,maxres),uzt(3,maxres)
1854 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1855 double precision delta /1.0d-7/
1858 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1859 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1860 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1861 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1862 cd & (dc_norm(if90,i),if90=1,3)
1863 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1864 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1865 cd write(iout,'(a)')
1871 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1872 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1885 cd write (iout,*) 'i=',i
1887 erij(k)=dc_norm(k,i)
1891 dc_norm(k,i)=erij(k)
1893 dc_norm(j,i)=dc_norm(j,i)+delta
1894 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1896 c dc_norm(k,i)=dc_norm(k,i)/fac
1898 c write (iout,*) (dc_norm(k,i),k=1,3)
1899 c write (iout,*) (erij(k),k=1,3)
1902 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1903 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1904 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1905 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1907 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1908 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1909 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1912 dc_norm(k,i)=erij(k)
1915 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1916 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1917 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1918 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1919 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1920 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1921 cd write (iout,'(a)')
1926 C--------------------------------------------------------------------------
1927 subroutine set_matrices
1928 implicit real*8 (a-h,o-z)
1929 include 'DIMENSIONS'
1930 include 'sizesclu.dat'
1931 include 'COMMON.IOUNITS'
1932 include 'COMMON.GEO'
1933 include 'COMMON.VAR'
1934 include 'COMMON.LOCAL'
1935 include 'COMMON.CHAIN'
1936 include 'COMMON.DERIV'
1937 include 'COMMON.INTERACT'
1938 include 'COMMON.CONTACTS'
1939 include 'COMMON.TORSION'
1940 include 'COMMON.VECTORS'
1941 include 'COMMON.FFIELD'
1942 double precision auxvec(2),auxmat(2,2)
1944 C Compute the virtual-bond-torsional-angle dependent quantities needed
1945 C to calculate the el-loc multibody terms of various order.
1948 if (i .lt. nres+1) then
1985 if (i .gt. 3 .and. i .lt. nres+1) then
1986 obrot_der(1,i-2)=-sin1
1987 obrot_der(2,i-2)= cos1
1988 Ugder(1,1,i-2)= sin1
1989 Ugder(1,2,i-2)=-cos1
1990 Ugder(2,1,i-2)=-cos1
1991 Ugder(2,2,i-2)=-sin1
1994 obrot2_der(1,i-2)=-dwasin2
1995 obrot2_der(2,i-2)= dwacos2
1996 Ug2der(1,1,i-2)= dwasin2
1997 Ug2der(1,2,i-2)=-dwacos2
1998 Ug2der(2,1,i-2)=-dwacos2
1999 Ug2der(2,2,i-2)=-dwasin2
2001 obrot_der(1,i-2)=0.0d0
2002 obrot_der(2,i-2)=0.0d0
2003 Ugder(1,1,i-2)=0.0d0
2004 Ugder(1,2,i-2)=0.0d0
2005 Ugder(2,1,i-2)=0.0d0
2006 Ugder(2,2,i-2)=0.0d0
2007 obrot2_der(1,i-2)=0.0d0
2008 obrot2_der(2,i-2)=0.0d0
2009 Ug2der(1,1,i-2)=0.0d0
2010 Ug2der(1,2,i-2)=0.0d0
2011 Ug2der(2,1,i-2)=0.0d0
2012 Ug2der(2,2,i-2)=0.0d0
2014 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2015 if (itype(i-2).le.ntyp) then
2016 iti = itortyp(itype(i-2))
2023 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2024 if (itype(i-1).le.ntyp) then
2025 iti1 = itortyp(itype(i-1))
2032 cd write (iout,*) '*******i',i,' iti1',iti
2033 cd write (iout,*) 'b1',b1(:,iti)
2034 cd write (iout,*) 'b2',b2(:,iti)
2035 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2036 c print *,"itilde1 i iti iti1",i,iti,iti1
2037 if (i .gt. iatel_s+2) then
2038 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2039 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2040 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2041 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2042 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2043 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2044 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2054 DtUg2(l,k,i-2)=0.0d0
2058 c print *,"itilde2 i iti iti1",i,iti,iti1
2059 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2060 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2061 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2062 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2063 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2064 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2065 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2066 c print *,"itilde3 i iti iti1",i,iti,iti1
2068 muder(k,i-2)=Ub2der(k,i-2)
2070 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2071 if (itype(i-1).le.ntyp) then
2072 iti1 = itortyp(itype(i-1))
2080 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2082 C Vectors and matrices dependent on a single virtual-bond dihedral.
2083 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2084 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2085 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2086 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2087 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2088 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2089 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2090 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2091 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2092 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
2093 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
2095 C Matrices dependent on two consecutive virtual-bond dihedrals.
2096 C The order of matrices is from left to right.
2098 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2099 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2100 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2101 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2102 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2103 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2104 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2105 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2108 cd iti = itortyp(itype(i))
2111 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2112 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2117 C--------------------------------------------------------------------------
2118 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2120 C This subroutine calculates the average interaction energy and its gradient
2121 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2122 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2123 C The potential depends both on the distance of peptide-group centers and on
2124 C the orientation of the CA-CA virtual bonds.
2126 implicit real*8 (a-h,o-z)
2127 include 'DIMENSIONS'
2128 include 'sizesclu.dat'
2129 include 'COMMON.CONTROL'
2130 include 'COMMON.IOUNITS'
2131 include 'COMMON.GEO'
2132 include 'COMMON.VAR'
2133 include 'COMMON.LOCAL'
2134 include 'COMMON.CHAIN'
2135 include 'COMMON.DERIV'
2136 include 'COMMON.INTERACT'
2137 include 'COMMON.CONTACTS'
2138 include 'COMMON.TORSION'
2139 include 'COMMON.VECTORS'
2140 include 'COMMON.FFIELD'
2141 include 'COMMON.SHIELD'
2143 integer xshift,yshift,zshift
2144 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2145 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2146 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2147 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2148 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
2149 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2150 double precision scal_el /0.5d0/
2152 C 13-go grudnia roku pamietnego...
2153 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2154 & 0.0d0,1.0d0,0.0d0,
2155 & 0.0d0,0.0d0,1.0d0/
2156 cd write(iout,*) 'In EELEC'
2158 cd write(iout,*) 'Type',i
2159 cd write(iout,*) 'B1',B1(:,i)
2160 cd write(iout,*) 'B2',B2(:,i)
2161 cd write(iout,*) 'CC',CC(:,:,i)
2162 cd write(iout,*) 'DD',DD(:,:,i)
2163 cd write(iout,*) 'EE',EE(:,:,i)
2165 cd call check_vecgrad
2167 if (icheckgrad.eq.1) then
2169 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2171 dc_norm(k,i)=dc(k,i)*fac
2173 c write (iout,*) 'i',i,' fac',fac
2176 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2177 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2178 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2179 cd if (wel_loc.gt.0.0d0) then
2180 if (icheckgrad.eq.1) then
2181 call vec_and_deriv_test
2188 cd write (iout,*) 'i=',i
2190 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2193 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2194 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2207 cd print '(a)','Enter EELEC'
2208 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2210 gel_loc_loc(i)=0.0d0
2213 do i=iatel_s,iatel_e
2214 cAna if (i.le.1) cycle
2215 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1
2216 cAna & .or. ((i+2).gt.nres)
2217 cAna & .or. ((i-1).le.0)
2218 cAna & .or. itype(i+2).eq.ntyp1
2219 cAna & .or. itype(i-1).eq.ntyp1
2222 if (itel(i).eq.0) goto 1215
2226 dx_normi=dc_norm(1,i)
2227 dy_normi=dc_norm(2,i)
2228 dz_normi=dc_norm(3,i)
2229 xmedi=c(1,i)+0.5d0*dxi
2230 ymedi=c(2,i)+0.5d0*dyi
2231 zmedi=c(3,i)+0.5d0*dzi
2232 xmedi=mod(xmedi,boxxsize)
2233 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2234 ymedi=mod(ymedi,boxysize)
2235 if (ymedi.lt.0) ymedi=ymedi+boxysize
2236 zmedi=mod(zmedi,boxzsize)
2237 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2239 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2240 do j=ielstart(i),ielend(i)
2241 cAna if (j.le.1) cycle
2242 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2243 cAna & .or.((j+2).gt.nres)
2244 cAna & .or.((j-1).le.0)
2245 cAna & .or.itype(j+2).eq.ntyp1
2246 cAna & .or.itype(j-1).eq.ntyp1
2249 if (itel(j).eq.0) goto 1216
2253 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2254 aaa=app(iteli,itelj)
2255 bbb=bpp(iteli,itelj)
2256 C Diagnostics only!!!
2262 ael6i=ael6(iteli,itelj)
2263 ael3i=ael3(iteli,itelj)
2267 dx_normj=dc_norm(1,j)
2268 dy_normj=dc_norm(2,j)
2269 dz_normj=dc_norm(3,j)
2274 if (xj.lt.0) xj=xj+boxxsize
2276 if (yj.lt.0) yj=yj+boxysize
2278 if (zj.lt.0) zj=zj+boxzsize
2279 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2287 xj=xj_safe+xshift*boxxsize
2288 yj=yj_safe+yshift*boxysize
2289 zj=zj_safe+zshift*boxzsize
2290 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2291 if(dist_temp.lt.dist_init) then
2301 if (isubchap.eq.1) then
2311 rij=xj*xj+yj*yj+zj*zj
2312 sss=sscale(sqrt(rij))
2313 sssgrad=sscagrad(sqrt(rij))
2319 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2320 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2321 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2322 fac=cosa-3.0D0*cosb*cosg
2324 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2325 if (j.eq.i+2) ev1=scal_el*ev1
2330 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2333 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
2334 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2335 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2336 if (shield_mode.gt.0) then
2341 write(iout,*) "ees_compon",i,j,el1,el2,
2342 & fac_shield(i),fac_shield(j)
2345 el1=el1*fac_shield(i)**2*fac_shield(j)**2
2346 el2=el2*fac_shield(i)**2*fac_shield(j)**2
2356 evdw1=evdw1+evdwij*sss
2357 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2358 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2359 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2360 cd & xmedi,ymedi,zmedi,xj,yj,zj
2362 C Calculate contributions to the Cartesian gradient.
2365 facvdw=-6*rrmij*(ev1+evdwij)*sss
2366 facel=-3*rrmij*(el1+eesij)
2373 * Radial derivatives. First process both termini of the fragment (i,j)
2379 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2380 & (shield_mode.gt.0)) then
2382 do ilist=1,ishield_list(i)
2383 iresshield=shield_list(ilist,i)
2385 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
2387 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2389 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
2390 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2391 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2392 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2393 C if (iresshield.gt.i) then
2394 C do ishi=i+1,iresshield-1
2395 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2396 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2400 C do ishi=iresshield,i
2401 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2402 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2410 do ilist=1,ishield_list(j)
2411 iresshield=shield_list(ilist,j)
2413 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
2415 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2417 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
2418 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2423 gshieldc(k,i)=gshieldc(k,i)+
2424 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2425 gshieldc(k,j)=gshieldc(k,j)+
2426 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2427 gshieldc(k,i-1)=gshieldc(k,i-1)+
2428 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2429 gshieldc(k,j-1)=gshieldc(k,j-1)+
2430 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2437 gelc(k,i)=gelc(k,i)+ghalf
2438 gelc(k,j)=gelc(k,j)+ghalf
2441 * Loop over residues i+1 thru j-1.
2445 gelc(l,k)=gelc(l,k)+ggg(l)
2451 if (sss.gt.0.0) then
2452 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2453 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2454 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2462 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2463 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2466 * Loop over residues i+1 thru j-1.
2470 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2474 facvdw=(ev1+evdwij)*sss
2477 fac=-3*rrmij*(facvdw+facvdw+facel)
2483 * Radial derivatives. First process both termini of the fragment (i,j)
2490 gelc(k,i)=gelc(k,i)+ghalf
2491 gelc(k,j)=gelc(k,j)+ghalf
2494 * Loop over residues i+1 thru j-1.
2498 gelc(l,k)=gelc(l,k)+ggg(l)
2505 ecosa=2.0D0*fac3*fac1+fac4
2508 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2509 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2511 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2512 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2514 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2515 cd & (dcosg(k),k=1,3)
2517 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2518 & *fac_shield(i)**2*fac_shield(j)**2
2522 gelc(k,i)=gelc(k,i)+ghalf
2523 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2524 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2525 & *fac_shield(i)**2*fac_shield(j)**2
2527 gelc(k,j)=gelc(k,j)+ghalf
2528 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2529 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2530 & *fac_shield(i)**2*fac_shield(j)**2
2534 gelc(l,k)=gelc(l,k)+ggg(l)
2539 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2540 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2541 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2543 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2544 C energy of a peptide unit is assumed in the form of a second-order
2545 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2546 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2547 C are computed for EVERY pair of non-contiguous peptide groups.
2549 if (j.lt.nres-1) then
2560 muij(kkk)=mu(k,i)*mu(l,j)
2563 cd write (iout,*) 'EELEC: i',i,' j',j
2564 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2565 cd write(iout,*) 'muij',muij
2566 ury=scalar(uy(1,i),erij)
2567 urz=scalar(uz(1,i),erij)
2568 vry=scalar(uy(1,j),erij)
2569 vrz=scalar(uz(1,j),erij)
2570 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2571 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2572 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2573 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2574 C For diagnostics only
2579 fac=dsqrt(-ael6i)*r3ij
2580 cd write (2,*) 'fac=',fac
2581 C For diagnostics only
2587 cd write (iout,'(4i5,4f10.5)')
2588 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2589 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2590 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2591 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2592 cd write (iout,'(4f10.5)')
2593 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2594 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2595 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2596 cd write (iout,'(2i3,9f10.5/)') i,j,
2597 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2599 C Derivatives of the elements of A in virtual-bond vectors
2600 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2607 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2608 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2609 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2610 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2611 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2612 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2613 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2614 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2615 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2616 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2617 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2618 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2628 C Compute radial contributions to the gradient
2650 C Add the contributions coming from er
2653 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2654 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2655 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2656 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2659 C Derivatives in DC(i)
2660 ghalf1=0.5d0*agg(k,1)
2661 ghalf2=0.5d0*agg(k,2)
2662 ghalf3=0.5d0*agg(k,3)
2663 ghalf4=0.5d0*agg(k,4)
2664 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2665 & -3.0d0*uryg(k,2)*vry)+ghalf1
2666 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2667 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2668 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2669 & -3.0d0*urzg(k,2)*vry)+ghalf3
2670 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2671 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2672 C Derivatives in DC(i+1)
2673 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2674 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2675 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2676 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2677 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2678 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2679 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2680 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2681 C Derivatives in DC(j)
2682 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2683 & -3.0d0*vryg(k,2)*ury)+ghalf1
2684 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2685 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2686 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2687 & -3.0d0*vryg(k,2)*urz)+ghalf3
2688 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2689 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2690 C Derivatives in DC(j+1) or DC(nres-1)
2691 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2692 & -3.0d0*vryg(k,3)*ury)
2693 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2694 & -3.0d0*vrzg(k,3)*ury)
2695 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2696 & -3.0d0*vryg(k,3)*urz)
2697 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2698 & -3.0d0*vrzg(k,3)*urz)
2703 C Derivatives in DC(i+1)
2704 cd aggi1(k,1)=agg(k,1)
2705 cd aggi1(k,2)=agg(k,2)
2706 cd aggi1(k,3)=agg(k,3)
2707 cd aggi1(k,4)=agg(k,4)
2708 C Derivatives in DC(j)
2713 C Derivatives in DC(j+1)
2718 if (j.eq.nres-1 .and. i.lt.j-2) then
2720 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2721 cd aggj1(k,l)=agg(k,l)
2727 C Check the loc-el terms by numerical integration
2737 aggi(k,l)=-aggi(k,l)
2738 aggi1(k,l)=-aggi1(k,l)
2739 aggj(k,l)=-aggj(k,l)
2740 aggj1(k,l)=-aggj1(k,l)
2743 if (j.lt.nres-1) then
2749 aggi(k,l)=-aggi(k,l)
2750 aggi1(k,l)=-aggi1(k,l)
2751 aggj(k,l)=-aggj(k,l)
2752 aggj1(k,l)=-aggj1(k,l)
2763 aggi(k,l)=-aggi(k,l)
2764 aggi1(k,l)=-aggi1(k,l)
2765 aggj(k,l)=-aggj(k,l)
2766 aggj1(k,l)=-aggj1(k,l)
2772 IF (wel_loc.gt.0.0d0) THEN
2773 C Contribution to the local-electrostatic energy coming from the i-j pair
2774 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2776 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2777 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2778 if (shield_mode.eq.0) then
2785 eel_loc_ij=eel_loc_ij
2786 & *fac_shield(i)*fac_shield(j)
2787 eel_loc=eel_loc+eel_loc_ij
2788 C Partial derivatives in virtual-bond dihedral angles gamma
2790 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2791 & (shield_mode.gt.0)) then
2794 do ilist=1,ishield_list(i)
2795 iresshield=shield_list(ilist,i)
2797 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
2800 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2802 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
2803 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2807 do ilist=1,ishield_list(j)
2808 iresshield=shield_list(ilist,j)
2810 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
2813 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2815 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
2816 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2822 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
2823 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
2824 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
2825 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
2826 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
2827 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
2828 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
2829 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
2833 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2834 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2835 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2836 & *fac_shield(i)*fac_shield(j)
2837 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2838 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2839 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2840 & *fac_shield(i)*fac_shield(j)
2842 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2843 cd write(iout,*) 'agg ',agg
2844 cd write(iout,*) 'aggi ',aggi
2845 cd write(iout,*) 'aggi1',aggi1
2846 cd write(iout,*) 'aggj ',aggj
2847 cd write(iout,*) 'aggj1',aggj1
2849 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2851 ggg(l)=agg(l,1)*muij(1)+
2852 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2853 & *fac_shield(i)*fac_shield(j)
2858 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2861 C Remaining derivatives of eello
2863 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2864 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2865 & *fac_shield(i)*fac_shield(j)
2867 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2868 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2869 & *fac_shield(i)*fac_shield(j)
2871 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2872 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2873 & *fac_shield(i)*fac_shield(j)
2875 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2876 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2877 & *fac_shield(i)*fac_shield(j)
2882 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2883 C Contributions from turns
2888 call eturn34(i,j,eello_turn3,eello_turn4)
2890 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2891 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2893 C Calculate the contact function. The ith column of the array JCONT will
2894 C contain the numbers of atoms that make contacts with the atom I (of numbers
2895 C greater than I). The arrays FACONT and GACONT will contain the values of
2896 C the contact function and its derivative.
2897 c r0ij=1.02D0*rpp(iteli,itelj)
2898 c r0ij=1.11D0*rpp(iteli,itelj)
2899 r0ij=2.20D0*rpp(iteli,itelj)
2900 c r0ij=1.55D0*rpp(iteli,itelj)
2901 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2902 if (fcont.gt.0.0D0) then
2903 num_conti=num_conti+1
2904 if (num_conti.gt.maxconts) then
2905 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2906 & ' will skip next contacts for this conf.'
2908 jcont_hb(num_conti,i)=j
2909 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2910 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2911 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2913 d_cont(num_conti,i)=rij
2914 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2915 C --- Electrostatic-interaction matrix ---
2916 a_chuj(1,1,num_conti,i)=a22
2917 a_chuj(1,2,num_conti,i)=a23
2918 a_chuj(2,1,num_conti,i)=a32
2919 a_chuj(2,2,num_conti,i)=a33
2920 C --- Gradient of rij
2922 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2925 c a_chuj(1,1,num_conti,i)=-0.61d0
2926 c a_chuj(1,2,num_conti,i)= 0.4d0
2927 c a_chuj(2,1,num_conti,i)= 0.65d0
2928 c a_chuj(2,2,num_conti,i)= 0.50d0
2929 c else if (i.eq.2) then
2930 c a_chuj(1,1,num_conti,i)= 0.0d0
2931 c a_chuj(1,2,num_conti,i)= 0.0d0
2932 c a_chuj(2,1,num_conti,i)= 0.0d0
2933 c a_chuj(2,2,num_conti,i)= 0.0d0
2935 C --- and its gradients
2936 cd write (iout,*) 'i',i,' j',j
2938 cd write (iout,*) 'iii 1 kkk',kkk
2939 cd write (iout,*) agg(kkk,:)
2942 cd write (iout,*) 'iii 2 kkk',kkk
2943 cd write (iout,*) aggi(kkk,:)
2946 cd write (iout,*) 'iii 3 kkk',kkk
2947 cd write (iout,*) aggi1(kkk,:)
2950 cd write (iout,*) 'iii 4 kkk',kkk
2951 cd write (iout,*) aggj(kkk,:)
2954 cd write (iout,*) 'iii 5 kkk',kkk
2955 cd write (iout,*) aggj1(kkk,:)
2962 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2963 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2964 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2965 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2966 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2968 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2974 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2975 C Calculate contact energies
2977 wij=cosa-3.0D0*cosb*cosg
2980 c fac3=dsqrt(-ael6i)/r0ij**3
2981 fac3=dsqrt(-ael6i)*r3ij
2982 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2983 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2984 if (shield_mode.eq.0) then
2988 ees0plist(num_conti,i)=j
2989 C fac_shield(i)=0.4d0
2990 C fac_shield(j)=0.6d0
2993 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2994 & *fac_shield(i)*fac_shield(j)
2996 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2997 & *fac_shield(i)*fac_shield(j)
2999 C Diagnostics. Comment out or remove after debugging!
3000 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3001 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3002 c ees0m(num_conti,i)=0.0D0
3004 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3005 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3006 facont_hb(num_conti,i)=fcont
3008 C Angular derivatives of the contact function
3009 ees0pij1=fac3/ees0pij
3010 ees0mij1=fac3/ees0mij
3011 fac3p=-3.0D0*fac3*rrmij
3012 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3013 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3015 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3016 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3017 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3018 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3019 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3020 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3021 ecosap=ecosa1+ecosa2
3022 ecosbp=ecosb1+ecosb2
3023 ecosgp=ecosg1+ecosg2
3024 ecosam=ecosa1-ecosa2
3025 ecosbm=ecosb1-ecosb2
3026 ecosgm=ecosg1-ecosg2
3035 fprimcont=fprimcont/rij
3036 cd facont_hb(num_conti,i)=1.0D0
3037 C Following line is for diagnostics.
3040 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3041 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3044 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3045 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3047 gggp(1)=gggp(1)+ees0pijp*xj
3048 gggp(2)=gggp(2)+ees0pijp*yj
3049 gggp(3)=gggp(3)+ees0pijp*zj
3050 gggm(1)=gggm(1)+ees0mijp*xj
3051 gggm(2)=gggm(2)+ees0mijp*yj
3052 gggm(3)=gggm(3)+ees0mijp*zj
3053 C Derivatives due to the contact function
3054 gacont_hbr(1,num_conti,i)=fprimcont*xj
3055 gacont_hbr(2,num_conti,i)=fprimcont*yj
3056 gacont_hbr(3,num_conti,i)=fprimcont*zj
3058 ghalfp=0.5D0*gggp(k)
3059 ghalfm=0.5D0*gggm(k)
3060 gacontp_hb1(k,num_conti,i)=ghalfp
3061 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3062 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3063 & *fac_shield(i)*fac_shield(j)
3065 gacontp_hb2(k,num_conti,i)=ghalfp
3066 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3067 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3068 & *fac_shield(i)*fac_shield(j)
3070 gacontp_hb3(k,num_conti,i)=gggp(k)
3071 & *fac_shield(i)*fac_shield(j)
3073 gacontm_hb1(k,num_conti,i)=ghalfm
3074 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3075 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3076 & *fac_shield(i)*fac_shield(j)
3078 gacontm_hb2(k,num_conti,i)=ghalfm
3079 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3080 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3081 & *fac_shield(i)*fac_shield(j)
3083 gacontm_hb3(k,num_conti,i)=gggm(k)
3084 & *fac_shield(i)*fac_shield(j)
3088 C Diagnostics. Comment out or remove after debugging!
3090 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3091 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3092 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3093 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3094 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3095 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3098 endif ! num_conti.le.maxconts
3103 num_cont_hb(i)=num_conti
3107 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3108 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3110 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3111 ccc eel_loc=eel_loc+eello_turn3
3114 C-----------------------------------------------------------------------------
3115 subroutine eturn34(i,j,eello_turn3,eello_turn4)
3116 C Third- and fourth-order contributions from turns
3117 implicit real*8 (a-h,o-z)
3118 include 'DIMENSIONS'
3119 include 'sizesclu.dat'
3120 include 'COMMON.IOUNITS'
3121 include 'COMMON.GEO'
3122 include 'COMMON.VAR'
3123 include 'COMMON.LOCAL'
3124 include 'COMMON.CHAIN'
3125 include 'COMMON.DERIV'
3126 include 'COMMON.INTERACT'
3127 include 'COMMON.CONTACTS'
3128 include 'COMMON.TORSION'
3129 include 'COMMON.VECTORS'
3130 include 'COMMON.FFIELD'
3131 include 'COMMON.SHIELD'
3132 include 'COMMON.CONTROL'
3135 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3136 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3137 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3138 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3139 & aggj(3,4),aggj1(3,4),a_temp(2,2)
3140 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
3142 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3143 C changes suggested by Ana to avoid out of bounds
3144 C & .or.((i+5).gt.nres)
3145 C & .or.((i-1).le.0)
3146 C end of changes suggested by Ana
3147 & .or. itype(i+2).eq.ntyp1
3148 & .or. itype(i+3).eq.ntyp1
3149 C & .or. itype(i+5).eq.ntyp1
3150 C & .or. itype(i).eq.ntyp1
3151 C & .or. itype(i-1).eq.ntyp1
3154 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3156 C Third-order contributions
3163 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3164 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3165 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3166 call transpose2(auxmat(1,1),auxmat1(1,1))
3167 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3168 if (shield_mode.eq.0) then
3175 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3176 & *fac_shield(i)*fac_shield(j)
3177 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
3178 & *fac_shield(i)*fac_shield(j)
3180 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3181 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3182 cd & ' eello_turn3_num',4*eello_turn3_num
3184 C Derivatives in shield mode
3185 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3186 & (shield_mode.gt.0)) then
3189 do ilist=1,ishield_list(i)
3190 iresshield=shield_list(ilist,i)
3192 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
3194 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3196 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
3197 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3201 do ilist=1,ishield_list(j)
3202 iresshield=shield_list(ilist,j)
3204 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
3206 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3208 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
3209 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3216 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
3217 & grad_shield(k,i)*eello_t3/fac_shield(i)
3218 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
3219 & grad_shield(k,j)*eello_t3/fac_shield(j)
3220 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
3221 & grad_shield(k,i)*eello_t3/fac_shield(i)
3222 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
3223 & grad_shield(k,j)*eello_t3/fac_shield(j)
3227 C Derivatives in gamma(i)
3228 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3229 call transpose2(auxmat2(1,1),pizda(1,1))
3230 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
3231 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3232 & *fac_shield(i)*fac_shield(j)
3234 C Derivatives in gamma(i+1)
3235 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3236 call transpose2(auxmat2(1,1),pizda(1,1))
3237 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
3238 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3239 & +0.5d0*(pizda(1,1)+pizda(2,2))
3240 & *fac_shield(i)*fac_shield(j)
3242 C Cartesian derivatives
3244 a_temp(1,1)=aggi(l,1)
3245 a_temp(1,2)=aggi(l,2)
3246 a_temp(2,1)=aggi(l,3)
3247 a_temp(2,2)=aggi(l,4)
3248 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3249 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3250 & +0.5d0*(pizda(1,1)+pizda(2,2))
3251 & *fac_shield(i)*fac_shield(j)
3253 a_temp(1,1)=aggi1(l,1)
3254 a_temp(1,2)=aggi1(l,2)
3255 a_temp(2,1)=aggi1(l,3)
3256 a_temp(2,2)=aggi1(l,4)
3257 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3258 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3259 & +0.5d0*(pizda(1,1)+pizda(2,2))
3260 & *fac_shield(i)*fac_shield(j)
3262 a_temp(1,1)=aggj(l,1)
3263 a_temp(1,2)=aggj(l,2)
3264 a_temp(2,1)=aggj(l,3)
3265 a_temp(2,2)=aggj(l,4)
3266 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3267 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3268 & +0.5d0*(pizda(1,1)+pizda(2,2))
3269 & *fac_shield(i)*fac_shield(j)
3271 a_temp(1,1)=aggj1(l,1)
3272 a_temp(1,2)=aggj1(l,2)
3273 a_temp(2,1)=aggj1(l,3)
3274 a_temp(2,2)=aggj1(l,4)
3275 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3276 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3277 & +0.5d0*(pizda(1,1)+pizda(2,2))
3278 & *fac_shield(i)*fac_shield(j)
3283 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
3284 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3285 C changes suggested by Ana to avoid out of bounds
3286 C & .or.((i+5).gt.nres)
3287 C & .or.((i-1).le.0)
3288 C end of changes suggested by Ana
3289 & .or. itype(i+3).eq.ntyp1
3290 & .or. itype(i+4).eq.ntyp1
3291 C & .or. itype(i+5).eq.ntyp1
3292 & .or. itype(i).eq.ntyp1
3293 C & .or. itype(i-1).eq.ntyp1
3296 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3298 C Fourth-order contributions
3306 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3307 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3308 iti1=itortyp(itype(i+1))
3309 iti2=itortyp(itype(i+2))
3310 iti3=itortyp(itype(i+3))
3311 call transpose2(EUg(1,1,i+1),e1t(1,1))
3312 call transpose2(Eug(1,1,i+2),e2t(1,1))
3313 call transpose2(Eug(1,1,i+3),e3t(1,1))
3314 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3315 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3316 s1=scalar2(b1(1,iti2),auxvec(1))
3317 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3318 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3319 s2=scalar2(b1(1,iti1),auxvec(1))
3320 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3321 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3322 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3323 if (shield_mode.eq.0) then
3330 eello_turn4=eello_turn4-(s1+s2+s3)
3331 & *fac_shield(i)*fac_shield(j)
3332 eello_t4=-(s1+s2+s3)
3333 & *fac_shield(i)*fac_shield(j)
3335 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3336 cd & ' eello_turn4_num',8*eello_turn4_num
3337 C Derivatives in gamma(i)
3339 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3340 & (shield_mode.gt.0)) then
3343 do ilist=1,ishield_list(i)
3344 iresshield=shield_list(ilist,i)
3346 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
3348 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3350 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
3351 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3355 do ilist=1,ishield_list(j)
3356 iresshield=shield_list(ilist,j)
3358 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
3360 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3362 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
3363 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3370 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
3371 & grad_shield(k,i)*eello_t4/fac_shield(i)
3372 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
3373 & grad_shield(k,j)*eello_t4/fac_shield(j)
3374 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
3375 & grad_shield(k,i)*eello_t4/fac_shield(i)
3376 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
3377 & grad_shield(k,j)*eello_t4/fac_shield(j)
3381 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3382 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3383 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3384 s1=scalar2(b1(1,iti2),auxvec(1))
3385 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3386 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3387 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3388 & *fac_shield(i)*fac_shield(j)
3390 C Derivatives in gamma(i+1)
3391 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3392 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3393 s2=scalar2(b1(1,iti1),auxvec(1))
3394 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3395 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3396 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3397 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3398 & *fac_shield(i)*fac_shield(j)
3400 C Derivatives in gamma(i+2)
3401 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3402 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3403 s1=scalar2(b1(1,iti2),auxvec(1))
3404 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3405 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3406 s2=scalar2(b1(1,iti1),auxvec(1))
3407 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
3408 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3409 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3410 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3411 & *fac_shield(i)*fac_shield(j)
3413 C Cartesian derivatives
3414 C Derivatives of this turn contributions in DC(i+2)
3415 if (j.lt.nres-1) then
3417 a_temp(1,1)=agg(l,1)
3418 a_temp(1,2)=agg(l,2)
3419 a_temp(2,1)=agg(l,3)
3420 a_temp(2,2)=agg(l,4)
3421 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3422 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3423 s1=scalar2(b1(1,iti2),auxvec(1))
3424 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3425 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3426 s2=scalar2(b1(1,iti1),auxvec(1))
3427 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3428 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3429 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3431 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3432 & *fac_shield(i)*fac_shield(j)
3436 C Remaining derivatives of this turn contribution
3438 a_temp(1,1)=aggi(l,1)
3439 a_temp(1,2)=aggi(l,2)
3440 a_temp(2,1)=aggi(l,3)
3441 a_temp(2,2)=aggi(l,4)
3442 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3443 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3444 s1=scalar2(b1(1,iti2),auxvec(1))
3445 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3446 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3447 s2=scalar2(b1(1,iti1),auxvec(1))
3448 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3449 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3450 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3451 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3452 & *fac_shield(i)*fac_shield(j)
3454 a_temp(1,1)=aggi1(l,1)
3455 a_temp(1,2)=aggi1(l,2)
3456 a_temp(2,1)=aggi1(l,3)
3457 a_temp(2,2)=aggi1(l,4)
3458 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3459 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3460 s1=scalar2(b1(1,iti2),auxvec(1))
3461 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3462 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3463 s2=scalar2(b1(1,iti1),auxvec(1))
3464 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3465 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3466 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3467 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3468 & *fac_shield(i)*fac_shield(j)
3470 a_temp(1,1)=aggj(l,1)
3471 a_temp(1,2)=aggj(l,2)
3472 a_temp(2,1)=aggj(l,3)
3473 a_temp(2,2)=aggj(l,4)
3474 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3475 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3476 s1=scalar2(b1(1,iti2),auxvec(1))
3477 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3478 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3479 s2=scalar2(b1(1,iti1),auxvec(1))
3480 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3481 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3482 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3483 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3484 & *fac_shield(i)*fac_shield(j)
3486 a_temp(1,1)=aggj1(l,1)
3487 a_temp(1,2)=aggj1(l,2)
3488 a_temp(2,1)=aggj1(l,3)
3489 a_temp(2,2)=aggj1(l,4)
3490 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3491 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3492 s1=scalar2(b1(1,iti2),auxvec(1))
3493 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3494 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3495 s2=scalar2(b1(1,iti1),auxvec(1))
3496 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3497 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3498 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3499 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3500 & *fac_shield(i)*fac_shield(j)
3508 C-----------------------------------------------------------------------------
3509 subroutine vecpr(u,v,w)
3510 implicit real*8(a-h,o-z)
3511 dimension u(3),v(3),w(3)
3512 w(1)=u(2)*v(3)-u(3)*v(2)
3513 w(2)=-u(1)*v(3)+u(3)*v(1)
3514 w(3)=u(1)*v(2)-u(2)*v(1)
3517 C-----------------------------------------------------------------------------
3518 subroutine unormderiv(u,ugrad,unorm,ungrad)
3519 C This subroutine computes the derivatives of a normalized vector u, given
3520 C the derivatives computed without normalization conditions, ugrad. Returns
3523 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3524 double precision vec(3)
3525 double precision scalar
3527 c write (2,*) 'ugrad',ugrad
3530 vec(i)=scalar(ugrad(1,i),u(1))
3532 c write (2,*) 'vec',vec
3535 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3538 c write (2,*) 'ungrad',ungrad
3541 C-----------------------------------------------------------------------------
3542 subroutine escp(evdw2,evdw2_14)
3544 C This subroutine calculates the excluded-volume interaction energy between
3545 C peptide-group centers and side chains and its gradient in virtual-bond and
3546 C side-chain vectors.
3548 implicit real*8 (a-h,o-z)
3549 include 'DIMENSIONS'
3550 include 'sizesclu.dat'
3551 include 'COMMON.GEO'
3552 include 'COMMON.VAR'
3553 include 'COMMON.LOCAL'
3554 include 'COMMON.CHAIN'
3555 include 'COMMON.DERIV'
3556 include 'COMMON.INTERACT'
3557 include 'COMMON.FFIELD'
3558 include 'COMMON.IOUNITS'
3559 integer xshift,yshift,zshift
3563 cd print '(a)','Enter ESCP'
3564 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
3565 c & ' scal14',scal14
3566 do i=iatscp_s,iatscp_e
3567 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3569 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
3570 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
3571 if (iteli.eq.0) goto 1225
3572 xi=0.5D0*(c(1,i)+c(1,i+1))
3573 yi=0.5D0*(c(2,i)+c(2,i+1))
3574 zi=0.5D0*(c(3,i)+c(3,i+1))
3575 C Returning the ith atom to box
3577 if (xi.lt.0) xi=xi+boxxsize
3579 if (yi.lt.0) yi=yi+boxysize
3581 if (zi.lt.0) zi=zi+boxzsize
3583 do iint=1,nscp_gr(i)
3585 do j=iscpstart(i,iint),iscpend(i,iint)
3586 itypj=iabs(itype(j))
3587 if (itypj.eq.ntyp1) cycle
3588 C Uncomment following three lines for SC-p interactions
3592 C Uncomment following three lines for Ca-p interactions
3596 C returning the jth atom to box
3598 if (xj.lt.0) xj=xj+boxxsize
3600 if (yj.lt.0) yj=yj+boxysize
3602 if (zj.lt.0) zj=zj+boxzsize
3603 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3608 C Finding the closest jth atom
3612 xj=xj_safe+xshift*boxxsize
3613 yj=yj_safe+yshift*boxysize
3614 zj=zj_safe+zshift*boxzsize
3615 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3616 if(dist_temp.lt.dist_init) then
3626 if (subchap.eq.1) then
3636 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3637 C sss is scaling function for smoothing the cutoff gradient otherwise
3638 C the gradient would not be continuouse
3639 sss=sscale(1.0d0/(dsqrt(rrij)))
3640 if (sss.le.0.0d0) cycle
3641 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3643 e1=fac*fac*aad(itypj,iteli)
3644 e2=fac*bad(itypj,iteli)
3645 if (iabs(j-i) .le. 2) then
3648 evdw2_14=evdw2_14+(e1+e2)*sss
3651 c write (iout,*) i,j,evdwij
3652 evdw2=evdw2+evdwij*sss
3655 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3657 fac=-(evdwij+e1)*rrij*sss
3658 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
3663 cd write (iout,*) 'j<i'
3664 C Uncomment following three lines for SC-p interactions
3666 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3669 cd write (iout,*) 'j>i'
3672 C Uncomment following line for SC-p interactions
3673 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3677 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3681 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3682 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3685 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3695 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3696 gradx_scp(j,i)=expon*gradx_scp(j,i)
3699 C******************************************************************************
3703 C To save time the factor EXPON has been extracted from ALL components
3704 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3707 C******************************************************************************
3710 C--------------------------------------------------------------------------
3711 subroutine edis(ehpb)
3713 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3715 implicit real*8 (a-h,o-z)
3716 include 'DIMENSIONS'
3717 include 'sizesclu.dat'
3718 include 'COMMON.SBRIDGE'
3719 include 'COMMON.CHAIN'
3720 include 'COMMON.DERIV'
3721 include 'COMMON.VAR'
3722 include 'COMMON.INTERACT'
3723 include 'COMMON.CONTROL'
3726 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
3727 cd print *,'link_start=',link_start,' link_end=',link_end
3728 if (link_end.eq.0) return
3729 do i=link_start,link_end
3730 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3731 C CA-CA distance used in regularization of structure.
3734 C iii and jjj point to the residues for which the distance is assigned.
3735 if (ii.gt.nres) then
3742 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3743 C distance and angle dependent SS bond potential.
3744 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3745 C & iabs(itype(jjj)).eq.1) then
3746 C call ssbond_ene(iii,jjj,eij)
3749 if (.not.dyn_ss .and. i.le.nss) then
3750 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3751 & iabs(itype(jjj)).eq.1) then
3752 call ssbond_ene(iii,jjj,eij)
3755 else if (ii.gt.nres .and. jj.gt.nres) then
3756 c Restraints from contact prediction
3758 if (constr_dist.eq.11) then
3759 C ehpb=ehpb+fordepth(i)**4.0d0
3760 C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3761 ehpb=ehpb+fordepth(i)**4.0d0
3762 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3763 fac=fordepth(i)**4.0d0
3764 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3765 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3766 C & ehpb,fordepth(i),dd
3768 C write(iout,*) ehpb,"atu?"
3770 C fac=fordepth(i)**4.0d0
3771 C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3772 else !constr_dist.eq.11
3773 if (dhpb1(i).gt.0.0d0) then
3774 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3775 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3776 c write (iout,*) "beta nmr",
3777 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3778 else !dhpb(i).gt.0.00
3780 C Calculate the distance between the two points and its difference from the
3784 C Get the force constant corresponding to this distance.
3786 C Calculate the contribution to energy.
3787 ehpb=ehpb+waga*rdis*rdis
3789 C Evaluate gradient.
3794 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
3795 cd & ' waga=',waga,' fac=',fac
3797 ggg(j)=fac*(c(j,jj)-c(j,ii))
3799 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3800 C If this is a SC-SC distance, we need to calculate the contributions to the
3801 C Cartesian gradient in the SC vectors (ghpbx).
3804 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3805 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3809 C write(iout,*) "before"
3811 C write(iout,*) "after",dd
3812 if (constr_dist.eq.11) then
3813 ehpb=ehpb+fordepth(i)**4.0d0
3814 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3815 fac=fordepth(i)**4.0d0
3816 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3817 C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
3818 C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
3819 C print *,ehpb,"tu?"
3820 C write(iout,*) ehpb,"btu?",
3821 C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
3822 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3823 C & ehpb,fordepth(i),dd
3825 if (dhpb1(i).gt.0.0d0) then
3826 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3827 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3828 c write (iout,*) "alph nmr",
3829 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3832 C Get the force constant corresponding to this distance.
3834 C Calculate the contribution to energy.
3835 ehpb=ehpb+waga*rdis*rdis
3836 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
3838 C Evaluate gradient.
3844 ggg(j)=fac*(c(j,jj)-c(j,ii))
3846 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3847 C If this is a SC-SC distance, we need to calculate the contributions to the
3848 C Cartesian gradient in the SC vectors (ghpbx).
3851 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3852 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3857 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3862 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
3865 C--------------------------------------------------------------------------
3866 subroutine ssbond_ene(i,j,eij)
3868 C Calculate the distance and angle dependent SS-bond potential energy
3869 C using a free-energy function derived based on RHF/6-31G** ab initio
3870 C calculations of diethyl disulfide.
3872 C A. Liwo and U. Kozlowska, 11/24/03
3874 implicit real*8 (a-h,o-z)
3875 include 'DIMENSIONS'
3876 include 'sizesclu.dat'
3877 include 'COMMON.SBRIDGE'
3878 include 'COMMON.CHAIN'
3879 include 'COMMON.DERIV'
3880 include 'COMMON.LOCAL'
3881 include 'COMMON.INTERACT'
3882 include 'COMMON.VAR'
3883 include 'COMMON.IOUNITS'
3884 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3885 itypi=iabs(itype(i))
3889 dxi=dc_norm(1,nres+i)
3890 dyi=dc_norm(2,nres+i)
3891 dzi=dc_norm(3,nres+i)
3892 dsci_inv=dsc_inv(itypi)
3893 itypj=iabs(itype(j))
3894 dscj_inv=dsc_inv(itypj)
3898 dxj=dc_norm(1,nres+j)
3899 dyj=dc_norm(2,nres+j)
3900 dzj=dc_norm(3,nres+j)
3901 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3906 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3907 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3908 om12=dxi*dxj+dyi*dyj+dzi*dzj
3910 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3911 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3917 deltat12=om2-om1+2.0d0
3919 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3920 & +akct*deltad*deltat12
3921 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3922 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3923 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3924 c & " deltat12",deltat12," eij",eij
3925 ed=2*akcm*deltad+akct*deltat12
3927 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3928 eom1=-2*akth*deltat1-pom1-om2*pom2
3929 eom2= 2*akth*deltat2+pom1-om1*pom2
3932 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3935 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3936 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3937 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3938 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3941 C Calculate the components of the gradient in DC and X
3945 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3950 C--------------------------------------------------------------------------
3953 c LICZENIE WIEZOW Z ROWNANIA ENERGII MODELLERA
3954 subroutine e_modeller(ehomology_constr)
3955 implicit real*8 (a-h,o-z)
3957 include 'DIMENSIONS'
3959 integer nnn, i, j, k, ki, irec, l
3960 integer katy, odleglosci, test7
3961 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
3962 real*8 distance(max_template),distancek(max_template),
3963 & min_odl,godl(max_template),dih_diff(max_template)
3966 c FP - 30/10/2014 Temporary specifications for homology restraints
3968 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
3970 double precision, dimension (maxres) :: guscdiff,usc_diff
3971 double precision, dimension (max_template) ::
3972 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
3975 include 'COMMON.SBRIDGE'
3976 include 'COMMON.CHAIN'
3977 include 'COMMON.GEO'
3978 include 'COMMON.DERIV'
3979 include 'COMMON.LOCAL'
3980 include 'COMMON.INTERACT'
3981 include 'COMMON.VAR'
3982 include 'COMMON.IOUNITS'
3983 include 'COMMON.CONTROL'
3984 include 'COMMON.HOMRESTR'
3986 include 'COMMON.SETUP'
3987 include 'COMMON.NAMES'
3990 distancek(i)=9999999.9
3995 c Pseudo-energy and gradient from homology restraints (MODELLER-like
3997 C AL 5/2/14 - Introduce list of restraints
3998 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
4000 write(iout,*) "------- dist restrs start -------"
4001 write (iout,*) "link_start_homo",link_start_homo,
4002 & " link_end_homo",link_end_homo
4004 do ii = link_start_homo,link_end_homo
4008 c write (iout,*) "dij(",i,j,") =",dij
4010 do k=1,constr_homology
4011 if(.not.l_homo(k,ii)) then
4015 distance(k)=odl(k,ii)-dij
4016 c write (iout,*) "distance(",k,") =",distance(k)
4018 c For Gaussian-type Urestr
4020 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
4021 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
4022 c write (iout,*) "distancek(",k,") =",distancek(k)
4023 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
4025 c For Lorentzian-type Urestr
4027 if (waga_dist.lt.0.0d0) then
4028 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
4029 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
4030 & (distance(k)**2+sigma_odlir(k,ii)**2))
4034 c min_odl=minval(distancek)
4035 do kk=1,constr_homology
4036 if(l_homo(kk,ii)) then
4037 min_odl=distancek(kk)
4041 do kk=1,constr_homology
4042 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
4043 & min_odl=distancek(kk)
4045 c write (iout,* )"min_odl",min_odl
4047 write (iout,*) "ij dij",i,j,dij
4048 write (iout,*) "distance",(distance(k),k=1,constr_homology)
4049 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
4050 write (iout,* )"min_odl",min_odl
4055 if (waga_dist.ge.0.0d0) then
4061 do k=1,constr_homology
4062 c Nie wiem po co to liczycie jeszcze raz!
4063 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
4064 c & (2*(sigma_odl(i,j,k))**2))
4065 if(.not.l_homo(k,ii)) cycle
4066 if (waga_dist.ge.0.0d0) then
4068 c For Gaussian-type Urestr
4070 godl(k)=dexp(-distancek(k)+min_odl)
4071 odleg2=odleg2+godl(k)
4073 c For Lorentzian-type Urestr
4076 odleg2=odleg2+distancek(k)
4079 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
4080 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
4081 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
4082 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
4085 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
4086 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
4088 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
4089 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
4091 if (waga_dist.ge.0.0d0) then
4093 c For Gaussian-type Urestr
4095 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
4097 c For Lorentzian-type Urestr
4100 odleg=odleg+odleg2/constr_homology
4104 c write (iout,*) "odleg",odleg ! sum of -ln-s
4107 c For Gaussian-type Urestr
4109 if (waga_dist.ge.0.0d0) sum_godl=odleg2
4111 do k=1,constr_homology
4112 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
4113 c & *waga_dist)+min_odl
4114 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
4116 if(.not.l_homo(k,ii)) cycle
4117 if (waga_dist.ge.0.0d0) then
4118 c For Gaussian-type Urestr
4120 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
4122 c For Lorentzian-type Urestr
4125 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
4126 & sigma_odlir(k,ii)**2)**2)
4128 sum_sgodl=sum_sgodl+sgodl
4130 c sgodl2=sgodl2+sgodl
4131 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
4132 c write(iout,*) "constr_homology=",constr_homology
4133 c write(iout,*) i, j, k, "TEST K"
4135 if (waga_dist.ge.0.0d0) then
4137 c For Gaussian-type Urestr
4139 grad_odl3=waga_homology(iset)*waga_dist
4140 & *sum_sgodl/(sum_godl*dij)
4142 c For Lorentzian-type Urestr
4145 c Original grad expr modified by analogy w Gaussian-type Urestr grad
4146 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
4147 grad_odl3=-waga_homology(iset)*waga_dist*
4148 & sum_sgodl/(constr_homology*dij)
4151 c grad_odl3=sum_sgodl/(sum_godl*dij)
4154 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
4155 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
4156 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
4158 ccc write(iout,*) godl, sgodl, grad_odl3
4160 c grad_odl=grad_odl+grad_odl3
4163 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
4164 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
4165 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
4166 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
4167 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
4168 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
4169 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
4170 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
4171 c if (i.eq.25.and.j.eq.27) then
4172 c write(iout,*) "jik",jik,"i",i,"j",j
4173 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
4174 c write(iout,*) "grad_odl3",grad_odl3
4175 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
4176 c write(iout,*) "ggodl",ggodl
4177 c write(iout,*) "ghpbc(",jik,i,")",
4178 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
4183 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
4184 ccc & dLOG(odleg2),"-odleg=", -odleg
4186 enddo ! ii-loop for dist
4188 write(iout,*) "------- dist restrs end -------"
4189 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
4190 c & waga_d.eq.1.0d0) call sum_gradient
4192 c Pseudo-energy and gradient from dihedral-angle restraints from
4193 c homology templates
4194 c write (iout,*) "End of distance loop"
4197 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
4199 write(iout,*) "------- dih restrs start -------"
4200 do i=idihconstr_start_homo,idihconstr_end_homo
4201 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
4204 do i=idihconstr_start_homo,idihconstr_end_homo
4206 c betai=beta(i,i+1,i+2,i+3)
4208 c write (iout,*) "betai =",betai
4209 do k=1,constr_homology
4210 dih_diff(k)=pinorm(dih(k,i)-betai)
4211 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
4212 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
4213 c & -(6.28318-dih_diff(i,k))
4214 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
4215 c & 6.28318+dih_diff(i,k)
4217 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
4219 kat3=(dcos(dih_diff(k))-1)*sigma_dih(k,i)
4221 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
4224 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
4227 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
4228 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
4230 write (iout,*) "i",i," betai",betai," kat2",kat2
4231 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
4233 if (kat2.le.1.0d-14) cycle
4234 kat=kat-dLOG(kat2/constr_homology)
4235 c write (iout,*) "kat",kat ! sum of -ln-s
4237 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
4238 ccc & dLOG(kat2), "-kat=", -kat
4241 c ----------------------------------------------------------------------
4243 c ----------------------------------------------------------------------
4247 do k=1,constr_homology
4249 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
4251 sgdih=-gdih(k)*dsin(dih_diff(k))*sigma_dih(k,i)
4253 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
4254 sum_sgdih=sum_sgdih+sgdih
4256 c grad_dih3=sum_sgdih/sum_gdih
4257 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
4259 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
4260 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
4261 ccc & gloc(nphi+i-3,icg)
4262 gloc(i,icg)=gloc(i,icg)+grad_dih3
4264 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
4266 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
4267 ccc & gloc(nphi+i-3,icg)
4269 enddo ! i-loop for dih
4271 write(iout,*) "------- dih restrs end -------"
4274 c Pseudo-energy and gradient for theta angle restraints from
4275 c homology templates
4276 c FP 01/15 - inserted from econstr_local_test.F, loop structure
4280 c For constr_homology reference structures (FP)
4282 c Uconst_back_tot=0.0d0
4285 c Econstr_back legacy
4288 c do i=ithet_start,ithet_end
4291 c do i=loc_start,loc_end
4294 duscdiffx(j,i)=0.0d0
4300 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
4301 c write (iout,*) "waga_theta",waga_theta
4302 if (waga_theta.gt.0.0d0) then
4304 write (iout,*) "usampl",usampl
4305 write(iout,*) "------- theta restrs start -------"
4306 c do i=ithet_start,ithet_end
4307 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
4310 c write (iout,*) "maxres",maxres,"nres",nres
4312 do i=ithet_start,ithet_end
4315 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
4317 c Deviation of theta angles wrt constr_homology ref structures
4319 utheta_i=0.0d0 ! argument of Gaussian for single k
4320 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
4321 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
4322 c over residues in a fragment
4323 c write (iout,*) "theta(",i,")=",theta(i)
4324 do k=1,constr_homology
4326 c dtheta_i=theta(j)-thetaref(j,iref)
4327 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
4328 theta_diff(k)=thetatpl(k,i)-theta(i)
4330 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
4331 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
4332 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
4333 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
4334 c Gradient for single Gaussian restraint in subr Econstr_back
4335 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
4338 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
4339 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
4343 c Gradient for multiple Gaussian restraint
4344 sum_gtheta=gutheta_i
4346 do k=1,constr_homology
4347 c New generalized expr for multiple Gaussian from Econstr_back
4348 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
4350 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
4351 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
4354 c Final value of gradient using same var as in Econstr_back
4355 dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
4356 & *waga_homology(iset)
4357 c dutheta(i)=sum_sgtheta/sum_gtheta
4359 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
4361 Eval=Eval-dLOG(gutheta_i/constr_homology)
4362 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
4363 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
4364 c Uconst_back=Uconst_back+utheta(i)
4365 enddo ! (i-loop for theta)
4367 write(iout,*) "------- theta restrs end -------"
4371 c Deviation of local SC geometry
4373 c Separation of two i-loops (instructed by AL - 11/3/2014)
4375 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
4376 c write (iout,*) "waga_d",waga_d
4379 write(iout,*) "------- SC restrs start -------"
4380 write (iout,*) "Initial duscdiff,duscdiffx"
4381 do i=loc_start,loc_end
4382 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
4383 & (duscdiffx(jik,i),jik=1,3)
4386 do i=loc_start,loc_end
4387 usc_diff_i=0.0d0 ! argument of Gaussian for single k
4388 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
4389 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
4390 c write(iout,*) "xxtab, yytab, zztab"
4391 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
4392 do k=1,constr_homology
4394 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
4395 c Original sign inverted for calc of gradients (s. Econstr_back)
4396 dyy=-yytpl(k,i)+yytab(i) ! ibid y
4397 dzz=-zztpl(k,i)+zztab(i) ! ibid z
4398 c write(iout,*) "dxx, dyy, dzz"
4399 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
4401 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
4402 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
4403 c uscdiffk(k)=usc_diff(i)
4404 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
4405 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
4406 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
4407 c & xxref(j),yyref(j),zzref(j)
4412 c Generalized expression for multiple Gaussian acc to that for a single
4413 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
4415 c Original implementation
4416 c sum_guscdiff=guscdiff(i)
4418 c sum_sguscdiff=0.0d0
4419 c do k=1,constr_homology
4420 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
4421 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
4422 c sum_sguscdiff=sum_sguscdiff+sguscdiff
4425 c Implementation of new expressions for gradient (Jan. 2015)
4427 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
4429 do k=1,constr_homology
4431 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
4432 c before. Now the drivatives should be correct
4434 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
4435 c Original sign inverted for calc of gradients (s. Econstr_back)
4436 dyy=-yytpl(k,i)+yytab(i) ! ibid y
4437 dzz=-zztpl(k,i)+zztab(i) ! ibid z
4439 c New implementation
4441 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
4442 & sigma_d(k,i) ! for the grad wrt r'
4443 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
4446 c New implementation
4447 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
4449 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
4450 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
4451 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
4452 duscdiff(jik,i)=duscdiff(jik,i)+
4453 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
4454 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
4455 duscdiffx(jik,i)=duscdiffx(jik,i)+
4456 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
4457 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
4460 write(iout,*) "jik",jik,"i",i
4461 write(iout,*) "dxx, dyy, dzz"
4462 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
4463 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
4464 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
4465 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
4466 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
4467 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
4468 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
4469 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
4470 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
4471 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
4472 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
4473 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
4474 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
4475 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
4476 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
4483 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
4484 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
4486 c write (iout,*) i," uscdiff",uscdiff(i)
4488 c Put together deviations from local geometry
4490 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
4491 c & wfrag_back(3,i,iset)*uscdiff(i)
4492 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
4493 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
4494 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
4495 c Uconst_back=Uconst_back+usc_diff(i)
4497 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
4499 c New implment: multiplied by sum_sguscdiff
4502 enddo ! (i-loop for dscdiff)
4507 write(iout,*) "------- SC restrs end -------"
4508 write (iout,*) "------ After SC loop in e_modeller ------"
4509 do i=loc_start,loc_end
4510 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
4511 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
4513 if (waga_theta.eq.1.0d0) then
4514 write (iout,*) "in e_modeller after SC restr end: dutheta"
4515 do i=ithet_start,ithet_end
4516 write (iout,*) i,dutheta(i)
4519 if (waga_d.eq.1.0d0) then
4520 write (iout,*) "e_modeller after SC loop: duscdiff/x"
4522 write (iout,*) i,(duscdiff(j,i),j=1,3)
4523 write (iout,*) i,(duscdiffx(j,i),j=1,3)
4528 c Total energy from homology restraints
4530 write (iout,*) "odleg",odleg," kat",kat
4531 write (iout,*) "odleg",odleg," kat",kat
4532 write (iout,*) "Eval",Eval," Erot",Erot
4533 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
4534 write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
4535 write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
4536 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
4539 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
4541 c ehomology_constr=odleg+kat
4543 c For Lorentzian-type Urestr
4546 if (waga_dist.ge.0.0d0) then
4548 c For Gaussian-type Urestr
4550 ehomology_constr=(waga_dist*odleg+waga_angle*kat+
4551 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
4552 c write (iout,*) "ehomology_constr=",ehomology_constr
4555 c For Lorentzian-type Urestr
4557 ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
4558 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
4559 c write (iout,*) "ehomology_constr=",ehomology_constr
4562 write (iout,*) "iset",iset," waga_homology",waga_homology(iset)
4563 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
4564 & " Eval",waga_theta,Eval," Erot",waga_d,Erot
4565 write (iout,*) "ehomology_constr",ehomology_constr
4569 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
4570 747 format(a12,i4,i4,i4,f8.3,f8.3)
4571 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
4572 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
4573 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
4574 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
4576 C--------------------------------------------------------------------------
4578 C--------------------------------------------------------------------------
4579 subroutine ebond(estr)
4581 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4583 implicit real*8 (a-h,o-z)
4584 include 'DIMENSIONS'
4585 include 'sizesclu.dat'
4586 include 'COMMON.LOCAL'
4587 include 'COMMON.GEO'
4588 include 'COMMON.INTERACT'
4589 include 'COMMON.DERIV'
4590 include 'COMMON.VAR'
4591 include 'COMMON.CHAIN'
4592 include 'COMMON.IOUNITS'
4593 include 'COMMON.NAMES'
4594 include 'COMMON.FFIELD'
4595 include 'COMMON.CONTROL'
4596 logical energy_dec /.false./
4597 double precision u(3),ud(3)
4601 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4602 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4604 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4605 C & *dc(j,i-1)/vbld(i)
4607 C if (energy_dec) write(iout,*)
4608 C & "estr1",i,vbld(i),distchainmax,
4609 C & gnmr1(vbld(i),-1.0d0,distchainmax)
4611 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4612 diff = vbld(i)-vbldpDUM
4614 diff = vbld(i)-vbldp0
4615 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4619 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4622 C write (iout,'(a7,i5,4f7.3)')
4623 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4625 estr=0.5d0*AKP*estr+estr1
4627 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4631 if (iti.ne.10 .and. iti.ne.ntyp1) then
4634 diff=vbld(i+nres)-vbldsc0(1,iti)
4635 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4636 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4637 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4639 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4643 diff=vbld(i+nres)-vbldsc0(j,iti)
4644 ud(j)=aksc(j,iti)*diff
4645 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4659 uprod2=uprod2*u(k)*u(k)
4663 usumsqder=usumsqder+ud(j)*uprod2
4665 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
4666 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
4667 estr=estr+uprod/usum
4669 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4677 C--------------------------------------------------------------------------
4678 subroutine ebend(etheta,ethetacnstr)
4680 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4681 C angles gamma and its derivatives in consecutive thetas and gammas.
4683 implicit real*8 (a-h,o-z)
4684 include 'DIMENSIONS'
4685 include 'sizesclu.dat'
4686 include 'COMMON.LOCAL'
4687 include 'COMMON.GEO'
4688 include 'COMMON.INTERACT'
4689 include 'COMMON.DERIV'
4690 include 'COMMON.VAR'
4691 include 'COMMON.CHAIN'
4692 include 'COMMON.IOUNITS'
4693 include 'COMMON.NAMES'
4694 include 'COMMON.FFIELD'
4695 include 'COMMON.TORCNSTR'
4696 common /calcthet/ term1,term2,termm,diffak,ratak,
4697 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4698 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4699 double precision y(2),z(2)
4701 c time11=dexp(-2*time)
4704 c write (iout,*) "nres",nres
4705 c write (*,'(a,i2)') 'EBEND ICG=',icg
4706 c write (iout,*) ithet_start,ithet_end
4707 do i=ithet_start,ithet_end
4708 C if (itype(i-1).eq.ntyp1) cycle
4710 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4711 & .or.itype(i).eq.ntyp1) cycle
4712 C Zero the energy function and its derivative at 0 or pi.
4713 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4715 ichir1=isign(1,itype(i-2))
4716 ichir2=isign(1,itype(i))
4717 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4718 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4719 if (itype(i-1).eq.10) then
4720 itype1=isign(10,itype(i-2))
4721 ichir11=isign(1,itype(i-2))
4722 ichir12=isign(1,itype(i-2))
4723 itype2=isign(10,itype(i))
4724 ichir21=isign(1,itype(i))
4725 ichir22=isign(1,itype(i))
4732 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
4736 c call proc_proc(phii,icrc)
4737 if (icrc.eq.1) phii=150.0
4748 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4752 c call proc_proc(phii1,icrc)
4753 if (icrc.eq.1) phii1=150.0
4765 C Calculate the "mean" value of theta from the part of the distribution
4766 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4767 C In following comments this theta will be referred to as t_c.
4768 thet_pred_mean=0.0d0
4770 athetk=athet(k,it,ichir1,ichir2)
4771 bthetk=bthet(k,it,ichir1,ichir2)
4773 athetk=athet(k,itype1,ichir11,ichir12)
4774 bthetk=bthet(k,itype2,ichir21,ichir22)
4776 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4778 c write (iout,*) "thet_pred_mean",thet_pred_mean
4779 dthett=thet_pred_mean*ssd
4780 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4781 c write (iout,*) "thet_pred_mean",thet_pred_mean
4782 C Derivatives of the "mean" values in gamma1 and gamma2.
4783 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4784 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4785 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4786 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4788 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4789 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4790 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4791 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4793 if (theta(i).gt.pi-delta) then
4794 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4796 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4797 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4798 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4800 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4802 else if (theta(i).lt.delta) then
4803 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4804 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4805 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4807 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4808 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4811 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4814 etheta=etheta+ethetai
4815 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4816 c & rad2deg*phii,rad2deg*phii1,ethetai
4817 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4818 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4819 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4822 C Ufff.... We've done all this!!!
4825 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4826 do i=1,ntheta_constr
4827 itheta=itheta_constr(i)
4828 thetiii=theta(itheta)
4829 difi=pinorm(thetiii-theta_constr0(i))
4830 if (difi.gt.theta_drange(i)) then
4831 difi=difi-theta_drange(i)
4832 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4833 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4834 & +for_thet_constr(i)*difi**3
4835 else if (difi.lt.-drange(i)) then
4837 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4838 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4839 & +for_thet_constr(i)*difi**3
4843 C if (energy_dec) then
4844 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4845 C & i,itheta,rad2deg*thetiii,
4846 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4847 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4848 C & gloc(itheta+nphi-2,icg)
4853 C---------------------------------------------------------------------------
4854 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4856 implicit real*8 (a-h,o-z)
4857 include 'DIMENSIONS'
4858 include 'COMMON.LOCAL'
4859 include 'COMMON.IOUNITS'
4860 common /calcthet/ term1,term2,termm,diffak,ratak,
4861 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4862 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4863 C Calculate the contributions to both Gaussian lobes.
4864 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4865 C The "polynomial part" of the "standard deviation" of this part of
4869 sig=sig*thet_pred_mean+polthet(j,it)
4871 C Derivative of the "interior part" of the "standard deviation of the"
4872 C gamma-dependent Gaussian lobe in t_c.
4873 sigtc=3*polthet(3,it)
4875 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4878 C Set the parameters of both Gaussian lobes of the distribution.
4879 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4880 fac=sig*sig+sigc0(it)
4883 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4884 sigsqtc=-4.0D0*sigcsq*sigtc
4885 c print *,i,sig,sigtc,sigsqtc
4886 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4887 sigtc=-sigtc/(fac*fac)
4888 C Following variable is sigma(t_c)**(-2)
4889 sigcsq=sigcsq*sigcsq
4891 sig0inv=1.0D0/sig0i**2
4892 delthec=thetai-thet_pred_mean
4893 delthe0=thetai-theta0i
4894 term1=-0.5D0*sigcsq*delthec*delthec
4895 term2=-0.5D0*sig0inv*delthe0*delthe0
4896 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4897 C NaNs in taking the logarithm. We extract the largest exponent which is added
4898 C to the energy (this being the log of the distribution) at the end of energy
4899 C term evaluation for this virtual-bond angle.
4900 if (term1.gt.term2) then
4902 term2=dexp(term2-termm)
4906 term1=dexp(term1-termm)
4909 C The ratio between the gamma-independent and gamma-dependent lobes of
4910 C the distribution is a Gaussian function of thet_pred_mean too.
4911 diffak=gthet(2,it)-thet_pred_mean
4912 ratak=diffak/gthet(3,it)**2
4913 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4914 C Let's differentiate it in thet_pred_mean NOW.
4916 C Now put together the distribution terms to make complete distribution.
4917 termexp=term1+ak*term2
4918 termpre=sigc+ak*sig0i
4919 C Contribution of the bending energy from this theta is just the -log of
4920 C the sum of the contributions from the two lobes and the pre-exponential
4921 C factor. Simple enough, isn't it?
4922 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4923 C NOW the derivatives!!!
4924 C 6/6/97 Take into account the deformation.
4925 E_theta=(delthec*sigcsq*term1
4926 & +ak*delthe0*sig0inv*term2)/termexp
4927 E_tc=((sigtc+aktc*sig0i)/termpre
4928 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4929 & aktc*term2)/termexp)
4932 c-----------------------------------------------------------------------------
4933 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4934 implicit real*8 (a-h,o-z)
4935 include 'DIMENSIONS'
4936 include 'COMMON.LOCAL'
4937 include 'COMMON.IOUNITS'
4938 common /calcthet/ term1,term2,termm,diffak,ratak,
4939 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4940 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4941 delthec=thetai-thet_pred_mean
4942 delthe0=thetai-theta0i
4943 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4944 t3 = thetai-thet_pred_mean
4948 t14 = t12+t6*sigsqtc
4950 t21 = thetai-theta0i
4956 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4957 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4958 & *(-t12*t9-ak*sig0inv*t27)
4962 C--------------------------------------------------------------------------
4963 subroutine ebend(etheta,ethetacnstr)
4965 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4966 C angles gamma and its derivatives in consecutive thetas and gammas.
4967 C ab initio-derived potentials from
4968 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4970 implicit real*8 (a-h,o-z)
4971 include 'DIMENSIONS'
4972 include 'sizesclu.dat'
4973 include 'COMMON.LOCAL'
4974 include 'COMMON.GEO'
4975 include 'COMMON.INTERACT'
4976 include 'COMMON.DERIV'
4977 include 'COMMON.VAR'
4978 include 'COMMON.CHAIN'
4979 include 'COMMON.IOUNITS'
4980 include 'COMMON.NAMES'
4981 include 'COMMON.FFIELD'
4982 include 'COMMON.CONTROL'
4983 include 'COMMON.TORCNSTR'
4984 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4985 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4986 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4987 & sinph1ph2(maxdouble,maxdouble)
4988 logical lprn /.false./, lprn1 /.false./
4990 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4991 do i=ithet_start,ithet_end
4993 c print *,i,itype(i-1),itype(i),itype(i-2)
4994 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1)
4995 & .or.(itype(i).eq.ntyp1)) cycle
4996 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
4998 if (iabs(itype(i+1)).eq.20) iblock=2
4999 if (iabs(itype(i+1)).ne.20) iblock=1
5003 theti2=0.5d0*theta(i)
5004 ityp2=ithetyp((itype(i-1)))
5006 coskt(k)=dcos(k*theti2)
5007 sinkt(k)=dsin(k*theti2)
5009 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
5012 if (phii.ne.phii) phii=150.0
5016 ityp1=ithetyp((itype(i-2)))
5018 cosph1(k)=dcos(k*phii)
5019 sinph1(k)=dsin(k*phii)
5023 ityp1=ithetyp(itype(i-2))
5029 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5032 if (phii1.ne.phii1) phii1=150.0
5037 ityp3=ithetyp((itype(i)))
5039 cosph2(k)=dcos(k*phii1)
5040 sinph2(k)=dsin(k*phii1)
5044 ityp3=ithetyp(itype(i))
5050 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
5051 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
5053 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5056 ccl=cosph1(l)*cosph2(k-l)
5057 ssl=sinph1(l)*sinph2(k-l)
5058 scl=sinph1(l)*cosph2(k-l)
5059 csl=cosph1(l)*sinph2(k-l)
5060 cosph1ph2(l,k)=ccl-ssl
5061 cosph1ph2(k,l)=ccl+ssl
5062 sinph1ph2(l,k)=scl+csl
5063 sinph1ph2(k,l)=scl-csl
5067 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5068 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5069 write (iout,*) "coskt and sinkt"
5071 write (iout,*) k,coskt(k),sinkt(k)
5075 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5076 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5079 & write (iout,*) "k",k," aathet",
5080 & aathet(k,ityp1,ityp2,ityp3,iblock),
5081 & " ethetai",ethetai
5084 write (iout,*) "cosph and sinph"
5086 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5088 write (iout,*) "cosph1ph2 and sinph2ph2"
5091 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5092 & sinph1ph2(l,k),sinph1ph2(k,l)
5095 write(iout,*) "ethetai",ethetai
5099 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5100 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5101 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5102 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5103 ethetai=ethetai+sinkt(m)*aux
5104 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5105 dephii=dephii+k*sinkt(m)*(
5106 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5107 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5108 dephii1=dephii1+k*sinkt(m)*(
5109 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5110 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5112 & write (iout,*) "m",m," k",k," bbthet",
5113 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5114 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5115 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5116 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5120 & write(iout,*) "ethetai",ethetai
5124 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5125 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5126 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5127 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5128 ethetai=ethetai+sinkt(m)*aux
5129 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5130 dephii=dephii+l*sinkt(m)*(
5131 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5132 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5133 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5134 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5135 dephii1=dephii1+(k-l)*sinkt(m)*(
5136 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5137 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5138 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5139 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5141 write (iout,*) "m",m," k",k," l",l," ffthet",
5142 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5143 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5144 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5145 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5146 & " ethetai",ethetai
5147 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5148 & cosph1ph2(k,l)*sinkt(m),
5149 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5155 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5156 & i,theta(i)*rad2deg,phii*rad2deg,
5157 & phii1*rad2deg,ethetai
5158 etheta=etheta+ethetai
5159 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5160 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5161 c gloc(nphi+i-2,icg)=wang*dethetai
5162 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
5166 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
5167 do i=1,ntheta_constr
5168 itheta=itheta_constr(i)
5169 thetiii=theta(itheta)
5170 difi=pinorm(thetiii-theta_constr0(i))
5171 if (difi.gt.theta_drange(i)) then
5172 difi=difi-theta_drange(i)
5173 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5174 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
5175 & +for_thet_constr(i)*difi**3
5176 else if (difi.lt.-drange(i)) then
5178 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5179 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
5180 & +for_thet_constr(i)*difi**3
5184 C if (energy_dec) then
5185 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
5186 C & i,itheta,rad2deg*thetiii,
5187 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
5188 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
5189 C & gloc(itheta+nphi-2,icg)
5196 c-----------------------------------------------------------------------------
5197 subroutine esc(escloc)
5198 C Calculate the local energy of a side chain and its derivatives in the
5199 C corresponding virtual-bond valence angles THETA and the spherical angles
5201 implicit real*8 (a-h,o-z)
5202 include 'DIMENSIONS'
5203 include 'sizesclu.dat'
5204 include 'COMMON.GEO'
5205 include 'COMMON.LOCAL'
5206 include 'COMMON.VAR'
5207 include 'COMMON.INTERACT'
5208 include 'COMMON.DERIV'
5209 include 'COMMON.CHAIN'
5210 include 'COMMON.IOUNITS'
5211 include 'COMMON.NAMES'
5212 include 'COMMON.FFIELD'
5213 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5214 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5215 common /sccalc/ time11,time12,time112,theti,it,nlobit
5218 c write (iout,'(a)') 'ESC'
5219 do i=loc_start,loc_end
5221 if (it.eq.ntyp1) cycle
5222 if (it.eq.10) goto 1
5223 nlobit=nlob(iabs(it))
5224 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5225 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5226 theti=theta(i+1)-pipol
5230 c write (iout,*) "i",i," x",x(1),x(2),x(3)
5232 if (x(2).gt.pi-delta) then
5236 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5238 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5239 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5241 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5242 & ddersc0(1),dersc(1))
5243 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5244 & ddersc0(3),dersc(3))
5246 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5248 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5249 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5250 & dersc0(2),esclocbi,dersc02)
5251 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5253 call splinthet(x(2),0.5d0*delta,ss,ssd)
5258 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5260 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5261 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5263 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5265 c write (iout,*) escloci
5266 else if (x(2).lt.delta) then
5270 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5272 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5273 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5275 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5276 & ddersc0(1),dersc(1))
5277 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5278 & ddersc0(3),dersc(3))
5280 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5282 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5283 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5284 & dersc0(2),esclocbi,dersc02)
5285 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5290 call splinthet(x(2),0.5d0*delta,ss,ssd)
5292 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5294 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5295 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5297 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5298 c write (iout,*) escloci
5300 call enesc(x,escloci,dersc,ddummy,.false.)
5303 escloc=escloc+escloci
5304 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5306 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5308 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5309 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5314 C---------------------------------------------------------------------------
5315 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5316 implicit real*8 (a-h,o-z)
5317 include 'DIMENSIONS'
5318 include 'COMMON.GEO'
5319 include 'COMMON.LOCAL'
5320 include 'COMMON.IOUNITS'
5321 common /sccalc/ time11,time12,time112,theti,it,nlobit
5322 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5323 double precision contr(maxlob,-1:1)
5325 c write (iout,*) 'it=',it,' nlobit=',nlobit
5329 if (mixed) ddersc(j)=0.0d0
5333 C Because of periodicity of the dependence of the SC energy in omega we have
5334 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5335 C To avoid underflows, first compute & store the exponents.
5343 z(k)=x(k)-censc(k,j,it)
5348 Axk=Axk+gaussc(l,k,j,it)*z(l)
5354 expfac=expfac+Ax(k,j,iii)*z(k)
5362 C As in the case of ebend, we want to avoid underflows in exponentiation and
5363 C subsequent NaNs and INFs in energy calculation.
5364 C Find the largest exponent
5368 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5372 cd print *,'it=',it,' emin=',emin
5374 C Compute the contribution to SC energy and derivatives
5378 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5379 cd print *,'j=',j,' expfac=',expfac
5380 escloc_i=escloc_i+expfac
5382 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5386 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5387 & +gaussc(k,2,j,it))*expfac
5394 dersc(1)=dersc(1)/cos(theti)**2
5395 ddersc(1)=ddersc(1)/cos(theti)**2
5398 escloci=-(dlog(escloc_i)-emin)
5400 dersc(j)=dersc(j)/escloc_i
5404 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5409 C------------------------------------------------------------------------------
5410 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5411 implicit real*8 (a-h,o-z)
5412 include 'DIMENSIONS'
5413 include 'COMMON.GEO'
5414 include 'COMMON.LOCAL'
5415 include 'COMMON.IOUNITS'
5416 common /sccalc/ time11,time12,time112,theti,it,nlobit
5417 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5418 double precision contr(maxlob)
5429 z(k)=x(k)-censc(k,j,it)
5435 Axk=Axk+gaussc(l,k,j,it)*z(l)
5441 expfac=expfac+Ax(k,j)*z(k)
5446 C As in the case of ebend, we want to avoid underflows in exponentiation and
5447 C subsequent NaNs and INFs in energy calculation.
5448 C Find the largest exponent
5451 if (emin.gt.contr(j)) emin=contr(j)
5455 C Compute the contribution to SC energy and derivatives
5459 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5460 escloc_i=escloc_i+expfac
5462 dersc(k)=dersc(k)+Ax(k,j)*expfac
5464 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5465 & +gaussc(1,2,j,it))*expfac
5469 dersc(1)=dersc(1)/cos(theti)**2
5470 dersc12=dersc12/cos(theti)**2
5471 escloci=-(dlog(escloc_i)-emin)
5473 dersc(j)=dersc(j)/escloc_i
5475 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5479 c----------------------------------------------------------------------------------
5480 subroutine esc(escloc)
5481 C Calculate the local energy of a side chain and its derivatives in the
5482 C corresponding virtual-bond valence angles THETA and the spherical angles
5483 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5484 C added by Urszula Kozlowska. 07/11/2007
5486 implicit real*8 (a-h,o-z)
5487 include 'DIMENSIONS'
5488 include 'sizesclu.dat'
5489 include 'COMMON.GEO'
5490 include 'COMMON.LOCAL'
5491 include 'COMMON.VAR'
5492 include 'COMMON.SCROT'
5493 include 'COMMON.INTERACT'
5494 include 'COMMON.DERIV'
5495 include 'COMMON.CHAIN'
5496 include 'COMMON.IOUNITS'
5497 include 'COMMON.NAMES'
5498 include 'COMMON.FFIELD'
5499 include 'COMMON.CONTROL'
5500 include 'COMMON.VECTORS'
5501 double precision x_prime(3),y_prime(3),z_prime(3)
5502 & , sumene,dsc_i,dp2_i,x(65),
5503 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5504 & de_dxx,de_dyy,de_dzz,de_dt
5505 double precision s1_t,s1_6_t,s2_t,s2_6_t
5507 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5508 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5509 & dt_dCi(3),dt_dCi1(3)
5510 common /sccalc/ time11,time12,time112,theti,it,nlobit
5513 do i=loc_start,loc_end
5514 if (itype(i).eq.ntyp1) cycle
5515 costtab(i+1) =dcos(theta(i+1))
5516 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5517 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5518 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5519 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5520 cosfac=dsqrt(cosfac2)
5521 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5522 sinfac=dsqrt(sinfac2)
5524 if (it.eq.10) goto 1
5526 C Compute the axes of tghe local cartesian coordinates system; store in
5527 c x_prime, y_prime and z_prime
5534 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5535 C & dc_norm(3,i+nres)
5537 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5538 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5541 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5544 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5545 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5546 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5547 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5548 c & " xy",scalar(x_prime(1),y_prime(1)),
5549 c & " xz",scalar(x_prime(1),z_prime(1)),
5550 c & " yy",scalar(y_prime(1),y_prime(1)),
5551 c & " yz",scalar(y_prime(1),z_prime(1)),
5552 c & " zz",scalar(z_prime(1),z_prime(1))
5554 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5555 C to local coordinate system. Store in xx, yy, zz.
5561 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5562 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5563 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5570 C Compute the energy of the ith side cbain
5572 c write (2,*) "xx",xx," yy",yy," zz",zz
5575 x(j) = sc_parmin(j,it)
5578 Cc diagnostics - remove later
5580 yy1 = dsin(alph(2))*dcos(omeg(2))
5581 c zz1 = -dsin(alph(2))*dsin(omeg(2))
5582 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
5583 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5584 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5586 C," --- ", xx_w,yy_w,zz_w
5589 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5590 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5592 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5593 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5595 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5596 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5597 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5598 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5599 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5601 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5602 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5603 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5604 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5605 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5607 dsc_i = 0.743d0+x(61)
5609 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5610 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5611 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5612 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5613 s1=(1+x(63))/(0.1d0 + dscp1)
5614 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5615 s2=(1+x(65))/(0.1d0 + dscp2)
5616 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5617 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5618 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5619 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5621 c & dscp1,dscp2,sumene
5622 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5623 escloc = escloc + sumene
5624 c write (2,*) "escloc",escloc
5625 if (.not. calc_grad) goto 1
5628 C This section to check the numerical derivatives of the energy of ith side
5629 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5630 C #define DEBUG in the code to turn it on.
5632 write (2,*) "sumene =",sumene
5636 write (2,*) xx,yy,zz
5637 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5638 de_dxx_num=(sumenep-sumene)/aincr
5640 write (2,*) "xx+ sumene from enesc=",sumenep
5643 write (2,*) xx,yy,zz
5644 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5645 de_dyy_num=(sumenep-sumene)/aincr
5647 write (2,*) "yy+ sumene from enesc=",sumenep
5650 write (2,*) xx,yy,zz
5651 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5652 de_dzz_num=(sumenep-sumene)/aincr
5654 write (2,*) "zz+ sumene from enesc=",sumenep
5655 costsave=cost2tab(i+1)
5656 sintsave=sint2tab(i+1)
5657 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5658 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5659 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5660 de_dt_num=(sumenep-sumene)/aincr
5661 write (2,*) " t+ sumene from enesc=",sumenep
5662 cost2tab(i+1)=costsave
5663 sint2tab(i+1)=sintsave
5664 C End of diagnostics section.
5667 C Compute the gradient of esc
5669 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5670 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5671 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5672 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5673 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5674 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5675 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5676 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5677 pom1=(sumene3*sint2tab(i+1)+sumene1)
5678 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5679 pom2=(sumene4*cost2tab(i+1)+sumene2)
5680 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5681 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5682 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5683 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5685 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5686 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5687 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5689 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5690 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5691 & +(pom1+pom2)*pom_dx
5693 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5696 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5697 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5698 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5700 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5701 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5702 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5703 & +x(59)*zz**2 +x(60)*xx*zz
5704 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5705 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5706 & +(pom1-pom2)*pom_dy
5708 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5711 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5712 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5713 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5714 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5715 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5716 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5717 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5718 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5720 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5723 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5724 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5725 & +pom1*pom_dt1+pom2*pom_dt2
5727 write(2,*), "de_dt = ", de_dt,de_dt_num
5731 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5732 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5733 cosfac2xx=cosfac2*xx
5734 sinfac2yy=sinfac2*yy
5736 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5738 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5740 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5741 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5742 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5743 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5744 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5745 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5746 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5747 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5748 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5749 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5753 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5754 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5755 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5756 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5759 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5760 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5761 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5763 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5764 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5768 dXX_Ctab(k,i)=dXX_Ci(k)
5769 dXX_C1tab(k,i)=dXX_Ci1(k)
5770 dYY_Ctab(k,i)=dYY_Ci(k)
5771 dYY_C1tab(k,i)=dYY_Ci1(k)
5772 dZZ_Ctab(k,i)=dZZ_Ci(k)
5773 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5774 dXX_XYZtab(k,i)=dXX_XYZ(k)
5775 dYY_XYZtab(k,i)=dYY_XYZ(k)
5776 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5780 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5781 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5782 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5783 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5784 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5786 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5787 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5788 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5789 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5790 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5791 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5792 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5793 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5795 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5796 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5798 C to check gradient call subroutine check_grad
5805 c------------------------------------------------------------------------------
5806 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5808 C This procedure calculates two-body contact function g(rij) and its derivative:
5811 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5814 C where x=(rij-r0ij)/delta
5816 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5819 double precision rij,r0ij,eps0ij,fcont,fprimcont
5820 double precision x,x2,x4,delta
5824 if (x.lt.-1.0D0) then
5827 else if (x.le.1.0D0) then
5830 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5831 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5838 c------------------------------------------------------------------------------
5839 subroutine splinthet(theti,delta,ss,ssder)
5840 implicit real*8 (a-h,o-z)
5841 include 'DIMENSIONS'
5842 include 'sizesclu.dat'
5843 include 'COMMON.VAR'
5844 include 'COMMON.GEO'
5847 if (theti.gt.pipol) then
5848 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5850 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5855 c------------------------------------------------------------------------------
5856 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5858 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5859 double precision ksi,ksi2,ksi3,a1,a2,a3
5860 a1=fprim0*delta/(f1-f0)
5866 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5867 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5870 c------------------------------------------------------------------------------
5871 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5873 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5874 double precision ksi,ksi2,ksi3,a1,a2,a3
5879 a2=3*(f1x-f0x)-2*fprim0x*delta
5880 a3=fprim0x*delta-2*(f1x-f0x)
5881 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5884 C-----------------------------------------------------------------------------
5886 C-----------------------------------------------------------------------------
5887 subroutine etor(etors,edihcnstr,fact)
5888 implicit real*8 (a-h,o-z)
5889 include 'DIMENSIONS'
5890 include 'sizesclu.dat'
5891 include 'COMMON.VAR'
5892 include 'COMMON.GEO'
5893 include 'COMMON.LOCAL'
5894 include 'COMMON.TORSION'
5895 include 'COMMON.INTERACT'
5896 include 'COMMON.DERIV'
5897 include 'COMMON.CHAIN'
5898 include 'COMMON.NAMES'
5899 include 'COMMON.IOUNITS'
5900 include 'COMMON.FFIELD'
5901 include 'COMMON.TORCNSTR'
5903 C Set lprn=.true. for debugging
5907 do i=iphi_start,iphi_end
5908 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5909 & .or. itype(i).eq.ntyp1) cycle
5910 itori=itortyp(itype(i-2))
5911 itori1=itortyp(itype(i-1))
5914 C Proline-Proline pair is a special case...
5915 if (itori.eq.3 .and. itori1.eq.3) then
5916 if (phii.gt.-dwapi3) then
5918 fac=1.0D0/(1.0D0-cosphi)
5919 etorsi=v1(1,3,3)*fac
5920 etorsi=etorsi+etorsi
5921 etors=etors+etorsi-v1(1,3,3)
5922 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5925 v1ij=v1(j+1,itori,itori1)
5926 v2ij=v2(j+1,itori,itori1)
5929 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5930 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5934 v1ij=v1(j,itori,itori1)
5935 v2ij=v2(j,itori,itori1)
5938 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5939 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5943 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5944 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5945 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5946 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5947 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5949 ! 6/20/98 - dihedral angle constraints
5952 itori=idih_constr(i)
5955 if (difi.gt.drange(i)) then
5957 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5958 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5959 else if (difi.lt.-drange(i)) then
5961 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5962 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5964 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5965 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5967 ! write (iout,*) 'edihcnstr',edihcnstr
5970 c------------------------------------------------------------------------------
5972 subroutine etor(etors,edihcnstr,fact)
5973 implicit real*8 (a-h,o-z)
5974 include 'DIMENSIONS'
5975 include 'sizesclu.dat'
5976 include 'COMMON.VAR'
5977 include 'COMMON.GEO'
5978 include 'COMMON.LOCAL'
5979 include 'COMMON.TORSION'
5980 include 'COMMON.INTERACT'
5981 include 'COMMON.DERIV'
5982 include 'COMMON.CHAIN'
5983 include 'COMMON.NAMES'
5984 include 'COMMON.IOUNITS'
5985 include 'COMMON.FFIELD'
5986 include 'COMMON.TORCNSTR'
5988 C Set lprn=.true. for debugging
5992 do i=iphi_start,iphi_end
5994 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5995 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5996 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5997 if (iabs(itype(i)).eq.20) then
6002 itori=itortyp(itype(i-2))
6003 itori1=itortyp(itype(i-1))
6006 C Regular cosine and sine terms
6007 do j=1,nterm(itori,itori1,iblock)
6008 v1ij=v1(j,itori,itori1,iblock)
6009 v2ij=v2(j,itori,itori1,iblock)
6012 etors=etors+v1ij*cosphi+v2ij*sinphi
6013 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6017 C E = SUM ----------------------------------- - v1
6018 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6020 cosphi=dcos(0.5d0*phii)
6021 sinphi=dsin(0.5d0*phii)
6022 do j=1,nlor(itori,itori1,iblock)
6023 vl1ij=vlor1(j,itori,itori1)
6024 vl2ij=vlor2(j,itori,itori1)
6025 vl3ij=vlor3(j,itori,itori1)
6026 pom=vl2ij*cosphi+vl3ij*sinphi
6027 pom1=1.0d0/(pom*pom+1.0d0)
6028 etors=etors+vl1ij*pom1
6030 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6032 C Subtract the constant term
6033 etors=etors-v0(itori,itori1,iblock)
6035 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6036 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6037 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
6038 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
6039 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6042 ! 6/20/98 - dihedral angle constraints
6045 itori=idih_constr(i)
6047 difi=pinorm(phii-phi0(i))
6049 if (difi.gt.drange(i)) then
6051 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6052 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6053 edihi=0.25d0*ftors(i)*difi**4
6054 else if (difi.lt.-drange(i)) then
6056 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6057 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6058 edihi=0.25d0*ftors(i)*difi**4
6062 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
6064 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6065 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6067 ! write (iout,*) 'edihcnstr',edihcnstr
6070 c----------------------------------------------------------------------------
6071 subroutine etor_d(etors_d,fact2)
6072 C 6/23/01 Compute double torsional energy
6073 implicit real*8 (a-h,o-z)
6074 include 'DIMENSIONS'
6075 include 'sizesclu.dat'
6076 include 'COMMON.VAR'
6077 include 'COMMON.GEO'
6078 include 'COMMON.LOCAL'
6079 include 'COMMON.TORSION'
6080 include 'COMMON.INTERACT'
6081 include 'COMMON.DERIV'
6082 include 'COMMON.CHAIN'
6083 include 'COMMON.NAMES'
6084 include 'COMMON.IOUNITS'
6085 include 'COMMON.FFIELD'
6086 include 'COMMON.TORCNSTR'
6088 C Set lprn=.true. for debugging
6092 do i=iphi_start,iphi_end-1
6094 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
6095 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
6096 & (itype(i+1).eq.ntyp1)) cycle
6097 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
6099 itori=itortyp(itype(i-2))
6100 itori1=itortyp(itype(i-1))
6101 itori2=itortyp(itype(i))
6107 if (iabs(itype(i+1)).eq.20) iblock=2
6108 C Regular cosine and sine terms
6109 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6110 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6111 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6112 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6113 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6114 cosphi1=dcos(j*phii)
6115 sinphi1=dsin(j*phii)
6116 cosphi2=dcos(j*phii1)
6117 sinphi2=dsin(j*phii1)
6118 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6119 & v2cij*cosphi2+v2sij*sinphi2
6120 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6121 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6123 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6125 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6126 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6127 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6128 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6129 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6130 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6131 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6132 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6133 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6134 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6135 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6136 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6137 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6138 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6141 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
6142 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
6148 c------------------------------------------------------------------------------
6149 subroutine eback_sc_corr(esccor)
6150 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6151 c conformational states; temporarily implemented as differences
6152 c between UNRES torsional potentials (dependent on three types of
6153 c residues) and the torsional potentials dependent on all 20 types
6154 c of residues computed from AM1 energy surfaces of terminally-blocked
6155 c amino-acid residues.
6156 implicit real*8 (a-h,o-z)
6157 include 'DIMENSIONS'
6158 include 'sizesclu.dat'
6159 include 'COMMON.VAR'
6160 include 'COMMON.GEO'
6161 include 'COMMON.LOCAL'
6162 include 'COMMON.TORSION'
6163 include 'COMMON.SCCOR'
6164 include 'COMMON.INTERACT'
6165 include 'COMMON.DERIV'
6166 include 'COMMON.CHAIN'
6167 include 'COMMON.NAMES'
6168 include 'COMMON.IOUNITS'
6169 include 'COMMON.FFIELD'
6170 include 'COMMON.CONTROL'
6172 C Set lprn=.true. for debugging
6175 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
6177 do i=itau_start,itau_end
6178 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6180 isccori=isccortyp(itype(i-2))
6181 isccori1=isccortyp(itype(i-1))
6183 do intertyp=1,3 !intertyp
6184 cc Added 09 May 2012 (Adasko)
6185 cc Intertyp means interaction type of backbone mainchain correlation:
6186 c 1 = SC...Ca...Ca...Ca
6187 c 2 = Ca...Ca...Ca...SC
6188 c 3 = SC...Ca...Ca...SCi
6190 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6191 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6192 & (itype(i-1).eq.ntyp1)))
6193 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6194 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6195 & .or.(itype(i).eq.ntyp1)))
6196 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6197 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6198 & (itype(i-3).eq.ntyp1)))) cycle
6199 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6200 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6202 do j=1,nterm_sccor(isccori,isccori1)
6203 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6204 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6205 cosphi=dcos(j*tauangle(intertyp,i))
6206 sinphi=dsin(j*tauangle(intertyp,i))
6207 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6208 c gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6210 c write (iout,*) "EBACK_SC_COR",i,esccor,intertyp
6211 c gloc_sc(intertyp,i-3)=gloc_sc(intertyp,i-3)+wsccor*gloci
6213 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6214 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6215 & (v1sccor(j,1,itori,itori1),j=1,6),
6216 & (v2sccor(j,1,itori,itori1),j=1,6)
6217 gsccor_loc(i-3)=gloci
6222 c------------------------------------------------------------------------------
6223 subroutine multibody(ecorr)
6224 C This subroutine calculates multi-body contributions to energy following
6225 C the idea of Skolnick et al. If side chains I and J make a contact and
6226 C at the same time side chains I+1 and J+1 make a contact, an extra
6227 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6228 implicit real*8 (a-h,o-z)
6229 include 'DIMENSIONS'
6230 include 'COMMON.IOUNITS'
6231 include 'COMMON.DERIV'
6232 include 'COMMON.INTERACT'
6233 include 'COMMON.CONTACTS'
6234 double precision gx(3),gx1(3)
6237 C Set lprn=.true. for debugging
6241 write (iout,'(a)') 'Contact function values:'
6243 write (iout,'(i2,20(1x,i2,f10.5))')
6244 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6259 num_conti=num_cont(i)
6260 num_conti1=num_cont(i1)
6265 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6266 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6267 cd & ' ishift=',ishift
6268 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6269 C The system gains extra energy.
6270 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6271 endif ! j1==j+-ishift
6280 c------------------------------------------------------------------------------
6281 double precision function esccorr(i,j,k,l,jj,kk)
6282 implicit real*8 (a-h,o-z)
6283 include 'DIMENSIONS'
6284 include 'COMMON.IOUNITS'
6285 include 'COMMON.DERIV'
6286 include 'COMMON.INTERACT'
6287 include 'COMMON.CONTACTS'
6288 double precision gx(3),gx1(3)
6293 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6294 C Calculate the multi-body contribution to energy.
6295 C Calculate multi-body contributions to the gradient.
6296 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6297 cd & k,l,(gacont(m,kk,k),m=1,3)
6299 gx(m) =ekl*gacont(m,jj,i)
6300 gx1(m)=eij*gacont(m,kk,k)
6301 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6302 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6303 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6304 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6308 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6313 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6319 c------------------------------------------------------------------------------
6321 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
6322 implicit real*8 (a-h,o-z)
6323 include 'DIMENSIONS'
6324 integer dimen1,dimen2,atom,indx
6325 double precision buffer(dimen1,dimen2)
6326 double precision zapas
6327 common /contacts_hb/ zapas(3,20,maxres,7),
6328 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
6329 & num_cont_hb(maxres),jcont_hb(20,maxres)
6330 num_kont=num_cont_hb(atom)
6334 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
6337 buffer(i,indx+22)=facont_hb(i,atom)
6338 buffer(i,indx+23)=ees0p(i,atom)
6339 buffer(i,indx+24)=ees0m(i,atom)
6340 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
6342 buffer(1,indx+26)=dfloat(num_kont)
6345 c------------------------------------------------------------------------------
6346 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
6347 implicit real*8 (a-h,o-z)
6348 include 'DIMENSIONS'
6349 integer dimen1,dimen2,atom,indx
6350 double precision buffer(dimen1,dimen2)
6351 double precision zapas
6352 common /contacts_hb/ zapas(3,ntyp,maxres,7),
6353 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
6354 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
6355 num_kont=buffer(1,indx+26)
6356 num_kont_old=num_cont_hb(atom)
6357 num_cont_hb(atom)=num_kont+num_kont_old
6362 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
6365 facont_hb(ii,atom)=buffer(i,indx+22)
6366 ees0p(ii,atom)=buffer(i,indx+23)
6367 ees0m(ii,atom)=buffer(i,indx+24)
6368 jcont_hb(ii,atom)=buffer(i,indx+25)
6372 c------------------------------------------------------------------------------
6374 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6375 C This subroutine calculates multi-body contributions to hydrogen-bonding
6376 implicit real*8 (a-h,o-z)
6377 include 'DIMENSIONS'
6378 include 'sizesclu.dat'
6379 include 'COMMON.IOUNITS'
6381 include 'COMMON.INFO'
6383 include 'COMMON.FFIELD'
6384 include 'COMMON.DERIV'
6385 include 'COMMON.INTERACT'
6386 include 'COMMON.CONTACTS'
6388 parameter (max_cont=maxconts)
6389 parameter (max_dim=2*(8*3+2))
6390 parameter (msglen1=max_cont*max_dim*4)
6391 parameter (msglen2=2*msglen1)
6392 integer source,CorrelType,CorrelID,Error
6393 double precision buffer(max_cont,max_dim)
6395 double precision gx(3),gx1(3)
6398 C Set lprn=.true. for debugging
6403 if (fgProcs.le.1) goto 30
6405 write (iout,'(a)') 'Contact function values:'
6407 write (iout,'(2i3,50(1x,i2,f5.2))')
6408 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6409 & j=1,num_cont_hb(i))
6412 C Caution! Following code assumes that electrostatic interactions concerning
6413 C a given atom are split among at most two processors!
6423 cd write (iout,*) 'MyRank',MyRank,' mm',mm
6426 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
6427 if (MyRank.gt.0) then
6428 C Send correlation contributions to the preceding processor
6430 nn=num_cont_hb(iatel_s)
6431 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
6432 cd write (iout,*) 'The BUFFER array:'
6434 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
6436 if (ielstart(iatel_s).gt.iatel_s+ispp) then
6438 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
6439 C Clear the contacts of the atom passed to the neighboring processor
6440 nn=num_cont_hb(iatel_s+1)
6442 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
6444 num_cont_hb(iatel_s)=0
6446 cd write (iout,*) 'Processor ',MyID,MyRank,
6447 cd & ' is sending correlation contribution to processor',MyID-1,
6448 cd & ' msglen=',msglen
6449 cd write (*,*) 'Processor ',MyID,MyRank,
6450 cd & ' is sending correlation contribution to processor',MyID-1,
6451 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6452 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
6453 cd write (iout,*) 'Processor ',MyID,
6454 cd & ' has sent correlation contribution to processor',MyID-1,
6455 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6456 cd write (*,*) 'Processor ',MyID,
6457 cd & ' has sent correlation contribution to processor',MyID-1,
6458 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6460 endif ! (MyRank.gt.0)
6464 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6465 if (MyRank.lt.fgProcs-1) then
6466 C Receive correlation contributions from the next processor
6468 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6469 cd write (iout,*) 'Processor',MyID,
6470 cd & ' is receiving correlation contribution from processor',MyID+1,
6471 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6472 cd write (*,*) 'Processor',MyID,
6473 cd & ' is receiving correlation contribution from processor',MyID+1,
6474 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6476 do while (nbytes.le.0)
6477 call mp_probe(MyID+1,CorrelType,nbytes)
6479 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6480 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6481 cd write (iout,*) 'Processor',MyID,
6482 cd & ' has received correlation contribution from processor',MyID+1,
6483 cd & ' msglen=',msglen,' nbytes=',nbytes
6484 cd write (iout,*) 'The received BUFFER array:'
6486 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6488 if (msglen.eq.msglen1) then
6489 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6490 else if (msglen.eq.msglen2) then
6491 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6492 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6495 & 'ERROR!!!! message length changed while processing correlations.'
6497 & 'ERROR!!!! message length changed while processing correlations.'
6498 call mp_stopall(Error)
6499 endif ! msglen.eq.msglen1
6500 endif ! MyRank.lt.fgProcs-1
6507 write (iout,'(a)') 'Contact function values:'
6509 write (iout,'(2i3,50(1x,i2,f5.2))')
6510 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6511 & j=1,num_cont_hb(i))
6515 C Remove the loop below after debugging !!!
6522 C Calculate the local-electrostatic correlation terms
6523 do i=iatel_s,iatel_e+1
6525 num_conti=num_cont_hb(i)
6526 num_conti1=num_cont_hb(i+1)
6531 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6532 c & ' jj=',jj,' kk=',kk
6533 if (j1.eq.j+1 .or. j1.eq.j-1) then
6534 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6535 C The system gains extra energy.
6536 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6538 else if (j1.eq.j) then
6539 C Contacts I-J and I-(J+1) occur simultaneously.
6540 C The system loses extra energy.
6541 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6546 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6547 c & ' jj=',jj,' kk=',kk
6549 C Contacts I-J and (I+1)-J occur simultaneously.
6550 C The system loses extra energy.
6551 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6558 c------------------------------------------------------------------------------
6559 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6561 C This subroutine calculates multi-body contributions to hydrogen-bonding
6562 implicit real*8 (a-h,o-z)
6563 include 'DIMENSIONS'
6564 include 'sizesclu.dat'
6565 include 'COMMON.IOUNITS'
6567 include 'COMMON.INFO'
6569 include 'COMMON.FFIELD'
6570 include 'COMMON.DERIV'
6571 include 'COMMON.INTERACT'
6572 include 'COMMON.CONTACTS'
6574 parameter (max_cont=maxconts)
6575 parameter (max_dim=2*(8*3+2))
6576 parameter (msglen1=max_cont*max_dim*4)
6577 parameter (msglen2=2*msglen1)
6578 integer source,CorrelType,CorrelID,Error
6579 double precision buffer(max_cont,max_dim)
6581 double precision gx(3),gx1(3)
6584 C Set lprn=.true. for debugging
6590 if (fgProcs.le.1) goto 30
6592 write (iout,'(a)') 'Contact function values:'
6594 write (iout,'(2i3,50(1x,i2,f5.2))')
6595 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6596 & j=1,num_cont_hb(i))
6599 C Caution! Following code assumes that electrostatic interactions concerning
6600 C a given atom are split among at most two processors!
6610 cd write (iout,*) 'MyRank',MyRank,' mm',mm
6613 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
6614 if (MyRank.gt.0) then
6615 C Send correlation contributions to the preceding processor
6617 nn=num_cont_hb(iatel_s)
6618 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
6619 cd write (iout,*) 'The BUFFER array:'
6621 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
6623 if (ielstart(iatel_s).gt.iatel_s+ispp) then
6625 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
6626 C Clear the contacts of the atom passed to the neighboring processor
6627 nn=num_cont_hb(iatel_s+1)
6629 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
6631 num_cont_hb(iatel_s)=0
6633 cd write (iout,*) 'Processor ',MyID,MyRank,
6634 cd & ' is sending correlation contribution to processor',MyID-1,
6635 cd & ' msglen=',msglen
6636 cd write (*,*) 'Processor ',MyID,MyRank,
6637 cd & ' is sending correlation contribution to processor',MyID-1,
6638 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6639 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
6640 cd write (iout,*) 'Processor ',MyID,
6641 cd & ' has sent correlation contribution to processor',MyID-1,
6642 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6643 cd write (*,*) 'Processor ',MyID,
6644 cd & ' has sent correlation contribution to processor',MyID-1,
6645 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6647 endif ! (MyRank.gt.0)
6651 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6652 if (MyRank.lt.fgProcs-1) then
6653 C Receive correlation contributions from the next processor
6655 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6656 cd write (iout,*) 'Processor',MyID,
6657 cd & ' is receiving correlation contribution from processor',MyID+1,
6658 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6659 cd write (*,*) 'Processor',MyID,
6660 cd & ' is receiving correlation contribution from processor',MyID+1,
6661 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6663 do while (nbytes.le.0)
6664 call mp_probe(MyID+1,CorrelType,nbytes)
6666 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6667 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6668 cd write (iout,*) 'Processor',MyID,
6669 cd & ' has received correlation contribution from processor',MyID+1,
6670 cd & ' msglen=',msglen,' nbytes=',nbytes
6671 cd write (iout,*) 'The received BUFFER array:'
6673 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6675 if (msglen.eq.msglen1) then
6676 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6677 else if (msglen.eq.msglen2) then
6678 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6679 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6682 & 'ERROR!!!! message length changed while processing correlations.'
6684 & 'ERROR!!!! message length changed while processing correlations.'
6685 call mp_stopall(Error)
6686 endif ! msglen.eq.msglen1
6687 endif ! MyRank.lt.fgProcs-1
6694 write (iout,'(a)') 'Contact function values:'
6696 write (iout,'(2i3,50(1x,i2,f5.2))')
6697 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6698 & j=1,num_cont_hb(i))
6704 C Remove the loop below after debugging !!!
6711 C Calculate the dipole-dipole interaction energies
6712 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6713 do i=iatel_s,iatel_e+1
6714 num_conti=num_cont_hb(i)
6721 C Calculate the local-electrostatic correlation terms
6722 do i=iatel_s,iatel_e+1
6724 num_conti=num_cont_hb(i)
6725 num_conti1=num_cont_hb(i+1)
6730 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6731 c & ' jj=',jj,' kk=',kk
6732 if (j1.eq.j+1 .or. j1.eq.j-1) then
6733 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6734 C The system gains extra energy.
6736 sqd1=dsqrt(d_cont(jj,i))
6737 sqd2=dsqrt(d_cont(kk,i1))
6738 sred_geom = sqd1*sqd2
6739 IF (sred_geom.lt.cutoff_corr) THEN
6740 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6742 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6743 c & ' jj=',jj,' kk=',kk
6744 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6745 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6747 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6748 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6751 cd write (iout,*) 'sred_geom=',sred_geom,
6752 cd & ' ekont=',ekont,' fprim=',fprimcont
6753 call calc_eello(i,j,i+1,j1,jj,kk)
6754 if (wcorr4.gt.0.0d0)
6755 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
6756 if (wcorr5.gt.0.0d0)
6757 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
6758 c print *,"wcorr5",ecorr5
6759 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6760 cd write(2,*)'ijkl',i,j,i+1,j1
6761 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
6762 & .or. wturn6.eq.0.0d0))then
6763 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6764 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
6765 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6766 cd & 'ecorr6=',ecorr6
6767 cd write (iout,'(4e15.5)') sred_geom,
6768 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
6769 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
6770 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
6771 else if (wturn6.gt.0.0d0
6772 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
6773 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
6774 eturn6=eturn6+eello_turn6(i,jj,kk)
6775 cd write (2,*) 'multibody_eello:eturn6',eturn6
6779 else if (j1.eq.j) then
6780 C Contacts I-J and I-(J+1) occur simultaneously.
6781 C The system loses extra energy.
6782 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6787 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6788 c & ' jj=',jj,' kk=',kk
6790 C Contacts I-J and (I+1)-J occur simultaneously.
6791 C The system loses extra energy.
6792 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6799 c------------------------------------------------------------------------------
6800 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6801 implicit real*8 (a-h,o-z)
6802 include 'DIMENSIONS'
6803 include 'COMMON.IOUNITS'
6804 include 'COMMON.DERIV'
6805 include 'COMMON.INTERACT'
6806 include 'COMMON.CONTACTS'
6807 include 'COMMON.SHIELD'
6809 double precision gx(3),gx1(3)
6819 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6820 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6821 C Following 4 lines for diagnostics.
6826 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
6828 c write (iout,*)'Contacts have occurred for peptide groups',
6829 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
6830 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
6831 C Calculate the multi-body contribution to energy.
6832 ecorr=ecorr+ekont*ees
6834 C Calculate multi-body contributions to the gradient.
6836 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
6837 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
6838 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
6839 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
6840 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
6841 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
6842 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
6843 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
6844 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
6845 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
6846 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
6847 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
6848 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
6849 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
6853 gradcorr(ll,m)=gradcorr(ll,m)+
6854 & ees*ekl*gacont_hbr(ll,jj,i)-
6855 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6856 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6861 gradcorr(ll,m)=gradcorr(ll,m)+
6862 & ees*eij*gacont_hbr(ll,kk,k)-
6863 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6864 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6867 if (shield_mode.gt.0) then
6870 C print *,i,j,fac_shield(i),fac_shield(j),
6871 C &fac_shield(k),fac_shield(l)
6872 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
6873 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
6874 do ilist=1,ishield_list(i)
6875 iresshield=shield_list(ilist,i)
6877 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
6879 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6881 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
6882 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6886 do ilist=1,ishield_list(j)
6887 iresshield=shield_list(ilist,j)
6889 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
6891 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6893 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
6894 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6898 do ilist=1,ishield_list(k)
6899 iresshield=shield_list(ilist,k)
6901 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
6903 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6905 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
6906 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6910 do ilist=1,ishield_list(l)
6911 iresshield=shield_list(ilist,l)
6913 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
6915 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6917 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
6918 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6922 C print *,gshieldx(m,iresshield)
6924 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
6925 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6926 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
6927 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6928 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
6929 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6930 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
6931 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6933 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
6934 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6935 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
6936 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6937 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
6938 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6939 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
6940 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6949 C---------------------------------------------------------------------------
6950 subroutine dipole(i,j,jj)
6951 implicit real*8 (a-h,o-z)
6952 include 'DIMENSIONS'
6953 include 'sizesclu.dat'
6954 include 'COMMON.IOUNITS'
6955 include 'COMMON.CHAIN'
6956 include 'COMMON.FFIELD'
6957 include 'COMMON.DERIV'
6958 include 'COMMON.INTERACT'
6959 include 'COMMON.CONTACTS'
6960 include 'COMMON.TORSION'
6961 include 'COMMON.VAR'
6962 include 'COMMON.GEO'
6963 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6965 iti1 = itortyp(itype(i+1))
6966 if (j.lt.nres-1) then
6967 if (itype(j).le.ntyp) then
6968 itj1 = itortyp(itype(j+1))
6976 dipi(iii,1)=Ub2(iii,i)
6977 dipderi(iii)=Ub2der(iii,i)
6978 dipi(iii,2)=b1(iii,iti1)
6979 dipj(iii,1)=Ub2(iii,j)
6980 dipderj(iii)=Ub2der(iii,j)
6981 dipj(iii,2)=b1(iii,itj1)
6985 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6988 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6991 if (.not.calc_grad) return
6996 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7000 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7005 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7006 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7008 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7010 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7012 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7016 C---------------------------------------------------------------------------
7017 subroutine calc_eello(i,j,k,l,jj,kk)
7019 C This subroutine computes matrices and vectors needed to calculate
7020 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7022 implicit real*8 (a-h,o-z)
7023 include 'DIMENSIONS'
7024 include 'sizesclu.dat'
7025 include 'COMMON.IOUNITS'
7026 include 'COMMON.CHAIN'
7027 include 'COMMON.DERIV'
7028 include 'COMMON.INTERACT'
7029 include 'COMMON.CONTACTS'
7030 include 'COMMON.TORSION'
7031 include 'COMMON.VAR'
7032 include 'COMMON.GEO'
7033 include 'COMMON.FFIELD'
7034 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7035 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7038 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7039 cd & ' jj=',jj,' kk=',kk
7040 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7043 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7044 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7047 call transpose2(aa1(1,1),aa1t(1,1))
7048 call transpose2(aa2(1,1),aa2t(1,1))
7051 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7052 & aa1tder(1,1,lll,kkk))
7053 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7054 & aa2tder(1,1,lll,kkk))
7058 C parallel orientation of the two CA-CA-CA frames.
7060 if (i.gt.1 .and. itype(i).le.ntyp) then
7061 iti=itortyp(itype(i))
7065 itk1=itortyp(itype(k+1))
7066 itj=itortyp(itype(j))
7067 c if (l.lt.nres-1) then
7068 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
7069 itl1=itortyp(itype(l+1))
7073 C A1 kernel(j+1) A2T
7075 cd write (iout,'(3f10.5,5x,3f10.5)')
7076 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7078 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7079 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7080 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7081 C Following matrices are needed only for 6-th order cumulants
7082 IF (wcorr6.gt.0.0d0) THEN
7083 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7084 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7085 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7086 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7087 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7088 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7089 & ADtEAderx(1,1,1,1,1,1))
7091 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7092 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7093 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7094 & ADtEA1derx(1,1,1,1,1,1))
7096 C End 6-th order cumulants
7099 cd write (2,*) 'In calc_eello6'
7101 cd write (2,*) 'iii=',iii
7103 cd write (2,*) 'kkk=',kkk
7105 cd write (2,'(3(2f10.5),5x)')
7106 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7111 call transpose2(EUgder(1,1,k),auxmat(1,1))
7112 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7113 call transpose2(EUg(1,1,k),auxmat(1,1))
7114 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7115 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7119 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7120 & EAEAderx(1,1,lll,kkk,iii,1))
7124 C A1T kernel(i+1) A2
7125 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7126 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7127 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7128 C Following matrices are needed only for 6-th order cumulants
7129 IF (wcorr6.gt.0.0d0) THEN
7130 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7131 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7132 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7133 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7134 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7135 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7136 & ADtEAderx(1,1,1,1,1,2))
7137 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7138 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7139 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7140 & ADtEA1derx(1,1,1,1,1,2))
7142 C End 6-th order cumulants
7143 call transpose2(EUgder(1,1,l),auxmat(1,1))
7144 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7145 call transpose2(EUg(1,1,l),auxmat(1,1))
7146 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7147 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7151 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7152 & EAEAderx(1,1,lll,kkk,iii,2))
7157 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7158 C They are needed only when the fifth- or the sixth-order cumulants are
7160 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7161 call transpose2(AEA(1,1,1),auxmat(1,1))
7162 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7163 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7164 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7165 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7166 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7167 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7168 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7169 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7170 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7171 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7172 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7173 call transpose2(AEA(1,1,2),auxmat(1,1))
7174 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7175 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7176 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7177 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7178 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7179 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7180 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7181 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7182 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7183 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7184 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7185 C Calculate the Cartesian derivatives of the vectors.
7189 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7190 call matvec2(auxmat(1,1),b1(1,iti),
7191 & AEAb1derx(1,lll,kkk,iii,1,1))
7192 call matvec2(auxmat(1,1),Ub2(1,i),
7193 & AEAb2derx(1,lll,kkk,iii,1,1))
7194 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7195 & AEAb1derx(1,lll,kkk,iii,2,1))
7196 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7197 & AEAb2derx(1,lll,kkk,iii,2,1))
7198 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7199 call matvec2(auxmat(1,1),b1(1,itj),
7200 & AEAb1derx(1,lll,kkk,iii,1,2))
7201 call matvec2(auxmat(1,1),Ub2(1,j),
7202 & AEAb2derx(1,lll,kkk,iii,1,2))
7203 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7204 & AEAb1derx(1,lll,kkk,iii,2,2))
7205 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7206 & AEAb2derx(1,lll,kkk,iii,2,2))
7213 C Antiparallel orientation of the two CA-CA-CA frames.
7215 if (i.gt.1 .and. itype(i).le.ntyp) then
7216 iti=itortyp(itype(i))
7220 itk1=itortyp(itype(k+1))
7221 itl=itortyp(itype(l))
7222 itj=itortyp(itype(j))
7223 c if (j.lt.nres-1) then
7224 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7225 itj1=itortyp(itype(j+1))
7229 C A2 kernel(j-1)T A1T
7230 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7231 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7232 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7233 C Following matrices are needed only for 6-th order cumulants
7234 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7235 & j.eq.i+4 .and. l.eq.i+3)) THEN
7236 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7237 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7238 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7239 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7240 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7241 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7242 & ADtEAderx(1,1,1,1,1,1))
7243 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7244 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7245 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7246 & ADtEA1derx(1,1,1,1,1,1))
7248 C End 6-th order cumulants
7249 call transpose2(EUgder(1,1,k),auxmat(1,1))
7250 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7251 call transpose2(EUg(1,1,k),auxmat(1,1))
7252 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7253 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7257 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7258 & EAEAderx(1,1,lll,kkk,iii,1))
7262 C A2T kernel(i+1)T A1
7263 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7264 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7265 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7266 C Following matrices are needed only for 6-th order cumulants
7267 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7268 & j.eq.i+4 .and. l.eq.i+3)) THEN
7269 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7270 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7271 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7272 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7273 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7274 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7275 & ADtEAderx(1,1,1,1,1,2))
7276 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7277 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7278 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7279 & ADtEA1derx(1,1,1,1,1,2))
7281 C End 6-th order cumulants
7282 call transpose2(EUgder(1,1,j),auxmat(1,1))
7283 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7284 call transpose2(EUg(1,1,j),auxmat(1,1))
7285 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7286 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7290 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7291 & EAEAderx(1,1,lll,kkk,iii,2))
7296 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7297 C They are needed only when the fifth- or the sixth-order cumulants are
7299 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7300 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7301 call transpose2(AEA(1,1,1),auxmat(1,1))
7302 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7303 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7304 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7305 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7306 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7307 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7308 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7309 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7310 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7311 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7312 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7313 call transpose2(AEA(1,1,2),auxmat(1,1))
7314 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7315 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7316 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7317 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7318 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7319 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7320 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7321 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7322 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7323 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7324 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7325 C Calculate the Cartesian derivatives of the vectors.
7329 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7330 call matvec2(auxmat(1,1),b1(1,iti),
7331 & AEAb1derx(1,lll,kkk,iii,1,1))
7332 call matvec2(auxmat(1,1),Ub2(1,i),
7333 & AEAb2derx(1,lll,kkk,iii,1,1))
7334 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7335 & AEAb1derx(1,lll,kkk,iii,2,1))
7336 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7337 & AEAb2derx(1,lll,kkk,iii,2,1))
7338 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7339 call matvec2(auxmat(1,1),b1(1,itl),
7340 & AEAb1derx(1,lll,kkk,iii,1,2))
7341 call matvec2(auxmat(1,1),Ub2(1,l),
7342 & AEAb2derx(1,lll,kkk,iii,1,2))
7343 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7344 & AEAb1derx(1,lll,kkk,iii,2,2))
7345 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7346 & AEAb2derx(1,lll,kkk,iii,2,2))
7355 C---------------------------------------------------------------------------
7356 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7357 & KK,KKderg,AKA,AKAderg,AKAderx)
7361 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7362 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7363 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7368 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7370 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7373 cd if (lprn) write (2,*) 'In kernel'
7375 cd if (lprn) write (2,*) 'kkk=',kkk
7377 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7378 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7380 cd write (2,*) 'lll=',lll
7381 cd write (2,*) 'iii=1'
7383 cd write (2,'(3(2f10.5),5x)')
7384 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7387 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7388 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7390 cd write (2,*) 'lll=',lll
7391 cd write (2,*) 'iii=2'
7393 cd write (2,'(3(2f10.5),5x)')
7394 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7401 C---------------------------------------------------------------------------
7402 double precision function eello4(i,j,k,l,jj,kk)
7403 implicit real*8 (a-h,o-z)
7404 include 'DIMENSIONS'
7405 include 'sizesclu.dat'
7406 include 'COMMON.IOUNITS'
7407 include 'COMMON.CHAIN'
7408 include 'COMMON.DERIV'
7409 include 'COMMON.INTERACT'
7410 include 'COMMON.CONTACTS'
7411 include 'COMMON.TORSION'
7412 include 'COMMON.VAR'
7413 include 'COMMON.GEO'
7414 double precision pizda(2,2),ggg1(3),ggg2(3)
7415 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7419 cd print *,'eello4:',i,j,k,l,jj,kk
7420 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7421 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7422 cold eij=facont_hb(jj,i)
7423 cold ekl=facont_hb(kk,k)
7425 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7427 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7428 gcorr_loc(k-1)=gcorr_loc(k-1)
7429 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7431 gcorr_loc(l-1)=gcorr_loc(l-1)
7432 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7434 gcorr_loc(j-1)=gcorr_loc(j-1)
7435 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7440 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7441 & -EAEAderx(2,2,lll,kkk,iii,1)
7442 cd derx(lll,kkk,iii)=0.0d0
7446 cd gcorr_loc(l-1)=0.0d0
7447 cd gcorr_loc(j-1)=0.0d0
7448 cd gcorr_loc(k-1)=0.0d0
7450 cd write (iout,*)'Contacts have occurred for peptide groups',
7451 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7452 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7453 if (j.lt.nres-1) then
7460 if (l.lt.nres-1) then
7468 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
7469 ggg1(ll)=eel4*g_contij(ll,1)
7470 ggg2(ll)=eel4*g_contij(ll,2)
7471 ghalf=0.5d0*ggg1(ll)
7473 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
7474 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7475 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
7476 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7477 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
7478 ghalf=0.5d0*ggg2(ll)
7480 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
7481 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7482 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
7483 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7488 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
7489 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7494 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
7495 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7501 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7506 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7510 cd write (2,*) iii,gcorr_loc(iii)
7514 cd write (2,*) 'ekont',ekont
7515 cd write (iout,*) 'eello4',ekont*eel4
7518 C---------------------------------------------------------------------------
7519 double precision function eello5(i,j,k,l,jj,kk)
7520 implicit real*8 (a-h,o-z)
7521 include 'DIMENSIONS'
7522 include 'sizesclu.dat'
7523 include 'COMMON.IOUNITS'
7524 include 'COMMON.CHAIN'
7525 include 'COMMON.DERIV'
7526 include 'COMMON.INTERACT'
7527 include 'COMMON.CONTACTS'
7528 include 'COMMON.TORSION'
7529 include 'COMMON.VAR'
7530 include 'COMMON.GEO'
7531 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7532 double precision ggg1(3),ggg2(3)
7533 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7538 C /l\ / \ \ / \ / \ / C
7539 C / \ / \ \ / \ / \ / C
7540 C j| o |l1 | o | o| o | | o |o C
7541 C \ |/k\| |/ \| / |/ \| |/ \| C
7542 C \i/ \ / \ / / \ / \ C
7544 C (I) (II) (III) (IV) C
7546 C eello5_1 eello5_2 eello5_3 eello5_4 C
7548 C Antiparallel chains C
7551 C /j\ / \ \ / \ / \ / C
7552 C / \ / \ \ / \ / \ / C
7553 C j1| o |l | o | o| o | | o |o C
7554 C \ |/k\| |/ \| / |/ \| |/ \| C
7555 C \i/ \ / \ / / \ / \ C
7557 C (I) (II) (III) (IV) C
7559 C eello5_1 eello5_2 eello5_3 eello5_4 C
7561 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7563 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7564 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7569 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7571 itk=itortyp(itype(k))
7572 itl=itortyp(itype(l))
7573 itj=itortyp(itype(j))
7578 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7579 cd & eel5_3_num,eel5_4_num)
7583 derx(lll,kkk,iii)=0.0d0
7587 cd eij=facont_hb(jj,i)
7588 cd ekl=facont_hb(kk,k)
7590 cd write (iout,*)'Contacts have occurred for peptide groups',
7591 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7593 C Contribution from the graph I.
7594 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7595 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7596 call transpose2(EUg(1,1,k),auxmat(1,1))
7597 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7598 vv(1)=pizda(1,1)-pizda(2,2)
7599 vv(2)=pizda(1,2)+pizda(2,1)
7600 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7601 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7603 C Explicit gradient in virtual-dihedral angles.
7604 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7605 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7606 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7607 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7608 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7609 vv(1)=pizda(1,1)-pizda(2,2)
7610 vv(2)=pizda(1,2)+pizda(2,1)
7611 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7612 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7613 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7614 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7615 vv(1)=pizda(1,1)-pizda(2,2)
7616 vv(2)=pizda(1,2)+pizda(2,1)
7618 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7619 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7620 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7622 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7623 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7624 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7626 C Cartesian gradient
7630 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7632 vv(1)=pizda(1,1)-pizda(2,2)
7633 vv(2)=pizda(1,2)+pizda(2,1)
7634 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7635 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7636 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7643 C Contribution from graph II
7644 call transpose2(EE(1,1,itk),auxmat(1,1))
7645 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7646 vv(1)=pizda(1,1)+pizda(2,2)
7647 vv(2)=pizda(2,1)-pizda(1,2)
7648 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7649 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7651 C Explicit gradient in virtual-dihedral angles.
7652 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7653 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7654 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7655 vv(1)=pizda(1,1)+pizda(2,2)
7656 vv(2)=pizda(2,1)-pizda(1,2)
7658 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7659 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7660 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7662 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7663 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7664 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7666 C Cartesian gradient
7670 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7672 vv(1)=pizda(1,1)+pizda(2,2)
7673 vv(2)=pizda(2,1)-pizda(1,2)
7674 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7675 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7676 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7685 C Parallel orientation
7686 C Contribution from graph III
7687 call transpose2(EUg(1,1,l),auxmat(1,1))
7688 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7689 vv(1)=pizda(1,1)-pizda(2,2)
7690 vv(2)=pizda(1,2)+pizda(2,1)
7691 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7692 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7694 C Explicit gradient in virtual-dihedral angles.
7695 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7696 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7697 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7698 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7699 vv(1)=pizda(1,1)-pizda(2,2)
7700 vv(2)=pizda(1,2)+pizda(2,1)
7701 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7702 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7703 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7704 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7705 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7706 vv(1)=pizda(1,1)-pizda(2,2)
7707 vv(2)=pizda(1,2)+pizda(2,1)
7708 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7709 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7710 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7711 C Cartesian gradient
7715 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7717 vv(1)=pizda(1,1)-pizda(2,2)
7718 vv(2)=pizda(1,2)+pizda(2,1)
7719 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7720 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7721 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7727 C Contribution from graph IV
7729 call transpose2(EE(1,1,itl),auxmat(1,1))
7730 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7731 vv(1)=pizda(1,1)+pizda(2,2)
7732 vv(2)=pizda(2,1)-pizda(1,2)
7733 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7734 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7736 C Explicit gradient in virtual-dihedral angles.
7737 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7738 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7739 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7740 vv(1)=pizda(1,1)+pizda(2,2)
7741 vv(2)=pizda(2,1)-pizda(1,2)
7742 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7743 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7744 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7745 C Cartesian gradient
7749 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7751 vv(1)=pizda(1,1)+pizda(2,2)
7752 vv(2)=pizda(2,1)-pizda(1,2)
7753 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7754 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7755 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7761 C Antiparallel orientation
7762 C Contribution from graph III
7764 call transpose2(EUg(1,1,j),auxmat(1,1))
7765 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7766 vv(1)=pizda(1,1)-pizda(2,2)
7767 vv(2)=pizda(1,2)+pizda(2,1)
7768 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7769 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7771 C Explicit gradient in virtual-dihedral angles.
7772 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7773 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7774 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7775 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7776 vv(1)=pizda(1,1)-pizda(2,2)
7777 vv(2)=pizda(1,2)+pizda(2,1)
7778 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7779 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7780 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7781 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7782 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7783 vv(1)=pizda(1,1)-pizda(2,2)
7784 vv(2)=pizda(1,2)+pizda(2,1)
7785 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7786 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7787 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7788 C Cartesian gradient
7792 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7794 vv(1)=pizda(1,1)-pizda(2,2)
7795 vv(2)=pizda(1,2)+pizda(2,1)
7796 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7797 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7798 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7804 C Contribution from graph IV
7806 call transpose2(EE(1,1,itj),auxmat(1,1))
7807 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7808 vv(1)=pizda(1,1)+pizda(2,2)
7809 vv(2)=pizda(2,1)-pizda(1,2)
7810 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7811 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7813 C Explicit gradient in virtual-dihedral angles.
7814 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7815 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7816 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7817 vv(1)=pizda(1,1)+pizda(2,2)
7818 vv(2)=pizda(2,1)-pizda(1,2)
7819 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7820 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7821 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7822 C Cartesian gradient
7826 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7828 vv(1)=pizda(1,1)+pizda(2,2)
7829 vv(2)=pizda(2,1)-pizda(1,2)
7830 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7831 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7832 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7839 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7840 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7841 cd write (2,*) 'ijkl',i,j,k,l
7842 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7843 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7845 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7846 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7847 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7848 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7850 if (j.lt.nres-1) then
7857 if (l.lt.nres-1) then
7867 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7869 ggg1(ll)=eel5*g_contij(ll,1)
7870 ggg2(ll)=eel5*g_contij(ll,2)
7871 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7872 ghalf=0.5d0*ggg1(ll)
7874 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
7875 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7876 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
7877 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7878 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7879 ghalf=0.5d0*ggg2(ll)
7881 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7882 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7883 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7884 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7889 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7890 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7895 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7896 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7902 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7907 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7911 cd write (2,*) iii,g_corr5_loc(iii)
7915 cd write (2,*) 'ekont',ekont
7916 cd write (iout,*) 'eello5',ekont*eel5
7919 c--------------------------------------------------------------------------
7920 double precision function eello6(i,j,k,l,jj,kk)
7921 implicit real*8 (a-h,o-z)
7922 include 'DIMENSIONS'
7923 include 'sizesclu.dat'
7924 include 'COMMON.IOUNITS'
7925 include 'COMMON.CHAIN'
7926 include 'COMMON.DERIV'
7927 include 'COMMON.INTERACT'
7928 include 'COMMON.CONTACTS'
7929 include 'COMMON.TORSION'
7930 include 'COMMON.VAR'
7931 include 'COMMON.GEO'
7932 include 'COMMON.FFIELD'
7933 double precision ggg1(3),ggg2(3)
7934 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7939 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7947 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7948 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7952 derx(lll,kkk,iii)=0.0d0
7956 cd eij=facont_hb(jj,i)
7957 cd ekl=facont_hb(kk,k)
7963 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7964 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7965 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7966 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7967 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7968 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7970 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7971 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7972 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7973 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7974 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7975 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7979 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7981 C If turn contributions are considered, they will be handled separately.
7982 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7983 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7984 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7985 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7986 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7987 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7988 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7991 if (j.lt.nres-1) then
7998 if (l.lt.nres-1) then
8006 ggg1(ll)=eel6*g_contij(ll,1)
8007 ggg2(ll)=eel6*g_contij(ll,2)
8008 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8009 ghalf=0.5d0*ggg1(ll)
8011 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
8012 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8013 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
8014 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8015 ghalf=0.5d0*ggg2(ll)
8016 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8018 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
8019 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8020 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
8021 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8026 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8027 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8032 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8033 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8039 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8044 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8048 cd write (2,*) iii,g_corr6_loc(iii)
8052 cd write (2,*) 'ekont',ekont
8053 cd write (iout,*) 'eello6',ekont*eel6
8056 c--------------------------------------------------------------------------
8057 double precision function eello6_graph1(i,j,k,l,imat,swap)
8058 implicit real*8 (a-h,o-z)
8059 include 'DIMENSIONS'
8060 include 'sizesclu.dat'
8061 include 'COMMON.IOUNITS'
8062 include 'COMMON.CHAIN'
8063 include 'COMMON.DERIV'
8064 include 'COMMON.INTERACT'
8065 include 'COMMON.CONTACTS'
8066 include 'COMMON.TORSION'
8067 include 'COMMON.VAR'
8068 include 'COMMON.GEO'
8069 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8073 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8075 C Parallel Antiparallel C
8081 C \ j|/k\| / \ |/k\|l / C
8086 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8087 itk=itortyp(itype(k))
8088 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8089 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8090 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8091 call transpose2(EUgC(1,1,k),auxmat(1,1))
8092 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8093 vv1(1)=pizda1(1,1)-pizda1(2,2)
8094 vv1(2)=pizda1(1,2)+pizda1(2,1)
8095 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8096 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8097 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8098 s5=scalar2(vv(1),Dtobr2(1,i))
8099 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8100 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8101 if (.not. calc_grad) return
8102 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8103 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8104 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8105 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8106 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8107 & +scalar2(vv(1),Dtobr2der(1,i)))
8108 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8109 vv1(1)=pizda1(1,1)-pizda1(2,2)
8110 vv1(2)=pizda1(1,2)+pizda1(2,1)
8111 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8112 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8114 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8115 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8116 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8117 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8118 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8120 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8121 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8122 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8123 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8124 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8126 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8127 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8128 vv1(1)=pizda1(1,1)-pizda1(2,2)
8129 vv1(2)=pizda1(1,2)+pizda1(2,1)
8130 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8131 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8132 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8133 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8142 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8143 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8144 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8145 call transpose2(EUgC(1,1,k),auxmat(1,1))
8146 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8148 vv1(1)=pizda1(1,1)-pizda1(2,2)
8149 vv1(2)=pizda1(1,2)+pizda1(2,1)
8150 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8151 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8152 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8153 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8154 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8155 s5=scalar2(vv(1),Dtobr2(1,i))
8156 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8162 c----------------------------------------------------------------------------
8163 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8164 implicit real*8 (a-h,o-z)
8165 include 'DIMENSIONS'
8166 include 'sizesclu.dat'
8167 include 'COMMON.IOUNITS'
8168 include 'COMMON.CHAIN'
8169 include 'COMMON.DERIV'
8170 include 'COMMON.INTERACT'
8171 include 'COMMON.CONTACTS'
8172 include 'COMMON.TORSION'
8173 include 'COMMON.VAR'
8174 include 'COMMON.GEO'
8176 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8177 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8180 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8182 C Parallel Antiparallel C
8188 C \ j|/k\| \ |/k\|l C
8193 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8194 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8195 C AL 7/4/01 s1 would occur in the sixth-order moment,
8196 C but not in a cluster cumulant
8198 s1=dip(1,jj,i)*dip(1,kk,k)
8200 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8201 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8202 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8203 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8204 call transpose2(EUg(1,1,k),auxmat(1,1))
8205 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8206 vv(1)=pizda(1,1)-pizda(2,2)
8207 vv(2)=pizda(1,2)+pizda(2,1)
8208 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8209 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8211 eello6_graph2=-(s1+s2+s3+s4)
8213 eello6_graph2=-(s2+s3+s4)
8216 if (.not. calc_grad) return
8217 C Derivatives in gamma(i-1)
8220 s1=dipderg(1,jj,i)*dip(1,kk,k)
8222 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8223 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8224 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8225 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8227 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8229 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8231 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8233 C Derivatives in gamma(k-1)
8235 s1=dip(1,jj,i)*dipderg(1,kk,k)
8237 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8238 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8239 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8240 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8241 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8242 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8243 vv(1)=pizda(1,1)-pizda(2,2)
8244 vv(2)=pizda(1,2)+pizda(2,1)
8245 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8247 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8249 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8251 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8252 C Derivatives in gamma(j-1) or gamma(l-1)
8255 s1=dipderg(3,jj,i)*dip(1,kk,k)
8257 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8258 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8259 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8260 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8261 vv(1)=pizda(1,1)-pizda(2,2)
8262 vv(2)=pizda(1,2)+pizda(2,1)
8263 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8266 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8268 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8271 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8272 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8274 C Derivatives in gamma(l-1) or gamma(j-1)
8277 s1=dip(1,jj,i)*dipderg(3,kk,k)
8279 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8280 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8281 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8282 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8283 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8284 vv(1)=pizda(1,1)-pizda(2,2)
8285 vv(2)=pizda(1,2)+pizda(2,1)
8286 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8289 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8291 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8294 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8295 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8297 C Cartesian derivatives.
8299 write (2,*) 'In eello6_graph2'
8301 write (2,*) 'iii=',iii
8303 write (2,*) 'kkk=',kkk
8305 write (2,'(3(2f10.5),5x)')
8306 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8316 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8318 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8321 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8323 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8324 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8326 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8327 call transpose2(EUg(1,1,k),auxmat(1,1))
8328 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8330 vv(1)=pizda(1,1)-pizda(2,2)
8331 vv(2)=pizda(1,2)+pizda(2,1)
8332 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8333 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8335 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8337 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8340 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8342 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8349 c----------------------------------------------------------------------------
8350 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8351 implicit real*8 (a-h,o-z)
8352 include 'DIMENSIONS'
8353 include 'sizesclu.dat'
8354 include 'COMMON.IOUNITS'
8355 include 'COMMON.CHAIN'
8356 include 'COMMON.DERIV'
8357 include 'COMMON.INTERACT'
8358 include 'COMMON.CONTACTS'
8359 include 'COMMON.TORSION'
8360 include 'COMMON.VAR'
8361 include 'COMMON.GEO'
8362 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8364 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8366 C Parallel Antiparallel C
8372 C j|/k\| / |/k\|l / C
8377 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8379 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8380 C energy moment and not to the cluster cumulant.
8381 iti=itortyp(itype(i))
8382 c if (j.lt.nres-1) then
8383 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
8384 itj1=itortyp(itype(j+1))
8388 itk=itortyp(itype(k))
8389 itk1=itortyp(itype(k+1))
8390 c if (l.lt.nres-1) then
8391 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
8392 itl1=itortyp(itype(l+1))
8397 s1=dip(4,jj,i)*dip(4,kk,k)
8399 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8400 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8401 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8402 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8403 call transpose2(EE(1,1,itk),auxmat(1,1))
8404 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8405 vv(1)=pizda(1,1)+pizda(2,2)
8406 vv(2)=pizda(2,1)-pizda(1,2)
8407 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8408 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8410 eello6_graph3=-(s1+s2+s3+s4)
8412 eello6_graph3=-(s2+s3+s4)
8415 if (.not. calc_grad) return
8416 C Derivatives in gamma(k-1)
8417 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8418 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8419 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8420 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8421 C Derivatives in gamma(l-1)
8422 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8423 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8424 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8425 vv(1)=pizda(1,1)+pizda(2,2)
8426 vv(2)=pizda(2,1)-pizda(1,2)
8427 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8428 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8429 C Cartesian derivatives.
8435 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8437 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8440 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8442 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8443 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8445 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8446 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8448 vv(1)=pizda(1,1)+pizda(2,2)
8449 vv(2)=pizda(2,1)-pizda(1,2)
8450 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8452 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8454 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8457 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8459 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8461 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8467 c----------------------------------------------------------------------------
8468 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8469 implicit real*8 (a-h,o-z)
8470 include 'DIMENSIONS'
8471 include 'sizesclu.dat'
8472 include 'COMMON.IOUNITS'
8473 include 'COMMON.CHAIN'
8474 include 'COMMON.DERIV'
8475 include 'COMMON.INTERACT'
8476 include 'COMMON.CONTACTS'
8477 include 'COMMON.TORSION'
8478 include 'COMMON.VAR'
8479 include 'COMMON.GEO'
8480 include 'COMMON.FFIELD'
8481 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8482 & auxvec1(2),auxmat1(2,2)
8484 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8486 C Parallel Antiparallel C
8492 C \ j|/k\| \ |/k\|l C
8497 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8499 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8500 C energy moment and not to the cluster cumulant.
8501 cd write (2,*) 'eello_graph4: wturn6',wturn6
8502 iti=itortyp(itype(i))
8503 itj=itortyp(itype(j))
8504 c if (j.lt.nres-1) then
8505 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
8506 itj1=itortyp(itype(j+1))
8510 itk=itortyp(itype(k))
8511 c if (k.lt.nres-1) then
8512 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
8513 itk1=itortyp(itype(k+1))
8517 itl=itortyp(itype(l))
8518 if (l.lt.nres-1) then
8519 itl1=itortyp(itype(l+1))
8523 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8524 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8525 cd & ' itl',itl,' itl1',itl1
8528 s1=dip(3,jj,i)*dip(3,kk,k)
8530 s1=dip(2,jj,j)*dip(2,kk,l)
8533 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8534 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8536 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8537 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8539 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8540 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8542 call transpose2(EUg(1,1,k),auxmat(1,1))
8543 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8544 vv(1)=pizda(1,1)-pizda(2,2)
8545 vv(2)=pizda(2,1)+pizda(1,2)
8546 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8547 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8549 eello6_graph4=-(s1+s2+s3+s4)
8551 eello6_graph4=-(s2+s3+s4)
8553 if (.not. calc_grad) return
8554 C Derivatives in gamma(i-1)
8558 s1=dipderg(2,jj,i)*dip(3,kk,k)
8560 s1=dipderg(4,jj,j)*dip(2,kk,l)
8563 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8565 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8566 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8568 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8569 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8571 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8572 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8573 cd write (2,*) 'turn6 derivatives'
8575 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8577 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8581 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8583 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8587 C Derivatives in gamma(k-1)
8590 s1=dip(3,jj,i)*dipderg(2,kk,k)
8592 s1=dip(2,jj,j)*dipderg(4,kk,l)
8595 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8596 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8598 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8599 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8601 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8602 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8604 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8605 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8606 vv(1)=pizda(1,1)-pizda(2,2)
8607 vv(2)=pizda(2,1)+pizda(1,2)
8608 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8609 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8611 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8613 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8617 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8619 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8622 C Derivatives in gamma(j-1) or gamma(l-1)
8623 if (l.eq.j+1 .and. l.gt.1) then
8624 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8625 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8626 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8627 vv(1)=pizda(1,1)-pizda(2,2)
8628 vv(2)=pizda(2,1)+pizda(1,2)
8629 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8630 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8631 else if (j.gt.1) then
8632 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8633 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8634 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8635 vv(1)=pizda(1,1)-pizda(2,2)
8636 vv(2)=pizda(2,1)+pizda(1,2)
8637 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8638 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8639 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8641 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8644 C Cartesian derivatives.
8651 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8653 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8657 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8659 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8663 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8665 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8667 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8668 & b1(1,itj1),auxvec(1))
8669 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8671 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8672 & b1(1,itl1),auxvec(1))
8673 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8675 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8677 vv(1)=pizda(1,1)-pizda(2,2)
8678 vv(2)=pizda(2,1)+pizda(1,2)
8679 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8681 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8683 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8686 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8689 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8692 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8694 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8696 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8700 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8702 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8705 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8707 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8715 c----------------------------------------------------------------------------
8716 double precision function eello_turn6(i,jj,kk)
8717 implicit real*8 (a-h,o-z)
8718 include 'DIMENSIONS'
8719 include 'sizesclu.dat'
8720 include 'COMMON.IOUNITS'
8721 include 'COMMON.CHAIN'
8722 include 'COMMON.DERIV'
8723 include 'COMMON.INTERACT'
8724 include 'COMMON.CONTACTS'
8725 include 'COMMON.TORSION'
8726 include 'COMMON.VAR'
8727 include 'COMMON.GEO'
8728 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8729 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8731 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8732 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8733 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8734 C the respective energy moment and not to the cluster cumulant.
8739 iti=itortyp(itype(i))
8740 itk=itortyp(itype(k))
8741 itk1=itortyp(itype(k+1))
8742 itl=itortyp(itype(l))
8743 itj=itortyp(itype(j))
8744 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8745 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8746 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8751 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8753 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8757 derx_turn(lll,kkk,iii)=0.0d0
8764 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8766 cd write (2,*) 'eello6_5',eello6_5
8768 call transpose2(AEA(1,1,1),auxmat(1,1))
8769 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8770 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8771 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8775 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8776 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8777 s2 = scalar2(b1(1,itk),vtemp1(1))
8779 call transpose2(AEA(1,1,2),atemp(1,1))
8780 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8781 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8782 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8786 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8787 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8788 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8790 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8791 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8792 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8793 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8794 ss13 = scalar2(b1(1,itk),vtemp4(1))
8795 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8799 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8805 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8807 C Derivatives in gamma(i+2)
8809 call transpose2(AEA(1,1,1),auxmatd(1,1))
8810 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8811 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8812 call transpose2(AEAderg(1,1,2),atempd(1,1))
8813 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8814 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8818 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8819 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8820 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8826 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8827 C Derivatives in gamma(i+3)
8829 call transpose2(AEA(1,1,1),auxmatd(1,1))
8830 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8831 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8832 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8836 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8837 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8838 s2d = scalar2(b1(1,itk),vtemp1d(1))
8840 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8841 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8843 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8845 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8846 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8847 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8857 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8858 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8860 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8861 & -0.5d0*ekont*(s2d+s12d)
8863 C Derivatives in gamma(i+4)
8864 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8865 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8866 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8868 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8869 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8870 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8880 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8882 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8884 C Derivatives in gamma(i+5)
8886 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8887 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8888 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8892 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8893 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8894 s2d = scalar2(b1(1,itk),vtemp1d(1))
8896 call transpose2(AEA(1,1,2),atempd(1,1))
8897 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8898 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8902 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8903 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8905 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8906 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8907 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8917 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8918 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8920 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8921 & -0.5d0*ekont*(s2d+s12d)
8923 C Cartesian derivatives
8928 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8929 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8930 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8934 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8935 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8937 s2d = scalar2(b1(1,itk),vtemp1d(1))
8939 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8940 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8941 s8d = -(atempd(1,1)+atempd(2,2))*
8942 & scalar2(cc(1,1,itl),vtemp2(1))
8946 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8948 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8949 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8956 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8959 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8963 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8964 & - 0.5d0*(s8d+s12d)
8966 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8975 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8977 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8978 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8979 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8980 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8981 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8983 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8984 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8985 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8989 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8990 cd & 16*eel_turn6_num
8992 if (j.lt.nres-1) then
8999 if (l.lt.nres-1) then
9007 ggg1(ll)=eel_turn6*g_contij(ll,1)
9008 ggg2(ll)=eel_turn6*g_contij(ll,2)
9009 ghalf=0.5d0*ggg1(ll)
9011 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
9012 & +ekont*derx_turn(ll,2,1)
9013 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9014 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
9015 & +ekont*derx_turn(ll,4,1)
9016 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9017 ghalf=0.5d0*ggg2(ll)
9019 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
9020 & +ekont*derx_turn(ll,2,2)
9021 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9022 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
9023 & +ekont*derx_turn(ll,4,2)
9024 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9029 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9034 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9040 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9045 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9049 cd write (2,*) iii,g_corr6_loc(iii)
9052 eello_turn6=ekont*eel_turn6
9053 cd write (2,*) 'ekont',ekont
9054 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9057 crc-------------------------------------------------
9058 SUBROUTINE MATVEC2(A1,V1,V2)
9059 implicit real*8 (a-h,o-z)
9060 include 'DIMENSIONS'
9061 DIMENSION A1(2,2),V1(2),V2(2)
9065 c 3 VI=VI+A1(I,K)*V1(K)
9069 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9070 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9075 C---------------------------------------
9076 SUBROUTINE MATMAT2(A1,A2,A3)
9077 implicit real*8 (a-h,o-z)
9078 include 'DIMENSIONS'
9079 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9080 c DIMENSION AI3(2,2)
9084 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9090 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9091 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9092 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9093 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9101 c-------------------------------------------------------------------------
9102 double precision function scalar2(u,v)
9104 double precision u(2),v(2)
9107 scalar2=u(1)*v(1)+u(2)*v(2)
9111 C-----------------------------------------------------------------------------
9113 subroutine transpose2(a,at)
9115 double precision a(2,2),at(2,2)
9122 c--------------------------------------------------------------------------
9123 subroutine transpose(n,a,at)
9126 double precision a(n,n),at(n,n)
9134 C---------------------------------------------------------------------------
9135 subroutine prodmat3(a1,a2,kk,transp,prod)
9138 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9140 crc double precision auxmat(2,2),prod_(2,2)
9143 crc call transpose2(kk(1,1),auxmat(1,1))
9144 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9145 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9147 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9148 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9149 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9150 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9151 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9152 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9153 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9154 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9157 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9158 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9160 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9161 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9162 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9163 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9164 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9165 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9166 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9167 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9170 c call transpose2(a2(1,1),a2t(1,1))
9173 crc print *,((prod_(i,j),i=1,2),j=1,2)
9174 crc print *,((prod(i,j),i=1,2),j=1,2)
9178 C-----------------------------------------------------------------------------
9179 double precision function scalar(u,v)
9181 double precision u(3),v(3)
9191 C-----------------------------------------------------------------------
9192 double precision function sscale(r)
9193 double precision r,gamm
9194 include "COMMON.SPLITELE"
9195 if(r.lt.r_cut-rlamb) then
9197 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9198 gamm=(r-(r_cut-rlamb))/rlamb
9199 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
9205 C-----------------------------------------------------------------------
9206 C-----------------------------------------------------------------------
9207 double precision function sscagrad(r)
9208 double precision r,gamm
9209 include "COMMON.SPLITELE"
9210 if(r.lt.r_cut-rlamb) then
9212 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9213 gamm=(r-(r_cut-rlamb))/rlamb
9214 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
9220 C-----------------------------------------------------------------------
9221 C first for shielding is setting of function of side-chains
9222 subroutine set_shield_fac2
9223 implicit real*8 (a-h,o-z)
9224 include 'DIMENSIONS'
9225 include 'COMMON.CHAIN'
9226 include 'COMMON.DERIV'
9227 include 'COMMON.IOUNITS'
9228 include 'COMMON.SHIELD'
9229 include 'COMMON.INTERACT'
9230 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
9231 double precision div77_81/0.974996043d0/,
9232 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
9234 C the vector between center of side_chain and peptide group
9235 double precision pep_side(3),long,side_calf(3),
9236 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
9237 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
9238 C the line belowe needs to be changed for FGPROC>1
9240 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
9242 Cif there two consequtive dummy atoms there is no peptide group between them
9243 C the line below has to be changed for FGPROC>1
9246 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
9250 C first lets set vector conecting the ithe side-chain with kth side-chain
9251 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
9253 C and vector conecting the side-chain with its proper calfa
9254 side_calf(j)=c(j,k+nres)-c(j,k)
9255 C side_calf(j)=2.0d0
9256 pept_group(j)=c(j,i)-c(j,i+1)
9257 C lets have their lenght
9258 dist_pep_side=pep_side(j)**2+dist_pep_side
9259 dist_side_calf=dist_side_calf+side_calf(j)**2
9260 dist_pept_group=dist_pept_group+pept_group(j)**2
9262 dist_pep_side=dsqrt(dist_pep_side)
9263 dist_pept_group=dsqrt(dist_pept_group)
9264 dist_side_calf=dsqrt(dist_side_calf)
9266 pep_side_norm(j)=pep_side(j)/dist_pep_side
9267 side_calf_norm(j)=dist_side_calf
9269 C now sscale fraction
9270 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
9271 C print *,buff_shield,"buff"
9273 if (sh_frac_dist.le.0.0) cycle
9274 C If we reach here it means that this side chain reaches the shielding sphere
9275 C Lets add him to the list for gradient
9276 ishield_list(i)=ishield_list(i)+1
9277 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
9278 C this list is essential otherwise problem would be O3
9279 shield_list(ishield_list(i),i)=k
9280 C Lets have the sscale value
9281 if (sh_frac_dist.gt.1.0) then
9282 scale_fac_dist=1.0d0
9284 sh_frac_dist_grad(j)=0.0d0
9287 scale_fac_dist=-sh_frac_dist*sh_frac_dist
9288 & *(2.0d0*sh_frac_dist-3.0d0)
9289 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
9290 & /dist_pep_side/buff_shield*0.5d0
9291 C remember for the final gradient multiply sh_frac_dist_grad(j)
9292 C for side_chain by factor -2 !
9294 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
9295 C sh_frac_dist_grad(j)=0.0d0
9296 C scale_fac_dist=1.0d0
9297 C print *,"jestem",scale_fac_dist,fac_help_scale,
9298 C & sh_frac_dist_grad(j)
9301 C this is what is now we have the distance scaling now volume...
9302 short=short_r_sidechain(itype(k))
9303 long=long_r_sidechain(itype(k))
9304 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
9305 sinthet=short/dist_pep_side*costhet
9309 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
9310 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
9311 C & -short/dist_pep_side**2/costhet)
9314 costhet_grad(j)=costhet_fac*pep_side(j)
9316 C remember for the final gradient multiply costhet_grad(j)
9317 C for side_chain by factor -2 !
9318 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9319 C pep_side0pept_group is vector multiplication
9320 pep_side0pept_group=0.0d0
9322 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9324 cosalfa=(pep_side0pept_group/
9325 & (dist_pep_side*dist_side_calf))
9326 fac_alfa_sin=1.0d0-cosalfa**2
9327 fac_alfa_sin=dsqrt(fac_alfa_sin)
9328 rkprim=fac_alfa_sin*(long-short)+short
9332 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
9334 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
9335 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
9339 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9340 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
9341 &*(long-short)/fac_alfa_sin*cosalfa/
9342 &((dist_pep_side*dist_side_calf))*
9343 &((side_calf(j))-cosalfa*
9344 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9345 C cosphi_grad_long(j)=0.0d0
9346 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
9347 &*(long-short)/fac_alfa_sin*cosalfa
9348 &/((dist_pep_side*dist_side_calf))*
9350 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9351 C cosphi_grad_loc(j)=0.0d0
9353 C print *,sinphi,sinthet
9354 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
9357 C now the gradient...
9359 grad_shield(j,i)=grad_shield(j,i)
9360 C gradient po skalowaniu
9361 & +(sh_frac_dist_grad(j)*VofOverlap
9362 C gradient po costhet
9363 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
9364 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9365 & sinphi/sinthet*costhet*costhet_grad(j)
9366 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9368 C grad_shield_side is Cbeta sidechain gradient
9369 grad_shield_side(j,ishield_list(i),i)=
9370 & (sh_frac_dist_grad(j)*(-2.0d0)
9372 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9373 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9374 & sinphi/sinthet*costhet*costhet_grad(j)
9375 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9378 grad_shield_loc(j,ishield_list(i),i)=
9379 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9380 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
9381 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
9385 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9387 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
9388 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
9392 C first for shielding is setting of function of side-chains
9393 subroutine set_shield_fac
9394 implicit real*8 (a-h,o-z)
9395 include 'DIMENSIONS'
9396 include 'COMMON.CHAIN'
9397 include 'COMMON.DERIV'
9398 include 'COMMON.IOUNITS'
9399 include 'COMMON.SHIELD'
9400 include 'COMMON.INTERACT'
9401 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
9402 double precision div77_81/0.974996043d0/,
9403 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
9405 C the vector between center of side_chain and peptide group
9406 double precision pep_side(3),long,side_calf(3),
9407 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
9408 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
9409 C the line belowe needs to be changed for FGPROC>1
9411 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
9413 Cif there two consequtive dummy atoms there is no peptide group between them
9414 C the line below has to be changed for FGPROC>1
9417 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
9421 C first lets set vector conecting the ithe side-chain with kth side-chain
9422 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
9424 C and vector conecting the side-chain with its proper calfa
9425 side_calf(j)=c(j,k+nres)-c(j,k)
9426 C side_calf(j)=2.0d0
9427 pept_group(j)=c(j,i)-c(j,i+1)
9428 C lets have their lenght
9429 dist_pep_side=pep_side(j)**2+dist_pep_side
9430 dist_side_calf=dist_side_calf+side_calf(j)**2
9431 dist_pept_group=dist_pept_group+pept_group(j)**2
9433 dist_pep_side=dsqrt(dist_pep_side)
9434 dist_pept_group=dsqrt(dist_pept_group)
9435 dist_side_calf=dsqrt(dist_side_calf)
9437 pep_side_norm(j)=pep_side(j)/dist_pep_side
9438 side_calf_norm(j)=dist_side_calf
9440 C now sscale fraction
9441 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
9442 C print *,buff_shield,"buff"
9444 if (sh_frac_dist.le.0.0) cycle
9445 C If we reach here it means that this side chain reaches the shielding sphere
9446 C Lets add him to the list for gradient
9447 ishield_list(i)=ishield_list(i)+1
9448 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
9449 C this list is essential otherwise problem would be O3
9450 shield_list(ishield_list(i),i)=k
9451 C Lets have the sscale value
9452 if (sh_frac_dist.gt.1.0) then
9453 scale_fac_dist=1.0d0
9455 sh_frac_dist_grad(j)=0.0d0
9458 scale_fac_dist=-sh_frac_dist*sh_frac_dist
9459 & *(2.0*sh_frac_dist-3.0d0)
9460 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
9461 & /dist_pep_side/buff_shield*0.5
9462 C remember for the final gradient multiply sh_frac_dist_grad(j)
9463 C for side_chain by factor -2 !
9465 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
9466 C print *,"jestem",scale_fac_dist,fac_help_scale,
9467 C & sh_frac_dist_grad(j)
9470 C if ((i.eq.3).and.(k.eq.2)) then
9471 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
9475 C this is what is now we have the distance scaling now volume...
9476 short=short_r_sidechain(itype(k))
9477 long=long_r_sidechain(itype(k))
9478 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
9481 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
9484 costhet_grad(j)=costhet_fac*pep_side(j)
9486 C remember for the final gradient multiply costhet_grad(j)
9487 C for side_chain by factor -2 !
9488 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9489 C pep_side0pept_group is vector multiplication
9490 pep_side0pept_group=0.0
9492 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9494 cosalfa=(pep_side0pept_group/
9495 & (dist_pep_side*dist_side_calf))
9496 fac_alfa_sin=1.0-cosalfa**2
9497 fac_alfa_sin=dsqrt(fac_alfa_sin)
9498 rkprim=fac_alfa_sin*(long-short)+short
9500 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
9501 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
9504 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9505 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9506 &*(long-short)/fac_alfa_sin*cosalfa/
9507 &((dist_pep_side*dist_side_calf))*
9508 &((side_calf(j))-cosalfa*
9509 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9511 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9512 &*(long-short)/fac_alfa_sin*cosalfa
9513 &/((dist_pep_side*dist_side_calf))*
9515 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9518 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
9521 C now the gradient...
9522 C grad_shield is gradient of Calfa for peptide groups
9523 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
9525 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
9526 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
9528 grad_shield(j,i)=grad_shield(j,i)
9529 C gradient po skalowaniu
9530 & +(sh_frac_dist_grad(j)
9531 C gradient po costhet
9532 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
9533 &-scale_fac_dist*(cosphi_grad_long(j))
9534 &/(1.0-cosphi) )*div77_81
9536 C grad_shield_side is Cbeta sidechain gradient
9537 grad_shield_side(j,ishield_list(i),i)=
9538 & (sh_frac_dist_grad(j)*(-2.0d0)
9539 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
9540 & +scale_fac_dist*(cosphi_grad_long(j))
9541 & *2.0d0/(1.0-cosphi))
9542 & *div77_81*VofOverlap
9544 grad_shield_loc(j,ishield_list(i),i)=
9545 & scale_fac_dist*cosphi_grad_loc(j)
9546 & *2.0d0/(1.0-cosphi)
9547 & *div77_81*VofOverlap
9549 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9551 fac_shield(i)=VolumeTotal*div77_81+div4_81
9552 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
9556 C--------------------------------------------------------------------------
9557 C-----------------------------------------------------------------------
9558 double precision function sscalelip(r)
9559 double precision r,gamm
9560 include "COMMON.SPLITELE"
9561 C if(r.lt.r_cut-rlamb) then
9563 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9564 C gamm=(r-(r_cut-rlamb))/rlamb
9565 sscalelip=1.0d0+r*r*(2*r-3.0d0)
9571 C-----------------------------------------------------------------------
9572 double precision function sscagradlip(r)
9573 double precision r,gamm
9574 include "COMMON.SPLITELE"
9575 C if(r.lt.r_cut-rlamb) then
9577 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9578 C gamm=(r-(r_cut-rlamb))/rlamb
9579 sscagradlip=r*(6*r-6.0d0)
9585 c----------------------------------------------------------------------------
9586 double precision function sscale2(r,r_cut,r0,rlamb)
9588 double precision r,gamm,r_cut,r0,rlamb,rr
9590 c write (2,*) "r",r," r_cut",r_cut," r0",r0," rlamb",rlamb
9591 c write (2,*) "rr",rr
9592 if(rr.lt.r_cut-rlamb) then
9594 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
9595 gamm=(rr-(r_cut-rlamb))/rlamb
9596 sscale2=1.0d0+gamm*gamm*(2*gamm-3.0d0)
9602 C-----------------------------------------------------------------------
9603 double precision function sscalgrad2(r,r_cut,r0,rlamb)
9605 double precision r,gamm,r_cut,r0,rlamb,rr
9607 if(rr.lt.r_cut-rlamb) then
9609 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
9610 gamm=(rr-(r_cut-rlamb))/rlamb
9612 sscalgrad2=gamm*(6*gamm-6.0d0)/rlamb
9614 sscalgrad2=-gamm*(6*gamm-6.0d0)/rlamb
9621 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9622 subroutine Eliptransfer(eliptran)
9623 implicit real*8 (a-h,o-z)
9624 include 'DIMENSIONS'
9625 include 'COMMON.GEO'
9626 include 'COMMON.VAR'
9627 include 'COMMON.LOCAL'
9628 include 'COMMON.CHAIN'
9629 include 'COMMON.DERIV'
9630 include 'COMMON.INTERACT'
9631 include 'COMMON.IOUNITS'
9632 include 'COMMON.CALC'
9633 include 'COMMON.CONTROL'
9634 include 'COMMON.SPLITELE'
9635 include 'COMMON.SBRIDGE'
9636 C this is done by Adasko
9640 C--bordliptop-- buffore starts
9641 C--bufliptop--- here true lipid starts
9643 C--buflipbot--- lipid ends buffore starts
9644 C--bordlipbot--buffore ends
9646 write(iout,*) "I am in?"
9649 if (itype(i).eq.ntyp1) cycle
9651 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
9652 if (positi.le.0) positi=positi+boxzsize
9654 C first for peptide groups
9655 c for each residue check if it is in lipid or lipid water border area
9656 if ((positi.gt.bordlipbot)
9657 &.and.(positi.lt.bordliptop)) then
9658 C the energy transfer exist
9659 if (positi.lt.buflipbot) then
9660 C what fraction I am in
9662 & ((positi-bordlipbot)/lipbufthick)
9663 C lipbufthick is thickenes of lipid buffore
9664 sslip=sscalelip(fracinbuf)
9665 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9666 eliptran=eliptran+sslip*pepliptran
9667 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
9668 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
9669 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
9670 elseif (positi.gt.bufliptop) then
9671 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
9672 sslip=sscalelip(fracinbuf)
9673 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9674 eliptran=eliptran+sslip*pepliptran
9675 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
9676 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
9677 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
9678 C print *, "doing sscalefor top part"
9679 C print *,i,sslip,fracinbuf,ssgradlip
9681 eliptran=eliptran+pepliptran
9682 C print *,"I am in true lipid"
9685 C eliptran=elpitran+0.0 ! I am in water
9688 C print *, "nic nie bylo w lipidzie?"
9689 C now multiply all by the peptide group transfer factor
9690 C eliptran=eliptran*pepliptran
9691 C now the same for side chains
9694 if (itype(i).eq.ntyp1) cycle
9695 positi=(mod(c(3,i+nres),boxzsize))
9696 if (positi.le.0) positi=positi+boxzsize
9697 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
9698 c for each residue check if it is in lipid or lipid water border area
9699 C respos=mod(c(3,i+nres),boxzsize)
9700 C print *,positi,bordlipbot,buflipbot
9701 if ((positi.gt.bordlipbot)
9702 & .and.(positi.lt.bordliptop)) then
9703 C the energy transfer exist
9704 if (positi.lt.buflipbot) then
9706 & ((positi-bordlipbot)/lipbufthick)
9707 C lipbufthick is thickenes of lipid buffore
9708 sslip=sscalelip(fracinbuf)
9709 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9710 eliptran=eliptran+sslip*liptranene(itype(i))
9711 gliptranx(3,i)=gliptranx(3,i)
9712 &+ssgradlip*liptranene(itype(i))
9713 gliptranc(3,i-1)= gliptranc(3,i-1)
9714 &+ssgradlip*liptranene(itype(i))
9715 C print *,"doing sccale for lower part"
9716 elseif (positi.gt.bufliptop) then
9718 &((bordliptop-positi)/lipbufthick)
9719 sslip=sscalelip(fracinbuf)
9720 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9721 eliptran=eliptran+sslip*liptranene(itype(i))
9722 gliptranx(3,i)=gliptranx(3,i)
9723 &+ssgradlip*liptranene(itype(i))
9724 gliptranc(3,i-1)= gliptranc(3,i-1)
9725 &+ssgradlip*liptranene(itype(i))
9726 C print *, "doing sscalefor top part",sslip,fracinbuf
9728 eliptran=eliptran+liptranene(itype(i))
9729 C print *,"I am in true lipid"
9731 endif ! if in lipid or buffor
9733 C eliptran=elpitran+0.0 ! I am in water
9737 c----------------------------------------------------------------------------
9738 subroutine e_saxs(Esaxs_constr)
9740 include 'DIMENSIONS'
9743 include "COMMON.SETUP"
9746 include 'COMMON.SBRIDGE'
9747 include 'COMMON.CHAIN'
9748 include 'COMMON.GEO'
9749 include 'COMMON.LOCAL'
9750 include 'COMMON.INTERACT'
9751 include 'COMMON.VAR'
9752 include 'COMMON.IOUNITS'
9753 include 'COMMON.DERIV'
9754 include 'COMMON.CONTROL'
9755 include 'COMMON.NAMES'
9756 include 'COMMON.FFIELD'
9757 include 'COMMON.LANGEVIN'
9759 double precision Esaxs_constr
9760 integer i,iint,j,k,l
9761 double precision PgradC(maxSAXS,3,maxres),
9762 & PgradX(maxSAXS,3,maxres),Pcalc(maxSAXS)
9764 double precision PgradC_(maxSAXS,3,maxres),
9765 & PgradX_(maxSAXS,3,maxres),Pcalc_(maxSAXS)
9767 double precision dk,dijCACA,dijCASC,dijSCCA,dijSCSC,
9768 & sigma2CACA,sigma2CASC,sigma2SCCA,sigma2SCSC,expCACA,expCASC,
9769 & expSCCA,expSCSC,CASCgrad,SCCAgrad,SCSCgrad,aux,auxC,auxC1,
9770 & auxX,auxX1,CACAgrad,Cnorm
9771 double precision sss2,ssgrad2,rrr,sscalgrad2,sscale2
9772 double precision dist
9774 c SAXS restraint penalty function
9776 write(iout,*) "------- SAXS penalty function start -------"
9777 write (iout,*) "nsaxs",nsaxs
9778 write (iout,*) "Esaxs: iatsc_s",iatsc_s," iatsc_e",iatsc_e
9779 write (iout,*) "Psaxs"
9781 write (iout,'(i5,e15.5)') i, Psaxs(i)
9784 Esaxs_constr = 0.0d0
9794 do i=iatsc_s,iatsc_e
9795 if (itype(i).eq.ntyp1) cycle
9796 do iint=1,nint_gr(i)
9797 do j=istart(i,iint),iend(i,iint)
9798 if (itype(j).eq.ntyp1) cycle
9801 dijCASC=dist(i,j+nres)
9802 dijSCCA=dist(i+nres,j)
9803 dijSCSC=dist(i+nres,j+nres)
9804 sigma2CACA=2.0d0/(pstok**2)
9805 sigma2CASC=4.0d0/(pstok**2+restok(itype(j))**2)
9806 sigma2SCCA=4.0d0/(pstok**2+restok(itype(i))**2)
9807 sigma2SCSC=4.0d0/(restok(itype(j))**2+restok(itype(i))**2)
9810 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
9811 if (itype(j).ne.10) then
9812 expCASC = dexp(-0.5d0*sigma2CASC*(dijCASC-dk)**2)
9816 if (itype(i).ne.10) then
9817 expSCCA = dexp(-0.5d0*sigma2SCCA*(dijSCCA-dk)**2)
9821 if (itype(i).ne.10 .and. itype(j).ne.10) then
9822 expSCSC = dexp(-0.5d0*sigma2SCSC*(dijSCSC-dk)**2)
9826 Pcalc(k) = Pcalc(k)+expCACA+expCASC+expSCCA+expSCSC
9828 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
9830 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
9831 CASCgrad = sigma2CASC*(dijCASC-dk)*expCASC
9832 SCCAgrad = sigma2SCCA*(dijSCCA-dk)*expSCCA
9833 SCSCgrad = sigma2SCSC*(dijSCSC-dk)*expSCSC
9836 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9837 PgradC(k,l,i) = PgradC(k,l,i)-aux
9838 PgradC(k,l,j) = PgradC(k,l,j)+aux
9840 if (itype(j).ne.10) then
9841 aux = CASCgrad*(C(l,j+nres)-C(l,i))/dijCASC
9842 PgradC(k,l,i) = PgradC(k,l,i)-aux
9843 PgradC(k,l,j) = PgradC(k,l,j)+aux
9844 PgradX(k,l,j) = PgradX(k,l,j)+aux
9847 if (itype(i).ne.10) then
9848 aux = SCCAgrad*(C(l,j)-C(l,i+nres))/dijSCCA
9849 PgradX(k,l,i) = PgradX(k,l,i)-aux
9850 PgradC(k,l,i) = PgradC(k,l,i)-aux
9851 PgradC(k,l,j) = PgradC(k,l,j)+aux
9854 if (itype(i).ne.10 .and. itype(j).ne.10) then
9855 aux = SCSCgrad*(C(l,j+nres)-C(l,i+nres))/dijSCSC
9856 PgradC(k,l,i) = PgradC(k,l,i)-aux
9857 PgradC(k,l,j) = PgradC(k,l,j)+aux
9858 PgradX(k,l,i) = PgradX(k,l,i)-aux
9859 PgradX(k,l,j) = PgradX(k,l,j)+aux
9865 sigma2CACA=scal_rad**2*0.25d0/
9866 & (restok(itype(j))**2+restok(itype(i))**2)
9868 IF (saxs_cutoff.eq.0) THEN
9871 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
9872 Pcalc(k) = Pcalc(k)+expCACA
9873 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
9875 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9876 PgradC(k,l,i) = PgradC(k,l,i)-aux
9877 PgradC(k,l,j) = PgradC(k,l,j)+aux
9881 rrr = saxs_cutoff*2.0d0/dsqrt(sigma2CACA)
9884 c write (2,*) "ijk",i,j,k
9885 sss2 = sscale2(dijCACA,rrr,dk,0.3d0)
9886 if (sss2.eq.0.0d0) cycle
9887 ssgrad2 = sscalgrad2(dijCACA,rrr,dk,0.3d0)
9888 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)*sss2
9889 Pcalc(k) = Pcalc(k)+expCACA
9891 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
9893 CACAgrad = -sigma2CACA*(dijCACA-dk)*expCACA+
9894 & ssgrad2*expCACA/sss2
9897 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9898 PgradC(k,l,i) = PgradC(k,l,i)+aux
9899 PgradC(k,l,j) = PgradC(k,l,j)-aux
9908 if (nfgtasks.gt.1) then
9909 call MPI_Reduce(Pcalc(1),Pcalc_(1),nsaxs,MPI_DOUBLE_PRECISION,
9910 & MPI_SUM,king,FG_COMM,IERR)
9911 if (fg_rank.eq.king) then
9913 Pcalc(k) = Pcalc_(k)
9916 call MPI_Reduce(PgradC(k,1,1),PgradC_(k,1,1),3*maxsaxs*nres,
9917 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9918 if (fg_rank.eq.king) then
9922 PgradC(k,l,i) = PgradC_(k,l,i)
9928 call MPI_Reduce(PgradX(k,1,1),PgradX_(k,1,1),3*maxsaxs*nres,
9929 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9930 if (fg_rank.eq.king) then
9934 PgradX(k,l,i) = PgradX_(k,l,i)
9943 if (fg_rank.eq.king) then
9947 Cnorm = Cnorm + Pcalc(k)
9949 Esaxs_constr = dlog(Cnorm)-wsaxs0
9951 if (Pcalc(k).gt.0.0d0)
9952 & Esaxs_constr = Esaxs_constr - Psaxs(k)*dlog(Pcalc(k))
9954 write (iout,*) "k",k," Esaxs_constr",Esaxs_constr
9958 write (iout,*) "Cnorm",Cnorm," Esaxs_constr",Esaxs_constr
9968 & auxC = auxC +Psaxs(k)*PgradC(k,l,i)/Pcalc(k)
9969 auxC1 = auxC1+PgradC(k,l,i)
9971 auxX = auxX +Psaxs(k)*PgradX(k,l,i)/Pcalc(k)
9972 auxX1 = auxX1+PgradX(k,l,i)
9975 gsaxsC(l,i) = auxC - auxC1/Cnorm
9977 gsaxsX(l,i) = auxX - auxX1/Cnorm
9979 c write (iout,*) "l i",l,i," gradC",wsaxs*(auxC - auxC1/Cnorm),
9980 c * " gradX",wsaxs*(auxX - auxX1/Cnorm)
9988 c----------------------------------------------------------------------------
9989 subroutine e_saxsC(Esaxs_constr)
9991 include 'DIMENSIONS'
9994 include "COMMON.SETUP"
9997 include 'COMMON.SBRIDGE'
9998 include 'COMMON.CHAIN'
9999 include 'COMMON.INTERACT'
10000 include 'COMMON.GEO'
10001 include 'COMMON.LOCAL'
10002 include 'COMMON.VAR'
10003 include 'COMMON.IOUNITS'
10004 include 'COMMON.DERIV'
10005 include 'COMMON.CONTROL'
10006 include 'COMMON.NAMES'
10007 include 'COMMON.FFIELD'
10008 include 'COMMON.LANGEVIN'
10010 double precision Esaxs_constr
10011 integer i,iint,j,k,l
10012 double precision PgradC(3,maxres),PgradX(3,maxres),Pcalc,logPtot
10014 double precision gsaxsc_(3,maxres),gsaxsx_(3,maxres),logPtot_
10016 double precision dk,dijCASPH,dijSCSPH,
10017 & sigma2CA,sigma2SC,expCASPH,expSCSPH,
10018 & CASPHgrad,SCSPHgrad,aux,auxC,auxC1,
10020 c SAXS restraint penalty function
10022 write(iout,*) "------- SAXS penalty function start -------"
10023 write (iout,*) "nsaxs",nsaxs," isaxs_start",isaxs_start,
10024 & " isaxs_end",isaxs_end
10025 write (iout,*) "nnt",nnt," ntc",nct
10027 write(iout,'(a6,i5,3f10.5,5x,2f10.5)')
10028 & "CA",i,(C(j,i),j=1,3),pstok,restok(itype(i))
10031 write(iout,'(a6,i5,3f10.5)')"CSaxs",i,(Csaxs(j,i),j=1,3)
10034 Esaxs_constr = 0.0d0
10036 do j=isaxs_start,isaxs_end
10048 dijCASPH=dijCASPH+(C(l,i)-Csaxs(l,j))**2
10050 if (itype(i).ne.10) then
10052 dijSCSPH=dijSCSPH+(C(l,i+nres)-Csaxs(l,j))**2
10055 sigma2CA=2.0d0/pstok**2
10056 sigma2SC=4.0d0/restok(itype(i))**2
10057 expCASPH = dexp(-0.5d0*sigma2CA*dijCASPH)
10058 expSCSPH = dexp(-0.5d0*sigma2SC*dijSCSPH)
10059 Pcalc = Pcalc+expCASPH+expSCSPH
10061 write(*,*) "processor i j Pcalc",
10062 & MyRank,i,j,dijCASPH,dijSCSPH, Pcalc
10064 CASPHgrad = sigma2CA*expCASPH
10065 SCSPHgrad = sigma2SC*expSCSPH
10067 aux = (C(l,i+nres)-Csaxs(l,j))*SCSPHgrad
10068 PgradX(l,i) = PgradX(l,i) + aux
10069 PgradC(l,i) = PgradC(l,i)+(C(l,i)-Csaxs(l,j))*CASPHgrad+aux
10074 gsaxsc(l,i)=gsaxsc(l,i)+PgradC(l,i)/Pcalc
10075 gsaxsx(l,i)=gsaxsx(l,i)+PgradX(l,i)/Pcalc
10078 logPtot = logPtot - dlog(Pcalc)
10079 c print *,"me",me,MyRank," j",j," logPcalc",-dlog(Pcalc),
10080 c & " logPtot",logPtot
10083 if (nfgtasks.gt.1) then
10084 c write (iout,*) "logPtot before reduction",logPtot
10085 call MPI_Reduce(logPtot,logPtot_,1,MPI_DOUBLE_PRECISION,
10086 & MPI_SUM,king,FG_COMM,IERR)
10088 c write (iout,*) "logPtot after reduction",logPtot
10089 call MPI_Reduce(gsaxsC(1,1),gsaxsC_(1,1),3*nres,
10090 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10091 if (fg_rank.eq.king) then
10094 gsaxsC(l,i) = gsaxsC_(l,i)
10098 call MPI_Reduce(gsaxsX(1,1),gsaxsX_(1,1),3*nres,
10099 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10100 if (fg_rank.eq.king) then
10103 gsaxsX(l,i) = gsaxsX_(l,i)
10109 Esaxs_constr = logPtot