1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
4 include 'DIMENSIONS.ZSCOPT'
10 cMS$ATTRIBUTES C :: proc_proc
13 include 'COMMON.IOUNITS'
14 double precision energia(0:max_ene),energia1(0:max_ene+1)
15 include 'COMMON.FFIELD'
16 include 'COMMON.DERIV'
17 include 'COMMON.INTERACT'
18 include 'COMMON.SBRIDGE'
19 include 'COMMON.CHAIN'
20 include 'COMMON.SHIELD'
21 include 'COMMON.CONTROL'
22 include 'COMMON.TORCNSTR'
24 double precision fact(6)
25 c write(iout, '(a,i2)')'Calling etotal ipot=',ipot
27 cd print *,'nnt=',nnt,' nct=',nct
29 C Compute the side-chain and electrostatic interaction energy
31 goto (101,102,103,104,105) ipot
32 C Lennard-Jones potential.
33 101 call elj(evdw,evdw_t)
34 cd print '(a)','Exit ELJ'
36 C Lennard-Jones-Kihara potential (shifted).
37 102 call eljk(evdw,evdw_t)
39 C Berne-Pechukas potential (dilated LJ, angular dependence).
40 103 call ebp(evdw,evdw_t)
42 C Gay-Berne potential (shifted LJ, angular dependence).
43 104 call egb(evdw,evdw_t)
45 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
46 105 call egbv(evdw,evdw_t)
47 C write(iout,*) 'po elektostatyce'
49 C Calculate electrostatic (H-bonding) energy of the main chain.
53 if (shield_mode.eq.1) then
55 else if (shield_mode.eq.2) then
58 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
59 C write(iout,*) 'po eelec'
61 C Calculate excluded-volume interaction energy between peptide groups
64 call escp(evdw2,evdw2_14)
66 c Calculate the bond-stretching energy
70 C write (iout,*) "estr",estr
72 C Calculate the disulfide-bridge and other energy and the contributions
73 C from other distance constraints.
74 cd print *,'Calling EHPB'
76 cd print *,'EHPB exitted succesfully.'
78 C Calculate the virtual-bond-angle energy.
80 C print *,'Bend energy finished.'
82 if (tor_mode.eq.0) then
85 C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
93 if (with_theta_constr) call etheta_constr(ethetacnstr)
94 c call ebend(ebe,ethetacnstr)
95 cd print *,'Bend energy finished.'
97 C Calculate the SC local energy.
100 C print *,'SCLOC energy finished.'
102 C Calculate the virtual-bond torsional energy.
104 if (wtor.gt.0.0d0) then
105 if (tor_mode.eq.0) then
106 call etor(etors,fact(1))
108 C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
110 call etor_kcc(etors,fact(1))
116 if (ndih_constr.gt.0) call etor_constr(edihcnstr)
117 c print *,"Processor",myrank," computed Utor"
119 C 6/23/01 Calculate double-torsional energy
121 if ((wtor_d.gt.0.0d0).and.(tor_mode.eq.0)) then
122 call etor_d(etors_d,fact(2))
126 c print *,"Processor",myrank," computed Utord"
128 if (wsccor.gt.0.0d0) then
129 call eback_sc_corr(esccor)
134 if (wliptran.gt.0) then
135 call Eliptransfer(eliptran)
141 C 12/1/95 Multi-body terms
145 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
146 & .or. wturn6.gt.0.0d0) then
147 c write(iout,*)"calling multibody_eello"
148 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
149 c write (iout,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
150 c write (iout,*) ecorr,ecorr5,ecorr6,eturn6
157 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
158 c write (iout,*) "Calling multibody_hbond"
159 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
162 c write (iout,*) "nsaxs",nsaxs
163 c write (iout,*) "From Esaxs: Esaxs_constr",Esaxs_constr
164 if (nsaxs.gt.0 .and. saxs_mode.eq.0) then
165 call e_saxs(Esaxs_constr)
166 c write (iout,*) "From Esaxs: Esaxs_constr",Esaxs_constr
167 else if (nsaxs.gt.0 .and. saxs_mode.gt.0) then
168 call e_saxsC(Esaxs_constr)
169 c write (iout,*) "From EsaxsC: Esaxs_constr",Esaxs_constr
174 c write(iout,*) "TEST_ENE1 constr_homology=",constr_homology
175 if (constr_homology.ge.1) then
176 call e_modeller(ehomology_constr)
178 ehomology_constr=0.0d0
181 c write(iout,*) "TEST_ENE1 ehomology_constr=",ehomology_constr
183 C BARTEK for dfa test!
185 if (wdfa_dist.gt.0) call edfad(edfadis)
186 c write(iout,*)'edfad is finished!', wdfa_dist,edfadis
188 if (wdfa_tor.gt.0) call edfat(edfator)
189 c write(iout,*)'edfat is finished!', wdfa_tor,edfator
191 if (wdfa_nei.gt.0) call edfan(edfanei)
192 c write(iout,*)'edfan is finished!', wdfa_nei,edfanei
194 if (wdfa_beta.gt.0) call edfab(edfabet)
195 c write(iout,*)'edfab is finished!', wdfa_beta,edfabet
202 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
204 if (shield_mode.gt.0) then
205 etot=fact(1)*wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
207 & +fact(1)*wvdwpp*evdw1
208 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
209 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
210 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
211 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
212 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
213 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr+wsaxs*esaxs_constr
214 & +wliptran*eliptran*esaxs_constr
215 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
218 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
220 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
221 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
222 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
223 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
224 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
225 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
226 & +wliptran*eliptran+wsaxs*esaxs_constr
227 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
231 if (shield_mode.gt.0) then
232 etot=fact(1)wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
233 & +welec*fact(1)*(ees+evdw1)
234 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
235 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
236 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
237 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
238 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
239 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
240 & +wliptran*eliptran+wsaxs*esaxs_constr
241 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
244 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
245 & +welec*fact(1)*(ees+evdw1)
246 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
247 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
248 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
249 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
250 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
251 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
252 & +wliptran*eliptran+wsaxs*esaxs_constr
253 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
260 energia(2)=evdw2-evdw2_14
277 energia(8)=eello_turn3
278 energia(9)=eello_turn4
287 energia(20)=edihcnstr
290 energia(24)=ethetacnstr
291 energia(26)=esaxs_constr
292 energia(27)=ehomology_constr
300 if (isnan(etot).ne.0) energia(0)=1.0d+99
302 if (isnan(etot)) energia(0)=1.0d+99
307 idumm=proc_proc(etot,i)
309 call proc_proc(etot,i)
311 if(i.eq.1)energia(0)=1.0d+99
317 call enerprint(energia,fact)
321 C Sum up the components of the Cartesian gradient.
326 if (shield_mode.eq.0) then
327 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
328 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
330 & wstrain*ghpbc(j,i)+
331 & wcorr*fact(3)*gradcorr(j,i)+
332 & wel_loc*fact(2)*gel_loc(j,i)+
333 & wturn3*fact(2)*gcorr3_turn(j,i)+
334 & wturn4*fact(3)*gcorr4_turn(j,i)+
335 & wcorr5*fact(4)*gradcorr5(j,i)+
336 & wcorr6*fact(5)*gradcorr6(j,i)+
337 & wturn6*fact(5)*gcorr6_turn(j,i)+
338 & wsccor*fact(2)*gsccorc(j,i)+
339 & wliptran*gliptranc(j,i)+
340 & wdfa_dist*gdfad(j,i)+
341 & wdfa_tor*gdfat(j,i)+
342 & wdfa_nei*gdfan(j,i)+
343 & wdfa_beta*gdfab(j,i)
344 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
346 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
347 & wsccor*fact(2)*gsccorx(j,i)
348 & +wliptran*gliptranx(j,i)
350 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)
351 & +fact(1)*wscp*gvdwc_scp(j,i)+
352 & welec*fact(1)*gelc(j,i)+fact(1)*wvdwpp*gvdwpp(j,i)+
354 & wstrain*ghpbc(j,i)+
355 & wcorr*fact(3)*gradcorr(j,i)+
356 & wel_loc*fact(2)*gel_loc(j,i)+
357 & wturn3*fact(2)*gcorr3_turn(j,i)+
358 & wturn4*fact(3)*gcorr4_turn(j,i)+
359 & wcorr5*fact(4)*gradcorr5(j,i)+
360 & wcorr6*fact(5)*gradcorr6(j,i)+
361 & wturn6*fact(5)*gcorr6_turn(j,i)+
362 & wsccor*fact(2)*gsccorc(j,i)
363 & +wliptran*gliptranc(j,i)
364 & +welec*gshieldc(j,i)
365 & +welec*gshieldc_loc(j,i)
366 & +wcorr*gshieldc_ec(j,i)
367 & +wcorr*gshieldc_loc_ec(j,i)
368 & +wturn3*gshieldc_t3(j,i)
369 & +wturn3*gshieldc_loc_t3(j,i)
370 & +wturn4*gshieldc_t4(j,i)
371 & +wturn4*gshieldc_loc_t4(j,i)
372 & +wel_loc*gshieldc_ll(j,i)
373 & +wel_loc*gshieldc_loc_ll(j,i)+
374 & wdfa_dist*gdfad(j,i)+
375 & wdfa_tor*gdfat(j,i)+
376 & wdfa_nei*gdfan(j,i)+
377 & wdfa_beta*gdfab(j,i)
378 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)
379 & +fact(1)*wscp*gradx_scp(j,i)+
381 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
382 & wsccor*fact(2)*gsccorx(j,i)
383 & +wliptran*gliptranx(j,i)
384 & +welec*gshieldx(j,i)
385 & +wcorr*gshieldx_ec(j,i)
386 & +wturn3*gshieldx_t3(j,i)
387 & +wturn4*gshieldx_t4(j,i)
388 & +wel_loc*gshieldx_ll(j,i)
394 if (shield_mode.eq.0) then
395 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
396 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
398 & wcorr*fact(3)*gradcorr(j,i)+
399 & wel_loc*fact(2)*gel_loc(j,i)+
400 & wturn3*fact(2)*gcorr3_turn(j,i)+
401 & wturn4*fact(3)*gcorr4_turn(j,i)+
402 & wcorr5*fact(4)*gradcorr5(j,i)+
403 & wcorr6*fact(5)*gradcorr6(j,i)+
404 & wturn6*fact(5)*gcorr6_turn(j,i)+
405 & wsccor*fact(2)*gsccorc(j,i)
406 & +wliptran*gliptranc(j,i)+
407 & wdfa_dist*gdfad(j,i)+
408 & wdfa_tor*gdfat(j,i)+
409 & wdfa_nei*gdfan(j,i)+
410 & wdfa_beta*gdfab(j,i)
412 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
414 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
415 & wsccor*fact(1)*gsccorx(j,i)
416 & +wliptran*gliptranx(j,i)
418 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)+
419 & fact(1)*wscp*gvdwc_scp(j,i)+
420 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
422 & wcorr*fact(3)*gradcorr(j,i)+
423 & wel_loc*fact(2)*gel_loc(j,i)+
424 & wturn3*fact(2)*gcorr3_turn(j,i)+
425 & wturn4*fact(3)*gcorr4_turn(j,i)+
426 & wcorr5*fact(4)*gradcorr5(j,i)+
427 & wcorr6*fact(5)*gradcorr6(j,i)+
428 & wturn6*fact(5)*gcorr6_turn(j,i)+
429 & wsccor*fact(2)*gsccorc(j,i)
430 & +wliptran*gliptranc(j,i)
431 & +welec*gshieldc(j,i)
432 & +welec*gshieldc_loc(j,i)
433 & +wcorr*gshieldc_ec(j,i)
434 & +wcorr*gshieldc_loc_ec(j,i)
435 & +wturn3*gshieldc_t3(j,i)
436 & +wturn3*gshieldc_loc_t3(j,i)
437 & +wturn4*gshieldc_t4(j,i)
438 & +wturn4*gshieldc_loc_t4(j,i)
439 & +wel_loc*gshieldc_ll(j,i)
440 & +wel_loc*gshieldc_loc_ll(j,i)+
441 & wdfa_dist*gdfad(j,i)+
442 & wdfa_tor*gdfat(j,i)+
443 & wdfa_nei*gdfan(j,i)+
444 & wdfa_beta*gdfab(j,i)
445 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)+
446 & fact(1)*wscp*gradx_scp(j,i)+
448 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
449 & wsccor*fact(1)*gsccorx(j,i)
450 & +wliptran*gliptranx(j,i)
451 & +welec*gshieldx(j,i)
452 & +wcorr*gshieldx_ec(j,i)
453 & +wturn3*gshieldx_t3(j,i)
454 & +wturn4*gshieldx_t4(j,i)
455 & +wel_loc*gshieldx_ll(j,i)
464 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
465 & +wcorr5*fact(4)*g_corr5_loc(i)
466 & +wcorr6*fact(5)*g_corr6_loc(i)
467 & +wturn4*fact(3)*gel_loc_turn4(i)
468 & +wturn3*fact(2)*gel_loc_turn3(i)
469 & +wturn6*fact(5)*gel_loc_turn6(i)
470 & +wel_loc*fact(2)*gel_loc_loc(i)
471 c & +wsccor*fact(1)*gsccor_loc(i)
472 c BYLA ROZNICA Z CLUSTER< OSTATNIA LINIA DODANA
475 if (dyn_ss) call dyn_set_nss
478 C------------------------------------------------------------------------
479 subroutine enerprint(energia,fact)
480 implicit real*8 (a-h,o-z)
482 include 'DIMENSIONS.ZSCOPT'
483 include 'COMMON.IOUNITS'
484 include 'COMMON.FFIELD'
485 include 'COMMON.SBRIDGE'
486 include 'COMMON.CONTROL'
487 double precision energia(0:max_ene),fact(6)
489 evdw=energia(1)+fact(6)*energia(21)
491 evdw2=energia(2)+energia(17)
503 eello_turn3=energia(8)
504 eello_turn4=energia(9)
505 eello_turn6=energia(10)
512 edihcnstr=energia(20)
514 ethetacnstr=energia(24)
517 ehomology_constr=energia(27)
519 edfadis = energia(28)
520 edfator = energia(29)
521 edfanei = energia(30)
522 edfabet = energia(31)
527 write(iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,wvdwpp,
528 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
529 & etors_d,wtor_d*fact(2),ehpb,wstrain,
531 & ecorr,wcorr*fact(3),
532 & ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
535 & wel_loc*fact(2),eello_turn3,wturn3*fact(2),
536 & eello_turn4,wturn4*fact(3),
538 & eello_turn6,wturn6*fact(5),
540 & esccor,wsccor*fact(1),edihcnstr,
541 & ethetacnstr,ebr*nss,Uconst,wumb,eliptran,wliptran,Eafmforc,
542 & etube,wtube,esaxs,wsaxs,ehomology_constr,
543 & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,
546 10 format (/'Virtual-chain energies:'//
547 & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/
548 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/
549 & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/
550 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pE16.6,' (p-p VDW)'/
551 & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/
552 & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/
553 & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/
554 & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/
555 & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
556 & 'EHBP= ',1pE16.6,' WEIGHT=',1pE16.6,
557 & ' (SS bridges & dist. cnstr.)'/
559 & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
560 & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
561 & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
563 & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
564 & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
565 & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
567 & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
569 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
570 & 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/
571 & 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/
572 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
573 & 'UCONST=',1pE16.6,' WEIGHT=',1pE16.6' (umbrella restraints)'/
574 & 'ELT= ',1pE16.6,' WEIGHT=',1pE16.6,' (Lipid transfer)'/
575 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
576 & 'ETUBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (tube confinment)'/
577 & 'E_SAXS=',1pE16.6,' WEIGHT=',1pE16.6,' (SAXS restraints)'/
578 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
579 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA distance energy)'/
580 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA torsion energy)'/
581 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA NCa energy)'/
582 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA Beta energy)'/
583 & 'ETOT= ',1pE16.6,' (total)')
586 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),
587 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
588 & etors_d,wtor_d*fact(2),ehpb,wstrain,
590 & ecorr,wcorr*fact(3),
591 & ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
593 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
594 & eello_turn4,wturn4*fact(3),
596 & eello_turn6,wturn6*fact(5),
598 & esccor,wsccor*fact(1),edihcnstr,
599 & ethetacnstr,ebr*nss,Uconst,wumb,eliptran,wliptran,Eafmforc,
600 & etube,wtube,esaxs,wsaxs,ehomology_constr,
601 & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,
604 10 format (/'Virtual-chain energies:'//
605 & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/
606 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/
607 & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/
608 & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/
609 & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/
610 & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/
611 & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/
612 & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
613 & 'EHBP= ',1pE16.6,' WEIGHT=',1pE16.6,
614 & ' (SS bridges & dist. restr.)'/
616 & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
617 & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
618 & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
620 & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
621 & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
622 & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
624 & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
626 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
627 & 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/
628 & 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/
629 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
630 & 'UCONST=',1pE16.6,' WEIGHT=',1pE16.6' (umbrella restraints)'/
631 & 'ELT= ',1pE16.6,' WEIGHT=',1pE16.6,' (Lipid transfer)'/
632 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
633 & 'ETUBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (tube confinment)'/
634 & 'E_SAXS=',1pE16.6,' WEIGHT=',1pE16.6,' (SAXS restraints)'/
635 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
636 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA distance energy)'/
637 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA torsion energy)'/
638 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA NCa energy)'/
639 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA Beta energy)'/
640 & 'ETOT= ',1pE16.6,' (total)')
644 C-----------------------------------------------------------------------
645 subroutine elj(evdw,evdw_t)
647 C This subroutine calculates the interaction energy of nonbonded side chains
648 C assuming the LJ potential of interaction.
650 implicit real*8 (a-h,o-z)
652 include 'DIMENSIONS.ZSCOPT'
653 include "DIMENSIONS.COMPAR"
654 parameter (accur=1.0d-10)
657 include 'COMMON.LOCAL'
658 include 'COMMON.CHAIN'
659 include 'COMMON.DERIV'
660 include 'COMMON.INTERACT'
661 include 'COMMON.TORSION'
662 include 'COMMON.ENEPS'
663 include 'COMMON.SBRIDGE'
664 include 'COMMON.NAMES'
665 include 'COMMON.IOUNITS'
667 include 'COMMON.CONTACTS'
668 include 'COMMON.CONTMAT'
673 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
677 eneps_temp(j,i)=0.0d0
686 if (itypi.eq.ntyp1) cycle
687 itypi1=iabs(itype(i+1))
691 call to_box(xi,yi,zi)
695 C Calculate SC interaction energy.
698 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
699 cd & 'iend=',iend(i,iint)
700 do j=istart(i,iint),iend(i,iint)
702 if (itypj.eq.ntyp1) cycle
706 call to_box(xj,yj,zj)
707 xj=boxshift(xj-xi,boxxsize)
708 yj=boxshift(yj-yi,boxysize)
709 zj=boxshift(zj-zi,boxzsize)
710 C Change 12/1/95 to calculate four-body interactions
711 rij=xj*xj+yj*yj+zj*zj
715 if (sss1.eq.0.0d0) cycle
716 sssgrad1=sscagrad(sqrij)
717 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
718 eps0ij=eps(itypi,itypj)
723 ij=icant(itypi,itypj)
725 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
726 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
729 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
730 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
731 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
732 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
733 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
734 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
735 if (bb.gt.0.0d0) then
736 evdw=evdw+sss1*evdwij
738 evdw_t=evdw_t+sss1*evdwij
742 C Calculate the components of the gradient in DC and X
744 fac=-rrij*(e1+evdwij)*sss1
745 & +evdwij*sssgrad1/sqrij/expon
750 gvdwx(k,i)=gvdwx(k,i)-gg(k)
751 gvdwx(k,j)=gvdwx(k,j)+gg(k)
755 gvdwc(l,k)=gvdwc(l,k)+gg(l)
761 C 12/1/95, revised on 5/20/97
763 C Calculate the contact function. The ith column of the array JCONT will
764 C contain the numbers of atoms that make contacts with the atom I (of numbers
765 C greater than I). The arrays FACONT and GACONT will contain the values of
766 C the contact function and its derivative.
768 C Uncomment next line, if the correlation interactions include EVDW explicitly.
769 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
770 C Uncomment next line, if the correlation interactions are contact function only
771 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
773 sigij=sigma(itypi,itypj)
774 r0ij=rs0(itypi,itypj)
776 C Check whether the SC's are not too far to make a contact.
779 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
780 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
782 if (fcont.gt.0.0D0) then
783 C If the SC-SC distance if close to sigma, apply spline.
784 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
785 cAdam & fcont1,fprimcont1)
786 cAdam fcont1=1.0d0-fcont1
787 cAdam if (fcont1.gt.0.0d0) then
788 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
789 cAdam fcont=fcont*fcont1
791 C Uncomment following 4 lines to have the geometric average of the epsilon0's
792 cga eps0ij=1.0d0/dsqrt(eps0ij)
794 cga gg(k)=gg(k)*eps0ij
796 cga eps0ij=-evdwij*eps0ij
797 C Uncomment for AL's type of SC correlation interactions.
799 num_conti=num_conti+1
801 facont(num_conti,i)=fcont*eps0ij
802 fprimcont=eps0ij*fprimcont/rij
804 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
805 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
806 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
807 C Uncomment following 3 lines for Skolnick's type of SC correlation.
808 gacont(1,num_conti,i)=-fprimcont*xj
809 gacont(2,num_conti,i)=-fprimcont*yj
810 gacont(3,num_conti,i)=-fprimcont*zj
811 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
812 cd write (iout,'(2i3,3f10.5)')
813 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
821 num_cont(i)=num_conti
827 gvdwc(j,i)=expon*gvdwc(j,i)
828 gvdwx(j,i)=expon*gvdwx(j,i)
832 C******************************************************************************
836 C To save time, the factor of EXPON has been extracted from ALL components
837 C of GVDWC and GRADX. Remember to multiply them by this factor before further
840 C******************************************************************************
843 C-----------------------------------------------------------------------------
844 subroutine eljk(evdw,evdw_t)
846 C This subroutine calculates the interaction energy of nonbonded side chains
847 C assuming the LJK potential of interaction.
849 implicit real*8 (a-h,o-z)
851 include 'DIMENSIONS.ZSCOPT'
852 include "DIMENSIONS.COMPAR"
855 include 'COMMON.LOCAL'
856 include 'COMMON.CHAIN'
857 include 'COMMON.DERIV'
858 include 'COMMON.INTERACT'
859 include 'COMMON.ENEPS'
860 include 'COMMON.IOUNITS'
861 include 'COMMON.NAMES'
866 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
869 eneps_temp(j,i)=0.0d0
876 if (itypi.eq.ntyp1) cycle
877 itypi1=iabs(itype(i+1))
881 call to_box(xi,yi,zi)
883 C Calculate SC interaction energy.
886 do j=istart(i,iint),iend(i,iint)
888 if (itypj.eq.ntyp1) cycle
892 call to_box(xj,yj,zj)
893 xj=boxshift(xj-xi,boxxsize)
894 yj=boxshift(yj-yi,boxysize)
895 zj=boxshift(zj-zi,boxzsize)
896 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
898 e_augm=augm(itypi,itypj)*fac_augm
902 if (sss1.eq.0.0d0) cycle
903 sssgrad1=sscagrad(rij)
904 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
905 fac=r_shift_inv**expon
909 ij=icant(itypi,itypj)
910 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
911 & /dabs(eps(itypi,itypj))
912 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
913 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
914 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
915 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
916 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
917 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
918 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
919 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
920 if (bb.gt.0.0d0) then
921 evdw=evdw+evdwij*sss1
923 evdw_t=evdw_t+evdwij*sss1
927 C Calculate the components of the gradient in DC and X
929 fac=(-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2))*sss1
930 & +evdwij*sssgrad1*r_inv_ij/expon
935 gvdwx(k,i)=gvdwx(k,i)-gg(k)
936 gvdwx(k,j)=gvdwx(k,j)+gg(k)
940 gvdwc(l,k)=gvdwc(l,k)+gg(l)
950 gvdwc(j,i)=expon*gvdwc(j,i)
951 gvdwx(j,i)=expon*gvdwx(j,i)
957 C-----------------------------------------------------------------------------
958 subroutine ebp(evdw,evdw_t)
960 C This subroutine calculates the interaction energy of nonbonded side chains
961 C assuming the Berne-Pechukas potential of interaction.
963 implicit real*8 (a-h,o-z)
965 include 'DIMENSIONS.ZSCOPT'
966 include "DIMENSIONS.COMPAR"
969 include 'COMMON.LOCAL'
970 include 'COMMON.CHAIN'
971 include 'COMMON.DERIV'
972 include 'COMMON.NAMES'
973 include 'COMMON.INTERACT'
974 include 'COMMON.ENEPS'
975 include 'COMMON.IOUNITS'
976 include 'COMMON.CALC'
978 c double precision rrsave(maxdim)
984 eneps_temp(j,i)=0.0d0
989 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
990 c if (icall.eq.0) then
998 if (itypi.eq.ntyp1) cycle
999 itypi1=iabs(itype(i+1))
1003 call to_box(xi,yi,zi)
1004 dxi=dc_norm(1,nres+i)
1005 dyi=dc_norm(2,nres+i)
1006 dzi=dc_norm(3,nres+i)
1007 dsci_inv=vbld_inv(i+nres)
1009 C Calculate SC interaction energy.
1011 do iint=1,nint_gr(i)
1012 do j=istart(i,iint),iend(i,iint)
1014 itypj=iabs(itype(j))
1015 if (itypj.eq.ntyp1) cycle
1016 dscj_inv=vbld_inv(j+nres)
1017 chi1=chi(itypi,itypj)
1018 chi2=chi(itypj,itypi)
1025 alf12=0.5D0*(alf1+alf2)
1026 C For diagnostics only!!!
1039 call to_box(xj,yj,zj)
1040 xj=boxshift(xj-xi,boxxsize)
1041 yj=boxshift(yj-yi,boxysize)
1042 zj=boxshift(zj-zi,boxzsize)
1043 dxj=dc_norm(1,nres+j)
1044 dyj=dc_norm(2,nres+j)
1045 dzj=dc_norm(3,nres+j)
1046 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1047 cd if (icall.eq.0) then
1053 sss1=sscale(1.0d0/rij)
1054 if (sss1.eq.0.0d0) cycle
1055 sssgrad1=sscagrad(1.0d0/rij)
1057 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1059 C Calculate whole angle-dependent part of epsilon and contributions
1060 C to its derivatives
1061 fac=(rrij*sigsq)**expon2
1064 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1065 eps2der=evdwij*eps3rt
1066 eps3der=evdwij*eps2rt
1067 evdwij=evdwij*eps2rt*eps3rt
1068 ij=icant(itypi,itypj)
1069 aux=eps1*eps2rt**2*eps3rt**2
1070 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
1071 & /dabs(eps(itypi,itypj))
1072 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
1073 if (bb.gt.0.0d0) then
1074 evdw=evdw+sss1*evdwij
1076 evdw_t=evdw_t+sss1*evdwij
1080 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1082 write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1083 & restyp(itypi),i,restyp(itypj),j,
1084 & epsi,sigm,chi1,chi2,chip1,chip2,
1085 & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1086 & om1,om2,om12,1.0D0/dsqrt(rrij),
1089 C Calculate gradient components.
1090 e1=e1*eps1*eps2rt**2*eps3rt**2
1091 fac=-expon*(e1+evdwij)
1094 & +evdwij*sssgrad1/sss1*rij
1095 C Calculate radial part of the gradient
1099 C Calculate the angular part of the gradient and sum add the contributions
1100 C to the appropriate components of the Cartesian gradient.
1109 C-----------------------------------------------------------------------------
1110 subroutine egb(evdw,evdw_t)
1112 C This subroutine calculates the interaction energy of nonbonded side chains
1113 C assuming the Gay-Berne potential of interaction.
1115 implicit real*8 (a-h,o-z)
1116 include 'DIMENSIONS'
1117 include 'DIMENSIONS.ZSCOPT'
1118 include "DIMENSIONS.COMPAR"
1119 include 'COMMON.CONTROL'
1120 include 'COMMON.GEO'
1121 include 'COMMON.VAR'
1122 include 'COMMON.LOCAL'
1123 include 'COMMON.CHAIN'
1124 include 'COMMON.DERIV'
1125 include 'COMMON.NAMES'
1126 include 'COMMON.INTERACT'
1127 include 'COMMON.ENEPS'
1128 include 'COMMON.IOUNITS'
1129 include 'COMMON.CALC'
1130 include 'COMMON.SBRIDGE'
1133 integer icant,xshift,yshift,zshift
1137 eneps_temp(j,i)=0.0d0
1140 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1144 c if (icall.gt.0) lprn=.true.
1146 do i=iatsc_s,iatsc_e
1147 itypi=iabs(itype(i))
1148 if (itypi.eq.ntyp1) cycle
1149 itypi1=iabs(itype(i+1))
1153 C returning the ith atom to box
1154 call to_box(xi,yi,zi)
1155 call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
1156 dxi=dc_norm(1,nres+i)
1157 dyi=dc_norm(2,nres+i)
1158 dzi=dc_norm(3,nres+i)
1159 dsci_inv=vbld_inv(i+nres)
1161 C Calculate SC interaction energy.
1163 do iint=1,nint_gr(i)
1164 do j=istart(i,iint),iend(i,iint)
1165 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1166 call dyn_ssbond_ene(i,j,evdwij)
1168 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1169 C & 'evdw',i,j,evdwij,' ss',evdw,evdw_t
1170 C triple bond artifac removal
1171 do k=j+1,iend(i,iint)
1172 C search over all next residues
1173 if (dyn_ss_mask(k)) then
1174 C check if they are cysteins
1175 C write(iout,*) 'k=',k
1176 call triple_ssbond_ene(i,j,k,evdwij)
1177 C call the energy function that removes the artifical triple disulfide
1178 C bond the soubroutine is located in ssMD.F
1180 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1181 C & 'evdw',i,j,evdwij,'tss',evdw,evdw_t
1182 endif!dyn_ss_mask(k)
1186 itypj=iabs(itype(j))
1187 if (itypj.eq.ntyp1) cycle
1188 dscj_inv=vbld_inv(j+nres)
1189 sig0ij=sigma(itypi,itypj)
1190 chi1=chi(itypi,itypj)
1191 chi2=chi(itypj,itypi)
1198 alf12=0.5D0*(alf1+alf2)
1199 C For diagnostics only!!!
1212 C returning jth atom to box
1213 call to_box(xj,yj,zj)
1214 call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
1215 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1216 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1217 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1218 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1219 c write(iout,*) "tu,", i,j,aa_lip(itypi,itypj),bb_lip(itypi,itypj)
1220 c if (aa.ne.aa_aq(itypi,itypj)) write(iout,'(2e15.5)')
1221 c &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
1222 xj=boxshift(xj-xi,boxxsize)
1223 yj=boxshift(yj-yi,boxysize)
1224 zj=boxshift(zj-zi,boxzsize)
1225 dxj=dc_norm(1,nres+j)
1226 dyj=dc_norm(2,nres+j)
1227 dzj=dc_norm(3,nres+j)
1228 c write (iout,*) i,j,xj,yj,zj
1229 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1231 sss=sscale(1.0d0/rij)
1232 sssgrad=sscagrad(1.0d0/rij)
1233 if (sss.le.0.0) cycle
1234 C Calculate angle-dependent terms of energy and contributions to their
1239 sig=sig0ij*dsqrt(sigsq)
1240 rij_shift=1.0D0/rij-sig+sig0ij
1241 C I hate to put IF's in the loops, but here don't have another choice!!!!
1242 if (rij_shift.le.0.0D0) then
1247 c---------------------------------------------------------------
1248 rij_shift=1.0D0/rij_shift
1249 fac=rij_shift**expon
1252 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1253 eps2der=evdwij*eps3rt
1254 eps3der=evdwij*eps2rt
1255 evdwij=evdwij*eps2rt*eps3rt
1257 evdw=evdw+evdwij*sss
1259 evdw_t=evdw_t+evdwij*sss
1261 ij=icant(itypi,itypj)
1262 aux=eps1*eps2rt**2*eps3rt**2
1263 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
1264 & /dabs(eps(itypi,itypj))
1265 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1266 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1267 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1268 c & aux*e2/eps(itypi,itypj)
1270 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1274 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1275 & restyp(itypi),i,restyp(itypj),j,
1276 & epsi,sigm,chi1,chi2,chip1,chip2,
1277 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1278 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1280 write (iout,*) "partial sum", evdw, evdw_t
1284 if (energy_dec) write (iout,'(a,2i5,4f10.5,e15.5)')
1285 & 'r sss evdw',i,j,1.0d0/rij,sss,sslipi,sslipj,evdwij
1287 C Calculate gradient components.
1288 e1=e1*eps1*eps2rt**2*eps3rt**2
1289 fac=-expon*(e1+evdwij)*rij_shift
1292 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1293 C Calculate the radial part of the gradient
1294 gg_lipi(3)=eps1*(eps2rt*eps2rt)
1295 & *(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
1296 & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
1297 & +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1298 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1299 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1303 C Calculate angular part of the gradient.
1306 C write(iout,*) "partial sum", evdw, evdw_t
1313 C-----------------------------------------------------------------------------
1314 subroutine egbv(evdw,evdw_t)
1316 C This subroutine calculates the interaction energy of nonbonded side chains
1317 C assuming the Gay-Berne-Vorobjev potential of interaction.
1319 implicit real*8 (a-h,o-z)
1320 include 'DIMENSIONS'
1321 include 'DIMENSIONS.ZSCOPT'
1322 include "DIMENSIONS.COMPAR"
1323 include 'COMMON.GEO'
1324 include 'COMMON.VAR'
1325 include 'COMMON.LOCAL'
1326 include 'COMMON.CHAIN'
1327 include 'COMMON.DERIV'
1328 include 'COMMON.NAMES'
1329 include 'COMMON.INTERACT'
1330 include 'COMMON.ENEPS'
1331 include 'COMMON.IOUNITS'
1332 include 'COMMON.CALC'
1333 common /srutu/ icall
1339 eneps_temp(j,i)=0.0d0
1344 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1347 c if (icall.gt.0) lprn=.true.
1349 do i=iatsc_s,iatsc_e
1350 itypi=iabs(itype(i))
1351 if (itypi.eq.ntyp1) cycle
1352 itypi1=iabs(itype(i+1))
1356 call to_box(xi,yi,zi)
1357 call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
1358 dxi=dc_norm(1,nres+i)
1359 dyi=dc_norm(2,nres+i)
1360 dzi=dc_norm(3,nres+i)
1361 dsci_inv=vbld_inv(i+nres)
1363 C Calculate SC interaction energy.
1365 do iint=1,nint_gr(i)
1366 do j=istart(i,iint),iend(i,iint)
1368 itypj=iabs(itype(j))
1369 if (itypj.eq.ntyp1) cycle
1370 dscj_inv=vbld_inv(j+nres)
1371 sig0ij=sigma(itypi,itypj)
1372 r0ij=r0(itypi,itypj)
1373 chi1=chi(itypi,itypj)
1374 chi2=chi(itypj,itypi)
1381 alf12=0.5D0*(alf1+alf2)
1382 C For diagnostics only!!!
1395 call to_box(xj,yj,zj)
1396 call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
1397 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1398 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1399 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1400 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1401 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'2e10.5')
1402 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
1403 C write(iout,*) "tu,", i,j,aa,bb,aa_lip(itypi,itypj),sslipi,sslipj
1404 xj=boxshift(xj-xi,boxxsize)
1405 yj=boxshift(yj-yi,boxysize)
1406 zj=boxshift(zj-zi,boxzsize)
1407 dxj=dc_norm(1,nres+j)
1408 dyj=dc_norm(2,nres+j)
1409 dzj=dc_norm(3,nres+j)
1410 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1412 sss=sscale(1.0d0/rij)
1413 if (sss.eq.0.0d0) cycle
1414 sssgrad=sscagrad(1.0d0/rij)
1415 C Calculate angle-dependent terms of energy and contributions to their
1419 sig=sig0ij*dsqrt(sigsq)
1420 rij_shift=1.0D0/rij-sig+r0ij
1421 C I hate to put IF's in the loops, but here don't have another choice!!!!
1422 if (rij_shift.le.0.0D0) then
1427 c---------------------------------------------------------------
1428 rij_shift=1.0D0/rij_shift
1429 fac=rij_shift**expon
1432 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1433 eps2der=evdwij*eps3rt
1434 eps3der=evdwij*eps2rt
1435 fac_augm=rrij**expon
1436 e_augm=augm(itypi,itypj)*fac_augm
1437 evdwij=evdwij*eps2rt*eps3rt
1438 if (bb.gt.0.0d0) then
1439 evdw=evdw+(evdwij+e_augm)*sss
1441 evdw_t=evdw_t+(evdwij+e_augm)*sss
1443 ij=icant(itypi,itypj)
1444 aux=eps1*eps2rt**2*eps3rt**2
1445 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1446 & /dabs(eps(itypi,itypj))
1447 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1448 c eneps_temp(ij)=eneps_temp(ij)
1449 c & +(evdwij+e_augm)/eps(itypi,itypj)
1451 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1452 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1453 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1454 c & restyp(itypi),i,restyp(itypj),j,
1455 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1456 c & chi1,chi2,chip1,chip2,
1457 c & eps1,eps2rt**2,eps3rt**2,
1458 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1462 C Calculate gradient components.
1463 e1=e1*eps1*eps2rt**2*eps3rt**2
1464 fac=-expon*(e1+evdwij)*rij_shift
1466 fac=rij*fac-2*expon*rrij*e_augm
1467 fac=fac+(evdwij+e_augm)*sssgrad/sss*rij
1468 C Calculate the radial part of the gradient
1469 gg_lipi(3)=eps1*(eps2rt*eps2rt)
1470 & *(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
1471 & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
1472 & +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1473 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1474 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1478 C Calculate angular part of the gradient.
1486 C-----------------------------------------------------------------------------
1487 subroutine sc_angular
1488 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1489 C om12. Called by ebp, egb, and egbv.
1491 include 'COMMON.CALC'
1495 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1496 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1497 om12=dxi*dxj+dyi*dyj+dzi*dzj
1499 C Calculate eps1(om12) and its derivative in om12
1500 faceps1=1.0D0-om12*chiom12
1501 faceps1_inv=1.0D0/faceps1
1502 eps1=dsqrt(faceps1_inv)
1503 C Following variable is eps1*deps1/dom12
1504 eps1_om12=faceps1_inv*chiom12
1505 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1510 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1511 sigsq=1.0D0-facsig*faceps1_inv
1512 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1513 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1514 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1515 C Calculate eps2 and its derivatives in om1, om2, and om12.
1518 chipom12=chip12*om12
1519 facp=1.0D0-om12*chipom12
1521 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1522 C Following variable is the square root of eps2
1523 eps2rt=1.0D0-facp1*facp_inv
1524 C Following three variables are the derivatives of the square root of eps
1525 C in om1, om2, and om12.
1526 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1527 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1528 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1529 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1530 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1531 C Calculate whole angle-dependent part of epsilon and contributions
1532 C to its derivatives
1535 C----------------------------------------------------------------------------
1537 implicit real*8 (a-h,o-z)
1538 include 'DIMENSIONS'
1539 include 'DIMENSIONS.ZSCOPT'
1540 include 'COMMON.CHAIN'
1541 include 'COMMON.DERIV'
1542 include 'COMMON.CALC'
1543 double precision dcosom1(3),dcosom2(3)
1544 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1545 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1546 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1547 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1549 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1550 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1553 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1556 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1557 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1558 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1559 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1560 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1561 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1564 C Calculate the components of the gradient in DC and X
1568 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1573 c------------------------------------------------------------------------------
1574 subroutine vec_and_deriv
1575 implicit real*8 (a-h,o-z)
1576 include 'DIMENSIONS'
1577 include 'DIMENSIONS.ZSCOPT'
1578 include 'COMMON.IOUNITS'
1579 include 'COMMON.GEO'
1580 include 'COMMON.VAR'
1581 include 'COMMON.LOCAL'
1582 include 'COMMON.CHAIN'
1583 include 'COMMON.VECTORS'
1584 include 'COMMON.DERIV'
1585 include 'COMMON.INTERACT'
1586 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1587 C Compute the local reference systems. For reference system (i), the
1588 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1589 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1591 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1592 if (i.eq.nres-1) then
1593 C Case of the last full residue
1594 C Compute the Z-axis
1595 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1596 costh=dcos(pi-theta(nres))
1597 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1598 c write (iout,*) "i",i," dc_norm",dc_norm(:,i),dc_norm(:,i-1),
1604 C Compute the derivatives of uz
1606 uzder(2,1,1)=-dc_norm(3,i-1)
1607 uzder(3,1,1)= dc_norm(2,i-1)
1608 uzder(1,2,1)= dc_norm(3,i-1)
1610 uzder(3,2,1)=-dc_norm(1,i-1)
1611 uzder(1,3,1)=-dc_norm(2,i-1)
1612 uzder(2,3,1)= dc_norm(1,i-1)
1615 uzder(2,1,2)= dc_norm(3,i)
1616 uzder(3,1,2)=-dc_norm(2,i)
1617 uzder(1,2,2)=-dc_norm(3,i)
1619 uzder(3,2,2)= dc_norm(1,i)
1620 uzder(1,3,2)= dc_norm(2,i)
1621 uzder(2,3,2)=-dc_norm(1,i)
1624 C Compute the Y-axis
1627 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1630 C Compute the derivatives of uy
1633 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1634 & -dc_norm(k,i)*dc_norm(j,i-1)
1635 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1637 uyder(j,j,1)=uyder(j,j,1)-costh
1638 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1643 uygrad(l,k,j,i)=uyder(l,k,j)
1644 uzgrad(l,k,j,i)=uzder(l,k,j)
1648 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1649 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1650 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1651 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1655 C Compute the Z-axis
1656 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1657 costh=dcos(pi-theta(i+2))
1658 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1663 C Compute the derivatives of uz
1665 uzder(2,1,1)=-dc_norm(3,i+1)
1666 uzder(3,1,1)= dc_norm(2,i+1)
1667 uzder(1,2,1)= dc_norm(3,i+1)
1669 uzder(3,2,1)=-dc_norm(1,i+1)
1670 uzder(1,3,1)=-dc_norm(2,i+1)
1671 uzder(2,3,1)= dc_norm(1,i+1)
1674 uzder(2,1,2)= dc_norm(3,i)
1675 uzder(3,1,2)=-dc_norm(2,i)
1676 uzder(1,2,2)=-dc_norm(3,i)
1678 uzder(3,2,2)= dc_norm(1,i)
1679 uzder(1,3,2)= dc_norm(2,i)
1680 uzder(2,3,2)=-dc_norm(1,i)
1683 C Compute the Y-axis
1686 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1689 C Compute the derivatives of uy
1692 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1693 & -dc_norm(k,i)*dc_norm(j,i+1)
1694 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1696 uyder(j,j,1)=uyder(j,j,1)-costh
1697 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1702 uygrad(l,k,j,i)=uyder(l,k,j)
1703 uzgrad(l,k,j,i)=uzder(l,k,j)
1707 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1708 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1709 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1710 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1716 vbld_inv_temp(1)=vbld_inv(i+1)
1717 if (i.lt.nres-1) then
1718 vbld_inv_temp(2)=vbld_inv(i+2)
1720 vbld_inv_temp(2)=vbld_inv(i)
1725 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1726 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1734 C--------------------------------------------------------------------------
1735 subroutine set_matrices
1736 implicit real*8 (a-h,o-z)
1737 include 'DIMENSIONS'
1741 integer status(MPI_STATUS_SIZE)
1743 include 'DIMENSIONS.ZSCOPT'
1744 include 'COMMON.IOUNITS'
1745 include 'COMMON.GEO'
1746 include 'COMMON.VAR'
1747 include 'COMMON.LOCAL'
1748 include 'COMMON.CHAIN'
1749 include 'COMMON.DERIV'
1750 include 'COMMON.INTERACT'
1751 include 'COMMON.CORRMAT'
1752 include 'COMMON.TORSION'
1753 include 'COMMON.VECTORS'
1754 include 'COMMON.FFIELD'
1755 double precision auxvec(2),auxmat(2,2)
1757 C Compute the virtual-bond-torsional-angle dependent quantities needed
1758 C to calculate the el-loc multibody terms of various order.
1760 c write(iout,*) 'SET_MATRICES nphi=',nphi,nres
1764 innt=chain_border(1,ii)
1765 inct=chain_border(2,ii)
1766 c if (i.gt. nnt+2 .and. i.lt.nct+2) then
1767 if (i.gt. innt+2 .and. i.lt.inct+2) then
1768 iti = itype2loc(itype(i-2))
1772 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1773 c if (i.gt. nnt+1 .and. i.lt.nct+1) then
1774 if (i.gt. innt+1 .and. i.lt.inct+1) then
1775 iti1 = itype2loc(itype(i-1))
1780 cost1=dcos(theta(i-1))
1781 sint1=dsin(theta(i-1))
1783 sint1cub=sint1sq*sint1
1784 sint1cost1=2*sint1*cost1
1786 write (iout,*) "bnew1",i,iti
1787 write (iout,*) (bnew1(k,1,iti),k=1,3)
1788 write (iout,*) (bnew1(k,2,iti),k=1,3)
1789 write (iout,*) "bnew2",i,iti
1790 write (iout,*) (bnew2(k,1,iti),k=1,3)
1791 write (iout,*) (bnew2(k,2,iti),k=1,3)
1794 b1k=bnew1(1,k,iti)+(bnew1(2,k,iti)+bnew1(3,k,iti)*cost1)*cost1
1796 gtb1(k,i-2)=cost1*b1k-sint1sq*
1797 & (bnew1(2,k,iti)+2*bnew1(3,k,iti)*cost1)
1798 b2k=bnew2(1,k,iti)+(bnew2(2,k,iti)+bnew2(3,k,iti)*cost1)*cost1
1800 if (calc_grad) gtb2(k,i-2)=cost1*b2k-sint1sq*
1801 & (bnew2(2,k,iti)+2*bnew2(3,k,iti)*cost1)
1804 aux=ccnew(1,k,iti)+(ccnew(2,k,iti)+ccnew(3,k,iti)*cost1)*cost1
1805 cc(1,k,i-2)=sint1sq*aux
1806 if (calc_grad) gtcc(1,k,i-2)=sint1cost1*aux-sint1cub*
1807 & (ccnew(2,k,iti)+2*ccnew(3,k,iti)*cost1)
1808 aux=ddnew(1,k,iti)+(ddnew(2,k,iti)+ddnew(3,k,iti)*cost1)*cost1
1809 dd(1,k,i-2)=sint1sq*aux
1810 if (calc_grad) gtdd(1,k,i-2)=sint1cost1*aux-sint1cub*
1811 & (ddnew(2,k,iti)+2*ddnew(3,k,iti)*cost1)
1813 cc(2,1,i-2)=cc(1,2,i-2)
1814 cc(2,2,i-2)=-cc(1,1,i-2)
1815 gtcc(2,1,i-2)=gtcc(1,2,i-2)
1816 gtcc(2,2,i-2)=-gtcc(1,1,i-2)
1817 dd(2,1,i-2)=dd(1,2,i-2)
1818 dd(2,2,i-2)=-dd(1,1,i-2)
1819 gtdd(2,1,i-2)=gtdd(1,2,i-2)
1820 gtdd(2,2,i-2)=-gtdd(1,1,i-2)
1823 aux=eenew(1,l,k,iti)+eenew(2,l,k,iti)*cost1
1824 EE(l,k,i-2)=sint1sq*aux
1826 & gtEE(l,k,i-2)=sint1cost1*aux-sint1cub*eenew(2,l,k,iti)
1829 EE(1,1,i-2)=EE(1,1,i-2)+e0new(1,iti)*cost1
1830 EE(1,2,i-2)=EE(1,2,i-2)+e0new(2,iti)+e0new(3,iti)*cost1
1831 EE(2,1,i-2)=EE(2,1,i-2)+e0new(2,iti)*cost1+e0new(3,iti)
1832 EE(2,2,i-2)=EE(2,2,i-2)-e0new(1,iti)
1834 gtEE(1,1,i-2)=gtEE(1,1,i-2)-e0new(1,iti)*sint1
1835 gtEE(1,2,i-2)=gtEE(1,2,i-2)-e0new(3,iti)*sint1
1836 gtEE(2,1,i-2)=gtEE(2,1,i-2)-e0new(2,iti)*sint1
1838 c b1tilde(1,i-2)=b1(1,i-2)
1839 c b1tilde(2,i-2)=-b1(2,i-2)
1840 c b2tilde(1,i-2)=b2(1,i-2)
1841 c b2tilde(2,i-2)=-b2(2,i-2)
1843 write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
1844 write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
1845 write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
1846 write (iout,*) 'theta=', theta(i-1)
1849 c if (i.gt. nnt+2 .and. i.lt.nct+2) then
1850 c iti = itype2loc(itype(i-2))
1854 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1855 c if (i.gt. nnt+1 .and. i.lt.nct+1) then
1856 c iti1 = itype2loc(itype(i-1))
1866 CC(k,l,i-2)=ccold(k,l,iti)
1867 DD(k,l,i-2)=ddold(k,l,iti)
1868 EE(k,l,i-2)=eeold(k,l,iti)
1872 b1tilde(1,i-2)= b1(1,i-2)
1873 b1tilde(2,i-2)=-b1(2,i-2)
1874 b2tilde(1,i-2)= b2(1,i-2)
1875 b2tilde(2,i-2)=-b2(2,i-2)
1877 Ctilde(1,1,i-2)= CC(1,1,i-2)
1878 Ctilde(1,2,i-2)= CC(1,2,i-2)
1879 Ctilde(2,1,i-2)=-CC(2,1,i-2)
1880 Ctilde(2,2,i-2)=-CC(2,2,i-2)
1882 Dtilde(1,1,i-2)= DD(1,1,i-2)
1883 Dtilde(1,2,i-2)= DD(1,2,i-2)
1884 Dtilde(2,1,i-2)=-DD(2,1,i-2)
1885 Dtilde(2,2,i-2)=-DD(2,2,i-2)
1887 write(iout,*) "i",i," iti",iti
1888 write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
1889 write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
1893 if (i .lt. nres+1) then
1930 if (i .gt. 3 .and. i .lt. nres+1) then
1931 obrot_der(1,i-2)=-sin1
1932 obrot_der(2,i-2)= cos1
1933 Ugder(1,1,i-2)= sin1
1934 Ugder(1,2,i-2)=-cos1
1935 Ugder(2,1,i-2)=-cos1
1936 Ugder(2,2,i-2)=-sin1
1939 obrot2_der(1,i-2)=-dwasin2
1940 obrot2_der(2,i-2)= dwacos2
1941 Ug2der(1,1,i-2)= dwasin2
1942 Ug2der(1,2,i-2)=-dwacos2
1943 Ug2der(2,1,i-2)=-dwacos2
1944 Ug2der(2,2,i-2)=-dwasin2
1946 obrot_der(1,i-2)=0.0d0
1947 obrot_der(2,i-2)=0.0d0
1948 Ugder(1,1,i-2)=0.0d0
1949 Ugder(1,2,i-2)=0.0d0
1950 Ugder(2,1,i-2)=0.0d0
1951 Ugder(2,2,i-2)=0.0d0
1952 obrot2_der(1,i-2)=0.0d0
1953 obrot2_der(2,i-2)=0.0d0
1954 Ug2der(1,1,i-2)=0.0d0
1955 Ug2der(1,2,i-2)=0.0d0
1956 Ug2der(2,1,i-2)=0.0d0
1957 Ug2der(2,2,i-2)=0.0d0
1959 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1960 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1961 iti = itype2loc(itype(i-2))
1965 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1966 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1967 iti1 = itype2loc(itype(i-1))
1971 cd write (iout,*) '*******i',i,' iti1',iti
1972 cd write (iout,*) 'b1',b1(:,iti)
1973 cd write (iout,*) 'b2',b2(:,iti)
1974 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1975 c if (i .gt. iatel_s+2) then
1976 if (i .gt. nnt+2) then
1977 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
1979 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
1980 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
1982 c write(iout,*) "co jest kurwa", iti, EE(1,1,i),EE(2,1,i),
1983 c & EE(1,2,iti),EE(2,2,i)
1984 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
1985 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
1986 c write(iout,*) "Macierz EUG",
1987 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
1990 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
1992 call matmat2(CC(1,1,i-2),Ug(1,1,i-2),CUg(1,1,i-2))
1993 call matmat2(DD(1,1,i-2),Ug(1,1,i-2),DUg(1,1,i-2))
1994 call matmat2(Dtilde(1,1,i-2),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1995 call matvec2(Ctilde(1,1,i-1),obrot(1,i-2),Ctobr(1,i-2))
1996 call matvec2(Dtilde(1,1,i-2),obrot2(1,i-2),Dtobr2(1,i-2))
2008 DtUg2(l,k,i-2)=0.0d0
2012 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2013 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2015 muder(k,i-2)=Ub2der(k,i-2)
2017 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2018 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2019 if (itype(i-1).le.ntyp) then
2020 iti1 = itype2loc(itype(i-1))
2028 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2031 write (iout,'(2hmu,i3,3f8.1,12f10.5)') i-2,rad2deg*theta(i-1),
2032 & rad2deg*theta(i),rad2deg*phi(i),mu(1,i-2),mu(2,i-2),
2033 & -b2(1,i-2),b2(2,i-2),b1(1,i-2),b1(2,i-2),
2034 & dsqrt(b2(1,i-1)**2+b2(2,i-1)**2)
2035 & +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2),
2036 & ((ee(l,k,i-2),l=1,2),k=1,2)
2038 cd write (iout,*) 'mu1',mu1(:,i-2)
2039 cd write (iout,*) 'mu2',mu2(:,i-2)
2041 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2044 call matmat2(CC(1,1,i-1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2045 call matmat2(DD(1,1,i-2),Ugder(1,1,i-2),DUgder(1,1,i-2))
2046 call matmat2(Dtilde(1,1,i-2),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2047 call matvec2(Ctilde(1,1,i-1),obrot_der(1,i-2),Ctobrder(1,i-2))
2048 call matvec2(Dtilde(1,1,i-2),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2050 C Vectors and matrices dependent on a single virtual-bond dihedral.
2051 call matvec2(DD(1,1,i-2),b1tilde(1,i-1),auxvec(1))
2052 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2053 call matvec2(CC(1,1,i-1),Ub2(1,i-2),CUgb2(1,i-2))
2054 call matmat2(EUg(1,1,i-2),CC(1,1,i-1),EUgC(1,1,i-2))
2055 call matmat2(EUg(1,1,i-2),DD(1,1,i-1),EUgD(1,1,i-2))
2057 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2058 call matvec2(CC(1,1,i-1),Ub2der(1,i-2),CUgb2der(1,i-2))
2059 call matmat2(EUgder(1,1,i-2),CC(1,1,i-1),EUgCder(1,1,i-2))
2060 call matmat2(EUgder(1,1,i-2),DD(1,1,i-1),EUgDder(1,1,i-2))
2066 C Matrices dependent on two consecutive virtual-bond dihedrals.
2067 C The order of matrices is from left to right.
2068 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2071 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2073 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2074 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2076 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2077 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2079 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2080 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2081 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2088 C--------------------------------------------------------------------------
2089 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2091 C This subroutine calculates the average interaction energy and its gradient
2092 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2093 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2094 C The potential depends both on the distance of peptide-group centers and on
2095 C the orientation of the CA-CA virtual bonds.
2097 implicit real*8 (a-h,o-z)
2101 include 'DIMENSIONS'
2102 include 'DIMENSIONS.ZSCOPT'
2103 include 'COMMON.CONTROL'
2104 include 'COMMON.IOUNITS'
2105 include 'COMMON.GEO'
2106 include 'COMMON.VAR'
2107 include 'COMMON.LOCAL'
2108 include 'COMMON.CHAIN'
2109 include 'COMMON.DERIV'
2110 include 'COMMON.INTERACT'
2112 include 'COMMON.CONTACTS'
2113 include 'COMMON.CONTMAT'
2115 include 'COMMON.CORRMAT'
2116 include 'COMMON.TORSION'
2117 include 'COMMON.VECTORS'
2118 include 'COMMON.FFIELD'
2119 include 'COMMON.TIME1'
2120 include 'COMMON.SPLITELE'
2121 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2122 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2123 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2124 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
2125 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2126 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2128 double precision sslipi,sslipj,ssgradlipi,ssgradlipj
2129 common /lipcalc/ sslipi,sslipj,ssgradlipi,ssgradlipj
2130 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2132 double precision scal_el /1.0d0/
2134 double precision scal_el /0.5d0/
2137 C 13-go grudnia roku pamietnego...
2138 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2139 & 0.0d0,1.0d0,0.0d0,
2140 & 0.0d0,0.0d0,1.0d0/
2141 cd write(iout,*) 'In EELEC'
2143 cd write(iout,*) 'Type',i
2144 cd write(iout,*) 'B1',B1(:,i)
2145 cd write(iout,*) 'B2',B2(:,i)
2146 cd write(iout,*) 'CC',CC(:,:,i)
2147 cd write(iout,*) 'DD',DD(:,:,i)
2148 cd write(iout,*) 'EE',EE(:,:,i)
2150 cd call check_vecgrad
2152 if (icheckgrad.eq.1) then
2154 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2156 dc_norm(k,i)=dc(k,i)*fac
2158 c write (iout,*) 'i',i,' fac',fac
2161 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2162 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2163 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2164 c call vec_and_deriv
2170 time_mat=time_mat+MPI_Wtime()-time01
2174 cd write (iout,*) 'i=',i
2176 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2179 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2180 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2195 cd print '(a)','Enter EELEC'
2196 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2198 gel_loc_loc(i)=0.0d0
2203 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2205 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2207 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
2208 do i=iturn3_start,iturn3_end
2210 C write(iout,*) "tu jest i",i
2211 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2212 C changes suggested by Ana to avoid out of bounds
2213 C Adam: Unnecessary: handled by iturn3_end and iturn3_start
2214 c & .or.((i+4).gt.nres)
2215 c & .or.((i-1).le.0)
2216 C end of changes by Ana
2217 C dobra zmiana wycofana
2218 & .or. itype(i+2).eq.ntyp1
2219 & .or. itype(i+3).eq.ntyp1) cycle
2220 C Adam: Instructions below will switch off existing interactions
2222 c if(itype(i-1).eq.ntyp1)cycle
2224 c if(i.LT.nres-3)then
2225 c if (itype(i+4).eq.ntyp1) cycle
2230 dx_normi=dc_norm(1,i)
2231 dy_normi=dc_norm(2,i)
2232 dz_normi=dc_norm(3,i)
2233 xmedi=c(1,i)+0.5d0*dxi
2234 ymedi=c(2,i)+0.5d0*dyi
2235 zmedi=c(3,i)+0.5d0*dzi
2236 call to_box(xmedi,ymedi,zmedi)
2237 call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
2239 call eelecij(i,i+2,ees,evdw1,eel_loc)
2240 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2242 num_cont_hb(i)=num_conti
2245 do i=iturn4_start,iturn4_end
2247 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2248 C changes suggested by Ana to avoid out of bounds
2249 c & .or.((i+5).gt.nres)
2250 c & .or.((i-1).le.0)
2251 C end of changes suggested by Ana
2252 & .or. itype(i+3).eq.ntyp1
2253 & .or. itype(i+4).eq.ntyp1
2254 c & .or. itype(i+5).eq.ntyp1
2255 c & .or. itype(i).eq.ntyp1
2256 c & .or. itype(i-1).eq.ntyp1
2261 dx_normi=dc_norm(1,i)
2262 dy_normi=dc_norm(2,i)
2263 dz_normi=dc_norm(3,i)
2264 xmedi=c(1,i)+0.5d0*dxi
2265 ymedi=c(2,i)+0.5d0*dyi
2266 zmedi=c(3,i)+0.5d0*dzi
2267 call to_box(xmedi,ymedi,zmedi)
2268 call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
2270 num_conti=num_cont_hb(i)
2272 c write(iout,*) "JESTEM W PETLI"
2273 call eelecij(i,i+3,ees,evdw1,eel_loc)
2274 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2275 & call eturn4(i,eello_turn4)
2277 num_cont_hb(i)=num_conti
2280 C Loop over all neighbouring boxes
2285 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2288 do i=iatel_s,iatel_e
2291 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2292 C changes suggested by Ana to avoid out of bounds
2293 c & .or.((i+2).gt.nres)
2294 c & .or.((i-1).le.0)
2295 C end of changes by Ana
2296 c & .or. itype(i+2).eq.ntyp1
2297 c & .or. itype(i-1).eq.ntyp1
2302 dx_normi=dc_norm(1,i)
2303 dy_normi=dc_norm(2,i)
2304 dz_normi=dc_norm(3,i)
2305 xmedi=c(1,i)+0.5d0*dxi
2306 ymedi=c(2,i)+0.5d0*dyi
2307 zmedi=c(3,i)+0.5d0*dzi
2308 call to_box(xmedi,ymedi,zmedi)
2309 call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
2311 num_conti=num_cont_hb(i)
2314 do j=ielstart(i),ielend(i)
2316 C write (iout,*) i,j
2318 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
2319 C changes suggested by Ana to avoid out of bounds
2320 c & .or.((j+2).gt.nres)
2321 c & .or.((j-1).le.0)
2322 C end of changes by Ana
2323 c & .or.itype(j+2).eq.ntyp1
2324 c & .or.itype(j-1).eq.ntyp1
2326 call eelecij(i,j,ees,evdw1,eel_loc)
2329 num_cont_hb(i)=num_conti
2336 c write (iout,*) "Number of loop steps in EELEC:",ind
2338 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2339 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2341 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2342 ccc eel_loc=eel_loc+eello_turn3
2343 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2346 C-------------------------------------------------------------------------------
2347 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2348 implicit real*8 (a-h,o-z)
2349 include 'DIMENSIONS'
2350 include 'DIMENSIONS.ZSCOPT'
2354 include 'COMMON.CONTROL'
2355 include 'COMMON.IOUNITS'
2356 include 'COMMON.GEO'
2357 include 'COMMON.VAR'
2358 include 'COMMON.LOCAL'
2359 include 'COMMON.CHAIN'
2360 include 'COMMON.DERIV'
2361 include 'COMMON.INTERACT'
2363 include 'COMMON.CONTACTS'
2364 include 'COMMON.CONTMAT'
2366 include 'COMMON.CORRMAT'
2367 include 'COMMON.TORSION'
2368 include 'COMMON.VECTORS'
2369 include 'COMMON.FFIELD'
2370 include 'COMMON.TIME1'
2371 include 'COMMON.SPLITELE'
2372 include 'COMMON.SHIELD'
2373 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2374 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2375 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2376 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
2377 & gmuij2(4),gmuji2(4)
2378 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2379 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2381 double precision sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij,
2383 common /lipcalc/ sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij
2384 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2386 double precision scal_el /1.0d0/
2388 double precision scal_el /0.5d0/
2391 C 13-go grudnia roku pamietnego...
2392 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2393 & 0.0d0,1.0d0,0.0d0,
2394 & 0.0d0,0.0d0,1.0d0/
2395 integer xshift,yshift,zshift
2396 c time00=MPI_Wtime()
2397 cd write (iout,*) "eelecij",i,j
2401 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2402 aaa=app(iteli,itelj)
2403 bbb=bpp(iteli,itelj)
2404 ael6i=ael6(iteli,itelj)
2405 ael3i=ael3(iteli,itelj)
2409 dx_normj=dc_norm(1,j)
2410 dy_normj=dc_norm(2,j)
2411 dz_normj=dc_norm(3,j)
2412 C xj=c(1,j)+0.5D0*dxj-xmedi
2413 C yj=c(2,j)+0.5D0*dyj-ymedi
2414 C zj=c(3,j)+0.5D0*dzj-zmedi
2418 call to_box(xj,yj,zj)
2419 call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
2420 faclipij=(sslipi+sslipj)/2.0d0*lipscale+1.0d0
2421 faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
2422 xj=boxshift(xj-xmedi,boxxsize)
2423 yj=boxshift(yj-ymedi,boxysize)
2424 zj=boxshift(zj-zmedi,boxzsize)
2425 rij=xj*xj+yj*yj+zj*zj
2427 sss=sscale(sqrt(rij))
2428 if (sss.eq.0.0d0) return
2429 sssgrad=sscagrad(sqrt(rij))
2430 c write (iout,*) "ij",i,j," rij",sqrt(rij)," r_cut",r_cut,
2431 c & " rlamb",rlamb," sss",sss
2432 c if (sss.gt.0.0d0) then
2438 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2439 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2440 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2441 fac=cosa-3.0D0*cosb*cosg
2443 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2444 if (j.eq.i+2) ev1=scal_el*ev1
2449 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2453 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2454 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2455 if (shield_mode.gt.0) then
2458 el1=el1*fac_shield(i)**2*fac_shield(j)**2
2459 el2=el2*fac_shield(i)**2*fac_shield(j)**2
2461 ees=ees+eesij*faclipij2
2466 ees=ees+eesij*faclipij2
2468 evdw1=evdw1+evdwij*sss*faclipij2
2469 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2470 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2471 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2472 cd & xmedi,ymedi,zmedi,xj,yj,zj
2474 if (energy_dec) then
2475 write (iout,'(a6,2i5,0pf7.3,2i5,3e11.3)')
2476 &' evdw1',i,j,evdwij,iteli,itelj,aaa,evdw1,sss
2477 write (iout,'(a6,2i5,0pf7.3,6f8.5)') 'ees',i,j,eesij,
2478 & fac_shield(i),fac_shield(j),sslipi,sslipj,faclipij,
2483 C Calculate contributions to the Cartesian gradient.
2486 facvdw=-6*rrmij*(ev1+evdwij)*sss
2487 facel=-3*rrmij*(el1+eesij)
2494 * Radial derivatives. First process both termini of the fragment (i,j)
2497 aux=(facel*sss+rmij*sssgrad*eesij)*faclipij2
2501 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2502 & (shield_mode.gt.0)) then
2504 do ilist=1,ishield_list(i)
2505 iresshield=shield_list(ilist,i)
2507 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
2509 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2511 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
2512 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2513 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2514 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2515 C if (iresshield.gt.i) then
2516 C do ishi=i+1,iresshield-1
2517 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2518 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2522 C do ishi=iresshield,i
2523 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2524 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2530 do ilist=1,ishield_list(j)
2531 iresshield=shield_list(ilist,j)
2533 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
2535 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2537 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
2538 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2540 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2541 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2542 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2543 C if (iresshield.gt.j) then
2544 C do ishi=j+1,iresshield-1
2545 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2546 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2550 C do ishi=iresshield,j
2551 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2552 C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2559 gshieldc(k,i)=gshieldc(k,i)+
2560 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2561 gshieldc(k,j)=gshieldc(k,j)+
2562 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2563 gshieldc(k,i-1)=gshieldc(k,i-1)+
2564 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2565 gshieldc(k,j-1)=gshieldc(k,j-1)+
2566 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2571 c ghalf=0.5D0*ggg(k)
2572 c gelc(k,i)=gelc(k,i)+ghalf
2573 c gelc(k,j)=gelc(k,j)+ghalf
2575 c 9/28/08 AL Gradient compotents will be summed only at the end
2576 C print *,"before", gelc_long(1,i), gelc_long(1,j)
2578 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2579 C & +grad_shield(k,j)*eesij/fac_shield(j)
2580 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2581 C & +grad_shield(k,i)*eesij/fac_shield(i)
2582 C gelc_long(k,i-1)=gelc_long(k,i-1)
2583 C & +grad_shield(k,i)*eesij/fac_shield(i)
2584 C gelc_long(k,j-1)=gelc_long(k,j-1)
2585 C & +grad_shield(k,j)*eesij/fac_shield(j)
2586 gelc_long(3,j)=gelc_long(3,j)+
2587 & ssgradlipj*eesij/2.0d0*lipscale**2*sss
2589 gelc_long(3,i)=gelc_long(3,i)+
2590 & ssgradlipi*eesij/2.0d0*lipscale**2*sss
2592 C print *,"bafter", gelc_long(1,i), gelc_long(1,j)
2595 * Loop over residues i+1 thru j-1.
2599 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2602 if (sss.gt.0.0) then
2603 facvdw=(facvdw+sssgrad*rmij*evdwij)*faclipij2
2613 c ghalf=0.5D0*ggg(k)
2614 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2615 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2617 c 9/28/08 AL Gradient compotents will be summed only at the end
2619 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2620 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2622 !C Lipidic part for scaling weight
2623 gvdwpp(3,j)=gvdwpp(3,j)+
2624 & sss*ssgradlipj*evdwij/2.0d0*lipscale**2
2625 gvdwpp(3,i)=gvdwpp(3,i)+
2626 & sss*ssgradlipi*evdwij/2.0d0*lipscale**2
2628 * Loop over residues i+1 thru j-1.
2632 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2638 facvdw=(ev1+evdwij)*faclipij2
2641 fac=-3*rrmij*(facvdw+facvdw+facel)*sss
2642 & +(evdwij+eesij)*sssgrad*rrmij
2647 * Radial derivatives. First process both termini of the fragment (i,j)
2651 C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j)
2653 C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j)
2655 C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j)
2657 c ghalf=0.5D0*ggg(k)
2658 c gelc(k,i)=gelc(k,i)+ghalf
2659 c gelc(k,j)=gelc(k,j)+ghalf
2661 c 9/28/08 AL Gradient compotents will be summed only at the end
2663 gelc_long(k,j)=gelc(k,j)+ggg(k)
2664 gelc_long(k,i)=gelc(k,i)-ggg(k)
2667 * Loop over residues i+1 thru j-1.
2671 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2674 c 9/28/08 AL Gradient compotents will be summed only at the end
2675 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2676 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2677 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2679 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2680 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2682 gvdwpp(3,j)=gvdwpp(3,j)+
2683 & sss*ssgradlipj*evdwij/2.0d0*lipscale**2
2684 gvdwpp(3,i)=gvdwpp(3,i)+
2685 & sss*ssgradlipi*evdwij/2.0d0*lipscale**2
2692 ecosa=2.0D0*fac3*fac1+fac4
2695 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2696 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2698 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2699 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2701 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2702 cd & (dcosg(k),k=1,3)
2704 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
2705 & fac_shield(i)**2*fac_shield(j)**2*sss*faclipij2
2708 c ghalf=0.5D0*ggg(k)
2709 c gelc(k,i)=gelc(k,i)+ghalf
2710 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2711 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2712 c gelc(k,j)=gelc(k,j)+ghalf
2713 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2714 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2718 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2721 C print *,"before22", gelc_long(1,i), gelc_long(1,j)
2724 & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2725 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
2726 & *fac_shield(i)**2*fac_shield(j)**2*faclipij2
2728 & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2729 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
2730 & *fac_shield(i)**2*fac_shield(j)**2*faclipij2
2731 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2732 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2734 C print *,"before33", gelc_long(1,i), gelc_long(1,j)
2739 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2740 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2741 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2743 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2744 C energy of a peptide unit is assumed in the form of a second-order
2745 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2746 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2747 C are computed for EVERY pair of non-contiguous peptide groups.
2750 if (j.lt.nres-1) then
2762 muij(kkk)=mu(k,i)*mu(l,j)
2763 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
2766 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
2767 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
2768 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
2769 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
2770 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
2771 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
2777 write (iout,*) 'EELEC: i',i,' j',j
2778 write (iout,*) 'j',j,' j1',j1,' j2',j2
2779 write(iout,*) 'muij',muij
2780 write (iout,*) "uy",uy(:,i)
2781 write (iout,*) "uz",uz(:,j)
2782 write (iout,*) "erij",erij
2784 ury=scalar(uy(1,i),erij)
2785 urz=scalar(uz(1,i),erij)
2786 vry=scalar(uy(1,j),erij)
2787 vrz=scalar(uz(1,j),erij)
2788 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2789 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2790 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2791 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2792 fac=dsqrt(-ael6i)*r3ij
2797 cd write (iout,'(4i5,4f10.5)')
2798 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2799 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2800 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
2801 cd & uy(:,j),uz(:,j)
2802 cd write (iout,'(4f10.5)')
2803 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2804 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2805 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2806 cd write (iout,'(9f10.5/)')
2807 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2808 C Derivatives of the elements of A in virtual-bond vectors
2810 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2812 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2813 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2814 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2815 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2816 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2817 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2818 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2819 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2820 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2821 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2822 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2823 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2825 C Compute radial contributions to the gradient
2843 C Add the contributions coming from er
2846 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2847 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2848 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2849 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2852 C Derivatives in DC(i)
2853 cgrad ghalf1=0.5d0*agg(k,1)
2854 cgrad ghalf2=0.5d0*agg(k,2)
2855 cgrad ghalf3=0.5d0*agg(k,3)
2856 cgrad ghalf4=0.5d0*agg(k,4)
2857 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2858 & -3.0d0*uryg(k,2)*vry)!+ghalf1
2859 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2860 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
2861 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2862 & -3.0d0*urzg(k,2)*vry)!+ghalf3
2863 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2864 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
2865 C Derivatives in DC(i+1)
2866 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2867 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
2868 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2869 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
2870 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2871 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
2872 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2873 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
2874 C Derivatives in DC(j)
2875 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2876 & -3.0d0*vryg(k,2)*ury)!+ghalf1
2877 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2878 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
2879 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2880 & -3.0d0*vryg(k,2)*urz)!+ghalf3
2881 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2882 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
2883 C Derivatives in DC(j+1) or DC(nres-1)
2884 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2885 & -3.0d0*vryg(k,3)*ury)
2886 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2887 & -3.0d0*vrzg(k,3)*ury)
2888 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2889 & -3.0d0*vryg(k,3)*urz)
2890 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2891 & -3.0d0*vrzg(k,3)*urz)
2892 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
2894 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
2909 aggi(k,l)=-aggi(k,l)
2910 aggi1(k,l)=-aggi1(k,l)
2911 aggj(k,l)=-aggj(k,l)
2912 aggj1(k,l)=-aggj1(k,l)
2916 if (j.lt.nres-1) then
2922 aggi(k,l)=-aggi(k,l)
2923 aggi1(k,l)=-aggi1(k,l)
2924 aggj(k,l)=-aggj(k,l)
2925 aggj1(k,l)=-aggj1(k,l)
2936 aggi(k,l)=-aggi(k,l)
2937 aggi1(k,l)=-aggi1(k,l)
2938 aggj(k,l)=-aggj(k,l)
2939 aggj1(k,l)=-aggj1(k,l)
2944 IF (wel_loc.gt.0.0d0) THEN
2945 C Contribution to the local-electrostatic energy coming from the i-j pair
2946 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2949 write (iout,*) "muij",muij," a22",a22," a23",a23," a32",a32,
2951 write (iout,*) "ij",i,j," eel_loc_ij",eel_loc_ij,
2952 & " wel_loc",wel_loc
2954 if (shield_mode.eq.0) then
2961 eel_loc_ij=eel_loc_ij
2962 & *fac_shield(i)*fac_shield(j)*sss*faclipij
2963 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
2964 & 'eelloc',i,j,eel_loc_ij
2965 c if (eel_loc_ij.ne.0)
2966 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
2967 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
2969 eel_loc=eel_loc+eel_loc_ij
2970 C Now derivative over eel_loc
2972 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2973 & (shield_mode.gt.0)) then
2976 do ilist=1,ishield_list(i)
2977 iresshield=shield_list(ilist,i)
2979 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
2982 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2984 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
2985 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2989 do ilist=1,ishield_list(j)
2990 iresshield=shield_list(ilist,j)
2992 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
2995 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2997 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
2998 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
3005 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
3006 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
3007 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
3008 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
3009 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
3010 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
3011 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
3012 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
3017 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
3018 c & ' eel_loc_ij',eel_loc_ij
3019 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
3020 C Calculate patrial derivative for theta angle
3022 geel_loc_ij=(a22*gmuij1(1)
3026 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3027 c write(iout,*) "derivative over thatai"
3028 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
3030 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
3031 & geel_loc_ij*wel_loc
3032 c write(iout,*) "derivative over thatai-1"
3033 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
3040 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3041 & geel_loc_ij*wel_loc
3042 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3044 c Derivative over j residue
3045 geel_loc_ji=a22*gmuji1(1)
3049 c write(iout,*) "derivative over thataj"
3050 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
3053 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
3054 & geel_loc_ji*wel_loc
3055 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3062 c write(iout,*) "derivative over thataj-1"
3063 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
3065 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
3066 & geel_loc_ji*wel_loc
3067 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3069 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3071 C Partial derivatives in virtual-bond dihedral angles gamma
3073 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3074 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3075 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
3076 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3078 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3079 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3080 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
3081 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3082 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3083 aux=eel_loc_ij/sss*sssgrad*rmij
3088 ggg(l)=ggg(l)+(agg(l,1)*muij(1)+
3089 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
3090 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3091 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3092 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3093 cgrad ghalf=0.5d0*ggg(l)
3094 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3095 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3097 gel_loc_long(3,j)=gel_loc_long(3,j)+
3098 & ssgradlipj*eel_loc_ij/2.0d0*lipscale/faclipij
3100 gel_loc_long(3,i)=gel_loc_long(3,i)+
3101 & ssgradlipi*eel_loc_ij/2.0d0*lipscale/faclipij
3104 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3107 C Remaining derivatives of eello
3109 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
3110 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
3111 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3113 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
3114 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
3115 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3117 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
3118 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
3119 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3121 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
3122 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
3123 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3130 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3131 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3133 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3134 & .and. num_conti.le.maxconts) then
3135 c write (iout,*) i,j," entered corr"
3137 C Calculate the contact function. The ith column of the array JCONT will
3138 C contain the numbers of atoms that make contacts with the atom I (of numbers
3139 C greater than I). The arrays FACONT and GACONT will contain the values of
3140 C the contact function and its derivative.
3141 c r0ij=1.02D0*rpp(iteli,itelj)
3142 c r0ij=1.11D0*rpp(iteli,itelj)
3143 r0ij=2.20D0*rpp(iteli,itelj)
3144 c r0ij=1.55D0*rpp(iteli,itelj)
3145 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3146 if (fcont.gt.0.0D0) then
3147 num_conti=num_conti+1
3148 if (num_conti.gt.maxconts) then
3149 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3150 & ' will skip next contacts for this conf.'
3152 jcont_hb(num_conti,i)=j
3153 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3154 cd & " jcont_hb",jcont_hb(num_conti,i)
3155 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3156 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3157 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3159 d_cont(num_conti,i)=rij
3160 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3161 C --- Electrostatic-interaction matrix ---
3162 a_chuj(1,1,num_conti,i)=a22
3163 a_chuj(1,2,num_conti,i)=a23
3164 a_chuj(2,1,num_conti,i)=a32
3165 a_chuj(2,2,num_conti,i)=a33
3166 C --- Gradient of rij
3169 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3176 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3177 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3178 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3179 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3180 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3186 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3187 C Calculate contact energies
3189 wij=cosa-3.0D0*cosb*cosg
3192 c fac3=dsqrt(-ael6i)/r0ij**3
3193 fac3=dsqrt(-ael6i)*r3ij
3194 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3195 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3196 if (ees0tmp.gt.0) then
3197 ees0pij=dsqrt(ees0tmp)
3201 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3202 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3203 if (ees0tmp.gt.0) then
3204 ees0mij=dsqrt(ees0tmp)
3209 if (shield_mode.eq.0) then
3213 ees0plist(num_conti,i)=j
3214 C fac_shield(i)=0.4d0
3215 C fac_shield(j)=0.6d0
3217 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3218 & *fac_shield(i)*fac_shield(j)
3219 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3220 & *fac_shield(i)*fac_shield(j)
3221 C Diagnostics. Comment out or remove after debugging!
3222 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3223 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3224 c ees0m(num_conti,i)=0.0D0
3226 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3227 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3228 C Angular derivatives of the contact function
3230 ees0pij1=fac3/ees0pij
3231 ees0mij1=fac3/ees0mij
3232 fac3p=-3.0D0*fac3*rrmij
3233 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3234 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3236 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3237 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3238 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3239 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3240 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3241 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3242 ecosap=ecosa1+ecosa2
3243 ecosbp=ecosb1+ecosb2
3244 ecosgp=ecosg1+ecosg2
3245 ecosam=ecosa1-ecosa2
3246 ecosbm=ecosb1-ecosb2
3247 ecosgm=ecosg1-ecosg2
3256 facont_hb(num_conti,i)=fcont
3259 fprimcont=fprimcont/rij
3260 cd facont_hb(num_conti,i)=1.0D0
3261 C Following line is for diagnostics.
3264 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3265 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3268 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3269 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3271 gggp(1)=gggp(1)+ees0pijp*xj
3272 & +ees0p(num_conti,i)/sss*rmij*xj*sssgrad
3273 gggp(2)=gggp(2)+ees0pijp*yj
3274 & +ees0p(num_conti,i)/sss*rmij*yj*sssgrad
3275 gggp(3)=gggp(3)+ees0pijp*zj
3276 & +ees0p(num_conti,i)/sss*rmij*zj*sssgrad
3277 gggm(1)=gggm(1)+ees0mijp*xj
3278 & +ees0m(num_conti,i)/sss*rmij*xj*sssgrad
3279 gggm(2)=gggm(2)+ees0mijp*yj
3280 & +ees0m(num_conti,i)/sss*rmij*yj*sssgrad
3281 gggm(3)=gggm(3)+ees0mijp*zj
3282 & +ees0m(num_conti,i)/sss*rmij*zj*sssgrad
3283 C Derivatives due to the contact function
3284 gacont_hbr(1,num_conti,i)=fprimcont*xj
3285 gacont_hbr(2,num_conti,i)=fprimcont*yj
3286 gacont_hbr(3,num_conti,i)=fprimcont*zj
3289 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3290 c following the change of gradient-summation algorithm.
3292 cgrad ghalfp=0.5D0*gggp(k)
3293 cgrad ghalfm=0.5D0*gggm(k)
3294 gacontp_hb1(k,num_conti,i)=!ghalfp
3295 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3296 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3297 & *fac_shield(i)*fac_shield(j)*sss
3299 gacontp_hb2(k,num_conti,i)=!ghalfp
3300 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3301 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3302 & *fac_shield(i)*fac_shield(j)*sss
3304 gacontp_hb3(k,num_conti,i)=gggp(k)
3305 & *fac_shield(i)*fac_shield(j)*sss
3307 gacontm_hb1(k,num_conti,i)=!ghalfm
3308 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3309 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3310 & *fac_shield(i)*fac_shield(j)*sss
3312 gacontm_hb2(k,num_conti,i)=!ghalfm
3313 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3314 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3315 & *fac_shield(i)*fac_shield(j)*sss
3317 gacontm_hb3(k,num_conti,i)=gggm(k)
3318 & *fac_shield(i)*fac_shield(j)*sss
3321 C Diagnostics. Comment out or remove after debugging!
3323 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3324 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3325 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3326 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3327 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3328 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3334 endif ! num_conti.le.maxconts
3339 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3342 ghalf=0.5d0*agg(l,k)
3343 aggi(l,k)=aggi(l,k)+ghalf
3344 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3345 aggj(l,k)=aggj(l,k)+ghalf
3348 if (j.eq.nres-1 .and. i.lt.j-2) then
3351 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3357 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3360 C-----------------------------------------------------------------------------
3361 subroutine eturn3(i,eello_turn3)
3362 C Third- and fourth-order contributions from turns
3363 implicit real*8 (a-h,o-z)
3364 include 'DIMENSIONS'
3365 include 'DIMENSIONS.ZSCOPT'
3366 include 'COMMON.IOUNITS'
3367 include 'COMMON.GEO'
3368 include 'COMMON.VAR'
3369 include 'COMMON.LOCAL'
3370 include 'COMMON.CHAIN'
3371 include 'COMMON.DERIV'
3372 include 'COMMON.INTERACT'
3373 include 'COMMON.CONTACTS'
3374 include 'COMMON.TORSION'
3375 include 'COMMON.VECTORS'
3376 include 'COMMON.FFIELD'
3377 include 'COMMON.CONTROL'
3378 include 'COMMON.SHIELD'
3379 include 'COMMON.CORRMAT'
3381 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3382 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3383 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
3384 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
3385 & auxgmat2(2,2),auxgmatt2(2,2)
3386 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3387 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3388 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3389 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3391 double precision sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij
3392 common /lipcalc/ sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij
3394 c write (iout,*) "eturn3",i,j,j1,j2
3399 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3401 C Third-order contributions
3408 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3409 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3410 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3411 c auxalary matices for theta gradient
3412 c auxalary matrix for i+1 and constant i+2
3413 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
3414 c auxalary matrix for i+2 and constant i+1
3415 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
3416 call transpose2(auxmat(1,1),auxmat1(1,1))
3417 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
3418 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
3419 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3420 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
3421 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
3422 if (shield_mode.eq.0) then
3429 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3430 & *fac_shield(i)*fac_shield(j)*faclipij
3431 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
3432 & *fac_shield(i)*fac_shield(j)
3433 if (energy_dec) write (iout,'(6heturn3,2i5,0pf7.3)') i,i+2,
3437 C Derivatives in theta
3438 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3439 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
3440 & *fac_shield(i)*fac_shield(j)*faclipij
3441 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
3442 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
3443 & *fac_shield(i)*fac_shield(j)*faclipij
3446 C Derivatives in shield mode
3447 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3448 & (shield_mode.gt.0)) then
3451 do ilist=1,ishield_list(i)
3452 iresshield=shield_list(ilist,i)
3454 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
3456 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3458 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
3459 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3463 do ilist=1,ishield_list(j)
3464 iresshield=shield_list(ilist,j)
3466 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
3468 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3470 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
3471 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3478 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
3479 & grad_shield(k,i)*eello_t3/fac_shield(i)
3480 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
3481 & grad_shield(k,j)*eello_t3/fac_shield(j)
3482 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
3483 & grad_shield(k,i)*eello_t3/fac_shield(i)
3484 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
3485 & grad_shield(k,j)*eello_t3/fac_shield(j)
3489 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3490 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3491 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3492 cd & ' eello_turn3_num',4*eello_turn3_num
3493 C Derivatives in gamma(i)
3494 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3495 call transpose2(auxmat2(1,1),auxmat3(1,1))
3496 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3497 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3498 & *fac_shield(i)*fac_shield(j)*faclipij
3499 C Derivatives in gamma(i+1)
3500 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3501 call transpose2(auxmat2(1,1),auxmat3(1,1))
3502 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3503 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3504 & +0.5d0*(pizda(1,1)+pizda(2,2))
3505 & *fac_shield(i)*fac_shield(j)*faclipij
3506 C Cartesian derivatives
3508 c ghalf1=0.5d0*agg(l,1)
3509 c ghalf2=0.5d0*agg(l,2)
3510 c ghalf3=0.5d0*agg(l,3)
3511 c ghalf4=0.5d0*agg(l,4)
3512 a_temp(1,1)=aggi(l,1)!+ghalf1
3513 a_temp(1,2)=aggi(l,2)!+ghalf2
3514 a_temp(2,1)=aggi(l,3)!+ghalf3
3515 a_temp(2,2)=aggi(l,4)!+ghalf4
3516 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3517 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3518 & +0.5d0*(pizda(1,1)+pizda(2,2))
3519 & *fac_shield(i)*fac_shield(j)*faclipij
3521 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3522 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3523 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3524 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3525 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3526 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3527 & +0.5d0*(pizda(1,1)+pizda(2,2))
3528 & *fac_shield(i)*fac_shield(j)*faclipij
3529 a_temp(1,1)=aggj(l,1)!+ghalf1
3530 a_temp(1,2)=aggj(l,2)!+ghalf2
3531 a_temp(2,1)=aggj(l,3)!+ghalf3
3532 a_temp(2,2)=aggj(l,4)!+ghalf4
3533 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3534 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3535 & +0.5d0*(pizda(1,1)+pizda(2,2))
3536 & *fac_shield(i)*fac_shield(j)*faclipij
3537 a_temp(1,1)=aggj1(l,1)
3538 a_temp(1,2)=aggj1(l,2)
3539 a_temp(2,1)=aggj1(l,3)
3540 a_temp(2,2)=aggj1(l,4)
3541 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3542 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3543 & +0.5d0*(pizda(1,1)+pizda(2,2))
3544 & *fac_shield(i)*fac_shield(j)*faclipij
3551 C-------------------------------------------------------------------------------
3552 subroutine eturn4(i,eello_turn4)
3553 C Third- and fourth-order contributions from turns
3554 implicit real*8 (a-h,o-z)
3555 include 'DIMENSIONS'
3556 include 'DIMENSIONS.ZSCOPT'
3557 include 'COMMON.IOUNITS'
3558 include 'COMMON.GEO'
3559 include 'COMMON.VAR'
3560 include 'COMMON.LOCAL'
3561 include 'COMMON.CHAIN'
3562 include 'COMMON.DERIV'
3563 include 'COMMON.INTERACT'
3564 include 'COMMON.CONTACTS'
3565 include 'COMMON.TORSION'
3566 include 'COMMON.VECTORS'
3567 include 'COMMON.FFIELD'
3568 include 'COMMON.CONTROL'
3569 include 'COMMON.SHIELD'
3570 include 'COMMON.CORRMAT'
3572 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3573 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3574 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
3575 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
3576 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
3577 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
3578 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
3579 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3580 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3581 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3582 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3585 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3587 C Fourth-order contributions
3595 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3596 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3597 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3598 c write(iout,*)"WCHODZE W PROGRAM"
3603 iti1=itype2loc(itype(i+1))
3604 iti2=itype2loc(itype(i+2))
3605 iti3=itype2loc(itype(i+3))
3606 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3607 call transpose2(EUg(1,1,i+1),e1t(1,1))
3608 call transpose2(Eug(1,1,i+2),e2t(1,1))
3609 call transpose2(Eug(1,1,i+3),e3t(1,1))
3610 C Ematrix derivative in theta
3611 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
3612 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
3613 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
3614 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3615 c eta1 in derivative theta
3616 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
3617 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3618 c auxgvec is derivative of Ub2 so i+3 theta
3619 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
3620 c auxalary matrix of E i+1
3621 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
3624 s1=scalar2(b1(1,i+2),auxvec(1))
3625 c derivative of theta i+2 with constant i+3
3626 gs23=scalar2(gtb1(1,i+2),auxvec(1))
3627 c derivative of theta i+2 with constant i+2
3628 gs32=scalar2(b1(1,i+2),auxgvec(1))
3629 c derivative of E matix in theta of i+1
3630 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
3632 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3633 c ea31 in derivative theta
3634 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
3635 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3636 c auxilary matrix auxgvec of Ub2 with constant E matirx
3637 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
3638 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
3639 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
3643 s2=scalar2(b1(1,i+1),auxvec(1))
3644 c derivative of theta i+1 with constant i+3
3645 gs13=scalar2(gtb1(1,i+1),auxvec(1))
3646 c derivative of theta i+2 with constant i+1
3647 gs21=scalar2(b1(1,i+1),auxgvec(1))
3648 c derivative of theta i+3 with constant i+1
3649 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
3650 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
3652 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3653 c two derivatives over diffetent matrices
3654 c gtae3e2 is derivative over i+3
3655 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
3656 c ae3gte2 is derivative over i+2
3657 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
3658 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3659 c three possible derivative over theta E matices
3661 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
3663 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
3665 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
3666 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3668 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
3669 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
3670 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
3671 if (shield_mode.eq.0) then
3678 eello_turn4=eello_turn4-(s1+s2+s3)
3679 & *fac_shield(i)*fac_shield(j)*faclipij
3680 eello_t4=-(s1+s2+s3)
3681 & *fac_shield(i)*fac_shield(j)
3682 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
3683 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
3684 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
3685 C Now derivative over shield:
3686 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3687 & (shield_mode.gt.0)) then
3690 do ilist=1,ishield_list(i)
3691 iresshield=shield_list(ilist,i)
3693 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
3695 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3697 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
3698 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3702 do ilist=1,ishield_list(j)
3703 iresshield=shield_list(ilist,j)
3705 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
3707 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3709 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
3710 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3717 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
3718 & grad_shield(k,i)*eello_t4/fac_shield(i)
3719 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
3720 & grad_shield(k,j)*eello_t4/fac_shield(j)
3721 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
3722 & grad_shield(k,i)*eello_t4/fac_shield(i)
3723 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
3724 & grad_shield(k,j)*eello_t4/fac_shield(j)
3727 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3728 cd & ' eello_turn4_num',8*eello_turn4_num
3730 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3731 & -(gs13+gsE13+gsEE1)*wturn4
3732 & *fac_shield(i)*fac_shield(j)
3733 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
3734 & -(gs23+gs21+gsEE2)*wturn4
3735 & *fac_shield(i)*fac_shield(j)
3737 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
3738 & -(gs32+gsE31+gsEE3)*wturn4
3739 & *fac_shield(i)*fac_shield(j)
3741 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
3744 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3745 & 'eturn4',i,j,-(s1+s2+s3)
3746 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3747 c & ' eello_turn4_num',8*eello_turn4_num
3748 C Derivatives in gamma(i)
3749 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3750 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3751 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3752 s1=scalar2(b1(1,i+2),auxvec(1))
3753 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3754 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3755 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3756 & *fac_shield(i)*fac_shield(j)*faclipij
3757 C Derivatives in gamma(i+1)
3758 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3759 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3760 s2=scalar2(b1(1,i+1),auxvec(1))
3761 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3762 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3763 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3764 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3765 & *fac_shield(i)*fac_shield(j)*faclipij
3766 C Derivatives in gamma(i+2)
3767 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3768 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3769 s1=scalar2(b1(1,i+2),auxvec(1))
3770 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3771 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3772 s2=scalar2(b1(1,i+1),auxvec(1))
3773 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3774 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3775 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3776 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3777 & *fac_shield(i)*fac_shield(j)*faclipij
3779 C Cartesian derivatives
3780 C Derivatives of this turn contributions in DC(i+2)
3781 if (j.lt.nres-1) then
3783 a_temp(1,1)=agg(l,1)
3784 a_temp(1,2)=agg(l,2)
3785 a_temp(2,1)=agg(l,3)
3786 a_temp(2,2)=agg(l,4)
3787 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3788 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3789 s1=scalar2(b1(1,i+2),auxvec(1))
3790 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3791 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3792 s2=scalar2(b1(1,i+1),auxvec(1))
3793 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3794 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3795 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3797 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3798 & *fac_shield(i)*fac_shield(j)*faclipij
3801 C Remaining derivatives of this turn contribution
3803 a_temp(1,1)=aggi(l,1)
3804 a_temp(1,2)=aggi(l,2)
3805 a_temp(2,1)=aggi(l,3)
3806 a_temp(2,2)=aggi(l,4)
3807 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3808 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3809 s1=scalar2(b1(1,i+2),auxvec(1))
3810 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3811 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3812 s2=scalar2(b1(1,i+1),auxvec(1))
3813 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3814 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3815 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3816 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3817 & *fac_shield(i)*fac_shield(j)*faclipij
3818 a_temp(1,1)=aggi1(l,1)
3819 a_temp(1,2)=aggi1(l,2)
3820 a_temp(2,1)=aggi1(l,3)
3821 a_temp(2,2)=aggi1(l,4)
3822 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3823 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3824 s1=scalar2(b1(1,i+2),auxvec(1))
3825 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3826 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3827 s2=scalar2(b1(1,i+1),auxvec(1))
3828 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3829 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3830 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3831 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3832 & *fac_shield(i)*fac_shield(j)*faclipij
3833 a_temp(1,1)=aggj(l,1)
3834 a_temp(1,2)=aggj(l,2)
3835 a_temp(2,1)=aggj(l,3)
3836 a_temp(2,2)=aggj(l,4)
3837 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3838 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3839 s1=scalar2(b1(1,i+2),auxvec(1))
3840 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3841 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3842 s2=scalar2(b1(1,i+1),auxvec(1))
3843 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3844 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3845 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3846 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3847 & *fac_shield(i)*fac_shield(j)*faclipij
3848 a_temp(1,1)=aggj1(l,1)
3849 a_temp(1,2)=aggj1(l,2)
3850 a_temp(2,1)=aggj1(l,3)
3851 a_temp(2,2)=aggj1(l,4)
3852 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3853 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3854 s1=scalar2(b1(1,i+2),auxvec(1))
3855 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3856 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3857 s2=scalar2(b1(1,i+1),auxvec(1))
3858 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3859 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3860 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3861 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3862 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3863 & *fac_shield(i)*fac_shield(j)*faclipij
3870 C-----------------------------------------------------------------------------
3871 subroutine vecpr(u,v,w)
3872 implicit real*8(a-h,o-z)
3873 dimension u(3),v(3),w(3)
3874 w(1)=u(2)*v(3)-u(3)*v(2)
3875 w(2)=-u(1)*v(3)+u(3)*v(1)
3876 w(3)=u(1)*v(2)-u(2)*v(1)
3879 C-----------------------------------------------------------------------------
3880 subroutine unormderiv(u,ugrad,unorm,ungrad)
3881 C This subroutine computes the derivatives of a normalized vector u, given
3882 C the derivatives computed without normalization conditions, ugrad. Returns
3885 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3886 double precision vec(3)
3887 double precision scalar
3889 c write (2,*) 'ugrad',ugrad
3892 vec(i)=scalar(ugrad(1,i),u(1))
3894 c write (2,*) 'vec',vec
3897 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3900 c write (2,*) 'ungrad',ungrad
3903 C-----------------------------------------------------------------------------
3904 subroutine escp(evdw2,evdw2_14)
3906 C This subroutine calculates the excluded-volume interaction energy between
3907 C peptide-group centers and side chains and its gradient in virtual-bond and
3908 C side-chain vectors.
3910 implicit real*8 (a-h,o-z)
3911 include 'DIMENSIONS'
3912 include 'DIMENSIONS.ZSCOPT'
3913 include 'COMMON.CONTROL'
3914 include 'COMMON.GEO'
3915 include 'COMMON.VAR'
3916 include 'COMMON.LOCAL'
3917 include 'COMMON.CHAIN'
3918 include 'COMMON.DERIV'
3919 include 'COMMON.INTERACT'
3920 include 'COMMON.FFIELD'
3921 include 'COMMON.IOUNITS'
3925 cd print '(a)','Enter ESCP'
3926 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
3927 c & ' scal14',scal14
3928 do i=iatscp_s,iatscp_e
3929 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3931 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
3932 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
3933 if (iteli.eq.0) goto 1225
3934 xi=0.5D0*(c(1,i)+c(1,i+1))
3935 yi=0.5D0*(c(2,i)+c(2,i+1))
3936 zi=0.5D0*(c(3,i)+c(3,i+1))
3937 call to_box(xi,yi,zi)
3938 do iint=1,nscp_gr(i)
3940 do j=iscpstart(i,iint),iscpend(i,iint)
3941 itypj=iabs(itype(j))
3942 if (itypj.eq.ntyp1) cycle
3943 C Uncomment following three lines for SC-p interactions
3947 C Uncomment following three lines for Ca-p interactions
3951 C returning the jth atom to box
3952 call to_box(xj,yj,zj)
3953 xj=boxshift(xj-xi,boxxsize)
3954 yj=boxshift(yj-yi,boxysize)
3955 zj=boxshift(zj-zi,boxzsize)
3956 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3957 C sss is scaling function for smoothing the cutoff gradient otherwise
3958 C the gradient would not be continuouse
3959 sss=sscale(1.0d0/(dsqrt(rrij)))
3960 if (sss.le.0.0d0) cycle
3961 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3963 e1=fac*fac*aad(itypj,iteli)
3964 e2=fac*bad(itypj,iteli)
3965 if (iabs(j-i) .le. 2) then
3968 evdw2_14=evdw2_14+(e1+e2)*sss
3971 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3972 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
3973 c & bad(itypj,iteli)
3974 evdw2=evdw2+evdwij*sss
3975 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3976 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
3981 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3983 fac=-(evdwij+e1)*rrij*sss
3984 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
3989 cd write (iout,*) 'j<i'
3990 C Uncomment following three lines for SC-p interactions
3992 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3995 cd write (iout,*) 'j>i'
3998 C Uncomment following line for SC-p interactions
3999 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4003 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4007 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4008 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4011 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4021 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4022 gradx_scp(j,i)=expon*gradx_scp(j,i)
4025 C******************************************************************************
4029 C To save time the factor EXPON has been extracted from ALL components
4030 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4033 C******************************************************************************
4036 C--------------------------------------------------------------------------
4037 subroutine edis(ehpb)
4039 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4041 implicit real*8 (a-h,o-z)
4042 include 'DIMENSIONS'
4043 include 'DIMENSIONS.ZSCOPT'
4044 include 'COMMON.SBRIDGE'
4045 include 'COMMON.CHAIN'
4046 include 'COMMON.DERIV'
4047 include 'COMMON.VAR'
4048 include 'COMMON.INTERACT'
4049 include 'COMMON.CONTROL'
4050 include 'COMMON.IOUNITS'
4051 dimension ggg(3),ggg_peak(3,1000)
4056 c 8/21/18 AL: added explicit restraints on reference coords
4057 c write (iout,*) "restr_on_coord",restr_on_coord
4058 if (restr_on_coord) then
4062 if (itype(i).eq.ntyp1) cycle
4064 ecoor=ecoor+(c(j,i)-cref(j,i))**2
4065 ghpbc(j,i)=ghpbc(j,i)+bfac(i)*(c(j,i)-cref(j,i))
4067 if (itype(i).ne.10) then
4069 ecoor=ecoor+(c(j,i+nres)-cref(j,i+nres))**2
4070 ghpbx(j,i)=ghpbx(j,i)+bfac(i)*(c(j,i+nres)-cref(j,i+nres))
4073 if (energy_dec) write (iout,*)
4074 & "i",i," bfac",bfac(i)," ecoor",ecoor
4075 ehpb=ehpb+0.5d0*bfac(i)*ecoor
4080 C write (iout,*) ,"link_end",link_end,constr_dist
4081 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4082 c write(iout,*)'link_start=',link_start,' link_end=',link_end,
4083 c & " constr_dist",constr_dist
4084 if (link_end.eq.0.and.link_end_peak.eq.0) return
4085 do i=link_start_peak,link_end_peak
4087 c print *,"i",i," link_end_peak",link_end_peak," ipeak",
4088 c & ipeak(1,i),ipeak(2,i)
4089 do ip=ipeak(1,i),ipeak(2,i)
4094 C iii and jjj point to the residues for which the distance is assigned.
4095 c if (ii.gt.nres) then
4102 if (ii.gt.nres) then
4107 if (jj.gt.nres) then
4112 aux=rlornmr1(dd,dhpb_peak(ip),dhpb1_peak(ip),forcon_peak(ip))
4113 aux=dexp(-scal_peak*aux)
4114 ehpb_peak=ehpb_peak+aux
4115 fac=rlornmr1prim(dd,dhpb_peak(ip),dhpb1_peak(ip),
4116 & forcon_peak(ip))*aux/dd
4118 ggg_peak(j,iip)=fac*(c(j,jj)-c(j,ii))
4120 if (energy_dec) write (iout,'(a6,3i5,6f10.3,i5)')
4121 & "edisL",i,ii,jj,dd,dhpb_peak(ip),dhpb1_peak(ip),
4122 & forcon_peak(ip),fordepth_peak(ip),ehpb_peak
4124 c write (iout,*) "ehpb_peak",ehpb_peak," scal_peak",scal_peak
4125 ehpb=ehpb-fordepth_peak(ipeak(1,i))*dlog(ehpb_peak)/scal_peak
4126 do ip=ipeak(1,i),ipeak(2,i)
4129 ggg(j)=ggg_peak(j,iip)/ehpb_peak
4133 C iii and jjj point to the residues for which the distance is assigned.
4134 if (ii.gt.nres) then
4143 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4148 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4152 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4153 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4157 do i=link_start,link_end
4158 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4159 C CA-CA distance used in regularization of structure.
4162 C iii and jjj point to the residues for which the distance is assigned.
4163 if (ii.gt.nres) then
4168 if (jj.gt.nres) then
4173 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4174 c & dhpb(i),dhpb1(i),forcon(i)
4175 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4176 C distance and angle dependent SS bond potential.
4177 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4178 C & iabs(itype(jjj)).eq.1) then
4179 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4180 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4181 if (.not.dyn_ss .and. i.le.nss) then
4182 C 15/02/13 CC dynamic SSbond - additional check
4183 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4184 & iabs(itype(jjj)).eq.1) then
4185 call ssbond_ene(iii,jjj,eij)
4188 cd write (iout,*) "eij",eij
4189 cd & ' waga=',waga,' fac=',fac
4190 ! else if (ii.gt.nres .and. jj.gt.nres) then
4192 C Calculate the distance between the two points and its difference from the
4195 if (irestr_type(i).eq.11) then
4196 ehpb=ehpb+fordepth(i)!**4.0d0
4197 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4198 fac=fordepth(i)!**4.0d0
4199 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4200 if (energy_dec) write (iout,'(a6,2i5,6f10.3,i5)')
4201 & "edisL",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
4202 & ehpb,irestr_type(i)
4203 else if (irestr_type(i).eq.10) then
4204 c AL 6//19/2018 cross-link restraints
4205 xdis = 0.5d0*(dd/forcon(i))**2
4206 expdis = dexp(-xdis)
4207 c aux=(dhpb(i)+dhpb1(i)*xdis)*expdis+fordepth(i)
4208 aux=(dhpb(i)+dhpb1(i)*xdis*xdis)*expdis+fordepth(i)
4209 c write (iout,*)"HERE: xdis",xdis," expdis",expdis," aux",aux,
4210 c & " wboltzd",wboltzd
4211 ehpb=ehpb-wboltzd*xlscore(i)*dlog(aux)
4212 c fac=-wboltzd*(dhpb1(i)*(1.0d0-xdis)-dhpb(i))
4213 fac=-wboltzd*xlscore(i)*(dhpb1(i)*(2.0d0-xdis)*xdis-dhpb(i))
4214 & *expdis/(aux*forcon(i)**2)
4215 if (energy_dec) write(iout,'(a6,2i5,6f10.3,i5)')
4216 & "edisX",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
4217 & -wboltzd*xlscore(i)*dlog(aux),irestr_type(i)
4218 else if (irestr_type(i).eq.2) then
4219 c Quartic restraints
4220 ehpb=ehpb+forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4221 if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
4222 & "edisQ",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
4223 & forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)),irestr_type(i)
4224 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4226 c Quadratic restraints
4228 C Get the force constant corresponding to this distance.
4230 C Calculate the contribution to energy.
4231 ehpb=ehpb+0.5d0*waga*rdis*rdis
4232 if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
4233 & "edisS",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
4234 & 0.5d0*waga*rdis*rdis,irestr_type(i)
4236 C Evaluate gradient.
4240 c Calculate Cartesian gradient
4242 ggg(j)=fac*(c(j,jj)-c(j,ii))
4244 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4245 C If this is a SC-SC distance, we need to calculate the contributions to the
4246 C Cartesian gradient in the SC vectors (ghpbx).
4249 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4254 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4258 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4259 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4265 C--------------------------------------------------------------------------
4266 subroutine ssbond_ene(i,j,eij)
4268 C Calculate the distance and angle dependent SS-bond potential energy
4269 C using a free-energy function derived based on RHF/6-31G** ab initio
4270 C calculations of diethyl disulfide.
4272 C A. Liwo and U. Kozlowska, 11/24/03
4274 implicit real*8 (a-h,o-z)
4275 include 'DIMENSIONS'
4276 include 'DIMENSIONS.ZSCOPT'
4277 include 'COMMON.SBRIDGE'
4278 include 'COMMON.CHAIN'
4279 include 'COMMON.DERIV'
4280 include 'COMMON.LOCAL'
4281 include 'COMMON.INTERACT'
4282 include 'COMMON.VAR'
4283 include 'COMMON.IOUNITS'
4284 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4285 itypi=iabs(itype(i))
4289 dxi=dc_norm(1,nres+i)
4290 dyi=dc_norm(2,nres+i)
4291 dzi=dc_norm(3,nres+i)
4292 dsci_inv=dsc_inv(itypi)
4293 itypj=iabs(itype(j))
4294 dscj_inv=dsc_inv(itypj)
4298 dxj=dc_norm(1,nres+j)
4299 dyj=dc_norm(2,nres+j)
4300 dzj=dc_norm(3,nres+j)
4301 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4306 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4307 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4308 om12=dxi*dxj+dyi*dyj+dzi*dzj
4310 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4311 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4317 deltat12=om2-om1+2.0d0
4319 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4320 & +akct*deltad*deltat12
4321 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4322 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4323 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4324 c & " deltat12",deltat12," eij",eij
4325 ed=2*akcm*deltad+akct*deltat12
4327 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4328 eom1=-2*akth*deltat1-pom1-om2*pom2
4329 eom2= 2*akth*deltat2+pom1-om1*pom2
4332 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4335 ghpbx(k,i)=ghpbx(k,i)-gg(k)
4336 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
4337 ghpbx(k,j)=ghpbx(k,j)+gg(k)
4338 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
4341 C Calculate the components of the gradient in DC and X
4345 ghpbc(l,k)=ghpbc(l,k)+gg(l)
4350 C--------------------------------------------------------------------------
4351 c MODELLER restraint function
4352 subroutine e_modeller(ehomology_constr)
4353 implicit real*8 (a-h,o-z)
4354 include 'DIMENSIONS'
4355 include 'DIMENSIONS.ZSCOPT'
4356 include 'DIMENSIONS.FREE'
4357 integer nnn, i, j, k, ki, irec, l
4358 integer katy, odleglosci, test7
4359 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
4360 real*8 distance(max_template),distancek(max_template),
4361 & min_odl,godl(max_template),dih_diff(max_template)
4364 c FP - 30/10/2014 Temporary specifications for homology restraints
4366 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
4368 double precision, dimension (maxres) :: guscdiff,usc_diff
4369 double precision, dimension (max_template) ::
4370 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
4373 include 'COMMON.SBRIDGE'
4374 include 'COMMON.CHAIN'
4375 include 'COMMON.GEO'
4376 include 'COMMON.DERIV'
4377 include 'COMMON.LOCAL'
4378 include 'COMMON.INTERACT'
4379 include 'COMMON.VAR'
4380 include 'COMMON.IOUNITS'
4381 include 'COMMON.CONTROL'
4382 include 'COMMON.HOMRESTR'
4383 include 'COMMON.HOMOLOGY'
4384 include 'COMMON.SETUP'
4385 include 'COMMON.NAMES'
4388 distancek(i)=9999999.9
4393 c Pseudo-energy and gradient from homology restraints (MODELLER-like
4395 C AL 5/2/14 - Introduce list of restraints
4396 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
4398 write(iout,*) "------- dist restrs start -------"
4400 do ii = link_start_homo,link_end_homo
4404 c write (iout,*) "dij(",i,j,") =",dij
4406 do k=1,constr_homology
4407 if(.not.l_homo(k,ii)) then
4411 distance(k)=odl(k,ii)-dij
4412 c write (iout,*) "distance(",k,") =",distance(k)
4414 c For Gaussian-type Urestr
4416 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
4417 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
4418 c write (iout,*) "distancek(",k,") =",distancek(k)
4419 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
4421 c For Lorentzian-type Urestr
4423 if (waga_dist.lt.0.0d0) then
4424 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
4425 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
4426 & (distance(k)**2+sigma_odlir(k,ii)**2))
4430 c min_odl=minval(distancek)
4434 do kk=1,constr_homology
4435 if(l_homo(kk,ii)) then
4436 min_odl=distancek(kk)
4440 do kk=1,constr_homology
4441 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
4442 & min_odl=distancek(kk)
4445 c write (iout,* )"min_odl",min_odl
4447 write (iout,*) "ij dij",i,j,dij
4448 write (iout,*) "distance",(distance(k),k=1,constr_homology)
4449 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
4450 write (iout,* )"min_odl",min_odl
4455 if (waga_dist.ge.0.0d0) then
4461 do k=1,constr_homology
4462 c Nie wiem po co to liczycie jeszcze raz!
4463 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
4464 c & (2*(sigma_odl(i,j,k))**2))
4465 if(.not.l_homo(k,ii)) cycle
4466 if (waga_dist.ge.0.0d0) then
4468 c For Gaussian-type Urestr
4470 godl(k)=dexp(-distancek(k)+min_odl)
4471 odleg2=odleg2+godl(k)
4473 c For Lorentzian-type Urestr
4476 odleg2=odleg2+distancek(k)
4479 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
4480 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
4481 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
4482 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
4485 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
4486 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
4488 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
4489 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
4491 if (waga_dist.ge.0.0d0) then
4493 c For Gaussian-type Urestr
4495 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
4497 c For Lorentzian-type Urestr
4500 odleg=odleg+odleg2/constr_homology
4504 c write (iout,*) "odleg",odleg ! sum of -ln-s
4507 c For Gaussian-type Urestr
4509 if (waga_dist.ge.0.0d0) sum_godl=odleg2
4511 do k=1,constr_homology
4512 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
4513 c & *waga_dist)+min_odl
4514 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
4516 if(.not.l_homo(k,ii)) cycle
4517 if (waga_dist.ge.0.0d0) then
4518 c For Gaussian-type Urestr
4520 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
4522 c For Lorentzian-type Urestr
4525 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
4526 & sigma_odlir(k,ii)**2)**2)
4528 sum_sgodl=sum_sgodl+sgodl
4530 c sgodl2=sgodl2+sgodl
4531 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
4532 c write(iout,*) "constr_homology=",constr_homology
4533 c write(iout,*) i, j, k, "TEST K"
4535 if (waga_dist.ge.0.0d0) then
4537 c For Gaussian-type Urestr
4539 grad_odl3=waga_homology(iset)*waga_dist
4540 & *sum_sgodl/(sum_godl*dij)
4542 c For Lorentzian-type Urestr
4545 c Original grad expr modified by analogy w Gaussian-type Urestr grad
4546 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
4547 grad_odl3=-waga_homology(iset)*waga_dist*
4548 & sum_sgodl/(constr_homology*dij)
4551 c grad_odl3=sum_sgodl/(sum_godl*dij)
4554 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
4555 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
4556 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
4558 ccc write(iout,*) godl, sgodl, grad_odl3
4560 c grad_odl=grad_odl+grad_odl3
4563 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
4564 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
4565 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
4566 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
4567 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
4568 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
4569 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
4570 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
4571 c if (i.eq.25.and.j.eq.27) then
4572 c write(iout,*) "jik",jik,"i",i,"j",j
4573 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
4574 c write(iout,*) "grad_odl3",grad_odl3
4575 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
4576 c write(iout,*) "ggodl",ggodl
4577 c write(iout,*) "ghpbc(",jik,i,")",
4578 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
4583 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
4584 ccc & dLOG(odleg2),"-odleg=", -odleg
4586 enddo ! ii-loop for dist
4588 write(iout,*) "------- dist restrs end -------"
4589 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
4590 c & waga_d.eq.1.0d0) call sum_gradient
4592 c Pseudo-energy and gradient from dihedral-angle restraints from
4593 c homology templates
4594 c write (iout,*) "End of distance loop"
4597 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
4599 write(iout,*) "------- dih restrs start -------"
4600 do i=idihconstr_start_homo,idihconstr_end_homo
4601 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
4604 do i=idihconstr_start_homo,idihconstr_end_homo
4606 c betai=beta(i,i+1,i+2,i+3)
4608 c write (iout,*) "betai =",betai
4609 do k=1,constr_homology
4610 dih_diff(k)=pinorm(dih(k,i)-betai)
4611 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
4612 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
4613 c & -(6.28318-dih_diff(i,k))
4614 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
4615 c & 6.28318+dih_diff(i,k)
4617 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
4619 kat3=(dcos(dih_diff(k))-1)*sigma_dih(k,i)
4621 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
4624 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
4627 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
4628 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
4630 write (iout,*) "i",i," betai",betai," kat2",kat2
4631 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
4633 if (kat2.le.1.0d-14) cycle
4634 kat=kat-dLOG(kat2/constr_homology)
4635 c write (iout,*) "kat",kat ! sum of -ln-s
4637 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
4638 ccc & dLOG(kat2), "-kat=", -kat
4641 c ----------------------------------------------------------------------
4643 c ----------------------------------------------------------------------
4647 do k=1,constr_homology
4649 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
4651 sgdih=-gdih(k)*dsin(dih_diff(k))*sigma_dih(k,i)
4653 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
4654 sum_sgdih=sum_sgdih+sgdih
4656 c grad_dih3=sum_sgdih/sum_gdih
4657 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
4659 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
4660 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
4661 ccc & gloc(nphi+i-3,icg)
4662 gloc(i,icg)=gloc(i,icg)+grad_dih3
4664 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
4666 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
4667 ccc & gloc(nphi+i-3,icg)
4669 enddo ! i-loop for dih
4671 write(iout,*) "------- dih restrs end -------"
4674 c Pseudo-energy and gradient for theta angle restraints from
4675 c homology templates
4676 c FP 01/15 - inserted from econstr_local_test.F, loop structure
4680 c For constr_homology reference structures (FP)
4682 c Uconst_back_tot=0.0d0
4685 c Econstr_back legacy
4688 c do i=ithet_start,ithet_end
4691 c do i=loc_start,loc_end
4694 duscdiffx(j,i)=0.0d0
4700 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
4701 c write (iout,*) "waga_theta",waga_theta
4702 if (waga_theta.gt.0.0d0) then
4704 write (iout,*) "usampl",usampl
4705 write(iout,*) "------- theta restrs start -------"
4706 c do i=ithet_start,ithet_end
4707 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
4710 c write (iout,*) "maxres",maxres,"nres",nres
4712 do i=ithet_start,ithet_end
4715 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
4717 c Deviation of theta angles wrt constr_homology ref structures
4719 utheta_i=0.0d0 ! argument of Gaussian for single k
4720 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
4721 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
4722 c over residues in a fragment
4723 c write (iout,*) "theta(",i,")=",theta(i)
4724 do k=1,constr_homology
4726 c dtheta_i=theta(j)-thetaref(j,iref)
4727 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
4728 theta_diff(k)=thetatpl(k,i)-theta(i)
4730 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
4731 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
4732 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
4733 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
4734 c Gradient for single Gaussian restraint in subr Econstr_back
4735 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
4738 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
4739 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
4743 c Gradient for multiple Gaussian restraint
4744 sum_gtheta=gutheta_i
4746 do k=1,constr_homology
4747 c New generalized expr for multiple Gaussian from Econstr_back
4748 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
4750 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
4751 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
4754 c Final value of gradient using same var as in Econstr_back
4755 dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
4756 & *waga_homology(iset)
4757 c dutheta(i)=sum_sgtheta/sum_gtheta
4759 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
4761 Eval=Eval-dLOG(gutheta_i/constr_homology)
4762 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
4763 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
4764 c Uconst_back=Uconst_back+utheta(i)
4765 enddo ! (i-loop for theta)
4767 write(iout,*) "------- theta restrs end -------"
4771 c Deviation of local SC geometry
4773 c Separation of two i-loops (instructed by AL - 11/3/2014)
4775 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
4776 c write (iout,*) "waga_d",waga_d
4779 write(iout,*) "------- SC restrs start -------"
4780 write (iout,*) "Initial duscdiff,duscdiffx"
4781 do i=loc_start,loc_end
4782 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
4783 & (duscdiffx(jik,i),jik=1,3)
4786 do i=loc_start,loc_end
4787 usc_diff_i=0.0d0 ! argument of Gaussian for single k
4788 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
4789 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
4790 c write(iout,*) "xxtab, yytab, zztab"
4791 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
4792 do k=1,constr_homology
4794 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
4795 c Original sign inverted for calc of gradients (s. Econstr_back)
4796 dyy=-yytpl(k,i)+yytab(i) ! ibid y
4797 dzz=-zztpl(k,i)+zztab(i) ! ibid z
4798 c write(iout,*) "dxx, dyy, dzz"
4799 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
4801 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
4802 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
4803 c uscdiffk(k)=usc_diff(i)
4804 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
4805 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
4806 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
4807 c & xxref(j),yyref(j),zzref(j)
4812 c Generalized expression for multiple Gaussian acc to that for a single
4813 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
4815 c Original implementation
4816 c sum_guscdiff=guscdiff(i)
4818 c sum_sguscdiff=0.0d0
4819 c do k=1,constr_homology
4820 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
4821 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
4822 c sum_sguscdiff=sum_sguscdiff+sguscdiff
4825 c Implementation of new expressions for gradient (Jan. 2015)
4827 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
4829 do k=1,constr_homology
4831 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
4832 c before. Now the drivatives should be correct
4834 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
4835 c Original sign inverted for calc of gradients (s. Econstr_back)
4836 dyy=-yytpl(k,i)+yytab(i) ! ibid y
4837 dzz=-zztpl(k,i)+zztab(i) ! ibid z
4839 c New implementation
4841 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
4842 & sigma_d(k,i) ! for the grad wrt r'
4843 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
4846 c New implementation
4847 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
4849 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
4850 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
4851 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
4852 duscdiff(jik,i)=duscdiff(jik,i)+
4853 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
4854 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
4855 duscdiffx(jik,i)=duscdiffx(jik,i)+
4856 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
4857 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
4860 write(iout,*) "jik",jik,"i",i
4861 write(iout,*) "dxx, dyy, dzz"
4862 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
4863 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
4864 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
4865 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
4866 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
4867 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
4868 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
4869 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
4870 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
4871 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
4872 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
4873 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
4874 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
4875 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
4876 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
4883 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
4884 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
4886 c write (iout,*) i," uscdiff",uscdiff(i)
4888 c Put together deviations from local geometry
4890 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
4891 c & wfrag_back(3,i,iset)*uscdiff(i)
4892 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
4893 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
4894 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
4895 c Uconst_back=Uconst_back+usc_diff(i)
4897 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
4899 c New implment: multiplied by sum_sguscdiff
4902 enddo ! (i-loop for dscdiff)
4907 write(iout,*) "------- SC restrs end -------"
4908 write (iout,*) "------ After SC loop in e_modeller ------"
4909 do i=loc_start,loc_end
4910 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
4911 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
4913 if (waga_theta.eq.1.0d0) then
4914 write (iout,*) "in e_modeller after SC restr end: dutheta"
4915 do i=ithet_start,ithet_end
4916 write (iout,*) i,dutheta(i)
4919 if (waga_d.eq.1.0d0) then
4920 write (iout,*) "e_modeller after SC loop: duscdiff/x"
4922 write (iout,*) i,(duscdiff(j,i),j=1,3)
4923 write (iout,*) i,(duscdiffx(j,i),j=1,3)
4928 c Total energy from homology restraints
4930 write (iout,*) "odleg",odleg," kat",kat
4931 write (iout,*) "odleg",odleg," kat",kat
4932 write (iout,*) "Eval",Eval," Erot",Erot
4933 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
4934 write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
4935 write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
4938 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
4940 c ehomology_constr=odleg+kat
4942 c For Lorentzian-type Urestr
4945 if (waga_dist.ge.0.0d0) then
4947 c For Gaussian-type Urestr
4949 c ehomology_constr=(waga_dist*odleg+waga_angle*kat+
4950 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
4951 ehomology_constr=waga_dist*odleg+waga_angle*kat+
4952 & waga_theta*Eval+waga_d*Erot
4953 c write (iout,*) "ehomology_constr=",ehomology_constr
4956 c For Lorentzian-type Urestr
4958 c ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
4959 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
4960 ehomology_constr=-waga_dist*odleg+waga_angle*kat+
4961 & waga_theta*Eval+waga_d*Erot
4962 c write (iout,*) "ehomology_constr=",ehomology_constr
4965 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
4966 & "Eval",waga_theta,eval,
4967 & "Erot",waga_d,Erot
4968 write (iout,*) "ehomology_constr",ehomology_constr
4972 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
4973 747 format(a12,i4,i4,i4,f8.3,f8.3)
4974 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
4975 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
4976 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
4977 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
4979 c-----------------------------------------------------------------------
4980 subroutine ebond(estr)
4982 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4984 implicit real*8 (a-h,o-z)
4985 include 'DIMENSIONS'
4986 include 'DIMENSIONS.ZSCOPT'
4987 include 'COMMON.LOCAL'
4988 include 'COMMON.GEO'
4989 include 'COMMON.INTERACT'
4990 include 'COMMON.DERIV'
4991 include 'COMMON.VAR'
4992 include 'COMMON.CHAIN'
4993 include 'COMMON.IOUNITS'
4994 include 'COMMON.NAMES'
4995 include 'COMMON.FFIELD'
4996 include 'COMMON.CONTROL'
4997 double precision u(3),ud(3)
5000 c write (iout,*) "distchainmax",distchainmax
5003 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) cycle
5004 diff = vbld(i)-vbldp0
5006 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5007 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5009 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5010 C & *dc(j,i-1)/vbld(i)
5012 C if (energy_dec) write(iout,*)
5013 C & "estr1",i,vbld(i),distchainmax,
5014 C & gnmr1(vbld(i),-1.0d0,distchainmax)
5016 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5017 diff = vbld(i)-vbldpDUM
5018 C write(iout,*) i,diff
5020 diff = vbld(i)-vbldp0
5021 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
5026 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5029 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
5030 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5032 estr=0.5d0*AKP*estr+estr1
5034 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5038 if (iti.ne.10 .and. iti.ne.ntyp1) then
5041 diff=vbld(i+nres)-vbldsc0(1,iti)
5042 if (energy_dec) write (iout,*) "estr sc",iti,vbld(i+nres),
5043 & vbldsc0(1,iti),diff,
5044 & AKSC(1,iti),AKSC(1,iti)*diff*diff
5045 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5047 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5051 diff=vbld(i+nres)-vbldsc0(j,iti)
5052 ud(j)=aksc(j,iti)*diff
5053 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5067 uprod2=uprod2*u(k)*u(k)
5071 usumsqder=usumsqder+ud(j)*uprod2
5073 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
5074 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
5075 estr=estr+uprod/usum
5077 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5085 C--------------------------------------------------------------------------
5086 subroutine ebend(etheta,ethetacnstr)
5088 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5089 C angles gamma and its derivatives in consecutive thetas and gammas.
5091 implicit real*8 (a-h,o-z)
5092 include 'DIMENSIONS'
5093 include 'DIMENSIONS.ZSCOPT'
5094 include 'COMMON.LOCAL'
5095 include 'COMMON.GEO'
5096 include 'COMMON.INTERACT'
5097 include 'COMMON.DERIV'
5098 include 'COMMON.VAR'
5099 include 'COMMON.CHAIN'
5100 include 'COMMON.IOUNITS'
5101 include 'COMMON.NAMES'
5102 include 'COMMON.FFIELD'
5103 include 'COMMON.TORCNSTR'
5104 common /calcthet/ term1,term2,termm,diffak,ratak,
5105 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5106 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5107 double precision y(2),z(2)
5109 c time11=dexp(-2*time)
5112 c write (iout,*) "nres",nres
5113 c write (*,'(a,i2)') 'EBEND ICG=',icg
5114 c write (iout,*) ithet_start,ithet_end
5115 do i=ithet_start,ithet_end
5116 C if (itype(i-1).eq.ntyp1) cycle
5118 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5119 & .or.itype(i).eq.ntyp1) cycle
5120 C Zero the energy function and its derivative at 0 or pi.
5121 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5123 ichir1=isign(1,itype(i-2))
5124 ichir2=isign(1,itype(i))
5125 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5126 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5127 if (itype(i-1).eq.10) then
5128 itype1=isign(10,itype(i-2))
5129 ichir11=isign(1,itype(i-2))
5130 ichir12=isign(1,itype(i-2))
5131 itype2=isign(10,itype(i))
5132 ichir21=isign(1,itype(i))
5133 ichir22=isign(1,itype(i))
5140 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5144 c call proc_proc(phii,icrc)
5145 if (icrc.eq.1) phii=150.0
5156 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5160 c call proc_proc(phii1,icrc)
5161 if (icrc.eq.1) phii1=150.0
5173 C Calculate the "mean" value of theta from the part of the distribution
5174 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5175 C In following comments this theta will be referred to as t_c.
5176 thet_pred_mean=0.0d0
5178 athetk=athet(k,it,ichir1,ichir2)
5179 bthetk=bthet(k,it,ichir1,ichir2)
5181 athetk=athet(k,itype1,ichir11,ichir12)
5182 bthetk=bthet(k,itype2,ichir21,ichir22)
5184 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5186 c write (iout,*) "thet_pred_mean",thet_pred_mean
5187 dthett=thet_pred_mean*ssd
5188 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5189 c write (iout,*) "thet_pred_mean",thet_pred_mean
5190 C Derivatives of the "mean" values in gamma1 and gamma2.
5191 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
5192 &+athet(2,it,ichir1,ichir2)*y(1))*ss
5193 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
5194 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
5196 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
5197 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
5198 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
5199 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5201 if (theta(i).gt.pi-delta) then
5202 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
5204 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5205 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5206 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5208 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5210 else if (theta(i).lt.delta) then
5211 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5212 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5213 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5215 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5216 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5219 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5222 etheta=etheta+ethetai
5223 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
5224 c & 'ebend',i,ethetai,theta(i),itype(i)
5225 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
5226 c & rad2deg*phii,rad2deg*phii1,ethetai
5227 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5228 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5229 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
5233 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
5234 do i=1,ntheta_constr
5235 itheta=itheta_constr(i)
5236 thetiii=theta(itheta)
5237 difi=pinorm(thetiii-theta_constr0(i))
5238 if (difi.gt.theta_drange(i)) then
5239 difi=difi-theta_drange(i)
5240 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5241 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
5242 & +for_thet_constr(i)*difi**3
5243 else if (difi.lt.-drange(i)) then
5245 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5246 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
5247 & +for_thet_constr(i)*difi**3
5251 C if (energy_dec) then
5252 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
5253 C & i,itheta,rad2deg*thetiii,
5254 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
5255 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
5256 C & gloc(itheta+nphi-2,icg)
5259 C Ufff.... We've done all this!!!
5262 C---------------------------------------------------------------------------
5263 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5265 implicit real*8 (a-h,o-z)
5266 include 'DIMENSIONS'
5267 include 'COMMON.LOCAL'
5268 include 'COMMON.IOUNITS'
5269 common /calcthet/ term1,term2,termm,diffak,ratak,
5270 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5271 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5272 C Calculate the contributions to both Gaussian lobes.
5273 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5274 C The "polynomial part" of the "standard deviation" of this part of
5278 sig=sig*thet_pred_mean+polthet(j,it)
5280 C Derivative of the "interior part" of the "standard deviation of the"
5281 C gamma-dependent Gaussian lobe in t_c.
5282 sigtc=3*polthet(3,it)
5284 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5287 C Set the parameters of both Gaussian lobes of the distribution.
5288 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5289 fac=sig*sig+sigc0(it)
5292 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5293 sigsqtc=-4.0D0*sigcsq*sigtc
5294 c print *,i,sig,sigtc,sigsqtc
5295 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5296 sigtc=-sigtc/(fac*fac)
5297 C Following variable is sigma(t_c)**(-2)
5298 sigcsq=sigcsq*sigcsq
5300 sig0inv=1.0D0/sig0i**2
5301 delthec=thetai-thet_pred_mean
5302 delthe0=thetai-theta0i
5303 term1=-0.5D0*sigcsq*delthec*delthec
5304 term2=-0.5D0*sig0inv*delthe0*delthe0
5305 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5306 C NaNs in taking the logarithm. We extract the largest exponent which is added
5307 C to the energy (this being the log of the distribution) at the end of energy
5308 C term evaluation for this virtual-bond angle.
5309 if (term1.gt.term2) then
5311 term2=dexp(term2-termm)
5315 term1=dexp(term1-termm)
5318 C The ratio between the gamma-independent and gamma-dependent lobes of
5319 C the distribution is a Gaussian function of thet_pred_mean too.
5320 diffak=gthet(2,it)-thet_pred_mean
5321 ratak=diffak/gthet(3,it)**2
5322 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5323 C Let's differentiate it in thet_pred_mean NOW.
5325 C Now put together the distribution terms to make complete distribution.
5326 termexp=term1+ak*term2
5327 termpre=sigc+ak*sig0i
5328 C Contribution of the bending energy from this theta is just the -log of
5329 C the sum of the contributions from the two lobes and the pre-exponential
5330 C factor. Simple enough, isn't it?
5331 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5332 C NOW the derivatives!!!
5333 C 6/6/97 Take into account the deformation.
5334 E_theta=(delthec*sigcsq*term1
5335 & +ak*delthe0*sig0inv*term2)/termexp
5336 E_tc=((sigtc+aktc*sig0i)/termpre
5337 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5338 & aktc*term2)/termexp)
5341 c-----------------------------------------------------------------------------
5342 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5343 implicit real*8 (a-h,o-z)
5344 include 'DIMENSIONS'
5345 include 'COMMON.LOCAL'
5346 include 'COMMON.IOUNITS'
5347 common /calcthet/ term1,term2,termm,diffak,ratak,
5348 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5349 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5350 delthec=thetai-thet_pred_mean
5351 delthe0=thetai-theta0i
5352 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5353 t3 = thetai-thet_pred_mean
5357 t14 = t12+t6*sigsqtc
5359 t21 = thetai-theta0i
5365 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5366 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5367 & *(-t12*t9-ak*sig0inv*t27)
5371 C--------------------------------------------------------------------------
5372 subroutine ebend(etheta)
5374 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5375 C angles gamma and its derivatives in consecutive thetas and gammas.
5376 C ab initio-derived potentials from
5377 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5379 implicit real*8 (a-h,o-z)
5380 include 'DIMENSIONS'
5381 include 'DIMENSIONS.ZSCOPT'
5382 include 'COMMON.LOCAL'
5383 include 'COMMON.GEO'
5384 include 'COMMON.INTERACT'
5385 include 'COMMON.DERIV'
5386 include 'COMMON.VAR'
5387 include 'COMMON.CHAIN'
5388 include 'COMMON.IOUNITS'
5389 include 'COMMON.NAMES'
5390 include 'COMMON.FFIELD'
5391 include 'COMMON.CONTROL'
5392 include 'COMMON.TORCNSTR'
5393 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5394 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5395 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5396 & sinph1ph2(maxdouble,maxdouble)
5397 logical lprn /.false./, lprn1 /.false./
5399 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
5400 do i=ithet_start,ithet_end
5402 C if (itype(i-1).eq.ntyp1) cycle
5404 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5405 & .or.itype(i).eq.ntyp1) cycle
5406 if (iabs(itype(i+1)).eq.20) iblock=2
5407 if (iabs(itype(i+1)).ne.20) iblock=1
5411 theti2=0.5d0*theta(i)
5412 ityp2=ithetyp((itype(i-1)))
5414 coskt(k)=dcos(k*theti2)
5415 sinkt(k)=dsin(k*theti2)
5425 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5428 if (phii.ne.phii) phii=150.0
5432 ityp1=ithetyp((itype(i-2)))
5434 cosph1(k)=dcos(k*phii)
5435 sinph1(k)=dsin(k*phii)
5441 ityp1=ithetyp((itype(i-2)))
5446 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5449 if (phii1.ne.phii1) phii1=150.0
5454 ityp3=ithetyp((itype(i)))
5456 cosph2(k)=dcos(k*phii1)
5457 sinph2(k)=dsin(k*phii1)
5462 ityp3=ithetyp((itype(i)))
5468 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
5469 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
5471 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5474 ccl=cosph1(l)*cosph2(k-l)
5475 ssl=sinph1(l)*sinph2(k-l)
5476 scl=sinph1(l)*cosph2(k-l)
5477 csl=cosph1(l)*sinph2(k-l)
5478 cosph1ph2(l,k)=ccl-ssl
5479 cosph1ph2(k,l)=ccl+ssl
5480 sinph1ph2(l,k)=scl+csl
5481 sinph1ph2(k,l)=scl-csl
5485 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5486 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5487 write (iout,*) "coskt and sinkt"
5489 write (iout,*) k,coskt(k),sinkt(k)
5493 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5494 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5497 & write (iout,*) "k",k,"
5498 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5499 & " ethetai",ethetai
5502 write (iout,*) "cosph and sinph"
5504 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5506 write (iout,*) "cosph1ph2 and sinph2ph2"
5509 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5510 & sinph1ph2(l,k),sinph1ph2(k,l)
5513 write(iout,*) "ethetai",ethetai
5517 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5518 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5519 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5520 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5521 ethetai=ethetai+sinkt(m)*aux
5522 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5523 dephii=dephii+k*sinkt(m)*(
5524 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5525 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5526 dephii1=dephii1+k*sinkt(m)*(
5527 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5528 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5530 & write (iout,*) "m",m," k",k," bbthet",
5531 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5532 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5533 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5534 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5538 & write(iout,*) "ethetai",ethetai
5542 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5543 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5544 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5545 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5546 ethetai=ethetai+sinkt(m)*aux
5547 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5548 dephii=dephii+l*sinkt(m)*(
5549 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5550 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5551 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5552 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5553 dephii1=dephii1+(k-l)*sinkt(m)*(
5554 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5555 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5556 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5557 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5559 write (iout,*) "m",m," k",k," l",l," ffthet",
5560 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5561 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5562 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5563 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5564 & " ethetai",ethetai
5565 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5566 & cosph1ph2(k,l)*sinkt(m),
5567 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5573 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5574 & i,theta(i)*rad2deg,phii*rad2deg,
5575 & phii1*rad2deg,ethetai
5576 etheta=etheta+ethetai
5577 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5578 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5579 c gloc(nphi+i-2,icg)=wang*dethetai
5580 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
5586 c-----------------------------------------------------------------------------
5587 subroutine esc(escloc)
5588 C Calculate the local energy of a side chain and its derivatives in the
5589 C corresponding virtual-bond valence angles THETA and the spherical angles
5591 implicit real*8 (a-h,o-z)
5592 include 'DIMENSIONS'
5593 include 'DIMENSIONS.ZSCOPT'
5594 include 'COMMON.GEO'
5595 include 'COMMON.LOCAL'
5596 include 'COMMON.VAR'
5597 include 'COMMON.INTERACT'
5598 include 'COMMON.DERIV'
5599 include 'COMMON.CHAIN'
5600 include 'COMMON.IOUNITS'
5601 include 'COMMON.NAMES'
5602 include 'COMMON.FFIELD'
5603 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5604 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5605 common /sccalc/ time11,time12,time112,theti,it,nlobit
5608 C write (iout,*) 'ESC'
5609 do i=loc_start,loc_end
5611 if (it.eq.ntyp1) cycle
5612 if (it.eq.10) goto 1
5613 nlobit=nlob(iabs(it))
5614 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5615 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5616 theti=theta(i+1)-pipol
5620 c write (iout,*) "i",i," x",x(1),x(2),x(3)
5622 if (x(2).gt.pi-delta) then
5626 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5628 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5629 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5631 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5632 & ddersc0(1),dersc(1))
5633 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5634 & ddersc0(3),dersc(3))
5636 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5638 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5639 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5640 & dersc0(2),esclocbi,dersc02)
5641 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5643 call splinthet(x(2),0.5d0*delta,ss,ssd)
5648 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5650 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5651 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5653 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5655 c write (iout,*) escloci
5656 else if (x(2).lt.delta) then
5660 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5662 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5663 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5665 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5666 & ddersc0(1),dersc(1))
5667 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5668 & ddersc0(3),dersc(3))
5670 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5672 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5673 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5674 & dersc0(2),esclocbi,dersc02)
5675 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5680 call splinthet(x(2),0.5d0*delta,ss,ssd)
5682 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5684 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5685 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5687 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5688 C write (iout,*) 'i=',i, escloci
5690 call enesc(x,escloci,dersc,ddummy,.false.)
5693 escloc=escloc+escloci
5694 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5695 write (iout,'(a6,i5,0pf7.3)')
5696 & 'escloc',i,escloci
5698 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5700 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5701 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5706 C---------------------------------------------------------------------------
5707 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5708 implicit real*8 (a-h,o-z)
5709 include 'DIMENSIONS'
5710 include 'COMMON.GEO'
5711 include 'COMMON.LOCAL'
5712 include 'COMMON.IOUNITS'
5713 common /sccalc/ time11,time12,time112,theti,it,nlobit
5714 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5715 double precision contr(maxlob,-1:1)
5717 c write (iout,*) 'it=',it,' nlobit=',nlobit
5721 if (mixed) ddersc(j)=0.0d0
5725 C Because of periodicity of the dependence of the SC energy in omega we have
5726 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5727 C To avoid underflows, first compute & store the exponents.
5735 z(k)=x(k)-censc(k,j,it)
5740 Axk=Axk+gaussc(l,k,j,it)*z(l)
5746 expfac=expfac+Ax(k,j,iii)*z(k)
5754 C As in the case of ebend, we want to avoid underflows in exponentiation and
5755 C subsequent NaNs and INFs in energy calculation.
5756 C Find the largest exponent
5760 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5764 cd print *,'it=',it,' emin=',emin
5766 C Compute the contribution to SC energy and derivatives
5770 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5771 cd print *,'j=',j,' expfac=',expfac
5772 escloc_i=escloc_i+expfac
5774 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5778 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5779 & +gaussc(k,2,j,it))*expfac
5786 dersc(1)=dersc(1)/cos(theti)**2
5787 ddersc(1)=ddersc(1)/cos(theti)**2
5790 escloci=-(dlog(escloc_i)-emin)
5792 dersc(j)=dersc(j)/escloc_i
5796 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5801 C------------------------------------------------------------------------------
5802 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5803 implicit real*8 (a-h,o-z)
5804 include 'DIMENSIONS'
5805 include 'COMMON.GEO'
5806 include 'COMMON.LOCAL'
5807 include 'COMMON.IOUNITS'
5808 common /sccalc/ time11,time12,time112,theti,it,nlobit
5809 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5810 double precision contr(maxlob)
5821 z(k)=x(k)-censc(k,j,it)
5827 Axk=Axk+gaussc(l,k,j,it)*z(l)
5833 expfac=expfac+Ax(k,j)*z(k)
5838 C As in the case of ebend, we want to avoid underflows in exponentiation and
5839 C subsequent NaNs and INFs in energy calculation.
5840 C Find the largest exponent
5843 if (emin.gt.contr(j)) emin=contr(j)
5847 C Compute the contribution to SC energy and derivatives
5851 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5852 escloc_i=escloc_i+expfac
5854 dersc(k)=dersc(k)+Ax(k,j)*expfac
5856 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5857 & +gaussc(1,2,j,it))*expfac
5861 dersc(1)=dersc(1)/cos(theti)**2
5862 dersc12=dersc12/cos(theti)**2
5863 escloci=-(dlog(escloc_i)-emin)
5865 dersc(j)=dersc(j)/escloc_i
5867 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5871 c----------------------------------------------------------------------------------
5872 subroutine esc(escloc)
5873 C Calculate the local energy of a side chain and its derivatives in the
5874 C corresponding virtual-bond valence angles THETA and the spherical angles
5875 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5876 C added by Urszula Kozlowska. 07/11/2007
5878 implicit real*8 (a-h,o-z)
5879 include 'DIMENSIONS'
5880 include 'DIMENSIONS.ZSCOPT'
5881 include 'COMMON.GEO'
5882 include 'COMMON.LOCAL'
5883 include 'COMMON.VAR'
5884 include 'COMMON.SCROT'
5885 include 'COMMON.INTERACT'
5886 include 'COMMON.DERIV'
5887 include 'COMMON.CHAIN'
5888 include 'COMMON.IOUNITS'
5889 include 'COMMON.NAMES'
5890 include 'COMMON.FFIELD'
5891 include 'COMMON.CONTROL'
5892 include 'COMMON.VECTORS'
5893 double precision x_prime(3),y_prime(3),z_prime(3)
5894 & , sumene,dsc_i,dp2_i,x(65),
5895 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5896 & de_dxx,de_dyy,de_dzz,de_dt
5897 double precision s1_t,s1_6_t,s2_t,s2_6_t
5899 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5900 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5901 & dt_dCi(3),dt_dCi1(3)
5902 common /sccalc/ time11,time12,time112,theti,it,nlobit
5905 do i=loc_start,loc_end
5906 if (itype(i).eq.ntyp1) cycle
5907 costtab(i+1) =dcos(theta(i+1))
5908 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5909 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5910 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5911 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5912 cosfac=dsqrt(cosfac2)
5913 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5914 sinfac=dsqrt(sinfac2)
5916 if (it.eq.10) goto 1
5918 C Compute the axes of tghe local cartesian coordinates system; store in
5919 c x_prime, y_prime and z_prime
5926 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5927 C & dc_norm(3,i+nres)
5929 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5930 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5933 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5936 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5937 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5938 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5939 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5940 c & " xy",scalar(x_prime(1),y_prime(1)),
5941 c & " xz",scalar(x_prime(1),z_prime(1)),
5942 c & " yy",scalar(y_prime(1),y_prime(1)),
5943 c & " yz",scalar(y_prime(1),z_prime(1)),
5944 c & " zz",scalar(z_prime(1),z_prime(1))
5946 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5947 C to local coordinate system. Store in xx, yy, zz.
5953 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5954 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5955 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5962 C Compute the energy of the ith side cbain
5964 c write (2,*) "xx",xx," yy",yy," zz",zz
5967 x(j) = sc_parmin(j,it)
5970 Cc diagnostics - remove later
5972 yy1 = dsin(alph(2))*dcos(omeg(2))
5973 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
5974 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5975 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5977 C," --- ", xx_w,yy_w,zz_w
5980 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5981 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5983 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5984 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5986 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5987 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5988 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5989 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5990 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5992 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5993 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5994 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5995 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5996 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5998 dsc_i = 0.743d0+x(61)
6000 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6001 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6002 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6003 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6004 s1=(1+x(63))/(0.1d0 + dscp1)
6005 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6006 s2=(1+x(65))/(0.1d0 + dscp2)
6007 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6008 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6009 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6010 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6012 c & dscp1,dscp2,sumene
6013 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6014 escloc = escloc + sumene
6015 c write (2,*) "escloc",escloc
6016 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
6018 if (.not. calc_grad) goto 1
6021 C This section to check the numerical derivatives of the energy of ith side
6022 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6023 C #define DEBUG in the code to turn it on.
6025 write (2,*) "sumene =",sumene
6029 write (2,*) xx,yy,zz
6030 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6031 de_dxx_num=(sumenep-sumene)/aincr
6033 write (2,*) "xx+ sumene from enesc=",sumenep
6036 write (2,*) xx,yy,zz
6037 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6038 de_dyy_num=(sumenep-sumene)/aincr
6040 write (2,*) "yy+ sumene from enesc=",sumenep
6043 write (2,*) xx,yy,zz
6044 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6045 de_dzz_num=(sumenep-sumene)/aincr
6047 write (2,*) "zz+ sumene from enesc=",sumenep
6048 costsave=cost2tab(i+1)
6049 sintsave=sint2tab(i+1)
6050 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6051 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6052 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6053 de_dt_num=(sumenep-sumene)/aincr
6054 write (2,*) " t+ sumene from enesc=",sumenep
6055 cost2tab(i+1)=costsave
6056 sint2tab(i+1)=sintsave
6057 C End of diagnostics section.
6060 C Compute the gradient of esc
6062 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6063 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6064 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6065 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6066 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6067 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6068 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6069 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6070 pom1=(sumene3*sint2tab(i+1)+sumene1)
6071 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6072 pom2=(sumene4*cost2tab(i+1)+sumene2)
6073 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6074 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6075 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6076 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6078 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6079 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6080 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6082 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6083 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6084 & +(pom1+pom2)*pom_dx
6086 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
6089 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6090 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6091 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6093 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6094 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6095 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6096 & +x(59)*zz**2 +x(60)*xx*zz
6097 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6098 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6099 & +(pom1-pom2)*pom_dy
6101 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
6104 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6105 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6106 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6107 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6108 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6109 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6110 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6111 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6113 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
6116 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6117 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6118 & +pom1*pom_dt1+pom2*pom_dt2
6120 write(2,*), "de_dt = ", de_dt,de_dt_num
6124 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6125 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6126 cosfac2xx=cosfac2*xx
6127 sinfac2yy=sinfac2*yy
6129 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6131 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6133 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6134 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6135 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6136 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6137 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6138 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6139 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6140 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6141 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6142 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6146 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6147 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6148 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6149 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6152 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6153 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6154 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
6156 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6157 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6161 dXX_Ctab(k,i)=dXX_Ci(k)
6162 dXX_C1tab(k,i)=dXX_Ci1(k)
6163 dYY_Ctab(k,i)=dYY_Ci(k)
6164 dYY_C1tab(k,i)=dYY_Ci1(k)
6165 dZZ_Ctab(k,i)=dZZ_Ci(k)
6166 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6167 dXX_XYZtab(k,i)=dXX_XYZ(k)
6168 dYY_XYZtab(k,i)=dYY_XYZ(k)
6169 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6173 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6174 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6175 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6176 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
6177 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6179 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6180 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6181 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
6182 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6183 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
6184 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6185 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
6186 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6188 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6189 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6191 C to check gradient call subroutine check_grad
6198 c------------------------------------------------------------------------------
6199 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6201 C This procedure calculates two-body contact function g(rij) and its derivative:
6204 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6207 C where x=(rij-r0ij)/delta
6209 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6212 double precision rij,r0ij,eps0ij,fcont,fprimcont
6213 double precision x,x2,x4,delta
6217 if (x.lt.-1.0D0) then
6220 else if (x.le.1.0D0) then
6223 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6224 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6231 c------------------------------------------------------------------------------
6232 subroutine splinthet(theti,delta,ss,ssder)
6233 implicit real*8 (a-h,o-z)
6234 include 'DIMENSIONS'
6235 include 'DIMENSIONS.ZSCOPT'
6236 include 'COMMON.VAR'
6237 include 'COMMON.GEO'
6240 if (theti.gt.pipol) then
6241 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6243 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6248 c------------------------------------------------------------------------------
6249 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6251 double precision x,x0,delta,f0,f1,fprim0,f,fprim
6252 double precision ksi,ksi2,ksi3,a1,a2,a3
6253 a1=fprim0*delta/(f1-f0)
6259 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6260 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6263 c------------------------------------------------------------------------------
6264 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6266 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6267 double precision ksi,ksi2,ksi3,a1,a2,a3
6272 a2=3*(f1x-f0x)-2*fprim0x*delta
6273 a3=fprim0x*delta-2*(f1x-f0x)
6274 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6277 C-----------------------------------------------------------------------------
6279 C-----------------------------------------------------------------------------
6280 subroutine etor(etors,fact)
6281 implicit real*8 (a-h,o-z)
6282 include 'DIMENSIONS'
6283 include 'DIMENSIONS.ZSCOPT'
6284 include 'COMMON.VAR'
6285 include 'COMMON.GEO'
6286 include 'COMMON.LOCAL'
6287 include 'COMMON.TORSION'
6288 include 'COMMON.INTERACT'
6289 include 'COMMON.DERIV'
6290 include 'COMMON.CHAIN'
6291 include 'COMMON.NAMES'
6292 include 'COMMON.IOUNITS'
6293 include 'COMMON.FFIELD'
6294 include 'COMMON.TORCNSTR'
6296 C Set lprn=.true. for debugging
6300 do i=iphi_start,iphi_end
6301 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
6302 & .or. itype(i).eq.ntyp1) cycle
6303 itori=itortyp(itype(i-2))
6304 itori1=itortyp(itype(i-1))
6307 C Proline-Proline pair is a special case...
6308 if (itori.eq.3 .and. itori1.eq.3) then
6309 if (phii.gt.-dwapi3) then
6311 fac=1.0D0/(1.0D0-cosphi)
6312 etorsi=v1(1,3,3)*fac
6313 etorsi=etorsi+etorsi
6314 etors=etors+etorsi-v1(1,3,3)
6315 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6318 v1ij=v1(j+1,itori,itori1)
6319 v2ij=v2(j+1,itori,itori1)
6322 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6323 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6327 v1ij=v1(j,itori,itori1)
6328 v2ij=v2(j,itori,itori1)
6331 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6332 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6336 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6337 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6338 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6339 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
6340 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6344 c------------------------------------------------------------------------------
6346 subroutine etor(etors,fact)
6347 implicit real*8 (a-h,o-z)
6348 include 'DIMENSIONS'
6349 include 'DIMENSIONS.ZSCOPT'
6350 include 'COMMON.VAR'
6351 include 'COMMON.GEO'
6352 include 'COMMON.LOCAL'
6353 include 'COMMON.TORSION'
6354 include 'COMMON.INTERACT'
6355 include 'COMMON.DERIV'
6356 include 'COMMON.CHAIN'
6357 include 'COMMON.NAMES'
6358 include 'COMMON.IOUNITS'
6359 include 'COMMON.FFIELD'
6360 include 'COMMON.TORCNSTR'
6362 C Set lprn=.true. for debugging
6366 do i=iphi_start,iphi_end
6368 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6369 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6370 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
6371 C & .or. itype(i).eq.ntyp1) cycle
6372 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
6373 if (iabs(itype(i)).eq.20) then
6378 itori=itortyp(itype(i-2))
6379 itori1=itortyp(itype(i-1))
6382 C Regular cosine and sine terms
6383 do j=1,nterm(itori,itori1,iblock)
6384 v1ij=v1(j,itori,itori1,iblock)
6385 v2ij=v2(j,itori,itori1,iblock)
6388 etors=etors+v1ij*cosphi+v2ij*sinphi
6389 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6393 C E = SUM ----------------------------------- - v1
6394 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6396 cosphi=dcos(0.5d0*phii)
6397 sinphi=dsin(0.5d0*phii)
6398 do j=1,nlor(itori,itori1,iblock)
6399 vl1ij=vlor1(j,itori,itori1)
6400 vl2ij=vlor2(j,itori,itori1)
6401 vl3ij=vlor3(j,itori,itori1)
6402 pom=vl2ij*cosphi+vl3ij*sinphi
6403 pom1=1.0d0/(pom*pom+1.0d0)
6404 etors=etors+vl1ij*pom1
6405 c if (energy_dec) etors_ii=etors_ii+
6408 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6410 C Subtract the constant term
6411 etors=etors-v0(itori,itori1,iblock)
6413 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6414 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6415 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
6416 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
6417 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6422 c----------------------------------------------------------------------------
6423 subroutine etor_d(etors_d,fact2)
6424 C 6/23/01 Compute double torsional energy
6425 implicit real*8 (a-h,o-z)
6426 include 'DIMENSIONS'
6427 include 'DIMENSIONS.ZSCOPT'
6428 include 'COMMON.VAR'
6429 include 'COMMON.GEO'
6430 include 'COMMON.LOCAL'
6431 include 'COMMON.TORSION'
6432 include 'COMMON.INTERACT'
6433 include 'COMMON.DERIV'
6434 include 'COMMON.CHAIN'
6435 include 'COMMON.NAMES'
6436 include 'COMMON.IOUNITS'
6437 include 'COMMON.FFIELD'
6438 include 'COMMON.TORCNSTR'
6440 C Set lprn=.true. for debugging
6444 do i=iphi_start,iphi_end-1
6446 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6447 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
6448 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
6449 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
6450 & (itype(i+1).eq.ntyp1)) cycle
6451 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
6453 itori=itortyp(itype(i-2))
6454 itori1=itortyp(itype(i-1))
6455 itori2=itortyp(itype(i))
6461 if (iabs(itype(i+1)).eq.20) iblock=2
6462 C Regular cosine and sine terms
6463 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6464 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6465 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6466 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6467 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6468 cosphi1=dcos(j*phii)
6469 sinphi1=dsin(j*phii)
6470 cosphi2=dcos(j*phii1)
6471 sinphi2=dsin(j*phii1)
6472 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6473 & v2cij*cosphi2+v2sij*sinphi2
6474 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6475 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6477 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6479 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6480 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6481 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6482 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6483 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6484 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6485 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6486 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6487 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6488 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6489 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6490 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6491 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6492 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6495 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
6496 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
6502 c---------------------------------------------------------------------------
6503 C The rigorous attempt to derive energy function
6504 subroutine etor_kcc(etors,fact)
6505 implicit real*8 (a-h,o-z)
6506 include 'DIMENSIONS'
6507 include 'DIMENSIONS.ZSCOPT'
6508 include 'COMMON.VAR'
6509 include 'COMMON.GEO'
6510 include 'COMMON.LOCAL'
6511 include 'COMMON.TORSION'
6512 include 'COMMON.INTERACT'
6513 include 'COMMON.DERIV'
6514 include 'COMMON.CHAIN'
6515 include 'COMMON.NAMES'
6516 include 'COMMON.IOUNITS'
6517 include 'COMMON.FFIELD'
6518 include 'COMMON.TORCNSTR'
6519 include 'COMMON.CONTROL'
6520 double precision c1(0:maxval_kcc),c2(0:maxval_kcc)
6522 c double precision thybt1(maxtermkcc),thybt2(maxtermkcc)
6523 C Set lprn=.true. for debugging
6526 C print *,"wchodze kcc"
6527 if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode
6529 do i=iphi_start,iphi_end
6530 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6531 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6532 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6533 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6534 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6535 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6536 itori=itortyp(itype(i-2))
6537 itori1=itortyp(itype(i-1))
6542 C to avoid multiple devision by 2
6543 c theti22=0.5d0*theta(i)
6544 C theta 12 is the theta_1 /2
6545 C theta 22 is theta_2 /2
6546 c theti12=0.5d0*theta(i-1)
6547 C and appropriate sinus function
6548 sinthet1=dsin(theta(i-1))
6549 sinthet2=dsin(theta(i))
6550 costhet1=dcos(theta(i-1))
6551 costhet2=dcos(theta(i))
6552 C to speed up lets store its mutliplication
6553 sint1t2=sinthet2*sinthet1
6555 C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
6556 C +d_n*sin(n*gamma)) *
6557 C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
6558 C we have two sum 1) Non-Chebyshev which is with n and gamma
6559 nval=nterm_kcc_Tb(itori,itori1)
6565 c1(j)=c1(j-1)*costhet1
6566 c2(j)=c2(j-1)*costhet2
6569 do j=1,nterm_kcc(itori,itori1)
6573 sint1t2n=sint1t2n*sint1t2
6579 sumvalc=sumvalc+v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
6580 gradvalct1=gradvalct1+
6581 & (k-1)*v1_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
6582 gradvalct2=gradvalct2+
6583 & (l-1)*v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
6586 gradvalct1=-gradvalct1*sinthet1
6587 gradvalct2=-gradvalct2*sinthet2
6593 sumvals=sumvals+v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
6594 gradvalst1=gradvalst1+
6595 & (k-1)*v2_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
6596 gradvalst2=gradvalst2+
6597 & (l-1)*v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
6600 gradvalst1=-gradvalst1*sinthet1
6601 gradvalst2=-gradvalst2*sinthet2
6602 etori=etori+sint1t2n*(sumvalc*cosphi+sumvals*sinphi)
6603 C glocig is the gradient local i site in gamma
6604 glocig=glocig+j*sint1t2n*(sumvals*cosphi-sumvalc*sinphi)
6605 C now gradient over theta_1
6606 glocit1=glocit1+sint1t2n*(gradvalct1*cosphi+gradvalst1*sinphi)
6607 & +j*sint1t2n1*costhet1*sinthet2*(sumvalc*cosphi+sumvals*sinphi)
6608 glocit2=glocit2+sint1t2n*(gradvalct2*cosphi+gradvalst2*sinphi)
6609 & +j*sint1t2n1*sinthet1*costhet2*(sumvalc*cosphi+sumvals*sinphi)
6612 C derivative over gamma
6613 gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
6614 C derivative over theta1
6615 gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1
6616 C now derivative over theta2
6617 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2
6619 write (iout,*) i-2,i-1,itype(i-2),itype(i-1),itori,itori1,
6620 & theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori
6621 write (iout,*) "c1",(c1(k),k=0,nval),
6622 & " c2",(c2(k),k=0,nval)
6623 write (iout,*) "sumvalc",sumvalc," sumvals",sumvals
6628 c---------------------------------------------------------------------------------------------
6629 subroutine etor_constr(edihcnstr)
6630 implicit real*8 (a-h,o-z)
6631 include 'DIMENSIONS'
6632 include 'DIMENSIONS.ZSCOPT'
6633 include 'COMMON.VAR'
6634 include 'COMMON.GEO'
6635 include 'COMMON.LOCAL'
6636 include 'COMMON.TORSION'
6637 include 'COMMON.INTERACT'
6638 include 'COMMON.DERIV'
6639 include 'COMMON.CHAIN'
6640 include 'COMMON.NAMES'
6641 include 'COMMON.IOUNITS'
6642 include 'COMMON.FFIELD'
6643 include 'COMMON.TORCNSTR'
6644 include 'COMMON.CONTROL'
6645 ! 6/20/98 - dihedral angle constraints
6647 c do i=1,ndih_constr
6648 c write (iout,*) "idihconstr_start",idihconstr_start,
6649 c & " idihconstr_end",idihconstr_end
6651 if (raw_psipred) then
6652 do i=idihconstr_start,idihconstr_end
6653 itori=idih_constr(i)
6655 gaudih_i=vpsipred(1,i)
6659 cos_i=(1.0d0-dcos(phii-phibound(j,i)))/s**2
6660 dexpcos_i=dexp(-cos_i*cos_i)
6661 gaudih_i=gaudih_i+vpsipred(j+1,i)*dexpcos_i
6662 gauder_i=gauder_i-2*vpsipred(j+1,i)*dsin(phii-phibound(j,i))
6663 & *cos_i*dexpcos_i/s**2
6665 edihcnstr=edihcnstr-wdihc*dlog(gaudih_i)
6666 gloc(itori-3,icg)=gloc(itori-3,icg)-wdihc*gauder_i/gaudih_i
6668 & write (iout,'(2i5,f8.3,f8.5,2(f8.5,2f8.3),f10.5)')
6669 & i,itori,phii*rad2deg,vpsipred(1,i),vpsipred(2,i),
6670 & phibound(1,i)*rad2deg,sdihed(1,i)*rad2deg,vpsipred(3,i),
6671 & phibound(2,i)*rad2deg,sdihed(2,i)*rad2deg,
6672 & -wdihc*dlog(gaudih_i)
6676 do i=idihconstr_start,idihconstr_end
6677 itori=idih_constr(i)
6679 difi=pinorm(phii-phi0(i))
6680 if (difi.gt.drange(i)) then
6682 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6683 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6684 else if (difi.lt.-drange(i)) then
6686 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6687 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6695 c write (iout,*) "ETOR_CONSTR",edihcnstr
6698 c----------------------------------------------------------------------------
6699 C The rigorous attempt to derive energy function
6700 subroutine ebend_kcc(etheta)
6702 implicit real*8 (a-h,o-z)
6703 include 'DIMENSIONS'
6704 include 'DIMENSIONS.ZSCOPT'
6705 include 'COMMON.VAR'
6706 include 'COMMON.GEO'
6707 include 'COMMON.LOCAL'
6708 include 'COMMON.TORSION'
6709 include 'COMMON.INTERACT'
6710 include 'COMMON.DERIV'
6711 include 'COMMON.CHAIN'
6712 include 'COMMON.NAMES'
6713 include 'COMMON.IOUNITS'
6714 include 'COMMON.FFIELD'
6715 include 'COMMON.TORCNSTR'
6716 include 'COMMON.CONTROL'
6718 double precision thybt1(maxang_kcc)
6719 C Set lprn=.true. for debugging
6722 C print *,"wchodze kcc"
6723 if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
6725 do i=ithet_start,ithet_end
6726 c print *,i,itype(i-1),itype(i),itype(i-2)
6727 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6728 & .or.itype(i).eq.ntyp1) cycle
6729 iti=iabs(itortyp(itype(i-1)))
6730 sinthet=dsin(theta(i))
6731 costhet=dcos(theta(i))
6732 do j=1,nbend_kcc_Tb(iti)
6733 thybt1(j)=v1bend_chyb(j,iti)
6735 sumth1thyb=v1bend_chyb(0,iti)+
6736 & tschebyshev(1,nbend_kcc_Tb(iti),thybt1(1),costhet)
6737 if (lprn) write (iout,*) i-1,itype(i-1),iti,theta(i)*rad2deg,
6739 ihelp=nbend_kcc_Tb(iti)-1
6740 gradthybt1=gradtschebyshev(0,ihelp,thybt1(1),costhet)
6741 etheta=etheta+sumth1thyb
6742 C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
6743 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)-wang*gradthybt1*sinthet
6747 c-------------------------------------------------------------------------------------
6748 subroutine etheta_constr(ethetacnstr)
6750 implicit real*8 (a-h,o-z)
6751 include 'DIMENSIONS'
6752 include 'DIMENSIONS.ZSCOPT'
6753 include 'COMMON.VAR'
6754 include 'COMMON.GEO'
6755 include 'COMMON.LOCAL'
6756 include 'COMMON.TORSION'
6757 include 'COMMON.INTERACT'
6758 include 'COMMON.DERIV'
6759 include 'COMMON.CHAIN'
6760 include 'COMMON.NAMES'
6761 include 'COMMON.IOUNITS'
6762 include 'COMMON.FFIELD'
6763 include 'COMMON.TORCNSTR'
6764 include 'COMMON.CONTROL'
6766 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6767 do i=ithetaconstr_start,ithetaconstr_end
6768 itheta=itheta_constr(i)
6769 thetiii=theta(itheta)
6770 difi=pinorm(thetiii-theta_constr0(i))
6771 if (difi.gt.theta_drange(i)) then
6772 difi=difi-theta_drange(i)
6773 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6774 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6775 & +for_thet_constr(i)*difi**3
6776 else if (difi.lt.-drange(i)) then
6778 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6779 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6780 & +for_thet_constr(i)*difi**3
6784 if (energy_dec) then
6785 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6786 & i,itheta,rad2deg*thetiii,
6787 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6788 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6789 & gloc(itheta+nphi-2,icg)
6794 c------------------------------------------------------------------------------
6795 c------------------------------------------------------------------------------
6796 subroutine eback_sc_corr(esccor)
6797 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6798 c conformational states; temporarily implemented as differences
6799 c between UNRES torsional potentials (dependent on three types of
6800 c residues) and the torsional potentials dependent on all 20 types
6801 c of residues computed from AM1 energy surfaces of terminally-blocked
6802 c amino-acid residues.
6803 implicit real*8 (a-h,o-z)
6804 include 'DIMENSIONS'
6805 include 'DIMENSIONS.ZSCOPT'
6806 include 'COMMON.VAR'
6807 include 'COMMON.GEO'
6808 include 'COMMON.LOCAL'
6809 include 'COMMON.TORSION'
6810 include 'COMMON.SCCOR'
6811 include 'COMMON.INTERACT'
6812 include 'COMMON.DERIV'
6813 include 'COMMON.CHAIN'
6814 include 'COMMON.NAMES'
6815 include 'COMMON.IOUNITS'
6816 include 'COMMON.FFIELD'
6817 include 'COMMON.CONTROL'
6819 C Set lprn=.true. for debugging
6822 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
6824 do i=itau_start,itau_end
6825 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6827 isccori=isccortyp(itype(i-2))
6828 isccori1=isccortyp(itype(i-1))
6830 do intertyp=1,3 !intertyp
6831 cc Added 09 May 2012 (Adasko)
6832 cc Intertyp means interaction type of backbone mainchain correlation:
6833 c 1 = SC...Ca...Ca...Ca
6834 c 2 = Ca...Ca...Ca...SC
6835 c 3 = SC...Ca...Ca...SCi
6837 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6838 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6839 & (itype(i-1).eq.ntyp1)))
6840 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6841 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6842 & .or.(itype(i).eq.ntyp1)))
6843 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6844 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6845 & (itype(i-3).eq.ntyp1)))) cycle
6846 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6847 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6849 do j=1,nterm_sccor(isccori,isccori1)
6850 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6851 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6852 cosphi=dcos(j*tauangle(intertyp,i))
6853 sinphi=dsin(j*tauangle(intertyp,i))
6854 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6855 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6857 C write (iout,*)"EBACK_SC_COR",esccor,i
6858 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
6859 c & nterm_sccor(isccori,isccori1),isccori,isccori1
6860 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6862 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6863 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6864 & (v1sccor(j,1,itori,itori1),j=1,6)
6865 & ,(v2sccor(j,1,itori,itori1),j=1,6)
6866 c gsccor_loc(i-3)=gloci
6872 c------------------------------------------------------------------------------
6873 subroutine multibody(ecorr)
6874 C This subroutine calculates multi-body contributions to energy following
6875 C the idea of Skolnick et al. If side chains I and J make a contact and
6876 C at the same time side chains I+1 and J+1 make a contact, an extra
6877 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6878 implicit real*8 (a-h,o-z)
6879 include 'DIMENSIONS'
6880 include 'COMMON.IOUNITS'
6881 include 'COMMON.DERIV'
6882 include 'COMMON.INTERACT'
6883 include 'COMMON.CONTACTS'
6884 include 'COMMON.CONTMAT'
6885 include 'COMMON.CORRMAT'
6886 double precision gx(3),gx1(3)
6889 C Set lprn=.true. for debugging
6893 write (iout,'(a)') 'Contact function values:'
6895 write (iout,'(i2,20(1x,i2,f10.5))')
6896 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6911 num_conti=num_cont(i)
6912 num_conti1=num_cont(i1)
6917 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6918 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6919 cd & ' ishift=',ishift
6920 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6921 C The system gains extra energy.
6922 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6923 endif ! j1==j+-ishift
6932 c------------------------------------------------------------------------------
6933 double precision function esccorr(i,j,k,l,jj,kk)
6934 implicit real*8 (a-h,o-z)
6935 include 'DIMENSIONS'
6936 include 'COMMON.IOUNITS'
6937 include 'COMMON.DERIV'
6938 include 'COMMON.INTERACT'
6939 include 'COMMON.CONTACTS'
6940 include 'COMMON.CONTMAT'
6941 include 'COMMON.CORRMAT'
6942 double precision gx(3),gx1(3)
6947 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6948 C Calculate the multi-body contribution to energy.
6949 C Calculate multi-body contributions to the gradient.
6950 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6951 cd & k,l,(gacont(m,kk,k),m=1,3)
6953 gx(m) =ekl*gacont(m,jj,i)
6954 gx1(m)=eij*gacont(m,kk,k)
6955 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6956 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6957 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6958 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6962 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6967 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6973 c------------------------------------------------------------------------------
6974 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6975 C This subroutine calculates multi-body contributions to hydrogen-bonding
6976 implicit real*8 (a-h,o-z)
6977 include 'DIMENSIONS'
6978 include 'DIMENSIONS.ZSCOPT'
6979 include 'COMMON.IOUNITS'
6980 include 'COMMON.FFIELD'
6981 include 'COMMON.DERIV'
6982 include 'COMMON.INTERACT'
6983 include 'COMMON.CONTACTS'
6984 include 'COMMON.CONTMAT'
6985 include 'COMMON.CORRMAT'
6986 double precision gx(3),gx1(3)
6989 C Set lprn=.true. for debugging
6992 write (iout,'(a)') 'Contact function values:'
6994 write (iout,'(2i3,50(1x,i2,f5.2))')
6995 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6996 & j=1,num_cont_hb(i))
7000 C Remove the loop below after debugging !!!
7007 C Calculate the local-electrostatic correlation terms
7008 do i=iatel_s,iatel_e+1
7010 num_conti=num_cont_hb(i)
7011 num_conti1=num_cont_hb(i+1)
7016 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7017 c & ' jj=',jj,' kk=',kk
7018 if (j1.eq.j+1 .or. j1.eq.j-1) then
7019 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7020 C The system gains extra energy.
7021 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7023 else if (j1.eq.j) then
7024 C Contacts I-J and I-(J+1) occur simultaneously.
7025 C The system loses extra energy.
7026 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7031 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7032 c & ' jj=',jj,' kk=',kk
7034 C Contacts I-J and (I+1)-J occur simultaneously.
7035 C The system loses extra energy.
7036 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7043 c------------------------------------------------------------------------------
7044 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
7046 C This subroutine calculates multi-body contributions to hydrogen-bonding
7047 implicit real*8 (a-h,o-z)
7048 include 'DIMENSIONS'
7049 include 'DIMENSIONS.ZSCOPT'
7050 include 'COMMON.IOUNITS'
7054 include 'COMMON.FFIELD'
7055 include 'COMMON.DERIV'
7056 include 'COMMON.LOCAL'
7057 include 'COMMON.INTERACT'
7058 include 'COMMON.CONTACTS'
7059 include 'COMMON.CONTMAT'
7060 include 'COMMON.CORRMAT'
7061 include 'COMMON.CHAIN'
7062 include 'COMMON.CONTROL'
7063 include 'COMMON.SHIELD'
7064 double precision gx(3),gx1(3)
7065 integer num_cont_hb_old(maxres)
7067 double precision eello4,eello5,eelo6,eello_turn6
7068 external eello4,eello5,eello6,eello_turn6
7069 C Set lprn=.true. for debugging
7073 write (iout,'(a)') 'Contact function values:'
7075 write (iout,'(2i3,50(1x,i2,5f6.3))')
7076 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7077 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7083 C Remove the loop below after debugging !!!
7090 C Calculate the dipole-dipole interaction energies
7091 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7092 do i=iatel_s,iatel_e+1
7093 num_conti=num_cont_hb(i)
7102 C Calculate the local-electrostatic correlation terms
7103 c write (iout,*) "gradcorr5 in eello5 before loop"
7105 c write (iout,'(i5,3f10.5)')
7106 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7108 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7109 c write (iout,*) "corr loop i",i
7111 num_conti=num_cont_hb(i)
7112 num_conti1=num_cont_hb(i+1)
7119 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7120 c & ' jj=',jj,' kk=',kk
7121 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7122 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7123 & .or. j.lt.0 .and. j1.gt.0) .and.
7124 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7125 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7126 C The system gains extra energy.
7128 sqd1=dsqrt(d_cont(jj,i))
7129 sqd2=dsqrt(d_cont(kk,i1))
7130 sred_geom = sqd1*sqd2
7131 IF (sred_geom.lt.cutoff_corr) THEN
7132 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7134 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7135 cd & ' jj=',jj,' kk=',kk
7136 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7137 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7139 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7140 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7143 cd write (iout,*) 'sred_geom=',sred_geom,
7144 cd & ' ekont=',ekont,' fprim=',fprimcont,
7145 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7146 cd write (iout,*) "g_contij",g_contij
7147 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7148 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7149 call calc_eello(i,jp,i+1,jp1,jj,kk)
7150 if (wcorr4.gt.0.0d0)
7151 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7152 CC & *fac_shield(i)**2*fac_shield(j)**2
7153 if (energy_dec.and.wcorr4.gt.0.0d0)
7154 1 write (iout,'(a6,4i5,0pf7.3)')
7155 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7156 c write (iout,*) "gradcorr5 before eello5"
7158 c write (iout,'(i5,3f10.5)')
7159 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7161 if (wcorr5.gt.0.0d0)
7162 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7163 c write (iout,*) "gradcorr5 after eello5"
7165 c write (iout,'(i5,3f10.5)')
7166 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7168 if (energy_dec.and.wcorr5.gt.0.0d0)
7169 1 write (iout,'(a6,4i5,0pf7.3)')
7170 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7171 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7172 cd write(2,*)'ijkl',i,jp,i+1,jp1
7173 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7174 & .or. wturn6.eq.0.0d0))then
7175 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7176 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7177 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7178 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7179 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7180 cd & 'ecorr6=',ecorr6
7181 cd write (iout,'(4e15.5)') sred_geom,
7182 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7183 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7184 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7185 else if (wturn6.gt.0.0d0
7186 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7187 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7188 eturn6=eturn6+eello_turn6(i,jj,kk)
7189 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7190 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7191 cd write (2,*) 'multibody_eello:eturn6',eturn6
7200 num_cont_hb(i)=num_cont_hb_old(i)
7202 c write (iout,*) "gradcorr5 in eello5"
7204 c write (iout,'(i5,3f10.5)')
7205 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7209 c------------------------------------------------------------------------------
7210 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7211 implicit real*8 (a-h,o-z)
7212 include 'DIMENSIONS'
7213 include 'DIMENSIONS.ZSCOPT'
7214 include 'COMMON.IOUNITS'
7215 include 'COMMON.DERIV'
7216 include 'COMMON.INTERACT'
7217 include 'COMMON.CONTACTS'
7218 include 'COMMON.CONTMAT'
7219 include 'COMMON.CORRMAT'
7220 include 'COMMON.SHIELD'
7221 include 'COMMON.CONTROL'
7222 double precision gx(3),gx1(3)
7225 C print *,"wchodze",fac_shield(i),shield_mode
7233 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7235 C & fac_shield(i)**2*fac_shield(j)**2
7236 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7237 C Following 4 lines for diagnostics.
7242 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7243 c & 'Contacts ',i,j,
7244 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7245 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7247 C Calculate the multi-body contribution to energy.
7248 C ecorr=ecorr+ekont*ees
7249 C Calculate multi-body contributions to the gradient.
7250 coeffpees0pij=coeffp*ees0pij
7251 coeffmees0mij=coeffm*ees0mij
7252 coeffpees0pkl=coeffp*ees0pkl
7253 coeffmees0mkl=coeffm*ees0mkl
7255 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7256 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7257 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7258 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7259 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7260 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7261 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7262 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7263 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7264 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7265 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7266 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7267 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7268 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7269 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7270 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7271 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7272 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7273 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7274 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7275 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7276 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7277 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7278 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7279 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7284 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7285 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7286 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7287 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7292 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7293 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7294 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7295 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7298 c write (iout,*) "ehbcorr",ekont*ees
7299 C print *,ekont,ees,i,k
7301 C now gradient over shielding
7303 if (shield_mode.gt.0) then
7306 C print *,i,j,fac_shield(i),fac_shield(j),
7307 C &fac_shield(k),fac_shield(l)
7308 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
7309 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
7310 do ilist=1,ishield_list(i)
7311 iresshield=shield_list(ilist,i)
7313 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
7315 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
7317 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
7318 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
7322 do ilist=1,ishield_list(j)
7323 iresshield=shield_list(ilist,j)
7325 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
7327 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
7329 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
7330 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
7335 do ilist=1,ishield_list(k)
7336 iresshield=shield_list(ilist,k)
7338 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
7340 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
7342 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
7343 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
7347 do ilist=1,ishield_list(l)
7348 iresshield=shield_list(ilist,l)
7350 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
7352 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
7354 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
7355 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
7359 C print *,gshieldx(m,iresshield)
7361 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
7362 & grad_shield(m,i)*ehbcorr/fac_shield(i)
7363 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
7364 & grad_shield(m,j)*ehbcorr/fac_shield(j)
7365 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
7366 & grad_shield(m,i)*ehbcorr/fac_shield(i)
7367 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
7368 & grad_shield(m,j)*ehbcorr/fac_shield(j)
7370 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
7371 & grad_shield(m,k)*ehbcorr/fac_shield(k)
7372 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
7373 & grad_shield(m,l)*ehbcorr/fac_shield(l)
7374 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
7375 & grad_shield(m,k)*ehbcorr/fac_shield(k)
7376 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
7377 & grad_shield(m,l)*ehbcorr/fac_shield(l)
7385 C---------------------------------------------------------------------------
7386 subroutine dipole(i,j,jj)
7387 implicit real*8 (a-h,o-z)
7388 include 'DIMENSIONS'
7389 include 'DIMENSIONS.ZSCOPT'
7390 include 'COMMON.IOUNITS'
7391 include 'COMMON.CHAIN'
7392 include 'COMMON.FFIELD'
7393 include 'COMMON.DERIV'
7394 include 'COMMON.INTERACT'
7395 include 'COMMON.CONTACTS'
7396 include 'COMMON.CONTMAT'
7397 include 'COMMON.CORRMAT'
7398 include 'COMMON.TORSION'
7399 include 'COMMON.VAR'
7400 include 'COMMON.GEO'
7401 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7403 iti1 = itortyp(itype(i+1))
7404 if (j.lt.nres-1) then
7405 itj1 = itype2loc(itype(j+1))
7410 dipi(iii,1)=Ub2(iii,i)
7411 dipderi(iii)=Ub2der(iii,i)
7412 dipi(iii,2)=b1(iii,i+1)
7413 dipj(iii,1)=Ub2(iii,j)
7414 dipderj(iii)=Ub2der(iii,j)
7415 dipj(iii,2)=b1(iii,j+1)
7419 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7422 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7429 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7433 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7438 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7439 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7441 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7443 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7445 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7450 C---------------------------------------------------------------------------
7451 subroutine calc_eello(i,j,k,l,jj,kk)
7453 C This subroutine computes matrices and vectors needed to calculate
7454 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7456 implicit real*8 (a-h,o-z)
7457 include 'DIMENSIONS'
7458 include 'DIMENSIONS.ZSCOPT'
7459 include 'COMMON.IOUNITS'
7460 include 'COMMON.CHAIN'
7461 include 'COMMON.DERIV'
7462 include 'COMMON.INTERACT'
7463 include 'COMMON.CONTACTS'
7464 include 'COMMON.CONTMAT'
7465 include 'COMMON.CORRMAT'
7466 include 'COMMON.TORSION'
7467 include 'COMMON.VAR'
7468 include 'COMMON.GEO'
7469 include 'COMMON.FFIELD'
7470 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7471 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7474 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7475 cd & ' jj=',jj,' kk=',kk
7476 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7477 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7478 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7481 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7482 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7485 call transpose2(aa1(1,1),aa1t(1,1))
7486 call transpose2(aa2(1,1),aa2t(1,1))
7489 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7490 & aa1tder(1,1,lll,kkk))
7491 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7492 & aa2tder(1,1,lll,kkk))
7496 C parallel orientation of the two CA-CA-CA frames.
7498 iti=itype2loc(itype(i))
7502 itk1=itype2loc(itype(k+1))
7503 itj=itype2loc(itype(j))
7504 if (l.lt.nres-1) then
7505 itl1=itype2loc(itype(l+1))
7509 C A1 kernel(j+1) A2T
7511 cd write (iout,'(3f10.5,5x,3f10.5)')
7512 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7514 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7515 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7516 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7517 C Following matrices are needed only for 6-th order cumulants
7518 IF (wcorr6.gt.0.0d0) THEN
7519 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7520 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7521 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7522 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7523 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7524 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7525 & ADtEAderx(1,1,1,1,1,1))
7527 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7528 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7529 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7530 & ADtEA1derx(1,1,1,1,1,1))
7532 C End 6-th order cumulants
7535 cd write (2,*) 'In calc_eello6'
7537 cd write (2,*) 'iii=',iii
7539 cd write (2,*) 'kkk=',kkk
7541 cd write (2,'(3(2f10.5),5x)')
7542 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7547 call transpose2(EUgder(1,1,k),auxmat(1,1))
7548 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7549 call transpose2(EUg(1,1,k),auxmat(1,1))
7550 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7551 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7555 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7556 & EAEAderx(1,1,lll,kkk,iii,1))
7560 C A1T kernel(i+1) A2
7561 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7562 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7563 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7564 C Following matrices are needed only for 6-th order cumulants
7565 IF (wcorr6.gt.0.0d0) THEN
7566 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7567 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7568 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7569 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7570 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7571 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7572 & ADtEAderx(1,1,1,1,1,2))
7573 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7574 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7575 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7576 & ADtEA1derx(1,1,1,1,1,2))
7578 C End 6-th order cumulants
7579 call transpose2(EUgder(1,1,l),auxmat(1,1))
7580 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7581 call transpose2(EUg(1,1,l),auxmat(1,1))
7582 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7583 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7587 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7588 & EAEAderx(1,1,lll,kkk,iii,2))
7593 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7594 C They are needed only when the fifth- or the sixth-order cumulants are
7596 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7597 call transpose2(AEA(1,1,1),auxmat(1,1))
7598 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7599 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7600 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7601 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7602 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7603 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7604 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7605 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7606 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7607 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7608 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7609 call transpose2(AEA(1,1,2),auxmat(1,1))
7610 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
7611 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7612 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7613 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7614 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
7615 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7616 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
7617 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
7618 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7619 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7620 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7621 C Calculate the Cartesian derivatives of the vectors.
7625 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7626 call matvec2(auxmat(1,1),b1(1,i),
7627 & AEAb1derx(1,lll,kkk,iii,1,1))
7628 call matvec2(auxmat(1,1),Ub2(1,i),
7629 & AEAb2derx(1,lll,kkk,iii,1,1))
7630 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7631 & AEAb1derx(1,lll,kkk,iii,2,1))
7632 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7633 & AEAb2derx(1,lll,kkk,iii,2,1))
7634 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7635 call matvec2(auxmat(1,1),b1(1,j),
7636 & AEAb1derx(1,lll,kkk,iii,1,2))
7637 call matvec2(auxmat(1,1),Ub2(1,j),
7638 & AEAb2derx(1,lll,kkk,iii,1,2))
7639 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
7640 & AEAb1derx(1,lll,kkk,iii,2,2))
7641 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7642 & AEAb2derx(1,lll,kkk,iii,2,2))
7649 C Antiparallel orientation of the two CA-CA-CA frames.
7651 iti=itype2loc(itype(i))
7655 itk1=itype2loc(itype(k+1))
7656 itl=itype2loc(itype(l))
7657 itj=itype2loc(itype(j))
7658 if (j.lt.nres-1) then
7659 itj1=itype2loc(itype(j+1))
7663 C A2 kernel(j-1)T A1T
7664 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7665 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7666 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7667 C Following matrices are needed only for 6-th order cumulants
7668 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7669 & j.eq.i+4 .and. l.eq.i+3)) THEN
7670 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7671 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7672 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7673 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7674 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7675 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7676 & ADtEAderx(1,1,1,1,1,1))
7677 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7678 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7679 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7680 & ADtEA1derx(1,1,1,1,1,1))
7682 C End 6-th order cumulants
7683 call transpose2(EUgder(1,1,k),auxmat(1,1))
7684 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7685 call transpose2(EUg(1,1,k),auxmat(1,1))
7686 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7687 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7691 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7692 & EAEAderx(1,1,lll,kkk,iii,1))
7696 C A2T kernel(i+1)T A1
7697 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7698 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7699 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7700 C Following matrices are needed only for 6-th order cumulants
7701 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7702 & j.eq.i+4 .and. l.eq.i+3)) THEN
7703 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7704 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7705 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7706 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7707 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7708 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7709 & ADtEAderx(1,1,1,1,1,2))
7710 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7711 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7712 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7713 & ADtEA1derx(1,1,1,1,1,2))
7715 C End 6-th order cumulants
7716 call transpose2(EUgder(1,1,j),auxmat(1,1))
7717 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7718 call transpose2(EUg(1,1,j),auxmat(1,1))
7719 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7720 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7724 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7725 & EAEAderx(1,1,lll,kkk,iii,2))
7730 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7731 C They are needed only when the fifth- or the sixth-order cumulants are
7733 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7734 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7735 call transpose2(AEA(1,1,1),auxmat(1,1))
7736 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7737 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7738 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7739 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7740 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7741 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7742 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7743 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7744 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7745 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7746 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7747 call transpose2(AEA(1,1,2),auxmat(1,1))
7748 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
7749 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7750 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7751 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7752 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
7753 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7754 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
7755 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
7756 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7757 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7758 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7759 C Calculate the Cartesian derivatives of the vectors.
7763 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7764 call matvec2(auxmat(1,1),b1(1,i),
7765 & AEAb1derx(1,lll,kkk,iii,1,1))
7766 call matvec2(auxmat(1,1),Ub2(1,i),
7767 & AEAb2derx(1,lll,kkk,iii,1,1))
7768 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7769 & AEAb1derx(1,lll,kkk,iii,2,1))
7770 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7771 & AEAb2derx(1,lll,kkk,iii,2,1))
7772 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7773 call matvec2(auxmat(1,1),b1(1,l),
7774 & AEAb1derx(1,lll,kkk,iii,1,2))
7775 call matvec2(auxmat(1,1),Ub2(1,l),
7776 & AEAb2derx(1,lll,kkk,iii,1,2))
7777 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
7778 & AEAb1derx(1,lll,kkk,iii,2,2))
7779 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7780 & AEAb2derx(1,lll,kkk,iii,2,2))
7789 C---------------------------------------------------------------------------
7790 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7791 & KK,KKderg,AKA,AKAderg,AKAderx)
7795 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7796 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7797 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7802 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7804 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7807 cd if (lprn) write (2,*) 'In kernel'
7809 cd if (lprn) write (2,*) 'kkk=',kkk
7811 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7812 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7814 cd write (2,*) 'lll=',lll
7815 cd write (2,*) 'iii=1'
7817 cd write (2,'(3(2f10.5),5x)')
7818 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7821 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7822 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7824 cd write (2,*) 'lll=',lll
7825 cd write (2,*) 'iii=2'
7827 cd write (2,'(3(2f10.5),5x)')
7828 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7835 C---------------------------------------------------------------------------
7836 double precision function eello4(i,j,k,l,jj,kk)
7837 implicit real*8 (a-h,o-z)
7838 include 'DIMENSIONS'
7839 include 'DIMENSIONS.ZSCOPT'
7840 include 'COMMON.IOUNITS'
7841 include 'COMMON.CHAIN'
7842 include 'COMMON.DERIV'
7843 include 'COMMON.INTERACT'
7844 include 'COMMON.CONTACTS'
7845 include 'COMMON.CONTMAT'
7846 include 'COMMON.CORRMAT'
7847 include 'COMMON.TORSION'
7848 include 'COMMON.VAR'
7849 include 'COMMON.GEO'
7850 double precision pizda(2,2),ggg1(3),ggg2(3)
7851 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7855 cd print *,'eello4:',i,j,k,l,jj,kk
7856 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7857 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7858 cold eij=facont_hb(jj,i)
7859 cold ekl=facont_hb(kk,k)
7861 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7863 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7864 gcorr_loc(k-1)=gcorr_loc(k-1)
7865 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7867 gcorr_loc(l-1)=gcorr_loc(l-1)
7868 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7870 gcorr_loc(j-1)=gcorr_loc(j-1)
7871 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7876 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7877 & -EAEAderx(2,2,lll,kkk,iii,1)
7878 cd derx(lll,kkk,iii)=0.0d0
7882 cd gcorr_loc(l-1)=0.0d0
7883 cd gcorr_loc(j-1)=0.0d0
7884 cd gcorr_loc(k-1)=0.0d0
7886 cd write (iout,*)'Contacts have occurred for peptide groups',
7887 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7888 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7889 if (j.lt.nres-1) then
7896 if (l.lt.nres-1) then
7904 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7905 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7906 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7907 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7908 cgrad ghalf=0.5d0*ggg1(ll)
7909 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7910 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7911 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7912 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7913 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7914 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7915 cgrad ghalf=0.5d0*ggg2(ll)
7916 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7917 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7918 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7919 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7920 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7921 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7925 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7930 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7935 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7940 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7944 cd write (2,*) iii,gcorr_loc(iii)
7948 cd write (2,*) 'ekont',ekont
7949 cd write (iout,*) 'eello4',ekont*eel4
7952 C---------------------------------------------------------------------------
7953 double precision function eello5(i,j,k,l,jj,kk)
7954 implicit real*8 (a-h,o-z)
7955 include 'DIMENSIONS'
7956 include 'DIMENSIONS.ZSCOPT'
7957 include 'COMMON.IOUNITS'
7958 include 'COMMON.CHAIN'
7959 include 'COMMON.DERIV'
7960 include 'COMMON.INTERACT'
7961 include 'COMMON.CONTACTS'
7962 include 'COMMON.CONTMAT'
7963 include 'COMMON.CORRMAT'
7964 include 'COMMON.TORSION'
7965 include 'COMMON.VAR'
7966 include 'COMMON.GEO'
7967 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7968 double precision ggg1(3),ggg2(3)
7969 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7974 C /l\ / \ \ / \ / \ / C
7975 C / \ / \ \ / \ / \ / C
7976 C j| o |l1 | o | o| o | | o |o C
7977 C \ |/k\| |/ \| / |/ \| |/ \| C
7978 C \i/ \ / \ / / \ / \ C
7980 C (I) (II) (III) (IV) C
7982 C eello5_1 eello5_2 eello5_3 eello5_4 C
7984 C Antiparallel chains C
7987 C /j\ / \ \ / \ / \ / C
7988 C / \ / \ \ / \ / \ / C
7989 C j1| o |l | o | o| o | | o |o C
7990 C \ |/k\| |/ \| / |/ \| |/ \| C
7991 C \i/ \ / \ / / \ / \ C
7993 C (I) (II) (III) (IV) C
7995 C eello5_1 eello5_2 eello5_3 eello5_4 C
7997 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7999 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8000 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8005 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8007 itk=itype2loc(itype(k))
8008 itl=itype2loc(itype(l))
8009 itj=itype2loc(itype(j))
8014 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8015 cd & eel5_3_num,eel5_4_num)
8019 derx(lll,kkk,iii)=0.0d0
8023 cd eij=facont_hb(jj,i)
8024 cd ekl=facont_hb(kk,k)
8026 cd write (iout,*)'Contacts have occurred for peptide groups',
8027 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8029 C Contribution from the graph I.
8030 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8031 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8032 call transpose2(EUg(1,1,k),auxmat(1,1))
8033 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8034 vv(1)=pizda(1,1)-pizda(2,2)
8035 vv(2)=pizda(1,2)+pizda(2,1)
8036 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8037 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8039 C Explicit gradient in virtual-dihedral angles.
8040 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8041 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8042 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8043 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8044 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8045 vv(1)=pizda(1,1)-pizda(2,2)
8046 vv(2)=pizda(1,2)+pizda(2,1)
8047 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8048 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8049 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8050 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8051 vv(1)=pizda(1,1)-pizda(2,2)
8052 vv(2)=pizda(1,2)+pizda(2,1)
8054 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8055 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8056 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8058 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8059 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8060 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8062 C Cartesian gradient
8066 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8068 vv(1)=pizda(1,1)-pizda(2,2)
8069 vv(2)=pizda(1,2)+pizda(2,1)
8070 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8071 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8072 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8079 C Contribution from graph II
8080 call transpose2(EE(1,1,k),auxmat(1,1))
8081 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8082 vv(1)=pizda(1,1)+pizda(2,2)
8083 vv(2)=pizda(2,1)-pizda(1,2)
8084 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
8085 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8087 C Explicit gradient in virtual-dihedral angles.
8088 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8089 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8090 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8091 vv(1)=pizda(1,1)+pizda(2,2)
8092 vv(2)=pizda(2,1)-pizda(1,2)
8094 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8095 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8096 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8098 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8099 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8100 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8102 C Cartesian gradient
8106 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8108 vv(1)=pizda(1,1)+pizda(2,2)
8109 vv(2)=pizda(2,1)-pizda(1,2)
8110 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8111 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
8112 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8121 C Parallel orientation
8122 C Contribution from graph III
8123 call transpose2(EUg(1,1,l),auxmat(1,1))
8124 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8125 vv(1)=pizda(1,1)-pizda(2,2)
8126 vv(2)=pizda(1,2)+pizda(2,1)
8127 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8128 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8130 C Explicit gradient in virtual-dihedral angles.
8131 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8132 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8133 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8134 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8135 vv(1)=pizda(1,1)-pizda(2,2)
8136 vv(2)=pizda(1,2)+pizda(2,1)
8137 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8138 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8139 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8140 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8141 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8142 vv(1)=pizda(1,1)-pizda(2,2)
8143 vv(2)=pizda(1,2)+pizda(2,1)
8144 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8145 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8146 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8147 C Cartesian gradient
8151 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8153 vv(1)=pizda(1,1)-pizda(2,2)
8154 vv(2)=pizda(1,2)+pizda(2,1)
8155 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8156 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8157 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8162 C Contribution from graph IV
8164 call transpose2(EE(1,1,l),auxmat(1,1))
8165 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8166 vv(1)=pizda(1,1)+pizda(2,2)
8167 vv(2)=pizda(2,1)-pizda(1,2)
8168 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
8169 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8170 C Explicit gradient in virtual-dihedral angles.
8171 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8172 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8173 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8174 vv(1)=pizda(1,1)+pizda(2,2)
8175 vv(2)=pizda(2,1)-pizda(1,2)
8176 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8177 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
8178 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8179 C Cartesian gradient
8183 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8185 vv(1)=pizda(1,1)+pizda(2,2)
8186 vv(2)=pizda(2,1)-pizda(1,2)
8187 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8188 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
8189 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8195 C Antiparallel orientation
8196 C Contribution from graph III
8198 call transpose2(EUg(1,1,j),auxmat(1,1))
8199 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8200 vv(1)=pizda(1,1)-pizda(2,2)
8201 vv(2)=pizda(1,2)+pizda(2,1)
8202 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8203 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8205 C Explicit gradient in virtual-dihedral angles.
8206 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8207 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8208 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8209 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8210 vv(1)=pizda(1,1)-pizda(2,2)
8211 vv(2)=pizda(1,2)+pizda(2,1)
8212 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8213 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8214 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8215 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8216 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8217 vv(1)=pizda(1,1)-pizda(2,2)
8218 vv(2)=pizda(1,2)+pizda(2,1)
8219 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8220 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8221 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8222 C Cartesian gradient
8226 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8228 vv(1)=pizda(1,1)-pizda(2,2)
8229 vv(2)=pizda(1,2)+pizda(2,1)
8230 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8231 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8232 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8238 C Contribution from graph IV
8240 call transpose2(EE(1,1,j),auxmat(1,1))
8241 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8242 vv(1)=pizda(1,1)+pizda(2,2)
8243 vv(2)=pizda(2,1)-pizda(1,2)
8244 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
8245 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8247 C Explicit gradient in virtual-dihedral angles.
8248 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8249 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8250 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8251 vv(1)=pizda(1,1)+pizda(2,2)
8252 vv(2)=pizda(2,1)-pizda(1,2)
8253 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8254 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
8255 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8256 C Cartesian gradient
8260 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8262 vv(1)=pizda(1,1)+pizda(2,2)
8263 vv(2)=pizda(2,1)-pizda(1,2)
8264 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8265 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
8266 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8273 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8274 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8275 cd write (2,*) 'ijkl',i,j,k,l
8276 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8277 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8279 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8280 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8281 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8282 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8284 if (j.lt.nres-1) then
8291 if (l.lt.nres-1) then
8301 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8302 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8303 C summed up outside the subrouine as for the other subroutines
8304 C handling long-range interactions. The old code is commented out
8305 C with "cgrad" to keep track of changes.
8307 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8308 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8309 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8310 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8311 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8312 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8313 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8314 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8315 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8316 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8318 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8319 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8320 cgrad ghalf=0.5d0*ggg1(ll)
8322 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8323 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8324 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8325 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8326 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8327 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8328 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8329 cgrad ghalf=0.5d0*ggg2(ll)
8331 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
8332 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8333 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
8334 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8335 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8336 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8342 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8343 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8348 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8349 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8355 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8360 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8364 cd write (2,*) iii,g_corr5_loc(iii)
8367 cd write (2,*) 'ekont',ekont
8368 cd write (iout,*) 'eello5',ekont*eel5
8371 c--------------------------------------------------------------------------
8372 double precision function eello6(i,j,k,l,jj,kk)
8373 implicit real*8 (a-h,o-z)
8374 include 'DIMENSIONS'
8375 include 'DIMENSIONS.ZSCOPT'
8376 include 'COMMON.IOUNITS'
8377 include 'COMMON.CHAIN'
8378 include 'COMMON.DERIV'
8379 include 'COMMON.INTERACT'
8380 include 'COMMON.CONTACTS'
8381 include 'COMMON.CONTMAT'
8382 include 'COMMON.CORRMAT'
8383 include 'COMMON.TORSION'
8384 include 'COMMON.VAR'
8385 include 'COMMON.GEO'
8386 include 'COMMON.FFIELD'
8387 double precision ggg1(3),ggg2(3)
8388 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8393 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8401 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8402 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8406 derx(lll,kkk,iii)=0.0d0
8410 cd eij=facont_hb(jj,i)
8411 cd ekl=facont_hb(kk,k)
8417 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8418 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8419 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8420 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8421 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8422 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8424 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8425 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8426 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8427 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8428 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8429 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8433 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8435 C If turn contributions are considered, they will be handled separately.
8436 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8437 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8438 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8439 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8440 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8441 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8442 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8445 if (j.lt.nres-1) then
8452 if (l.lt.nres-1) then
8460 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8461 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8462 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8463 cgrad ghalf=0.5d0*ggg1(ll)
8465 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8466 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8467 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8468 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8469 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8470 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8471 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8472 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8473 cgrad ghalf=0.5d0*ggg2(ll)
8474 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8476 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8477 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8478 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8479 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8480 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8481 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8487 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8488 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8493 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8494 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8500 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8505 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8509 cd write (2,*) iii,g_corr6_loc(iii)
8512 cd write (2,*) 'ekont',ekont
8513 cd write (iout,*) 'eello6',ekont*eel6
8516 c--------------------------------------------------------------------------
8517 double precision function eello6_graph1(i,j,k,l,imat,swap)
8518 implicit real*8 (a-h,o-z)
8519 include 'DIMENSIONS'
8520 include 'DIMENSIONS.ZSCOPT'
8521 include 'COMMON.IOUNITS'
8522 include 'COMMON.CHAIN'
8523 include 'COMMON.DERIV'
8524 include 'COMMON.INTERACT'
8525 include 'COMMON.CONTACTS'
8526 include 'COMMON.CONTMAT'
8527 include 'COMMON.CORRMAT'
8528 include 'COMMON.TORSION'
8529 include 'COMMON.VAR'
8530 include 'COMMON.GEO'
8531 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8535 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8537 C Parallel Antiparallel C
8543 C \ j|/k\| / \ |/k\|l / C
8548 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8549 itk=itype2loc(itype(k))
8550 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8551 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8552 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8553 call transpose2(EUgC(1,1,k),auxmat(1,1))
8554 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8555 vv1(1)=pizda1(1,1)-pizda1(2,2)
8556 vv1(2)=pizda1(1,2)+pizda1(2,1)
8557 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8558 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
8559 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
8560 s5=scalar2(vv(1),Dtobr2(1,i))
8561 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8562 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8564 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8565 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8566 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8567 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8568 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8569 & +scalar2(vv(1),Dtobr2der(1,i)))
8570 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8571 vv1(1)=pizda1(1,1)-pizda1(2,2)
8572 vv1(2)=pizda1(1,2)+pizda1(2,1)
8573 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
8574 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
8576 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8577 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8578 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8579 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8580 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8582 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8583 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8584 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8585 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8586 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8588 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8589 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8590 vv1(1)=pizda1(1,1)-pizda1(2,2)
8591 vv1(2)=pizda1(1,2)+pizda1(2,1)
8592 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8593 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8594 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8595 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8604 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8605 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8606 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8607 call transpose2(EUgC(1,1,k),auxmat(1,1))
8608 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8610 vv1(1)=pizda1(1,1)-pizda1(2,2)
8611 vv1(2)=pizda1(1,2)+pizda1(2,1)
8612 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8613 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
8614 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
8615 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
8616 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
8617 s5=scalar2(vv(1),Dtobr2(1,i))
8618 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8625 c----------------------------------------------------------------------------
8626 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8627 implicit real*8 (a-h,o-z)
8628 include 'DIMENSIONS'
8629 include 'DIMENSIONS.ZSCOPT'
8630 include 'COMMON.IOUNITS'
8631 include 'COMMON.CHAIN'
8632 include 'COMMON.DERIV'
8633 include 'COMMON.INTERACT'
8634 include 'COMMON.CONTACTS'
8635 include 'COMMON.CONTMAT'
8636 include 'COMMON.CORRMAT'
8637 include 'COMMON.TORSION'
8638 include 'COMMON.VAR'
8639 include 'COMMON.GEO'
8641 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8642 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8645 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8647 C Parallel Antiparallel C
8653 C \ j|/k\| \ |/k\|l C
8658 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8659 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8660 C AL 7/4/01 s1 would occur in the sixth-order moment,
8661 C but not in a cluster cumulant
8663 s1=dip(1,jj,i)*dip(1,kk,k)
8665 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8666 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8667 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8668 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8669 call transpose2(EUg(1,1,k),auxmat(1,1))
8670 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8671 vv(1)=pizda(1,1)-pizda(2,2)
8672 vv(2)=pizda(1,2)+pizda(2,1)
8673 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8674 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8676 eello6_graph2=-(s1+s2+s3+s4)
8678 eello6_graph2=-(s2+s3+s4)
8681 C Derivatives in gamma(i-1)
8685 s1=dipderg(1,jj,i)*dip(1,kk,k)
8687 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8688 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8689 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8690 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8692 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8694 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8696 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8698 C Derivatives in gamma(k-1)
8700 s1=dip(1,jj,i)*dipderg(1,kk,k)
8702 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8703 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8704 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8705 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8706 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8707 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8708 vv(1)=pizda(1,1)-pizda(2,2)
8709 vv(2)=pizda(1,2)+pizda(2,1)
8710 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8712 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8714 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8716 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8717 C Derivatives in gamma(j-1) or gamma(l-1)
8720 s1=dipderg(3,jj,i)*dip(1,kk,k)
8722 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8723 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8724 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8725 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8726 vv(1)=pizda(1,1)-pizda(2,2)
8727 vv(2)=pizda(1,2)+pizda(2,1)
8728 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8731 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8733 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8736 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8737 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8739 C Derivatives in gamma(l-1) or gamma(j-1)
8742 s1=dip(1,jj,i)*dipderg(3,kk,k)
8744 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8745 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8746 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8747 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8748 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8749 vv(1)=pizda(1,1)-pizda(2,2)
8750 vv(2)=pizda(1,2)+pizda(2,1)
8751 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8754 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8756 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8759 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8760 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8762 C Cartesian derivatives.
8764 write (2,*) 'In eello6_graph2'
8766 write (2,*) 'iii=',iii
8768 write (2,*) 'kkk=',kkk
8770 write (2,'(3(2f10.5),5x)')
8771 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8781 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8783 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8786 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8788 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8789 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8791 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8792 call transpose2(EUg(1,1,k),auxmat(1,1))
8793 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8795 vv(1)=pizda(1,1)-pizda(2,2)
8796 vv(2)=pizda(1,2)+pizda(2,1)
8797 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8798 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8800 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8802 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8805 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8807 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8815 c----------------------------------------------------------------------------
8816 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8817 implicit real*8 (a-h,o-z)
8818 include 'DIMENSIONS'
8819 include 'DIMENSIONS.ZSCOPT'
8820 include 'COMMON.IOUNITS'
8821 include 'COMMON.CHAIN'
8822 include 'COMMON.DERIV'
8823 include 'COMMON.INTERACT'
8824 include 'COMMON.CONTACTS'
8825 include 'COMMON.CONTMAT'
8826 include 'COMMON.CORRMAT'
8827 include 'COMMON.TORSION'
8828 include 'COMMON.VAR'
8829 include 'COMMON.GEO'
8830 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8832 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8834 C Parallel Antiparallel C
8840 C j|/k\| / |/k\|l / C
8845 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8847 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8848 C energy moment and not to the cluster cumulant.
8849 iti=itortyp(itype(i))
8850 if (j.lt.nres-1) then
8851 itj1=itype2loc(itype(j+1))
8855 itk=itype2loc(itype(k))
8856 itk1=itype2loc(itype(k+1))
8857 if (l.lt.nres-1) then
8858 itl1=itype2loc(itype(l+1))
8863 s1=dip(4,jj,i)*dip(4,kk,k)
8865 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
8866 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8867 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
8868 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8869 call transpose2(EE(1,1,k),auxmat(1,1))
8870 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8871 vv(1)=pizda(1,1)+pizda(2,2)
8872 vv(2)=pizda(2,1)-pizda(1,2)
8873 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8874 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8875 cd & "sum",-(s2+s3+s4)
8877 eello6_graph3=-(s1+s2+s3+s4)
8879 eello6_graph3=-(s2+s3+s4)
8882 C Derivatives in gamma(k-1)
8884 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
8885 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8886 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8887 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8888 C Derivatives in gamma(l-1)
8889 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
8890 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8891 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8892 vv(1)=pizda(1,1)+pizda(2,2)
8893 vv(2)=pizda(2,1)-pizda(1,2)
8894 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8895 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8896 C Cartesian derivatives.
8902 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8904 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8907 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8909 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8910 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8912 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8913 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8915 vv(1)=pizda(1,1)+pizda(2,2)
8916 vv(2)=pizda(2,1)-pizda(1,2)
8917 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8919 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8921 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8924 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8926 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8928 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8935 c----------------------------------------------------------------------------
8936 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8937 implicit real*8 (a-h,o-z)
8938 include 'DIMENSIONS'
8939 include 'DIMENSIONS.ZSCOPT'
8940 include 'COMMON.IOUNITS'
8941 include 'COMMON.CHAIN'
8942 include 'COMMON.DERIV'
8943 include 'COMMON.INTERACT'
8944 include 'COMMON.CONTACTS'
8945 include 'COMMON.CONTMAT'
8946 include 'COMMON.CORRMAT'
8947 include 'COMMON.TORSION'
8948 include 'COMMON.VAR'
8949 include 'COMMON.GEO'
8950 include 'COMMON.FFIELD'
8951 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8952 & auxvec1(2),auxmat1(2,2)
8954 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8956 C Parallel Antiparallel C
8962 C \ j|/k\| \ |/k\|l C
8967 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8969 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8970 C energy moment and not to the cluster cumulant.
8971 cd write (2,*) 'eello_graph4: wturn6',wturn6
8972 iti=itype2loc(itype(i))
8973 itj=itype2loc(itype(j))
8974 if (j.lt.nres-1) then
8975 itj1=itype2loc(itype(j+1))
8979 itk=itype2loc(itype(k))
8980 if (k.lt.nres-1) then
8981 itk1=itype2loc(itype(k+1))
8985 itl=itype2loc(itype(l))
8986 if (l.lt.nres-1) then
8987 itl1=itype2loc(itype(l+1))
8991 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8992 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8993 cd & ' itl',itl,' itl1',itl1
8996 s1=dip(3,jj,i)*dip(3,kk,k)
8998 s1=dip(2,jj,j)*dip(2,kk,l)
9001 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9002 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9004 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
9005 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9007 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
9008 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9010 call transpose2(EUg(1,1,k),auxmat(1,1))
9011 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9012 vv(1)=pizda(1,1)-pizda(2,2)
9013 vv(2)=pizda(2,1)+pizda(1,2)
9014 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9015 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9017 eello6_graph4=-(s1+s2+s3+s4)
9019 eello6_graph4=-(s2+s3+s4)
9021 C Derivatives in gamma(i-1)
9026 s1=dipderg(2,jj,i)*dip(3,kk,k)
9028 s1=dipderg(4,jj,j)*dip(2,kk,l)
9031 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9033 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
9034 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9036 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
9037 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9039 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9040 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9041 cd write (2,*) 'turn6 derivatives'
9043 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9045 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9049 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9051 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9055 C Derivatives in gamma(k-1)
9058 s1=dip(3,jj,i)*dipderg(2,kk,k)
9060 s1=dip(2,jj,j)*dipderg(4,kk,l)
9063 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9064 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9066 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
9067 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9069 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
9070 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9072 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9073 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9074 vv(1)=pizda(1,1)-pizda(2,2)
9075 vv(2)=pizda(2,1)+pizda(1,2)
9076 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9077 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9079 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9081 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9085 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9087 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9090 C Derivatives in gamma(j-1) or gamma(l-1)
9091 if (l.eq.j+1 .and. l.gt.1) then
9092 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9093 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9094 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9095 vv(1)=pizda(1,1)-pizda(2,2)
9096 vv(2)=pizda(2,1)+pizda(1,2)
9097 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9098 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9099 else if (j.gt.1) then
9100 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9101 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9102 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9103 vv(1)=pizda(1,1)-pizda(2,2)
9104 vv(2)=pizda(2,1)+pizda(1,2)
9105 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9106 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9107 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9109 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9112 C Cartesian derivatives.
9119 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9121 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9125 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9127 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9131 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9133 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9135 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9136 & b1(1,j+1),auxvec(1))
9137 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
9139 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9140 & b1(1,l+1),auxvec(1))
9141 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
9143 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9145 vv(1)=pizda(1,1)-pizda(2,2)
9146 vv(2)=pizda(2,1)+pizda(1,2)
9147 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9149 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9151 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9154 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9157 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9160 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9162 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9164 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9168 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9170 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9173 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9175 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9184 c----------------------------------------------------------------------------
9185 double precision function eello_turn6(i,jj,kk)
9186 implicit real*8 (a-h,o-z)
9187 include 'DIMENSIONS'
9188 include 'DIMENSIONS.ZSCOPT'
9189 include 'COMMON.IOUNITS'
9190 include 'COMMON.CHAIN'
9191 include 'COMMON.DERIV'
9192 include 'COMMON.INTERACT'
9193 include 'COMMON.CONTACTS'
9194 include 'COMMON.CONTMAT'
9195 include 'COMMON.CORRMAT'
9196 include 'COMMON.TORSION'
9197 include 'COMMON.VAR'
9198 include 'COMMON.GEO'
9199 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9200 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9202 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9203 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9204 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9205 C the respective energy moment and not to the cluster cumulant.
9214 iti=itype2loc(itype(i))
9215 itk=itype2loc(itype(k))
9216 itk1=itype2loc(itype(k+1))
9217 itl=itype2loc(itype(l))
9218 itj=itype2loc(itype(j))
9219 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9220 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9221 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9226 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9228 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9232 derx_turn(lll,kkk,iii)=0.0d0
9239 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9241 cd write (2,*) 'eello6_5',eello6_5
9243 call transpose2(AEA(1,1,1),auxmat(1,1))
9244 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9245 ss1=scalar2(Ub2(1,i+2),b1(1,l))
9246 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9248 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9249 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9250 s2 = scalar2(b1(1,k),vtemp1(1))
9252 call transpose2(AEA(1,1,2),atemp(1,1))
9253 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9254 call matvec2(Ug2(1,1,i+2),dd(1,1,k+1),vtemp2(1))
9255 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2(1))
9257 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9258 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9259 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9261 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9262 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9263 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9264 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9265 ss13 = scalar2(b1(1,k),vtemp4(1))
9266 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9268 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9274 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9275 C Derivatives in gamma(i+2)
9280 call transpose2(AEA(1,1,1),auxmatd(1,1))
9281 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9282 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9283 call transpose2(AEAderg(1,1,2),atempd(1,1))
9284 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9285 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
9287 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9288 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9289 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9295 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9296 C Derivatives in gamma(i+3)
9298 call transpose2(AEA(1,1,1),auxmatd(1,1))
9299 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9300 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
9301 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9303 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
9304 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9305 s2d = scalar2(b1(1,k),vtemp1d(1))
9307 call matvec2(Ug2der(1,1,i+2),dd(1,1,k+1),vtemp2d(1))
9308 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2d(1))
9310 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9312 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9313 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9314 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9322 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9323 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9325 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9326 & -0.5d0*ekont*(s2d+s12d)
9328 C Derivatives in gamma(i+4)
9329 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9330 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9331 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9333 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9334 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9335 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9343 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9345 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9347 C Derivatives in gamma(i+5)
9349 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9350 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9351 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9353 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
9354 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9355 s2d = scalar2(b1(1,k),vtemp1d(1))
9357 call transpose2(AEA(1,1,2),atempd(1,1))
9358 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9359 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
9361 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9362 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9364 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9365 ss13d = scalar2(b1(1,k),vtemp4d(1))
9366 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9374 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9375 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9377 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9378 & -0.5d0*ekont*(s2d+s12d)
9380 C Cartesian derivatives
9385 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9386 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9387 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9389 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9390 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9392 s2d = scalar2(b1(1,k),vtemp1d(1))
9394 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9395 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9396 s8d = -(atempd(1,1)+atempd(2,2))*
9397 & scalar2(cc(1,1,l),vtemp2(1))
9399 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9401 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9402 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9409 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9412 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9416 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9417 & - 0.5d0*(s8d+s12d)
9419 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9428 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9430 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9431 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9432 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9433 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9434 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9436 ss13d = scalar2(b1(1,k),vtemp4d(1))
9437 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9438 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9442 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9443 cd & 16*eel_turn6_num
9445 if (j.lt.nres-1) then
9452 if (l.lt.nres-1) then
9460 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9461 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9462 cgrad ghalf=0.5d0*ggg1(ll)
9464 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9465 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9466 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9467 & +ekont*derx_turn(ll,2,1)
9468 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9469 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9470 & +ekont*derx_turn(ll,4,1)
9471 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9472 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9473 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9474 cgrad ghalf=0.5d0*ggg2(ll)
9476 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9477 & +ekont*derx_turn(ll,2,2)
9478 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9479 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9480 & +ekont*derx_turn(ll,4,2)
9481 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9482 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9483 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9488 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9493 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9499 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9504 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9508 cd write (2,*) iii,g_corr6_loc(iii)
9511 eello_turn6=ekont*eel_turn6
9512 cd write (2,*) 'ekont',ekont
9513 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9517 crc-------------------------------------------------
9518 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9519 subroutine Eliptransfer(eliptran)
9520 implicit real*8 (a-h,o-z)
9521 include 'DIMENSIONS'
9522 include 'DIMENSIONS.ZSCOPT'
9523 include 'COMMON.GEO'
9524 include 'COMMON.VAR'
9525 include 'COMMON.LOCAL'
9526 include 'COMMON.CHAIN'
9527 include 'COMMON.DERIV'
9528 include 'COMMON.INTERACT'
9529 include 'COMMON.IOUNITS'
9530 include 'COMMON.CALC'
9531 include 'COMMON.CONTROL'
9532 include 'COMMON.SPLITELE'
9533 include 'COMMON.SBRIDGE'
9534 C this is done by Adasko
9538 C--bordliptop-- buffore starts
9539 C--bufliptop--- here true lipid starts
9541 C--buflipbot--- lipid ends buffore starts
9542 C--bordlipbot--buffore ends
9544 c write (iout,*) "Eliptransfer peplipran",pepliptran
9548 if (itype(i).eq.ntyp1) cycle
9550 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
9551 if (positi.le.0) positi=positi+boxzsize
9553 C first for peptide groups
9554 c for each residue check if it is in lipid or lipid water border area
9555 if ((positi.gt.bordlipbot)
9556 &.and.(positi.lt.bordliptop)) then
9557 C the energy transfer exist
9558 if (positi.lt.buflipbot) then
9559 C what fraction I am in
9561 & ((positi-bordlipbot)/lipbufthick)
9562 C lipbufthick is thickenes of lipid buffore
9563 sslip=sscalelip(fracinbuf)
9564 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9565 eliptran=eliptran+sslip*pepliptran
9566 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
9567 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
9568 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
9569 elseif (positi.gt.bufliptop) then
9570 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
9571 sslip=sscalelip(fracinbuf)
9572 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9573 eliptran=eliptran+sslip*pepliptran
9574 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
9575 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
9576 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
9577 C print *, "doing sscalefor top part"
9578 C print *,i,sslip,fracinbuf,ssgradlip
9580 eliptran=eliptran+pepliptran
9581 C print *,"I am in true lipid"
9584 C eliptran=elpitran+0.0 ! I am in water
9587 C print *, "nic nie bylo w lipidzie?"
9588 C now multiply all by the peptide group transfer factor
9589 C eliptran=eliptran*pepliptran
9590 C now the same for side chains
9593 if (itype(i).eq.ntyp1) cycle
9594 positi=(mod(c(3,i+nres),boxzsize))
9595 if (positi.le.0) positi=positi+boxzsize
9596 c write(iout,*) "i",i," positi",positi,bordlipbot,buflipbot,
9598 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
9599 c for each residue check if it is in lipid or lipid water border area
9600 C respos=mod(c(3,i+nres),boxzsize)
9601 C print *,positi,bordlipbot,buflipbot
9602 if ((positi.gt.bordlipbot)
9603 & .and.(positi.lt.bordliptop)) then
9604 C the energy transfer exist
9605 if (positi.lt.buflipbot) then
9607 & ((positi-bordlipbot)/lipbufthick)
9608 c write (iout,*) "i",i,itype(i)," fracinbuf",fracinbuf
9609 c write (iout,*) "i",i," liptranene",liptranene(itype(i))
9610 C lipbufthick is thickenes of lipid buffore
9611 sslip=sscalelip(fracinbuf)
9612 c write (iout,*) "sslip",sslip
9613 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9614 eliptran=eliptran+sslip*liptranene(itype(i))
9615 gliptranx(3,i)=gliptranx(3,i)
9616 &+ssgradlip*liptranene(itype(i))
9617 gliptranc(3,i-1)= gliptranc(3,i-1)
9618 &+ssgradlip*liptranene(itype(i))
9619 C print *,"doing sccale for lower part"
9620 elseif (positi.gt.bufliptop) then
9622 &((bordliptop-positi)/lipbufthick)
9623 sslip=sscalelip(fracinbuf)
9624 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9625 eliptran=eliptran+sslip*liptranene(itype(i))
9626 gliptranx(3,i)=gliptranx(3,i)
9627 &+ssgradlip*liptranene(itype(i))
9628 gliptranc(3,i-1)= gliptranc(3,i-1)
9629 &+ssgradlip*liptranene(itype(i))
9630 C print *, "doing sscalefor top part",sslip,fracinbuf
9632 eliptran=eliptran+liptranene(itype(i))
9633 C print *,"I am in true lipid"
9635 endif ! if in lipid or buffor
9637 C eliptran=elpitran+0.0 ! I am in water
9638 c write (iout,*) "eliptran",eliptran
9644 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9646 SUBROUTINE MATVEC2(A1,V1,V2)
9647 implicit real*8 (a-h,o-z)
9648 include 'DIMENSIONS'
9649 DIMENSION A1(2,2),V1(2),V2(2)
9653 c 3 VI=VI+A1(I,K)*V1(K)
9657 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9658 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9663 C---------------------------------------
9664 SUBROUTINE MATMAT2(A1,A2,A3)
9665 implicit real*8 (a-h,o-z)
9666 include 'DIMENSIONS'
9667 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9668 c DIMENSION AI3(2,2)
9672 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9678 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9679 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9680 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9681 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9689 c-------------------------------------------------------------------------
9690 double precision function scalar2(u,v)
9692 double precision u(2),v(2)
9695 scalar2=u(1)*v(1)+u(2)*v(2)
9699 C-----------------------------------------------------------------------------
9701 subroutine transpose2(a,at)
9703 double precision a(2,2),at(2,2)
9710 c--------------------------------------------------------------------------
9711 subroutine transpose(n,a,at)
9714 double precision a(n,n),at(n,n)
9722 C---------------------------------------------------------------------------
9723 subroutine prodmat3(a1,a2,kk,transp,prod)
9726 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9728 crc double precision auxmat(2,2),prod_(2,2)
9731 crc call transpose2(kk(1,1),auxmat(1,1))
9732 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9733 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9735 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9736 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9737 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9738 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9739 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9740 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9741 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9742 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9745 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9746 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9748 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9749 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9750 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9751 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9752 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9753 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9754 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9755 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9758 c call transpose2(a2(1,1),a2t(1,1))
9761 crc print *,((prod_(i,j),i=1,2),j=1,2)
9762 crc print *,((prod(i,j),i=1,2),j=1,2)
9766 C-----------------------------------------------------------------------------
9767 double precision function scalar(u,v)
9769 double precision u(3),v(3)
9779 C-----------------------------------------------------------------------
9780 double precision function sscale(r)
9781 double precision r,gamm
9782 include "COMMON.SPLITELE"
9783 if(r.lt.r_cut-rlamb) then
9785 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9786 gamm=(r-(r_cut-rlamb))/rlamb
9787 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
9793 C-----------------------------------------------------------------------
9794 C-----------------------------------------------------------------------
9795 double precision function sscagrad(r)
9796 double precision r,gamm
9797 include "COMMON.SPLITELE"
9798 if(r.lt.r_cut-rlamb) then
9800 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9801 gamm=(r-(r_cut-rlamb))/rlamb
9802 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
9808 C-----------------------------------------------------------------------
9809 C-----------------------------------------------------------------------
9810 double precision function sscalelip(r)
9811 double precision r,gamm
9812 include "COMMON.SPLITELE"
9813 C if(r.lt.r_cut-rlamb) then
9815 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9816 C gamm=(r-(r_cut-rlamb))/rlamb
9817 sscalelip=1.0d0+r*r*(2*r-3.0d0)
9823 C-----------------------------------------------------------------------
9824 double precision function sscagradlip(r)
9825 double precision r,gamm
9826 include "COMMON.SPLITELE"
9827 C if(r.lt.r_cut-rlamb) then
9829 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9830 C gamm=(r-(r_cut-rlamb))/rlamb
9831 sscagradlip=r*(6*r-6.0d0)
9838 C-----------------------------------------------------------------------
9839 subroutine set_shield_fac
9840 implicit real*8 (a-h,o-z)
9841 include 'DIMENSIONS'
9842 include 'DIMENSIONS.ZSCOPT'
9843 include 'COMMON.CHAIN'
9844 include 'COMMON.DERIV'
9845 include 'COMMON.IOUNITS'
9846 include 'COMMON.SHIELD'
9847 include 'COMMON.INTERACT'
9848 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
9849 double precision div77_81/0.974996043d0/,
9850 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
9852 C the vector between center of side_chain and peptide group
9853 double precision pep_side(3),long,side_calf(3),
9854 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
9855 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
9856 C the line belowe needs to be changed for FGPROC>1
9858 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
9860 Cif there two consequtive dummy atoms there is no peptide group between them
9861 C the line below has to be changed for FGPROC>1
9864 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
9868 C first lets set vector conecting the ithe side-chain with kth side-chain
9869 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
9871 C and vector conecting the side-chain with its proper calfa
9872 side_calf(j)=c(j,k+nres)-c(j,k)
9873 C side_calf(j)=2.0d0
9874 pept_group(j)=c(j,i)-c(j,i+1)
9875 C lets have their lenght
9876 dist_pep_side=pep_side(j)**2+dist_pep_side
9877 dist_side_calf=dist_side_calf+side_calf(j)**2
9878 dist_pept_group=dist_pept_group+pept_group(j)**2
9880 dist_pep_side=dsqrt(dist_pep_side)
9881 dist_pept_group=dsqrt(dist_pept_group)
9882 dist_side_calf=dsqrt(dist_side_calf)
9884 pep_side_norm(j)=pep_side(j)/dist_pep_side
9885 side_calf_norm(j)=dist_side_calf
9887 C now sscale fraction
9888 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
9889 C print *,buff_shield,"buff"
9891 if (sh_frac_dist.le.0.0) cycle
9892 C If we reach here it means that this side chain reaches the shielding sphere
9893 C Lets add him to the list for gradient
9894 ishield_list(i)=ishield_list(i)+1
9895 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
9896 C this list is essential otherwise problem would be O3
9897 shield_list(ishield_list(i),i)=k
9898 C Lets have the sscale value
9899 if (sh_frac_dist.gt.1.0) then
9900 scale_fac_dist=1.0d0
9902 sh_frac_dist_grad(j)=0.0d0
9905 scale_fac_dist=-sh_frac_dist*sh_frac_dist
9906 & *(2.0*sh_frac_dist-3.0d0)
9907 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
9908 & /dist_pep_side/buff_shield*0.5
9909 C remember for the final gradient multiply sh_frac_dist_grad(j)
9910 C for side_chain by factor -2 !
9912 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
9913 C print *,"jestem",scale_fac_dist,fac_help_scale,
9914 C & sh_frac_dist_grad(j)
9917 C if ((i.eq.3).and.(k.eq.2)) then
9918 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
9922 C this is what is now we have the distance scaling now volume...
9923 short=short_r_sidechain(itype(k))
9924 long=long_r_sidechain(itype(k))
9925 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
9928 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
9931 costhet_grad(j)=costhet_fac*pep_side(j)
9933 C remember for the final gradient multiply costhet_grad(j)
9934 C for side_chain by factor -2 !
9935 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9936 C pep_side0pept_group is vector multiplication
9937 pep_side0pept_group=0.0
9939 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9941 cosalfa=(pep_side0pept_group/
9942 & (dist_pep_side*dist_side_calf))
9943 fac_alfa_sin=1.0-cosalfa**2
9944 fac_alfa_sin=dsqrt(fac_alfa_sin)
9945 rkprim=fac_alfa_sin*(long-short)+short
9947 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
9948 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
9951 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9952 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9953 &*(long-short)/fac_alfa_sin*cosalfa/
9954 &((dist_pep_side*dist_side_calf))*
9955 &((side_calf(j))-cosalfa*
9956 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9958 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9959 &*(long-short)/fac_alfa_sin*cosalfa
9960 &/((dist_pep_side*dist_side_calf))*
9962 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9965 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
9968 C now the gradient...
9969 C grad_shield is gradient of Calfa for peptide groups
9970 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
9972 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
9973 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
9975 grad_shield(j,i)=grad_shield(j,i)
9976 C gradient po skalowaniu
9977 & +(sh_frac_dist_grad(j)
9978 C gradient po costhet
9979 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
9980 &-scale_fac_dist*(cosphi_grad_long(j))
9981 &/(1.0-cosphi) )*div77_81
9983 C grad_shield_side is Cbeta sidechain gradient
9984 grad_shield_side(j,ishield_list(i),i)=
9985 & (sh_frac_dist_grad(j)*(-2.0d0)
9986 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
9987 & +scale_fac_dist*(cosphi_grad_long(j))
9988 & *2.0d0/(1.0-cosphi))
9989 & *div77_81*VofOverlap
9991 grad_shield_loc(j,ishield_list(i),i)=
9992 & scale_fac_dist*cosphi_grad_loc(j)
9993 & *2.0d0/(1.0-cosphi)
9994 & *div77_81*VofOverlap
9996 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9998 fac_shield(i)=VolumeTotal*div77_81+div4_81
9999 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
10003 C--------------------------------------------------------------------------
10004 C first for shielding is setting of function of side-chains
10005 subroutine set_shield_fac2
10006 implicit real*8 (a-h,o-z)
10007 include 'DIMENSIONS'
10008 include 'DIMENSIONS.ZSCOPT'
10009 include 'COMMON.CHAIN'
10010 include 'COMMON.DERIV'
10011 include 'COMMON.IOUNITS'
10012 include 'COMMON.SHIELD'
10013 include 'COMMON.INTERACT'
10014 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
10015 double precision div77_81/0.974996043d0/,
10016 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
10018 C the vector between center of side_chain and peptide group
10019 double precision pep_side(3),long,side_calf(3),
10020 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
10021 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
10022 C the line belowe needs to be changed for FGPROC>1
10024 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
10026 Cif there two consequtive dummy atoms there is no peptide group between them
10027 C the line below has to be changed for FGPROC>1
10030 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
10034 C first lets set vector conecting the ithe side-chain with kth side-chain
10035 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
10036 C pep_side(j)=2.0d0
10037 C and vector conecting the side-chain with its proper calfa
10038 side_calf(j)=c(j,k+nres)-c(j,k)
10039 C side_calf(j)=2.0d0
10040 pept_group(j)=c(j,i)-c(j,i+1)
10041 C lets have their lenght
10042 dist_pep_side=pep_side(j)**2+dist_pep_side
10043 dist_side_calf=dist_side_calf+side_calf(j)**2
10044 dist_pept_group=dist_pept_group+pept_group(j)**2
10046 dist_pep_side=dsqrt(dist_pep_side)
10047 dist_pept_group=dsqrt(dist_pept_group)
10048 dist_side_calf=dsqrt(dist_side_calf)
10050 pep_side_norm(j)=pep_side(j)/dist_pep_side
10051 side_calf_norm(j)=dist_side_calf
10053 C now sscale fraction
10054 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
10055 C print *,buff_shield,"buff"
10057 if (sh_frac_dist.le.0.0) cycle
10058 C If we reach here it means that this side chain reaches the shielding sphere
10059 C Lets add him to the list for gradient
10060 ishield_list(i)=ishield_list(i)+1
10061 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
10062 C this list is essential otherwise problem would be O3
10063 shield_list(ishield_list(i),i)=k
10064 C Lets have the sscale value
10065 if (sh_frac_dist.gt.1.0) then
10066 scale_fac_dist=1.0d0
10068 sh_frac_dist_grad(j)=0.0d0
10071 scale_fac_dist=-sh_frac_dist*sh_frac_dist
10072 & *(2.0d0*sh_frac_dist-3.0d0)
10073 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
10074 & /dist_pep_side/buff_shield*0.5d0
10075 C remember for the final gradient multiply sh_frac_dist_grad(j)
10076 C for side_chain by factor -2 !
10078 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
10079 C sh_frac_dist_grad(j)=0.0d0
10080 C scale_fac_dist=1.0d0
10081 C print *,"jestem",scale_fac_dist,fac_help_scale,
10082 C & sh_frac_dist_grad(j)
10085 C this is what is now we have the distance scaling now volume...
10086 short=short_r_sidechain(itype(k))
10087 long=long_r_sidechain(itype(k))
10088 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
10089 sinthet=short/dist_pep_side*costhet
10093 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
10094 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
10095 C & -short/dist_pep_side**2/costhet)
10096 C costhet_fac=0.0d0
10098 costhet_grad(j)=costhet_fac*pep_side(j)
10100 C remember for the final gradient multiply costhet_grad(j)
10101 C for side_chain by factor -2 !
10102 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
10103 C pep_side0pept_group is vector multiplication
10104 pep_side0pept_group=0.0d0
10106 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
10108 cosalfa=(pep_side0pept_group/
10109 & (dist_pep_side*dist_side_calf))
10110 fac_alfa_sin=1.0d0-cosalfa**2
10111 fac_alfa_sin=dsqrt(fac_alfa_sin)
10112 rkprim=fac_alfa_sin*(long-short)+short
10116 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
10118 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
10119 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
10120 & dist_pep_side**2)
10123 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
10124 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
10125 &*(long-short)/fac_alfa_sin*cosalfa/
10126 &((dist_pep_side*dist_side_calf))*
10127 &((side_calf(j))-cosalfa*
10128 &((pep_side(j)/dist_pep_side)*dist_side_calf))
10129 C cosphi_grad_long(j)=0.0d0
10130 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
10131 &*(long-short)/fac_alfa_sin*cosalfa
10132 &/((dist_pep_side*dist_side_calf))*
10134 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
10135 C cosphi_grad_loc(j)=0.0d0
10137 C print *,sinphi,sinthet
10138 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
10141 C now the gradient...
10143 grad_shield(j,i)=grad_shield(j,i)
10144 C gradient po skalowaniu
10145 & +(sh_frac_dist_grad(j)*VofOverlap
10146 C gradient po costhet
10147 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
10148 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
10149 & sinphi/sinthet*costhet*costhet_grad(j)
10150 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
10152 C grad_shield_side is Cbeta sidechain gradient
10153 grad_shield_side(j,ishield_list(i),i)=
10154 & (sh_frac_dist_grad(j)*(-2.0d0)
10156 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
10157 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
10158 & sinphi/sinthet*costhet*costhet_grad(j)
10159 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
10162 grad_shield_loc(j,ishield_list(i),i)=
10163 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
10164 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
10165 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
10169 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
10171 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
10172 c write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i),
10173 c & " wshield",wshield
10174 c write(2,*) "TU",rpp(1,1),short,long,buff_shield
10178 C--------------------------------------------------------------------------
10179 double precision function tschebyshev(m,n,x,y)
10181 include "DIMENSIONS"
10183 double precision x(n),y,yy(0:maxvar),aux
10184 c Tschebyshev polynomial. Note that the first term is omitted
10185 c m=0: the constant term is included
10186 c m=1: the constant term is not included
10190 yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
10199 C--------------------------------------------------------------------------
10200 double precision function gradtschebyshev(m,n,x,y)
10202 include "DIMENSIONS"
10204 double precision x(n+1),y,yy(0:maxvar),aux
10205 c Tschebyshev polynomial. Note that the first term is omitted
10206 c m=0: the constant term is included
10207 c m=1: the constant term is not included
10211 yy(i)=2*y*yy(i-1)-yy(i-2)
10215 aux=aux+x(i+1)*yy(i)*(i+1)
10216 C print *, x(i+1),yy(i),i
10218 gradtschebyshev=aux
10221 c----------------------------------------------------------------------------
10222 double precision function sscale2(r,r_cut,r0,rlamb)
10224 double precision r,gamm,r_cut,r0,rlamb,rr
10226 c write (2,*) "r",r," r_cut",r_cut," r0",r0," rlamb",rlamb
10227 c write (2,*) "rr",rr
10228 if(rr.lt.r_cut-rlamb) then
10230 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
10231 gamm=(rr-(r_cut-rlamb))/rlamb
10232 sscale2=1.0d0+gamm*gamm*(2*gamm-3.0d0)
10238 C-----------------------------------------------------------------------
10239 double precision function sscalgrad2(r,r_cut,r0,rlamb)
10241 double precision r,gamm,r_cut,r0,rlamb,rr
10243 if(rr.lt.r_cut-rlamb) then
10245 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
10246 gamm=(rr-(r_cut-rlamb))/rlamb
10248 sscalgrad2=gamm*(6*gamm-6.0d0)/rlamb
10250 sscalgrad2=-gamm*(6*gamm-6.0d0)/rlamb
10257 c----------------------------------------------------------------------------
10258 subroutine e_saxs(Esaxs_constr)
10260 include 'DIMENSIONS'
10261 include 'DIMENSIONS.ZSCOPT'
10262 include 'DIMENSIONS.FREE'
10265 include "COMMON.SETUP"
10268 include 'COMMON.SBRIDGE'
10269 include 'COMMON.CHAIN'
10270 include 'COMMON.GEO'
10271 include 'COMMON.LOCAL'
10272 include 'COMMON.INTERACT'
10273 include 'COMMON.VAR'
10274 include 'COMMON.IOUNITS'
10275 include 'COMMON.DERIV'
10276 include 'COMMON.CONTROL'
10277 include 'COMMON.NAMES'
10278 include 'COMMON.FFIELD'
10279 include 'COMMON.LANGEVIN'
10280 include 'COMMON.SAXS'
10282 double precision Esaxs_constr
10283 integer i,iint,j,k,l
10284 double precision PgradC(maxSAXS,3,maxres),
10285 & PgradX(maxSAXS,3,maxres),Pcalc(maxSAXS)
10287 double precision PgradC_(maxSAXS,3,maxres),
10288 & PgradX_(maxSAXS,3,maxres),Pcalc_(maxSAXS)
10290 double precision dk,dijCACA,dijCASC,dijSCCA,dijSCSC,
10291 & sigma2CACA,sigma2CASC,sigma2SCCA,sigma2SCSC,expCACA,expCASC,
10292 & expSCCA,expSCSC,CASCgrad,SCCAgrad,SCSCgrad,aux,auxC,auxC1,
10293 & auxX,auxX1,CACAgrad,Cnorm
10294 double precision sss2,ssgrad2,rrr,sscalgrad2,sscale2
10295 double precision dist
10297 c SAXS restraint penalty function
10299 write(iout,*) "------- SAXS penalty function start -------"
10300 write (iout,*) "nsaxs",nsaxs
10301 write (iout,*) "Esaxs: iatsc_s",iatsc_s," iatsc_e",iatsc_e
10302 write (iout,*) "Psaxs"
10304 write (iout,'(i5,e15.5)') i, Psaxs(i)
10307 Esaxs_constr = 0.0d0
10312 PgradC(k,l,j)=0.0d0
10313 PgradX(k,l,j)=0.0d0
10317 do i=iatsc_s,iatsc_e
10318 if (itype(i).eq.ntyp1) cycle
10319 do iint=1,nint_gr(i)
10320 do j=istart(i,iint),iend(i,iint)
10321 if (itype(j).eq.ntyp1) cycle
10324 dijCASC=dist(i,j+nres)
10325 dijSCCA=dist(i+nres,j)
10326 dijSCSC=dist(i+nres,j+nres)
10327 sigma2CACA=2.0d0/(pstok**2)
10328 sigma2CASC=4.0d0/(pstok**2+restok(itype(j))**2)
10329 sigma2SCCA=4.0d0/(pstok**2+restok(itype(i))**2)
10330 sigma2SCSC=4.0d0/(restok(itype(j))**2+restok(itype(i))**2)
10333 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
10334 if (itype(j).ne.10) then
10335 expCASC = dexp(-0.5d0*sigma2CASC*(dijCASC-dk)**2)
10339 if (itype(i).ne.10) then
10340 expSCCA = dexp(-0.5d0*sigma2SCCA*(dijSCCA-dk)**2)
10344 if (itype(i).ne.10 .and. itype(j).ne.10) then
10345 expSCSC = dexp(-0.5d0*sigma2SCSC*(dijSCSC-dk)**2)
10349 Pcalc(k) = Pcalc(k)+expCACA+expCASC+expSCCA+expSCSC
10351 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
10353 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
10354 CASCgrad = sigma2CASC*(dijCASC-dk)*expCASC
10355 SCCAgrad = sigma2SCCA*(dijSCCA-dk)*expSCCA
10356 SCSCgrad = sigma2SCSC*(dijSCSC-dk)*expSCSC
10359 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
10360 PgradC(k,l,i) = PgradC(k,l,i)-aux
10361 PgradC(k,l,j) = PgradC(k,l,j)+aux
10363 if (itype(j).ne.10) then
10364 aux = CASCgrad*(C(l,j+nres)-C(l,i))/dijCASC
10365 PgradC(k,l,i) = PgradC(k,l,i)-aux
10366 PgradC(k,l,j) = PgradC(k,l,j)+aux
10367 PgradX(k,l,j) = PgradX(k,l,j)+aux
10370 if (itype(i).ne.10) then
10371 aux = SCCAgrad*(C(l,j)-C(l,i+nres))/dijSCCA
10372 PgradX(k,l,i) = PgradX(k,l,i)-aux
10373 PgradC(k,l,i) = PgradC(k,l,i)-aux
10374 PgradC(k,l,j) = PgradC(k,l,j)+aux
10377 if (itype(i).ne.10 .and. itype(j).ne.10) then
10378 aux = SCSCgrad*(C(l,j+nres)-C(l,i+nres))/dijSCSC
10379 PgradC(k,l,i) = PgradC(k,l,i)-aux
10380 PgradC(k,l,j) = PgradC(k,l,j)+aux
10381 PgradX(k,l,i) = PgradX(k,l,i)-aux
10382 PgradX(k,l,j) = PgradX(k,l,j)+aux
10388 sigma2CACA=scal_rad**2*0.25d0/
10389 & (restok(itype(j))**2+restok(itype(i))**2)
10391 IF (saxs_cutoff.eq.0) THEN
10394 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
10395 Pcalc(k) = Pcalc(k)+expCACA
10396 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
10398 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
10399 PgradC(k,l,i) = PgradC(k,l,i)-aux
10400 PgradC(k,l,j) = PgradC(k,l,j)+aux
10404 rrr = saxs_cutoff*2.0d0/dsqrt(sigma2CACA)
10407 c write (2,*) "ijk",i,j,k
10408 sss2 = sscale2(dijCACA,rrr,dk,0.3d0)
10409 if (sss2.eq.0.0d0) cycle
10410 ssgrad2 = sscalgrad2(dijCACA,rrr,dk,0.3d0)
10411 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)*sss2
10412 Pcalc(k) = Pcalc(k)+expCACA
10414 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
10416 CACAgrad = -sigma2CACA*(dijCACA-dk)*expCACA+
10417 & ssgrad2*expCACA/sss2
10420 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
10421 PgradC(k,l,i) = PgradC(k,l,i)+aux
10422 PgradC(k,l,j) = PgradC(k,l,j)-aux
10431 if (nfgtasks.gt.1) then
10432 call MPI_Reduce(Pcalc(1),Pcalc_(1),nsaxs,MPI_DOUBLE_PRECISION,
10433 & MPI_SUM,king,FG_COMM,IERR)
10434 if (fg_rank.eq.king) then
10436 Pcalc(k) = Pcalc_(k)
10439 call MPI_Reduce(PgradC(k,1,1),PgradC_(k,1,1),3*maxsaxs*nres,
10440 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10441 if (fg_rank.eq.king) then
10445 PgradC(k,l,i) = PgradC_(k,l,i)
10451 call MPI_Reduce(PgradX(k,1,1),PgradX_(k,1,1),3*maxsaxs*nres,
10452 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10453 if (fg_rank.eq.king) then
10457 PgradX(k,l,i) = PgradX_(k,l,i)
10466 if (fg_rank.eq.king) then
10470 Cnorm = Cnorm + Pcalc(k)
10472 Esaxs_constr = dlog(Cnorm)-wsaxs0
10474 if (Pcalc(k).gt.0.0d0)
10475 & Esaxs_constr = Esaxs_constr - Psaxs(k)*dlog(Pcalc(k))
10477 write (iout,*) "k",k," Esaxs_constr",Esaxs_constr
10481 write (iout,*) "Cnorm",Cnorm," Esaxs_constr",Esaxs_constr
10491 & auxC = auxC +Psaxs(k)*PgradC(k,l,i)/Pcalc(k)
10492 auxC1 = auxC1+PgradC(k,l,i)
10494 auxX = auxX +Psaxs(k)*PgradX(k,l,i)/Pcalc(k)
10495 auxX1 = auxX1+PgradX(k,l,i)
10498 gsaxsC(l,i) = auxC - auxC1/Cnorm
10500 gsaxsX(l,i) = auxX - auxX1/Cnorm
10502 c write (iout,*) "l i",l,i," gradC",wsaxs*(auxC - auxC1/Cnorm),
10503 c * " gradX",wsaxs*(auxX - auxX1/Cnorm)
10511 c----------------------------------------------------------------------------
10512 subroutine e_saxsC(Esaxs_constr)
10514 include 'DIMENSIONS'
10515 include 'DIMENSIONS.ZSCOPT'
10516 include 'DIMENSIONS.FREE'
10519 include "COMMON.SETUP"
10522 include 'COMMON.SBRIDGE'
10523 include 'COMMON.CHAIN'
10524 include 'COMMON.GEO'
10525 include 'COMMON.LOCAL'
10526 include 'COMMON.INTERACT'
10527 include 'COMMON.VAR'
10528 include 'COMMON.IOUNITS'
10529 include 'COMMON.DERIV'
10530 include 'COMMON.CONTROL'
10531 include 'COMMON.NAMES'
10532 include 'COMMON.FFIELD'
10533 include 'COMMON.LANGEVIN'
10534 include 'COMMON.SAXS'
10536 double precision Esaxs_constr
10537 integer i,iint,j,k,l
10538 double precision PgradC(3,maxres),PgradX(3,maxres),Pcalc,logPtot
10540 double precision gsaxsc_(3,maxres),gsaxsx_(3,maxres),logPtot_
10542 double precision dk,dijCASPH,dijSCSPH,
10543 & sigma2CA,sigma2SC,expCASPH,expSCSPH,
10544 & CASPHgrad,SCSPHgrad,aux,auxC,auxC1,
10546 c SAXS restraint penalty function
10548 write(iout,*) "------- SAXS penalty function start -------"
10549 write (iout,*) "nsaxs",nsaxs," isaxs_start",isaxs_start,
10550 & " isaxs_end",isaxs_end
10551 write (iout,*) "nnt",nnt," ntc",nct
10553 write(iout,'(a6,i5,3f10.5,5x,2f10.5)')
10554 & "CA",i,(C(j,i),j=1,3),pstok,restok(itype(i))
10557 write(iout,'(a6,i5,3f10.5)')"CSaxs",i,(Csaxs(j,i),j=1,3)
10560 Esaxs_constr = 0.0d0
10562 do j=isaxs_start,isaxs_end
10574 dijCASPH=dijCASPH+(C(l,i)-Csaxs(l,j))**2
10576 if (itype(i).ne.10) then
10578 dijSCSPH=dijSCSPH+(C(l,i+nres)-Csaxs(l,j))**2
10581 sigma2CA=2.0d0/pstok**2
10582 sigma2SC=4.0d0/restok(itype(i))**2
10583 expCASPH = dexp(-0.5d0*sigma2CA*dijCASPH)
10584 expSCSPH = dexp(-0.5d0*sigma2SC*dijSCSPH)
10585 Pcalc = Pcalc+expCASPH+expSCSPH
10587 write(*,*) "processor i j Pcalc",
10588 & MyRank,i,j,dijCASPH,dijSCSPH, Pcalc
10590 CASPHgrad = sigma2CA*expCASPH
10591 SCSPHgrad = sigma2SC*expSCSPH
10593 aux = (C(l,i+nres)-Csaxs(l,j))*SCSPHgrad
10594 PgradX(l,i) = PgradX(l,i) + aux
10595 PgradC(l,i) = PgradC(l,i)+(C(l,i)-Csaxs(l,j))*CASPHgrad+aux
10600 gsaxsc(l,i)=gsaxsc(l,i)+PgradC(l,i)/Pcalc
10601 gsaxsx(l,i)=gsaxsx(l,i)+PgradX(l,i)/Pcalc
10604 logPtot = logPtot - dlog(Pcalc)
10605 c print *,"me",me,MyRank," j",j," logPcalc",-dlog(Pcalc),
10606 c & " logPtot",logPtot
10609 if (nfgtasks.gt.1) then
10610 c write (iout,*) "logPtot before reduction",logPtot
10611 call MPI_Reduce(logPtot,logPtot_,1,MPI_DOUBLE_PRECISION,
10612 & MPI_SUM,king,FG_COMM,IERR)
10614 c write (iout,*) "logPtot after reduction",logPtot
10615 call MPI_Reduce(gsaxsC(1,1),gsaxsC_(1,1),3*nres,
10616 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10617 if (fg_rank.eq.king) then
10620 gsaxsC(l,i) = gsaxsC_(l,i)
10624 call MPI_Reduce(gsaxsX(1,1),gsaxsX_(1,1),3*nres,
10625 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10626 if (fg_rank.eq.king) then
10629 gsaxsX(l,i) = gsaxsX_(l,i)
10635 Esaxs_constr = logPtot