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 'COMMON.SBRIDGE'
3718 include 'COMMON.CHAIN'
3719 include 'COMMON.DERIV'
3720 include 'COMMON.VAR'
3721 include 'COMMON.INTERACT'
3722 include 'COMMON.CONTROL'
3723 include 'COMMON.IOUNITS'
3727 C write (iout,*) ,"link_end",link_end,constr_dist
3728 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
3729 c write(iout,*)'link_start=',link_start,' link_end=',link_end,
3730 c & " constr_dist",constr_dist
3731 if (link_end.eq.0) return
3732 do i=link_start,link_end
3733 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3734 C CA-CA distance used in regularization of structure.
3737 C iii and jjj point to the residues for which the distance is assigned.
3738 if (ii.gt.nres) then
3745 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
3746 c & dhpb(i),dhpb1(i),forcon(i)
3747 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3748 C distance and angle dependent SS bond potential.
3749 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3750 C & iabs(itype(jjj)).eq.1) then
3751 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
3752 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
3753 if (.not.dyn_ss .and. i.le.nss) then
3754 C 15/02/13 CC dynamic SSbond - additional check
3755 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3756 & iabs(itype(jjj)).eq.1) then
3757 call ssbond_ene(iii,jjj,eij)
3760 cd write (iout,*) "eij",eij
3761 cd & ' waga=',waga,' fac=',fac
3762 ! else if (ii.gt.nres .and. jj.gt.nres) then
3764 C Calculate the distance between the two points and its difference from the
3767 if (irestr_type(i).eq.11) then
3768 ehpb=ehpb+fordepth(i)!**4.0d0
3769 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3770 fac=fordepth(i)!**4.0d0
3771 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3772 c if (energy_dec) write (iout,'(a6,2i5,6f10.3,i5)')
3773 c & "edisL",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
3774 c & ehpb,irestr_type(i)
3775 else if (irestr_type(i).eq.10) then
3776 c AL 6//19/2018 cross-link restraints
3777 xdis = 0.5d0*(dd/forcon(i))**2
3778 expdis = dexp(-xdis)
3779 c aux=(dhpb(i)+dhpb1(i)*xdis)*expdis+fordepth(i)
3780 aux=(dhpb(i)+dhpb1(i)*xdis*xdis)*expdis+fordepth(i)
3781 c write (iout,*)"HERE: xdis",xdis," expdis",expdis," aux",aux,
3782 c & " wboltzd",wboltzd
3783 ehpb=ehpb-wboltzd*xlscore(i)*dlog(aux)
3784 c fac=-wboltzd*(dhpb1(i)*(1.0d0-xdis)-dhpb(i))
3785 fac=-wboltzd*xlscore(i)*(dhpb1(i)*(2.0d0-xdis)*xdis-dhpb(i))
3786 & *expdis/(aux*forcon(i)**2)
3787 c if (energy_dec) write(iout,'(a6,2i5,6f10.3,i5)')
3788 c & "edisX",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
3789 c & -wboltzd*xlscore(i)*dlog(aux),irestr_type(i)
3790 else if (irestr_type(i).eq.2) then
3791 c Quartic restraints
3792 ehpb=ehpb+forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3793 c if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
3794 c & "edisQ",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
3795 c & forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)),irestr_type(i)
3796 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3798 c Quadratic restraints
3800 C Get the force constant corresponding to this distance.
3802 C Calculate the contribution to energy.
3803 ehpb=ehpb+0.5d0*waga*rdis*rdis
3804 c if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
3805 c & "edisS",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
3806 c & 0.5d0*waga*rdis*rdis,irestr_type(i)
3808 C Evaluate gradient.
3812 c Calculate Cartesian gradient
3814 ggg(j)=fac*(c(j,jj)-c(j,ii))
3816 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3817 C If this is a SC-SC distance, we need to calculate the contributions to the
3818 C Cartesian gradient in the SC vectors (ghpbx).
3821 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3822 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3826 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3827 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3833 C--------------------------------------------------------------------------
3834 subroutine ssbond_ene(i,j,eij)
3836 C Calculate the distance and angle dependent SS-bond potential energy
3837 C using a free-energy function derived based on RHF/6-31G** ab initio
3838 C calculations of diethyl disulfide.
3840 C A. Liwo and U. Kozlowska, 11/24/03
3842 implicit real*8 (a-h,o-z)
3843 include 'DIMENSIONS'
3844 include 'sizesclu.dat'
3845 include 'COMMON.SBRIDGE'
3846 include 'COMMON.CHAIN'
3847 include 'COMMON.DERIV'
3848 include 'COMMON.LOCAL'
3849 include 'COMMON.INTERACT'
3850 include 'COMMON.VAR'
3851 include 'COMMON.IOUNITS'
3852 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3853 itypi=iabs(itype(i))
3857 dxi=dc_norm(1,nres+i)
3858 dyi=dc_norm(2,nres+i)
3859 dzi=dc_norm(3,nres+i)
3860 dsci_inv=dsc_inv(itypi)
3861 itypj=iabs(itype(j))
3862 dscj_inv=dsc_inv(itypj)
3866 dxj=dc_norm(1,nres+j)
3867 dyj=dc_norm(2,nres+j)
3868 dzj=dc_norm(3,nres+j)
3869 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3874 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3875 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3876 om12=dxi*dxj+dyi*dyj+dzi*dzj
3878 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3879 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3885 deltat12=om2-om1+2.0d0
3887 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3888 & +akct*deltad*deltat12
3889 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3890 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3891 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3892 c & " deltat12",deltat12," eij",eij
3893 ed=2*akcm*deltad+akct*deltat12
3895 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3896 eom1=-2*akth*deltat1-pom1-om2*pom2
3897 eom2= 2*akth*deltat2+pom1-om1*pom2
3900 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3903 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3904 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3905 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3906 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3909 C Calculate the components of the gradient in DC and X
3913 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3918 C--------------------------------------------------------------------------
3921 c LICZENIE WIEZOW Z ROWNANIA ENERGII MODELLERA
3922 subroutine e_modeller(ehomology_constr)
3923 implicit real*8 (a-h,o-z)
3925 include 'DIMENSIONS'
3927 integer nnn, i, j, k, ki, irec, l
3928 integer katy, odleglosci, test7
3929 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
3930 real*8 distance(max_template),distancek(max_template),
3931 & min_odl,godl(max_template),dih_diff(max_template)
3934 c FP - 30/10/2014 Temporary specifications for homology restraints
3936 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
3938 double precision, dimension (maxres) :: guscdiff,usc_diff
3939 double precision, dimension (max_template) ::
3940 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
3943 include 'COMMON.SBRIDGE'
3944 include 'COMMON.CHAIN'
3945 include 'COMMON.GEO'
3946 include 'COMMON.DERIV'
3947 include 'COMMON.LOCAL'
3948 include 'COMMON.INTERACT'
3949 include 'COMMON.VAR'
3950 include 'COMMON.IOUNITS'
3951 include 'COMMON.CONTROL'
3952 include 'COMMON.HOMRESTR'
3954 include 'COMMON.SETUP'
3955 include 'COMMON.NAMES'
3958 distancek(i)=9999999.9
3963 c Pseudo-energy and gradient from homology restraints (MODELLER-like
3965 C AL 5/2/14 - Introduce list of restraints
3966 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
3968 write(iout,*) "------- dist restrs start -------"
3969 write (iout,*) "link_start_homo",link_start_homo,
3970 & " link_end_homo",link_end_homo
3972 do ii = link_start_homo,link_end_homo
3976 c write (iout,*) "dij(",i,j,") =",dij
3978 do k=1,constr_homology
3979 if(.not.l_homo(k,ii)) then
3983 distance(k)=odl(k,ii)-dij
3984 c write (iout,*) "distance(",k,") =",distance(k)
3986 c For Gaussian-type Urestr
3988 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
3989 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
3990 c write (iout,*) "distancek(",k,") =",distancek(k)
3991 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
3993 c For Lorentzian-type Urestr
3995 if (waga_dist.lt.0.0d0) then
3996 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
3997 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
3998 & (distance(k)**2+sigma_odlir(k,ii)**2))
4002 c min_odl=minval(distancek)
4003 do kk=1,constr_homology
4004 if(l_homo(kk,ii)) then
4005 min_odl=distancek(kk)
4009 do kk=1,constr_homology
4010 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
4011 & min_odl=distancek(kk)
4013 c write (iout,* )"min_odl",min_odl
4015 write (iout,*) "ij dij",i,j,dij
4016 write (iout,*) "distance",(distance(k),k=1,constr_homology)
4017 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
4018 write (iout,* )"min_odl",min_odl
4023 if (waga_dist.ge.0.0d0) then
4029 do k=1,constr_homology
4030 c Nie wiem po co to liczycie jeszcze raz!
4031 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
4032 c & (2*(sigma_odl(i,j,k))**2))
4033 if(.not.l_homo(k,ii)) cycle
4034 if (waga_dist.ge.0.0d0) then
4036 c For Gaussian-type Urestr
4038 godl(k)=dexp(-distancek(k)+min_odl)
4039 odleg2=odleg2+godl(k)
4041 c For Lorentzian-type Urestr
4044 odleg2=odleg2+distancek(k)
4047 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
4048 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
4049 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
4050 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
4053 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
4054 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
4056 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
4057 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
4059 if (waga_dist.ge.0.0d0) then
4061 c For Gaussian-type Urestr
4063 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
4065 c For Lorentzian-type Urestr
4068 odleg=odleg+odleg2/constr_homology
4072 c write (iout,*) "odleg",odleg ! sum of -ln-s
4075 c For Gaussian-type Urestr
4077 if (waga_dist.ge.0.0d0) sum_godl=odleg2
4079 do k=1,constr_homology
4080 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
4081 c & *waga_dist)+min_odl
4082 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
4084 if(.not.l_homo(k,ii)) cycle
4085 if (waga_dist.ge.0.0d0) then
4086 c For Gaussian-type Urestr
4088 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
4090 c For Lorentzian-type Urestr
4093 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
4094 & sigma_odlir(k,ii)**2)**2)
4096 sum_sgodl=sum_sgodl+sgodl
4098 c sgodl2=sgodl2+sgodl
4099 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
4100 c write(iout,*) "constr_homology=",constr_homology
4101 c write(iout,*) i, j, k, "TEST K"
4103 if (waga_dist.ge.0.0d0) then
4105 c For Gaussian-type Urestr
4107 grad_odl3=waga_homology(iset)*waga_dist
4108 & *sum_sgodl/(sum_godl*dij)
4110 c For Lorentzian-type Urestr
4113 c Original grad expr modified by analogy w Gaussian-type Urestr grad
4114 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
4115 grad_odl3=-waga_homology(iset)*waga_dist*
4116 & sum_sgodl/(constr_homology*dij)
4119 c grad_odl3=sum_sgodl/(sum_godl*dij)
4122 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
4123 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
4124 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
4126 ccc write(iout,*) godl, sgodl, grad_odl3
4128 c grad_odl=grad_odl+grad_odl3
4131 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
4132 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
4133 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
4134 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
4135 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
4136 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
4137 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
4138 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
4139 c if (i.eq.25.and.j.eq.27) then
4140 c write(iout,*) "jik",jik,"i",i,"j",j
4141 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
4142 c write(iout,*) "grad_odl3",grad_odl3
4143 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
4144 c write(iout,*) "ggodl",ggodl
4145 c write(iout,*) "ghpbc(",jik,i,")",
4146 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
4151 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
4152 ccc & dLOG(odleg2),"-odleg=", -odleg
4154 enddo ! ii-loop for dist
4156 write(iout,*) "------- dist restrs end -------"
4157 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
4158 c & waga_d.eq.1.0d0) call sum_gradient
4160 c Pseudo-energy and gradient from dihedral-angle restraints from
4161 c homology templates
4162 c write (iout,*) "End of distance loop"
4165 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
4167 write(iout,*) "------- dih restrs start -------"
4168 do i=idihconstr_start_homo,idihconstr_end_homo
4169 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
4172 do i=idihconstr_start_homo,idihconstr_end_homo
4174 c betai=beta(i,i+1,i+2,i+3)
4176 c write (iout,*) "betai =",betai
4177 do k=1,constr_homology
4178 dih_diff(k)=pinorm(dih(k,i)-betai)
4179 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
4180 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
4181 c & -(6.28318-dih_diff(i,k))
4182 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
4183 c & 6.28318+dih_diff(i,k)
4185 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
4187 kat3=(dcos(dih_diff(k))-1)*sigma_dih(k,i)
4189 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
4192 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
4195 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
4196 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
4198 write (iout,*) "i",i," betai",betai," kat2",kat2
4199 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
4201 if (kat2.le.1.0d-14) cycle
4202 kat=kat-dLOG(kat2/constr_homology)
4203 c write (iout,*) "kat",kat ! sum of -ln-s
4205 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
4206 ccc & dLOG(kat2), "-kat=", -kat
4209 c ----------------------------------------------------------------------
4211 c ----------------------------------------------------------------------
4215 do k=1,constr_homology
4217 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
4219 sgdih=-gdih(k)*dsin(dih_diff(k))*sigma_dih(k,i)
4221 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
4222 sum_sgdih=sum_sgdih+sgdih
4224 c grad_dih3=sum_sgdih/sum_gdih
4225 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
4227 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
4228 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
4229 ccc & gloc(nphi+i-3,icg)
4230 gloc(i,icg)=gloc(i,icg)+grad_dih3
4232 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
4234 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
4235 ccc & gloc(nphi+i-3,icg)
4237 enddo ! i-loop for dih
4239 write(iout,*) "------- dih restrs end -------"
4242 c Pseudo-energy and gradient for theta angle restraints from
4243 c homology templates
4244 c FP 01/15 - inserted from econstr_local_test.F, loop structure
4248 c For constr_homology reference structures (FP)
4250 c Uconst_back_tot=0.0d0
4253 c Econstr_back legacy
4256 c do i=ithet_start,ithet_end
4259 c do i=loc_start,loc_end
4262 duscdiffx(j,i)=0.0d0
4268 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
4269 c write (iout,*) "waga_theta",waga_theta
4270 if (waga_theta.gt.0.0d0) then
4272 write (iout,*) "usampl",usampl
4273 write(iout,*) "------- theta restrs start -------"
4274 c do i=ithet_start,ithet_end
4275 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
4278 c write (iout,*) "maxres",maxres,"nres",nres
4280 do i=ithet_start,ithet_end
4283 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
4285 c Deviation of theta angles wrt constr_homology ref structures
4287 utheta_i=0.0d0 ! argument of Gaussian for single k
4288 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
4289 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
4290 c over residues in a fragment
4291 c write (iout,*) "theta(",i,")=",theta(i)
4292 do k=1,constr_homology
4294 c dtheta_i=theta(j)-thetaref(j,iref)
4295 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
4296 theta_diff(k)=thetatpl(k,i)-theta(i)
4298 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
4299 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
4300 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
4301 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
4302 c Gradient for single Gaussian restraint in subr Econstr_back
4303 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
4306 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
4307 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
4311 c Gradient for multiple Gaussian restraint
4312 sum_gtheta=gutheta_i
4314 do k=1,constr_homology
4315 c New generalized expr for multiple Gaussian from Econstr_back
4316 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
4318 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
4319 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
4322 c Final value of gradient using same var as in Econstr_back
4323 dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
4324 & *waga_homology(iset)
4325 c dutheta(i)=sum_sgtheta/sum_gtheta
4327 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
4329 Eval=Eval-dLOG(gutheta_i/constr_homology)
4330 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
4331 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
4332 c Uconst_back=Uconst_back+utheta(i)
4333 enddo ! (i-loop for theta)
4335 write(iout,*) "------- theta restrs end -------"
4339 c Deviation of local SC geometry
4341 c Separation of two i-loops (instructed by AL - 11/3/2014)
4343 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
4344 c write (iout,*) "waga_d",waga_d
4347 write(iout,*) "------- SC restrs start -------"
4348 write (iout,*) "Initial duscdiff,duscdiffx"
4349 do i=loc_start,loc_end
4350 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
4351 & (duscdiffx(jik,i),jik=1,3)
4354 do i=loc_start,loc_end
4355 usc_diff_i=0.0d0 ! argument of Gaussian for single k
4356 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
4357 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
4358 c write(iout,*) "xxtab, yytab, zztab"
4359 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
4360 do k=1,constr_homology
4362 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
4363 c Original sign inverted for calc of gradients (s. Econstr_back)
4364 dyy=-yytpl(k,i)+yytab(i) ! ibid y
4365 dzz=-zztpl(k,i)+zztab(i) ! ibid z
4366 c write(iout,*) "dxx, dyy, dzz"
4367 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
4369 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
4370 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
4371 c uscdiffk(k)=usc_diff(i)
4372 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
4373 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
4374 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
4375 c & xxref(j),yyref(j),zzref(j)
4380 c Generalized expression for multiple Gaussian acc to that for a single
4381 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
4383 c Original implementation
4384 c sum_guscdiff=guscdiff(i)
4386 c sum_sguscdiff=0.0d0
4387 c do k=1,constr_homology
4388 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
4389 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
4390 c sum_sguscdiff=sum_sguscdiff+sguscdiff
4393 c Implementation of new expressions for gradient (Jan. 2015)
4395 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
4397 do k=1,constr_homology
4399 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
4400 c before. Now the drivatives should be correct
4402 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
4403 c Original sign inverted for calc of gradients (s. Econstr_back)
4404 dyy=-yytpl(k,i)+yytab(i) ! ibid y
4405 dzz=-zztpl(k,i)+zztab(i) ! ibid z
4407 c New implementation
4409 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
4410 & sigma_d(k,i) ! for the grad wrt r'
4411 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
4414 c New implementation
4415 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
4417 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
4418 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
4419 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
4420 duscdiff(jik,i)=duscdiff(jik,i)+
4421 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
4422 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
4423 duscdiffx(jik,i)=duscdiffx(jik,i)+
4424 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
4425 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
4428 write(iout,*) "jik",jik,"i",i
4429 write(iout,*) "dxx, dyy, dzz"
4430 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
4431 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
4432 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
4433 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
4434 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
4435 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
4436 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
4437 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
4438 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
4439 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
4440 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
4441 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
4442 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
4443 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
4444 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
4451 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
4452 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
4454 c write (iout,*) i," uscdiff",uscdiff(i)
4456 c Put together deviations from local geometry
4458 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
4459 c & wfrag_back(3,i,iset)*uscdiff(i)
4460 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
4461 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
4462 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
4463 c Uconst_back=Uconst_back+usc_diff(i)
4465 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
4467 c New implment: multiplied by sum_sguscdiff
4470 enddo ! (i-loop for dscdiff)
4475 write(iout,*) "------- SC restrs end -------"
4476 write (iout,*) "------ After SC loop in e_modeller ------"
4477 do i=loc_start,loc_end
4478 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
4479 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
4481 if (waga_theta.eq.1.0d0) then
4482 write (iout,*) "in e_modeller after SC restr end: dutheta"
4483 do i=ithet_start,ithet_end
4484 write (iout,*) i,dutheta(i)
4487 if (waga_d.eq.1.0d0) then
4488 write (iout,*) "e_modeller after SC loop: duscdiff/x"
4490 write (iout,*) i,(duscdiff(j,i),j=1,3)
4491 write (iout,*) i,(duscdiffx(j,i),j=1,3)
4496 c Total energy from homology restraints
4498 write (iout,*) "odleg",odleg," kat",kat
4499 write (iout,*) "odleg",odleg," kat",kat
4500 write (iout,*) "Eval",Eval," Erot",Erot
4501 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
4502 write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
4503 write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
4504 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
4507 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
4509 c ehomology_constr=odleg+kat
4511 c For Lorentzian-type Urestr
4514 if (waga_dist.ge.0.0d0) then
4516 c For Gaussian-type Urestr
4518 ehomology_constr=(waga_dist*odleg+waga_angle*kat+
4519 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
4520 c write (iout,*) "ehomology_constr=",ehomology_constr
4523 c For Lorentzian-type Urestr
4525 ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
4526 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
4527 c write (iout,*) "ehomology_constr=",ehomology_constr
4530 write (iout,*) "iset",iset," waga_homology",waga_homology(iset)
4531 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
4532 & " Eval",waga_theta,Eval," Erot",waga_d,Erot
4533 write (iout,*) "ehomology_constr",ehomology_constr
4537 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
4538 747 format(a12,i4,i4,i4,f8.3,f8.3)
4539 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
4540 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
4541 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
4542 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
4544 C--------------------------------------------------------------------------
4546 C--------------------------------------------------------------------------
4547 subroutine ebond(estr)
4549 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4551 implicit real*8 (a-h,o-z)
4552 include 'DIMENSIONS'
4553 include 'sizesclu.dat'
4554 include 'COMMON.LOCAL'
4555 include 'COMMON.GEO'
4556 include 'COMMON.INTERACT'
4557 include 'COMMON.DERIV'
4558 include 'COMMON.VAR'
4559 include 'COMMON.CHAIN'
4560 include 'COMMON.IOUNITS'
4561 include 'COMMON.NAMES'
4562 include 'COMMON.FFIELD'
4563 include 'COMMON.CONTROL'
4564 logical energy_dec /.false./
4565 double precision u(3),ud(3)
4569 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4570 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4572 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4573 C & *dc(j,i-1)/vbld(i)
4575 C if (energy_dec) write(iout,*)
4576 C & "estr1",i,vbld(i),distchainmax,
4577 C & gnmr1(vbld(i),-1.0d0,distchainmax)
4579 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4580 diff = vbld(i)-vbldpDUM
4582 diff = vbld(i)-vbldp0
4583 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4587 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4590 C write (iout,'(a7,i5,4f7.3)')
4591 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4593 estr=0.5d0*AKP*estr+estr1
4595 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4599 if (iti.ne.10 .and. iti.ne.ntyp1) then
4602 diff=vbld(i+nres)-vbldsc0(1,iti)
4603 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4604 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4605 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4607 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4611 diff=vbld(i+nres)-vbldsc0(j,iti)
4612 ud(j)=aksc(j,iti)*diff
4613 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4627 uprod2=uprod2*u(k)*u(k)
4631 usumsqder=usumsqder+ud(j)*uprod2
4633 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
4634 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
4635 estr=estr+uprod/usum
4637 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4645 C--------------------------------------------------------------------------
4646 subroutine ebend(etheta,ethetacnstr)
4648 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4649 C angles gamma and its derivatives in consecutive thetas and gammas.
4651 implicit real*8 (a-h,o-z)
4652 include 'DIMENSIONS'
4653 include 'sizesclu.dat'
4654 include 'COMMON.LOCAL'
4655 include 'COMMON.GEO'
4656 include 'COMMON.INTERACT'
4657 include 'COMMON.DERIV'
4658 include 'COMMON.VAR'
4659 include 'COMMON.CHAIN'
4660 include 'COMMON.IOUNITS'
4661 include 'COMMON.NAMES'
4662 include 'COMMON.FFIELD'
4663 include 'COMMON.TORCNSTR'
4664 common /calcthet/ term1,term2,termm,diffak,ratak,
4665 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4666 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4667 double precision y(2),z(2)
4669 c time11=dexp(-2*time)
4672 c write (iout,*) "nres",nres
4673 c write (*,'(a,i2)') 'EBEND ICG=',icg
4674 c write (iout,*) ithet_start,ithet_end
4675 do i=ithet_start,ithet_end
4676 C if (itype(i-1).eq.ntyp1) cycle
4678 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4679 & .or.itype(i).eq.ntyp1) cycle
4680 C Zero the energy function and its derivative at 0 or pi.
4681 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4683 ichir1=isign(1,itype(i-2))
4684 ichir2=isign(1,itype(i))
4685 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4686 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4687 if (itype(i-1).eq.10) then
4688 itype1=isign(10,itype(i-2))
4689 ichir11=isign(1,itype(i-2))
4690 ichir12=isign(1,itype(i-2))
4691 itype2=isign(10,itype(i))
4692 ichir21=isign(1,itype(i))
4693 ichir22=isign(1,itype(i))
4700 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
4704 c call proc_proc(phii,icrc)
4705 if (icrc.eq.1) phii=150.0
4716 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4720 c call proc_proc(phii1,icrc)
4721 if (icrc.eq.1) phii1=150.0
4733 C Calculate the "mean" value of theta from the part of the distribution
4734 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4735 C In following comments this theta will be referred to as t_c.
4736 thet_pred_mean=0.0d0
4738 athetk=athet(k,it,ichir1,ichir2)
4739 bthetk=bthet(k,it,ichir1,ichir2)
4741 athetk=athet(k,itype1,ichir11,ichir12)
4742 bthetk=bthet(k,itype2,ichir21,ichir22)
4744 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4746 c write (iout,*) "thet_pred_mean",thet_pred_mean
4747 dthett=thet_pred_mean*ssd
4748 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4749 c write (iout,*) "thet_pred_mean",thet_pred_mean
4750 C Derivatives of the "mean" values in gamma1 and gamma2.
4751 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4752 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4753 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4754 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4756 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4757 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4758 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4759 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4761 if (theta(i).gt.pi-delta) then
4762 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4764 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4765 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4766 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4768 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4770 else if (theta(i).lt.delta) then
4771 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4772 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4773 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4775 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4776 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4779 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4782 etheta=etheta+ethetai
4783 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4784 c & rad2deg*phii,rad2deg*phii1,ethetai
4785 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4786 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4787 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4790 C Ufff.... We've done all this!!!
4793 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4794 do i=1,ntheta_constr
4795 itheta=itheta_constr(i)
4796 thetiii=theta(itheta)
4797 difi=pinorm(thetiii-theta_constr0(i))
4798 if (difi.gt.theta_drange(i)) then
4799 difi=difi-theta_drange(i)
4800 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4801 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4802 & +for_thet_constr(i)*difi**3
4803 else if (difi.lt.-drange(i)) then
4805 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4806 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4807 & +for_thet_constr(i)*difi**3
4811 C if (energy_dec) then
4812 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4813 C & i,itheta,rad2deg*thetiii,
4814 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4815 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4816 C & gloc(itheta+nphi-2,icg)
4821 C---------------------------------------------------------------------------
4822 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4824 implicit real*8 (a-h,o-z)
4825 include 'DIMENSIONS'
4826 include 'COMMON.LOCAL'
4827 include 'COMMON.IOUNITS'
4828 common /calcthet/ term1,term2,termm,diffak,ratak,
4829 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4830 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4831 C Calculate the contributions to both Gaussian lobes.
4832 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4833 C The "polynomial part" of the "standard deviation" of this part of
4837 sig=sig*thet_pred_mean+polthet(j,it)
4839 C Derivative of the "interior part" of the "standard deviation of the"
4840 C gamma-dependent Gaussian lobe in t_c.
4841 sigtc=3*polthet(3,it)
4843 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4846 C Set the parameters of both Gaussian lobes of the distribution.
4847 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4848 fac=sig*sig+sigc0(it)
4851 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4852 sigsqtc=-4.0D0*sigcsq*sigtc
4853 c print *,i,sig,sigtc,sigsqtc
4854 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4855 sigtc=-sigtc/(fac*fac)
4856 C Following variable is sigma(t_c)**(-2)
4857 sigcsq=sigcsq*sigcsq
4859 sig0inv=1.0D0/sig0i**2
4860 delthec=thetai-thet_pred_mean
4861 delthe0=thetai-theta0i
4862 term1=-0.5D0*sigcsq*delthec*delthec
4863 term2=-0.5D0*sig0inv*delthe0*delthe0
4864 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4865 C NaNs in taking the logarithm. We extract the largest exponent which is added
4866 C to the energy (this being the log of the distribution) at the end of energy
4867 C term evaluation for this virtual-bond angle.
4868 if (term1.gt.term2) then
4870 term2=dexp(term2-termm)
4874 term1=dexp(term1-termm)
4877 C The ratio between the gamma-independent and gamma-dependent lobes of
4878 C the distribution is a Gaussian function of thet_pred_mean too.
4879 diffak=gthet(2,it)-thet_pred_mean
4880 ratak=diffak/gthet(3,it)**2
4881 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4882 C Let's differentiate it in thet_pred_mean NOW.
4884 C Now put together the distribution terms to make complete distribution.
4885 termexp=term1+ak*term2
4886 termpre=sigc+ak*sig0i
4887 C Contribution of the bending energy from this theta is just the -log of
4888 C the sum of the contributions from the two lobes and the pre-exponential
4889 C factor. Simple enough, isn't it?
4890 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4891 C NOW the derivatives!!!
4892 C 6/6/97 Take into account the deformation.
4893 E_theta=(delthec*sigcsq*term1
4894 & +ak*delthe0*sig0inv*term2)/termexp
4895 E_tc=((sigtc+aktc*sig0i)/termpre
4896 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4897 & aktc*term2)/termexp)
4900 c-----------------------------------------------------------------------------
4901 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4902 implicit real*8 (a-h,o-z)
4903 include 'DIMENSIONS'
4904 include 'COMMON.LOCAL'
4905 include 'COMMON.IOUNITS'
4906 common /calcthet/ term1,term2,termm,diffak,ratak,
4907 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4908 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4909 delthec=thetai-thet_pred_mean
4910 delthe0=thetai-theta0i
4911 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4912 t3 = thetai-thet_pred_mean
4916 t14 = t12+t6*sigsqtc
4918 t21 = thetai-theta0i
4924 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4925 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4926 & *(-t12*t9-ak*sig0inv*t27)
4930 C--------------------------------------------------------------------------
4931 subroutine ebend(etheta,ethetacnstr)
4933 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4934 C angles gamma and its derivatives in consecutive thetas and gammas.
4935 C ab initio-derived potentials from
4936 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4938 implicit real*8 (a-h,o-z)
4939 include 'DIMENSIONS'
4940 include 'sizesclu.dat'
4941 include 'COMMON.LOCAL'
4942 include 'COMMON.GEO'
4943 include 'COMMON.INTERACT'
4944 include 'COMMON.DERIV'
4945 include 'COMMON.VAR'
4946 include 'COMMON.CHAIN'
4947 include 'COMMON.IOUNITS'
4948 include 'COMMON.NAMES'
4949 include 'COMMON.FFIELD'
4950 include 'COMMON.CONTROL'
4951 include 'COMMON.TORCNSTR'
4952 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4953 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4954 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4955 & sinph1ph2(maxdouble,maxdouble)
4956 logical lprn /.false./, lprn1 /.false./
4958 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4959 do i=ithet_start,ithet_end
4961 c print *,i,itype(i-1),itype(i),itype(i-2)
4962 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1)
4963 & .or.(itype(i).eq.ntyp1)) cycle
4964 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
4966 if (iabs(itype(i+1)).eq.20) iblock=2
4967 if (iabs(itype(i+1)).ne.20) iblock=1
4971 theti2=0.5d0*theta(i)
4972 ityp2=ithetyp((itype(i-1)))
4974 coskt(k)=dcos(k*theti2)
4975 sinkt(k)=dsin(k*theti2)
4977 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
4980 if (phii.ne.phii) phii=150.0
4984 ityp1=ithetyp((itype(i-2)))
4986 cosph1(k)=dcos(k*phii)
4987 sinph1(k)=dsin(k*phii)
4991 ityp1=ithetyp(itype(i-2))
4997 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5000 if (phii1.ne.phii1) phii1=150.0
5005 ityp3=ithetyp((itype(i)))
5007 cosph2(k)=dcos(k*phii1)
5008 sinph2(k)=dsin(k*phii1)
5012 ityp3=ithetyp(itype(i))
5018 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
5019 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
5021 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5024 ccl=cosph1(l)*cosph2(k-l)
5025 ssl=sinph1(l)*sinph2(k-l)
5026 scl=sinph1(l)*cosph2(k-l)
5027 csl=cosph1(l)*sinph2(k-l)
5028 cosph1ph2(l,k)=ccl-ssl
5029 cosph1ph2(k,l)=ccl+ssl
5030 sinph1ph2(l,k)=scl+csl
5031 sinph1ph2(k,l)=scl-csl
5035 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5036 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5037 write (iout,*) "coskt and sinkt"
5039 write (iout,*) k,coskt(k),sinkt(k)
5043 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5044 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5047 & write (iout,*) "k",k," aathet",
5048 & aathet(k,ityp1,ityp2,ityp3,iblock),
5049 & " ethetai",ethetai
5052 write (iout,*) "cosph and sinph"
5054 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5056 write (iout,*) "cosph1ph2 and sinph2ph2"
5059 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5060 & sinph1ph2(l,k),sinph1ph2(k,l)
5063 write(iout,*) "ethetai",ethetai
5067 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5068 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5069 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5070 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5071 ethetai=ethetai+sinkt(m)*aux
5072 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5073 dephii=dephii+k*sinkt(m)*(
5074 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5075 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5076 dephii1=dephii1+k*sinkt(m)*(
5077 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5078 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5080 & write (iout,*) "m",m," k",k," bbthet",
5081 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5082 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5083 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5084 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5088 & write(iout,*) "ethetai",ethetai
5092 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5093 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5094 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5095 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5096 ethetai=ethetai+sinkt(m)*aux
5097 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5098 dephii=dephii+l*sinkt(m)*(
5099 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5100 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5101 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5102 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5103 dephii1=dephii1+(k-l)*sinkt(m)*(
5104 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5105 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5106 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5107 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5109 write (iout,*) "m",m," k",k," l",l," ffthet",
5110 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5111 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5112 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5113 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5114 & " ethetai",ethetai
5115 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5116 & cosph1ph2(k,l)*sinkt(m),
5117 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5123 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5124 & i,theta(i)*rad2deg,phii*rad2deg,
5125 & phii1*rad2deg,ethetai
5126 etheta=etheta+ethetai
5127 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5128 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5129 c gloc(nphi+i-2,icg)=wang*dethetai
5130 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
5134 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
5135 do i=1,ntheta_constr
5136 itheta=itheta_constr(i)
5137 thetiii=theta(itheta)
5138 difi=pinorm(thetiii-theta_constr0(i))
5139 if (difi.gt.theta_drange(i)) then
5140 difi=difi-theta_drange(i)
5141 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5142 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
5143 & +for_thet_constr(i)*difi**3
5144 else if (difi.lt.-drange(i)) then
5146 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5147 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
5148 & +for_thet_constr(i)*difi**3
5152 C if (energy_dec) then
5153 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
5154 C & i,itheta,rad2deg*thetiii,
5155 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
5156 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
5157 C & gloc(itheta+nphi-2,icg)
5164 c-----------------------------------------------------------------------------
5165 subroutine esc(escloc)
5166 C Calculate the local energy of a side chain and its derivatives in the
5167 C corresponding virtual-bond valence angles THETA and the spherical angles
5169 implicit real*8 (a-h,o-z)
5170 include 'DIMENSIONS'
5171 include 'sizesclu.dat'
5172 include 'COMMON.GEO'
5173 include 'COMMON.LOCAL'
5174 include 'COMMON.VAR'
5175 include 'COMMON.INTERACT'
5176 include 'COMMON.DERIV'
5177 include 'COMMON.CHAIN'
5178 include 'COMMON.IOUNITS'
5179 include 'COMMON.NAMES'
5180 include 'COMMON.FFIELD'
5181 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5182 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5183 common /sccalc/ time11,time12,time112,theti,it,nlobit
5186 c write (iout,'(a)') 'ESC'
5187 do i=loc_start,loc_end
5189 if (it.eq.ntyp1) cycle
5190 if (it.eq.10) goto 1
5191 nlobit=nlob(iabs(it))
5192 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5193 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5194 theti=theta(i+1)-pipol
5198 c write (iout,*) "i",i," x",x(1),x(2),x(3)
5200 if (x(2).gt.pi-delta) then
5204 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5206 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5207 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5209 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5210 & ddersc0(1),dersc(1))
5211 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5212 & ddersc0(3),dersc(3))
5214 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5216 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5217 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5218 & dersc0(2),esclocbi,dersc02)
5219 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5221 call splinthet(x(2),0.5d0*delta,ss,ssd)
5226 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5228 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5229 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5231 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5233 c write (iout,*) escloci
5234 else if (x(2).lt.delta) then
5238 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5240 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5241 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5243 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5244 & ddersc0(1),dersc(1))
5245 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5246 & ddersc0(3),dersc(3))
5248 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5250 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5251 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5252 & dersc0(2),esclocbi,dersc02)
5253 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5258 call splinthet(x(2),0.5d0*delta,ss,ssd)
5260 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5262 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5263 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5265 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5266 c write (iout,*) escloci
5268 call enesc(x,escloci,dersc,ddummy,.false.)
5271 escloc=escloc+escloci
5272 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5274 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5276 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5277 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5282 C---------------------------------------------------------------------------
5283 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5284 implicit real*8 (a-h,o-z)
5285 include 'DIMENSIONS'
5286 include 'COMMON.GEO'
5287 include 'COMMON.LOCAL'
5288 include 'COMMON.IOUNITS'
5289 common /sccalc/ time11,time12,time112,theti,it,nlobit
5290 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5291 double precision contr(maxlob,-1:1)
5293 c write (iout,*) 'it=',it,' nlobit=',nlobit
5297 if (mixed) ddersc(j)=0.0d0
5301 C Because of periodicity of the dependence of the SC energy in omega we have
5302 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5303 C To avoid underflows, first compute & store the exponents.
5311 z(k)=x(k)-censc(k,j,it)
5316 Axk=Axk+gaussc(l,k,j,it)*z(l)
5322 expfac=expfac+Ax(k,j,iii)*z(k)
5330 C As in the case of ebend, we want to avoid underflows in exponentiation and
5331 C subsequent NaNs and INFs in energy calculation.
5332 C Find the largest exponent
5336 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5340 cd print *,'it=',it,' emin=',emin
5342 C Compute the contribution to SC energy and derivatives
5346 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5347 cd print *,'j=',j,' expfac=',expfac
5348 escloc_i=escloc_i+expfac
5350 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5354 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5355 & +gaussc(k,2,j,it))*expfac
5362 dersc(1)=dersc(1)/cos(theti)**2
5363 ddersc(1)=ddersc(1)/cos(theti)**2
5366 escloci=-(dlog(escloc_i)-emin)
5368 dersc(j)=dersc(j)/escloc_i
5372 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5377 C------------------------------------------------------------------------------
5378 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5379 implicit real*8 (a-h,o-z)
5380 include 'DIMENSIONS'
5381 include 'COMMON.GEO'
5382 include 'COMMON.LOCAL'
5383 include 'COMMON.IOUNITS'
5384 common /sccalc/ time11,time12,time112,theti,it,nlobit
5385 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5386 double precision contr(maxlob)
5397 z(k)=x(k)-censc(k,j,it)
5403 Axk=Axk+gaussc(l,k,j,it)*z(l)
5409 expfac=expfac+Ax(k,j)*z(k)
5414 C As in the case of ebend, we want to avoid underflows in exponentiation and
5415 C subsequent NaNs and INFs in energy calculation.
5416 C Find the largest exponent
5419 if (emin.gt.contr(j)) emin=contr(j)
5423 C Compute the contribution to SC energy and derivatives
5427 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5428 escloc_i=escloc_i+expfac
5430 dersc(k)=dersc(k)+Ax(k,j)*expfac
5432 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5433 & +gaussc(1,2,j,it))*expfac
5437 dersc(1)=dersc(1)/cos(theti)**2
5438 dersc12=dersc12/cos(theti)**2
5439 escloci=-(dlog(escloc_i)-emin)
5441 dersc(j)=dersc(j)/escloc_i
5443 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5447 c----------------------------------------------------------------------------------
5448 subroutine esc(escloc)
5449 C Calculate the local energy of a side chain and its derivatives in the
5450 C corresponding virtual-bond valence angles THETA and the spherical angles
5451 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5452 C added by Urszula Kozlowska. 07/11/2007
5454 implicit real*8 (a-h,o-z)
5455 include 'DIMENSIONS'
5456 include 'sizesclu.dat'
5457 include 'COMMON.GEO'
5458 include 'COMMON.LOCAL'
5459 include 'COMMON.VAR'
5460 include 'COMMON.SCROT'
5461 include 'COMMON.INTERACT'
5462 include 'COMMON.DERIV'
5463 include 'COMMON.CHAIN'
5464 include 'COMMON.IOUNITS'
5465 include 'COMMON.NAMES'
5466 include 'COMMON.FFIELD'
5467 include 'COMMON.CONTROL'
5468 include 'COMMON.VECTORS'
5469 double precision x_prime(3),y_prime(3),z_prime(3)
5470 & , sumene,dsc_i,dp2_i,x(65),
5471 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5472 & de_dxx,de_dyy,de_dzz,de_dt
5473 double precision s1_t,s1_6_t,s2_t,s2_6_t
5475 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5476 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5477 & dt_dCi(3),dt_dCi1(3)
5478 common /sccalc/ time11,time12,time112,theti,it,nlobit
5481 do i=loc_start,loc_end
5482 if (itype(i).eq.ntyp1) cycle
5483 costtab(i+1) =dcos(theta(i+1))
5484 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5485 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5486 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5487 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5488 cosfac=dsqrt(cosfac2)
5489 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5490 sinfac=dsqrt(sinfac2)
5492 if (it.eq.10) goto 1
5494 C Compute the axes of tghe local cartesian coordinates system; store in
5495 c x_prime, y_prime and z_prime
5502 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5503 C & dc_norm(3,i+nres)
5505 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5506 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5509 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5512 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5513 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5514 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5515 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5516 c & " xy",scalar(x_prime(1),y_prime(1)),
5517 c & " xz",scalar(x_prime(1),z_prime(1)),
5518 c & " yy",scalar(y_prime(1),y_prime(1)),
5519 c & " yz",scalar(y_prime(1),z_prime(1)),
5520 c & " zz",scalar(z_prime(1),z_prime(1))
5522 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5523 C to local coordinate system. Store in xx, yy, zz.
5529 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5530 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5531 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5538 C Compute the energy of the ith side cbain
5540 c write (2,*) "xx",xx," yy",yy," zz",zz
5543 x(j) = sc_parmin(j,it)
5546 Cc diagnostics - remove later
5548 yy1 = dsin(alph(2))*dcos(omeg(2))
5549 c zz1 = -dsin(alph(2))*dsin(omeg(2))
5550 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
5551 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5552 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5554 C," --- ", xx_w,yy_w,zz_w
5557 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5558 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5560 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5561 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5563 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5564 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5565 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5566 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5567 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5569 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5570 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5571 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5572 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5573 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5575 dsc_i = 0.743d0+x(61)
5577 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5578 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5579 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5580 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5581 s1=(1+x(63))/(0.1d0 + dscp1)
5582 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5583 s2=(1+x(65))/(0.1d0 + dscp2)
5584 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5585 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5586 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5587 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5589 c & dscp1,dscp2,sumene
5590 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5591 escloc = escloc + sumene
5592 c write (2,*) "escloc",escloc
5593 if (.not. calc_grad) goto 1
5596 C This section to check the numerical derivatives of the energy of ith side
5597 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5598 C #define DEBUG in the code to turn it on.
5600 write (2,*) "sumene =",sumene
5604 write (2,*) xx,yy,zz
5605 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5606 de_dxx_num=(sumenep-sumene)/aincr
5608 write (2,*) "xx+ sumene from enesc=",sumenep
5611 write (2,*) xx,yy,zz
5612 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5613 de_dyy_num=(sumenep-sumene)/aincr
5615 write (2,*) "yy+ sumene from enesc=",sumenep
5618 write (2,*) xx,yy,zz
5619 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5620 de_dzz_num=(sumenep-sumene)/aincr
5622 write (2,*) "zz+ sumene from enesc=",sumenep
5623 costsave=cost2tab(i+1)
5624 sintsave=sint2tab(i+1)
5625 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5626 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5627 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5628 de_dt_num=(sumenep-sumene)/aincr
5629 write (2,*) " t+ sumene from enesc=",sumenep
5630 cost2tab(i+1)=costsave
5631 sint2tab(i+1)=sintsave
5632 C End of diagnostics section.
5635 C Compute the gradient of esc
5637 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5638 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5639 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5640 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5641 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5642 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5643 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5644 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5645 pom1=(sumene3*sint2tab(i+1)+sumene1)
5646 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5647 pom2=(sumene4*cost2tab(i+1)+sumene2)
5648 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5649 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5650 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5651 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5653 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5654 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5655 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5657 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5658 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5659 & +(pom1+pom2)*pom_dx
5661 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5664 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5665 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5666 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5668 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5669 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5670 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5671 & +x(59)*zz**2 +x(60)*xx*zz
5672 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5673 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5674 & +(pom1-pom2)*pom_dy
5676 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5679 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5680 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5681 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5682 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5683 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5684 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5685 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5686 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5688 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5691 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5692 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5693 & +pom1*pom_dt1+pom2*pom_dt2
5695 write(2,*), "de_dt = ", de_dt,de_dt_num
5699 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5700 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5701 cosfac2xx=cosfac2*xx
5702 sinfac2yy=sinfac2*yy
5704 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5706 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5708 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5709 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5710 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5711 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5712 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5713 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5714 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5715 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5716 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5717 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5721 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5722 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5723 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5724 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5727 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5728 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5729 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5731 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5732 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5736 dXX_Ctab(k,i)=dXX_Ci(k)
5737 dXX_C1tab(k,i)=dXX_Ci1(k)
5738 dYY_Ctab(k,i)=dYY_Ci(k)
5739 dYY_C1tab(k,i)=dYY_Ci1(k)
5740 dZZ_Ctab(k,i)=dZZ_Ci(k)
5741 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5742 dXX_XYZtab(k,i)=dXX_XYZ(k)
5743 dYY_XYZtab(k,i)=dYY_XYZ(k)
5744 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5748 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5749 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5750 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5751 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5752 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5754 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5755 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5756 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5757 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5758 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5759 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5760 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5761 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5763 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5764 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5766 C to check gradient call subroutine check_grad
5773 c------------------------------------------------------------------------------
5774 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5776 C This procedure calculates two-body contact function g(rij) and its derivative:
5779 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5782 C where x=(rij-r0ij)/delta
5784 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5787 double precision rij,r0ij,eps0ij,fcont,fprimcont
5788 double precision x,x2,x4,delta
5792 if (x.lt.-1.0D0) then
5795 else if (x.le.1.0D0) then
5798 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5799 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5806 c------------------------------------------------------------------------------
5807 subroutine splinthet(theti,delta,ss,ssder)
5808 implicit real*8 (a-h,o-z)
5809 include 'DIMENSIONS'
5810 include 'sizesclu.dat'
5811 include 'COMMON.VAR'
5812 include 'COMMON.GEO'
5815 if (theti.gt.pipol) then
5816 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5818 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5823 c------------------------------------------------------------------------------
5824 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5826 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5827 double precision ksi,ksi2,ksi3,a1,a2,a3
5828 a1=fprim0*delta/(f1-f0)
5834 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5835 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5838 c------------------------------------------------------------------------------
5839 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5841 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5842 double precision ksi,ksi2,ksi3,a1,a2,a3
5847 a2=3*(f1x-f0x)-2*fprim0x*delta
5848 a3=fprim0x*delta-2*(f1x-f0x)
5849 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5852 C-----------------------------------------------------------------------------
5854 C-----------------------------------------------------------------------------
5855 subroutine etor(etors,edihcnstr,fact)
5856 implicit real*8 (a-h,o-z)
5857 include 'DIMENSIONS'
5858 include 'sizesclu.dat'
5859 include 'COMMON.VAR'
5860 include 'COMMON.GEO'
5861 include 'COMMON.LOCAL'
5862 include 'COMMON.TORSION'
5863 include 'COMMON.INTERACT'
5864 include 'COMMON.DERIV'
5865 include 'COMMON.CHAIN'
5866 include 'COMMON.NAMES'
5867 include 'COMMON.IOUNITS'
5868 include 'COMMON.FFIELD'
5869 include 'COMMON.TORCNSTR'
5871 C Set lprn=.true. for debugging
5875 do i=iphi_start,iphi_end
5876 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5877 & .or. itype(i).eq.ntyp1) cycle
5878 itori=itortyp(itype(i-2))
5879 itori1=itortyp(itype(i-1))
5882 C Proline-Proline pair is a special case...
5883 if (itori.eq.3 .and. itori1.eq.3) then
5884 if (phii.gt.-dwapi3) then
5886 fac=1.0D0/(1.0D0-cosphi)
5887 etorsi=v1(1,3,3)*fac
5888 etorsi=etorsi+etorsi
5889 etors=etors+etorsi-v1(1,3,3)
5890 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5893 v1ij=v1(j+1,itori,itori1)
5894 v2ij=v2(j+1,itori,itori1)
5897 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5898 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5902 v1ij=v1(j,itori,itori1)
5903 v2ij=v2(j,itori,itori1)
5906 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5907 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5911 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5912 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5913 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5914 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5915 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5917 ! 6/20/98 - dihedral angle constraints
5920 itori=idih_constr(i)
5923 if (difi.gt.drange(i)) then
5925 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5926 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5927 else if (difi.lt.-drange(i)) then
5929 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5930 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5932 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5933 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5935 ! write (iout,*) 'edihcnstr',edihcnstr
5938 c------------------------------------------------------------------------------
5940 subroutine etor(etors,edihcnstr,fact)
5941 implicit real*8 (a-h,o-z)
5942 include 'DIMENSIONS'
5943 include 'sizesclu.dat'
5944 include 'COMMON.VAR'
5945 include 'COMMON.GEO'
5946 include 'COMMON.LOCAL'
5947 include 'COMMON.TORSION'
5948 include 'COMMON.INTERACT'
5949 include 'COMMON.DERIV'
5950 include 'COMMON.CHAIN'
5951 include 'COMMON.NAMES'
5952 include 'COMMON.IOUNITS'
5953 include 'COMMON.FFIELD'
5954 include 'COMMON.TORCNSTR'
5956 C Set lprn=.true. for debugging
5960 do i=iphi_start,iphi_end
5962 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5963 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5964 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5965 if (iabs(itype(i)).eq.20) then
5970 itori=itortyp(itype(i-2))
5971 itori1=itortyp(itype(i-1))
5974 C Regular cosine and sine terms
5975 do j=1,nterm(itori,itori1,iblock)
5976 v1ij=v1(j,itori,itori1,iblock)
5977 v2ij=v2(j,itori,itori1,iblock)
5980 etors=etors+v1ij*cosphi+v2ij*sinphi
5981 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5985 C E = SUM ----------------------------------- - v1
5986 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5988 cosphi=dcos(0.5d0*phii)
5989 sinphi=dsin(0.5d0*phii)
5990 do j=1,nlor(itori,itori1,iblock)
5991 vl1ij=vlor1(j,itori,itori1)
5992 vl2ij=vlor2(j,itori,itori1)
5993 vl3ij=vlor3(j,itori,itori1)
5994 pom=vl2ij*cosphi+vl3ij*sinphi
5995 pom1=1.0d0/(pom*pom+1.0d0)
5996 etors=etors+vl1ij*pom1
5998 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6000 C Subtract the constant term
6001 etors=etors-v0(itori,itori1,iblock)
6003 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6004 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6005 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
6006 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
6007 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6010 ! 6/20/98 - dihedral angle constraints
6013 itori=idih_constr(i)
6015 difi=pinorm(phii-phi0(i))
6017 if (difi.gt.drange(i)) then
6019 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6020 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6021 edihi=0.25d0*ftors(i)*difi**4
6022 else if (difi.lt.-drange(i)) then
6024 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6025 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6026 edihi=0.25d0*ftors(i)*difi**4
6030 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
6032 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6033 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6035 ! write (iout,*) 'edihcnstr',edihcnstr
6038 c----------------------------------------------------------------------------
6039 subroutine etor_d(etors_d,fact2)
6040 C 6/23/01 Compute double torsional energy
6041 implicit real*8 (a-h,o-z)
6042 include 'DIMENSIONS'
6043 include 'sizesclu.dat'
6044 include 'COMMON.VAR'
6045 include 'COMMON.GEO'
6046 include 'COMMON.LOCAL'
6047 include 'COMMON.TORSION'
6048 include 'COMMON.INTERACT'
6049 include 'COMMON.DERIV'
6050 include 'COMMON.CHAIN'
6051 include 'COMMON.NAMES'
6052 include 'COMMON.IOUNITS'
6053 include 'COMMON.FFIELD'
6054 include 'COMMON.TORCNSTR'
6056 C Set lprn=.true. for debugging
6060 do i=iphi_start,iphi_end-1
6062 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
6063 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
6064 & (itype(i+1).eq.ntyp1)) cycle
6065 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
6067 itori=itortyp(itype(i-2))
6068 itori1=itortyp(itype(i-1))
6069 itori2=itortyp(itype(i))
6075 if (iabs(itype(i+1)).eq.20) iblock=2
6076 C Regular cosine and sine terms
6077 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6078 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6079 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6080 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6081 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6082 cosphi1=dcos(j*phii)
6083 sinphi1=dsin(j*phii)
6084 cosphi2=dcos(j*phii1)
6085 sinphi2=dsin(j*phii1)
6086 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6087 & v2cij*cosphi2+v2sij*sinphi2
6088 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6089 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6091 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6093 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6094 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6095 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6096 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6097 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6098 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6099 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6100 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6101 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6102 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6103 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6104 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6105 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6106 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6109 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
6110 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
6116 c------------------------------------------------------------------------------
6117 subroutine eback_sc_corr(esccor)
6118 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6119 c conformational states; temporarily implemented as differences
6120 c between UNRES torsional potentials (dependent on three types of
6121 c residues) and the torsional potentials dependent on all 20 types
6122 c of residues computed from AM1 energy surfaces of terminally-blocked
6123 c amino-acid residues.
6124 implicit real*8 (a-h,o-z)
6125 include 'DIMENSIONS'
6126 include 'sizesclu.dat'
6127 include 'COMMON.VAR'
6128 include 'COMMON.GEO'
6129 include 'COMMON.LOCAL'
6130 include 'COMMON.TORSION'
6131 include 'COMMON.SCCOR'
6132 include 'COMMON.INTERACT'
6133 include 'COMMON.DERIV'
6134 include 'COMMON.CHAIN'
6135 include 'COMMON.NAMES'
6136 include 'COMMON.IOUNITS'
6137 include 'COMMON.FFIELD'
6138 include 'COMMON.CONTROL'
6140 C Set lprn=.true. for debugging
6143 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
6145 do i=itau_start,itau_end
6146 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6148 isccori=isccortyp(itype(i-2))
6149 isccori1=isccortyp(itype(i-1))
6151 do intertyp=1,3 !intertyp
6152 cc Added 09 May 2012 (Adasko)
6153 cc Intertyp means interaction type of backbone mainchain correlation:
6154 c 1 = SC...Ca...Ca...Ca
6155 c 2 = Ca...Ca...Ca...SC
6156 c 3 = SC...Ca...Ca...SCi
6158 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6159 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6160 & (itype(i-1).eq.ntyp1)))
6161 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6162 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6163 & .or.(itype(i).eq.ntyp1)))
6164 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6165 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6166 & (itype(i-3).eq.ntyp1)))) cycle
6167 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6168 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6170 do j=1,nterm_sccor(isccori,isccori1)
6171 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6172 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6173 cosphi=dcos(j*tauangle(intertyp,i))
6174 sinphi=dsin(j*tauangle(intertyp,i))
6175 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6176 c gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6178 c write (iout,*) "EBACK_SC_COR",i,esccor,intertyp
6179 c gloc_sc(intertyp,i-3)=gloc_sc(intertyp,i-3)+wsccor*gloci
6181 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6182 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6183 & (v1sccor(j,1,itori,itori1),j=1,6),
6184 & (v2sccor(j,1,itori,itori1),j=1,6)
6185 gsccor_loc(i-3)=gloci
6190 c------------------------------------------------------------------------------
6191 subroutine multibody(ecorr)
6192 C This subroutine calculates multi-body contributions to energy following
6193 C the idea of Skolnick et al. If side chains I and J make a contact and
6194 C at the same time side chains I+1 and J+1 make a contact, an extra
6195 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6196 implicit real*8 (a-h,o-z)
6197 include 'DIMENSIONS'
6198 include 'COMMON.IOUNITS'
6199 include 'COMMON.DERIV'
6200 include 'COMMON.INTERACT'
6201 include 'COMMON.CONTACTS'
6202 double precision gx(3),gx1(3)
6205 C Set lprn=.true. for debugging
6209 write (iout,'(a)') 'Contact function values:'
6211 write (iout,'(i2,20(1x,i2,f10.5))')
6212 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6227 num_conti=num_cont(i)
6228 num_conti1=num_cont(i1)
6233 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6234 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6235 cd & ' ishift=',ishift
6236 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6237 C The system gains extra energy.
6238 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6239 endif ! j1==j+-ishift
6248 c------------------------------------------------------------------------------
6249 double precision function esccorr(i,j,k,l,jj,kk)
6250 implicit real*8 (a-h,o-z)
6251 include 'DIMENSIONS'
6252 include 'COMMON.IOUNITS'
6253 include 'COMMON.DERIV'
6254 include 'COMMON.INTERACT'
6255 include 'COMMON.CONTACTS'
6256 double precision gx(3),gx1(3)
6261 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6262 C Calculate the multi-body contribution to energy.
6263 C Calculate multi-body contributions to the gradient.
6264 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6265 cd & k,l,(gacont(m,kk,k),m=1,3)
6267 gx(m) =ekl*gacont(m,jj,i)
6268 gx1(m)=eij*gacont(m,kk,k)
6269 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6270 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6271 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6272 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6276 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6281 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6287 c------------------------------------------------------------------------------
6289 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
6290 implicit real*8 (a-h,o-z)
6291 include 'DIMENSIONS'
6292 integer dimen1,dimen2,atom,indx
6293 double precision buffer(dimen1,dimen2)
6294 double precision zapas
6295 common /contacts_hb/ zapas(3,20,maxres,7),
6296 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
6297 & num_cont_hb(maxres),jcont_hb(20,maxres)
6298 num_kont=num_cont_hb(atom)
6302 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
6305 buffer(i,indx+22)=facont_hb(i,atom)
6306 buffer(i,indx+23)=ees0p(i,atom)
6307 buffer(i,indx+24)=ees0m(i,atom)
6308 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
6310 buffer(1,indx+26)=dfloat(num_kont)
6313 c------------------------------------------------------------------------------
6314 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
6315 implicit real*8 (a-h,o-z)
6316 include 'DIMENSIONS'
6317 integer dimen1,dimen2,atom,indx
6318 double precision buffer(dimen1,dimen2)
6319 double precision zapas
6320 common /contacts_hb/ zapas(3,ntyp,maxres,7),
6321 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
6322 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
6323 num_kont=buffer(1,indx+26)
6324 num_kont_old=num_cont_hb(atom)
6325 num_cont_hb(atom)=num_kont+num_kont_old
6330 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
6333 facont_hb(ii,atom)=buffer(i,indx+22)
6334 ees0p(ii,atom)=buffer(i,indx+23)
6335 ees0m(ii,atom)=buffer(i,indx+24)
6336 jcont_hb(ii,atom)=buffer(i,indx+25)
6340 c------------------------------------------------------------------------------
6342 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6343 C This subroutine calculates multi-body contributions to hydrogen-bonding
6344 implicit real*8 (a-h,o-z)
6345 include 'DIMENSIONS'
6346 include 'sizesclu.dat'
6347 include 'COMMON.IOUNITS'
6349 include 'COMMON.INFO'
6351 include 'COMMON.FFIELD'
6352 include 'COMMON.DERIV'
6353 include 'COMMON.INTERACT'
6354 include 'COMMON.CONTACTS'
6356 parameter (max_cont=maxconts)
6357 parameter (max_dim=2*(8*3+2))
6358 parameter (msglen1=max_cont*max_dim*4)
6359 parameter (msglen2=2*msglen1)
6360 integer source,CorrelType,CorrelID,Error
6361 double precision buffer(max_cont,max_dim)
6363 double precision gx(3),gx1(3)
6366 C Set lprn=.true. for debugging
6371 if (fgProcs.le.1) goto 30
6373 write (iout,'(a)') 'Contact function values:'
6375 write (iout,'(2i3,50(1x,i2,f5.2))')
6376 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6377 & j=1,num_cont_hb(i))
6380 C Caution! Following code assumes that electrostatic interactions concerning
6381 C a given atom are split among at most two processors!
6391 cd write (iout,*) 'MyRank',MyRank,' mm',mm
6394 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
6395 if (MyRank.gt.0) then
6396 C Send correlation contributions to the preceding processor
6398 nn=num_cont_hb(iatel_s)
6399 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
6400 cd write (iout,*) 'The BUFFER array:'
6402 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
6404 if (ielstart(iatel_s).gt.iatel_s+ispp) then
6406 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
6407 C Clear the contacts of the atom passed to the neighboring processor
6408 nn=num_cont_hb(iatel_s+1)
6410 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
6412 num_cont_hb(iatel_s)=0
6414 cd write (iout,*) 'Processor ',MyID,MyRank,
6415 cd & ' is sending correlation contribution to processor',MyID-1,
6416 cd & ' msglen=',msglen
6417 cd write (*,*) 'Processor ',MyID,MyRank,
6418 cd & ' is sending correlation contribution to processor',MyID-1,
6419 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6420 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
6421 cd write (iout,*) 'Processor ',MyID,
6422 cd & ' has sent correlation contribution to processor',MyID-1,
6423 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6424 cd write (*,*) 'Processor ',MyID,
6425 cd & ' has sent correlation contribution to processor',MyID-1,
6426 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6428 endif ! (MyRank.gt.0)
6432 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6433 if (MyRank.lt.fgProcs-1) then
6434 C Receive correlation contributions from the next processor
6436 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6437 cd write (iout,*) 'Processor',MyID,
6438 cd & ' is receiving correlation contribution from processor',MyID+1,
6439 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6440 cd write (*,*) 'Processor',MyID,
6441 cd & ' is receiving correlation contribution from processor',MyID+1,
6442 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6444 do while (nbytes.le.0)
6445 call mp_probe(MyID+1,CorrelType,nbytes)
6447 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6448 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6449 cd write (iout,*) 'Processor',MyID,
6450 cd & ' has received correlation contribution from processor',MyID+1,
6451 cd & ' msglen=',msglen,' nbytes=',nbytes
6452 cd write (iout,*) 'The received BUFFER array:'
6454 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6456 if (msglen.eq.msglen1) then
6457 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6458 else if (msglen.eq.msglen2) then
6459 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6460 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6463 & 'ERROR!!!! message length changed while processing correlations.'
6465 & 'ERROR!!!! message length changed while processing correlations.'
6466 call mp_stopall(Error)
6467 endif ! msglen.eq.msglen1
6468 endif ! MyRank.lt.fgProcs-1
6475 write (iout,'(a)') 'Contact function values:'
6477 write (iout,'(2i3,50(1x,i2,f5.2))')
6478 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6479 & j=1,num_cont_hb(i))
6483 C Remove the loop below after debugging !!!
6490 C Calculate the local-electrostatic correlation terms
6491 do i=iatel_s,iatel_e+1
6493 num_conti=num_cont_hb(i)
6494 num_conti1=num_cont_hb(i+1)
6499 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6500 c & ' jj=',jj,' kk=',kk
6501 if (j1.eq.j+1 .or. j1.eq.j-1) then
6502 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6503 C The system gains extra energy.
6504 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6506 else if (j1.eq.j) then
6507 C Contacts I-J and I-(J+1) occur simultaneously.
6508 C The system loses extra energy.
6509 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6514 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6515 c & ' jj=',jj,' kk=',kk
6517 C Contacts I-J and (I+1)-J occur simultaneously.
6518 C The system loses extra energy.
6519 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6526 c------------------------------------------------------------------------------
6527 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6529 C This subroutine calculates multi-body contributions to hydrogen-bonding
6530 implicit real*8 (a-h,o-z)
6531 include 'DIMENSIONS'
6532 include 'sizesclu.dat'
6533 include 'COMMON.IOUNITS'
6535 include 'COMMON.INFO'
6537 include 'COMMON.FFIELD'
6538 include 'COMMON.DERIV'
6539 include 'COMMON.INTERACT'
6540 include 'COMMON.CONTACTS'
6542 parameter (max_cont=maxconts)
6543 parameter (max_dim=2*(8*3+2))
6544 parameter (msglen1=max_cont*max_dim*4)
6545 parameter (msglen2=2*msglen1)
6546 integer source,CorrelType,CorrelID,Error
6547 double precision buffer(max_cont,max_dim)
6549 double precision gx(3),gx1(3)
6552 C Set lprn=.true. for debugging
6558 if (fgProcs.le.1) goto 30
6560 write (iout,'(a)') 'Contact function values:'
6562 write (iout,'(2i3,50(1x,i2,f5.2))')
6563 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6564 & j=1,num_cont_hb(i))
6567 C Caution! Following code assumes that electrostatic interactions concerning
6568 C a given atom are split among at most two processors!
6578 cd write (iout,*) 'MyRank',MyRank,' mm',mm
6581 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
6582 if (MyRank.gt.0) then
6583 C Send correlation contributions to the preceding processor
6585 nn=num_cont_hb(iatel_s)
6586 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
6587 cd write (iout,*) 'The BUFFER array:'
6589 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
6591 if (ielstart(iatel_s).gt.iatel_s+ispp) then
6593 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
6594 C Clear the contacts of the atom passed to the neighboring processor
6595 nn=num_cont_hb(iatel_s+1)
6597 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
6599 num_cont_hb(iatel_s)=0
6601 cd write (iout,*) 'Processor ',MyID,MyRank,
6602 cd & ' is sending correlation contribution to processor',MyID-1,
6603 cd & ' msglen=',msglen
6604 cd write (*,*) 'Processor ',MyID,MyRank,
6605 cd & ' is sending correlation contribution to processor',MyID-1,
6606 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6607 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
6608 cd write (iout,*) 'Processor ',MyID,
6609 cd & ' has sent correlation contribution to processor',MyID-1,
6610 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6611 cd write (*,*) 'Processor ',MyID,
6612 cd & ' has sent correlation contribution to processor',MyID-1,
6613 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6615 endif ! (MyRank.gt.0)
6619 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6620 if (MyRank.lt.fgProcs-1) then
6621 C Receive correlation contributions from the next processor
6623 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6624 cd write (iout,*) 'Processor',MyID,
6625 cd & ' is receiving correlation contribution from processor',MyID+1,
6626 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6627 cd write (*,*) 'Processor',MyID,
6628 cd & ' is receiving correlation contribution from processor',MyID+1,
6629 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6631 do while (nbytes.le.0)
6632 call mp_probe(MyID+1,CorrelType,nbytes)
6634 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6635 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6636 cd write (iout,*) 'Processor',MyID,
6637 cd & ' has received correlation contribution from processor',MyID+1,
6638 cd & ' msglen=',msglen,' nbytes=',nbytes
6639 cd write (iout,*) 'The received BUFFER array:'
6641 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6643 if (msglen.eq.msglen1) then
6644 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6645 else if (msglen.eq.msglen2) then
6646 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6647 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6650 & 'ERROR!!!! message length changed while processing correlations.'
6652 & 'ERROR!!!! message length changed while processing correlations.'
6653 call mp_stopall(Error)
6654 endif ! msglen.eq.msglen1
6655 endif ! MyRank.lt.fgProcs-1
6662 write (iout,'(a)') 'Contact function values:'
6664 write (iout,'(2i3,50(1x,i2,f5.2))')
6665 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6666 & j=1,num_cont_hb(i))
6672 C Remove the loop below after debugging !!!
6679 C Calculate the dipole-dipole interaction energies
6680 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6681 do i=iatel_s,iatel_e+1
6682 num_conti=num_cont_hb(i)
6689 C Calculate the local-electrostatic correlation terms
6690 do i=iatel_s,iatel_e+1
6692 num_conti=num_cont_hb(i)
6693 num_conti1=num_cont_hb(i+1)
6698 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6699 c & ' jj=',jj,' kk=',kk
6700 if (j1.eq.j+1 .or. j1.eq.j-1) then
6701 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6702 C The system gains extra energy.
6704 sqd1=dsqrt(d_cont(jj,i))
6705 sqd2=dsqrt(d_cont(kk,i1))
6706 sred_geom = sqd1*sqd2
6707 IF (sred_geom.lt.cutoff_corr) THEN
6708 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6710 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6711 c & ' jj=',jj,' kk=',kk
6712 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6713 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6715 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6716 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6719 cd write (iout,*) 'sred_geom=',sred_geom,
6720 cd & ' ekont=',ekont,' fprim=',fprimcont
6721 call calc_eello(i,j,i+1,j1,jj,kk)
6722 if (wcorr4.gt.0.0d0)
6723 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
6724 if (wcorr5.gt.0.0d0)
6725 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
6726 c print *,"wcorr5",ecorr5
6727 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6728 cd write(2,*)'ijkl',i,j,i+1,j1
6729 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
6730 & .or. wturn6.eq.0.0d0))then
6731 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6732 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
6733 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6734 cd & 'ecorr6=',ecorr6
6735 cd write (iout,'(4e15.5)') sred_geom,
6736 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
6737 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
6738 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
6739 else if (wturn6.gt.0.0d0
6740 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
6741 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
6742 eturn6=eturn6+eello_turn6(i,jj,kk)
6743 cd write (2,*) 'multibody_eello:eturn6',eturn6
6747 else if (j1.eq.j) then
6748 C Contacts I-J and I-(J+1) occur simultaneously.
6749 C The system loses extra energy.
6750 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6755 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6756 c & ' jj=',jj,' kk=',kk
6758 C Contacts I-J and (I+1)-J occur simultaneously.
6759 C The system loses extra energy.
6760 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6767 c------------------------------------------------------------------------------
6768 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6769 implicit real*8 (a-h,o-z)
6770 include 'DIMENSIONS'
6771 include 'COMMON.IOUNITS'
6772 include 'COMMON.DERIV'
6773 include 'COMMON.INTERACT'
6774 include 'COMMON.CONTACTS'
6775 include 'COMMON.SHIELD'
6777 double precision gx(3),gx1(3)
6787 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6788 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6789 C Following 4 lines for diagnostics.
6794 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
6796 c write (iout,*)'Contacts have occurred for peptide groups',
6797 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
6798 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
6799 C Calculate the multi-body contribution to energy.
6800 ecorr=ecorr+ekont*ees
6802 C Calculate multi-body contributions to the gradient.
6804 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
6805 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
6806 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
6807 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
6808 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
6809 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
6810 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
6811 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
6812 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
6813 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
6814 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
6815 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
6816 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
6817 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
6821 gradcorr(ll,m)=gradcorr(ll,m)+
6822 & ees*ekl*gacont_hbr(ll,jj,i)-
6823 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6824 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6829 gradcorr(ll,m)=gradcorr(ll,m)+
6830 & ees*eij*gacont_hbr(ll,kk,k)-
6831 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6832 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6835 if (shield_mode.gt.0) then
6838 C print *,i,j,fac_shield(i),fac_shield(j),
6839 C &fac_shield(k),fac_shield(l)
6840 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
6841 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
6842 do ilist=1,ishield_list(i)
6843 iresshield=shield_list(ilist,i)
6845 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
6847 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6849 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
6850 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6854 do ilist=1,ishield_list(j)
6855 iresshield=shield_list(ilist,j)
6857 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
6859 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6861 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
6862 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6866 do ilist=1,ishield_list(k)
6867 iresshield=shield_list(ilist,k)
6869 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
6871 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6873 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
6874 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6878 do ilist=1,ishield_list(l)
6879 iresshield=shield_list(ilist,l)
6881 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
6883 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6885 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
6886 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6890 C print *,gshieldx(m,iresshield)
6892 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
6893 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6894 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
6895 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6896 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
6897 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6898 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
6899 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6901 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
6902 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6903 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
6904 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6905 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
6906 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6907 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
6908 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6917 C---------------------------------------------------------------------------
6918 subroutine dipole(i,j,jj)
6919 implicit real*8 (a-h,o-z)
6920 include 'DIMENSIONS'
6921 include 'sizesclu.dat'
6922 include 'COMMON.IOUNITS'
6923 include 'COMMON.CHAIN'
6924 include 'COMMON.FFIELD'
6925 include 'COMMON.DERIV'
6926 include 'COMMON.INTERACT'
6927 include 'COMMON.CONTACTS'
6928 include 'COMMON.TORSION'
6929 include 'COMMON.VAR'
6930 include 'COMMON.GEO'
6931 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6933 iti1 = itortyp(itype(i+1))
6934 if (j.lt.nres-1) then
6935 if (itype(j).le.ntyp) then
6936 itj1 = itortyp(itype(j+1))
6944 dipi(iii,1)=Ub2(iii,i)
6945 dipderi(iii)=Ub2der(iii,i)
6946 dipi(iii,2)=b1(iii,iti1)
6947 dipj(iii,1)=Ub2(iii,j)
6948 dipderj(iii)=Ub2der(iii,j)
6949 dipj(iii,2)=b1(iii,itj1)
6953 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6956 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6959 if (.not.calc_grad) return
6964 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6968 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6973 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6974 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6976 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6978 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6980 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6984 C---------------------------------------------------------------------------
6985 subroutine calc_eello(i,j,k,l,jj,kk)
6987 C This subroutine computes matrices and vectors needed to calculate
6988 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6990 implicit real*8 (a-h,o-z)
6991 include 'DIMENSIONS'
6992 include 'sizesclu.dat'
6993 include 'COMMON.IOUNITS'
6994 include 'COMMON.CHAIN'
6995 include 'COMMON.DERIV'
6996 include 'COMMON.INTERACT'
6997 include 'COMMON.CONTACTS'
6998 include 'COMMON.TORSION'
6999 include 'COMMON.VAR'
7000 include 'COMMON.GEO'
7001 include 'COMMON.FFIELD'
7002 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7003 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7006 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7007 cd & ' jj=',jj,' kk=',kk
7008 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7011 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7012 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7015 call transpose2(aa1(1,1),aa1t(1,1))
7016 call transpose2(aa2(1,1),aa2t(1,1))
7019 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7020 & aa1tder(1,1,lll,kkk))
7021 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7022 & aa2tder(1,1,lll,kkk))
7026 C parallel orientation of the two CA-CA-CA frames.
7028 if (i.gt.1 .and. itype(i).le.ntyp) then
7029 iti=itortyp(itype(i))
7033 itk1=itortyp(itype(k+1))
7034 itj=itortyp(itype(j))
7035 c if (l.lt.nres-1) then
7036 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
7037 itl1=itortyp(itype(l+1))
7041 C A1 kernel(j+1) A2T
7043 cd write (iout,'(3f10.5,5x,3f10.5)')
7044 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7046 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7047 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7048 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7049 C Following matrices are needed only for 6-th order cumulants
7050 IF (wcorr6.gt.0.0d0) THEN
7051 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7052 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7053 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7054 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7055 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7056 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7057 & ADtEAderx(1,1,1,1,1,1))
7059 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7060 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7061 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7062 & ADtEA1derx(1,1,1,1,1,1))
7064 C End 6-th order cumulants
7067 cd write (2,*) 'In calc_eello6'
7069 cd write (2,*) 'iii=',iii
7071 cd write (2,*) 'kkk=',kkk
7073 cd write (2,'(3(2f10.5),5x)')
7074 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7079 call transpose2(EUgder(1,1,k),auxmat(1,1))
7080 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7081 call transpose2(EUg(1,1,k),auxmat(1,1))
7082 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7083 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7087 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7088 & EAEAderx(1,1,lll,kkk,iii,1))
7092 C A1T kernel(i+1) A2
7093 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7094 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7095 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7096 C Following matrices are needed only for 6-th order cumulants
7097 IF (wcorr6.gt.0.0d0) THEN
7098 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7099 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7100 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7101 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7102 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7103 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7104 & ADtEAderx(1,1,1,1,1,2))
7105 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7106 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7107 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7108 & ADtEA1derx(1,1,1,1,1,2))
7110 C End 6-th order cumulants
7111 call transpose2(EUgder(1,1,l),auxmat(1,1))
7112 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7113 call transpose2(EUg(1,1,l),auxmat(1,1))
7114 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7115 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7119 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7120 & EAEAderx(1,1,lll,kkk,iii,2))
7125 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7126 C They are needed only when the fifth- or the sixth-order cumulants are
7128 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7129 call transpose2(AEA(1,1,1),auxmat(1,1))
7130 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7131 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7132 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7133 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7134 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7135 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7136 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7137 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7138 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7139 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7140 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7141 call transpose2(AEA(1,1,2),auxmat(1,1))
7142 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7143 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7144 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7145 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7146 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7147 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7148 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7149 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7150 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7151 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7152 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7153 C Calculate the Cartesian derivatives of the vectors.
7157 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7158 call matvec2(auxmat(1,1),b1(1,iti),
7159 & AEAb1derx(1,lll,kkk,iii,1,1))
7160 call matvec2(auxmat(1,1),Ub2(1,i),
7161 & AEAb2derx(1,lll,kkk,iii,1,1))
7162 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7163 & AEAb1derx(1,lll,kkk,iii,2,1))
7164 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7165 & AEAb2derx(1,lll,kkk,iii,2,1))
7166 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7167 call matvec2(auxmat(1,1),b1(1,itj),
7168 & AEAb1derx(1,lll,kkk,iii,1,2))
7169 call matvec2(auxmat(1,1),Ub2(1,j),
7170 & AEAb2derx(1,lll,kkk,iii,1,2))
7171 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7172 & AEAb1derx(1,lll,kkk,iii,2,2))
7173 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7174 & AEAb2derx(1,lll,kkk,iii,2,2))
7181 C Antiparallel orientation of the two CA-CA-CA frames.
7183 if (i.gt.1 .and. itype(i).le.ntyp) then
7184 iti=itortyp(itype(i))
7188 itk1=itortyp(itype(k+1))
7189 itl=itortyp(itype(l))
7190 itj=itortyp(itype(j))
7191 c if (j.lt.nres-1) then
7192 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7193 itj1=itortyp(itype(j+1))
7197 C A2 kernel(j-1)T A1T
7198 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7199 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7200 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7201 C Following matrices are needed only for 6-th order cumulants
7202 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7203 & j.eq.i+4 .and. l.eq.i+3)) THEN
7204 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7205 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7206 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7207 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7208 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7209 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7210 & ADtEAderx(1,1,1,1,1,1))
7211 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7212 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7213 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7214 & ADtEA1derx(1,1,1,1,1,1))
7216 C End 6-th order cumulants
7217 call transpose2(EUgder(1,1,k),auxmat(1,1))
7218 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7219 call transpose2(EUg(1,1,k),auxmat(1,1))
7220 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7221 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7225 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7226 & EAEAderx(1,1,lll,kkk,iii,1))
7230 C A2T kernel(i+1)T A1
7231 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7232 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7233 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7234 C Following matrices are needed only for 6-th order cumulants
7235 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7236 & j.eq.i+4 .and. l.eq.i+3)) THEN
7237 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7238 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7239 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7240 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7241 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7242 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7243 & ADtEAderx(1,1,1,1,1,2))
7244 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7245 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7246 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7247 & ADtEA1derx(1,1,1,1,1,2))
7249 C End 6-th order cumulants
7250 call transpose2(EUgder(1,1,j),auxmat(1,1))
7251 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7252 call transpose2(EUg(1,1,j),auxmat(1,1))
7253 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7254 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7258 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7259 & EAEAderx(1,1,lll,kkk,iii,2))
7264 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7265 C They are needed only when the fifth- or the sixth-order cumulants are
7267 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7268 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7269 call transpose2(AEA(1,1,1),auxmat(1,1))
7270 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7271 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7272 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7273 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7274 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7275 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7276 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7277 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7278 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7279 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7280 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7281 call transpose2(AEA(1,1,2),auxmat(1,1))
7282 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7283 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7284 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7285 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7286 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7287 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7288 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7289 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7290 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7291 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7292 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7293 C Calculate the Cartesian derivatives of the vectors.
7297 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7298 call matvec2(auxmat(1,1),b1(1,iti),
7299 & AEAb1derx(1,lll,kkk,iii,1,1))
7300 call matvec2(auxmat(1,1),Ub2(1,i),
7301 & AEAb2derx(1,lll,kkk,iii,1,1))
7302 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7303 & AEAb1derx(1,lll,kkk,iii,2,1))
7304 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7305 & AEAb2derx(1,lll,kkk,iii,2,1))
7306 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7307 call matvec2(auxmat(1,1),b1(1,itl),
7308 & AEAb1derx(1,lll,kkk,iii,1,2))
7309 call matvec2(auxmat(1,1),Ub2(1,l),
7310 & AEAb2derx(1,lll,kkk,iii,1,2))
7311 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7312 & AEAb1derx(1,lll,kkk,iii,2,2))
7313 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7314 & AEAb2derx(1,lll,kkk,iii,2,2))
7323 C---------------------------------------------------------------------------
7324 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7325 & KK,KKderg,AKA,AKAderg,AKAderx)
7329 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7330 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7331 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7336 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7338 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7341 cd if (lprn) write (2,*) 'In kernel'
7343 cd if (lprn) write (2,*) 'kkk=',kkk
7345 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7346 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7348 cd write (2,*) 'lll=',lll
7349 cd write (2,*) 'iii=1'
7351 cd write (2,'(3(2f10.5),5x)')
7352 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7355 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7356 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7358 cd write (2,*) 'lll=',lll
7359 cd write (2,*) 'iii=2'
7361 cd write (2,'(3(2f10.5),5x)')
7362 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7369 C---------------------------------------------------------------------------
7370 double precision function eello4(i,j,k,l,jj,kk)
7371 implicit real*8 (a-h,o-z)
7372 include 'DIMENSIONS'
7373 include 'sizesclu.dat'
7374 include 'COMMON.IOUNITS'
7375 include 'COMMON.CHAIN'
7376 include 'COMMON.DERIV'
7377 include 'COMMON.INTERACT'
7378 include 'COMMON.CONTACTS'
7379 include 'COMMON.TORSION'
7380 include 'COMMON.VAR'
7381 include 'COMMON.GEO'
7382 double precision pizda(2,2),ggg1(3),ggg2(3)
7383 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7387 cd print *,'eello4:',i,j,k,l,jj,kk
7388 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7389 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7390 cold eij=facont_hb(jj,i)
7391 cold ekl=facont_hb(kk,k)
7393 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7395 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7396 gcorr_loc(k-1)=gcorr_loc(k-1)
7397 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7399 gcorr_loc(l-1)=gcorr_loc(l-1)
7400 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7402 gcorr_loc(j-1)=gcorr_loc(j-1)
7403 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7408 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7409 & -EAEAderx(2,2,lll,kkk,iii,1)
7410 cd derx(lll,kkk,iii)=0.0d0
7414 cd gcorr_loc(l-1)=0.0d0
7415 cd gcorr_loc(j-1)=0.0d0
7416 cd gcorr_loc(k-1)=0.0d0
7418 cd write (iout,*)'Contacts have occurred for peptide groups',
7419 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7420 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7421 if (j.lt.nres-1) then
7428 if (l.lt.nres-1) then
7436 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
7437 ggg1(ll)=eel4*g_contij(ll,1)
7438 ggg2(ll)=eel4*g_contij(ll,2)
7439 ghalf=0.5d0*ggg1(ll)
7441 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
7442 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7443 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
7444 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7445 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
7446 ghalf=0.5d0*ggg2(ll)
7448 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
7449 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7450 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
7451 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7456 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
7457 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7462 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
7463 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7469 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7474 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7478 cd write (2,*) iii,gcorr_loc(iii)
7482 cd write (2,*) 'ekont',ekont
7483 cd write (iout,*) 'eello4',ekont*eel4
7486 C---------------------------------------------------------------------------
7487 double precision function eello5(i,j,k,l,jj,kk)
7488 implicit real*8 (a-h,o-z)
7489 include 'DIMENSIONS'
7490 include 'sizesclu.dat'
7491 include 'COMMON.IOUNITS'
7492 include 'COMMON.CHAIN'
7493 include 'COMMON.DERIV'
7494 include 'COMMON.INTERACT'
7495 include 'COMMON.CONTACTS'
7496 include 'COMMON.TORSION'
7497 include 'COMMON.VAR'
7498 include 'COMMON.GEO'
7499 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7500 double precision ggg1(3),ggg2(3)
7501 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7506 C /l\ / \ \ / \ / \ / C
7507 C / \ / \ \ / \ / \ / C
7508 C j| o |l1 | o | o| o | | o |o C
7509 C \ |/k\| |/ \| / |/ \| |/ \| C
7510 C \i/ \ / \ / / \ / \ C
7512 C (I) (II) (III) (IV) C
7514 C eello5_1 eello5_2 eello5_3 eello5_4 C
7516 C Antiparallel chains C
7519 C /j\ / \ \ / \ / \ / C
7520 C / \ / \ \ / \ / \ / C
7521 C j1| o |l | 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 o denotes a local interaction, vertical lines an electrostatic interaction. C
7531 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7532 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7537 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7539 itk=itortyp(itype(k))
7540 itl=itortyp(itype(l))
7541 itj=itortyp(itype(j))
7546 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7547 cd & eel5_3_num,eel5_4_num)
7551 derx(lll,kkk,iii)=0.0d0
7555 cd eij=facont_hb(jj,i)
7556 cd ekl=facont_hb(kk,k)
7558 cd write (iout,*)'Contacts have occurred for peptide groups',
7559 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7561 C Contribution from the graph I.
7562 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7563 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7564 call transpose2(EUg(1,1,k),auxmat(1,1))
7565 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7566 vv(1)=pizda(1,1)-pizda(2,2)
7567 vv(2)=pizda(1,2)+pizda(2,1)
7568 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7569 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7571 C Explicit gradient in virtual-dihedral angles.
7572 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7573 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7574 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7575 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7576 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7577 vv(1)=pizda(1,1)-pizda(2,2)
7578 vv(2)=pizda(1,2)+pizda(2,1)
7579 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7580 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7581 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7582 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7583 vv(1)=pizda(1,1)-pizda(2,2)
7584 vv(2)=pizda(1,2)+pizda(2,1)
7586 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7587 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7588 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7590 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7591 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7592 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7594 C Cartesian gradient
7598 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7600 vv(1)=pizda(1,1)-pizda(2,2)
7601 vv(2)=pizda(1,2)+pizda(2,1)
7602 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7603 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7604 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7611 C Contribution from graph II
7612 call transpose2(EE(1,1,itk),auxmat(1,1))
7613 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7614 vv(1)=pizda(1,1)+pizda(2,2)
7615 vv(2)=pizda(2,1)-pizda(1,2)
7616 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7617 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7619 C Explicit gradient in virtual-dihedral angles.
7620 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7621 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7622 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7623 vv(1)=pizda(1,1)+pizda(2,2)
7624 vv(2)=pizda(2,1)-pizda(1,2)
7626 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7627 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7628 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7630 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7631 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7632 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7634 C Cartesian gradient
7638 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7640 vv(1)=pizda(1,1)+pizda(2,2)
7641 vv(2)=pizda(2,1)-pizda(1,2)
7642 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7643 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7644 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7653 C Parallel orientation
7654 C Contribution from graph III
7655 call transpose2(EUg(1,1,l),auxmat(1,1))
7656 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7657 vv(1)=pizda(1,1)-pizda(2,2)
7658 vv(2)=pizda(1,2)+pizda(2,1)
7659 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7660 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7662 C Explicit gradient in virtual-dihedral angles.
7663 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7664 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7665 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7666 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7667 vv(1)=pizda(1,1)-pizda(2,2)
7668 vv(2)=pizda(1,2)+pizda(2,1)
7669 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7670 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7671 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7672 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7673 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7674 vv(1)=pizda(1,1)-pizda(2,2)
7675 vv(2)=pizda(1,2)+pizda(2,1)
7676 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7677 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7678 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7679 C Cartesian gradient
7683 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7685 vv(1)=pizda(1,1)-pizda(2,2)
7686 vv(2)=pizda(1,2)+pizda(2,1)
7687 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7688 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7689 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7695 C Contribution from graph IV
7697 call transpose2(EE(1,1,itl),auxmat(1,1))
7698 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7699 vv(1)=pizda(1,1)+pizda(2,2)
7700 vv(2)=pizda(2,1)-pizda(1,2)
7701 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7702 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7704 C Explicit gradient in virtual-dihedral angles.
7705 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7706 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7707 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7708 vv(1)=pizda(1,1)+pizda(2,2)
7709 vv(2)=pizda(2,1)-pizda(1,2)
7710 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7711 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7712 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7713 C Cartesian gradient
7717 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7719 vv(1)=pizda(1,1)+pizda(2,2)
7720 vv(2)=pizda(2,1)-pizda(1,2)
7721 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7722 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7723 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7729 C Antiparallel orientation
7730 C Contribution from graph III
7732 call transpose2(EUg(1,1,j),auxmat(1,1))
7733 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7734 vv(1)=pizda(1,1)-pizda(2,2)
7735 vv(2)=pizda(1,2)+pizda(2,1)
7736 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7737 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7739 C Explicit gradient in virtual-dihedral angles.
7740 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7741 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7742 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7743 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7744 vv(1)=pizda(1,1)-pizda(2,2)
7745 vv(2)=pizda(1,2)+pizda(2,1)
7746 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7747 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7748 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7749 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7750 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7751 vv(1)=pizda(1,1)-pizda(2,2)
7752 vv(2)=pizda(1,2)+pizda(2,1)
7753 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7754 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7755 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7756 C Cartesian gradient
7760 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7762 vv(1)=pizda(1,1)-pizda(2,2)
7763 vv(2)=pizda(1,2)+pizda(2,1)
7764 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7765 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7766 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7772 C Contribution from graph IV
7774 call transpose2(EE(1,1,itj),auxmat(1,1))
7775 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7776 vv(1)=pizda(1,1)+pizda(2,2)
7777 vv(2)=pizda(2,1)-pizda(1,2)
7778 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7779 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7781 C Explicit gradient in virtual-dihedral angles.
7782 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7783 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7784 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7785 vv(1)=pizda(1,1)+pizda(2,2)
7786 vv(2)=pizda(2,1)-pizda(1,2)
7787 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7788 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7789 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7790 C Cartesian gradient
7794 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7796 vv(1)=pizda(1,1)+pizda(2,2)
7797 vv(2)=pizda(2,1)-pizda(1,2)
7798 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7799 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7800 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7807 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7808 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7809 cd write (2,*) 'ijkl',i,j,k,l
7810 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7811 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7813 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7814 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7815 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7816 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7818 if (j.lt.nres-1) then
7825 if (l.lt.nres-1) then
7835 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7837 ggg1(ll)=eel5*g_contij(ll,1)
7838 ggg2(ll)=eel5*g_contij(ll,2)
7839 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7840 ghalf=0.5d0*ggg1(ll)
7842 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
7843 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7844 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
7845 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7846 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7847 ghalf=0.5d0*ggg2(ll)
7849 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7850 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7851 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7852 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7857 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7858 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7863 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7864 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7870 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7875 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7879 cd write (2,*) iii,g_corr5_loc(iii)
7883 cd write (2,*) 'ekont',ekont
7884 cd write (iout,*) 'eello5',ekont*eel5
7887 c--------------------------------------------------------------------------
7888 double precision function eello6(i,j,k,l,jj,kk)
7889 implicit real*8 (a-h,o-z)
7890 include 'DIMENSIONS'
7891 include 'sizesclu.dat'
7892 include 'COMMON.IOUNITS'
7893 include 'COMMON.CHAIN'
7894 include 'COMMON.DERIV'
7895 include 'COMMON.INTERACT'
7896 include 'COMMON.CONTACTS'
7897 include 'COMMON.TORSION'
7898 include 'COMMON.VAR'
7899 include 'COMMON.GEO'
7900 include 'COMMON.FFIELD'
7901 double precision ggg1(3),ggg2(3)
7902 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7907 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7915 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7916 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7920 derx(lll,kkk,iii)=0.0d0
7924 cd eij=facont_hb(jj,i)
7925 cd ekl=facont_hb(kk,k)
7931 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7932 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7933 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7934 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7935 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7936 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7938 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7939 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7940 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7941 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7942 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7943 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7947 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7949 C If turn contributions are considered, they will be handled separately.
7950 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7951 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7952 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7953 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7954 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7955 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7956 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7959 if (j.lt.nres-1) then
7966 if (l.lt.nres-1) then
7974 ggg1(ll)=eel6*g_contij(ll,1)
7975 ggg2(ll)=eel6*g_contij(ll,2)
7976 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7977 ghalf=0.5d0*ggg1(ll)
7979 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
7980 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7981 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
7982 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7983 ghalf=0.5d0*ggg2(ll)
7984 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7986 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
7987 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7988 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
7989 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7994 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7995 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8000 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8001 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8007 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8012 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8016 cd write (2,*) iii,g_corr6_loc(iii)
8020 cd write (2,*) 'ekont',ekont
8021 cd write (iout,*) 'eello6',ekont*eel6
8024 c--------------------------------------------------------------------------
8025 double precision function eello6_graph1(i,j,k,l,imat,swap)
8026 implicit real*8 (a-h,o-z)
8027 include 'DIMENSIONS'
8028 include 'sizesclu.dat'
8029 include 'COMMON.IOUNITS'
8030 include 'COMMON.CHAIN'
8031 include 'COMMON.DERIV'
8032 include 'COMMON.INTERACT'
8033 include 'COMMON.CONTACTS'
8034 include 'COMMON.TORSION'
8035 include 'COMMON.VAR'
8036 include 'COMMON.GEO'
8037 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8041 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8043 C Parallel Antiparallel C
8049 C \ j|/k\| / \ |/k\|l / C
8054 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8055 itk=itortyp(itype(k))
8056 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8057 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8058 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8059 call transpose2(EUgC(1,1,k),auxmat(1,1))
8060 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8061 vv1(1)=pizda1(1,1)-pizda1(2,2)
8062 vv1(2)=pizda1(1,2)+pizda1(2,1)
8063 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8064 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8065 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8066 s5=scalar2(vv(1),Dtobr2(1,i))
8067 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8068 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8069 if (.not. calc_grad) return
8070 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8071 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8072 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8073 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8074 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8075 & +scalar2(vv(1),Dtobr2der(1,i)))
8076 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8077 vv1(1)=pizda1(1,1)-pizda1(2,2)
8078 vv1(2)=pizda1(1,2)+pizda1(2,1)
8079 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8080 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8082 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8083 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8084 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8085 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8086 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8088 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8089 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8090 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8091 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8092 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8094 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8095 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8096 vv1(1)=pizda1(1,1)-pizda1(2,2)
8097 vv1(2)=pizda1(1,2)+pizda1(2,1)
8098 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8099 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8100 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8101 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8110 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8111 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8112 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8113 call transpose2(EUgC(1,1,k),auxmat(1,1))
8114 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8116 vv1(1)=pizda1(1,1)-pizda1(2,2)
8117 vv1(2)=pizda1(1,2)+pizda1(2,1)
8118 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8119 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8120 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8121 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8122 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8123 s5=scalar2(vv(1),Dtobr2(1,i))
8124 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8130 c----------------------------------------------------------------------------
8131 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8132 implicit real*8 (a-h,o-z)
8133 include 'DIMENSIONS'
8134 include 'sizesclu.dat'
8135 include 'COMMON.IOUNITS'
8136 include 'COMMON.CHAIN'
8137 include 'COMMON.DERIV'
8138 include 'COMMON.INTERACT'
8139 include 'COMMON.CONTACTS'
8140 include 'COMMON.TORSION'
8141 include 'COMMON.VAR'
8142 include 'COMMON.GEO'
8144 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8145 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8148 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8150 C Parallel Antiparallel C
8156 C \ j|/k\| \ |/k\|l C
8161 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8162 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8163 C AL 7/4/01 s1 would occur in the sixth-order moment,
8164 C but not in a cluster cumulant
8166 s1=dip(1,jj,i)*dip(1,kk,k)
8168 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8169 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8170 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8171 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8172 call transpose2(EUg(1,1,k),auxmat(1,1))
8173 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8174 vv(1)=pizda(1,1)-pizda(2,2)
8175 vv(2)=pizda(1,2)+pizda(2,1)
8176 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8177 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8179 eello6_graph2=-(s1+s2+s3+s4)
8181 eello6_graph2=-(s2+s3+s4)
8184 if (.not. calc_grad) return
8185 C Derivatives in gamma(i-1)
8188 s1=dipderg(1,jj,i)*dip(1,kk,k)
8190 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8191 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8192 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8193 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8195 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8197 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8199 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8201 C Derivatives in gamma(k-1)
8203 s1=dip(1,jj,i)*dipderg(1,kk,k)
8205 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8206 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8207 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8208 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8209 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8210 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8211 vv(1)=pizda(1,1)-pizda(2,2)
8212 vv(2)=pizda(1,2)+pizda(2,1)
8213 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8215 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8217 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8219 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8220 C Derivatives in gamma(j-1) or gamma(l-1)
8223 s1=dipderg(3,jj,i)*dip(1,kk,k)
8225 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8226 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8227 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8228 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8229 vv(1)=pizda(1,1)-pizda(2,2)
8230 vv(2)=pizda(1,2)+pizda(2,1)
8231 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8234 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8236 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8239 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8240 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8242 C Derivatives in gamma(l-1) or gamma(j-1)
8245 s1=dip(1,jj,i)*dipderg(3,kk,k)
8247 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8248 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8249 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8250 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8251 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8252 vv(1)=pizda(1,1)-pizda(2,2)
8253 vv(2)=pizda(1,2)+pizda(2,1)
8254 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8257 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8259 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8262 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8263 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8265 C Cartesian derivatives.
8267 write (2,*) 'In eello6_graph2'
8269 write (2,*) 'iii=',iii
8271 write (2,*) 'kkk=',kkk
8273 write (2,'(3(2f10.5),5x)')
8274 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8284 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8286 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8289 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8291 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8292 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8294 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8295 call transpose2(EUg(1,1,k),auxmat(1,1))
8296 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8298 vv(1)=pizda(1,1)-pizda(2,2)
8299 vv(2)=pizda(1,2)+pizda(2,1)
8300 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8301 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8303 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8305 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8308 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8310 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8317 c----------------------------------------------------------------------------
8318 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8319 implicit real*8 (a-h,o-z)
8320 include 'DIMENSIONS'
8321 include 'sizesclu.dat'
8322 include 'COMMON.IOUNITS'
8323 include 'COMMON.CHAIN'
8324 include 'COMMON.DERIV'
8325 include 'COMMON.INTERACT'
8326 include 'COMMON.CONTACTS'
8327 include 'COMMON.TORSION'
8328 include 'COMMON.VAR'
8329 include 'COMMON.GEO'
8330 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8332 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8334 C Parallel Antiparallel C
8340 C j|/k\| / |/k\|l / C
8345 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8347 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8348 C energy moment and not to the cluster cumulant.
8349 iti=itortyp(itype(i))
8350 c if (j.lt.nres-1) then
8351 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
8352 itj1=itortyp(itype(j+1))
8356 itk=itortyp(itype(k))
8357 itk1=itortyp(itype(k+1))
8358 c if (l.lt.nres-1) then
8359 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
8360 itl1=itortyp(itype(l+1))
8365 s1=dip(4,jj,i)*dip(4,kk,k)
8367 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8368 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8369 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8370 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8371 call transpose2(EE(1,1,itk),auxmat(1,1))
8372 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8373 vv(1)=pizda(1,1)+pizda(2,2)
8374 vv(2)=pizda(2,1)-pizda(1,2)
8375 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8376 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8378 eello6_graph3=-(s1+s2+s3+s4)
8380 eello6_graph3=-(s2+s3+s4)
8383 if (.not. calc_grad) return
8384 C Derivatives in gamma(k-1)
8385 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8386 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8387 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8388 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8389 C Derivatives in gamma(l-1)
8390 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8391 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8392 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8393 vv(1)=pizda(1,1)+pizda(2,2)
8394 vv(2)=pizda(2,1)-pizda(1,2)
8395 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8396 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8397 C Cartesian derivatives.
8403 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8405 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8408 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8410 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8411 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8413 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8414 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8416 vv(1)=pizda(1,1)+pizda(2,2)
8417 vv(2)=pizda(2,1)-pizda(1,2)
8418 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8420 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8422 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8425 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8427 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8429 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8435 c----------------------------------------------------------------------------
8436 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8437 implicit real*8 (a-h,o-z)
8438 include 'DIMENSIONS'
8439 include 'sizesclu.dat'
8440 include 'COMMON.IOUNITS'
8441 include 'COMMON.CHAIN'
8442 include 'COMMON.DERIV'
8443 include 'COMMON.INTERACT'
8444 include 'COMMON.CONTACTS'
8445 include 'COMMON.TORSION'
8446 include 'COMMON.VAR'
8447 include 'COMMON.GEO'
8448 include 'COMMON.FFIELD'
8449 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8450 & auxvec1(2),auxmat1(2,2)
8452 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8454 C Parallel Antiparallel C
8460 C \ j|/k\| \ |/k\|l C
8465 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8467 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8468 C energy moment and not to the cluster cumulant.
8469 cd write (2,*) 'eello_graph4: wturn6',wturn6
8470 iti=itortyp(itype(i))
8471 itj=itortyp(itype(j))
8472 c if (j.lt.nres-1) then
8473 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
8474 itj1=itortyp(itype(j+1))
8478 itk=itortyp(itype(k))
8479 c if (k.lt.nres-1) then
8480 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
8481 itk1=itortyp(itype(k+1))
8485 itl=itortyp(itype(l))
8486 if (l.lt.nres-1) then
8487 itl1=itortyp(itype(l+1))
8491 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8492 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8493 cd & ' itl',itl,' itl1',itl1
8496 s1=dip(3,jj,i)*dip(3,kk,k)
8498 s1=dip(2,jj,j)*dip(2,kk,l)
8501 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8502 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8504 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8505 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8507 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8508 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8510 call transpose2(EUg(1,1,k),auxmat(1,1))
8511 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8512 vv(1)=pizda(1,1)-pizda(2,2)
8513 vv(2)=pizda(2,1)+pizda(1,2)
8514 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8515 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8517 eello6_graph4=-(s1+s2+s3+s4)
8519 eello6_graph4=-(s2+s3+s4)
8521 if (.not. calc_grad) return
8522 C Derivatives in gamma(i-1)
8526 s1=dipderg(2,jj,i)*dip(3,kk,k)
8528 s1=dipderg(4,jj,j)*dip(2,kk,l)
8531 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8533 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8534 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8536 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8537 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8539 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8540 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8541 cd write (2,*) 'turn6 derivatives'
8543 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8545 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8549 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8551 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8555 C Derivatives in gamma(k-1)
8558 s1=dip(3,jj,i)*dipderg(2,kk,k)
8560 s1=dip(2,jj,j)*dipderg(4,kk,l)
8563 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8564 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8566 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8567 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8569 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8570 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8572 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8573 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8574 vv(1)=pizda(1,1)-pizda(2,2)
8575 vv(2)=pizda(2,1)+pizda(1,2)
8576 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8577 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8579 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8581 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8585 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8587 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8590 C Derivatives in gamma(j-1) or gamma(l-1)
8591 if (l.eq.j+1 .and. l.gt.1) then
8592 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8593 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8594 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8595 vv(1)=pizda(1,1)-pizda(2,2)
8596 vv(2)=pizda(2,1)+pizda(1,2)
8597 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8598 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8599 else if (j.gt.1) then
8600 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8601 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8602 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8603 vv(1)=pizda(1,1)-pizda(2,2)
8604 vv(2)=pizda(2,1)+pizda(1,2)
8605 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8606 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8607 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8609 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8612 C Cartesian derivatives.
8619 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8621 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8625 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8627 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8631 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8633 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8635 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8636 & b1(1,itj1),auxvec(1))
8637 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8639 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8640 & b1(1,itl1),auxvec(1))
8641 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8643 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8645 vv(1)=pizda(1,1)-pizda(2,2)
8646 vv(2)=pizda(2,1)+pizda(1,2)
8647 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8649 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8651 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8654 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8657 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8660 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8662 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8664 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8668 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8670 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8673 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8675 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8683 c----------------------------------------------------------------------------
8684 double precision function eello_turn6(i,jj,kk)
8685 implicit real*8 (a-h,o-z)
8686 include 'DIMENSIONS'
8687 include 'sizesclu.dat'
8688 include 'COMMON.IOUNITS'
8689 include 'COMMON.CHAIN'
8690 include 'COMMON.DERIV'
8691 include 'COMMON.INTERACT'
8692 include 'COMMON.CONTACTS'
8693 include 'COMMON.TORSION'
8694 include 'COMMON.VAR'
8695 include 'COMMON.GEO'
8696 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8697 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8699 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8700 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8701 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8702 C the respective energy moment and not to the cluster cumulant.
8707 iti=itortyp(itype(i))
8708 itk=itortyp(itype(k))
8709 itk1=itortyp(itype(k+1))
8710 itl=itortyp(itype(l))
8711 itj=itortyp(itype(j))
8712 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8713 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8714 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8719 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8721 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8725 derx_turn(lll,kkk,iii)=0.0d0
8732 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8734 cd write (2,*) 'eello6_5',eello6_5
8736 call transpose2(AEA(1,1,1),auxmat(1,1))
8737 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8738 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8739 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8743 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8744 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8745 s2 = scalar2(b1(1,itk),vtemp1(1))
8747 call transpose2(AEA(1,1,2),atemp(1,1))
8748 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8749 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8750 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8754 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8755 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8756 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8758 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8759 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8760 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8761 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8762 ss13 = scalar2(b1(1,itk),vtemp4(1))
8763 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8767 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8773 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8775 C Derivatives in gamma(i+2)
8777 call transpose2(AEA(1,1,1),auxmatd(1,1))
8778 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8779 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8780 call transpose2(AEAderg(1,1,2),atempd(1,1))
8781 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8782 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8786 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8787 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8788 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8794 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8795 C Derivatives in gamma(i+3)
8797 call transpose2(AEA(1,1,1),auxmatd(1,1))
8798 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8799 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8800 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8804 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8805 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8806 s2d = scalar2(b1(1,itk),vtemp1d(1))
8808 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8809 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8811 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8813 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8814 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8815 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8825 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8826 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8828 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8829 & -0.5d0*ekont*(s2d+s12d)
8831 C Derivatives in gamma(i+4)
8832 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8833 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8834 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8836 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8837 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8838 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8848 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8850 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8852 C Derivatives in gamma(i+5)
8854 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8855 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8856 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8860 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8861 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8862 s2d = scalar2(b1(1,itk),vtemp1d(1))
8864 call transpose2(AEA(1,1,2),atempd(1,1))
8865 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8866 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8870 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8871 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8873 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8874 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8875 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8885 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8886 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8888 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8889 & -0.5d0*ekont*(s2d+s12d)
8891 C Cartesian derivatives
8896 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8897 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8898 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8902 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8903 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8905 s2d = scalar2(b1(1,itk),vtemp1d(1))
8907 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8908 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8909 s8d = -(atempd(1,1)+atempd(2,2))*
8910 & scalar2(cc(1,1,itl),vtemp2(1))
8914 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8916 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8917 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8924 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8927 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8931 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8932 & - 0.5d0*(s8d+s12d)
8934 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8943 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8945 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8946 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8947 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8948 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8949 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8951 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8952 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8953 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8957 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8958 cd & 16*eel_turn6_num
8960 if (j.lt.nres-1) then
8967 if (l.lt.nres-1) then
8975 ggg1(ll)=eel_turn6*g_contij(ll,1)
8976 ggg2(ll)=eel_turn6*g_contij(ll,2)
8977 ghalf=0.5d0*ggg1(ll)
8979 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
8980 & +ekont*derx_turn(ll,2,1)
8981 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8982 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
8983 & +ekont*derx_turn(ll,4,1)
8984 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8985 ghalf=0.5d0*ggg2(ll)
8987 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
8988 & +ekont*derx_turn(ll,2,2)
8989 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8990 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
8991 & +ekont*derx_turn(ll,4,2)
8992 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8997 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9002 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9008 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9013 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9017 cd write (2,*) iii,g_corr6_loc(iii)
9020 eello_turn6=ekont*eel_turn6
9021 cd write (2,*) 'ekont',ekont
9022 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9025 crc-------------------------------------------------
9026 SUBROUTINE MATVEC2(A1,V1,V2)
9027 implicit real*8 (a-h,o-z)
9028 include 'DIMENSIONS'
9029 DIMENSION A1(2,2),V1(2),V2(2)
9033 c 3 VI=VI+A1(I,K)*V1(K)
9037 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9038 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9043 C---------------------------------------
9044 SUBROUTINE MATMAT2(A1,A2,A3)
9045 implicit real*8 (a-h,o-z)
9046 include 'DIMENSIONS'
9047 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9048 c DIMENSION AI3(2,2)
9052 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9058 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9059 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9060 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9061 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9069 c-------------------------------------------------------------------------
9070 double precision function scalar2(u,v)
9072 double precision u(2),v(2)
9075 scalar2=u(1)*v(1)+u(2)*v(2)
9079 C-----------------------------------------------------------------------------
9081 subroutine transpose2(a,at)
9083 double precision a(2,2),at(2,2)
9090 c--------------------------------------------------------------------------
9091 subroutine transpose(n,a,at)
9094 double precision a(n,n),at(n,n)
9102 C---------------------------------------------------------------------------
9103 subroutine prodmat3(a1,a2,kk,transp,prod)
9106 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9108 crc double precision auxmat(2,2),prod_(2,2)
9111 crc call transpose2(kk(1,1),auxmat(1,1))
9112 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9113 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9115 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9116 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9117 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9118 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9119 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9120 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9121 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9122 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9125 crc call matmat2(a1(1,1),kk(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(2,1))*a2(1,1)
9129 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9130 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9131 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9132 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9133 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9134 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9135 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9138 c call transpose2(a2(1,1),a2t(1,1))
9141 crc print *,((prod_(i,j),i=1,2),j=1,2)
9142 crc print *,((prod(i,j),i=1,2),j=1,2)
9146 C-----------------------------------------------------------------------------
9147 double precision function scalar(u,v)
9149 double precision u(3),v(3)
9159 C-----------------------------------------------------------------------
9160 double precision function sscale(r)
9161 double precision r,gamm
9162 include "COMMON.SPLITELE"
9163 if(r.lt.r_cut-rlamb) then
9165 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9166 gamm=(r-(r_cut-rlamb))/rlamb
9167 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
9173 C-----------------------------------------------------------------------
9174 C-----------------------------------------------------------------------
9175 double precision function sscagrad(r)
9176 double precision r,gamm
9177 include "COMMON.SPLITELE"
9178 if(r.lt.r_cut-rlamb) then
9180 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9181 gamm=(r-(r_cut-rlamb))/rlamb
9182 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
9188 C-----------------------------------------------------------------------
9189 C first for shielding is setting of function of side-chains
9190 subroutine set_shield_fac2
9191 implicit real*8 (a-h,o-z)
9192 include 'DIMENSIONS'
9193 include 'COMMON.CHAIN'
9194 include 'COMMON.DERIV'
9195 include 'COMMON.IOUNITS'
9196 include 'COMMON.SHIELD'
9197 include 'COMMON.INTERACT'
9198 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
9199 double precision div77_81/0.974996043d0/,
9200 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
9202 C the vector between center of side_chain and peptide group
9203 double precision pep_side(3),long,side_calf(3),
9204 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
9205 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
9206 C the line belowe needs to be changed for FGPROC>1
9208 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
9210 Cif there two consequtive dummy atoms there is no peptide group between them
9211 C the line below has to be changed for FGPROC>1
9214 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
9218 C first lets set vector conecting the ithe side-chain with kth side-chain
9219 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
9221 C and vector conecting the side-chain with its proper calfa
9222 side_calf(j)=c(j,k+nres)-c(j,k)
9223 C side_calf(j)=2.0d0
9224 pept_group(j)=c(j,i)-c(j,i+1)
9225 C lets have their lenght
9226 dist_pep_side=pep_side(j)**2+dist_pep_side
9227 dist_side_calf=dist_side_calf+side_calf(j)**2
9228 dist_pept_group=dist_pept_group+pept_group(j)**2
9230 dist_pep_side=dsqrt(dist_pep_side)
9231 dist_pept_group=dsqrt(dist_pept_group)
9232 dist_side_calf=dsqrt(dist_side_calf)
9234 pep_side_norm(j)=pep_side(j)/dist_pep_side
9235 side_calf_norm(j)=dist_side_calf
9237 C now sscale fraction
9238 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
9239 C print *,buff_shield,"buff"
9241 if (sh_frac_dist.le.0.0) cycle
9242 C If we reach here it means that this side chain reaches the shielding sphere
9243 C Lets add him to the list for gradient
9244 ishield_list(i)=ishield_list(i)+1
9245 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
9246 C this list is essential otherwise problem would be O3
9247 shield_list(ishield_list(i),i)=k
9248 C Lets have the sscale value
9249 if (sh_frac_dist.gt.1.0) then
9250 scale_fac_dist=1.0d0
9252 sh_frac_dist_grad(j)=0.0d0
9255 scale_fac_dist=-sh_frac_dist*sh_frac_dist
9256 & *(2.0d0*sh_frac_dist-3.0d0)
9257 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
9258 & /dist_pep_side/buff_shield*0.5d0
9259 C remember for the final gradient multiply sh_frac_dist_grad(j)
9260 C for side_chain by factor -2 !
9262 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
9263 C sh_frac_dist_grad(j)=0.0d0
9264 C scale_fac_dist=1.0d0
9265 C print *,"jestem",scale_fac_dist,fac_help_scale,
9266 C & sh_frac_dist_grad(j)
9269 C this is what is now we have the distance scaling now volume...
9270 short=short_r_sidechain(itype(k))
9271 long=long_r_sidechain(itype(k))
9272 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
9273 sinthet=short/dist_pep_side*costhet
9277 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
9278 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
9279 C & -short/dist_pep_side**2/costhet)
9282 costhet_grad(j)=costhet_fac*pep_side(j)
9284 C remember for the final gradient multiply costhet_grad(j)
9285 C for side_chain by factor -2 !
9286 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9287 C pep_side0pept_group is vector multiplication
9288 pep_side0pept_group=0.0d0
9290 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9292 cosalfa=(pep_side0pept_group/
9293 & (dist_pep_side*dist_side_calf))
9294 fac_alfa_sin=1.0d0-cosalfa**2
9295 fac_alfa_sin=dsqrt(fac_alfa_sin)
9296 rkprim=fac_alfa_sin*(long-short)+short
9300 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
9302 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
9303 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
9307 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9308 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
9309 &*(long-short)/fac_alfa_sin*cosalfa/
9310 &((dist_pep_side*dist_side_calf))*
9311 &((side_calf(j))-cosalfa*
9312 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9313 C cosphi_grad_long(j)=0.0d0
9314 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
9315 &*(long-short)/fac_alfa_sin*cosalfa
9316 &/((dist_pep_side*dist_side_calf))*
9318 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9319 C cosphi_grad_loc(j)=0.0d0
9321 C print *,sinphi,sinthet
9322 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
9325 C now the gradient...
9327 grad_shield(j,i)=grad_shield(j,i)
9328 C gradient po skalowaniu
9329 & +(sh_frac_dist_grad(j)*VofOverlap
9330 C gradient po costhet
9331 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
9332 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9333 & sinphi/sinthet*costhet*costhet_grad(j)
9334 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9336 C grad_shield_side is Cbeta sidechain gradient
9337 grad_shield_side(j,ishield_list(i),i)=
9338 & (sh_frac_dist_grad(j)*(-2.0d0)
9340 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9341 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9342 & sinphi/sinthet*costhet*costhet_grad(j)
9343 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9346 grad_shield_loc(j,ishield_list(i),i)=
9347 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9348 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
9349 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
9353 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9355 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
9356 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
9360 C first for shielding is setting of function of side-chains
9361 subroutine set_shield_fac
9362 implicit real*8 (a-h,o-z)
9363 include 'DIMENSIONS'
9364 include 'COMMON.CHAIN'
9365 include 'COMMON.DERIV'
9366 include 'COMMON.IOUNITS'
9367 include 'COMMON.SHIELD'
9368 include 'COMMON.INTERACT'
9369 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
9370 double precision div77_81/0.974996043d0/,
9371 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
9373 C the vector between center of side_chain and peptide group
9374 double precision pep_side(3),long,side_calf(3),
9375 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
9376 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
9377 C the line belowe needs to be changed for FGPROC>1
9379 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
9381 Cif there two consequtive dummy atoms there is no peptide group between them
9382 C the line below has to be changed for FGPROC>1
9385 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
9389 C first lets set vector conecting the ithe side-chain with kth side-chain
9390 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
9392 C and vector conecting the side-chain with its proper calfa
9393 side_calf(j)=c(j,k+nres)-c(j,k)
9394 C side_calf(j)=2.0d0
9395 pept_group(j)=c(j,i)-c(j,i+1)
9396 C lets have their lenght
9397 dist_pep_side=pep_side(j)**2+dist_pep_side
9398 dist_side_calf=dist_side_calf+side_calf(j)**2
9399 dist_pept_group=dist_pept_group+pept_group(j)**2
9401 dist_pep_side=dsqrt(dist_pep_side)
9402 dist_pept_group=dsqrt(dist_pept_group)
9403 dist_side_calf=dsqrt(dist_side_calf)
9405 pep_side_norm(j)=pep_side(j)/dist_pep_side
9406 side_calf_norm(j)=dist_side_calf
9408 C now sscale fraction
9409 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
9410 C print *,buff_shield,"buff"
9412 if (sh_frac_dist.le.0.0) cycle
9413 C If we reach here it means that this side chain reaches the shielding sphere
9414 C Lets add him to the list for gradient
9415 ishield_list(i)=ishield_list(i)+1
9416 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
9417 C this list is essential otherwise problem would be O3
9418 shield_list(ishield_list(i),i)=k
9419 C Lets have the sscale value
9420 if (sh_frac_dist.gt.1.0) then
9421 scale_fac_dist=1.0d0
9423 sh_frac_dist_grad(j)=0.0d0
9426 scale_fac_dist=-sh_frac_dist*sh_frac_dist
9427 & *(2.0*sh_frac_dist-3.0d0)
9428 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
9429 & /dist_pep_side/buff_shield*0.5
9430 C remember for the final gradient multiply sh_frac_dist_grad(j)
9431 C for side_chain by factor -2 !
9433 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
9434 C print *,"jestem",scale_fac_dist,fac_help_scale,
9435 C & sh_frac_dist_grad(j)
9438 C if ((i.eq.3).and.(k.eq.2)) then
9439 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
9443 C this is what is now we have the distance scaling now volume...
9444 short=short_r_sidechain(itype(k))
9445 long=long_r_sidechain(itype(k))
9446 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
9449 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
9452 costhet_grad(j)=costhet_fac*pep_side(j)
9454 C remember for the final gradient multiply costhet_grad(j)
9455 C for side_chain by factor -2 !
9456 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9457 C pep_side0pept_group is vector multiplication
9458 pep_side0pept_group=0.0
9460 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9462 cosalfa=(pep_side0pept_group/
9463 & (dist_pep_side*dist_side_calf))
9464 fac_alfa_sin=1.0-cosalfa**2
9465 fac_alfa_sin=dsqrt(fac_alfa_sin)
9466 rkprim=fac_alfa_sin*(long-short)+short
9468 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
9469 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
9472 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9473 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9474 &*(long-short)/fac_alfa_sin*cosalfa/
9475 &((dist_pep_side*dist_side_calf))*
9476 &((side_calf(j))-cosalfa*
9477 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9479 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9480 &*(long-short)/fac_alfa_sin*cosalfa
9481 &/((dist_pep_side*dist_side_calf))*
9483 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9486 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
9489 C now the gradient...
9490 C grad_shield is gradient of Calfa for peptide groups
9491 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
9493 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
9494 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
9496 grad_shield(j,i)=grad_shield(j,i)
9497 C gradient po skalowaniu
9498 & +(sh_frac_dist_grad(j)
9499 C gradient po costhet
9500 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
9501 &-scale_fac_dist*(cosphi_grad_long(j))
9502 &/(1.0-cosphi) )*div77_81
9504 C grad_shield_side is Cbeta sidechain gradient
9505 grad_shield_side(j,ishield_list(i),i)=
9506 & (sh_frac_dist_grad(j)*(-2.0d0)
9507 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
9508 & +scale_fac_dist*(cosphi_grad_long(j))
9509 & *2.0d0/(1.0-cosphi))
9510 & *div77_81*VofOverlap
9512 grad_shield_loc(j,ishield_list(i),i)=
9513 & scale_fac_dist*cosphi_grad_loc(j)
9514 & *2.0d0/(1.0-cosphi)
9515 & *div77_81*VofOverlap
9517 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9519 fac_shield(i)=VolumeTotal*div77_81+div4_81
9520 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
9524 C--------------------------------------------------------------------------
9525 C-----------------------------------------------------------------------
9526 double precision function sscalelip(r)
9527 double precision r,gamm
9528 include "COMMON.SPLITELE"
9529 C if(r.lt.r_cut-rlamb) then
9531 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9532 C gamm=(r-(r_cut-rlamb))/rlamb
9533 sscalelip=1.0d0+r*r*(2*r-3.0d0)
9539 C-----------------------------------------------------------------------
9540 double precision function sscagradlip(r)
9541 double precision r,gamm
9542 include "COMMON.SPLITELE"
9543 C if(r.lt.r_cut-rlamb) then
9545 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9546 C gamm=(r-(r_cut-rlamb))/rlamb
9547 sscagradlip=r*(6*r-6.0d0)
9553 c----------------------------------------------------------------------------
9554 double precision function sscale2(r,r_cut,r0,rlamb)
9556 double precision r,gamm,r_cut,r0,rlamb,rr
9558 c write (2,*) "r",r," r_cut",r_cut," r0",r0," rlamb",rlamb
9559 c write (2,*) "rr",rr
9560 if(rr.lt.r_cut-rlamb) then
9562 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
9563 gamm=(rr-(r_cut-rlamb))/rlamb
9564 sscale2=1.0d0+gamm*gamm*(2*gamm-3.0d0)
9570 C-----------------------------------------------------------------------
9571 double precision function sscalgrad2(r,r_cut,r0,rlamb)
9573 double precision r,gamm,r_cut,r0,rlamb,rr
9575 if(rr.lt.r_cut-rlamb) then
9577 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
9578 gamm=(rr-(r_cut-rlamb))/rlamb
9580 sscalgrad2=gamm*(6*gamm-6.0d0)/rlamb
9582 sscalgrad2=-gamm*(6*gamm-6.0d0)/rlamb
9589 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9590 subroutine Eliptransfer(eliptran)
9591 implicit real*8 (a-h,o-z)
9592 include 'DIMENSIONS'
9593 include 'COMMON.GEO'
9594 include 'COMMON.VAR'
9595 include 'COMMON.LOCAL'
9596 include 'COMMON.CHAIN'
9597 include 'COMMON.DERIV'
9598 include 'COMMON.INTERACT'
9599 include 'COMMON.IOUNITS'
9600 include 'COMMON.CALC'
9601 include 'COMMON.CONTROL'
9602 include 'COMMON.SPLITELE'
9603 include 'COMMON.SBRIDGE'
9604 C this is done by Adasko
9608 C--bordliptop-- buffore starts
9609 C--bufliptop--- here true lipid starts
9611 C--buflipbot--- lipid ends buffore starts
9612 C--bordlipbot--buffore ends
9614 write(iout,*) "I am in?"
9617 if (itype(i).eq.ntyp1) cycle
9619 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
9620 if (positi.le.0) positi=positi+boxzsize
9622 C first for peptide groups
9623 c for each residue check if it is in lipid or lipid water border area
9624 if ((positi.gt.bordlipbot)
9625 &.and.(positi.lt.bordliptop)) then
9626 C the energy transfer exist
9627 if (positi.lt.buflipbot) then
9628 C what fraction I am in
9630 & ((positi-bordlipbot)/lipbufthick)
9631 C lipbufthick is thickenes of lipid buffore
9632 sslip=sscalelip(fracinbuf)
9633 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9634 eliptran=eliptran+sslip*pepliptran
9635 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
9636 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
9637 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
9638 elseif (positi.gt.bufliptop) then
9639 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
9640 sslip=sscalelip(fracinbuf)
9641 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9642 eliptran=eliptran+sslip*pepliptran
9643 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
9644 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
9645 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
9646 C print *, "doing sscalefor top part"
9647 C print *,i,sslip,fracinbuf,ssgradlip
9649 eliptran=eliptran+pepliptran
9650 C print *,"I am in true lipid"
9653 C eliptran=elpitran+0.0 ! I am in water
9656 C print *, "nic nie bylo w lipidzie?"
9657 C now multiply all by the peptide group transfer factor
9658 C eliptran=eliptran*pepliptran
9659 C now the same for side chains
9662 if (itype(i).eq.ntyp1) cycle
9663 positi=(mod(c(3,i+nres),boxzsize))
9664 if (positi.le.0) positi=positi+boxzsize
9665 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
9666 c for each residue check if it is in lipid or lipid water border area
9667 C respos=mod(c(3,i+nres),boxzsize)
9668 C print *,positi,bordlipbot,buflipbot
9669 if ((positi.gt.bordlipbot)
9670 & .and.(positi.lt.bordliptop)) then
9671 C the energy transfer exist
9672 if (positi.lt.buflipbot) then
9674 & ((positi-bordlipbot)/lipbufthick)
9675 C lipbufthick is thickenes of lipid buffore
9676 sslip=sscalelip(fracinbuf)
9677 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9678 eliptran=eliptran+sslip*liptranene(itype(i))
9679 gliptranx(3,i)=gliptranx(3,i)
9680 &+ssgradlip*liptranene(itype(i))
9681 gliptranc(3,i-1)= gliptranc(3,i-1)
9682 &+ssgradlip*liptranene(itype(i))
9683 C print *,"doing sccale for lower part"
9684 elseif (positi.gt.bufliptop) then
9686 &((bordliptop-positi)/lipbufthick)
9687 sslip=sscalelip(fracinbuf)
9688 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9689 eliptran=eliptran+sslip*liptranene(itype(i))
9690 gliptranx(3,i)=gliptranx(3,i)
9691 &+ssgradlip*liptranene(itype(i))
9692 gliptranc(3,i-1)= gliptranc(3,i-1)
9693 &+ssgradlip*liptranene(itype(i))
9694 C print *, "doing sscalefor top part",sslip,fracinbuf
9696 eliptran=eliptran+liptranene(itype(i))
9697 C print *,"I am in true lipid"
9699 endif ! if in lipid or buffor
9701 C eliptran=elpitran+0.0 ! I am in water
9705 c----------------------------------------------------------------------------
9706 subroutine e_saxs(Esaxs_constr)
9708 include 'DIMENSIONS'
9711 include "COMMON.SETUP"
9714 include 'COMMON.SBRIDGE'
9715 include 'COMMON.CHAIN'
9716 include 'COMMON.GEO'
9717 include 'COMMON.LOCAL'
9718 include 'COMMON.INTERACT'
9719 include 'COMMON.VAR'
9720 include 'COMMON.IOUNITS'
9721 include 'COMMON.DERIV'
9722 include 'COMMON.CONTROL'
9723 include 'COMMON.NAMES'
9724 include 'COMMON.FFIELD'
9725 include 'COMMON.LANGEVIN'
9727 double precision Esaxs_constr
9728 integer i,iint,j,k,l
9729 double precision PgradC(maxSAXS,3,maxres),
9730 & PgradX(maxSAXS,3,maxres),Pcalc(maxSAXS)
9732 double precision PgradC_(maxSAXS,3,maxres),
9733 & PgradX_(maxSAXS,3,maxres),Pcalc_(maxSAXS)
9735 double precision dk,dijCACA,dijCASC,dijSCCA,dijSCSC,
9736 & sigma2CACA,sigma2CASC,sigma2SCCA,sigma2SCSC,expCACA,expCASC,
9737 & expSCCA,expSCSC,CASCgrad,SCCAgrad,SCSCgrad,aux,auxC,auxC1,
9738 & auxX,auxX1,CACAgrad,Cnorm
9739 double precision sss2,ssgrad2,rrr,sscalgrad2,sscale2
9740 double precision dist
9742 c SAXS restraint penalty function
9744 write(iout,*) "------- SAXS penalty function start -------"
9745 write (iout,*) "nsaxs",nsaxs
9746 write (iout,*) "Esaxs: iatsc_s",iatsc_s," iatsc_e",iatsc_e
9747 write (iout,*) "Psaxs"
9749 write (iout,'(i5,e15.5)') i, Psaxs(i)
9752 Esaxs_constr = 0.0d0
9762 do i=iatsc_s,iatsc_e
9763 if (itype(i).eq.ntyp1) cycle
9764 do iint=1,nint_gr(i)
9765 do j=istart(i,iint),iend(i,iint)
9766 if (itype(j).eq.ntyp1) cycle
9769 dijCASC=dist(i,j+nres)
9770 dijSCCA=dist(i+nres,j)
9771 dijSCSC=dist(i+nres,j+nres)
9772 sigma2CACA=2.0d0/(pstok**2)
9773 sigma2CASC=4.0d0/(pstok**2+restok(itype(j))**2)
9774 sigma2SCCA=4.0d0/(pstok**2+restok(itype(i))**2)
9775 sigma2SCSC=4.0d0/(restok(itype(j))**2+restok(itype(i))**2)
9778 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
9779 if (itype(j).ne.10) then
9780 expCASC = dexp(-0.5d0*sigma2CASC*(dijCASC-dk)**2)
9784 if (itype(i).ne.10) then
9785 expSCCA = dexp(-0.5d0*sigma2SCCA*(dijSCCA-dk)**2)
9789 if (itype(i).ne.10 .and. itype(j).ne.10) then
9790 expSCSC = dexp(-0.5d0*sigma2SCSC*(dijSCSC-dk)**2)
9794 Pcalc(k) = Pcalc(k)+expCACA+expCASC+expSCCA+expSCSC
9796 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
9798 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
9799 CASCgrad = sigma2CASC*(dijCASC-dk)*expCASC
9800 SCCAgrad = sigma2SCCA*(dijSCCA-dk)*expSCCA
9801 SCSCgrad = sigma2SCSC*(dijSCSC-dk)*expSCSC
9804 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9805 PgradC(k,l,i) = PgradC(k,l,i)-aux
9806 PgradC(k,l,j) = PgradC(k,l,j)+aux
9808 if (itype(j).ne.10) then
9809 aux = CASCgrad*(C(l,j+nres)-C(l,i))/dijCASC
9810 PgradC(k,l,i) = PgradC(k,l,i)-aux
9811 PgradC(k,l,j) = PgradC(k,l,j)+aux
9812 PgradX(k,l,j) = PgradX(k,l,j)+aux
9815 if (itype(i).ne.10) then
9816 aux = SCCAgrad*(C(l,j)-C(l,i+nres))/dijSCCA
9817 PgradX(k,l,i) = PgradX(k,l,i)-aux
9818 PgradC(k,l,i) = PgradC(k,l,i)-aux
9819 PgradC(k,l,j) = PgradC(k,l,j)+aux
9822 if (itype(i).ne.10 .and. itype(j).ne.10) then
9823 aux = SCSCgrad*(C(l,j+nres)-C(l,i+nres))/dijSCSC
9824 PgradC(k,l,i) = PgradC(k,l,i)-aux
9825 PgradC(k,l,j) = PgradC(k,l,j)+aux
9826 PgradX(k,l,i) = PgradX(k,l,i)-aux
9827 PgradX(k,l,j) = PgradX(k,l,j)+aux
9833 sigma2CACA=scal_rad**2*0.25d0/
9834 & (restok(itype(j))**2+restok(itype(i))**2)
9836 IF (saxs_cutoff.eq.0) THEN
9839 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
9840 Pcalc(k) = Pcalc(k)+expCACA
9841 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
9843 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9844 PgradC(k,l,i) = PgradC(k,l,i)-aux
9845 PgradC(k,l,j) = PgradC(k,l,j)+aux
9849 rrr = saxs_cutoff*2.0d0/dsqrt(sigma2CACA)
9852 c write (2,*) "ijk",i,j,k
9853 sss2 = sscale2(dijCACA,rrr,dk,0.3d0)
9854 if (sss2.eq.0.0d0) cycle
9855 ssgrad2 = sscalgrad2(dijCACA,rrr,dk,0.3d0)
9856 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)*sss2
9857 Pcalc(k) = Pcalc(k)+expCACA
9859 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
9861 CACAgrad = -sigma2CACA*(dijCACA-dk)*expCACA+
9862 & ssgrad2*expCACA/sss2
9865 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9866 PgradC(k,l,i) = PgradC(k,l,i)+aux
9867 PgradC(k,l,j) = PgradC(k,l,j)-aux
9876 if (nfgtasks.gt.1) then
9877 call MPI_Reduce(Pcalc(1),Pcalc_(1),nsaxs,MPI_DOUBLE_PRECISION,
9878 & MPI_SUM,king,FG_COMM,IERR)
9879 if (fg_rank.eq.king) then
9881 Pcalc(k) = Pcalc_(k)
9884 call MPI_Reduce(PgradC(k,1,1),PgradC_(k,1,1),3*maxsaxs*nres,
9885 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9886 if (fg_rank.eq.king) then
9890 PgradC(k,l,i) = PgradC_(k,l,i)
9896 call MPI_Reduce(PgradX(k,1,1),PgradX_(k,1,1),3*maxsaxs*nres,
9897 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9898 if (fg_rank.eq.king) then
9902 PgradX(k,l,i) = PgradX_(k,l,i)
9911 if (fg_rank.eq.king) then
9915 Cnorm = Cnorm + Pcalc(k)
9917 Esaxs_constr = dlog(Cnorm)-wsaxs0
9919 if (Pcalc(k).gt.0.0d0)
9920 & Esaxs_constr = Esaxs_constr - Psaxs(k)*dlog(Pcalc(k))
9922 write (iout,*) "k",k," Esaxs_constr",Esaxs_constr
9926 write (iout,*) "Cnorm",Cnorm," Esaxs_constr",Esaxs_constr
9936 & auxC = auxC +Psaxs(k)*PgradC(k,l,i)/Pcalc(k)
9937 auxC1 = auxC1+PgradC(k,l,i)
9939 auxX = auxX +Psaxs(k)*PgradX(k,l,i)/Pcalc(k)
9940 auxX1 = auxX1+PgradX(k,l,i)
9943 gsaxsC(l,i) = auxC - auxC1/Cnorm
9945 gsaxsX(l,i) = auxX - auxX1/Cnorm
9947 c write (iout,*) "l i",l,i," gradC",wsaxs*(auxC - auxC1/Cnorm),
9948 c * " gradX",wsaxs*(auxX - auxX1/Cnorm)
9956 c----------------------------------------------------------------------------
9957 subroutine e_saxsC(Esaxs_constr)
9959 include 'DIMENSIONS'
9962 include "COMMON.SETUP"
9965 include 'COMMON.SBRIDGE'
9966 include 'COMMON.CHAIN'
9967 include 'COMMON.INTERACT'
9968 include 'COMMON.GEO'
9969 include 'COMMON.LOCAL'
9970 include 'COMMON.VAR'
9971 include 'COMMON.IOUNITS'
9972 include 'COMMON.DERIV'
9973 include 'COMMON.CONTROL'
9974 include 'COMMON.NAMES'
9975 include 'COMMON.FFIELD'
9976 include 'COMMON.LANGEVIN'
9978 double precision Esaxs_constr
9979 integer i,iint,j,k,l
9980 double precision PgradC(3,maxres),PgradX(3,maxres),Pcalc,logPtot
9982 double precision gsaxsc_(3,maxres),gsaxsx_(3,maxres),logPtot_
9984 double precision dk,dijCASPH,dijSCSPH,
9985 & sigma2CA,sigma2SC,expCASPH,expSCSPH,
9986 & CASPHgrad,SCSPHgrad,aux,auxC,auxC1,
9988 c SAXS restraint penalty function
9990 write(iout,*) "------- SAXS penalty function start -------"
9991 write (iout,*) "nsaxs",nsaxs," isaxs_start",isaxs_start,
9992 & " isaxs_end",isaxs_end
9993 write (iout,*) "nnt",nnt," ntc",nct
9995 write(iout,'(a6,i5,3f10.5,5x,2f10.5)')
9996 & "CA",i,(C(j,i),j=1,3),pstok,restok(itype(i))
9999 write(iout,'(a6,i5,3f10.5)')"CSaxs",i,(Csaxs(j,i),j=1,3)
10002 Esaxs_constr = 0.0d0
10004 do j=isaxs_start,isaxs_end
10016 dijCASPH=dijCASPH+(C(l,i)-Csaxs(l,j))**2
10018 if (itype(i).ne.10) then
10020 dijSCSPH=dijSCSPH+(C(l,i+nres)-Csaxs(l,j))**2
10023 sigma2CA=2.0d0/pstok**2
10024 sigma2SC=4.0d0/restok(itype(i))**2
10025 expCASPH = dexp(-0.5d0*sigma2CA*dijCASPH)
10026 expSCSPH = dexp(-0.5d0*sigma2SC*dijSCSPH)
10027 Pcalc = Pcalc+expCASPH+expSCSPH
10029 write(*,*) "processor i j Pcalc",
10030 & MyRank,i,j,dijCASPH,dijSCSPH, Pcalc
10032 CASPHgrad = sigma2CA*expCASPH
10033 SCSPHgrad = sigma2SC*expSCSPH
10035 aux = (C(l,i+nres)-Csaxs(l,j))*SCSPHgrad
10036 PgradX(l,i) = PgradX(l,i) + aux
10037 PgradC(l,i) = PgradC(l,i)+(C(l,i)-Csaxs(l,j))*CASPHgrad+aux
10042 gsaxsc(l,i)=gsaxsc(l,i)+PgradC(l,i)/Pcalc
10043 gsaxsx(l,i)=gsaxsx(l,i)+PgradX(l,i)/Pcalc
10046 logPtot = logPtot - dlog(Pcalc)
10047 c print *,"me",me,MyRank," j",j," logPcalc",-dlog(Pcalc),
10048 c & " logPtot",logPtot
10051 if (nfgtasks.gt.1) then
10052 c write (iout,*) "logPtot before reduction",logPtot
10053 call MPI_Reduce(logPtot,logPtot_,1,MPI_DOUBLE_PRECISION,
10054 & MPI_SUM,king,FG_COMM,IERR)
10056 c write (iout,*) "logPtot after reduction",logPtot
10057 call MPI_Reduce(gsaxsC(1,1),gsaxsC_(1,1),3*nres,
10058 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10059 if (fg_rank.eq.king) then
10062 gsaxsC(l,i) = gsaxsC_(l,i)
10066 call MPI_Reduce(gsaxsX(1,1),gsaxsX_(1,1),3*nres,
10067 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10068 if (fg_rank.eq.king) then
10071 gsaxsX(l,i) = gsaxsX_(l,i)
10077 Esaxs_constr = logPtot