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
4009 do k=1,constr_homology
4010 if(.not.l_homo(k,ii)) cycle
4011 distance(k)=odl(k,ii)-dij
4012 c write (iout,*) "distance(",k,") =",distance(k)
4014 c For Gaussian-type Urestr
4016 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
4017 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
4018 c write (iout,*) "distancek(",k,") =",distancek(k)
4019 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
4021 c For Lorentzian-type Urestr
4023 if (waga_dist.lt.0.0d0) then
4024 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
4025 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
4026 & (distance(k)**2+sigma_odlir(k,ii)**2))
4030 c min_odl=minval(distancek)
4031 do kk=1,constr_homology
4032 if(l_homo(kk,ii)) then
4033 min_odl=distancek(kk)
4037 do kk=1,constr_homology
4038 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
4039 & min_odl=distancek(kk)
4041 c write (iout,* )"min_odl",min_odl
4043 write (iout,*) "ij dij",i,j,dij
4044 write (iout,*) "distance",(distance(k),k=1,constr_homology)
4045 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
4046 write (iout,* )"min_odl",min_odl
4049 do k=1,constr_homology
4050 c Nie wiem po co to liczycie jeszcze raz!
4051 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
4052 c & (2*(sigma_odl(i,j,k))**2))
4053 if(.not.l_homo(k,ii)) cycle
4054 if (waga_dist.ge.0.0d0) then
4056 c For Gaussian-type Urestr
4058 godl(k)=dexp(-distancek(k)+min_odl)
4059 odleg2=odleg2+godl(k)
4061 c For Lorentzian-type Urestr
4064 odleg2=odleg2+distancek(k)
4067 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
4068 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
4069 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
4070 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
4073 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
4074 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
4076 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
4077 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
4079 if (waga_dist.ge.0.0d0) then
4081 c For Gaussian-type Urestr
4083 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
4085 c For Lorentzian-type Urestr
4088 odleg=odleg+odleg2/constr_homology
4092 c write (iout,*) "odleg",odleg ! sum of -ln-s
4095 c For Gaussian-type Urestr
4097 if (waga_dist.ge.0.0d0) sum_godl=odleg2
4099 do k=1,constr_homology
4100 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
4101 c & *waga_dist)+min_odl
4102 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
4104 if(.not.l_homo(k,ii)) cycle
4105 if (waga_dist.ge.0.0d0) then
4106 c For Gaussian-type Urestr
4108 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
4110 c For Lorentzian-type Urestr
4113 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
4114 & sigma_odlir(k,ii)**2)**2)
4116 sum_sgodl=sum_sgodl+sgodl
4118 c sgodl2=sgodl2+sgodl
4119 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
4120 c write(iout,*) "constr_homology=",constr_homology
4121 c write(iout,*) i, j, k, "TEST K"
4123 if (waga_dist.ge.0.0d0) then
4125 c For Gaussian-type Urestr
4127 grad_odl3=waga_homology(iset)*waga_dist
4128 & *sum_sgodl/(sum_godl*dij)
4130 c For Lorentzian-type Urestr
4133 c Original grad expr modified by analogy w Gaussian-type Urestr grad
4134 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
4135 grad_odl3=-waga_homology(iset)*waga_dist*
4136 & sum_sgodl/(constr_homology*dij)
4139 c grad_odl3=sum_sgodl/(sum_godl*dij)
4142 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
4143 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
4144 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
4146 ccc write(iout,*) godl, sgodl, grad_odl3
4148 c grad_odl=grad_odl+grad_odl3
4151 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
4152 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
4153 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
4154 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
4155 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
4156 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
4157 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
4158 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
4159 c if (i.eq.25.and.j.eq.27) then
4160 c write(iout,*) "jik",jik,"i",i,"j",j
4161 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
4162 c write(iout,*) "grad_odl3",grad_odl3
4163 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
4164 c write(iout,*) "ggodl",ggodl
4165 c write(iout,*) "ghpbc(",jik,i,")",
4166 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
4171 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
4172 ccc & dLOG(odleg2),"-odleg=", -odleg
4174 enddo ! ii-loop for dist
4176 write(iout,*) "------- dist restrs end -------"
4177 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
4178 c & waga_d.eq.1.0d0) call sum_gradient
4180 c Pseudo-energy and gradient from dihedral-angle restraints from
4181 c homology templates
4182 c write (iout,*) "End of distance loop"
4185 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
4187 write(iout,*) "------- dih restrs start -------"
4188 do i=idihconstr_start_homo,idihconstr_end_homo
4189 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
4192 do i=idihconstr_start_homo,idihconstr_end_homo
4194 c betai=beta(i,i+1,i+2,i+3)
4196 c write (iout,*) "betai =",betai
4197 do k=1,constr_homology
4198 dih_diff(k)=pinorm(dih(k,i)-betai)
4199 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
4200 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
4201 c & -(6.28318-dih_diff(i,k))
4202 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
4203 c & 6.28318+dih_diff(i,k)
4205 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
4206 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
4209 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
4212 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
4213 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
4215 write (iout,*) "i",i," betai",betai," kat2",kat2
4216 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
4218 if (kat2.le.1.0d-14) cycle
4219 kat=kat-dLOG(kat2/constr_homology)
4220 c write (iout,*) "kat",kat ! sum of -ln-s
4222 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
4223 ccc & dLOG(kat2), "-kat=", -kat
4226 c ----------------------------------------------------------------------
4228 c ----------------------------------------------------------------------
4232 do k=1,constr_homology
4233 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
4234 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
4235 sum_sgdih=sum_sgdih+sgdih
4237 c grad_dih3=sum_sgdih/sum_gdih
4238 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
4240 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
4241 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
4242 ccc & gloc(nphi+i-3,icg)
4243 gloc(i,icg)=gloc(i,icg)+grad_dih3
4245 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
4247 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
4248 ccc & gloc(nphi+i-3,icg)
4250 enddo ! i-loop for dih
4252 write(iout,*) "------- dih restrs end -------"
4255 c Pseudo-energy and gradient for theta angle restraints from
4256 c homology templates
4257 c FP 01/15 - inserted from econstr_local_test.F, loop structure
4261 c For constr_homology reference structures (FP)
4263 c Uconst_back_tot=0.0d0
4266 c Econstr_back legacy
4269 c do i=ithet_start,ithet_end
4272 c do i=loc_start,loc_end
4275 duscdiffx(j,i)=0.0d0
4281 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
4282 c write (iout,*) "waga_theta",waga_theta
4283 if (waga_theta.gt.0.0d0) then
4285 write (iout,*) "usampl",usampl
4286 write(iout,*) "------- theta restrs start -------"
4287 c do i=ithet_start,ithet_end
4288 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
4291 c write (iout,*) "maxres",maxres,"nres",nres
4293 do i=ithet_start,ithet_end
4296 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
4298 c Deviation of theta angles wrt constr_homology ref structures
4300 utheta_i=0.0d0 ! argument of Gaussian for single k
4301 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
4302 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
4303 c over residues in a fragment
4304 c write (iout,*) "theta(",i,")=",theta(i)
4305 do k=1,constr_homology
4307 c dtheta_i=theta(j)-thetaref(j,iref)
4308 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
4309 theta_diff(k)=thetatpl(k,i)-theta(i)
4311 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
4312 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
4313 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
4314 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
4315 c Gradient for single Gaussian restraint in subr Econstr_back
4316 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
4319 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
4320 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
4324 c Gradient for multiple Gaussian restraint
4325 sum_gtheta=gutheta_i
4327 do k=1,constr_homology
4328 c New generalized expr for multiple Gaussian from Econstr_back
4329 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
4331 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
4332 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
4335 c Final value of gradient using same var as in Econstr_back
4336 dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
4337 & *waga_homology(iset)
4338 c dutheta(i)=sum_sgtheta/sum_gtheta
4340 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
4342 Eval=Eval-dLOG(gutheta_i/constr_homology)
4343 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
4344 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
4345 c Uconst_back=Uconst_back+utheta(i)
4346 enddo ! (i-loop for theta)
4348 write(iout,*) "------- theta restrs end -------"
4352 c Deviation of local SC geometry
4354 c Separation of two i-loops (instructed by AL - 11/3/2014)
4356 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
4357 c write (iout,*) "waga_d",waga_d
4360 write(iout,*) "------- SC restrs start -------"
4361 write (iout,*) "Initial duscdiff,duscdiffx"
4362 do i=loc_start,loc_end
4363 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
4364 & (duscdiffx(jik,i),jik=1,3)
4367 do i=loc_start,loc_end
4368 usc_diff_i=0.0d0 ! argument of Gaussian for single k
4369 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
4370 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
4371 c write(iout,*) "xxtab, yytab, zztab"
4372 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
4373 do k=1,constr_homology
4375 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
4376 c Original sign inverted for calc of gradients (s. Econstr_back)
4377 dyy=-yytpl(k,i)+yytab(i) ! ibid y
4378 dzz=-zztpl(k,i)+zztab(i) ! ibid z
4379 c write(iout,*) "dxx, dyy, dzz"
4380 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
4382 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
4383 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
4384 c uscdiffk(k)=usc_diff(i)
4385 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
4386 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
4387 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
4388 c & xxref(j),yyref(j),zzref(j)
4393 c Generalized expression for multiple Gaussian acc to that for a single
4394 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
4396 c Original implementation
4397 c sum_guscdiff=guscdiff(i)
4399 c sum_sguscdiff=0.0d0
4400 c do k=1,constr_homology
4401 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
4402 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
4403 c sum_sguscdiff=sum_sguscdiff+sguscdiff
4406 c Implementation of new expressions for gradient (Jan. 2015)
4408 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
4410 do k=1,constr_homology
4412 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
4413 c before. Now the drivatives should be correct
4415 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
4416 c Original sign inverted for calc of gradients (s. Econstr_back)
4417 dyy=-yytpl(k,i)+yytab(i) ! ibid y
4418 dzz=-zztpl(k,i)+zztab(i) ! ibid z
4420 c New implementation
4422 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
4423 & sigma_d(k,i) ! for the grad wrt r'
4424 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
4427 c New implementation
4428 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
4430 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
4431 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
4432 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
4433 duscdiff(jik,i)=duscdiff(jik,i)+
4434 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
4435 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
4436 duscdiffx(jik,i)=duscdiffx(jik,i)+
4437 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
4438 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
4441 write(iout,*) "jik",jik,"i",i
4442 write(iout,*) "dxx, dyy, dzz"
4443 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
4444 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
4445 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
4446 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
4447 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
4448 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
4449 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
4450 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
4451 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
4452 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
4453 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
4454 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
4455 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
4456 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
4457 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
4464 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
4465 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
4467 c write (iout,*) i," uscdiff",uscdiff(i)
4469 c Put together deviations from local geometry
4471 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
4472 c & wfrag_back(3,i,iset)*uscdiff(i)
4473 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
4474 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
4475 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
4476 c Uconst_back=Uconst_back+usc_diff(i)
4478 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
4480 c New implment: multiplied by sum_sguscdiff
4483 enddo ! (i-loop for dscdiff)
4488 write(iout,*) "------- SC restrs end -------"
4489 write (iout,*) "------ After SC loop in e_modeller ------"
4490 do i=loc_start,loc_end
4491 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
4492 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
4494 if (waga_theta.eq.1.0d0) then
4495 write (iout,*) "in e_modeller after SC restr end: dutheta"
4496 do i=ithet_start,ithet_end
4497 write (iout,*) i,dutheta(i)
4500 if (waga_d.eq.1.0d0) then
4501 write (iout,*) "e_modeller after SC loop: duscdiff/x"
4503 write (iout,*) i,(duscdiff(j,i),j=1,3)
4504 write (iout,*) i,(duscdiffx(j,i),j=1,3)
4509 c Total energy from homology restraints
4511 write (iout,*) "odleg",odleg," kat",kat
4512 write (iout,*) "odleg",odleg," kat",kat
4513 write (iout,*) "Eval",Eval," Erot",Erot
4514 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
4515 write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
4516 write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
4517 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
4520 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
4522 c ehomology_constr=odleg+kat
4524 c For Lorentzian-type Urestr
4527 if (waga_dist.ge.0.0d0) then
4529 c For Gaussian-type Urestr
4531 ehomology_constr=(waga_dist*odleg+waga_angle*kat+
4532 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
4533 c write (iout,*) "ehomology_constr=",ehomology_constr
4536 c For Lorentzian-type Urestr
4538 ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
4539 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
4540 c write (iout,*) "ehomology_constr=",ehomology_constr
4543 write (iout,*) "iset",iset," waga_homology",waga_homology(iset)
4544 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
4545 & " Eval",waga_theta,Eval," Erot",waga_d,Erot
4546 write (iout,*) "ehomology_constr",ehomology_constr
4550 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
4551 747 format(a12,i4,i4,i4,f8.3,f8.3)
4552 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
4553 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
4554 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
4555 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
4557 C--------------------------------------------------------------------------
4559 C--------------------------------------------------------------------------
4560 subroutine ebond(estr)
4562 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4564 implicit real*8 (a-h,o-z)
4565 include 'DIMENSIONS'
4566 include 'sizesclu.dat'
4567 include 'COMMON.LOCAL'
4568 include 'COMMON.GEO'
4569 include 'COMMON.INTERACT'
4570 include 'COMMON.DERIV'
4571 include 'COMMON.VAR'
4572 include 'COMMON.CHAIN'
4573 include 'COMMON.IOUNITS'
4574 include 'COMMON.NAMES'
4575 include 'COMMON.FFIELD'
4576 include 'COMMON.CONTROL'
4577 logical energy_dec /.false./
4578 double precision u(3),ud(3)
4582 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4583 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4585 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4586 C & *dc(j,i-1)/vbld(i)
4588 C if (energy_dec) write(iout,*)
4589 C & "estr1",i,vbld(i),distchainmax,
4590 C & gnmr1(vbld(i),-1.0d0,distchainmax)
4592 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4593 diff = vbld(i)-vbldpDUM
4595 diff = vbld(i)-vbldp0
4596 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4600 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4603 C write (iout,'(a7,i5,4f7.3)')
4604 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4606 estr=0.5d0*AKP*estr+estr1
4608 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4612 if (iti.ne.10 .and. iti.ne.ntyp1) then
4615 diff=vbld(i+nres)-vbldsc0(1,iti)
4616 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4617 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4618 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4620 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4624 diff=vbld(i+nres)-vbldsc0(j,iti)
4625 ud(j)=aksc(j,iti)*diff
4626 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4640 uprod2=uprod2*u(k)*u(k)
4644 usumsqder=usumsqder+ud(j)*uprod2
4646 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
4647 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
4648 estr=estr+uprod/usum
4650 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4658 C--------------------------------------------------------------------------
4659 subroutine ebend(etheta,ethetacnstr)
4661 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4662 C angles gamma and its derivatives in consecutive thetas and gammas.
4664 implicit real*8 (a-h,o-z)
4665 include 'DIMENSIONS'
4666 include 'sizesclu.dat'
4667 include 'COMMON.LOCAL'
4668 include 'COMMON.GEO'
4669 include 'COMMON.INTERACT'
4670 include 'COMMON.DERIV'
4671 include 'COMMON.VAR'
4672 include 'COMMON.CHAIN'
4673 include 'COMMON.IOUNITS'
4674 include 'COMMON.NAMES'
4675 include 'COMMON.FFIELD'
4676 include 'COMMON.TORCNSTR'
4677 common /calcthet/ term1,term2,termm,diffak,ratak,
4678 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4679 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4680 double precision y(2),z(2)
4682 c time11=dexp(-2*time)
4685 c write (iout,*) "nres",nres
4686 c write (*,'(a,i2)') 'EBEND ICG=',icg
4687 c write (iout,*) ithet_start,ithet_end
4688 do i=ithet_start,ithet_end
4689 C if (itype(i-1).eq.ntyp1) cycle
4691 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4692 & .or.itype(i).eq.ntyp1) cycle
4693 C Zero the energy function and its derivative at 0 or pi.
4694 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4696 ichir1=isign(1,itype(i-2))
4697 ichir2=isign(1,itype(i))
4698 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4699 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4700 if (itype(i-1).eq.10) then
4701 itype1=isign(10,itype(i-2))
4702 ichir11=isign(1,itype(i-2))
4703 ichir12=isign(1,itype(i-2))
4704 itype2=isign(10,itype(i))
4705 ichir21=isign(1,itype(i))
4706 ichir22=isign(1,itype(i))
4713 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
4717 c call proc_proc(phii,icrc)
4718 if (icrc.eq.1) phii=150.0
4729 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4733 c call proc_proc(phii1,icrc)
4734 if (icrc.eq.1) phii1=150.0
4746 C Calculate the "mean" value of theta from the part of the distribution
4747 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4748 C In following comments this theta will be referred to as t_c.
4749 thet_pred_mean=0.0d0
4751 athetk=athet(k,it,ichir1,ichir2)
4752 bthetk=bthet(k,it,ichir1,ichir2)
4754 athetk=athet(k,itype1,ichir11,ichir12)
4755 bthetk=bthet(k,itype2,ichir21,ichir22)
4757 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4759 c write (iout,*) "thet_pred_mean",thet_pred_mean
4760 dthett=thet_pred_mean*ssd
4761 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4762 c write (iout,*) "thet_pred_mean",thet_pred_mean
4763 C Derivatives of the "mean" values in gamma1 and gamma2.
4764 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4765 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4766 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4767 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4769 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4770 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4771 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4772 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4774 if (theta(i).gt.pi-delta) then
4775 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4777 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4778 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4779 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4781 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4783 else if (theta(i).lt.delta) then
4784 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4785 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4786 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4788 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4789 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4792 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4795 etheta=etheta+ethetai
4796 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4797 c & rad2deg*phii,rad2deg*phii1,ethetai
4798 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4799 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4800 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4803 C Ufff.... We've done all this!!!
4806 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4807 do i=1,ntheta_constr
4808 itheta=itheta_constr(i)
4809 thetiii=theta(itheta)
4810 difi=pinorm(thetiii-theta_constr0(i))
4811 if (difi.gt.theta_drange(i)) then
4812 difi=difi-theta_drange(i)
4813 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4814 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4815 & +for_thet_constr(i)*difi**3
4816 else if (difi.lt.-drange(i)) then
4818 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4819 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4820 & +for_thet_constr(i)*difi**3
4824 C if (energy_dec) then
4825 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4826 C & i,itheta,rad2deg*thetiii,
4827 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4828 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4829 C & gloc(itheta+nphi-2,icg)
4834 C---------------------------------------------------------------------------
4835 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4837 implicit real*8 (a-h,o-z)
4838 include 'DIMENSIONS'
4839 include 'COMMON.LOCAL'
4840 include 'COMMON.IOUNITS'
4841 common /calcthet/ term1,term2,termm,diffak,ratak,
4842 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4843 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4844 C Calculate the contributions to both Gaussian lobes.
4845 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4846 C The "polynomial part" of the "standard deviation" of this part of
4850 sig=sig*thet_pred_mean+polthet(j,it)
4852 C Derivative of the "interior part" of the "standard deviation of the"
4853 C gamma-dependent Gaussian lobe in t_c.
4854 sigtc=3*polthet(3,it)
4856 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4859 C Set the parameters of both Gaussian lobes of the distribution.
4860 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4861 fac=sig*sig+sigc0(it)
4864 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4865 sigsqtc=-4.0D0*sigcsq*sigtc
4866 c print *,i,sig,sigtc,sigsqtc
4867 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4868 sigtc=-sigtc/(fac*fac)
4869 C Following variable is sigma(t_c)**(-2)
4870 sigcsq=sigcsq*sigcsq
4872 sig0inv=1.0D0/sig0i**2
4873 delthec=thetai-thet_pred_mean
4874 delthe0=thetai-theta0i
4875 term1=-0.5D0*sigcsq*delthec*delthec
4876 term2=-0.5D0*sig0inv*delthe0*delthe0
4877 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4878 C NaNs in taking the logarithm. We extract the largest exponent which is added
4879 C to the energy (this being the log of the distribution) at the end of energy
4880 C term evaluation for this virtual-bond angle.
4881 if (term1.gt.term2) then
4883 term2=dexp(term2-termm)
4887 term1=dexp(term1-termm)
4890 C The ratio between the gamma-independent and gamma-dependent lobes of
4891 C the distribution is a Gaussian function of thet_pred_mean too.
4892 diffak=gthet(2,it)-thet_pred_mean
4893 ratak=diffak/gthet(3,it)**2
4894 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4895 C Let's differentiate it in thet_pred_mean NOW.
4897 C Now put together the distribution terms to make complete distribution.
4898 termexp=term1+ak*term2
4899 termpre=sigc+ak*sig0i
4900 C Contribution of the bending energy from this theta is just the -log of
4901 C the sum of the contributions from the two lobes and the pre-exponential
4902 C factor. Simple enough, isn't it?
4903 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4904 C NOW the derivatives!!!
4905 C 6/6/97 Take into account the deformation.
4906 E_theta=(delthec*sigcsq*term1
4907 & +ak*delthe0*sig0inv*term2)/termexp
4908 E_tc=((sigtc+aktc*sig0i)/termpre
4909 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4910 & aktc*term2)/termexp)
4913 c-----------------------------------------------------------------------------
4914 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4915 implicit real*8 (a-h,o-z)
4916 include 'DIMENSIONS'
4917 include 'COMMON.LOCAL'
4918 include 'COMMON.IOUNITS'
4919 common /calcthet/ term1,term2,termm,diffak,ratak,
4920 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4921 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4922 delthec=thetai-thet_pred_mean
4923 delthe0=thetai-theta0i
4924 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4925 t3 = thetai-thet_pred_mean
4929 t14 = t12+t6*sigsqtc
4931 t21 = thetai-theta0i
4937 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4938 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4939 & *(-t12*t9-ak*sig0inv*t27)
4943 C--------------------------------------------------------------------------
4944 subroutine ebend(etheta,ethetacnstr)
4946 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4947 C angles gamma and its derivatives in consecutive thetas and gammas.
4948 C ab initio-derived potentials from
4949 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4951 implicit real*8 (a-h,o-z)
4952 include 'DIMENSIONS'
4953 include 'sizesclu.dat'
4954 include 'COMMON.LOCAL'
4955 include 'COMMON.GEO'
4956 include 'COMMON.INTERACT'
4957 include 'COMMON.DERIV'
4958 include 'COMMON.VAR'
4959 include 'COMMON.CHAIN'
4960 include 'COMMON.IOUNITS'
4961 include 'COMMON.NAMES'
4962 include 'COMMON.FFIELD'
4963 include 'COMMON.CONTROL'
4964 include 'COMMON.TORCNSTR'
4965 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4966 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4967 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4968 & sinph1ph2(maxdouble,maxdouble)
4969 logical lprn /.false./, lprn1 /.false./
4971 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4972 do i=ithet_start,ithet_end
4974 c print *,i,itype(i-1),itype(i),itype(i-2)
4975 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1)
4976 & .or.(itype(i).eq.ntyp1)) cycle
4977 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
4979 if (iabs(itype(i+1)).eq.20) iblock=2
4980 if (iabs(itype(i+1)).ne.20) iblock=1
4984 theti2=0.5d0*theta(i)
4985 ityp2=ithetyp((itype(i-1)))
4987 coskt(k)=dcos(k*theti2)
4988 sinkt(k)=dsin(k*theti2)
4990 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
4993 if (phii.ne.phii) phii=150.0
4997 ityp1=ithetyp((itype(i-2)))
4999 cosph1(k)=dcos(k*phii)
5000 sinph1(k)=dsin(k*phii)
5004 ityp1=ithetyp(itype(i-2))
5010 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5013 if (phii1.ne.phii1) phii1=150.0
5018 ityp3=ithetyp((itype(i)))
5020 cosph2(k)=dcos(k*phii1)
5021 sinph2(k)=dsin(k*phii1)
5025 ityp3=ithetyp(itype(i))
5031 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
5032 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
5034 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5037 ccl=cosph1(l)*cosph2(k-l)
5038 ssl=sinph1(l)*sinph2(k-l)
5039 scl=sinph1(l)*cosph2(k-l)
5040 csl=cosph1(l)*sinph2(k-l)
5041 cosph1ph2(l,k)=ccl-ssl
5042 cosph1ph2(k,l)=ccl+ssl
5043 sinph1ph2(l,k)=scl+csl
5044 sinph1ph2(k,l)=scl-csl
5048 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5049 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5050 write (iout,*) "coskt and sinkt"
5052 write (iout,*) k,coskt(k),sinkt(k)
5056 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5057 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5060 & write (iout,*) "k",k," aathet",
5061 & aathet(k,ityp1,ityp2,ityp3,iblock),
5062 & " ethetai",ethetai
5065 write (iout,*) "cosph and sinph"
5067 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5069 write (iout,*) "cosph1ph2 and sinph2ph2"
5072 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5073 & sinph1ph2(l,k),sinph1ph2(k,l)
5076 write(iout,*) "ethetai",ethetai
5080 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5081 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5082 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5083 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5084 ethetai=ethetai+sinkt(m)*aux
5085 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5086 dephii=dephii+k*sinkt(m)*(
5087 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5088 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5089 dephii1=dephii1+k*sinkt(m)*(
5090 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5091 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5093 & write (iout,*) "m",m," k",k," bbthet",
5094 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5095 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5096 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5097 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5101 & write(iout,*) "ethetai",ethetai
5105 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5106 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5107 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5108 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5109 ethetai=ethetai+sinkt(m)*aux
5110 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5111 dephii=dephii+l*sinkt(m)*(
5112 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5113 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5114 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5115 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5116 dephii1=dephii1+(k-l)*sinkt(m)*(
5117 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5118 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5119 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5120 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5122 write (iout,*) "m",m," k",k," l",l," ffthet",
5123 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5124 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5125 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5126 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5127 & " ethetai",ethetai
5128 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5129 & cosph1ph2(k,l)*sinkt(m),
5130 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5136 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5137 & i,theta(i)*rad2deg,phii*rad2deg,
5138 & phii1*rad2deg,ethetai
5139 etheta=etheta+ethetai
5140 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5141 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5142 c gloc(nphi+i-2,icg)=wang*dethetai
5143 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
5147 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
5148 do i=1,ntheta_constr
5149 itheta=itheta_constr(i)
5150 thetiii=theta(itheta)
5151 difi=pinorm(thetiii-theta_constr0(i))
5152 if (difi.gt.theta_drange(i)) then
5153 difi=difi-theta_drange(i)
5154 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5155 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
5156 & +for_thet_constr(i)*difi**3
5157 else if (difi.lt.-drange(i)) then
5159 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5160 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
5161 & +for_thet_constr(i)*difi**3
5165 C if (energy_dec) then
5166 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
5167 C & i,itheta,rad2deg*thetiii,
5168 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
5169 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
5170 C & gloc(itheta+nphi-2,icg)
5177 c-----------------------------------------------------------------------------
5178 subroutine esc(escloc)
5179 C Calculate the local energy of a side chain and its derivatives in the
5180 C corresponding virtual-bond valence angles THETA and the spherical angles
5182 implicit real*8 (a-h,o-z)
5183 include 'DIMENSIONS'
5184 include 'sizesclu.dat'
5185 include 'COMMON.GEO'
5186 include 'COMMON.LOCAL'
5187 include 'COMMON.VAR'
5188 include 'COMMON.INTERACT'
5189 include 'COMMON.DERIV'
5190 include 'COMMON.CHAIN'
5191 include 'COMMON.IOUNITS'
5192 include 'COMMON.NAMES'
5193 include 'COMMON.FFIELD'
5194 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5195 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5196 common /sccalc/ time11,time12,time112,theti,it,nlobit
5199 c write (iout,'(a)') 'ESC'
5200 do i=loc_start,loc_end
5202 if (it.eq.ntyp1) cycle
5203 if (it.eq.10) goto 1
5204 nlobit=nlob(iabs(it))
5205 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5206 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5207 theti=theta(i+1)-pipol
5211 c write (iout,*) "i",i," x",x(1),x(2),x(3)
5213 if (x(2).gt.pi-delta) then
5217 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5219 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5220 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5222 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5223 & ddersc0(1),dersc(1))
5224 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5225 & ddersc0(3),dersc(3))
5227 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5229 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5230 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5231 & dersc0(2),esclocbi,dersc02)
5232 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5234 call splinthet(x(2),0.5d0*delta,ss,ssd)
5239 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5241 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5242 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5244 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5246 c write (iout,*) escloci
5247 else if (x(2).lt.delta) then
5251 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5253 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5254 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5256 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5257 & ddersc0(1),dersc(1))
5258 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5259 & ddersc0(3),dersc(3))
5261 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5263 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5264 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5265 & dersc0(2),esclocbi,dersc02)
5266 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5271 call splinthet(x(2),0.5d0*delta,ss,ssd)
5273 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5275 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5276 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5278 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5279 c write (iout,*) escloci
5281 call enesc(x,escloci,dersc,ddummy,.false.)
5284 escloc=escloc+escloci
5285 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5287 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5289 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5290 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5295 C---------------------------------------------------------------------------
5296 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5297 implicit real*8 (a-h,o-z)
5298 include 'DIMENSIONS'
5299 include 'COMMON.GEO'
5300 include 'COMMON.LOCAL'
5301 include 'COMMON.IOUNITS'
5302 common /sccalc/ time11,time12,time112,theti,it,nlobit
5303 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5304 double precision contr(maxlob,-1:1)
5306 c write (iout,*) 'it=',it,' nlobit=',nlobit
5310 if (mixed) ddersc(j)=0.0d0
5314 C Because of periodicity of the dependence of the SC energy in omega we have
5315 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5316 C To avoid underflows, first compute & store the exponents.
5324 z(k)=x(k)-censc(k,j,it)
5329 Axk=Axk+gaussc(l,k,j,it)*z(l)
5335 expfac=expfac+Ax(k,j,iii)*z(k)
5343 C As in the case of ebend, we want to avoid underflows in exponentiation and
5344 C subsequent NaNs and INFs in energy calculation.
5345 C Find the largest exponent
5349 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5353 cd print *,'it=',it,' emin=',emin
5355 C Compute the contribution to SC energy and derivatives
5359 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5360 cd print *,'j=',j,' expfac=',expfac
5361 escloc_i=escloc_i+expfac
5363 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5367 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5368 & +gaussc(k,2,j,it))*expfac
5375 dersc(1)=dersc(1)/cos(theti)**2
5376 ddersc(1)=ddersc(1)/cos(theti)**2
5379 escloci=-(dlog(escloc_i)-emin)
5381 dersc(j)=dersc(j)/escloc_i
5385 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5390 C------------------------------------------------------------------------------
5391 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5392 implicit real*8 (a-h,o-z)
5393 include 'DIMENSIONS'
5394 include 'COMMON.GEO'
5395 include 'COMMON.LOCAL'
5396 include 'COMMON.IOUNITS'
5397 common /sccalc/ time11,time12,time112,theti,it,nlobit
5398 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5399 double precision contr(maxlob)
5410 z(k)=x(k)-censc(k,j,it)
5416 Axk=Axk+gaussc(l,k,j,it)*z(l)
5422 expfac=expfac+Ax(k,j)*z(k)
5427 C As in the case of ebend, we want to avoid underflows in exponentiation and
5428 C subsequent NaNs and INFs in energy calculation.
5429 C Find the largest exponent
5432 if (emin.gt.contr(j)) emin=contr(j)
5436 C Compute the contribution to SC energy and derivatives
5440 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5441 escloc_i=escloc_i+expfac
5443 dersc(k)=dersc(k)+Ax(k,j)*expfac
5445 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5446 & +gaussc(1,2,j,it))*expfac
5450 dersc(1)=dersc(1)/cos(theti)**2
5451 dersc12=dersc12/cos(theti)**2
5452 escloci=-(dlog(escloc_i)-emin)
5454 dersc(j)=dersc(j)/escloc_i
5456 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5460 c----------------------------------------------------------------------------------
5461 subroutine esc(escloc)
5462 C Calculate the local energy of a side chain and its derivatives in the
5463 C corresponding virtual-bond valence angles THETA and the spherical angles
5464 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5465 C added by Urszula Kozlowska. 07/11/2007
5467 implicit real*8 (a-h,o-z)
5468 include 'DIMENSIONS'
5469 include 'sizesclu.dat'
5470 include 'COMMON.GEO'
5471 include 'COMMON.LOCAL'
5472 include 'COMMON.VAR'
5473 include 'COMMON.SCROT'
5474 include 'COMMON.INTERACT'
5475 include 'COMMON.DERIV'
5476 include 'COMMON.CHAIN'
5477 include 'COMMON.IOUNITS'
5478 include 'COMMON.NAMES'
5479 include 'COMMON.FFIELD'
5480 include 'COMMON.CONTROL'
5481 include 'COMMON.VECTORS'
5482 double precision x_prime(3),y_prime(3),z_prime(3)
5483 & , sumene,dsc_i,dp2_i,x(65),
5484 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5485 & de_dxx,de_dyy,de_dzz,de_dt
5486 double precision s1_t,s1_6_t,s2_t,s2_6_t
5488 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5489 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5490 & dt_dCi(3),dt_dCi1(3)
5491 common /sccalc/ time11,time12,time112,theti,it,nlobit
5494 do i=loc_start,loc_end
5495 if (itype(i).eq.ntyp1) cycle
5496 costtab(i+1) =dcos(theta(i+1))
5497 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5498 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5499 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5500 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5501 cosfac=dsqrt(cosfac2)
5502 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5503 sinfac=dsqrt(sinfac2)
5505 if (it.eq.10) goto 1
5507 C Compute the axes of tghe local cartesian coordinates system; store in
5508 c x_prime, y_prime and z_prime
5515 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5516 C & dc_norm(3,i+nres)
5518 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5519 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5522 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5525 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5526 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5527 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5528 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5529 c & " xy",scalar(x_prime(1),y_prime(1)),
5530 c & " xz",scalar(x_prime(1),z_prime(1)),
5531 c & " yy",scalar(y_prime(1),y_prime(1)),
5532 c & " yz",scalar(y_prime(1),z_prime(1)),
5533 c & " zz",scalar(z_prime(1),z_prime(1))
5535 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5536 C to local coordinate system. Store in xx, yy, zz.
5542 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5543 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5544 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5551 C Compute the energy of the ith side cbain
5553 c write (2,*) "xx",xx," yy",yy," zz",zz
5556 x(j) = sc_parmin(j,it)
5559 Cc diagnostics - remove later
5561 yy1 = dsin(alph(2))*dcos(omeg(2))
5562 c zz1 = -dsin(alph(2))*dsin(omeg(2))
5563 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
5564 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5565 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5567 C," --- ", xx_w,yy_w,zz_w
5570 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5571 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5573 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5574 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5576 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5577 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5578 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5579 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5580 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5582 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5583 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5584 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5585 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5586 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5588 dsc_i = 0.743d0+x(61)
5590 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5591 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5592 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5593 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5594 s1=(1+x(63))/(0.1d0 + dscp1)
5595 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5596 s2=(1+x(65))/(0.1d0 + dscp2)
5597 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5598 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5599 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5600 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5602 c & dscp1,dscp2,sumene
5603 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5604 escloc = escloc + sumene
5605 c write (2,*) "escloc",escloc
5606 if (.not. calc_grad) goto 1
5609 C This section to check the numerical derivatives of the energy of ith side
5610 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5611 C #define DEBUG in the code to turn it on.
5613 write (2,*) "sumene =",sumene
5617 write (2,*) xx,yy,zz
5618 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5619 de_dxx_num=(sumenep-sumene)/aincr
5621 write (2,*) "xx+ sumene from enesc=",sumenep
5624 write (2,*) xx,yy,zz
5625 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5626 de_dyy_num=(sumenep-sumene)/aincr
5628 write (2,*) "yy+ sumene from enesc=",sumenep
5631 write (2,*) xx,yy,zz
5632 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5633 de_dzz_num=(sumenep-sumene)/aincr
5635 write (2,*) "zz+ sumene from enesc=",sumenep
5636 costsave=cost2tab(i+1)
5637 sintsave=sint2tab(i+1)
5638 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5639 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5640 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5641 de_dt_num=(sumenep-sumene)/aincr
5642 write (2,*) " t+ sumene from enesc=",sumenep
5643 cost2tab(i+1)=costsave
5644 sint2tab(i+1)=sintsave
5645 C End of diagnostics section.
5648 C Compute the gradient of esc
5650 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5651 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5652 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5653 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5654 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5655 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5656 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5657 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5658 pom1=(sumene3*sint2tab(i+1)+sumene1)
5659 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5660 pom2=(sumene4*cost2tab(i+1)+sumene2)
5661 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5662 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5663 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5664 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5666 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5667 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5668 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5670 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5671 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5672 & +(pom1+pom2)*pom_dx
5674 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5677 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5678 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5679 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5681 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5682 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5683 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5684 & +x(59)*zz**2 +x(60)*xx*zz
5685 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5686 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5687 & +(pom1-pom2)*pom_dy
5689 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5692 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5693 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5694 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5695 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5696 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5697 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5698 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5699 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5701 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5704 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5705 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5706 & +pom1*pom_dt1+pom2*pom_dt2
5708 write(2,*), "de_dt = ", de_dt,de_dt_num
5712 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5713 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5714 cosfac2xx=cosfac2*xx
5715 sinfac2yy=sinfac2*yy
5717 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5719 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5721 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5722 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5723 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5724 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5725 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5726 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5727 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5728 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5729 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5730 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5734 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5735 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5736 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5737 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5740 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5741 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5742 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5744 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5745 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5749 dXX_Ctab(k,i)=dXX_Ci(k)
5750 dXX_C1tab(k,i)=dXX_Ci1(k)
5751 dYY_Ctab(k,i)=dYY_Ci(k)
5752 dYY_C1tab(k,i)=dYY_Ci1(k)
5753 dZZ_Ctab(k,i)=dZZ_Ci(k)
5754 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5755 dXX_XYZtab(k,i)=dXX_XYZ(k)
5756 dYY_XYZtab(k,i)=dYY_XYZ(k)
5757 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5761 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5762 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5763 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5764 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5765 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5767 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5768 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5769 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5770 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5771 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5772 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5773 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5774 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5776 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5777 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5779 C to check gradient call subroutine check_grad
5786 c------------------------------------------------------------------------------
5787 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5789 C This procedure calculates two-body contact function g(rij) and its derivative:
5792 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5795 C where x=(rij-r0ij)/delta
5797 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5800 double precision rij,r0ij,eps0ij,fcont,fprimcont
5801 double precision x,x2,x4,delta
5805 if (x.lt.-1.0D0) then
5808 else if (x.le.1.0D0) then
5811 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5812 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5819 c------------------------------------------------------------------------------
5820 subroutine splinthet(theti,delta,ss,ssder)
5821 implicit real*8 (a-h,o-z)
5822 include 'DIMENSIONS'
5823 include 'sizesclu.dat'
5824 include 'COMMON.VAR'
5825 include 'COMMON.GEO'
5828 if (theti.gt.pipol) then
5829 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5831 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5836 c------------------------------------------------------------------------------
5837 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5839 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5840 double precision ksi,ksi2,ksi3,a1,a2,a3
5841 a1=fprim0*delta/(f1-f0)
5847 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5848 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5851 c------------------------------------------------------------------------------
5852 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5854 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5855 double precision ksi,ksi2,ksi3,a1,a2,a3
5860 a2=3*(f1x-f0x)-2*fprim0x*delta
5861 a3=fprim0x*delta-2*(f1x-f0x)
5862 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5865 C-----------------------------------------------------------------------------
5867 C-----------------------------------------------------------------------------
5868 subroutine etor(etors,edihcnstr,fact)
5869 implicit real*8 (a-h,o-z)
5870 include 'DIMENSIONS'
5871 include 'sizesclu.dat'
5872 include 'COMMON.VAR'
5873 include 'COMMON.GEO'
5874 include 'COMMON.LOCAL'
5875 include 'COMMON.TORSION'
5876 include 'COMMON.INTERACT'
5877 include 'COMMON.DERIV'
5878 include 'COMMON.CHAIN'
5879 include 'COMMON.NAMES'
5880 include 'COMMON.IOUNITS'
5881 include 'COMMON.FFIELD'
5882 include 'COMMON.TORCNSTR'
5884 C Set lprn=.true. for debugging
5888 do i=iphi_start,iphi_end
5889 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5890 & .or. itype(i).eq.ntyp1) cycle
5891 itori=itortyp(itype(i-2))
5892 itori1=itortyp(itype(i-1))
5895 C Proline-Proline pair is a special case...
5896 if (itori.eq.3 .and. itori1.eq.3) then
5897 if (phii.gt.-dwapi3) then
5899 fac=1.0D0/(1.0D0-cosphi)
5900 etorsi=v1(1,3,3)*fac
5901 etorsi=etorsi+etorsi
5902 etors=etors+etorsi-v1(1,3,3)
5903 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5906 v1ij=v1(j+1,itori,itori1)
5907 v2ij=v2(j+1,itori,itori1)
5910 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5911 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5915 v1ij=v1(j,itori,itori1)
5916 v2ij=v2(j,itori,itori1)
5919 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5920 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5924 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5925 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5926 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5927 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5928 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5930 ! 6/20/98 - dihedral angle constraints
5933 itori=idih_constr(i)
5936 if (difi.gt.drange(i)) then
5938 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5939 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5940 else if (difi.lt.-drange(i)) then
5942 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5943 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5945 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5946 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5948 ! write (iout,*) 'edihcnstr',edihcnstr
5951 c------------------------------------------------------------------------------
5953 subroutine etor(etors,edihcnstr,fact)
5954 implicit real*8 (a-h,o-z)
5955 include 'DIMENSIONS'
5956 include 'sizesclu.dat'
5957 include 'COMMON.VAR'
5958 include 'COMMON.GEO'
5959 include 'COMMON.LOCAL'
5960 include 'COMMON.TORSION'
5961 include 'COMMON.INTERACT'
5962 include 'COMMON.DERIV'
5963 include 'COMMON.CHAIN'
5964 include 'COMMON.NAMES'
5965 include 'COMMON.IOUNITS'
5966 include 'COMMON.FFIELD'
5967 include 'COMMON.TORCNSTR'
5969 C Set lprn=.true. for debugging
5973 do i=iphi_start,iphi_end
5975 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5976 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5977 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5978 if (iabs(itype(i)).eq.20) then
5983 itori=itortyp(itype(i-2))
5984 itori1=itortyp(itype(i-1))
5987 C Regular cosine and sine terms
5988 do j=1,nterm(itori,itori1,iblock)
5989 v1ij=v1(j,itori,itori1,iblock)
5990 v2ij=v2(j,itori,itori1,iblock)
5993 etors=etors+v1ij*cosphi+v2ij*sinphi
5994 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5998 C E = SUM ----------------------------------- - v1
5999 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6001 cosphi=dcos(0.5d0*phii)
6002 sinphi=dsin(0.5d0*phii)
6003 do j=1,nlor(itori,itori1,iblock)
6004 vl1ij=vlor1(j,itori,itori1)
6005 vl2ij=vlor2(j,itori,itori1)
6006 vl3ij=vlor3(j,itori,itori1)
6007 pom=vl2ij*cosphi+vl3ij*sinphi
6008 pom1=1.0d0/(pom*pom+1.0d0)
6009 etors=etors+vl1ij*pom1
6011 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6013 C Subtract the constant term
6014 etors=etors-v0(itori,itori1,iblock)
6016 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6017 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6018 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
6019 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
6020 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6023 ! 6/20/98 - dihedral angle constraints
6026 itori=idih_constr(i)
6028 difi=pinorm(phii-phi0(i))
6030 if (difi.gt.drange(i)) then
6032 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6033 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6034 edihi=0.25d0*ftors(i)*difi**4
6035 else if (difi.lt.-drange(i)) then
6037 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6038 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6039 edihi=0.25d0*ftors(i)*difi**4
6043 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
6045 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6046 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6048 ! write (iout,*) 'edihcnstr',edihcnstr
6051 c----------------------------------------------------------------------------
6052 subroutine etor_d(etors_d,fact2)
6053 C 6/23/01 Compute double torsional energy
6054 implicit real*8 (a-h,o-z)
6055 include 'DIMENSIONS'
6056 include 'sizesclu.dat'
6057 include 'COMMON.VAR'
6058 include 'COMMON.GEO'
6059 include 'COMMON.LOCAL'
6060 include 'COMMON.TORSION'
6061 include 'COMMON.INTERACT'
6062 include 'COMMON.DERIV'
6063 include 'COMMON.CHAIN'
6064 include 'COMMON.NAMES'
6065 include 'COMMON.IOUNITS'
6066 include 'COMMON.FFIELD'
6067 include 'COMMON.TORCNSTR'
6069 C Set lprn=.true. for debugging
6073 do i=iphi_start,iphi_end-1
6075 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
6076 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
6077 & (itype(i+1).eq.ntyp1)) cycle
6078 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
6080 itori=itortyp(itype(i-2))
6081 itori1=itortyp(itype(i-1))
6082 itori2=itortyp(itype(i))
6088 if (iabs(itype(i+1)).eq.20) iblock=2
6089 C Regular cosine and sine terms
6090 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6091 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6092 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6093 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6094 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6095 cosphi1=dcos(j*phii)
6096 sinphi1=dsin(j*phii)
6097 cosphi2=dcos(j*phii1)
6098 sinphi2=dsin(j*phii1)
6099 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6100 & v2cij*cosphi2+v2sij*sinphi2
6101 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6102 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6104 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6106 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6107 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6108 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6109 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6110 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6111 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6112 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6113 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6114 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6115 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6116 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6117 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6118 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6119 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6122 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
6123 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
6129 c------------------------------------------------------------------------------
6130 subroutine eback_sc_corr(esccor)
6131 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6132 c conformational states; temporarily implemented as differences
6133 c between UNRES torsional potentials (dependent on three types of
6134 c residues) and the torsional potentials dependent on all 20 types
6135 c of residues computed from AM1 energy surfaces of terminally-blocked
6136 c amino-acid residues.
6137 implicit real*8 (a-h,o-z)
6138 include 'DIMENSIONS'
6139 include 'sizesclu.dat'
6140 include 'COMMON.VAR'
6141 include 'COMMON.GEO'
6142 include 'COMMON.LOCAL'
6143 include 'COMMON.TORSION'
6144 include 'COMMON.SCCOR'
6145 include 'COMMON.INTERACT'
6146 include 'COMMON.DERIV'
6147 include 'COMMON.CHAIN'
6148 include 'COMMON.NAMES'
6149 include 'COMMON.IOUNITS'
6150 include 'COMMON.FFIELD'
6151 include 'COMMON.CONTROL'
6153 C Set lprn=.true. for debugging
6156 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
6158 do i=itau_start,itau_end
6159 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6161 isccori=isccortyp(itype(i-2))
6162 isccori1=isccortyp(itype(i-1))
6164 do intertyp=1,3 !intertyp
6165 cc Added 09 May 2012 (Adasko)
6166 cc Intertyp means interaction type of backbone mainchain correlation:
6167 c 1 = SC...Ca...Ca...Ca
6168 c 2 = Ca...Ca...Ca...SC
6169 c 3 = SC...Ca...Ca...SCi
6171 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6172 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6173 & (itype(i-1).eq.ntyp1)))
6174 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6175 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6176 & .or.(itype(i).eq.ntyp1)))
6177 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6178 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6179 & (itype(i-3).eq.ntyp1)))) cycle
6180 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6181 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6183 do j=1,nterm_sccor(isccori,isccori1)
6184 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6185 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6186 cosphi=dcos(j*tauangle(intertyp,i))
6187 sinphi=dsin(j*tauangle(intertyp,i))
6188 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6189 c gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6191 c write (iout,*) "EBACK_SC_COR",i,esccor,intertyp
6192 c gloc_sc(intertyp,i-3)=gloc_sc(intertyp,i-3)+wsccor*gloci
6194 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6195 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6196 & (v1sccor(j,1,itori,itori1),j=1,6),
6197 & (v2sccor(j,1,itori,itori1),j=1,6)
6198 gsccor_loc(i-3)=gloci
6203 c------------------------------------------------------------------------------
6204 subroutine multibody(ecorr)
6205 C This subroutine calculates multi-body contributions to energy following
6206 C the idea of Skolnick et al. If side chains I and J make a contact and
6207 C at the same time side chains I+1 and J+1 make a contact, an extra
6208 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6209 implicit real*8 (a-h,o-z)
6210 include 'DIMENSIONS'
6211 include 'COMMON.IOUNITS'
6212 include 'COMMON.DERIV'
6213 include 'COMMON.INTERACT'
6214 include 'COMMON.CONTACTS'
6215 double precision gx(3),gx1(3)
6218 C Set lprn=.true. for debugging
6222 write (iout,'(a)') 'Contact function values:'
6224 write (iout,'(i2,20(1x,i2,f10.5))')
6225 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6240 num_conti=num_cont(i)
6241 num_conti1=num_cont(i1)
6246 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6247 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6248 cd & ' ishift=',ishift
6249 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6250 C The system gains extra energy.
6251 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6252 endif ! j1==j+-ishift
6261 c------------------------------------------------------------------------------
6262 double precision function esccorr(i,j,k,l,jj,kk)
6263 implicit real*8 (a-h,o-z)
6264 include 'DIMENSIONS'
6265 include 'COMMON.IOUNITS'
6266 include 'COMMON.DERIV'
6267 include 'COMMON.INTERACT'
6268 include 'COMMON.CONTACTS'
6269 double precision gx(3),gx1(3)
6274 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6275 C Calculate the multi-body contribution to energy.
6276 C Calculate multi-body contributions to the gradient.
6277 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6278 cd & k,l,(gacont(m,kk,k),m=1,3)
6280 gx(m) =ekl*gacont(m,jj,i)
6281 gx1(m)=eij*gacont(m,kk,k)
6282 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6283 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6284 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6285 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6289 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6294 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6300 c------------------------------------------------------------------------------
6302 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
6303 implicit real*8 (a-h,o-z)
6304 include 'DIMENSIONS'
6305 integer dimen1,dimen2,atom,indx
6306 double precision buffer(dimen1,dimen2)
6307 double precision zapas
6308 common /contacts_hb/ zapas(3,20,maxres,7),
6309 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
6310 & num_cont_hb(maxres),jcont_hb(20,maxres)
6311 num_kont=num_cont_hb(atom)
6315 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
6318 buffer(i,indx+22)=facont_hb(i,atom)
6319 buffer(i,indx+23)=ees0p(i,atom)
6320 buffer(i,indx+24)=ees0m(i,atom)
6321 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
6323 buffer(1,indx+26)=dfloat(num_kont)
6326 c------------------------------------------------------------------------------
6327 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
6328 implicit real*8 (a-h,o-z)
6329 include 'DIMENSIONS'
6330 integer dimen1,dimen2,atom,indx
6331 double precision buffer(dimen1,dimen2)
6332 double precision zapas
6333 common /contacts_hb/ zapas(3,ntyp,maxres,7),
6334 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
6335 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
6336 num_kont=buffer(1,indx+26)
6337 num_kont_old=num_cont_hb(atom)
6338 num_cont_hb(atom)=num_kont+num_kont_old
6343 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
6346 facont_hb(ii,atom)=buffer(i,indx+22)
6347 ees0p(ii,atom)=buffer(i,indx+23)
6348 ees0m(ii,atom)=buffer(i,indx+24)
6349 jcont_hb(ii,atom)=buffer(i,indx+25)
6353 c------------------------------------------------------------------------------
6355 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6356 C This subroutine calculates multi-body contributions to hydrogen-bonding
6357 implicit real*8 (a-h,o-z)
6358 include 'DIMENSIONS'
6359 include 'sizesclu.dat'
6360 include 'COMMON.IOUNITS'
6362 include 'COMMON.INFO'
6364 include 'COMMON.FFIELD'
6365 include 'COMMON.DERIV'
6366 include 'COMMON.INTERACT'
6367 include 'COMMON.CONTACTS'
6369 parameter (max_cont=maxconts)
6370 parameter (max_dim=2*(8*3+2))
6371 parameter (msglen1=max_cont*max_dim*4)
6372 parameter (msglen2=2*msglen1)
6373 integer source,CorrelType,CorrelID,Error
6374 double precision buffer(max_cont,max_dim)
6376 double precision gx(3),gx1(3)
6379 C Set lprn=.true. for debugging
6384 if (fgProcs.le.1) goto 30
6386 write (iout,'(a)') 'Contact function values:'
6388 write (iout,'(2i3,50(1x,i2,f5.2))')
6389 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6390 & j=1,num_cont_hb(i))
6393 C Caution! Following code assumes that electrostatic interactions concerning
6394 C a given atom are split among at most two processors!
6404 cd write (iout,*) 'MyRank',MyRank,' mm',mm
6407 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
6408 if (MyRank.gt.0) then
6409 C Send correlation contributions to the preceding processor
6411 nn=num_cont_hb(iatel_s)
6412 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
6413 cd write (iout,*) 'The BUFFER array:'
6415 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
6417 if (ielstart(iatel_s).gt.iatel_s+ispp) then
6419 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
6420 C Clear the contacts of the atom passed to the neighboring processor
6421 nn=num_cont_hb(iatel_s+1)
6423 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
6425 num_cont_hb(iatel_s)=0
6427 cd write (iout,*) 'Processor ',MyID,MyRank,
6428 cd & ' is sending correlation contribution to processor',MyID-1,
6429 cd & ' msglen=',msglen
6430 cd write (*,*) 'Processor ',MyID,MyRank,
6431 cd & ' is sending correlation contribution to processor',MyID-1,
6432 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6433 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
6434 cd write (iout,*) 'Processor ',MyID,
6435 cd & ' has sent correlation contribution to processor',MyID-1,
6436 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6437 cd write (*,*) 'Processor ',MyID,
6438 cd & ' has sent correlation contribution to processor',MyID-1,
6439 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6441 endif ! (MyRank.gt.0)
6445 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6446 if (MyRank.lt.fgProcs-1) then
6447 C Receive correlation contributions from the next processor
6449 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6450 cd write (iout,*) 'Processor',MyID,
6451 cd & ' is receiving correlation contribution from processor',MyID+1,
6452 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6453 cd write (*,*) 'Processor',MyID,
6454 cd & ' is receiving correlation contribution from processor',MyID+1,
6455 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6457 do while (nbytes.le.0)
6458 call mp_probe(MyID+1,CorrelType,nbytes)
6460 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6461 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6462 cd write (iout,*) 'Processor',MyID,
6463 cd & ' has received correlation contribution from processor',MyID+1,
6464 cd & ' msglen=',msglen,' nbytes=',nbytes
6465 cd write (iout,*) 'The received BUFFER array:'
6467 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6469 if (msglen.eq.msglen1) then
6470 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6471 else if (msglen.eq.msglen2) then
6472 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6473 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6476 & 'ERROR!!!! message length changed while processing correlations.'
6478 & 'ERROR!!!! message length changed while processing correlations.'
6479 call mp_stopall(Error)
6480 endif ! msglen.eq.msglen1
6481 endif ! MyRank.lt.fgProcs-1
6488 write (iout,'(a)') 'Contact function values:'
6490 write (iout,'(2i3,50(1x,i2,f5.2))')
6491 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6492 & j=1,num_cont_hb(i))
6496 C Remove the loop below after debugging !!!
6503 C Calculate the local-electrostatic correlation terms
6504 do i=iatel_s,iatel_e+1
6506 num_conti=num_cont_hb(i)
6507 num_conti1=num_cont_hb(i+1)
6512 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6513 c & ' jj=',jj,' kk=',kk
6514 if (j1.eq.j+1 .or. j1.eq.j-1) then
6515 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6516 C The system gains extra energy.
6517 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6519 else if (j1.eq.j) then
6520 C Contacts I-J and I-(J+1) occur simultaneously.
6521 C The system loses extra energy.
6522 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6527 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6528 c & ' jj=',jj,' kk=',kk
6530 C Contacts I-J and (I+1)-J occur simultaneously.
6531 C The system loses extra energy.
6532 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6539 c------------------------------------------------------------------------------
6540 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6542 C This subroutine calculates multi-body contributions to hydrogen-bonding
6543 implicit real*8 (a-h,o-z)
6544 include 'DIMENSIONS'
6545 include 'sizesclu.dat'
6546 include 'COMMON.IOUNITS'
6548 include 'COMMON.INFO'
6550 include 'COMMON.FFIELD'
6551 include 'COMMON.DERIV'
6552 include 'COMMON.INTERACT'
6553 include 'COMMON.CONTACTS'
6555 parameter (max_cont=maxconts)
6556 parameter (max_dim=2*(8*3+2))
6557 parameter (msglen1=max_cont*max_dim*4)
6558 parameter (msglen2=2*msglen1)
6559 integer source,CorrelType,CorrelID,Error
6560 double precision buffer(max_cont,max_dim)
6562 double precision gx(3),gx1(3)
6565 C Set lprn=.true. for debugging
6571 if (fgProcs.le.1) goto 30
6573 write (iout,'(a)') 'Contact function values:'
6575 write (iout,'(2i3,50(1x,i2,f5.2))')
6576 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6577 & j=1,num_cont_hb(i))
6580 C Caution! Following code assumes that electrostatic interactions concerning
6581 C a given atom are split among at most two processors!
6591 cd write (iout,*) 'MyRank',MyRank,' mm',mm
6594 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
6595 if (MyRank.gt.0) then
6596 C Send correlation contributions to the preceding processor
6598 nn=num_cont_hb(iatel_s)
6599 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
6600 cd write (iout,*) 'The BUFFER array:'
6602 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
6604 if (ielstart(iatel_s).gt.iatel_s+ispp) then
6606 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
6607 C Clear the contacts of the atom passed to the neighboring processor
6608 nn=num_cont_hb(iatel_s+1)
6610 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
6612 num_cont_hb(iatel_s)=0
6614 cd write (iout,*) 'Processor ',MyID,MyRank,
6615 cd & ' is sending correlation contribution to processor',MyID-1,
6616 cd & ' msglen=',msglen
6617 cd write (*,*) 'Processor ',MyID,MyRank,
6618 cd & ' is sending correlation contribution to processor',MyID-1,
6619 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6620 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
6621 cd write (iout,*) 'Processor ',MyID,
6622 cd & ' has sent correlation contribution to processor',MyID-1,
6623 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6624 cd write (*,*) 'Processor ',MyID,
6625 cd & ' has sent correlation contribution to processor',MyID-1,
6626 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6628 endif ! (MyRank.gt.0)
6632 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6633 if (MyRank.lt.fgProcs-1) then
6634 C Receive correlation contributions from the next processor
6636 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6637 cd write (iout,*) 'Processor',MyID,
6638 cd & ' is receiving correlation contribution from processor',MyID+1,
6639 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6640 cd write (*,*) 'Processor',MyID,
6641 cd & ' is receiving correlation contribution from processor',MyID+1,
6642 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6644 do while (nbytes.le.0)
6645 call mp_probe(MyID+1,CorrelType,nbytes)
6647 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6648 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6649 cd write (iout,*) 'Processor',MyID,
6650 cd & ' has received correlation contribution from processor',MyID+1,
6651 cd & ' msglen=',msglen,' nbytes=',nbytes
6652 cd write (iout,*) 'The received BUFFER array:'
6654 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6656 if (msglen.eq.msglen1) then
6657 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6658 else if (msglen.eq.msglen2) then
6659 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6660 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6663 & 'ERROR!!!! message length changed while processing correlations.'
6665 & 'ERROR!!!! message length changed while processing correlations.'
6666 call mp_stopall(Error)
6667 endif ! msglen.eq.msglen1
6668 endif ! MyRank.lt.fgProcs-1
6675 write (iout,'(a)') 'Contact function values:'
6677 write (iout,'(2i3,50(1x,i2,f5.2))')
6678 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6679 & j=1,num_cont_hb(i))
6685 C Remove the loop below after debugging !!!
6692 C Calculate the dipole-dipole interaction energies
6693 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6694 do i=iatel_s,iatel_e+1
6695 num_conti=num_cont_hb(i)
6702 C Calculate the local-electrostatic correlation terms
6703 do i=iatel_s,iatel_e+1
6705 num_conti=num_cont_hb(i)
6706 num_conti1=num_cont_hb(i+1)
6711 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6712 c & ' jj=',jj,' kk=',kk
6713 if (j1.eq.j+1 .or. j1.eq.j-1) then
6714 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6715 C The system gains extra energy.
6717 sqd1=dsqrt(d_cont(jj,i))
6718 sqd2=dsqrt(d_cont(kk,i1))
6719 sred_geom = sqd1*sqd2
6720 IF (sred_geom.lt.cutoff_corr) THEN
6721 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6723 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6724 c & ' jj=',jj,' kk=',kk
6725 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6726 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6728 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6729 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6732 cd write (iout,*) 'sred_geom=',sred_geom,
6733 cd & ' ekont=',ekont,' fprim=',fprimcont
6734 call calc_eello(i,j,i+1,j1,jj,kk)
6735 if (wcorr4.gt.0.0d0)
6736 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
6737 if (wcorr5.gt.0.0d0)
6738 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
6739 c print *,"wcorr5",ecorr5
6740 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6741 cd write(2,*)'ijkl',i,j,i+1,j1
6742 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
6743 & .or. wturn6.eq.0.0d0))then
6744 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6745 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
6746 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6747 cd & 'ecorr6=',ecorr6
6748 cd write (iout,'(4e15.5)') sred_geom,
6749 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
6750 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
6751 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
6752 else if (wturn6.gt.0.0d0
6753 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
6754 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
6755 eturn6=eturn6+eello_turn6(i,jj,kk)
6756 cd write (2,*) 'multibody_eello:eturn6',eturn6
6760 else if (j1.eq.j) then
6761 C Contacts I-J and I-(J+1) occur simultaneously.
6762 C The system loses extra energy.
6763 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6768 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6769 c & ' jj=',jj,' kk=',kk
6771 C Contacts I-J and (I+1)-J occur simultaneously.
6772 C The system loses extra energy.
6773 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6780 c------------------------------------------------------------------------------
6781 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6782 implicit real*8 (a-h,o-z)
6783 include 'DIMENSIONS'
6784 include 'COMMON.IOUNITS'
6785 include 'COMMON.DERIV'
6786 include 'COMMON.INTERACT'
6787 include 'COMMON.CONTACTS'
6788 include 'COMMON.SHIELD'
6790 double precision gx(3),gx1(3)
6800 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6801 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6802 C Following 4 lines for diagnostics.
6807 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
6809 c write (iout,*)'Contacts have occurred for peptide groups',
6810 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
6811 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
6812 C Calculate the multi-body contribution to energy.
6813 ecorr=ecorr+ekont*ees
6815 C Calculate multi-body contributions to the gradient.
6817 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
6818 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
6819 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
6820 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
6821 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
6822 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
6823 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
6824 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
6825 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
6826 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
6827 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
6828 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
6829 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
6830 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
6834 gradcorr(ll,m)=gradcorr(ll,m)+
6835 & ees*ekl*gacont_hbr(ll,jj,i)-
6836 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6837 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6842 gradcorr(ll,m)=gradcorr(ll,m)+
6843 & ees*eij*gacont_hbr(ll,kk,k)-
6844 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6845 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6848 if (shield_mode.gt.0) then
6851 C print *,i,j,fac_shield(i),fac_shield(j),
6852 C &fac_shield(k),fac_shield(l)
6853 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
6854 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
6855 do ilist=1,ishield_list(i)
6856 iresshield=shield_list(ilist,i)
6858 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
6860 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6862 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
6863 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6867 do ilist=1,ishield_list(j)
6868 iresshield=shield_list(ilist,j)
6870 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
6872 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6874 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
6875 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6879 do ilist=1,ishield_list(k)
6880 iresshield=shield_list(ilist,k)
6882 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
6884 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6886 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
6887 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6891 do ilist=1,ishield_list(l)
6892 iresshield=shield_list(ilist,l)
6894 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
6896 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6898 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
6899 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6903 C print *,gshieldx(m,iresshield)
6905 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
6906 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6907 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
6908 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6909 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
6910 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6911 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
6912 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6914 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
6915 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6916 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
6917 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6918 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
6919 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6920 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
6921 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6930 C---------------------------------------------------------------------------
6931 subroutine dipole(i,j,jj)
6932 implicit real*8 (a-h,o-z)
6933 include 'DIMENSIONS'
6934 include 'sizesclu.dat'
6935 include 'COMMON.IOUNITS'
6936 include 'COMMON.CHAIN'
6937 include 'COMMON.FFIELD'
6938 include 'COMMON.DERIV'
6939 include 'COMMON.INTERACT'
6940 include 'COMMON.CONTACTS'
6941 include 'COMMON.TORSION'
6942 include 'COMMON.VAR'
6943 include 'COMMON.GEO'
6944 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6946 iti1 = itortyp(itype(i+1))
6947 if (j.lt.nres-1) then
6948 if (itype(j).le.ntyp) then
6949 itj1 = itortyp(itype(j+1))
6957 dipi(iii,1)=Ub2(iii,i)
6958 dipderi(iii)=Ub2der(iii,i)
6959 dipi(iii,2)=b1(iii,iti1)
6960 dipj(iii,1)=Ub2(iii,j)
6961 dipderj(iii)=Ub2der(iii,j)
6962 dipj(iii,2)=b1(iii,itj1)
6966 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6969 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6972 if (.not.calc_grad) return
6977 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6981 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6986 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6987 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6989 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6991 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6993 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6997 C---------------------------------------------------------------------------
6998 subroutine calc_eello(i,j,k,l,jj,kk)
7000 C This subroutine computes matrices and vectors needed to calculate
7001 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7003 implicit real*8 (a-h,o-z)
7004 include 'DIMENSIONS'
7005 include 'sizesclu.dat'
7006 include 'COMMON.IOUNITS'
7007 include 'COMMON.CHAIN'
7008 include 'COMMON.DERIV'
7009 include 'COMMON.INTERACT'
7010 include 'COMMON.CONTACTS'
7011 include 'COMMON.TORSION'
7012 include 'COMMON.VAR'
7013 include 'COMMON.GEO'
7014 include 'COMMON.FFIELD'
7015 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7016 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7019 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7020 cd & ' jj=',jj,' kk=',kk
7021 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7024 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7025 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7028 call transpose2(aa1(1,1),aa1t(1,1))
7029 call transpose2(aa2(1,1),aa2t(1,1))
7032 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7033 & aa1tder(1,1,lll,kkk))
7034 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7035 & aa2tder(1,1,lll,kkk))
7039 C parallel orientation of the two CA-CA-CA frames.
7041 if (i.gt.1 .and. itype(i).le.ntyp) then
7042 iti=itortyp(itype(i))
7046 itk1=itortyp(itype(k+1))
7047 itj=itortyp(itype(j))
7048 c if (l.lt.nres-1) then
7049 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
7050 itl1=itortyp(itype(l+1))
7054 C A1 kernel(j+1) A2T
7056 cd write (iout,'(3f10.5,5x,3f10.5)')
7057 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7059 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7060 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7061 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7062 C Following matrices are needed only for 6-th order cumulants
7063 IF (wcorr6.gt.0.0d0) THEN
7064 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7065 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7066 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7067 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7068 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7069 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7070 & ADtEAderx(1,1,1,1,1,1))
7072 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7073 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7074 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7075 & ADtEA1derx(1,1,1,1,1,1))
7077 C End 6-th order cumulants
7080 cd write (2,*) 'In calc_eello6'
7082 cd write (2,*) 'iii=',iii
7084 cd write (2,*) 'kkk=',kkk
7086 cd write (2,'(3(2f10.5),5x)')
7087 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7092 call transpose2(EUgder(1,1,k),auxmat(1,1))
7093 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7094 call transpose2(EUg(1,1,k),auxmat(1,1))
7095 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7096 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7100 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7101 & EAEAderx(1,1,lll,kkk,iii,1))
7105 C A1T kernel(i+1) A2
7106 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7107 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7108 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7109 C Following matrices are needed only for 6-th order cumulants
7110 IF (wcorr6.gt.0.0d0) THEN
7111 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7112 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7113 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7114 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7115 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7116 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7117 & ADtEAderx(1,1,1,1,1,2))
7118 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7119 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7120 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7121 & ADtEA1derx(1,1,1,1,1,2))
7123 C End 6-th order cumulants
7124 call transpose2(EUgder(1,1,l),auxmat(1,1))
7125 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7126 call transpose2(EUg(1,1,l),auxmat(1,1))
7127 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7128 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7132 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7133 & EAEAderx(1,1,lll,kkk,iii,2))
7138 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7139 C They are needed only when the fifth- or the sixth-order cumulants are
7141 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7142 call transpose2(AEA(1,1,1),auxmat(1,1))
7143 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7144 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7145 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7146 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7147 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7148 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7149 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7150 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7151 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7152 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7153 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7154 call transpose2(AEA(1,1,2),auxmat(1,1))
7155 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7156 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7157 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7158 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7159 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7160 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7161 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7162 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7163 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7164 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7165 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7166 C Calculate the Cartesian derivatives of the vectors.
7170 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7171 call matvec2(auxmat(1,1),b1(1,iti),
7172 & AEAb1derx(1,lll,kkk,iii,1,1))
7173 call matvec2(auxmat(1,1),Ub2(1,i),
7174 & AEAb2derx(1,lll,kkk,iii,1,1))
7175 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7176 & AEAb1derx(1,lll,kkk,iii,2,1))
7177 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7178 & AEAb2derx(1,lll,kkk,iii,2,1))
7179 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7180 call matvec2(auxmat(1,1),b1(1,itj),
7181 & AEAb1derx(1,lll,kkk,iii,1,2))
7182 call matvec2(auxmat(1,1),Ub2(1,j),
7183 & AEAb2derx(1,lll,kkk,iii,1,2))
7184 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7185 & AEAb1derx(1,lll,kkk,iii,2,2))
7186 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7187 & AEAb2derx(1,lll,kkk,iii,2,2))
7194 C Antiparallel orientation of the two CA-CA-CA frames.
7196 if (i.gt.1 .and. itype(i).le.ntyp) then
7197 iti=itortyp(itype(i))
7201 itk1=itortyp(itype(k+1))
7202 itl=itortyp(itype(l))
7203 itj=itortyp(itype(j))
7204 c if (j.lt.nres-1) then
7205 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7206 itj1=itortyp(itype(j+1))
7210 C A2 kernel(j-1)T A1T
7211 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7212 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7213 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7214 C Following matrices are needed only for 6-th order cumulants
7215 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7216 & j.eq.i+4 .and. l.eq.i+3)) THEN
7217 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7218 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7219 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7220 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7221 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7222 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7223 & ADtEAderx(1,1,1,1,1,1))
7224 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7225 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7226 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7227 & ADtEA1derx(1,1,1,1,1,1))
7229 C End 6-th order cumulants
7230 call transpose2(EUgder(1,1,k),auxmat(1,1))
7231 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7232 call transpose2(EUg(1,1,k),auxmat(1,1))
7233 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7234 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7238 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7239 & EAEAderx(1,1,lll,kkk,iii,1))
7243 C A2T kernel(i+1)T A1
7244 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7245 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7246 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7247 C Following matrices are needed only for 6-th order cumulants
7248 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7249 & j.eq.i+4 .and. l.eq.i+3)) THEN
7250 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7251 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7252 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7253 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7254 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7255 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7256 & ADtEAderx(1,1,1,1,1,2))
7257 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7258 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7259 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7260 & ADtEA1derx(1,1,1,1,1,2))
7262 C End 6-th order cumulants
7263 call transpose2(EUgder(1,1,j),auxmat(1,1))
7264 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7265 call transpose2(EUg(1,1,j),auxmat(1,1))
7266 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7267 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7271 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7272 & EAEAderx(1,1,lll,kkk,iii,2))
7277 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7278 C They are needed only when the fifth- or the sixth-order cumulants are
7280 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7281 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7282 call transpose2(AEA(1,1,1),auxmat(1,1))
7283 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7284 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7285 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7286 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7287 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7288 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7289 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7290 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7291 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7292 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7293 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7294 call transpose2(AEA(1,1,2),auxmat(1,1))
7295 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7296 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7297 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7298 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7299 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7300 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7301 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7302 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7303 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7304 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7305 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7306 C Calculate the Cartesian derivatives of the vectors.
7310 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7311 call matvec2(auxmat(1,1),b1(1,iti),
7312 & AEAb1derx(1,lll,kkk,iii,1,1))
7313 call matvec2(auxmat(1,1),Ub2(1,i),
7314 & AEAb2derx(1,lll,kkk,iii,1,1))
7315 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7316 & AEAb1derx(1,lll,kkk,iii,2,1))
7317 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7318 & AEAb2derx(1,lll,kkk,iii,2,1))
7319 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7320 call matvec2(auxmat(1,1),b1(1,itl),
7321 & AEAb1derx(1,lll,kkk,iii,1,2))
7322 call matvec2(auxmat(1,1),Ub2(1,l),
7323 & AEAb2derx(1,lll,kkk,iii,1,2))
7324 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7325 & AEAb1derx(1,lll,kkk,iii,2,2))
7326 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7327 & AEAb2derx(1,lll,kkk,iii,2,2))
7336 C---------------------------------------------------------------------------
7337 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7338 & KK,KKderg,AKA,AKAderg,AKAderx)
7342 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7343 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7344 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7349 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7351 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7354 cd if (lprn) write (2,*) 'In kernel'
7356 cd if (lprn) write (2,*) 'kkk=',kkk
7358 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7359 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7361 cd write (2,*) 'lll=',lll
7362 cd write (2,*) 'iii=1'
7364 cd write (2,'(3(2f10.5),5x)')
7365 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7368 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7369 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7371 cd write (2,*) 'lll=',lll
7372 cd write (2,*) 'iii=2'
7374 cd write (2,'(3(2f10.5),5x)')
7375 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7382 C---------------------------------------------------------------------------
7383 double precision function eello4(i,j,k,l,jj,kk)
7384 implicit real*8 (a-h,o-z)
7385 include 'DIMENSIONS'
7386 include 'sizesclu.dat'
7387 include 'COMMON.IOUNITS'
7388 include 'COMMON.CHAIN'
7389 include 'COMMON.DERIV'
7390 include 'COMMON.INTERACT'
7391 include 'COMMON.CONTACTS'
7392 include 'COMMON.TORSION'
7393 include 'COMMON.VAR'
7394 include 'COMMON.GEO'
7395 double precision pizda(2,2),ggg1(3),ggg2(3)
7396 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7400 cd print *,'eello4:',i,j,k,l,jj,kk
7401 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7402 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7403 cold eij=facont_hb(jj,i)
7404 cold ekl=facont_hb(kk,k)
7406 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7408 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7409 gcorr_loc(k-1)=gcorr_loc(k-1)
7410 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7412 gcorr_loc(l-1)=gcorr_loc(l-1)
7413 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7415 gcorr_loc(j-1)=gcorr_loc(j-1)
7416 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7421 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7422 & -EAEAderx(2,2,lll,kkk,iii,1)
7423 cd derx(lll,kkk,iii)=0.0d0
7427 cd gcorr_loc(l-1)=0.0d0
7428 cd gcorr_loc(j-1)=0.0d0
7429 cd gcorr_loc(k-1)=0.0d0
7431 cd write (iout,*)'Contacts have occurred for peptide groups',
7432 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7433 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7434 if (j.lt.nres-1) then
7441 if (l.lt.nres-1) then
7449 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
7450 ggg1(ll)=eel4*g_contij(ll,1)
7451 ggg2(ll)=eel4*g_contij(ll,2)
7452 ghalf=0.5d0*ggg1(ll)
7454 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
7455 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7456 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
7457 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7458 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
7459 ghalf=0.5d0*ggg2(ll)
7461 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
7462 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7463 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
7464 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7469 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
7470 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7475 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
7476 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7482 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7487 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7491 cd write (2,*) iii,gcorr_loc(iii)
7495 cd write (2,*) 'ekont',ekont
7496 cd write (iout,*) 'eello4',ekont*eel4
7499 C---------------------------------------------------------------------------
7500 double precision function eello5(i,j,k,l,jj,kk)
7501 implicit real*8 (a-h,o-z)
7502 include 'DIMENSIONS'
7503 include 'sizesclu.dat'
7504 include 'COMMON.IOUNITS'
7505 include 'COMMON.CHAIN'
7506 include 'COMMON.DERIV'
7507 include 'COMMON.INTERACT'
7508 include 'COMMON.CONTACTS'
7509 include 'COMMON.TORSION'
7510 include 'COMMON.VAR'
7511 include 'COMMON.GEO'
7512 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7513 double precision ggg1(3),ggg2(3)
7514 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7519 C /l\ / \ \ / \ / \ / C
7520 C / \ / \ \ / \ / \ / C
7521 C j| o |l1 | o | o| o | | o |o C
7522 C \ |/k\| |/ \| / |/ \| |/ \| C
7523 C \i/ \ / \ / / \ / \ C
7525 C (I) (II) (III) (IV) C
7527 C eello5_1 eello5_2 eello5_3 eello5_4 C
7529 C Antiparallel chains C
7532 C /j\ / \ \ / \ / \ / C
7533 C / \ / \ \ / \ / \ / C
7534 C j1| o |l | o | o| o | | o |o C
7535 C \ |/k\| |/ \| / |/ \| |/ \| C
7536 C \i/ \ / \ / / \ / \ C
7538 C (I) (II) (III) (IV) C
7540 C eello5_1 eello5_2 eello5_3 eello5_4 C
7542 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7544 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7545 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7550 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7552 itk=itortyp(itype(k))
7553 itl=itortyp(itype(l))
7554 itj=itortyp(itype(j))
7559 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7560 cd & eel5_3_num,eel5_4_num)
7564 derx(lll,kkk,iii)=0.0d0
7568 cd eij=facont_hb(jj,i)
7569 cd ekl=facont_hb(kk,k)
7571 cd write (iout,*)'Contacts have occurred for peptide groups',
7572 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7574 C Contribution from the graph I.
7575 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7576 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7577 call transpose2(EUg(1,1,k),auxmat(1,1))
7578 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7579 vv(1)=pizda(1,1)-pizda(2,2)
7580 vv(2)=pizda(1,2)+pizda(2,1)
7581 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7582 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7584 C Explicit gradient in virtual-dihedral angles.
7585 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7586 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7587 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7588 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7589 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7590 vv(1)=pizda(1,1)-pizda(2,2)
7591 vv(2)=pizda(1,2)+pizda(2,1)
7592 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7593 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7594 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7595 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7596 vv(1)=pizda(1,1)-pizda(2,2)
7597 vv(2)=pizda(1,2)+pizda(2,1)
7599 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7600 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7601 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7603 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7604 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7605 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7607 C Cartesian gradient
7611 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7613 vv(1)=pizda(1,1)-pizda(2,2)
7614 vv(2)=pizda(1,2)+pizda(2,1)
7615 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7616 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7617 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7624 C Contribution from graph II
7625 call transpose2(EE(1,1,itk),auxmat(1,1))
7626 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7627 vv(1)=pizda(1,1)+pizda(2,2)
7628 vv(2)=pizda(2,1)-pizda(1,2)
7629 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7630 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7632 C Explicit gradient in virtual-dihedral angles.
7633 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7634 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7635 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7636 vv(1)=pizda(1,1)+pizda(2,2)
7637 vv(2)=pizda(2,1)-pizda(1,2)
7639 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7640 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7641 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7643 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7644 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7645 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7647 C Cartesian gradient
7651 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7653 vv(1)=pizda(1,1)+pizda(2,2)
7654 vv(2)=pizda(2,1)-pizda(1,2)
7655 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7656 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7657 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7666 C Parallel orientation
7667 C Contribution from graph III
7668 call transpose2(EUg(1,1,l),auxmat(1,1))
7669 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7670 vv(1)=pizda(1,1)-pizda(2,2)
7671 vv(2)=pizda(1,2)+pizda(2,1)
7672 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7673 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7675 C Explicit gradient in virtual-dihedral angles.
7676 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7677 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7678 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7679 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7680 vv(1)=pizda(1,1)-pizda(2,2)
7681 vv(2)=pizda(1,2)+pizda(2,1)
7682 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7683 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7684 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7685 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7686 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7687 vv(1)=pizda(1,1)-pizda(2,2)
7688 vv(2)=pizda(1,2)+pizda(2,1)
7689 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7690 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7691 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7692 C Cartesian gradient
7696 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7698 vv(1)=pizda(1,1)-pizda(2,2)
7699 vv(2)=pizda(1,2)+pizda(2,1)
7700 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7701 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7702 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7708 C Contribution from graph IV
7710 call transpose2(EE(1,1,itl),auxmat(1,1))
7711 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7712 vv(1)=pizda(1,1)+pizda(2,2)
7713 vv(2)=pizda(2,1)-pizda(1,2)
7714 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7715 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7717 C Explicit gradient in virtual-dihedral angles.
7718 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7719 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7720 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7721 vv(1)=pizda(1,1)+pizda(2,2)
7722 vv(2)=pizda(2,1)-pizda(1,2)
7723 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7724 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7725 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7726 C Cartesian gradient
7730 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7732 vv(1)=pizda(1,1)+pizda(2,2)
7733 vv(2)=pizda(2,1)-pizda(1,2)
7734 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7735 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7736 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7742 C Antiparallel orientation
7743 C Contribution from graph III
7745 call transpose2(EUg(1,1,j),auxmat(1,1))
7746 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7747 vv(1)=pizda(1,1)-pizda(2,2)
7748 vv(2)=pizda(1,2)+pizda(2,1)
7749 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7750 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7752 C Explicit gradient in virtual-dihedral angles.
7753 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7754 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7755 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7756 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7757 vv(1)=pizda(1,1)-pizda(2,2)
7758 vv(2)=pizda(1,2)+pizda(2,1)
7759 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7760 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7761 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7762 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7763 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7764 vv(1)=pizda(1,1)-pizda(2,2)
7765 vv(2)=pizda(1,2)+pizda(2,1)
7766 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7767 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7768 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7769 C Cartesian gradient
7773 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7775 vv(1)=pizda(1,1)-pizda(2,2)
7776 vv(2)=pizda(1,2)+pizda(2,1)
7777 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7778 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7779 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7785 C Contribution from graph IV
7787 call transpose2(EE(1,1,itj),auxmat(1,1))
7788 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7789 vv(1)=pizda(1,1)+pizda(2,2)
7790 vv(2)=pizda(2,1)-pizda(1,2)
7791 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7792 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7794 C Explicit gradient in virtual-dihedral angles.
7795 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7796 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7797 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7798 vv(1)=pizda(1,1)+pizda(2,2)
7799 vv(2)=pizda(2,1)-pizda(1,2)
7800 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7801 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7802 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7803 C Cartesian gradient
7807 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7809 vv(1)=pizda(1,1)+pizda(2,2)
7810 vv(2)=pizda(2,1)-pizda(1,2)
7811 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7812 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7813 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7820 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7821 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7822 cd write (2,*) 'ijkl',i,j,k,l
7823 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7824 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7826 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7827 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7828 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7829 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7831 if (j.lt.nres-1) then
7838 if (l.lt.nres-1) then
7848 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7850 ggg1(ll)=eel5*g_contij(ll,1)
7851 ggg2(ll)=eel5*g_contij(ll,2)
7852 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7853 ghalf=0.5d0*ggg1(ll)
7855 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
7856 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7857 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
7858 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7859 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7860 ghalf=0.5d0*ggg2(ll)
7862 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7863 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7864 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7865 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7870 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7871 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7876 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7877 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7883 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7888 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7892 cd write (2,*) iii,g_corr5_loc(iii)
7896 cd write (2,*) 'ekont',ekont
7897 cd write (iout,*) 'eello5',ekont*eel5
7900 c--------------------------------------------------------------------------
7901 double precision function eello6(i,j,k,l,jj,kk)
7902 implicit real*8 (a-h,o-z)
7903 include 'DIMENSIONS'
7904 include 'sizesclu.dat'
7905 include 'COMMON.IOUNITS'
7906 include 'COMMON.CHAIN'
7907 include 'COMMON.DERIV'
7908 include 'COMMON.INTERACT'
7909 include 'COMMON.CONTACTS'
7910 include 'COMMON.TORSION'
7911 include 'COMMON.VAR'
7912 include 'COMMON.GEO'
7913 include 'COMMON.FFIELD'
7914 double precision ggg1(3),ggg2(3)
7915 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7920 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7928 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7929 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7933 derx(lll,kkk,iii)=0.0d0
7937 cd eij=facont_hb(jj,i)
7938 cd ekl=facont_hb(kk,k)
7944 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7945 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7946 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7947 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7948 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7949 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7951 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7952 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7953 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7954 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7955 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7956 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7960 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7962 C If turn contributions are considered, they will be handled separately.
7963 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7964 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7965 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7966 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7967 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7968 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7969 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7972 if (j.lt.nres-1) then
7979 if (l.lt.nres-1) then
7987 ggg1(ll)=eel6*g_contij(ll,1)
7988 ggg2(ll)=eel6*g_contij(ll,2)
7989 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7990 ghalf=0.5d0*ggg1(ll)
7992 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
7993 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7994 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
7995 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7996 ghalf=0.5d0*ggg2(ll)
7997 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7999 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
8000 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8001 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
8002 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8007 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8008 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8013 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8014 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8020 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8025 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8029 cd write (2,*) iii,g_corr6_loc(iii)
8033 cd write (2,*) 'ekont',ekont
8034 cd write (iout,*) 'eello6',ekont*eel6
8037 c--------------------------------------------------------------------------
8038 double precision function eello6_graph1(i,j,k,l,imat,swap)
8039 implicit real*8 (a-h,o-z)
8040 include 'DIMENSIONS'
8041 include 'sizesclu.dat'
8042 include 'COMMON.IOUNITS'
8043 include 'COMMON.CHAIN'
8044 include 'COMMON.DERIV'
8045 include 'COMMON.INTERACT'
8046 include 'COMMON.CONTACTS'
8047 include 'COMMON.TORSION'
8048 include 'COMMON.VAR'
8049 include 'COMMON.GEO'
8050 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8054 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8056 C Parallel Antiparallel C
8062 C \ j|/k\| / \ |/k\|l / C
8067 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8068 itk=itortyp(itype(k))
8069 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8070 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8071 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8072 call transpose2(EUgC(1,1,k),auxmat(1,1))
8073 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8074 vv1(1)=pizda1(1,1)-pizda1(2,2)
8075 vv1(2)=pizda1(1,2)+pizda1(2,1)
8076 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8077 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8078 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8079 s5=scalar2(vv(1),Dtobr2(1,i))
8080 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8081 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8082 if (.not. calc_grad) return
8083 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8084 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8085 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8086 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8087 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8088 & +scalar2(vv(1),Dtobr2der(1,i)))
8089 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8090 vv1(1)=pizda1(1,1)-pizda1(2,2)
8091 vv1(2)=pizda1(1,2)+pizda1(2,1)
8092 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8093 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8095 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8096 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8097 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8098 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8099 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8101 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8102 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8103 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8104 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8105 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8107 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8108 call matmat2(AEA(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 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8112 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8113 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8114 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8123 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8124 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8125 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8126 call transpose2(EUgC(1,1,k),auxmat(1,1))
8127 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8129 vv1(1)=pizda1(1,1)-pizda1(2,2)
8130 vv1(2)=pizda1(1,2)+pizda1(2,1)
8131 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8132 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8133 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8134 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8135 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8136 s5=scalar2(vv(1),Dtobr2(1,i))
8137 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8143 c----------------------------------------------------------------------------
8144 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8145 implicit real*8 (a-h,o-z)
8146 include 'DIMENSIONS'
8147 include 'sizesclu.dat'
8148 include 'COMMON.IOUNITS'
8149 include 'COMMON.CHAIN'
8150 include 'COMMON.DERIV'
8151 include 'COMMON.INTERACT'
8152 include 'COMMON.CONTACTS'
8153 include 'COMMON.TORSION'
8154 include 'COMMON.VAR'
8155 include 'COMMON.GEO'
8157 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8158 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8161 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8163 C Parallel Antiparallel C
8169 C \ j|/k\| \ |/k\|l C
8174 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8175 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8176 C AL 7/4/01 s1 would occur in the sixth-order moment,
8177 C but not in a cluster cumulant
8179 s1=dip(1,jj,i)*dip(1,kk,k)
8181 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8182 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8183 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8184 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8185 call transpose2(EUg(1,1,k),auxmat(1,1))
8186 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8187 vv(1)=pizda(1,1)-pizda(2,2)
8188 vv(2)=pizda(1,2)+pizda(2,1)
8189 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8190 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8192 eello6_graph2=-(s1+s2+s3+s4)
8194 eello6_graph2=-(s2+s3+s4)
8197 if (.not. calc_grad) return
8198 C Derivatives in gamma(i-1)
8201 s1=dipderg(1,jj,i)*dip(1,kk,k)
8203 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8204 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8205 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8206 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8208 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8210 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8212 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8214 C Derivatives in gamma(k-1)
8216 s1=dip(1,jj,i)*dipderg(1,kk,k)
8218 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8219 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8220 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8221 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8222 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8223 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8224 vv(1)=pizda(1,1)-pizda(2,2)
8225 vv(2)=pizda(1,2)+pizda(2,1)
8226 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8228 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8230 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8232 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8233 C Derivatives in gamma(j-1) or gamma(l-1)
8236 s1=dipderg(3,jj,i)*dip(1,kk,k)
8238 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8239 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8240 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8241 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8242 vv(1)=pizda(1,1)-pizda(2,2)
8243 vv(2)=pizda(1,2)+pizda(2,1)
8244 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8247 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8249 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8252 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8253 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8255 C Derivatives in gamma(l-1) or gamma(j-1)
8258 s1=dip(1,jj,i)*dipderg(3,kk,k)
8260 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8261 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8262 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8263 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8264 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8265 vv(1)=pizda(1,1)-pizda(2,2)
8266 vv(2)=pizda(1,2)+pizda(2,1)
8267 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8270 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8272 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8275 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8276 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8278 C Cartesian derivatives.
8280 write (2,*) 'In eello6_graph2'
8282 write (2,*) 'iii=',iii
8284 write (2,*) 'kkk=',kkk
8286 write (2,'(3(2f10.5),5x)')
8287 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8297 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8299 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8302 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8304 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8305 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8307 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8308 call transpose2(EUg(1,1,k),auxmat(1,1))
8309 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8311 vv(1)=pizda(1,1)-pizda(2,2)
8312 vv(2)=pizda(1,2)+pizda(2,1)
8313 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8314 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8316 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8318 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8321 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8323 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8330 c----------------------------------------------------------------------------
8331 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8332 implicit real*8 (a-h,o-z)
8333 include 'DIMENSIONS'
8334 include 'sizesclu.dat'
8335 include 'COMMON.IOUNITS'
8336 include 'COMMON.CHAIN'
8337 include 'COMMON.DERIV'
8338 include 'COMMON.INTERACT'
8339 include 'COMMON.CONTACTS'
8340 include 'COMMON.TORSION'
8341 include 'COMMON.VAR'
8342 include 'COMMON.GEO'
8343 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8345 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8347 C Parallel Antiparallel C
8353 C j|/k\| / |/k\|l / C
8358 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8360 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8361 C energy moment and not to the cluster cumulant.
8362 iti=itortyp(itype(i))
8363 c if (j.lt.nres-1) then
8364 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
8365 itj1=itortyp(itype(j+1))
8369 itk=itortyp(itype(k))
8370 itk1=itortyp(itype(k+1))
8371 c if (l.lt.nres-1) then
8372 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
8373 itl1=itortyp(itype(l+1))
8378 s1=dip(4,jj,i)*dip(4,kk,k)
8380 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8381 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8382 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8383 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8384 call transpose2(EE(1,1,itk),auxmat(1,1))
8385 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8386 vv(1)=pizda(1,1)+pizda(2,2)
8387 vv(2)=pizda(2,1)-pizda(1,2)
8388 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8389 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8391 eello6_graph3=-(s1+s2+s3+s4)
8393 eello6_graph3=-(s2+s3+s4)
8396 if (.not. calc_grad) return
8397 C Derivatives in gamma(k-1)
8398 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8399 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8400 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8401 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8402 C Derivatives in gamma(l-1)
8403 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8404 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8405 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8406 vv(1)=pizda(1,1)+pizda(2,2)
8407 vv(2)=pizda(2,1)-pizda(1,2)
8408 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8409 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8410 C Cartesian derivatives.
8416 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8418 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8421 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8423 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8424 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8426 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8427 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8429 vv(1)=pizda(1,1)+pizda(2,2)
8430 vv(2)=pizda(2,1)-pizda(1,2)
8431 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8433 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8435 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8438 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8440 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8442 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8448 c----------------------------------------------------------------------------
8449 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8450 implicit real*8 (a-h,o-z)
8451 include 'DIMENSIONS'
8452 include 'sizesclu.dat'
8453 include 'COMMON.IOUNITS'
8454 include 'COMMON.CHAIN'
8455 include 'COMMON.DERIV'
8456 include 'COMMON.INTERACT'
8457 include 'COMMON.CONTACTS'
8458 include 'COMMON.TORSION'
8459 include 'COMMON.VAR'
8460 include 'COMMON.GEO'
8461 include 'COMMON.FFIELD'
8462 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8463 & auxvec1(2),auxmat1(2,2)
8465 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8467 C Parallel Antiparallel C
8473 C \ j|/k\| \ |/k\|l C
8478 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8480 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8481 C energy moment and not to the cluster cumulant.
8482 cd write (2,*) 'eello_graph4: wturn6',wturn6
8483 iti=itortyp(itype(i))
8484 itj=itortyp(itype(j))
8485 c if (j.lt.nres-1) then
8486 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
8487 itj1=itortyp(itype(j+1))
8491 itk=itortyp(itype(k))
8492 c if (k.lt.nres-1) then
8493 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
8494 itk1=itortyp(itype(k+1))
8498 itl=itortyp(itype(l))
8499 if (l.lt.nres-1) then
8500 itl1=itortyp(itype(l+1))
8504 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8505 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8506 cd & ' itl',itl,' itl1',itl1
8509 s1=dip(3,jj,i)*dip(3,kk,k)
8511 s1=dip(2,jj,j)*dip(2,kk,l)
8514 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8515 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8517 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8518 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8520 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8521 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8523 call transpose2(EUg(1,1,k),auxmat(1,1))
8524 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8525 vv(1)=pizda(1,1)-pizda(2,2)
8526 vv(2)=pizda(2,1)+pizda(1,2)
8527 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8528 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8530 eello6_graph4=-(s1+s2+s3+s4)
8532 eello6_graph4=-(s2+s3+s4)
8534 if (.not. calc_grad) return
8535 C Derivatives in gamma(i-1)
8539 s1=dipderg(2,jj,i)*dip(3,kk,k)
8541 s1=dipderg(4,jj,j)*dip(2,kk,l)
8544 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8546 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8547 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8549 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8550 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8552 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8553 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8554 cd write (2,*) 'turn6 derivatives'
8556 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8558 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8562 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8564 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8568 C Derivatives in gamma(k-1)
8571 s1=dip(3,jj,i)*dipderg(2,kk,k)
8573 s1=dip(2,jj,j)*dipderg(4,kk,l)
8576 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8577 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8579 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8580 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8582 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8583 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8585 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8586 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8587 vv(1)=pizda(1,1)-pizda(2,2)
8588 vv(2)=pizda(2,1)+pizda(1,2)
8589 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8590 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8592 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8594 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8598 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8600 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8603 C Derivatives in gamma(j-1) or gamma(l-1)
8604 if (l.eq.j+1 .and. l.gt.1) then
8605 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8606 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8607 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8608 vv(1)=pizda(1,1)-pizda(2,2)
8609 vv(2)=pizda(2,1)+pizda(1,2)
8610 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8611 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8612 else if (j.gt.1) then
8613 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8614 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8615 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8616 vv(1)=pizda(1,1)-pizda(2,2)
8617 vv(2)=pizda(2,1)+pizda(1,2)
8618 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8619 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8620 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8622 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8625 C Cartesian derivatives.
8632 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8634 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8638 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8640 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8644 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8646 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8648 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8649 & b1(1,itj1),auxvec(1))
8650 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8652 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8653 & b1(1,itl1),auxvec(1))
8654 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8656 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8658 vv(1)=pizda(1,1)-pizda(2,2)
8659 vv(2)=pizda(2,1)+pizda(1,2)
8660 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8662 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8664 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8667 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8670 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8673 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8675 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8677 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8681 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8683 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8686 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8688 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8696 c----------------------------------------------------------------------------
8697 double precision function eello_turn6(i,jj,kk)
8698 implicit real*8 (a-h,o-z)
8699 include 'DIMENSIONS'
8700 include 'sizesclu.dat'
8701 include 'COMMON.IOUNITS'
8702 include 'COMMON.CHAIN'
8703 include 'COMMON.DERIV'
8704 include 'COMMON.INTERACT'
8705 include 'COMMON.CONTACTS'
8706 include 'COMMON.TORSION'
8707 include 'COMMON.VAR'
8708 include 'COMMON.GEO'
8709 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8710 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8712 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8713 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8714 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8715 C the respective energy moment and not to the cluster cumulant.
8720 iti=itortyp(itype(i))
8721 itk=itortyp(itype(k))
8722 itk1=itortyp(itype(k+1))
8723 itl=itortyp(itype(l))
8724 itj=itortyp(itype(j))
8725 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8726 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8727 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8732 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8734 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8738 derx_turn(lll,kkk,iii)=0.0d0
8745 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8747 cd write (2,*) 'eello6_5',eello6_5
8749 call transpose2(AEA(1,1,1),auxmat(1,1))
8750 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8751 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8752 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8756 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8757 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8758 s2 = scalar2(b1(1,itk),vtemp1(1))
8760 call transpose2(AEA(1,1,2),atemp(1,1))
8761 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8762 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8763 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8767 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8768 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8769 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8771 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8772 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8773 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8774 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8775 ss13 = scalar2(b1(1,itk),vtemp4(1))
8776 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8780 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8786 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8788 C Derivatives in gamma(i+2)
8790 call transpose2(AEA(1,1,1),auxmatd(1,1))
8791 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8792 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8793 call transpose2(AEAderg(1,1,2),atempd(1,1))
8794 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8795 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8799 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8800 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8801 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8807 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8808 C Derivatives in gamma(i+3)
8810 call transpose2(AEA(1,1,1),auxmatd(1,1))
8811 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8812 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8813 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8817 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8818 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8819 s2d = scalar2(b1(1,itk),vtemp1d(1))
8821 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8822 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8824 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8826 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8827 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8828 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8838 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8839 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8841 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8842 & -0.5d0*ekont*(s2d+s12d)
8844 C Derivatives in gamma(i+4)
8845 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8846 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8847 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8849 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8850 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8851 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8861 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8863 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8865 C Derivatives in gamma(i+5)
8867 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8868 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8869 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8873 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8874 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8875 s2d = scalar2(b1(1,itk),vtemp1d(1))
8877 call transpose2(AEA(1,1,2),atempd(1,1))
8878 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8879 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8883 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8884 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8886 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8887 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8888 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8898 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8899 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8901 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8902 & -0.5d0*ekont*(s2d+s12d)
8904 C Cartesian derivatives
8909 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8910 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8911 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8915 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8916 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8918 s2d = scalar2(b1(1,itk),vtemp1d(1))
8920 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8921 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8922 s8d = -(atempd(1,1)+atempd(2,2))*
8923 & scalar2(cc(1,1,itl),vtemp2(1))
8927 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8929 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8930 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8937 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8940 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8944 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8945 & - 0.5d0*(s8d+s12d)
8947 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8956 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8958 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8959 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8960 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8961 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8962 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8964 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8965 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8966 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8970 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8971 cd & 16*eel_turn6_num
8973 if (j.lt.nres-1) then
8980 if (l.lt.nres-1) then
8988 ggg1(ll)=eel_turn6*g_contij(ll,1)
8989 ggg2(ll)=eel_turn6*g_contij(ll,2)
8990 ghalf=0.5d0*ggg1(ll)
8992 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
8993 & +ekont*derx_turn(ll,2,1)
8994 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8995 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
8996 & +ekont*derx_turn(ll,4,1)
8997 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8998 ghalf=0.5d0*ggg2(ll)
9000 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
9001 & +ekont*derx_turn(ll,2,2)
9002 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9003 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
9004 & +ekont*derx_turn(ll,4,2)
9005 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9010 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9015 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9021 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9026 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9030 cd write (2,*) iii,g_corr6_loc(iii)
9033 eello_turn6=ekont*eel_turn6
9034 cd write (2,*) 'ekont',ekont
9035 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9038 crc-------------------------------------------------
9039 SUBROUTINE MATVEC2(A1,V1,V2)
9040 implicit real*8 (a-h,o-z)
9041 include 'DIMENSIONS'
9042 DIMENSION A1(2,2),V1(2),V2(2)
9046 c 3 VI=VI+A1(I,K)*V1(K)
9050 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9051 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9056 C---------------------------------------
9057 SUBROUTINE MATMAT2(A1,A2,A3)
9058 implicit real*8 (a-h,o-z)
9059 include 'DIMENSIONS'
9060 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9061 c DIMENSION AI3(2,2)
9065 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9071 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9072 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9073 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9074 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9082 c-------------------------------------------------------------------------
9083 double precision function scalar2(u,v)
9085 double precision u(2),v(2)
9088 scalar2=u(1)*v(1)+u(2)*v(2)
9092 C-----------------------------------------------------------------------------
9094 subroutine transpose2(a,at)
9096 double precision a(2,2),at(2,2)
9103 c--------------------------------------------------------------------------
9104 subroutine transpose(n,a,at)
9107 double precision a(n,n),at(n,n)
9115 C---------------------------------------------------------------------------
9116 subroutine prodmat3(a1,a2,kk,transp,prod)
9119 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9121 crc double precision auxmat(2,2),prod_(2,2)
9124 crc call transpose2(kk(1,1),auxmat(1,1))
9125 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9126 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9128 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9129 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9130 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9131 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9132 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9133 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9134 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9135 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9138 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9139 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9141 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9142 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9143 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9144 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9145 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9146 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9147 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9148 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9151 c call transpose2(a2(1,1),a2t(1,1))
9154 crc print *,((prod_(i,j),i=1,2),j=1,2)
9155 crc print *,((prod(i,j),i=1,2),j=1,2)
9159 C-----------------------------------------------------------------------------
9160 double precision function scalar(u,v)
9162 double precision u(3),v(3)
9172 C-----------------------------------------------------------------------
9173 double precision function sscale(r)
9174 double precision r,gamm
9175 include "COMMON.SPLITELE"
9176 if(r.lt.r_cut-rlamb) then
9178 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9179 gamm=(r-(r_cut-rlamb))/rlamb
9180 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
9186 C-----------------------------------------------------------------------
9187 C-----------------------------------------------------------------------
9188 double precision function sscagrad(r)
9189 double precision r,gamm
9190 include "COMMON.SPLITELE"
9191 if(r.lt.r_cut-rlamb) then
9193 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9194 gamm=(r-(r_cut-rlamb))/rlamb
9195 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
9201 C-----------------------------------------------------------------------
9202 C first for shielding is setting of function of side-chains
9203 subroutine set_shield_fac2
9204 implicit real*8 (a-h,o-z)
9205 include 'DIMENSIONS'
9206 include 'COMMON.CHAIN'
9207 include 'COMMON.DERIV'
9208 include 'COMMON.IOUNITS'
9209 include 'COMMON.SHIELD'
9210 include 'COMMON.INTERACT'
9211 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
9212 double precision div77_81/0.974996043d0/,
9213 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
9215 C the vector between center of side_chain and peptide group
9216 double precision pep_side(3),long,side_calf(3),
9217 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
9218 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
9219 C the line belowe needs to be changed for FGPROC>1
9221 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
9223 Cif there two consequtive dummy atoms there is no peptide group between them
9224 C the line below has to be changed for FGPROC>1
9227 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
9231 C first lets set vector conecting the ithe side-chain with kth side-chain
9232 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
9234 C and vector conecting the side-chain with its proper calfa
9235 side_calf(j)=c(j,k+nres)-c(j,k)
9236 C side_calf(j)=2.0d0
9237 pept_group(j)=c(j,i)-c(j,i+1)
9238 C lets have their lenght
9239 dist_pep_side=pep_side(j)**2+dist_pep_side
9240 dist_side_calf=dist_side_calf+side_calf(j)**2
9241 dist_pept_group=dist_pept_group+pept_group(j)**2
9243 dist_pep_side=dsqrt(dist_pep_side)
9244 dist_pept_group=dsqrt(dist_pept_group)
9245 dist_side_calf=dsqrt(dist_side_calf)
9247 pep_side_norm(j)=pep_side(j)/dist_pep_side
9248 side_calf_norm(j)=dist_side_calf
9250 C now sscale fraction
9251 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
9252 C print *,buff_shield,"buff"
9254 if (sh_frac_dist.le.0.0) cycle
9255 C If we reach here it means that this side chain reaches the shielding sphere
9256 C Lets add him to the list for gradient
9257 ishield_list(i)=ishield_list(i)+1
9258 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
9259 C this list is essential otherwise problem would be O3
9260 shield_list(ishield_list(i),i)=k
9261 C Lets have the sscale value
9262 if (sh_frac_dist.gt.1.0) then
9263 scale_fac_dist=1.0d0
9265 sh_frac_dist_grad(j)=0.0d0
9268 scale_fac_dist=-sh_frac_dist*sh_frac_dist
9269 & *(2.0d0*sh_frac_dist-3.0d0)
9270 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
9271 & /dist_pep_side/buff_shield*0.5d0
9272 C remember for the final gradient multiply sh_frac_dist_grad(j)
9273 C for side_chain by factor -2 !
9275 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
9276 C sh_frac_dist_grad(j)=0.0d0
9277 C scale_fac_dist=1.0d0
9278 C print *,"jestem",scale_fac_dist,fac_help_scale,
9279 C & sh_frac_dist_grad(j)
9282 C this is what is now we have the distance scaling now volume...
9283 short=short_r_sidechain(itype(k))
9284 long=long_r_sidechain(itype(k))
9285 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
9286 sinthet=short/dist_pep_side*costhet
9290 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
9291 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
9292 C & -short/dist_pep_side**2/costhet)
9295 costhet_grad(j)=costhet_fac*pep_side(j)
9297 C remember for the final gradient multiply costhet_grad(j)
9298 C for side_chain by factor -2 !
9299 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9300 C pep_side0pept_group is vector multiplication
9301 pep_side0pept_group=0.0d0
9303 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9305 cosalfa=(pep_side0pept_group/
9306 & (dist_pep_side*dist_side_calf))
9307 fac_alfa_sin=1.0d0-cosalfa**2
9308 fac_alfa_sin=dsqrt(fac_alfa_sin)
9309 rkprim=fac_alfa_sin*(long-short)+short
9313 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
9315 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
9316 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
9320 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9321 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
9322 &*(long-short)/fac_alfa_sin*cosalfa/
9323 &((dist_pep_side*dist_side_calf))*
9324 &((side_calf(j))-cosalfa*
9325 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9326 C cosphi_grad_long(j)=0.0d0
9327 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
9328 &*(long-short)/fac_alfa_sin*cosalfa
9329 &/((dist_pep_side*dist_side_calf))*
9331 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9332 C cosphi_grad_loc(j)=0.0d0
9334 C print *,sinphi,sinthet
9335 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
9338 C now the gradient...
9340 grad_shield(j,i)=grad_shield(j,i)
9341 C gradient po skalowaniu
9342 & +(sh_frac_dist_grad(j)*VofOverlap
9343 C gradient po costhet
9344 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
9345 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9346 & sinphi/sinthet*costhet*costhet_grad(j)
9347 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9349 C grad_shield_side is Cbeta sidechain gradient
9350 grad_shield_side(j,ishield_list(i),i)=
9351 & (sh_frac_dist_grad(j)*(-2.0d0)
9353 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9354 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9355 & sinphi/sinthet*costhet*costhet_grad(j)
9356 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9359 grad_shield_loc(j,ishield_list(i),i)=
9360 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9361 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
9362 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
9366 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9368 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
9369 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
9373 C first for shielding is setting of function of side-chains
9374 subroutine set_shield_fac
9375 implicit real*8 (a-h,o-z)
9376 include 'DIMENSIONS'
9377 include 'COMMON.CHAIN'
9378 include 'COMMON.DERIV'
9379 include 'COMMON.IOUNITS'
9380 include 'COMMON.SHIELD'
9381 include 'COMMON.INTERACT'
9382 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
9383 double precision div77_81/0.974996043d0/,
9384 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
9386 C the vector between center of side_chain and peptide group
9387 double precision pep_side(3),long,side_calf(3),
9388 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
9389 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
9390 C the line belowe needs to be changed for FGPROC>1
9392 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
9394 Cif there two consequtive dummy atoms there is no peptide group between them
9395 C the line below has to be changed for FGPROC>1
9398 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
9402 C first lets set vector conecting the ithe side-chain with kth side-chain
9403 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
9405 C and vector conecting the side-chain with its proper calfa
9406 side_calf(j)=c(j,k+nres)-c(j,k)
9407 C side_calf(j)=2.0d0
9408 pept_group(j)=c(j,i)-c(j,i+1)
9409 C lets have their lenght
9410 dist_pep_side=pep_side(j)**2+dist_pep_side
9411 dist_side_calf=dist_side_calf+side_calf(j)**2
9412 dist_pept_group=dist_pept_group+pept_group(j)**2
9414 dist_pep_side=dsqrt(dist_pep_side)
9415 dist_pept_group=dsqrt(dist_pept_group)
9416 dist_side_calf=dsqrt(dist_side_calf)
9418 pep_side_norm(j)=pep_side(j)/dist_pep_side
9419 side_calf_norm(j)=dist_side_calf
9421 C now sscale fraction
9422 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
9423 C print *,buff_shield,"buff"
9425 if (sh_frac_dist.le.0.0) cycle
9426 C If we reach here it means that this side chain reaches the shielding sphere
9427 C Lets add him to the list for gradient
9428 ishield_list(i)=ishield_list(i)+1
9429 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
9430 C this list is essential otherwise problem would be O3
9431 shield_list(ishield_list(i),i)=k
9432 C Lets have the sscale value
9433 if (sh_frac_dist.gt.1.0) then
9434 scale_fac_dist=1.0d0
9436 sh_frac_dist_grad(j)=0.0d0
9439 scale_fac_dist=-sh_frac_dist*sh_frac_dist
9440 & *(2.0*sh_frac_dist-3.0d0)
9441 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
9442 & /dist_pep_side/buff_shield*0.5
9443 C remember for the final gradient multiply sh_frac_dist_grad(j)
9444 C for side_chain by factor -2 !
9446 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
9447 C print *,"jestem",scale_fac_dist,fac_help_scale,
9448 C & sh_frac_dist_grad(j)
9451 C if ((i.eq.3).and.(k.eq.2)) then
9452 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
9456 C this is what is now we have the distance scaling now volume...
9457 short=short_r_sidechain(itype(k))
9458 long=long_r_sidechain(itype(k))
9459 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
9462 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
9465 costhet_grad(j)=costhet_fac*pep_side(j)
9467 C remember for the final gradient multiply costhet_grad(j)
9468 C for side_chain by factor -2 !
9469 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9470 C pep_side0pept_group is vector multiplication
9471 pep_side0pept_group=0.0
9473 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9475 cosalfa=(pep_side0pept_group/
9476 & (dist_pep_side*dist_side_calf))
9477 fac_alfa_sin=1.0-cosalfa**2
9478 fac_alfa_sin=dsqrt(fac_alfa_sin)
9479 rkprim=fac_alfa_sin*(long-short)+short
9481 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
9482 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
9485 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9486 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9487 &*(long-short)/fac_alfa_sin*cosalfa/
9488 &((dist_pep_side*dist_side_calf))*
9489 &((side_calf(j))-cosalfa*
9490 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9492 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9493 &*(long-short)/fac_alfa_sin*cosalfa
9494 &/((dist_pep_side*dist_side_calf))*
9496 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9499 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
9502 C now the gradient...
9503 C grad_shield is gradient of Calfa for peptide groups
9504 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
9506 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
9507 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
9509 grad_shield(j,i)=grad_shield(j,i)
9510 C gradient po skalowaniu
9511 & +(sh_frac_dist_grad(j)
9512 C gradient po costhet
9513 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
9514 &-scale_fac_dist*(cosphi_grad_long(j))
9515 &/(1.0-cosphi) )*div77_81
9517 C grad_shield_side is Cbeta sidechain gradient
9518 grad_shield_side(j,ishield_list(i),i)=
9519 & (sh_frac_dist_grad(j)*(-2.0d0)
9520 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
9521 & +scale_fac_dist*(cosphi_grad_long(j))
9522 & *2.0d0/(1.0-cosphi))
9523 & *div77_81*VofOverlap
9525 grad_shield_loc(j,ishield_list(i),i)=
9526 & scale_fac_dist*cosphi_grad_loc(j)
9527 & *2.0d0/(1.0-cosphi)
9528 & *div77_81*VofOverlap
9530 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9532 fac_shield(i)=VolumeTotal*div77_81+div4_81
9533 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
9537 C--------------------------------------------------------------------------
9538 C-----------------------------------------------------------------------
9539 double precision function sscalelip(r)
9540 double precision r,gamm
9541 include "COMMON.SPLITELE"
9542 C if(r.lt.r_cut-rlamb) then
9544 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9545 C gamm=(r-(r_cut-rlamb))/rlamb
9546 sscalelip=1.0d0+r*r*(2*r-3.0d0)
9552 C-----------------------------------------------------------------------
9553 double precision function sscagradlip(r)
9554 double precision r,gamm
9555 include "COMMON.SPLITELE"
9556 C if(r.lt.r_cut-rlamb) then
9558 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9559 C gamm=(r-(r_cut-rlamb))/rlamb
9560 sscagradlip=r*(6*r-6.0d0)
9566 c----------------------------------------------------------------------------
9567 double precision function sscale2(r,r_cut,r0,rlamb)
9569 double precision r,gamm,r_cut,r0,rlamb,rr
9571 c write (2,*) "r",r," r_cut",r_cut," r0",r0," rlamb",rlamb
9572 c write (2,*) "rr",rr
9573 if(rr.lt.r_cut-rlamb) then
9575 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
9576 gamm=(rr-(r_cut-rlamb))/rlamb
9577 sscale2=1.0d0+gamm*gamm*(2*gamm-3.0d0)
9583 C-----------------------------------------------------------------------
9584 double precision function sscalgrad2(r,r_cut,r0,rlamb)
9586 double precision r,gamm,r_cut,r0,rlamb,rr
9588 if(rr.lt.r_cut-rlamb) then
9590 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
9591 gamm=(rr-(r_cut-rlamb))/rlamb
9593 sscalgrad2=gamm*(6*gamm-6.0d0)/rlamb
9595 sscalgrad2=-gamm*(6*gamm-6.0d0)/rlamb
9602 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9603 subroutine Eliptransfer(eliptran)
9604 implicit real*8 (a-h,o-z)
9605 include 'DIMENSIONS'
9606 include 'COMMON.GEO'
9607 include 'COMMON.VAR'
9608 include 'COMMON.LOCAL'
9609 include 'COMMON.CHAIN'
9610 include 'COMMON.DERIV'
9611 include 'COMMON.INTERACT'
9612 include 'COMMON.IOUNITS'
9613 include 'COMMON.CALC'
9614 include 'COMMON.CONTROL'
9615 include 'COMMON.SPLITELE'
9616 include 'COMMON.SBRIDGE'
9617 C this is done by Adasko
9621 C--bordliptop-- buffore starts
9622 C--bufliptop--- here true lipid starts
9624 C--buflipbot--- lipid ends buffore starts
9625 C--bordlipbot--buffore ends
9627 write(iout,*) "I am in?"
9630 if (itype(i).eq.ntyp1) cycle
9632 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
9633 if (positi.le.0) positi=positi+boxzsize
9635 C first for peptide groups
9636 c for each residue check if it is in lipid or lipid water border area
9637 if ((positi.gt.bordlipbot)
9638 &.and.(positi.lt.bordliptop)) then
9639 C the energy transfer exist
9640 if (positi.lt.buflipbot) then
9641 C what fraction I am in
9643 & ((positi-bordlipbot)/lipbufthick)
9644 C lipbufthick is thickenes of lipid buffore
9645 sslip=sscalelip(fracinbuf)
9646 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9647 eliptran=eliptran+sslip*pepliptran
9648 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
9649 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
9650 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
9651 elseif (positi.gt.bufliptop) then
9652 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
9653 sslip=sscalelip(fracinbuf)
9654 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9655 eliptran=eliptran+sslip*pepliptran
9656 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
9657 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
9658 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
9659 C print *, "doing sscalefor top part"
9660 C print *,i,sslip,fracinbuf,ssgradlip
9662 eliptran=eliptran+pepliptran
9663 C print *,"I am in true lipid"
9666 C eliptran=elpitran+0.0 ! I am in water
9669 C print *, "nic nie bylo w lipidzie?"
9670 C now multiply all by the peptide group transfer factor
9671 C eliptran=eliptran*pepliptran
9672 C now the same for side chains
9675 if (itype(i).eq.ntyp1) cycle
9676 positi=(mod(c(3,i+nres),boxzsize))
9677 if (positi.le.0) positi=positi+boxzsize
9678 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
9679 c for each residue check if it is in lipid or lipid water border area
9680 C respos=mod(c(3,i+nres),boxzsize)
9681 C print *,positi,bordlipbot,buflipbot
9682 if ((positi.gt.bordlipbot)
9683 & .and.(positi.lt.bordliptop)) then
9684 C the energy transfer exist
9685 if (positi.lt.buflipbot) then
9687 & ((positi-bordlipbot)/lipbufthick)
9688 C lipbufthick is thickenes of lipid buffore
9689 sslip=sscalelip(fracinbuf)
9690 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9691 eliptran=eliptran+sslip*liptranene(itype(i))
9692 gliptranx(3,i)=gliptranx(3,i)
9693 &+ssgradlip*liptranene(itype(i))
9694 gliptranc(3,i-1)= gliptranc(3,i-1)
9695 &+ssgradlip*liptranene(itype(i))
9696 C print *,"doing sccale for lower part"
9697 elseif (positi.gt.bufliptop) then
9699 &((bordliptop-positi)/lipbufthick)
9700 sslip=sscalelip(fracinbuf)
9701 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9702 eliptran=eliptran+sslip*liptranene(itype(i))
9703 gliptranx(3,i)=gliptranx(3,i)
9704 &+ssgradlip*liptranene(itype(i))
9705 gliptranc(3,i-1)= gliptranc(3,i-1)
9706 &+ssgradlip*liptranene(itype(i))
9707 C print *, "doing sscalefor top part",sslip,fracinbuf
9709 eliptran=eliptran+liptranene(itype(i))
9710 C print *,"I am in true lipid"
9712 endif ! if in lipid or buffor
9714 C eliptran=elpitran+0.0 ! I am in water
9718 c----------------------------------------------------------------------------
9719 subroutine e_saxs(Esaxs_constr)
9721 include 'DIMENSIONS'
9724 include "COMMON.SETUP"
9727 include 'COMMON.SBRIDGE'
9728 include 'COMMON.CHAIN'
9729 include 'COMMON.GEO'
9730 include 'COMMON.LOCAL'
9731 include 'COMMON.INTERACT'
9732 include 'COMMON.VAR'
9733 include 'COMMON.IOUNITS'
9734 include 'COMMON.DERIV'
9735 include 'COMMON.CONTROL'
9736 include 'COMMON.NAMES'
9737 include 'COMMON.FFIELD'
9738 include 'COMMON.LANGEVIN'
9740 double precision Esaxs_constr
9741 integer i,iint,j,k,l
9742 double precision PgradC(maxSAXS,3,maxres),
9743 & PgradX(maxSAXS,3,maxres),Pcalc(maxSAXS)
9745 double precision PgradC_(maxSAXS,3,maxres),
9746 & PgradX_(maxSAXS,3,maxres),Pcalc_(maxSAXS)
9748 double precision dk,dijCACA,dijCASC,dijSCCA,dijSCSC,
9749 & sigma2CACA,sigma2CASC,sigma2SCCA,sigma2SCSC,expCACA,expCASC,
9750 & expSCCA,expSCSC,CASCgrad,SCCAgrad,SCSCgrad,aux,auxC,auxC1,
9751 & auxX,auxX1,CACAgrad,Cnorm
9752 double precision sss2,ssgrad2,rrr,sscalgrad2,sscale2
9753 double precision dist
9755 c SAXS restraint penalty function
9757 write(iout,*) "------- SAXS penalty function start -------"
9758 write (iout,*) "nsaxs",nsaxs
9759 write (iout,*) "Esaxs: iatsc_s",iatsc_s," iatsc_e",iatsc_e
9760 write (iout,*) "Psaxs"
9762 write (iout,'(i5,e15.5)') i, Psaxs(i)
9765 Esaxs_constr = 0.0d0
9775 do i=iatsc_s,iatsc_e
9776 if (itype(i).eq.ntyp1) cycle
9777 do iint=1,nint_gr(i)
9778 do j=istart(i,iint),iend(i,iint)
9779 if (itype(j).eq.ntyp1) cycle
9782 dijCASC=dist(i,j+nres)
9783 dijSCCA=dist(i+nres,j)
9784 dijSCSC=dist(i+nres,j+nres)
9785 sigma2CACA=2.0d0/(pstok**2)
9786 sigma2CASC=4.0d0/(pstok**2+restok(itype(j))**2)
9787 sigma2SCCA=4.0d0/(pstok**2+restok(itype(i))**2)
9788 sigma2SCSC=4.0d0/(restok(itype(j))**2+restok(itype(i))**2)
9791 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
9792 if (itype(j).ne.10) then
9793 expCASC = dexp(-0.5d0*sigma2CASC*(dijCASC-dk)**2)
9797 if (itype(i).ne.10) then
9798 expSCCA = dexp(-0.5d0*sigma2SCCA*(dijSCCA-dk)**2)
9802 if (itype(i).ne.10 .and. itype(j).ne.10) then
9803 expSCSC = dexp(-0.5d0*sigma2SCSC*(dijSCSC-dk)**2)
9807 Pcalc(k) = Pcalc(k)+expCACA+expCASC+expSCCA+expSCSC
9809 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
9811 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
9812 CASCgrad = sigma2CASC*(dijCASC-dk)*expCASC
9813 SCCAgrad = sigma2SCCA*(dijSCCA-dk)*expSCCA
9814 SCSCgrad = sigma2SCSC*(dijSCSC-dk)*expSCSC
9817 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9818 PgradC(k,l,i) = PgradC(k,l,i)-aux
9819 PgradC(k,l,j) = PgradC(k,l,j)+aux
9821 if (itype(j).ne.10) then
9822 aux = CASCgrad*(C(l,j+nres)-C(l,i))/dijCASC
9823 PgradC(k,l,i) = PgradC(k,l,i)-aux
9824 PgradC(k,l,j) = PgradC(k,l,j)+aux
9825 PgradX(k,l,j) = PgradX(k,l,j)+aux
9828 if (itype(i).ne.10) then
9829 aux = SCCAgrad*(C(l,j)-C(l,i+nres))/dijSCCA
9830 PgradX(k,l,i) = PgradX(k,l,i)-aux
9831 PgradC(k,l,i) = PgradC(k,l,i)-aux
9832 PgradC(k,l,j) = PgradC(k,l,j)+aux
9835 if (itype(i).ne.10 .and. itype(j).ne.10) then
9836 aux = SCSCgrad*(C(l,j+nres)-C(l,i+nres))/dijSCSC
9837 PgradC(k,l,i) = PgradC(k,l,i)-aux
9838 PgradC(k,l,j) = PgradC(k,l,j)+aux
9839 PgradX(k,l,i) = PgradX(k,l,i)-aux
9840 PgradX(k,l,j) = PgradX(k,l,j)+aux
9846 sigma2CACA=scal_rad**2*0.25d0/
9847 & (restok(itype(j))**2+restok(itype(i))**2)
9849 IF (saxs_cutoff.eq.0) THEN
9852 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
9853 Pcalc(k) = Pcalc(k)+expCACA
9854 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
9856 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9857 PgradC(k,l,i) = PgradC(k,l,i)-aux
9858 PgradC(k,l,j) = PgradC(k,l,j)+aux
9862 rrr = saxs_cutoff*2.0d0/dsqrt(sigma2CACA)
9865 c write (2,*) "ijk",i,j,k
9866 sss2 = sscale2(dijCACA,rrr,dk,0.3d0)
9867 if (sss2.eq.0.0d0) cycle
9868 ssgrad2 = sscalgrad2(dijCACA,rrr,dk,0.3d0)
9869 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)*sss2
9870 Pcalc(k) = Pcalc(k)+expCACA
9872 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
9874 CACAgrad = -sigma2CACA*(dijCACA-dk)*expCACA+
9875 & ssgrad2*expCACA/sss2
9878 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9879 PgradC(k,l,i) = PgradC(k,l,i)+aux
9880 PgradC(k,l,j) = PgradC(k,l,j)-aux
9889 if (nfgtasks.gt.1) then
9890 call MPI_Reduce(Pcalc(1),Pcalc_(1),nsaxs,MPI_DOUBLE_PRECISION,
9891 & MPI_SUM,king,FG_COMM,IERR)
9892 if (fg_rank.eq.king) then
9894 Pcalc(k) = Pcalc_(k)
9897 call MPI_Reduce(PgradC(k,1,1),PgradC_(k,1,1),3*maxsaxs*nres,
9898 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9899 if (fg_rank.eq.king) then
9903 PgradC(k,l,i) = PgradC_(k,l,i)
9909 call MPI_Reduce(PgradX(k,1,1),PgradX_(k,1,1),3*maxsaxs*nres,
9910 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9911 if (fg_rank.eq.king) then
9915 PgradX(k,l,i) = PgradX_(k,l,i)
9924 if (fg_rank.eq.king) then
9928 Cnorm = Cnorm + Pcalc(k)
9930 Esaxs_constr = dlog(Cnorm)-wsaxs0
9932 if (Pcalc(k).gt.0.0d0)
9933 & Esaxs_constr = Esaxs_constr - Psaxs(k)*dlog(Pcalc(k))
9935 write (iout,*) "k",k," Esaxs_constr",Esaxs_constr
9939 write (iout,*) "Cnorm",Cnorm," Esaxs_constr",Esaxs_constr
9949 & auxC = auxC +Psaxs(k)*PgradC(k,l,i)/Pcalc(k)
9950 auxC1 = auxC1+PgradC(k,l,i)
9952 auxX = auxX +Psaxs(k)*PgradX(k,l,i)/Pcalc(k)
9953 auxX1 = auxX1+PgradX(k,l,i)
9956 gsaxsC(l,i) = auxC - auxC1/Cnorm
9958 gsaxsX(l,i) = auxX - auxX1/Cnorm
9960 c write (iout,*) "l i",l,i," gradC",wsaxs*(auxC - auxC1/Cnorm),
9961 c * " gradX",wsaxs*(auxX - auxX1/Cnorm)
9969 c----------------------------------------------------------------------------
9970 subroutine e_saxsC(Esaxs_constr)
9972 include 'DIMENSIONS'
9975 include "COMMON.SETUP"
9978 include 'COMMON.SBRIDGE'
9979 include 'COMMON.CHAIN'
9980 include 'COMMON.INTERACT'
9981 include 'COMMON.GEO'
9982 include 'COMMON.LOCAL'
9983 include 'COMMON.VAR'
9984 include 'COMMON.IOUNITS'
9985 include 'COMMON.DERIV'
9986 include 'COMMON.CONTROL'
9987 include 'COMMON.NAMES'
9988 include 'COMMON.FFIELD'
9989 include 'COMMON.LANGEVIN'
9991 double precision Esaxs_constr
9992 integer i,iint,j,k,l
9993 double precision PgradC(3,maxres),PgradX(3,maxres),Pcalc,logPtot
9995 double precision gsaxsc_(3,maxres),gsaxsx_(3,maxres),logPtot_
9997 double precision dk,dijCASPH,dijSCSPH,
9998 & sigma2CA,sigma2SC,expCASPH,expSCSPH,
9999 & CASPHgrad,SCSPHgrad,aux,auxC,auxC1,
10001 c SAXS restraint penalty function
10003 write(iout,*) "------- SAXS penalty function start -------"
10004 write (iout,*) "nsaxs",nsaxs," isaxs_start",isaxs_start,
10005 & " isaxs_end",isaxs_end
10006 write (iout,*) "nnt",nnt," ntc",nct
10008 write(iout,'(a6,i5,3f10.5,5x,2f10.5)')
10009 & "CA",i,(C(j,i),j=1,3),pstok,restok(itype(i))
10012 write(iout,'(a6,i5,3f10.5)')"CSaxs",i,(Csaxs(j,i),j=1,3)
10015 Esaxs_constr = 0.0d0
10017 do j=isaxs_start,isaxs_end
10029 dijCASPH=dijCASPH+(C(l,i)-Csaxs(l,j))**2
10031 if (itype(i).ne.10) then
10033 dijSCSPH=dijSCSPH+(C(l,i+nres)-Csaxs(l,j))**2
10036 sigma2CA=2.0d0/pstok**2
10037 sigma2SC=4.0d0/restok(itype(i))**2
10038 expCASPH = dexp(-0.5d0*sigma2CA*dijCASPH)
10039 expSCSPH = dexp(-0.5d0*sigma2SC*dijSCSPH)
10040 Pcalc = Pcalc+expCASPH+expSCSPH
10042 write(*,*) "processor i j Pcalc",
10043 & MyRank,i,j,dijCASPH,dijSCSPH, Pcalc
10045 CASPHgrad = sigma2CA*expCASPH
10046 SCSPHgrad = sigma2SC*expSCSPH
10048 aux = (C(l,i+nres)-Csaxs(l,j))*SCSPHgrad
10049 PgradX(l,i) = PgradX(l,i) + aux
10050 PgradC(l,i) = PgradC(l,i)+(C(l,i)-Csaxs(l,j))*CASPHgrad+aux
10055 gsaxsc(l,i)=gsaxsc(l,i)+PgradC(l,i)/Pcalc
10056 gsaxsx(l,i)=gsaxsx(l,i)+PgradX(l,i)/Pcalc
10059 logPtot = logPtot - dlog(Pcalc)
10060 c print *,"me",me,MyRank," j",j," logPcalc",-dlog(Pcalc),
10061 c & " logPtot",logPtot
10064 if (nfgtasks.gt.1) then
10065 c write (iout,*) "logPtot before reduction",logPtot
10066 call MPI_Reduce(logPtot,logPtot_,1,MPI_DOUBLE_PRECISION,
10067 & MPI_SUM,king,FG_COMM,IERR)
10069 c write (iout,*) "logPtot after reduction",logPtot
10070 call MPI_Reduce(gsaxsC(1,1),gsaxsC_(1,1),3*nres,
10071 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10072 if (fg_rank.eq.king) then
10075 gsaxsC(l,i) = gsaxsC_(l,i)
10079 call MPI_Reduce(gsaxsX(1,1),gsaxsX_(1,1),3*nres,
10080 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10081 if (fg_rank.eq.king) then
10084 gsaxsX(l,i) = gsaxsX_(l,i)
10090 Esaxs_constr = logPtot