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 eello_turn4',eello_turn4
61 C Calculate excluded-volume interaction energy between peptide groups
64 call escp(evdw2,evdw2_14)
66 c Calculate the bond-stretching energy
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)
2276 c write (iout,*) "i",i," eello_turn4",eello_turn4
2278 num_cont_hb(i)=num_conti
2281 C Loop over all neighbouring boxes
2286 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2289 do i=iatel_s,iatel_e
2292 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2293 C changes suggested by Ana to avoid out of bounds
2294 c & .or.((i+2).gt.nres)
2295 c & .or.((i-1).le.0)
2296 C end of changes by Ana
2297 c & .or. itype(i+2).eq.ntyp1
2298 c & .or. itype(i-1).eq.ntyp1
2303 dx_normi=dc_norm(1,i)
2304 dy_normi=dc_norm(2,i)
2305 dz_normi=dc_norm(3,i)
2306 xmedi=c(1,i)+0.5d0*dxi
2307 ymedi=c(2,i)+0.5d0*dyi
2308 zmedi=c(3,i)+0.5d0*dzi
2309 call to_box(xmedi,ymedi,zmedi)
2310 call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
2312 num_conti=num_cont_hb(i)
2315 do j=ielstart(i),ielend(i)
2317 C write (iout,*) i,j
2319 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
2320 C changes suggested by Ana to avoid out of bounds
2321 c & .or.((j+2).gt.nres)
2322 c & .or.((j-1).le.0)
2323 C end of changes by Ana
2324 c & .or.itype(j+2).eq.ntyp1
2325 c & .or.itype(j-1).eq.ntyp1
2327 call eelecij(i,j,ees,evdw1,eel_loc)
2330 num_cont_hb(i)=num_conti
2337 c write (iout,*) "Number of loop steps in EELEC:",ind
2339 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2340 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2342 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2343 ccc eel_loc=eel_loc+eello_turn3
2344 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2347 C-------------------------------------------------------------------------------
2348 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2349 implicit real*8 (a-h,o-z)
2350 include 'DIMENSIONS'
2351 include 'DIMENSIONS.ZSCOPT'
2355 include 'COMMON.CONTROL'
2356 include 'COMMON.IOUNITS'
2357 include 'COMMON.GEO'
2358 include 'COMMON.VAR'
2359 include 'COMMON.LOCAL'
2360 include 'COMMON.CHAIN'
2361 include 'COMMON.DERIV'
2362 include 'COMMON.INTERACT'
2364 include 'COMMON.CONTACTS'
2365 include 'COMMON.CONTMAT'
2367 include 'COMMON.CORRMAT'
2368 include 'COMMON.TORSION'
2369 include 'COMMON.VECTORS'
2370 include 'COMMON.FFIELD'
2371 include 'COMMON.TIME1'
2372 include 'COMMON.SPLITELE'
2373 include 'COMMON.SHIELD'
2374 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2375 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2376 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2377 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
2378 & gmuij2(4),gmuji2(4)
2379 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2380 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2382 double precision sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij,
2384 common /lipcalc/ sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij
2385 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2387 double precision scal_el /1.0d0/
2389 double precision scal_el /0.5d0/
2392 C 13-go grudnia roku pamietnego...
2393 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2394 & 0.0d0,1.0d0,0.0d0,
2395 & 0.0d0,0.0d0,1.0d0/
2396 integer xshift,yshift,zshift
2397 c time00=MPI_Wtime()
2398 cd write (iout,*) "eelecij",i,j
2402 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2403 aaa=app(iteli,itelj)
2404 bbb=bpp(iteli,itelj)
2405 ael6i=ael6(iteli,itelj)
2406 ael3i=ael3(iteli,itelj)
2410 dx_normj=dc_norm(1,j)
2411 dy_normj=dc_norm(2,j)
2412 dz_normj=dc_norm(3,j)
2413 C xj=c(1,j)+0.5D0*dxj-xmedi
2414 C yj=c(2,j)+0.5D0*dyj-ymedi
2415 C zj=c(3,j)+0.5D0*dzj-zmedi
2419 call to_box(xj,yj,zj)
2420 call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
2421 faclipij=(sslipi+sslipj)/2.0d0*lipscale+1.0d0
2422 faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
2423 xj=boxshift(xj-xmedi,boxxsize)
2424 yj=boxshift(yj-ymedi,boxysize)
2425 zj=boxshift(zj-zmedi,boxzsize)
2426 rij=xj*xj+yj*yj+zj*zj
2428 sss=sscale(sqrt(rij))
2429 if (sss.eq.0.0d0) return
2430 sssgrad=sscagrad(sqrt(rij))
2431 c write (iout,*) "ij",i,j," rij",sqrt(rij)," r_cut",r_cut,
2432 c & " rlamb",rlamb," sss",sss
2433 c if (sss.gt.0.0d0) then
2439 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2440 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2441 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2442 fac=cosa-3.0D0*cosb*cosg
2444 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2445 if (j.eq.i+2) ev1=scal_el*ev1
2450 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2454 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2455 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2456 if (shield_mode.gt.0) then
2459 el1=el1*fac_shield(i)**2*fac_shield(j)**2
2460 el2=el2*fac_shield(i)**2*fac_shield(j)**2
2462 ees=ees+eesij*sss*faclipij2
2467 ees=ees+eesij*sss*faclipij2
2469 evdw1=evdw1+evdwij*sss*faclipij2
2470 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2471 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2472 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2473 cd & xmedi,ymedi,zmedi,xj,yj,zj
2475 if (energy_dec) then
2476 write (iout,'(a6,2i5,0pf7.3,2i5,3e11.3)')
2477 &' evdw1',i,j,evdwij,iteli,itelj,aaa,evdw1,sss
2478 write (iout,'(a6,2i5,0pf7.3,6f8.5)') 'ees',i,j,eesij,
2479 & fac_shield(i),fac_shield(j),sslipi,sslipj,faclipij,
2484 C Calculate contributions to the Cartesian gradient.
2487 facvdw=-6*rrmij*(ev1+evdwij)*sss
2488 facel=-3*rrmij*(el1+eesij)
2495 * Radial derivatives. First process both termini of the fragment (i,j)
2498 aux=(facel*sss+rmij*sssgrad*eesij)*faclipij2
2502 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2503 & (shield_mode.gt.0)) then
2505 do ilist=1,ishield_list(i)
2506 iresshield=shield_list(ilist,i)
2508 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
2510 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2512 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
2513 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2514 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2515 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2516 C if (iresshield.gt.i) then
2517 C do ishi=i+1,iresshield-1
2518 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2519 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2523 C do ishi=iresshield,i
2524 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2525 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2531 do ilist=1,ishield_list(j)
2532 iresshield=shield_list(ilist,j)
2534 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
2536 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2538 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
2539 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2541 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2542 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2543 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2544 C if (iresshield.gt.j) then
2545 C do ishi=j+1,iresshield-1
2546 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2547 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2551 C do ishi=iresshield,j
2552 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2553 C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2560 gshieldc(k,i)=gshieldc(k,i)+
2561 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2562 gshieldc(k,j)=gshieldc(k,j)+
2563 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2564 gshieldc(k,i-1)=gshieldc(k,i-1)+
2565 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2566 gshieldc(k,j-1)=gshieldc(k,j-1)+
2567 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2572 c ghalf=0.5D0*ggg(k)
2573 c gelc(k,i)=gelc(k,i)+ghalf
2574 c gelc(k,j)=gelc(k,j)+ghalf
2576 c 9/28/08 AL Gradient compotents will be summed only at the end
2577 C print *,"before", gelc_long(1,i), gelc_long(1,j)
2579 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2580 C & +grad_shield(k,j)*eesij/fac_shield(j)
2581 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2582 C & +grad_shield(k,i)*eesij/fac_shield(i)
2583 C gelc_long(k,i-1)=gelc_long(k,i-1)
2584 C & +grad_shield(k,i)*eesij/fac_shield(i)
2585 C gelc_long(k,j-1)=gelc_long(k,j-1)
2586 C & +grad_shield(k,j)*eesij/fac_shield(j)
2587 gelc_long(3,j)=gelc_long(3,j)+
2588 & ssgradlipj*eesij/2.0d0*lipscale**2*sss
2590 gelc_long(3,i)=gelc_long(3,i)+
2591 & ssgradlipi*eesij/2.0d0*lipscale**2*sss
2593 C print *,"bafter", gelc_long(1,i), gelc_long(1,j)
2596 * Loop over residues i+1 thru j-1.
2600 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2603 if (sss.gt.0.0) then
2604 facvdw=(facvdw+sssgrad*rmij*evdwij)*faclipij2
2614 c ghalf=0.5D0*ggg(k)
2615 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2616 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2618 c 9/28/08 AL Gradient compotents will be summed only at the end
2620 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2621 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2623 !C Lipidic part for scaling weight
2624 gvdwpp(3,j)=gvdwpp(3,j)+
2625 & sss*ssgradlipj*evdwij/2.0d0*lipscale**2
2626 gvdwpp(3,i)=gvdwpp(3,i)+
2627 & sss*ssgradlipi*evdwij/2.0d0*lipscale**2
2629 * Loop over residues i+1 thru j-1.
2633 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2639 facvdw=(ev1+evdwij)*faclipij2
2642 fac=-3*rrmij*(facvdw+facvdw+facel)*sss
2643 & +(evdwij+eesij)*sssgrad*rrmij
2648 * Radial derivatives. First process both termini of the fragment (i,j)
2652 C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j)
2654 C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j)
2656 C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j)
2658 c ghalf=0.5D0*ggg(k)
2659 c gelc(k,i)=gelc(k,i)+ghalf
2660 c gelc(k,j)=gelc(k,j)+ghalf
2662 c 9/28/08 AL Gradient compotents will be summed only at the end
2664 gelc_long(k,j)=gelc(k,j)+ggg(k)
2665 gelc_long(k,i)=gelc(k,i)-ggg(k)
2668 * Loop over residues i+1 thru j-1.
2672 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2675 c 9/28/08 AL Gradient compotents will be summed only at the end
2676 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2677 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2678 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2680 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2681 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2683 gvdwpp(3,j)=gvdwpp(3,j)+
2684 & sss*ssgradlipj*evdwij/2.0d0*lipscale**2
2685 gvdwpp(3,i)=gvdwpp(3,i)+
2686 & sss*ssgradlipi*evdwij/2.0d0*lipscale**2
2693 ecosa=2.0D0*fac3*fac1+fac4
2696 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2697 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2699 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2700 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2702 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2703 cd & (dcosg(k),k=1,3)
2705 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
2706 & fac_shield(i)**2*fac_shield(j)**2*sss*faclipij2
2709 c ghalf=0.5D0*ggg(k)
2710 c gelc(k,i)=gelc(k,i)+ghalf
2711 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2712 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2713 c gelc(k,j)=gelc(k,j)+ghalf
2714 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2715 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2719 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2722 C print *,"before22", gelc_long(1,i), gelc_long(1,j)
2725 & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2726 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
2727 & *fac_shield(i)**2*fac_shield(j)**2*faclipij2
2729 & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2730 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
2731 & *fac_shield(i)**2*fac_shield(j)**2*faclipij2
2732 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2733 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2735 C print *,"before33", gelc_long(1,i), gelc_long(1,j)
2740 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2741 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2742 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2744 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2745 C energy of a peptide unit is assumed in the form of a second-order
2746 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2747 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2748 C are computed for EVERY pair of non-contiguous peptide groups.
2751 if (j.lt.nres-1) then
2763 muij(kkk)=mu(k,i)*mu(l,j)
2764 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
2767 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
2768 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
2769 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
2770 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
2771 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
2772 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
2778 write (iout,*) 'EELEC: i',i,' j',j
2779 write (iout,*) 'j',j,' j1',j1,' j2',j2
2780 write(iout,*) 'muij',muij
2781 write (iout,*) "uy",uy(:,i)
2782 write (iout,*) "uz",uz(:,j)
2783 write (iout,*) "erij",erij
2785 ury=scalar(uy(1,i),erij)
2786 urz=scalar(uz(1,i),erij)
2787 vry=scalar(uy(1,j),erij)
2788 vrz=scalar(uz(1,j),erij)
2789 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2790 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2791 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2792 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2793 fac=dsqrt(-ael6i)*r3ij
2798 cd write (iout,'(4i5,4f10.5)')
2799 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2800 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2801 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
2802 cd & uy(:,j),uz(:,j)
2803 cd write (iout,'(4f10.5)')
2804 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2805 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2806 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2807 cd write (iout,'(9f10.5/)')
2808 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2809 C Derivatives of the elements of A in virtual-bond vectors
2811 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2813 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2814 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2815 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2816 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2817 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2818 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2819 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2820 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2821 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2822 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2823 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2824 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2826 C Compute radial contributions to the gradient
2844 C Add the contributions coming from er
2847 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2848 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2849 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2850 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2853 C Derivatives in DC(i)
2854 cgrad ghalf1=0.5d0*agg(k,1)
2855 cgrad ghalf2=0.5d0*agg(k,2)
2856 cgrad ghalf3=0.5d0*agg(k,3)
2857 cgrad ghalf4=0.5d0*agg(k,4)
2858 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2859 & -3.0d0*uryg(k,2)*vry)!+ghalf1
2860 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2861 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
2862 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2863 & -3.0d0*urzg(k,2)*vry)!+ghalf3
2864 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2865 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
2866 C Derivatives in DC(i+1)
2867 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2868 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
2869 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2870 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
2871 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2872 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
2873 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2874 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
2875 C Derivatives in DC(j)
2876 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2877 & -3.0d0*vryg(k,2)*ury)!+ghalf1
2878 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2879 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
2880 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2881 & -3.0d0*vryg(k,2)*urz)!+ghalf3
2882 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2883 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
2884 C Derivatives in DC(j+1) or DC(nres-1)
2885 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2886 & -3.0d0*vryg(k,3)*ury)
2887 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2888 & -3.0d0*vrzg(k,3)*ury)
2889 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2890 & -3.0d0*vryg(k,3)*urz)
2891 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2892 & -3.0d0*vrzg(k,3)*urz)
2893 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
2895 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
2910 aggi(k,l)=-aggi(k,l)
2911 aggi1(k,l)=-aggi1(k,l)
2912 aggj(k,l)=-aggj(k,l)
2913 aggj1(k,l)=-aggj1(k,l)
2917 if (j.lt.nres-1) then
2923 aggi(k,l)=-aggi(k,l)
2924 aggi1(k,l)=-aggi1(k,l)
2925 aggj(k,l)=-aggj(k,l)
2926 aggj1(k,l)=-aggj1(k,l)
2937 aggi(k,l)=-aggi(k,l)
2938 aggi1(k,l)=-aggi1(k,l)
2939 aggj(k,l)=-aggj(k,l)
2940 aggj1(k,l)=-aggj1(k,l)
2945 IF (wel_loc.gt.0.0d0) THEN
2946 C Contribution to the local-electrostatic energy coming from the i-j pair
2947 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2950 write (iout,*) "muij",muij," a22",a22," a23",a23," a32",a32,
2952 write (iout,*) "ij",i,j," eel_loc_ij",eel_loc_ij,
2953 & " wel_loc",wel_loc
2955 if (shield_mode.eq.0) then
2962 eel_loc_ij=eel_loc_ij
2963 & *fac_shield(i)*fac_shield(j)*sss*faclipij
2964 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
2965 & 'eelloc',i,j,eel_loc_ij
2966 c if (eel_loc_ij.ne.0)
2967 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
2968 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
2970 eel_loc=eel_loc+eel_loc_ij
2971 C Now derivative over eel_loc
2973 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2974 & (shield_mode.gt.0)) then
2977 do ilist=1,ishield_list(i)
2978 iresshield=shield_list(ilist,i)
2980 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
2983 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2985 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
2986 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2990 do ilist=1,ishield_list(j)
2991 iresshield=shield_list(ilist,j)
2993 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
2996 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2998 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
2999 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
3006 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
3007 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
3008 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
3009 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
3010 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
3011 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
3012 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
3013 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
3018 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
3019 c & ' eel_loc_ij',eel_loc_ij
3020 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
3021 C Calculate patrial derivative for theta angle
3023 geel_loc_ij=(a22*gmuij1(1)
3027 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3028 c write(iout,*) "derivative over thatai"
3029 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
3031 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
3032 & geel_loc_ij*wel_loc
3033 c write(iout,*) "derivative over thatai-1"
3034 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
3041 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3042 & geel_loc_ij*wel_loc
3043 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3045 c Derivative over j residue
3046 geel_loc_ji=a22*gmuji1(1)
3050 c write(iout,*) "derivative over thataj"
3051 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
3054 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
3055 & geel_loc_ji*wel_loc
3056 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3063 c write(iout,*) "derivative over thataj-1"
3064 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
3066 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
3067 & geel_loc_ji*wel_loc
3068 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3070 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3072 C Partial derivatives in virtual-bond dihedral angles gamma
3074 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3075 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3076 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
3077 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3079 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3080 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3081 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
3082 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3083 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3084 aux=eel_loc_ij/sss*sssgrad*rmij
3089 ggg(l)=ggg(l)+(agg(l,1)*muij(1)+
3090 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
3091 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3092 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3093 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3094 cgrad ghalf=0.5d0*ggg(l)
3095 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3096 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3098 gel_loc_long(3,j)=gel_loc_long(3,j)+
3099 & ssgradlipj*eel_loc_ij/2.0d0*lipscale/faclipij
3101 gel_loc_long(3,i)=gel_loc_long(3,i)+
3102 & ssgradlipi*eel_loc_ij/2.0d0*lipscale/faclipij
3105 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3108 C Remaining derivatives of eello
3110 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
3111 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
3112 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3114 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
3115 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
3116 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3118 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
3119 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
3120 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3122 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
3123 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
3124 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3131 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3132 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3134 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3135 & .and. num_conti.le.maxconts) then
3136 c write (iout,*) i,j," entered corr"
3138 C Calculate the contact function. The ith column of the array JCONT will
3139 C contain the numbers of atoms that make contacts with the atom I (of numbers
3140 C greater than I). The arrays FACONT and GACONT will contain the values of
3141 C the contact function and its derivative.
3142 c r0ij=1.02D0*rpp(iteli,itelj)
3143 c r0ij=1.11D0*rpp(iteli,itelj)
3144 r0ij=2.20D0*rpp(iteli,itelj)
3145 c r0ij=1.55D0*rpp(iteli,itelj)
3146 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3147 if (fcont.gt.0.0D0) then
3148 num_conti=num_conti+1
3149 if (num_conti.gt.maxconts) then
3150 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3151 & ' will skip next contacts for this conf.'
3153 jcont_hb(num_conti,i)=j
3154 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3155 cd & " jcont_hb",jcont_hb(num_conti,i)
3156 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3157 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3158 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3160 d_cont(num_conti,i)=rij
3161 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3162 C --- Electrostatic-interaction matrix ---
3163 a_chuj(1,1,num_conti,i)=a22
3164 a_chuj(1,2,num_conti,i)=a23
3165 a_chuj(2,1,num_conti,i)=a32
3166 a_chuj(2,2,num_conti,i)=a33
3167 C --- Gradient of rij
3170 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3177 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3178 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3179 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3180 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3181 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3187 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3188 C Calculate contact energies
3190 wij=cosa-3.0D0*cosb*cosg
3193 c fac3=dsqrt(-ael6i)/r0ij**3
3194 fac3=dsqrt(-ael6i)*r3ij
3195 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3196 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3197 if (ees0tmp.gt.0) then
3198 ees0pij=dsqrt(ees0tmp)
3202 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3203 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3204 if (ees0tmp.gt.0) then
3205 ees0mij=dsqrt(ees0tmp)
3210 if (shield_mode.eq.0) then
3214 ees0plist(num_conti,i)=j
3215 C fac_shield(i)=0.4d0
3216 C fac_shield(j)=0.6d0
3218 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3219 & *fac_shield(i)*fac_shield(j)
3220 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3221 & *fac_shield(i)*fac_shield(j)
3222 C Diagnostics. Comment out or remove after debugging!
3223 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3224 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3225 c ees0m(num_conti,i)=0.0D0
3227 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3228 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3229 C Angular derivatives of the contact function
3231 ees0pij1=fac3/ees0pij
3232 ees0mij1=fac3/ees0mij
3233 fac3p=-3.0D0*fac3*rrmij
3234 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3235 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3237 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3238 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3239 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3240 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3241 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3242 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3243 ecosap=ecosa1+ecosa2
3244 ecosbp=ecosb1+ecosb2
3245 ecosgp=ecosg1+ecosg2
3246 ecosam=ecosa1-ecosa2
3247 ecosbm=ecosb1-ecosb2
3248 ecosgm=ecosg1-ecosg2
3257 facont_hb(num_conti,i)=fcont
3260 fprimcont=fprimcont/rij
3261 cd facont_hb(num_conti,i)=1.0D0
3262 C Following line is for diagnostics.
3265 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3266 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3269 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3270 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3272 gggp(1)=gggp(1)+ees0pijp*xj
3273 & +ees0p(num_conti,i)/sss*rmij*xj*sssgrad
3274 gggp(2)=gggp(2)+ees0pijp*yj
3275 & +ees0p(num_conti,i)/sss*rmij*yj*sssgrad
3276 gggp(3)=gggp(3)+ees0pijp*zj
3277 & +ees0p(num_conti,i)/sss*rmij*zj*sssgrad
3278 gggm(1)=gggm(1)+ees0mijp*xj
3279 & +ees0m(num_conti,i)/sss*rmij*xj*sssgrad
3280 gggm(2)=gggm(2)+ees0mijp*yj
3281 & +ees0m(num_conti,i)/sss*rmij*yj*sssgrad
3282 gggm(3)=gggm(3)+ees0mijp*zj
3283 & +ees0m(num_conti,i)/sss*rmij*zj*sssgrad
3284 C Derivatives due to the contact function
3285 gacont_hbr(1,num_conti,i)=fprimcont*xj
3286 gacont_hbr(2,num_conti,i)=fprimcont*yj
3287 gacont_hbr(3,num_conti,i)=fprimcont*zj
3290 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3291 c following the change of gradient-summation algorithm.
3293 cgrad ghalfp=0.5D0*gggp(k)
3294 cgrad ghalfm=0.5D0*gggm(k)
3295 gacontp_hb1(k,num_conti,i)=!ghalfp
3296 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3297 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3298 & *fac_shield(i)*fac_shield(j)*sss
3300 gacontp_hb2(k,num_conti,i)=!ghalfp
3301 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3302 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3303 & *fac_shield(i)*fac_shield(j)*sss
3305 gacontp_hb3(k,num_conti,i)=gggp(k)
3306 & *fac_shield(i)*fac_shield(j)*sss
3308 gacontm_hb1(k,num_conti,i)=!ghalfm
3309 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3310 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3311 & *fac_shield(i)*fac_shield(j)*sss
3313 gacontm_hb2(k,num_conti,i)=!ghalfm
3314 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3315 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3316 & *fac_shield(i)*fac_shield(j)*sss
3318 gacontm_hb3(k,num_conti,i)=gggm(k)
3319 & *fac_shield(i)*fac_shield(j)*sss
3322 C Diagnostics. Comment out or remove after debugging!
3324 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3325 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3326 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3327 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3328 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3329 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3335 endif ! num_conti.le.maxconts
3340 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3343 ghalf=0.5d0*agg(l,k)
3344 aggi(l,k)=aggi(l,k)+ghalf
3345 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3346 aggj(l,k)=aggj(l,k)+ghalf
3349 if (j.eq.nres-1 .and. i.lt.j-2) then
3352 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3358 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3361 C-----------------------------------------------------------------------------
3362 subroutine eturn3(i,eello_turn3)
3363 C Third- and fourth-order contributions from turns
3364 implicit real*8 (a-h,o-z)
3365 include 'DIMENSIONS'
3366 include 'DIMENSIONS.ZSCOPT'
3367 include 'COMMON.IOUNITS'
3368 include 'COMMON.GEO'
3369 include 'COMMON.VAR'
3370 include 'COMMON.LOCAL'
3371 include 'COMMON.CHAIN'
3372 include 'COMMON.DERIV'
3373 include 'COMMON.INTERACT'
3374 include 'COMMON.CONTACTS'
3375 include 'COMMON.TORSION'
3376 include 'COMMON.VECTORS'
3377 include 'COMMON.FFIELD'
3378 include 'COMMON.CONTROL'
3379 include 'COMMON.SHIELD'
3380 include 'COMMON.CORRMAT'
3382 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3383 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3384 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
3385 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
3386 & auxgmat2(2,2),auxgmatt2(2,2)
3387 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3388 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3389 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3390 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3392 double precision sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij
3393 common /lipcalc/ sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij
3395 c write (iout,*) "eturn3",i,j,j1,j2
3400 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3402 C Third-order contributions
3409 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3410 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3411 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3412 c auxalary matices for theta gradient
3413 c auxalary matrix for i+1 and constant i+2
3414 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
3415 c auxalary matrix for i+2 and constant i+1
3416 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
3417 call transpose2(auxmat(1,1),auxmat1(1,1))
3418 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
3419 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
3420 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3421 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
3422 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
3423 if (shield_mode.eq.0) then
3430 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3431 & *fac_shield(i)*fac_shield(j)*faclipij
3432 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
3433 & *fac_shield(i)*fac_shield(j)
3434 if (energy_dec) write (iout,'(6heturn3,2i5,0pf7.3)') i,i+2,
3438 C Derivatives in theta
3439 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3440 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
3441 & *fac_shield(i)*fac_shield(j)*faclipij
3442 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
3443 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
3444 & *fac_shield(i)*fac_shield(j)*faclipij
3447 C Derivatives in shield mode
3448 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3449 & (shield_mode.gt.0)) then
3452 do ilist=1,ishield_list(i)
3453 iresshield=shield_list(ilist,i)
3455 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
3457 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3459 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
3460 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3464 do ilist=1,ishield_list(j)
3465 iresshield=shield_list(ilist,j)
3467 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
3469 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3471 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
3472 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3479 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
3480 & grad_shield(k,i)*eello_t3/fac_shield(i)
3481 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
3482 & grad_shield(k,j)*eello_t3/fac_shield(j)
3483 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
3484 & grad_shield(k,i)*eello_t3/fac_shield(i)
3485 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
3486 & grad_shield(k,j)*eello_t3/fac_shield(j)
3490 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3491 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3492 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3493 cd & ' eello_turn3_num',4*eello_turn3_num
3494 C Derivatives in gamma(i)
3495 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3496 call transpose2(auxmat2(1,1),auxmat3(1,1))
3497 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3498 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3499 & *fac_shield(i)*fac_shield(j)*faclipij
3500 C Derivatives in gamma(i+1)
3501 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3502 call transpose2(auxmat2(1,1),auxmat3(1,1))
3503 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3504 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3505 & +0.5d0*(pizda(1,1)+pizda(2,2))
3506 & *fac_shield(i)*fac_shield(j)*faclipij
3507 C Cartesian derivatives
3509 c ghalf1=0.5d0*agg(l,1)
3510 c ghalf2=0.5d0*agg(l,2)
3511 c ghalf3=0.5d0*agg(l,3)
3512 c ghalf4=0.5d0*agg(l,4)
3513 a_temp(1,1)=aggi(l,1)!+ghalf1
3514 a_temp(1,2)=aggi(l,2)!+ghalf2
3515 a_temp(2,1)=aggi(l,3)!+ghalf3
3516 a_temp(2,2)=aggi(l,4)!+ghalf4
3517 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3518 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3519 & +0.5d0*(pizda(1,1)+pizda(2,2))
3520 & *fac_shield(i)*fac_shield(j)*faclipij
3522 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3523 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3524 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3525 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3526 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3527 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3528 & +0.5d0*(pizda(1,1)+pizda(2,2))
3529 & *fac_shield(i)*fac_shield(j)*faclipij
3530 a_temp(1,1)=aggj(l,1)!+ghalf1
3531 a_temp(1,2)=aggj(l,2)!+ghalf2
3532 a_temp(2,1)=aggj(l,3)!+ghalf3
3533 a_temp(2,2)=aggj(l,4)!+ghalf4
3534 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3535 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3536 & +0.5d0*(pizda(1,1)+pizda(2,2))
3537 & *fac_shield(i)*fac_shield(j)*faclipij
3538 a_temp(1,1)=aggj1(l,1)
3539 a_temp(1,2)=aggj1(l,2)
3540 a_temp(2,1)=aggj1(l,3)
3541 a_temp(2,2)=aggj1(l,4)
3542 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3543 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3544 & +0.5d0*(pizda(1,1)+pizda(2,2))
3545 & *fac_shield(i)*fac_shield(j)*faclipij
3552 C-------------------------------------------------------------------------------
3553 subroutine eturn4(i,eello_turn4)
3554 C Third- and fourth-order contributions from turns
3555 implicit real*8 (a-h,o-z)
3556 include 'DIMENSIONS'
3557 include 'DIMENSIONS.ZSCOPT'
3558 include 'COMMON.IOUNITS'
3559 include 'COMMON.GEO'
3560 include 'COMMON.VAR'
3561 include 'COMMON.LOCAL'
3562 include 'COMMON.CHAIN'
3563 include 'COMMON.DERIV'
3564 include 'COMMON.INTERACT'
3565 include 'COMMON.CONTACTS'
3566 include 'COMMON.TORSION'
3567 include 'COMMON.VECTORS'
3568 include 'COMMON.FFIELD'
3569 include 'COMMON.CONTROL'
3570 include 'COMMON.SHIELD'
3571 include 'COMMON.CORRMAT'
3573 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3574 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3575 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
3576 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
3577 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
3578 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
3579 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
3580 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3581 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3582 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3583 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3585 double precision sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij
3586 common /lipcalc/ sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij
3588 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3590 C Fourth-order contributions
3598 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3599 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3600 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3601 c write(iout,*)"WCHODZE W PROGRAM"
3606 iti1=itype2loc(itype(i+1))
3607 iti2=itype2loc(itype(i+2))
3608 iti3=itype2loc(itype(i+3))
3609 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3610 call transpose2(EUg(1,1,i+1),e1t(1,1))
3611 call transpose2(Eug(1,1,i+2),e2t(1,1))
3612 call transpose2(Eug(1,1,i+3),e3t(1,1))
3613 C Ematrix derivative in theta
3614 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
3615 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
3616 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
3617 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3618 c eta1 in derivative theta
3619 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
3620 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3621 c auxgvec is derivative of Ub2 so i+3 theta
3622 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
3623 c auxalary matrix of E i+1
3624 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
3627 s1=scalar2(b1(1,i+2),auxvec(1))
3628 c derivative of theta i+2 with constant i+3
3629 gs23=scalar2(gtb1(1,i+2),auxvec(1))
3630 c derivative of theta i+2 with constant i+2
3631 gs32=scalar2(b1(1,i+2),auxgvec(1))
3632 c derivative of E matix in theta of i+1
3633 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
3635 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3636 c ea31 in derivative theta
3637 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
3638 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3639 c auxilary matrix auxgvec of Ub2 with constant E matirx
3640 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
3641 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
3642 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
3646 s2=scalar2(b1(1,i+1),auxvec(1))
3647 c derivative of theta i+1 with constant i+3
3648 gs13=scalar2(gtb1(1,i+1),auxvec(1))
3649 c derivative of theta i+2 with constant i+1
3650 gs21=scalar2(b1(1,i+1),auxgvec(1))
3651 c derivative of theta i+3 with constant i+1
3652 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
3653 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
3655 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3656 c two derivatives over diffetent matrices
3657 c gtae3e2 is derivative over i+3
3658 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
3659 c ae3gte2 is derivative over i+2
3660 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
3661 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3662 c three possible derivative over theta E matices
3664 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
3666 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
3668 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
3669 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3671 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
3672 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
3673 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
3674 if (shield_mode.eq.0) then
3681 eello_turn4=eello_turn4-(s1+s2+s3)
3682 & *fac_shield(i)*fac_shield(j)*faclipij
3683 eello_t4=-(s1+s2+s3)
3684 & *fac_shield(i)*fac_shield(j)
3685 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
3686 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
3687 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
3688 C Now derivative over shield:
3689 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3690 & (shield_mode.gt.0)) then
3693 do ilist=1,ishield_list(i)
3694 iresshield=shield_list(ilist,i)
3696 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
3698 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3700 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
3701 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3705 do ilist=1,ishield_list(j)
3706 iresshield=shield_list(ilist,j)
3708 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
3710 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3712 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
3713 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3720 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
3721 & grad_shield(k,i)*eello_t4/fac_shield(i)
3722 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
3723 & grad_shield(k,j)*eello_t4/fac_shield(j)
3724 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
3725 & grad_shield(k,i)*eello_t4/fac_shield(i)
3726 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
3727 & grad_shield(k,j)*eello_t4/fac_shield(j)
3730 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3731 cd & ' eello_turn4_num',8*eello_turn4_num
3733 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3734 & -(gs13+gsE13+gsEE1)*wturn4
3735 & *fac_shield(i)*fac_shield(j)
3736 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
3737 & -(gs23+gs21+gsEE2)*wturn4
3738 & *fac_shield(i)*fac_shield(j)
3740 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
3741 & -(gs32+gsE31+gsEE3)*wturn4
3742 & *fac_shield(i)*fac_shield(j)
3744 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
3747 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3748 & 'eturn4',i,j,-(s1+s2+s3)
3749 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3750 c & ' eello_turn4_num',8*eello_turn4_num
3751 C Derivatives in gamma(i)
3752 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3753 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3754 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3755 s1=scalar2(b1(1,i+2),auxvec(1))
3756 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3757 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3758 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3759 & *fac_shield(i)*fac_shield(j)*faclipij
3760 C Derivatives in gamma(i+1)
3761 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3762 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3763 s2=scalar2(b1(1,i+1),auxvec(1))
3764 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3765 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3766 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3767 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3768 & *fac_shield(i)*fac_shield(j)*faclipij
3769 C Derivatives in gamma(i+2)
3770 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3771 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3772 s1=scalar2(b1(1,i+2),auxvec(1))
3773 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3774 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3775 s2=scalar2(b1(1,i+1),auxvec(1))
3776 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3777 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3778 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3779 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3780 & *fac_shield(i)*fac_shield(j)*faclipij
3782 C Cartesian derivatives
3783 C Derivatives of this turn contributions in DC(i+2)
3784 if (j.lt.nres-1) then
3786 a_temp(1,1)=agg(l,1)
3787 a_temp(1,2)=agg(l,2)
3788 a_temp(2,1)=agg(l,3)
3789 a_temp(2,2)=agg(l,4)
3790 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3791 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3792 s1=scalar2(b1(1,i+2),auxvec(1))
3793 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3794 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3795 s2=scalar2(b1(1,i+1),auxvec(1))
3796 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3797 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3798 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3800 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3801 & *fac_shield(i)*fac_shield(j)*faclipij
3804 C Remaining derivatives of this turn contribution
3806 a_temp(1,1)=aggi(l,1)
3807 a_temp(1,2)=aggi(l,2)
3808 a_temp(2,1)=aggi(l,3)
3809 a_temp(2,2)=aggi(l,4)
3810 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3811 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3812 s1=scalar2(b1(1,i+2),auxvec(1))
3813 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3814 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3815 s2=scalar2(b1(1,i+1),auxvec(1))
3816 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3817 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3818 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3819 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3820 & *fac_shield(i)*fac_shield(j)*faclipij
3821 a_temp(1,1)=aggi1(l,1)
3822 a_temp(1,2)=aggi1(l,2)
3823 a_temp(2,1)=aggi1(l,3)
3824 a_temp(2,2)=aggi1(l,4)
3825 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3826 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3827 s1=scalar2(b1(1,i+2),auxvec(1))
3828 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3829 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3830 s2=scalar2(b1(1,i+1),auxvec(1))
3831 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3832 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3833 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3834 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3835 & *fac_shield(i)*fac_shield(j)*faclipij
3836 a_temp(1,1)=aggj(l,1)
3837 a_temp(1,2)=aggj(l,2)
3838 a_temp(2,1)=aggj(l,3)
3839 a_temp(2,2)=aggj(l,4)
3840 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3841 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3842 s1=scalar2(b1(1,i+2),auxvec(1))
3843 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3844 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3845 s2=scalar2(b1(1,i+1),auxvec(1))
3846 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3847 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3848 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3849 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3850 & *fac_shield(i)*fac_shield(j)*faclipij
3851 a_temp(1,1)=aggj1(l,1)
3852 a_temp(1,2)=aggj1(l,2)
3853 a_temp(2,1)=aggj1(l,3)
3854 a_temp(2,2)=aggj1(l,4)
3855 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3856 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3857 s1=scalar2(b1(1,i+2),auxvec(1))
3858 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3859 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3860 s2=scalar2(b1(1,i+1),auxvec(1))
3861 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3862 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3863 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3864 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3865 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3866 & *fac_shield(i)*fac_shield(j)*faclipij
3873 C-----------------------------------------------------------------------------
3874 subroutine vecpr(u,v,w)
3875 implicit real*8(a-h,o-z)
3876 dimension u(3),v(3),w(3)
3877 w(1)=u(2)*v(3)-u(3)*v(2)
3878 w(2)=-u(1)*v(3)+u(3)*v(1)
3879 w(3)=u(1)*v(2)-u(2)*v(1)
3882 C-----------------------------------------------------------------------------
3883 subroutine unormderiv(u,ugrad,unorm,ungrad)
3884 C This subroutine computes the derivatives of a normalized vector u, given
3885 C the derivatives computed without normalization conditions, ugrad. Returns
3888 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3889 double precision vec(3)
3890 double precision scalar
3892 c write (2,*) 'ugrad',ugrad
3895 vec(i)=scalar(ugrad(1,i),u(1))
3897 c write (2,*) 'vec',vec
3900 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3903 c write (2,*) 'ungrad',ungrad
3906 C-----------------------------------------------------------------------------
3907 subroutine escp(evdw2,evdw2_14)
3909 C This subroutine calculates the excluded-volume interaction energy between
3910 C peptide-group centers and side chains and its gradient in virtual-bond and
3911 C side-chain vectors.
3913 implicit real*8 (a-h,o-z)
3914 include 'DIMENSIONS'
3915 include 'DIMENSIONS.ZSCOPT'
3916 include 'COMMON.CONTROL'
3917 include 'COMMON.GEO'
3918 include 'COMMON.VAR'
3919 include 'COMMON.LOCAL'
3920 include 'COMMON.CHAIN'
3921 include 'COMMON.DERIV'
3922 include 'COMMON.INTERACT'
3923 include 'COMMON.FFIELD'
3924 include 'COMMON.IOUNITS'
3928 cd print '(a)','Enter ESCP'
3929 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
3930 c & ' scal14',scal14
3931 do i=iatscp_s,iatscp_e
3932 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3934 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
3935 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
3936 if (iteli.eq.0) goto 1225
3937 xi=0.5D0*(c(1,i)+c(1,i+1))
3938 yi=0.5D0*(c(2,i)+c(2,i+1))
3939 zi=0.5D0*(c(3,i)+c(3,i+1))
3940 call to_box(xi,yi,zi)
3941 do iint=1,nscp_gr(i)
3943 do j=iscpstart(i,iint),iscpend(i,iint)
3944 itypj=iabs(itype(j))
3945 if (itypj.eq.ntyp1) cycle
3946 C Uncomment following three lines for SC-p interactions
3950 C Uncomment following three lines for Ca-p interactions
3954 C returning the jth atom to box
3955 call to_box(xj,yj,zj)
3956 xj=boxshift(xj-xi,boxxsize)
3957 yj=boxshift(yj-yi,boxysize)
3958 zj=boxshift(zj-zi,boxzsize)
3959 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3960 C sss is scaling function for smoothing the cutoff gradient otherwise
3961 C the gradient would not be continuouse
3962 sss=sscale(1.0d0/(dsqrt(rrij)))
3963 if (sss.le.0.0d0) cycle
3964 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3966 e1=fac*fac*aad(itypj,iteli)
3967 e2=fac*bad(itypj,iteli)
3968 if (iabs(j-i) .le. 2) then
3971 evdw2_14=evdw2_14+(e1+e2)*sss
3974 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3975 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
3976 c & bad(itypj,iteli)
3977 evdw2=evdw2+evdwij*sss
3978 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3979 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
3984 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3986 fac=-(evdwij+e1)*rrij*sss
3987 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
3992 cd write (iout,*) 'j<i'
3993 C Uncomment following three lines for SC-p interactions
3995 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3998 cd write (iout,*) 'j>i'
4001 C Uncomment following line for SC-p interactions
4002 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4006 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4010 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4011 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4014 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4024 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4025 gradx_scp(j,i)=expon*gradx_scp(j,i)
4028 C******************************************************************************
4032 C To save time the factor EXPON has been extracted from ALL components
4033 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4036 C******************************************************************************
4039 C--------------------------------------------------------------------------
4040 subroutine edis(ehpb)
4042 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4044 implicit real*8 (a-h,o-z)
4045 include 'DIMENSIONS'
4046 include 'DIMENSIONS.ZSCOPT'
4047 include 'COMMON.SBRIDGE'
4048 include 'COMMON.CHAIN'
4049 include 'COMMON.DERIV'
4050 include 'COMMON.VAR'
4051 include 'COMMON.INTERACT'
4052 include 'COMMON.CONTROL'
4053 include 'COMMON.IOUNITS'
4054 dimension ggg(3),ggg_peak(3,1000)
4059 c 8/21/18 AL: added explicit restraints on reference coords
4060 c write (iout,*) "restr_on_coord",restr_on_coord
4061 if (restr_on_coord) then
4065 if (itype(i).eq.ntyp1) cycle
4067 ecoor=ecoor+(c(j,i)-cref(j,i))**2
4068 ghpbc(j,i)=ghpbc(j,i)+bfac(i)*(c(j,i)-cref(j,i))
4070 if (itype(i).ne.10) then
4072 ecoor=ecoor+(c(j,i+nres)-cref(j,i+nres))**2
4073 ghpbx(j,i)=ghpbx(j,i)+bfac(i)*(c(j,i+nres)-cref(j,i+nres))
4076 if (energy_dec) write (iout,*)
4077 & "i",i," bfac",bfac(i)," ecoor",ecoor
4078 ehpb=ehpb+0.5d0*bfac(i)*ecoor
4083 C write (iout,*) ,"link_end",link_end,constr_dist
4084 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4085 c write(iout,*)'link_start=',link_start,' link_end=',link_end,
4086 c & " constr_dist",constr_dist
4087 if (link_end.eq.0.and.link_end_peak.eq.0) return
4088 do i=link_start_peak,link_end_peak
4090 c print *,"i",i," link_end_peak",link_end_peak," ipeak",
4091 c & ipeak(1,i),ipeak(2,i)
4092 do ip=ipeak(1,i),ipeak(2,i)
4097 C iii and jjj point to the residues for which the distance is assigned.
4098 c if (ii.gt.nres) then
4105 if (ii.gt.nres) then
4110 if (jj.gt.nres) then
4115 aux=rlornmr1(dd,dhpb_peak(ip),dhpb1_peak(ip),forcon_peak(ip))
4116 aux=dexp(-scal_peak*aux)
4117 ehpb_peak=ehpb_peak+aux
4118 fac=rlornmr1prim(dd,dhpb_peak(ip),dhpb1_peak(ip),
4119 & forcon_peak(ip))*aux/dd
4121 ggg_peak(j,iip)=fac*(c(j,jj)-c(j,ii))
4123 if (energy_dec) write (iout,'(a6,3i5,6f10.3,i5)')
4124 & "edisL",i,ii,jj,dd,dhpb_peak(ip),dhpb1_peak(ip),
4125 & forcon_peak(ip),fordepth_peak(ip),ehpb_peak
4127 c write (iout,*) "ehpb_peak",ehpb_peak," scal_peak",scal_peak
4128 ehpb=ehpb-fordepth_peak(ipeak(1,i))*dlog(ehpb_peak)/scal_peak
4129 do ip=ipeak(1,i),ipeak(2,i)
4132 ggg(j)=ggg_peak(j,iip)/ehpb_peak
4136 C iii and jjj point to the residues for which the distance is assigned.
4137 if (ii.gt.nres) then
4146 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4151 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4155 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4156 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4160 do i=link_start,link_end
4161 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4162 C CA-CA distance used in regularization of structure.
4165 C iii and jjj point to the residues for which the distance is assigned.
4166 if (ii.gt.nres) then
4171 if (jj.gt.nres) then
4176 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4177 c & dhpb(i),dhpb1(i),forcon(i)
4178 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4179 C distance and angle dependent SS bond potential.
4180 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4181 C & iabs(itype(jjj)).eq.1) then
4182 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4183 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4184 if (.not.dyn_ss .and. i.le.nss) then
4185 C 15/02/13 CC dynamic SSbond - additional check
4186 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4187 & iabs(itype(jjj)).eq.1) then
4188 call ssbond_ene(iii,jjj,eij)
4191 cd write (iout,*) "eij",eij
4192 cd & ' waga=',waga,' fac=',fac
4193 ! else if (ii.gt.nres .and. jj.gt.nres) then
4195 C Calculate the distance between the two points and its difference from the
4198 if (irestr_type(i).eq.11) then
4199 ehpb=ehpb+fordepth(i)!**4.0d0
4200 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4201 fac=fordepth(i)!**4.0d0
4202 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4203 if (energy_dec) write (iout,'(a6,2i5,6f10.3,i5)')
4204 & "edisL",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
4205 & ehpb,irestr_type(i)
4206 else if (irestr_type(i).eq.10) then
4207 c AL 6//19/2018 cross-link restraints
4208 xdis = 0.5d0*(dd/forcon(i))**2
4209 expdis = dexp(-xdis)
4210 c aux=(dhpb(i)+dhpb1(i)*xdis)*expdis+fordepth(i)
4211 aux=(dhpb(i)+dhpb1(i)*xdis*xdis)*expdis+fordepth(i)
4212 c write (iout,*)"HERE: xdis",xdis," expdis",expdis," aux",aux,
4213 c & " wboltzd",wboltzd
4214 ehpb=ehpb-wboltzd*xlscore(i)*dlog(aux)
4215 c fac=-wboltzd*(dhpb1(i)*(1.0d0-xdis)-dhpb(i))
4216 fac=-wboltzd*xlscore(i)*(dhpb1(i)*(2.0d0-xdis)*xdis-dhpb(i))
4217 & *expdis/(aux*forcon(i)**2)
4218 if (energy_dec) write(iout,'(a6,2i5,6f10.3,i5)')
4219 & "edisX",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
4220 & -wboltzd*xlscore(i)*dlog(aux),irestr_type(i)
4221 else if (irestr_type(i).eq.2) then
4222 c Quartic restraints
4223 ehpb=ehpb+forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4224 if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
4225 & "edisQ",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
4226 & forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)),irestr_type(i)
4227 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4229 c Quadratic restraints
4231 C Get the force constant corresponding to this distance.
4233 C Calculate the contribution to energy.
4234 ehpb=ehpb+0.5d0*waga*rdis*rdis
4235 if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
4236 & "edisS",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
4237 & 0.5d0*waga*rdis*rdis,irestr_type(i)
4239 C Evaluate gradient.
4243 c Calculate Cartesian gradient
4245 ggg(j)=fac*(c(j,jj)-c(j,ii))
4247 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4248 C If this is a SC-SC distance, we need to calculate the contributions to the
4249 C Cartesian gradient in the SC vectors (ghpbx).
4252 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4257 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4261 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4262 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4268 C--------------------------------------------------------------------------
4269 subroutine ssbond_ene(i,j,eij)
4271 C Calculate the distance and angle dependent SS-bond potential energy
4272 C using a free-energy function derived based on RHF/6-31G** ab initio
4273 C calculations of diethyl disulfide.
4275 C A. Liwo and U. Kozlowska, 11/24/03
4277 implicit real*8 (a-h,o-z)
4278 include 'DIMENSIONS'
4279 include 'DIMENSIONS.ZSCOPT'
4280 include 'COMMON.SBRIDGE'
4281 include 'COMMON.CHAIN'
4282 include 'COMMON.DERIV'
4283 include 'COMMON.LOCAL'
4284 include 'COMMON.INTERACT'
4285 include 'COMMON.VAR'
4286 include 'COMMON.IOUNITS'
4287 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4288 itypi=iabs(itype(i))
4292 dxi=dc_norm(1,nres+i)
4293 dyi=dc_norm(2,nres+i)
4294 dzi=dc_norm(3,nres+i)
4295 dsci_inv=dsc_inv(itypi)
4296 itypj=iabs(itype(j))
4297 dscj_inv=dsc_inv(itypj)
4301 dxj=dc_norm(1,nres+j)
4302 dyj=dc_norm(2,nres+j)
4303 dzj=dc_norm(3,nres+j)
4304 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4309 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4310 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4311 om12=dxi*dxj+dyi*dyj+dzi*dzj
4313 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4314 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4320 deltat12=om2-om1+2.0d0
4322 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4323 & +akct*deltad*deltat12
4324 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4325 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4326 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4327 c & " deltat12",deltat12," eij",eij
4328 ed=2*akcm*deltad+akct*deltat12
4330 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4331 eom1=-2*akth*deltat1-pom1-om2*pom2
4332 eom2= 2*akth*deltat2+pom1-om1*pom2
4335 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4338 ghpbx(k,i)=ghpbx(k,i)-gg(k)
4339 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
4340 ghpbx(k,j)=ghpbx(k,j)+gg(k)
4341 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
4344 C Calculate the components of the gradient in DC and X
4348 ghpbc(l,k)=ghpbc(l,k)+gg(l)
4353 C--------------------------------------------------------------------------
4354 c MODELLER restraint function
4355 subroutine e_modeller(ehomology_constr)
4356 implicit real*8 (a-h,o-z)
4357 include 'DIMENSIONS'
4358 include 'DIMENSIONS.ZSCOPT'
4359 include 'DIMENSIONS.FREE'
4360 integer nnn, i, j, k, ki, irec, l
4361 integer katy, odleglosci, test7
4362 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
4363 real*8 distance(max_template),distancek(max_template),
4364 & min_odl,godl(max_template),dih_diff(max_template)
4367 c FP - 30/10/2014 Temporary specifications for homology restraints
4369 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
4371 double precision, dimension (maxres) :: guscdiff,usc_diff
4372 double precision, dimension (max_template) ::
4373 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
4376 include 'COMMON.SBRIDGE'
4377 include 'COMMON.CHAIN'
4378 include 'COMMON.GEO'
4379 include 'COMMON.DERIV'
4380 include 'COMMON.LOCAL'
4381 include 'COMMON.INTERACT'
4382 include 'COMMON.VAR'
4383 include 'COMMON.IOUNITS'
4384 include 'COMMON.CONTROL'
4385 include 'COMMON.HOMRESTR'
4386 include 'COMMON.HOMOLOGY'
4387 include 'COMMON.SETUP'
4388 include 'COMMON.NAMES'
4391 distancek(i)=9999999.9
4396 c Pseudo-energy and gradient from homology restraints (MODELLER-like
4398 C AL 5/2/14 - Introduce list of restraints
4399 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
4401 write(iout,*) "------- dist restrs start -------"
4403 do ii = link_start_homo,link_end_homo
4407 c write (iout,*) "dij(",i,j,") =",dij
4409 do k=1,constr_homology
4410 if(.not.l_homo(k,ii)) then
4414 distance(k)=odl(k,ii)-dij
4415 c write (iout,*) "distance(",k,") =",distance(k)
4417 c For Gaussian-type Urestr
4419 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
4420 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
4421 c write (iout,*) "distancek(",k,") =",distancek(k)
4422 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
4424 c For Lorentzian-type Urestr
4426 if (waga_dist.lt.0.0d0) then
4427 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
4428 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
4429 & (distance(k)**2+sigma_odlir(k,ii)**2))
4433 c min_odl=minval(distancek)
4437 do kk=1,constr_homology
4438 if(l_homo(kk,ii)) then
4439 min_odl=distancek(kk)
4443 do kk=1,constr_homology
4444 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
4445 & min_odl=distancek(kk)
4448 c write (iout,* )"min_odl",min_odl
4450 write (iout,*) "ij dij",i,j,dij
4451 write (iout,*) "distance",(distance(k),k=1,constr_homology)
4452 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
4453 write (iout,* )"min_odl",min_odl
4458 if (waga_dist.ge.0.0d0) then
4464 do k=1,constr_homology
4465 c Nie wiem po co to liczycie jeszcze raz!
4466 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
4467 c & (2*(sigma_odl(i,j,k))**2))
4468 if(.not.l_homo(k,ii)) cycle
4469 if (waga_dist.ge.0.0d0) then
4471 c For Gaussian-type Urestr
4473 godl(k)=dexp(-distancek(k)+min_odl)
4474 odleg2=odleg2+godl(k)
4476 c For Lorentzian-type Urestr
4479 odleg2=odleg2+distancek(k)
4482 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
4483 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
4484 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
4485 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
4488 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
4489 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
4491 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
4492 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
4494 if (waga_dist.ge.0.0d0) then
4496 c For Gaussian-type Urestr
4498 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
4500 c For Lorentzian-type Urestr
4503 odleg=odleg+odleg2/constr_homology
4507 c write (iout,*) "odleg",odleg ! sum of -ln-s
4510 c For Gaussian-type Urestr
4512 if (waga_dist.ge.0.0d0) sum_godl=odleg2
4514 do k=1,constr_homology
4515 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
4516 c & *waga_dist)+min_odl
4517 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
4519 if(.not.l_homo(k,ii)) cycle
4520 if (waga_dist.ge.0.0d0) then
4521 c For Gaussian-type Urestr
4523 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
4525 c For Lorentzian-type Urestr
4528 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
4529 & sigma_odlir(k,ii)**2)**2)
4531 sum_sgodl=sum_sgodl+sgodl
4533 c sgodl2=sgodl2+sgodl
4534 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
4535 c write(iout,*) "constr_homology=",constr_homology
4536 c write(iout,*) i, j, k, "TEST K"
4538 if (waga_dist.ge.0.0d0) then
4540 c For Gaussian-type Urestr
4542 grad_odl3=waga_homology(iset)*waga_dist
4543 & *sum_sgodl/(sum_godl*dij)
4545 c For Lorentzian-type Urestr
4548 c Original grad expr modified by analogy w Gaussian-type Urestr grad
4549 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
4550 grad_odl3=-waga_homology(iset)*waga_dist*
4551 & sum_sgodl/(constr_homology*dij)
4554 c grad_odl3=sum_sgodl/(sum_godl*dij)
4557 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
4558 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
4559 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
4561 ccc write(iout,*) godl, sgodl, grad_odl3
4563 c grad_odl=grad_odl+grad_odl3
4566 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
4567 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
4568 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
4569 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
4570 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
4571 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
4572 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
4573 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
4574 c if (i.eq.25.and.j.eq.27) then
4575 c write(iout,*) "jik",jik,"i",i,"j",j
4576 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
4577 c write(iout,*) "grad_odl3",grad_odl3
4578 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
4579 c write(iout,*) "ggodl",ggodl
4580 c write(iout,*) "ghpbc(",jik,i,")",
4581 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
4586 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
4587 ccc & dLOG(odleg2),"-odleg=", -odleg
4589 enddo ! ii-loop for dist
4591 write(iout,*) "------- dist restrs end -------"
4592 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
4593 c & waga_d.eq.1.0d0) call sum_gradient
4595 c Pseudo-energy and gradient from dihedral-angle restraints from
4596 c homology templates
4597 c write (iout,*) "End of distance loop"
4600 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
4602 write(iout,*) "------- dih restrs start -------"
4603 do i=idihconstr_start_homo,idihconstr_end_homo
4604 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
4607 do i=idihconstr_start_homo,idihconstr_end_homo
4609 c betai=beta(i,i+1,i+2,i+3)
4611 c write (iout,*) "betai =",betai
4612 do k=1,constr_homology
4613 dih_diff(k)=pinorm(dih(k,i)-betai)
4614 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
4615 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
4616 c & -(6.28318-dih_diff(i,k))
4617 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
4618 c & 6.28318+dih_diff(i,k)
4620 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
4622 kat3=(dcos(dih_diff(k))-1)*sigma_dih(k,i)
4624 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
4627 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
4630 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
4631 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
4633 write (iout,*) "i",i," betai",betai," kat2",kat2
4634 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
4636 if (kat2.le.1.0d-14) cycle
4637 kat=kat-dLOG(kat2/constr_homology)
4638 c write (iout,*) "kat",kat ! sum of -ln-s
4640 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
4641 ccc & dLOG(kat2), "-kat=", -kat
4644 c ----------------------------------------------------------------------
4646 c ----------------------------------------------------------------------
4650 do k=1,constr_homology
4652 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
4654 sgdih=-gdih(k)*dsin(dih_diff(k))*sigma_dih(k,i)
4656 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
4657 sum_sgdih=sum_sgdih+sgdih
4659 c grad_dih3=sum_sgdih/sum_gdih
4660 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
4662 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
4663 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
4664 ccc & gloc(nphi+i-3,icg)
4665 gloc(i,icg)=gloc(i,icg)+grad_dih3
4667 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
4669 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
4670 ccc & gloc(nphi+i-3,icg)
4672 enddo ! i-loop for dih
4674 write(iout,*) "------- dih restrs end -------"
4677 c Pseudo-energy and gradient for theta angle restraints from
4678 c homology templates
4679 c FP 01/15 - inserted from econstr_local_test.F, loop structure
4683 c For constr_homology reference structures (FP)
4685 c Uconst_back_tot=0.0d0
4688 c Econstr_back legacy
4691 c do i=ithet_start,ithet_end
4694 c do i=loc_start,loc_end
4697 duscdiffx(j,i)=0.0d0
4703 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
4704 c write (iout,*) "waga_theta",waga_theta
4705 if (waga_theta.gt.0.0d0) then
4707 write (iout,*) "usampl",usampl
4708 write(iout,*) "------- theta restrs start -------"
4709 c do i=ithet_start,ithet_end
4710 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
4713 c write (iout,*) "maxres",maxres,"nres",nres
4715 do i=ithet_start,ithet_end
4718 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
4720 c Deviation of theta angles wrt constr_homology ref structures
4722 utheta_i=0.0d0 ! argument of Gaussian for single k
4723 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
4724 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
4725 c over residues in a fragment
4726 c write (iout,*) "theta(",i,")=",theta(i)
4727 do k=1,constr_homology
4729 c dtheta_i=theta(j)-thetaref(j,iref)
4730 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
4731 theta_diff(k)=thetatpl(k,i)-theta(i)
4733 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
4734 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
4735 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
4736 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
4737 c Gradient for single Gaussian restraint in subr Econstr_back
4738 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
4741 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
4742 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
4746 c Gradient for multiple Gaussian restraint
4747 sum_gtheta=gutheta_i
4749 do k=1,constr_homology
4750 c New generalized expr for multiple Gaussian from Econstr_back
4751 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
4753 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
4754 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
4757 c Final value of gradient using same var as in Econstr_back
4758 dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
4759 & *waga_homology(iset)
4760 c dutheta(i)=sum_sgtheta/sum_gtheta
4762 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
4764 Eval=Eval-dLOG(gutheta_i/constr_homology)
4765 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
4766 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
4767 c Uconst_back=Uconst_back+utheta(i)
4768 enddo ! (i-loop for theta)
4770 write(iout,*) "------- theta restrs end -------"
4774 c Deviation of local SC geometry
4776 c Separation of two i-loops (instructed by AL - 11/3/2014)
4778 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
4779 c write (iout,*) "waga_d",waga_d
4782 write(iout,*) "------- SC restrs start -------"
4783 write (iout,*) "Initial duscdiff,duscdiffx"
4784 do i=loc_start,loc_end
4785 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
4786 & (duscdiffx(jik,i),jik=1,3)
4789 do i=loc_start,loc_end
4790 usc_diff_i=0.0d0 ! argument of Gaussian for single k
4791 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
4792 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
4793 c write(iout,*) "xxtab, yytab, zztab"
4794 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
4795 do k=1,constr_homology
4797 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
4798 c Original sign inverted for calc of gradients (s. Econstr_back)
4799 dyy=-yytpl(k,i)+yytab(i) ! ibid y
4800 dzz=-zztpl(k,i)+zztab(i) ! ibid z
4801 c write(iout,*) "dxx, dyy, dzz"
4802 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
4804 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
4805 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
4806 c uscdiffk(k)=usc_diff(i)
4807 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
4808 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
4809 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
4810 c & xxref(j),yyref(j),zzref(j)
4815 c Generalized expression for multiple Gaussian acc to that for a single
4816 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
4818 c Original implementation
4819 c sum_guscdiff=guscdiff(i)
4821 c sum_sguscdiff=0.0d0
4822 c do k=1,constr_homology
4823 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
4824 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
4825 c sum_sguscdiff=sum_sguscdiff+sguscdiff
4828 c Implementation of new expressions for gradient (Jan. 2015)
4830 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
4832 do k=1,constr_homology
4834 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
4835 c before. Now the drivatives should be correct
4837 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
4838 c Original sign inverted for calc of gradients (s. Econstr_back)
4839 dyy=-yytpl(k,i)+yytab(i) ! ibid y
4840 dzz=-zztpl(k,i)+zztab(i) ! ibid z
4842 c New implementation
4844 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
4845 & sigma_d(k,i) ! for the grad wrt r'
4846 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
4849 c New implementation
4850 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
4852 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
4853 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
4854 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
4855 duscdiff(jik,i)=duscdiff(jik,i)+
4856 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
4857 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
4858 duscdiffx(jik,i)=duscdiffx(jik,i)+
4859 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
4860 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
4863 write(iout,*) "jik",jik,"i",i
4864 write(iout,*) "dxx, dyy, dzz"
4865 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
4866 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
4867 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
4868 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
4869 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
4870 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
4871 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
4872 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
4873 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
4874 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
4875 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
4876 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
4877 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
4878 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
4879 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
4886 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
4887 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
4889 c write (iout,*) i," uscdiff",uscdiff(i)
4891 c Put together deviations from local geometry
4893 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
4894 c & wfrag_back(3,i,iset)*uscdiff(i)
4895 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
4896 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
4897 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
4898 c Uconst_back=Uconst_back+usc_diff(i)
4900 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
4902 c New implment: multiplied by sum_sguscdiff
4905 enddo ! (i-loop for dscdiff)
4910 write(iout,*) "------- SC restrs end -------"
4911 write (iout,*) "------ After SC loop in e_modeller ------"
4912 do i=loc_start,loc_end
4913 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
4914 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
4916 if (waga_theta.eq.1.0d0) then
4917 write (iout,*) "in e_modeller after SC restr end: dutheta"
4918 do i=ithet_start,ithet_end
4919 write (iout,*) i,dutheta(i)
4922 if (waga_d.eq.1.0d0) then
4923 write (iout,*) "e_modeller after SC loop: duscdiff/x"
4925 write (iout,*) i,(duscdiff(j,i),j=1,3)
4926 write (iout,*) i,(duscdiffx(j,i),j=1,3)
4931 c Total energy from homology restraints
4933 write (iout,*) "odleg",odleg," kat",kat
4934 write (iout,*) "odleg",odleg," kat",kat
4935 write (iout,*) "Eval",Eval," Erot",Erot
4936 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
4937 write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
4938 write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
4941 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
4943 c ehomology_constr=odleg+kat
4945 c For Lorentzian-type Urestr
4948 if (waga_dist.ge.0.0d0) then
4950 c For Gaussian-type Urestr
4952 c ehomology_constr=(waga_dist*odleg+waga_angle*kat+
4953 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
4954 ehomology_constr=waga_dist*odleg+waga_angle*kat+
4955 & waga_theta*Eval+waga_d*Erot
4956 c write (iout,*) "ehomology_constr=",ehomology_constr
4959 c For Lorentzian-type Urestr
4961 c ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
4962 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
4963 ehomology_constr=-waga_dist*odleg+waga_angle*kat+
4964 & waga_theta*Eval+waga_d*Erot
4965 c write (iout,*) "ehomology_constr=",ehomology_constr
4968 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
4969 & "Eval",waga_theta,eval,
4970 & "Erot",waga_d,Erot
4971 write (iout,*) "ehomology_constr",ehomology_constr
4975 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
4976 747 format(a12,i4,i4,i4,f8.3,f8.3)
4977 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
4978 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
4979 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
4980 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
4982 c-----------------------------------------------------------------------
4983 subroutine ebond(estr)
4985 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4987 implicit real*8 (a-h,o-z)
4988 include 'DIMENSIONS'
4989 include 'DIMENSIONS.ZSCOPT'
4990 include 'COMMON.LOCAL'
4991 include 'COMMON.GEO'
4992 include 'COMMON.INTERACT'
4993 include 'COMMON.DERIV'
4994 include 'COMMON.VAR'
4995 include 'COMMON.CHAIN'
4996 include 'COMMON.IOUNITS'
4997 include 'COMMON.NAMES'
4998 include 'COMMON.FFIELD'
4999 include 'COMMON.CONTROL'
5000 double precision u(3),ud(3)
5003 c write (iout,*) "distchainmax",distchainmax
5006 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) cycle
5007 diff = vbld(i)-vbldp0
5009 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5010 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5012 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5013 C & *dc(j,i-1)/vbld(i)
5015 C if (energy_dec) write(iout,*)
5016 C & "estr1",i,vbld(i),distchainmax,
5017 C & gnmr1(vbld(i),-1.0d0,distchainmax)
5019 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5020 diff = vbld(i)-vbldpDUM
5021 C write(iout,*) i,diff
5023 diff = vbld(i)-vbldp0
5024 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
5029 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5032 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
5033 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5035 estr=0.5d0*AKP*estr+estr1
5037 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5041 if (iti.ne.10 .and. iti.ne.ntyp1) then
5044 diff=vbld(i+nres)-vbldsc0(1,iti)
5045 if (energy_dec) write (iout,*) "estr sc",iti,vbld(i+nres),
5046 & vbldsc0(1,iti),diff,
5047 & AKSC(1,iti),AKSC(1,iti)*diff*diff
5048 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5050 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5054 diff=vbld(i+nres)-vbldsc0(j,iti)
5055 ud(j)=aksc(j,iti)*diff
5056 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5070 uprod2=uprod2*u(k)*u(k)
5074 usumsqder=usumsqder+ud(j)*uprod2
5076 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
5077 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
5078 estr=estr+uprod/usum
5080 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5088 C--------------------------------------------------------------------------
5089 subroutine ebend(etheta,ethetacnstr)
5091 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5092 C angles gamma and its derivatives in consecutive thetas and gammas.
5094 implicit real*8 (a-h,o-z)
5095 include 'DIMENSIONS'
5096 include 'DIMENSIONS.ZSCOPT'
5097 include 'COMMON.LOCAL'
5098 include 'COMMON.GEO'
5099 include 'COMMON.INTERACT'
5100 include 'COMMON.DERIV'
5101 include 'COMMON.VAR'
5102 include 'COMMON.CHAIN'
5103 include 'COMMON.IOUNITS'
5104 include 'COMMON.NAMES'
5105 include 'COMMON.FFIELD'
5106 include 'COMMON.TORCNSTR'
5107 common /calcthet/ term1,term2,termm,diffak,ratak,
5108 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5109 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5110 double precision y(2),z(2)
5112 c time11=dexp(-2*time)
5115 c write (iout,*) "nres",nres
5116 c write (*,'(a,i2)') 'EBEND ICG=',icg
5117 c write (iout,*) ithet_start,ithet_end
5118 do i=ithet_start,ithet_end
5119 C if (itype(i-1).eq.ntyp1) cycle
5121 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5122 & .or.itype(i).eq.ntyp1) cycle
5123 C Zero the energy function and its derivative at 0 or pi.
5124 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5126 ichir1=isign(1,itype(i-2))
5127 ichir2=isign(1,itype(i))
5128 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5129 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5130 if (itype(i-1).eq.10) then
5131 itype1=isign(10,itype(i-2))
5132 ichir11=isign(1,itype(i-2))
5133 ichir12=isign(1,itype(i-2))
5134 itype2=isign(10,itype(i))
5135 ichir21=isign(1,itype(i))
5136 ichir22=isign(1,itype(i))
5143 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5147 c call proc_proc(phii,icrc)
5148 if (icrc.eq.1) phii=150.0
5159 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5163 c call proc_proc(phii1,icrc)
5164 if (icrc.eq.1) phii1=150.0
5176 C Calculate the "mean" value of theta from the part of the distribution
5177 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5178 C In following comments this theta will be referred to as t_c.
5179 thet_pred_mean=0.0d0
5181 athetk=athet(k,it,ichir1,ichir2)
5182 bthetk=bthet(k,it,ichir1,ichir2)
5184 athetk=athet(k,itype1,ichir11,ichir12)
5185 bthetk=bthet(k,itype2,ichir21,ichir22)
5187 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5189 c write (iout,*) "thet_pred_mean",thet_pred_mean
5190 dthett=thet_pred_mean*ssd
5191 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5192 c write (iout,*) "thet_pred_mean",thet_pred_mean
5193 C Derivatives of the "mean" values in gamma1 and gamma2.
5194 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
5195 &+athet(2,it,ichir1,ichir2)*y(1))*ss
5196 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
5197 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
5199 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
5200 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
5201 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
5202 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5204 if (theta(i).gt.pi-delta) then
5205 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
5207 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5208 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5209 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5211 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5213 else if (theta(i).lt.delta) then
5214 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5215 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5216 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5218 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5219 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5222 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5225 etheta=etheta+ethetai
5226 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
5227 c & 'ebend',i,ethetai,theta(i),itype(i)
5228 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
5229 c & rad2deg*phii,rad2deg*phii1,ethetai
5230 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5231 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5232 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
5236 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
5237 do i=1,ntheta_constr
5238 itheta=itheta_constr(i)
5239 thetiii=theta(itheta)
5240 difi=pinorm(thetiii-theta_constr0(i))
5241 if (difi.gt.theta_drange(i)) then
5242 difi=difi-theta_drange(i)
5243 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5244 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
5245 & +for_thet_constr(i)*difi**3
5246 else if (difi.lt.-drange(i)) then
5248 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5249 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
5250 & +for_thet_constr(i)*difi**3
5254 C if (energy_dec) then
5255 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
5256 C & i,itheta,rad2deg*thetiii,
5257 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
5258 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
5259 C & gloc(itheta+nphi-2,icg)
5262 C Ufff.... We've done all this!!!
5265 C---------------------------------------------------------------------------
5266 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5268 implicit real*8 (a-h,o-z)
5269 include 'DIMENSIONS'
5270 include 'COMMON.LOCAL'
5271 include 'COMMON.IOUNITS'
5272 common /calcthet/ term1,term2,termm,diffak,ratak,
5273 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5274 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5275 C Calculate the contributions to both Gaussian lobes.
5276 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5277 C The "polynomial part" of the "standard deviation" of this part of
5281 sig=sig*thet_pred_mean+polthet(j,it)
5283 C Derivative of the "interior part" of the "standard deviation of the"
5284 C gamma-dependent Gaussian lobe in t_c.
5285 sigtc=3*polthet(3,it)
5287 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5290 C Set the parameters of both Gaussian lobes of the distribution.
5291 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5292 fac=sig*sig+sigc0(it)
5295 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5296 sigsqtc=-4.0D0*sigcsq*sigtc
5297 c print *,i,sig,sigtc,sigsqtc
5298 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5299 sigtc=-sigtc/(fac*fac)
5300 C Following variable is sigma(t_c)**(-2)
5301 sigcsq=sigcsq*sigcsq
5303 sig0inv=1.0D0/sig0i**2
5304 delthec=thetai-thet_pred_mean
5305 delthe0=thetai-theta0i
5306 term1=-0.5D0*sigcsq*delthec*delthec
5307 term2=-0.5D0*sig0inv*delthe0*delthe0
5308 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5309 C NaNs in taking the logarithm. We extract the largest exponent which is added
5310 C to the energy (this being the log of the distribution) at the end of energy
5311 C term evaluation for this virtual-bond angle.
5312 if (term1.gt.term2) then
5314 term2=dexp(term2-termm)
5318 term1=dexp(term1-termm)
5321 C The ratio between the gamma-independent and gamma-dependent lobes of
5322 C the distribution is a Gaussian function of thet_pred_mean too.
5323 diffak=gthet(2,it)-thet_pred_mean
5324 ratak=diffak/gthet(3,it)**2
5325 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5326 C Let's differentiate it in thet_pred_mean NOW.
5328 C Now put together the distribution terms to make complete distribution.
5329 termexp=term1+ak*term2
5330 termpre=sigc+ak*sig0i
5331 C Contribution of the bending energy from this theta is just the -log of
5332 C the sum of the contributions from the two lobes and the pre-exponential
5333 C factor. Simple enough, isn't it?
5334 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5335 C NOW the derivatives!!!
5336 C 6/6/97 Take into account the deformation.
5337 E_theta=(delthec*sigcsq*term1
5338 & +ak*delthe0*sig0inv*term2)/termexp
5339 E_tc=((sigtc+aktc*sig0i)/termpre
5340 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5341 & aktc*term2)/termexp)
5344 c-----------------------------------------------------------------------------
5345 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5346 implicit real*8 (a-h,o-z)
5347 include 'DIMENSIONS'
5348 include 'COMMON.LOCAL'
5349 include 'COMMON.IOUNITS'
5350 common /calcthet/ term1,term2,termm,diffak,ratak,
5351 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5352 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5353 delthec=thetai-thet_pred_mean
5354 delthe0=thetai-theta0i
5355 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5356 t3 = thetai-thet_pred_mean
5360 t14 = t12+t6*sigsqtc
5362 t21 = thetai-theta0i
5368 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5369 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5370 & *(-t12*t9-ak*sig0inv*t27)
5374 C--------------------------------------------------------------------------
5375 subroutine ebend(etheta)
5377 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5378 C angles gamma and its derivatives in consecutive thetas and gammas.
5379 C ab initio-derived potentials from
5380 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5382 implicit real*8 (a-h,o-z)
5383 include 'DIMENSIONS'
5384 include 'DIMENSIONS.ZSCOPT'
5385 include 'COMMON.LOCAL'
5386 include 'COMMON.GEO'
5387 include 'COMMON.INTERACT'
5388 include 'COMMON.DERIV'
5389 include 'COMMON.VAR'
5390 include 'COMMON.CHAIN'
5391 include 'COMMON.IOUNITS'
5392 include 'COMMON.NAMES'
5393 include 'COMMON.FFIELD'
5394 include 'COMMON.CONTROL'
5395 include 'COMMON.TORCNSTR'
5396 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5397 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5398 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5399 & sinph1ph2(maxdouble,maxdouble)
5400 logical lprn /.false./, lprn1 /.false./
5402 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
5403 do i=ithet_start,ithet_end
5405 C if (itype(i-1).eq.ntyp1) cycle
5407 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5408 & .or.itype(i).eq.ntyp1) cycle
5409 if (iabs(itype(i+1)).eq.20) iblock=2
5410 if (iabs(itype(i+1)).ne.20) iblock=1
5414 theti2=0.5d0*theta(i)
5415 ityp2=ithetyp((itype(i-1)))
5417 coskt(k)=dcos(k*theti2)
5418 sinkt(k)=dsin(k*theti2)
5428 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5431 if (phii.ne.phii) phii=150.0
5435 ityp1=ithetyp((itype(i-2)))
5437 cosph1(k)=dcos(k*phii)
5438 sinph1(k)=dsin(k*phii)
5444 ityp1=ithetyp((itype(i-2)))
5449 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5452 if (phii1.ne.phii1) phii1=150.0
5457 ityp3=ithetyp((itype(i)))
5459 cosph2(k)=dcos(k*phii1)
5460 sinph2(k)=dsin(k*phii1)
5465 ityp3=ithetyp((itype(i)))
5471 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
5472 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
5474 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5477 ccl=cosph1(l)*cosph2(k-l)
5478 ssl=sinph1(l)*sinph2(k-l)
5479 scl=sinph1(l)*cosph2(k-l)
5480 csl=cosph1(l)*sinph2(k-l)
5481 cosph1ph2(l,k)=ccl-ssl
5482 cosph1ph2(k,l)=ccl+ssl
5483 sinph1ph2(l,k)=scl+csl
5484 sinph1ph2(k,l)=scl-csl
5488 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5489 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5490 write (iout,*) "coskt and sinkt"
5492 write (iout,*) k,coskt(k),sinkt(k)
5496 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5497 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5500 & write (iout,*) "k",k,"
5501 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5502 & " ethetai",ethetai
5505 write (iout,*) "cosph and sinph"
5507 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5509 write (iout,*) "cosph1ph2 and sinph2ph2"
5512 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5513 & sinph1ph2(l,k),sinph1ph2(k,l)
5516 write(iout,*) "ethetai",ethetai
5520 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5521 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5522 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5523 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5524 ethetai=ethetai+sinkt(m)*aux
5525 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5526 dephii=dephii+k*sinkt(m)*(
5527 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5528 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5529 dephii1=dephii1+k*sinkt(m)*(
5530 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5531 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5533 & write (iout,*) "m",m," k",k," bbthet",
5534 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5535 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5536 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5537 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5541 & write(iout,*) "ethetai",ethetai
5545 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5546 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5547 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5548 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5549 ethetai=ethetai+sinkt(m)*aux
5550 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5551 dephii=dephii+l*sinkt(m)*(
5552 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5553 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5554 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5555 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5556 dephii1=dephii1+(k-l)*sinkt(m)*(
5557 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5558 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5559 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5560 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5562 write (iout,*) "m",m," k",k," l",l," ffthet",
5563 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5564 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5565 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5566 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5567 & " ethetai",ethetai
5568 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5569 & cosph1ph2(k,l)*sinkt(m),
5570 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5576 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5577 & i,theta(i)*rad2deg,phii*rad2deg,
5578 & phii1*rad2deg,ethetai
5579 etheta=etheta+ethetai
5580 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5581 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5582 c gloc(nphi+i-2,icg)=wang*dethetai
5583 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
5589 c-----------------------------------------------------------------------------
5590 subroutine esc(escloc)
5591 C Calculate the local energy of a side chain and its derivatives in the
5592 C corresponding virtual-bond valence angles THETA and the spherical angles
5594 implicit real*8 (a-h,o-z)
5595 include 'DIMENSIONS'
5596 include 'DIMENSIONS.ZSCOPT'
5597 include 'COMMON.GEO'
5598 include 'COMMON.LOCAL'
5599 include 'COMMON.VAR'
5600 include 'COMMON.INTERACT'
5601 include 'COMMON.DERIV'
5602 include 'COMMON.CHAIN'
5603 include 'COMMON.IOUNITS'
5604 include 'COMMON.NAMES'
5605 include 'COMMON.FFIELD'
5606 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5607 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5608 common /sccalc/ time11,time12,time112,theti,it,nlobit
5611 C write (iout,*) 'ESC'
5612 do i=loc_start,loc_end
5614 if (it.eq.ntyp1) cycle
5615 if (it.eq.10) goto 1
5616 nlobit=nlob(iabs(it))
5617 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5618 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5619 theti=theta(i+1)-pipol
5623 c write (iout,*) "i",i," x",x(1),x(2),x(3)
5625 if (x(2).gt.pi-delta) then
5629 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5631 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5632 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5634 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5635 & ddersc0(1),dersc(1))
5636 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5637 & ddersc0(3),dersc(3))
5639 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5641 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5642 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5643 & dersc0(2),esclocbi,dersc02)
5644 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5646 call splinthet(x(2),0.5d0*delta,ss,ssd)
5651 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5653 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5654 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5656 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5658 c write (iout,*) escloci
5659 else if (x(2).lt.delta) then
5663 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5665 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5666 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5668 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5669 & ddersc0(1),dersc(1))
5670 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5671 & ddersc0(3),dersc(3))
5673 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5675 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5676 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5677 & dersc0(2),esclocbi,dersc02)
5678 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5683 call splinthet(x(2),0.5d0*delta,ss,ssd)
5685 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5687 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5688 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5690 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5691 C write (iout,*) 'i=',i, escloci
5693 call enesc(x,escloci,dersc,ddummy,.false.)
5696 escloc=escloc+escloci
5697 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5698 write (iout,'(a6,i5,0pf7.3)')
5699 & 'escloc',i,escloci
5701 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5703 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5704 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5709 C---------------------------------------------------------------------------
5710 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5711 implicit real*8 (a-h,o-z)
5712 include 'DIMENSIONS'
5713 include 'COMMON.GEO'
5714 include 'COMMON.LOCAL'
5715 include 'COMMON.IOUNITS'
5716 common /sccalc/ time11,time12,time112,theti,it,nlobit
5717 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5718 double precision contr(maxlob,-1:1)
5720 c write (iout,*) 'it=',it,' nlobit=',nlobit
5724 if (mixed) ddersc(j)=0.0d0
5728 C Because of periodicity of the dependence of the SC energy in omega we have
5729 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5730 C To avoid underflows, first compute & store the exponents.
5738 z(k)=x(k)-censc(k,j,it)
5743 Axk=Axk+gaussc(l,k,j,it)*z(l)
5749 expfac=expfac+Ax(k,j,iii)*z(k)
5757 C As in the case of ebend, we want to avoid underflows in exponentiation and
5758 C subsequent NaNs and INFs in energy calculation.
5759 C Find the largest exponent
5763 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5767 cd print *,'it=',it,' emin=',emin
5769 C Compute the contribution to SC energy and derivatives
5773 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5774 cd print *,'j=',j,' expfac=',expfac
5775 escloc_i=escloc_i+expfac
5777 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5781 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5782 & +gaussc(k,2,j,it))*expfac
5789 dersc(1)=dersc(1)/cos(theti)**2
5790 ddersc(1)=ddersc(1)/cos(theti)**2
5793 escloci=-(dlog(escloc_i)-emin)
5795 dersc(j)=dersc(j)/escloc_i
5799 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5804 C------------------------------------------------------------------------------
5805 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5806 implicit real*8 (a-h,o-z)
5807 include 'DIMENSIONS'
5808 include 'COMMON.GEO'
5809 include 'COMMON.LOCAL'
5810 include 'COMMON.IOUNITS'
5811 common /sccalc/ time11,time12,time112,theti,it,nlobit
5812 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5813 double precision contr(maxlob)
5824 z(k)=x(k)-censc(k,j,it)
5830 Axk=Axk+gaussc(l,k,j,it)*z(l)
5836 expfac=expfac+Ax(k,j)*z(k)
5841 C As in the case of ebend, we want to avoid underflows in exponentiation and
5842 C subsequent NaNs and INFs in energy calculation.
5843 C Find the largest exponent
5846 if (emin.gt.contr(j)) emin=contr(j)
5850 C Compute the contribution to SC energy and derivatives
5854 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5855 escloc_i=escloc_i+expfac
5857 dersc(k)=dersc(k)+Ax(k,j)*expfac
5859 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5860 & +gaussc(1,2,j,it))*expfac
5864 dersc(1)=dersc(1)/cos(theti)**2
5865 dersc12=dersc12/cos(theti)**2
5866 escloci=-(dlog(escloc_i)-emin)
5868 dersc(j)=dersc(j)/escloc_i
5870 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5874 c----------------------------------------------------------------------------------
5875 subroutine esc(escloc)
5876 C Calculate the local energy of a side chain and its derivatives in the
5877 C corresponding virtual-bond valence angles THETA and the spherical angles
5878 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5879 C added by Urszula Kozlowska. 07/11/2007
5881 implicit real*8 (a-h,o-z)
5882 include 'DIMENSIONS'
5883 include 'DIMENSIONS.ZSCOPT'
5884 include 'COMMON.GEO'
5885 include 'COMMON.LOCAL'
5886 include 'COMMON.VAR'
5887 include 'COMMON.SCROT'
5888 include 'COMMON.INTERACT'
5889 include 'COMMON.DERIV'
5890 include 'COMMON.CHAIN'
5891 include 'COMMON.IOUNITS'
5892 include 'COMMON.NAMES'
5893 include 'COMMON.FFIELD'
5894 include 'COMMON.CONTROL'
5895 include 'COMMON.VECTORS'
5896 double precision x_prime(3),y_prime(3),z_prime(3)
5897 & , sumene,dsc_i,dp2_i,x(65),
5898 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5899 & de_dxx,de_dyy,de_dzz,de_dt
5900 double precision s1_t,s1_6_t,s2_t,s2_6_t
5902 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5903 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5904 & dt_dCi(3),dt_dCi1(3)
5905 common /sccalc/ time11,time12,time112,theti,it,nlobit
5908 do i=loc_start,loc_end
5909 if (itype(i).eq.ntyp1) cycle
5910 costtab(i+1) =dcos(theta(i+1))
5911 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5912 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5913 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5914 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5915 cosfac=dsqrt(cosfac2)
5916 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5917 sinfac=dsqrt(sinfac2)
5919 if (it.eq.10) goto 1
5921 C Compute the axes of tghe local cartesian coordinates system; store in
5922 c x_prime, y_prime and z_prime
5929 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5930 C & dc_norm(3,i+nres)
5932 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5933 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5936 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5939 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5940 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5941 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5942 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5943 c & " xy",scalar(x_prime(1),y_prime(1)),
5944 c & " xz",scalar(x_prime(1),z_prime(1)),
5945 c & " yy",scalar(y_prime(1),y_prime(1)),
5946 c & " yz",scalar(y_prime(1),z_prime(1)),
5947 c & " zz",scalar(z_prime(1),z_prime(1))
5949 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5950 C to local coordinate system. Store in xx, yy, zz.
5956 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5957 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5958 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5965 C Compute the energy of the ith side cbain
5967 c write (2,*) "xx",xx," yy",yy," zz",zz
5970 x(j) = sc_parmin(j,it)
5973 Cc diagnostics - remove later
5975 yy1 = dsin(alph(2))*dcos(omeg(2))
5976 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
5977 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5978 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5980 C," --- ", xx_w,yy_w,zz_w
5983 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5984 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5986 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5987 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5989 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5990 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5991 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5992 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5993 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5995 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5996 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5997 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5998 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5999 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6001 dsc_i = 0.743d0+x(61)
6003 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6004 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6005 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6006 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6007 s1=(1+x(63))/(0.1d0 + dscp1)
6008 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6009 s2=(1+x(65))/(0.1d0 + dscp2)
6010 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6011 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6012 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6013 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6015 c & dscp1,dscp2,sumene
6016 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6017 escloc = escloc + sumene
6018 c write (2,*) "escloc",escloc
6019 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
6021 if (.not. calc_grad) goto 1
6024 C This section to check the numerical derivatives of the energy of ith side
6025 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6026 C #define DEBUG in the code to turn it on.
6028 write (2,*) "sumene =",sumene
6032 write (2,*) xx,yy,zz
6033 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6034 de_dxx_num=(sumenep-sumene)/aincr
6036 write (2,*) "xx+ sumene from enesc=",sumenep
6039 write (2,*) xx,yy,zz
6040 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6041 de_dyy_num=(sumenep-sumene)/aincr
6043 write (2,*) "yy+ sumene from enesc=",sumenep
6046 write (2,*) xx,yy,zz
6047 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6048 de_dzz_num=(sumenep-sumene)/aincr
6050 write (2,*) "zz+ sumene from enesc=",sumenep
6051 costsave=cost2tab(i+1)
6052 sintsave=sint2tab(i+1)
6053 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6054 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6055 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6056 de_dt_num=(sumenep-sumene)/aincr
6057 write (2,*) " t+ sumene from enesc=",sumenep
6058 cost2tab(i+1)=costsave
6059 sint2tab(i+1)=sintsave
6060 C End of diagnostics section.
6063 C Compute the gradient of esc
6065 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6066 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6067 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6068 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6069 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6070 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6071 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6072 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6073 pom1=(sumene3*sint2tab(i+1)+sumene1)
6074 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6075 pom2=(sumene4*cost2tab(i+1)+sumene2)
6076 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6077 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6078 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6079 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6081 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6082 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6083 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6085 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6086 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6087 & +(pom1+pom2)*pom_dx
6089 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
6092 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6093 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6094 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6096 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6097 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6098 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6099 & +x(59)*zz**2 +x(60)*xx*zz
6100 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6101 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6102 & +(pom1-pom2)*pom_dy
6104 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
6107 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6108 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6109 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6110 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6111 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6112 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6113 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6114 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6116 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
6119 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6120 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6121 & +pom1*pom_dt1+pom2*pom_dt2
6123 write(2,*), "de_dt = ", de_dt,de_dt_num
6127 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6128 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6129 cosfac2xx=cosfac2*xx
6130 sinfac2yy=sinfac2*yy
6132 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6134 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6136 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6137 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6138 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6139 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6140 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6141 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6142 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6143 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6144 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6145 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6149 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6150 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6151 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6152 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6155 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6156 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6157 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
6159 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6160 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6164 dXX_Ctab(k,i)=dXX_Ci(k)
6165 dXX_C1tab(k,i)=dXX_Ci1(k)
6166 dYY_Ctab(k,i)=dYY_Ci(k)
6167 dYY_C1tab(k,i)=dYY_Ci1(k)
6168 dZZ_Ctab(k,i)=dZZ_Ci(k)
6169 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6170 dXX_XYZtab(k,i)=dXX_XYZ(k)
6171 dYY_XYZtab(k,i)=dYY_XYZ(k)
6172 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6176 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6177 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6178 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6179 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
6180 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6182 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6183 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6184 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
6185 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6186 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
6187 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6188 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
6189 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6191 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6192 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6194 C to check gradient call subroutine check_grad
6201 c------------------------------------------------------------------------------
6202 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6204 C This procedure calculates two-body contact function g(rij) and its derivative:
6207 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6210 C where x=(rij-r0ij)/delta
6212 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6215 double precision rij,r0ij,eps0ij,fcont,fprimcont
6216 double precision x,x2,x4,delta
6220 if (x.lt.-1.0D0) then
6223 else if (x.le.1.0D0) then
6226 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6227 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6234 c------------------------------------------------------------------------------
6235 subroutine splinthet(theti,delta,ss,ssder)
6236 implicit real*8 (a-h,o-z)
6237 include 'DIMENSIONS'
6238 include 'DIMENSIONS.ZSCOPT'
6239 include 'COMMON.VAR'
6240 include 'COMMON.GEO'
6243 if (theti.gt.pipol) then
6244 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6246 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6251 c------------------------------------------------------------------------------
6252 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6254 double precision x,x0,delta,f0,f1,fprim0,f,fprim
6255 double precision ksi,ksi2,ksi3,a1,a2,a3
6256 a1=fprim0*delta/(f1-f0)
6262 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6263 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6266 c------------------------------------------------------------------------------
6267 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6269 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6270 double precision ksi,ksi2,ksi3,a1,a2,a3
6275 a2=3*(f1x-f0x)-2*fprim0x*delta
6276 a3=fprim0x*delta-2*(f1x-f0x)
6277 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6280 C-----------------------------------------------------------------------------
6282 C-----------------------------------------------------------------------------
6283 subroutine etor(etors,fact)
6284 implicit real*8 (a-h,o-z)
6285 include 'DIMENSIONS'
6286 include 'DIMENSIONS.ZSCOPT'
6287 include 'COMMON.VAR'
6288 include 'COMMON.GEO'
6289 include 'COMMON.LOCAL'
6290 include 'COMMON.TORSION'
6291 include 'COMMON.INTERACT'
6292 include 'COMMON.DERIV'
6293 include 'COMMON.CHAIN'
6294 include 'COMMON.NAMES'
6295 include 'COMMON.IOUNITS'
6296 include 'COMMON.FFIELD'
6297 include 'COMMON.TORCNSTR'
6299 C Set lprn=.true. for debugging
6303 do i=iphi_start,iphi_end
6304 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
6305 & .or. itype(i).eq.ntyp1) cycle
6306 itori=itortyp(itype(i-2))
6307 itori1=itortyp(itype(i-1))
6310 C Proline-Proline pair is a special case...
6311 if (itori.eq.3 .and. itori1.eq.3) then
6312 if (phii.gt.-dwapi3) then
6314 fac=1.0D0/(1.0D0-cosphi)
6315 etorsi=v1(1,3,3)*fac
6316 etorsi=etorsi+etorsi
6317 etors=etors+etorsi-v1(1,3,3)
6318 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6321 v1ij=v1(j+1,itori,itori1)
6322 v2ij=v2(j+1,itori,itori1)
6325 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6326 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6330 v1ij=v1(j,itori,itori1)
6331 v2ij=v2(j,itori,itori1)
6334 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6335 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6339 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6340 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6341 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6342 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
6343 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6347 c------------------------------------------------------------------------------
6349 subroutine etor(etors,fact)
6350 implicit real*8 (a-h,o-z)
6351 include 'DIMENSIONS'
6352 include 'DIMENSIONS.ZSCOPT'
6353 include 'COMMON.VAR'
6354 include 'COMMON.GEO'
6355 include 'COMMON.LOCAL'
6356 include 'COMMON.TORSION'
6357 include 'COMMON.INTERACT'
6358 include 'COMMON.DERIV'
6359 include 'COMMON.CHAIN'
6360 include 'COMMON.NAMES'
6361 include 'COMMON.IOUNITS'
6362 include 'COMMON.FFIELD'
6363 include 'COMMON.TORCNSTR'
6365 C Set lprn=.true. for debugging
6369 do i=iphi_start,iphi_end
6371 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6372 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6373 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
6374 C & .or. itype(i).eq.ntyp1) cycle
6375 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
6376 if (iabs(itype(i)).eq.20) then
6381 itori=itortyp(itype(i-2))
6382 itori1=itortyp(itype(i-1))
6385 C Regular cosine and sine terms
6386 do j=1,nterm(itori,itori1,iblock)
6387 v1ij=v1(j,itori,itori1,iblock)
6388 v2ij=v2(j,itori,itori1,iblock)
6391 etors=etors+v1ij*cosphi+v2ij*sinphi
6392 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6396 C E = SUM ----------------------------------- - v1
6397 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6399 cosphi=dcos(0.5d0*phii)
6400 sinphi=dsin(0.5d0*phii)
6401 do j=1,nlor(itori,itori1,iblock)
6402 vl1ij=vlor1(j,itori,itori1)
6403 vl2ij=vlor2(j,itori,itori1)
6404 vl3ij=vlor3(j,itori,itori1)
6405 pom=vl2ij*cosphi+vl3ij*sinphi
6406 pom1=1.0d0/(pom*pom+1.0d0)
6407 etors=etors+vl1ij*pom1
6408 c if (energy_dec) etors_ii=etors_ii+
6411 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6413 C Subtract the constant term
6414 etors=etors-v0(itori,itori1,iblock)
6416 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6417 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6418 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
6419 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
6420 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6425 c----------------------------------------------------------------------------
6426 subroutine etor_d(etors_d,fact2)
6427 C 6/23/01 Compute double torsional energy
6428 implicit real*8 (a-h,o-z)
6429 include 'DIMENSIONS'
6430 include 'DIMENSIONS.ZSCOPT'
6431 include 'COMMON.VAR'
6432 include 'COMMON.GEO'
6433 include 'COMMON.LOCAL'
6434 include 'COMMON.TORSION'
6435 include 'COMMON.INTERACT'
6436 include 'COMMON.DERIV'
6437 include 'COMMON.CHAIN'
6438 include 'COMMON.NAMES'
6439 include 'COMMON.IOUNITS'
6440 include 'COMMON.FFIELD'
6441 include 'COMMON.TORCNSTR'
6443 C Set lprn=.true. for debugging
6447 do i=iphi_start,iphi_end-1
6449 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6450 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
6451 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
6452 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
6453 & (itype(i+1).eq.ntyp1)) cycle
6454 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
6456 itori=itortyp(itype(i-2))
6457 itori1=itortyp(itype(i-1))
6458 itori2=itortyp(itype(i))
6464 if (iabs(itype(i+1)).eq.20) iblock=2
6465 C Regular cosine and sine terms
6466 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6467 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6468 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6469 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6470 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6471 cosphi1=dcos(j*phii)
6472 sinphi1=dsin(j*phii)
6473 cosphi2=dcos(j*phii1)
6474 sinphi2=dsin(j*phii1)
6475 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6476 & v2cij*cosphi2+v2sij*sinphi2
6477 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6478 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6480 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6482 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6483 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6484 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6485 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6486 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6487 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6488 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6489 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6490 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6491 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6492 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6493 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6494 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6495 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6498 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
6499 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
6505 c---------------------------------------------------------------------------
6506 C The rigorous attempt to derive energy function
6507 subroutine etor_kcc(etors,fact)
6508 implicit real*8 (a-h,o-z)
6509 include 'DIMENSIONS'
6510 include 'DIMENSIONS.ZSCOPT'
6511 include 'COMMON.VAR'
6512 include 'COMMON.GEO'
6513 include 'COMMON.LOCAL'
6514 include 'COMMON.TORSION'
6515 include 'COMMON.INTERACT'
6516 include 'COMMON.DERIV'
6517 include 'COMMON.CHAIN'
6518 include 'COMMON.NAMES'
6519 include 'COMMON.IOUNITS'
6520 include 'COMMON.FFIELD'
6521 include 'COMMON.TORCNSTR'
6522 include 'COMMON.CONTROL'
6523 double precision c1(0:maxval_kcc),c2(0:maxval_kcc)
6525 c double precision thybt1(maxtermkcc),thybt2(maxtermkcc)
6526 C Set lprn=.true. for debugging
6529 C print *,"wchodze kcc"
6530 if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode
6532 do i=iphi_start,iphi_end
6533 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6534 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6535 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6536 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6537 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6538 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6539 itori=itortyp(itype(i-2))
6540 itori1=itortyp(itype(i-1))
6545 C to avoid multiple devision by 2
6546 c theti22=0.5d0*theta(i)
6547 C theta 12 is the theta_1 /2
6548 C theta 22 is theta_2 /2
6549 c theti12=0.5d0*theta(i-1)
6550 C and appropriate sinus function
6551 sinthet1=dsin(theta(i-1))
6552 sinthet2=dsin(theta(i))
6553 costhet1=dcos(theta(i-1))
6554 costhet2=dcos(theta(i))
6555 C to speed up lets store its mutliplication
6556 sint1t2=sinthet2*sinthet1
6558 C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
6559 C +d_n*sin(n*gamma)) *
6560 C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
6561 C we have two sum 1) Non-Chebyshev which is with n and gamma
6562 nval=nterm_kcc_Tb(itori,itori1)
6568 c1(j)=c1(j-1)*costhet1
6569 c2(j)=c2(j-1)*costhet2
6572 do j=1,nterm_kcc(itori,itori1)
6576 sint1t2n=sint1t2n*sint1t2
6582 sumvalc=sumvalc+v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
6583 gradvalct1=gradvalct1+
6584 & (k-1)*v1_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
6585 gradvalct2=gradvalct2+
6586 & (l-1)*v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
6589 gradvalct1=-gradvalct1*sinthet1
6590 gradvalct2=-gradvalct2*sinthet2
6596 sumvals=sumvals+v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
6597 gradvalst1=gradvalst1+
6598 & (k-1)*v2_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
6599 gradvalst2=gradvalst2+
6600 & (l-1)*v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
6603 gradvalst1=-gradvalst1*sinthet1
6604 gradvalst2=-gradvalst2*sinthet2
6605 etori=etori+sint1t2n*(sumvalc*cosphi+sumvals*sinphi)
6606 C glocig is the gradient local i site in gamma
6607 glocig=glocig+j*sint1t2n*(sumvals*cosphi-sumvalc*sinphi)
6608 C now gradient over theta_1
6609 glocit1=glocit1+sint1t2n*(gradvalct1*cosphi+gradvalst1*sinphi)
6610 & +j*sint1t2n1*costhet1*sinthet2*(sumvalc*cosphi+sumvals*sinphi)
6611 glocit2=glocit2+sint1t2n*(gradvalct2*cosphi+gradvalst2*sinphi)
6612 & +j*sint1t2n1*sinthet1*costhet2*(sumvalc*cosphi+sumvals*sinphi)
6615 C derivative over gamma
6616 gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
6617 C derivative over theta1
6618 gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1
6619 C now derivative over theta2
6620 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2
6622 write (iout,*) i-2,i-1,itype(i-2),itype(i-1),itori,itori1,
6623 & theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori
6624 write (iout,*) "c1",(c1(k),k=0,nval),
6625 & " c2",(c2(k),k=0,nval)
6626 write (iout,*) "sumvalc",sumvalc," sumvals",sumvals
6631 c---------------------------------------------------------------------------------------------
6632 subroutine etor_constr(edihcnstr)
6633 implicit real*8 (a-h,o-z)
6634 include 'DIMENSIONS'
6635 include 'DIMENSIONS.ZSCOPT'
6636 include 'COMMON.VAR'
6637 include 'COMMON.GEO'
6638 include 'COMMON.LOCAL'
6639 include 'COMMON.TORSION'
6640 include 'COMMON.INTERACT'
6641 include 'COMMON.DERIV'
6642 include 'COMMON.CHAIN'
6643 include 'COMMON.NAMES'
6644 include 'COMMON.IOUNITS'
6645 include 'COMMON.FFIELD'
6646 include 'COMMON.TORCNSTR'
6647 include 'COMMON.CONTROL'
6648 ! 6/20/98 - dihedral angle constraints
6650 c do i=1,ndih_constr
6651 c write (iout,*) "idihconstr_start",idihconstr_start,
6652 c & " idihconstr_end",idihconstr_end
6654 if (raw_psipred) then
6655 do i=idihconstr_start,idihconstr_end
6656 itori=idih_constr(i)
6658 gaudih_i=vpsipred(1,i)
6662 cos_i=(1.0d0-dcos(phii-phibound(j,i)))/s**2
6663 dexpcos_i=dexp(-cos_i*cos_i)
6664 gaudih_i=gaudih_i+vpsipred(j+1,i)*dexpcos_i
6665 gauder_i=gauder_i-2*vpsipred(j+1,i)*dsin(phii-phibound(j,i))
6666 & *cos_i*dexpcos_i/s**2
6668 edihcnstr=edihcnstr-wdihc*dlog(gaudih_i)
6669 gloc(itori-3,icg)=gloc(itori-3,icg)-wdihc*gauder_i/gaudih_i
6671 & write (iout,'(2i5,f8.3,f8.5,2(f8.5,2f8.3),f10.5)')
6672 & i,itori,phii*rad2deg,vpsipred(1,i),vpsipred(2,i),
6673 & phibound(1,i)*rad2deg,sdihed(1,i)*rad2deg,vpsipred(3,i),
6674 & phibound(2,i)*rad2deg,sdihed(2,i)*rad2deg,
6675 & -wdihc*dlog(gaudih_i)
6679 do i=idihconstr_start,idihconstr_end
6680 itori=idih_constr(i)
6682 difi=pinorm(phii-phi0(i))
6683 if (difi.gt.drange(i)) then
6685 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6686 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6687 else if (difi.lt.-drange(i)) then
6689 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6690 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6698 c write (iout,*) "ETOR_CONSTR",edihcnstr
6701 c----------------------------------------------------------------------------
6702 C The rigorous attempt to derive energy function
6703 subroutine ebend_kcc(etheta)
6705 implicit real*8 (a-h,o-z)
6706 include 'DIMENSIONS'
6707 include 'DIMENSIONS.ZSCOPT'
6708 include 'COMMON.VAR'
6709 include 'COMMON.GEO'
6710 include 'COMMON.LOCAL'
6711 include 'COMMON.TORSION'
6712 include 'COMMON.INTERACT'
6713 include 'COMMON.DERIV'
6714 include 'COMMON.CHAIN'
6715 include 'COMMON.NAMES'
6716 include 'COMMON.IOUNITS'
6717 include 'COMMON.FFIELD'
6718 include 'COMMON.TORCNSTR'
6719 include 'COMMON.CONTROL'
6721 double precision thybt1(maxang_kcc)
6722 C Set lprn=.true. for debugging
6725 C print *,"wchodze kcc"
6726 if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
6728 do i=ithet_start,ithet_end
6729 c print *,i,itype(i-1),itype(i),itype(i-2)
6730 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6731 & .or.itype(i).eq.ntyp1) cycle
6732 iti=iabs(itortyp(itype(i-1)))
6733 sinthet=dsin(theta(i))
6734 costhet=dcos(theta(i))
6735 do j=1,nbend_kcc_Tb(iti)
6736 thybt1(j)=v1bend_chyb(j,iti)
6738 sumth1thyb=v1bend_chyb(0,iti)+
6739 & tschebyshev(1,nbend_kcc_Tb(iti),thybt1(1),costhet)
6740 if (lprn) write (iout,*) i-1,itype(i-1),iti,theta(i)*rad2deg,
6742 ihelp=nbend_kcc_Tb(iti)-1
6743 gradthybt1=gradtschebyshev(0,ihelp,thybt1(1),costhet)
6744 etheta=etheta+sumth1thyb
6745 C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
6746 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)-wang*gradthybt1*sinthet
6750 c-------------------------------------------------------------------------------------
6751 subroutine etheta_constr(ethetacnstr)
6753 implicit real*8 (a-h,o-z)
6754 include 'DIMENSIONS'
6755 include 'DIMENSIONS.ZSCOPT'
6756 include 'COMMON.VAR'
6757 include 'COMMON.GEO'
6758 include 'COMMON.LOCAL'
6759 include 'COMMON.TORSION'
6760 include 'COMMON.INTERACT'
6761 include 'COMMON.DERIV'
6762 include 'COMMON.CHAIN'
6763 include 'COMMON.NAMES'
6764 include 'COMMON.IOUNITS'
6765 include 'COMMON.FFIELD'
6766 include 'COMMON.TORCNSTR'
6767 include 'COMMON.CONTROL'
6769 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6770 do i=ithetaconstr_start,ithetaconstr_end
6771 itheta=itheta_constr(i)
6772 thetiii=theta(itheta)
6773 difi=pinorm(thetiii-theta_constr0(i))
6774 if (difi.gt.theta_drange(i)) then
6775 difi=difi-theta_drange(i)
6776 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6777 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6778 & +for_thet_constr(i)*difi**3
6779 else if (difi.lt.-drange(i)) then
6781 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6782 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6783 & +for_thet_constr(i)*difi**3
6787 if (energy_dec) then
6788 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6789 & i,itheta,rad2deg*thetiii,
6790 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6791 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6792 & gloc(itheta+nphi-2,icg)
6797 c------------------------------------------------------------------------------
6798 c------------------------------------------------------------------------------
6799 subroutine eback_sc_corr(esccor)
6800 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6801 c conformational states; temporarily implemented as differences
6802 c between UNRES torsional potentials (dependent on three types of
6803 c residues) and the torsional potentials dependent on all 20 types
6804 c of residues computed from AM1 energy surfaces of terminally-blocked
6805 c amino-acid residues.
6806 implicit real*8 (a-h,o-z)
6807 include 'DIMENSIONS'
6808 include 'DIMENSIONS.ZSCOPT'
6809 include 'COMMON.VAR'
6810 include 'COMMON.GEO'
6811 include 'COMMON.LOCAL'
6812 include 'COMMON.TORSION'
6813 include 'COMMON.SCCOR'
6814 include 'COMMON.INTERACT'
6815 include 'COMMON.DERIV'
6816 include 'COMMON.CHAIN'
6817 include 'COMMON.NAMES'
6818 include 'COMMON.IOUNITS'
6819 include 'COMMON.FFIELD'
6820 include 'COMMON.CONTROL'
6822 C Set lprn=.true. for debugging
6825 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
6827 do i=itau_start,itau_end
6828 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6830 isccori=isccortyp(itype(i-2))
6831 isccori1=isccortyp(itype(i-1))
6833 do intertyp=1,3 !intertyp
6834 cc Added 09 May 2012 (Adasko)
6835 cc Intertyp means interaction type of backbone mainchain correlation:
6836 c 1 = SC...Ca...Ca...Ca
6837 c 2 = Ca...Ca...Ca...SC
6838 c 3 = SC...Ca...Ca...SCi
6840 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6841 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6842 & (itype(i-1).eq.ntyp1)))
6843 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6844 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6845 & .or.(itype(i).eq.ntyp1)))
6846 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6847 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6848 & (itype(i-3).eq.ntyp1)))) cycle
6849 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6850 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6852 do j=1,nterm_sccor(isccori,isccori1)
6853 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6854 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6855 cosphi=dcos(j*tauangle(intertyp,i))
6856 sinphi=dsin(j*tauangle(intertyp,i))
6857 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6858 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6860 C write (iout,*)"EBACK_SC_COR",esccor,i
6861 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
6862 c & nterm_sccor(isccori,isccori1),isccori,isccori1
6863 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6865 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6866 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6867 & (v1sccor(j,1,itori,itori1),j=1,6)
6868 & ,(v2sccor(j,1,itori,itori1),j=1,6)
6869 c gsccor_loc(i-3)=gloci
6875 c------------------------------------------------------------------------------
6876 subroutine multibody(ecorr)
6877 C This subroutine calculates multi-body contributions to energy following
6878 C the idea of Skolnick et al. If side chains I and J make a contact and
6879 C at the same time side chains I+1 and J+1 make a contact, an extra
6880 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6881 implicit real*8 (a-h,o-z)
6882 include 'DIMENSIONS'
6883 include 'COMMON.IOUNITS'
6884 include 'COMMON.DERIV'
6885 include 'COMMON.INTERACT'
6886 include 'COMMON.CONTACTS'
6887 include 'COMMON.CONTMAT'
6888 include 'COMMON.CORRMAT'
6889 double precision gx(3),gx1(3)
6892 C Set lprn=.true. for debugging
6896 write (iout,'(a)') 'Contact function values:'
6898 write (iout,'(i2,20(1x,i2,f10.5))')
6899 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6914 num_conti=num_cont(i)
6915 num_conti1=num_cont(i1)
6920 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6921 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6922 cd & ' ishift=',ishift
6923 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6924 C The system gains extra energy.
6925 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6926 endif ! j1==j+-ishift
6935 c------------------------------------------------------------------------------
6936 double precision function esccorr(i,j,k,l,jj,kk)
6937 implicit real*8 (a-h,o-z)
6938 include 'DIMENSIONS'
6939 include 'COMMON.IOUNITS'
6940 include 'COMMON.DERIV'
6941 include 'COMMON.INTERACT'
6942 include 'COMMON.CONTACTS'
6943 include 'COMMON.CONTMAT'
6944 include 'COMMON.CORRMAT'
6945 double precision gx(3),gx1(3)
6950 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6951 C Calculate the multi-body contribution to energy.
6952 C Calculate multi-body contributions to the gradient.
6953 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6954 cd & k,l,(gacont(m,kk,k),m=1,3)
6956 gx(m) =ekl*gacont(m,jj,i)
6957 gx1(m)=eij*gacont(m,kk,k)
6958 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6959 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6960 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6961 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6965 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6970 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6976 c------------------------------------------------------------------------------
6977 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6978 C This subroutine calculates multi-body contributions to hydrogen-bonding
6979 implicit real*8 (a-h,o-z)
6980 include 'DIMENSIONS'
6981 include 'DIMENSIONS.ZSCOPT'
6982 include 'COMMON.IOUNITS'
6983 include 'COMMON.FFIELD'
6984 include 'COMMON.DERIV'
6985 include 'COMMON.INTERACT'
6986 include 'COMMON.CONTACTS'
6987 include 'COMMON.CONTMAT'
6988 include 'COMMON.CORRMAT'
6989 double precision gx(3),gx1(3)
6992 C Set lprn=.true. for debugging
6995 write (iout,'(a)') 'Contact function values:'
6997 write (iout,'(2i3,50(1x,i2,f5.2))')
6998 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6999 & j=1,num_cont_hb(i))
7003 C Remove the loop below after debugging !!!
7010 C Calculate the local-electrostatic correlation terms
7011 do i=iatel_s,iatel_e+1
7013 num_conti=num_cont_hb(i)
7014 num_conti1=num_cont_hb(i+1)
7019 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7020 c & ' jj=',jj,' kk=',kk
7021 if (j1.eq.j+1 .or. j1.eq.j-1) then
7022 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7023 C The system gains extra energy.
7024 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7026 else if (j1.eq.j) then
7027 C Contacts I-J and I-(J+1) occur simultaneously.
7028 C The system loses extra energy.
7029 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7034 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7035 c & ' jj=',jj,' kk=',kk
7037 C Contacts I-J and (I+1)-J occur simultaneously.
7038 C The system loses extra energy.
7039 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7046 c------------------------------------------------------------------------------
7047 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
7049 C This subroutine calculates multi-body contributions to hydrogen-bonding
7050 implicit real*8 (a-h,o-z)
7051 include 'DIMENSIONS'
7052 include 'DIMENSIONS.ZSCOPT'
7053 include 'COMMON.IOUNITS'
7057 include 'COMMON.FFIELD'
7058 include 'COMMON.DERIV'
7059 include 'COMMON.LOCAL'
7060 include 'COMMON.INTERACT'
7061 include 'COMMON.CONTACTS'
7062 include 'COMMON.CONTMAT'
7063 include 'COMMON.CORRMAT'
7064 include 'COMMON.CHAIN'
7065 include 'COMMON.CONTROL'
7066 include 'COMMON.SHIELD'
7067 double precision gx(3),gx1(3)
7068 integer num_cont_hb_old(maxres)
7070 double precision eello4,eello5,eelo6,eello_turn6
7071 external eello4,eello5,eello6,eello_turn6
7072 C Set lprn=.true. for debugging
7076 write (iout,'(a)') 'Contact function values:'
7078 write (iout,'(2i3,50(1x,i2,5f6.3))')
7079 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7080 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7086 C Remove the loop below after debugging !!!
7093 C Calculate the dipole-dipole interaction energies
7094 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7095 do i=iatel_s,iatel_e+1
7096 num_conti=num_cont_hb(i)
7105 C Calculate the local-electrostatic correlation terms
7106 c write (iout,*) "gradcorr5 in eello5 before loop"
7108 c write (iout,'(i5,3f10.5)')
7109 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7111 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7112 c write (iout,*) "corr loop i",i
7114 num_conti=num_cont_hb(i)
7115 num_conti1=num_cont_hb(i+1)
7122 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7123 c & ' jj=',jj,' kk=',kk
7124 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7125 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7126 & .or. j.lt.0 .and. j1.gt.0) .and.
7127 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7128 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7129 C The system gains extra energy.
7131 sqd1=dsqrt(d_cont(jj,i))
7132 sqd2=dsqrt(d_cont(kk,i1))
7133 sred_geom = sqd1*sqd2
7134 IF (sred_geom.lt.cutoff_corr) THEN
7135 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7137 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7138 cd & ' jj=',jj,' kk=',kk
7139 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7140 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7142 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7143 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7146 cd write (iout,*) 'sred_geom=',sred_geom,
7147 cd & ' ekont=',ekont,' fprim=',fprimcont,
7148 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7149 cd write (iout,*) "g_contij",g_contij
7150 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7151 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7152 call calc_eello(i,jp,i+1,jp1,jj,kk)
7153 if (wcorr4.gt.0.0d0)
7154 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7155 CC & *fac_shield(i)**2*fac_shield(j)**2
7156 if (energy_dec.and.wcorr4.gt.0.0d0)
7157 1 write (iout,'(a6,4i5,0pf7.3)')
7158 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7159 c write (iout,*) "gradcorr5 before eello5"
7161 c write (iout,'(i5,3f10.5)')
7162 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7164 if (wcorr5.gt.0.0d0)
7165 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7166 c write (iout,*) "gradcorr5 after eello5"
7168 c write (iout,'(i5,3f10.5)')
7169 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7171 if (energy_dec.and.wcorr5.gt.0.0d0)
7172 1 write (iout,'(a6,4i5,0pf7.3)')
7173 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7174 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7175 cd write(2,*)'ijkl',i,jp,i+1,jp1
7176 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7177 & .or. wturn6.eq.0.0d0))then
7178 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7179 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7180 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7181 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7182 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7183 cd & 'ecorr6=',ecorr6
7184 cd write (iout,'(4e15.5)') sred_geom,
7185 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7186 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7187 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7188 else if (wturn6.gt.0.0d0
7189 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7190 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7191 eturn6=eturn6+eello_turn6(i,jj,kk)
7192 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7193 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7194 cd write (2,*) 'multibody_eello:eturn6',eturn6
7203 num_cont_hb(i)=num_cont_hb_old(i)
7205 c write (iout,*) "gradcorr5 in eello5"
7207 c write (iout,'(i5,3f10.5)')
7208 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7212 c------------------------------------------------------------------------------
7213 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7214 implicit real*8 (a-h,o-z)
7215 include 'DIMENSIONS'
7216 include 'DIMENSIONS.ZSCOPT'
7217 include 'COMMON.IOUNITS'
7218 include 'COMMON.DERIV'
7219 include 'COMMON.INTERACT'
7220 include 'COMMON.CONTACTS'
7221 include 'COMMON.CONTMAT'
7222 include 'COMMON.CORRMAT'
7223 include 'COMMON.SHIELD'
7224 include 'COMMON.CONTROL'
7225 double precision gx(3),gx1(3)
7228 C print *,"wchodze",fac_shield(i),shield_mode
7236 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7238 C & fac_shield(i)**2*fac_shield(j)**2
7239 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7240 C Following 4 lines for diagnostics.
7245 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7246 c & 'Contacts ',i,j,
7247 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7248 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7250 C Calculate the multi-body contribution to energy.
7251 C ecorr=ecorr+ekont*ees
7252 C Calculate multi-body contributions to the gradient.
7253 coeffpees0pij=coeffp*ees0pij
7254 coeffmees0mij=coeffm*ees0mij
7255 coeffpees0pkl=coeffp*ees0pkl
7256 coeffmees0mkl=coeffm*ees0mkl
7258 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7259 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7260 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7261 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7262 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7263 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7264 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7265 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7266 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7267 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7268 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7269 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7270 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7271 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7272 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7273 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7274 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7275 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7276 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7277 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7278 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7279 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7280 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7281 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7282 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7287 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7288 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7289 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7290 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7295 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7296 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7297 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7298 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7301 c write (iout,*) "ehbcorr",ekont*ees
7302 C print *,ekont,ees,i,k
7304 C now gradient over shielding
7306 if (shield_mode.gt.0) then
7309 C print *,i,j,fac_shield(i),fac_shield(j),
7310 C &fac_shield(k),fac_shield(l)
7311 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
7312 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
7313 do ilist=1,ishield_list(i)
7314 iresshield=shield_list(ilist,i)
7316 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
7318 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
7320 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
7321 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
7325 do ilist=1,ishield_list(j)
7326 iresshield=shield_list(ilist,j)
7328 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
7330 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
7332 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
7333 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
7338 do ilist=1,ishield_list(k)
7339 iresshield=shield_list(ilist,k)
7341 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
7343 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
7345 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
7346 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
7350 do ilist=1,ishield_list(l)
7351 iresshield=shield_list(ilist,l)
7353 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
7355 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
7357 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
7358 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
7362 C print *,gshieldx(m,iresshield)
7364 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
7365 & grad_shield(m,i)*ehbcorr/fac_shield(i)
7366 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
7367 & grad_shield(m,j)*ehbcorr/fac_shield(j)
7368 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
7369 & grad_shield(m,i)*ehbcorr/fac_shield(i)
7370 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
7371 & grad_shield(m,j)*ehbcorr/fac_shield(j)
7373 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
7374 & grad_shield(m,k)*ehbcorr/fac_shield(k)
7375 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
7376 & grad_shield(m,l)*ehbcorr/fac_shield(l)
7377 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
7378 & grad_shield(m,k)*ehbcorr/fac_shield(k)
7379 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
7380 & grad_shield(m,l)*ehbcorr/fac_shield(l)
7388 C---------------------------------------------------------------------------
7389 subroutine dipole(i,j,jj)
7390 implicit real*8 (a-h,o-z)
7391 include 'DIMENSIONS'
7392 include 'DIMENSIONS.ZSCOPT'
7393 include 'COMMON.IOUNITS'
7394 include 'COMMON.CHAIN'
7395 include 'COMMON.FFIELD'
7396 include 'COMMON.DERIV'
7397 include 'COMMON.INTERACT'
7398 include 'COMMON.CONTACTS'
7399 include 'COMMON.CONTMAT'
7400 include 'COMMON.CORRMAT'
7401 include 'COMMON.TORSION'
7402 include 'COMMON.VAR'
7403 include 'COMMON.GEO'
7404 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7406 iti1 = itortyp(itype(i+1))
7407 if (j.lt.nres-1) then
7408 itj1 = itype2loc(itype(j+1))
7413 dipi(iii,1)=Ub2(iii,i)
7414 dipderi(iii)=Ub2der(iii,i)
7415 dipi(iii,2)=b1(iii,i+1)
7416 dipj(iii,1)=Ub2(iii,j)
7417 dipderj(iii)=Ub2der(iii,j)
7418 dipj(iii,2)=b1(iii,j+1)
7422 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7425 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7432 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7436 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7441 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7442 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7444 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7446 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7448 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7453 C---------------------------------------------------------------------------
7454 subroutine calc_eello(i,j,k,l,jj,kk)
7456 C This subroutine computes matrices and vectors needed to calculate
7457 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7459 implicit real*8 (a-h,o-z)
7460 include 'DIMENSIONS'
7461 include 'DIMENSIONS.ZSCOPT'
7462 include 'COMMON.IOUNITS'
7463 include 'COMMON.CHAIN'
7464 include 'COMMON.DERIV'
7465 include 'COMMON.INTERACT'
7466 include 'COMMON.CONTACTS'
7467 include 'COMMON.CONTMAT'
7468 include 'COMMON.CORRMAT'
7469 include 'COMMON.TORSION'
7470 include 'COMMON.VAR'
7471 include 'COMMON.GEO'
7472 include 'COMMON.FFIELD'
7473 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7474 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7477 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7478 cd & ' jj=',jj,' kk=',kk
7479 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7480 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7481 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7484 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7485 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7488 call transpose2(aa1(1,1),aa1t(1,1))
7489 call transpose2(aa2(1,1),aa2t(1,1))
7492 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7493 & aa1tder(1,1,lll,kkk))
7494 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7495 & aa2tder(1,1,lll,kkk))
7499 C parallel orientation of the two CA-CA-CA frames.
7501 iti=itype2loc(itype(i))
7505 itk1=itype2loc(itype(k+1))
7506 itj=itype2loc(itype(j))
7507 if (l.lt.nres-1) then
7508 itl1=itype2loc(itype(l+1))
7512 C A1 kernel(j+1) A2T
7514 cd write (iout,'(3f10.5,5x,3f10.5)')
7515 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7517 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7518 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7519 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7520 C Following matrices are needed only for 6-th order cumulants
7521 IF (wcorr6.gt.0.0d0) THEN
7522 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7523 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7524 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7525 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7526 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7527 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7528 & ADtEAderx(1,1,1,1,1,1))
7530 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7531 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7532 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7533 & ADtEA1derx(1,1,1,1,1,1))
7535 C End 6-th order cumulants
7538 cd write (2,*) 'In calc_eello6'
7540 cd write (2,*) 'iii=',iii
7542 cd write (2,*) 'kkk=',kkk
7544 cd write (2,'(3(2f10.5),5x)')
7545 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7550 call transpose2(EUgder(1,1,k),auxmat(1,1))
7551 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7552 call transpose2(EUg(1,1,k),auxmat(1,1))
7553 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7554 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7558 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7559 & EAEAderx(1,1,lll,kkk,iii,1))
7563 C A1T kernel(i+1) A2
7564 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7565 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7566 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7567 C Following matrices are needed only for 6-th order cumulants
7568 IF (wcorr6.gt.0.0d0) THEN
7569 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7570 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7571 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7572 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7573 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7574 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7575 & ADtEAderx(1,1,1,1,1,2))
7576 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7577 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7578 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7579 & ADtEA1derx(1,1,1,1,1,2))
7581 C End 6-th order cumulants
7582 call transpose2(EUgder(1,1,l),auxmat(1,1))
7583 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7584 call transpose2(EUg(1,1,l),auxmat(1,1))
7585 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7586 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7590 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7591 & EAEAderx(1,1,lll,kkk,iii,2))
7596 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7597 C They are needed only when the fifth- or the sixth-order cumulants are
7599 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7600 call transpose2(AEA(1,1,1),auxmat(1,1))
7601 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7602 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7603 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7604 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7605 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7606 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7607 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7608 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7609 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7610 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7611 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7612 call transpose2(AEA(1,1,2),auxmat(1,1))
7613 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
7614 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7615 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7616 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7617 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
7618 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7619 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
7620 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
7621 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7622 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7623 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7624 C Calculate the Cartesian derivatives of the vectors.
7628 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7629 call matvec2(auxmat(1,1),b1(1,i),
7630 & AEAb1derx(1,lll,kkk,iii,1,1))
7631 call matvec2(auxmat(1,1),Ub2(1,i),
7632 & AEAb2derx(1,lll,kkk,iii,1,1))
7633 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7634 & AEAb1derx(1,lll,kkk,iii,2,1))
7635 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7636 & AEAb2derx(1,lll,kkk,iii,2,1))
7637 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7638 call matvec2(auxmat(1,1),b1(1,j),
7639 & AEAb1derx(1,lll,kkk,iii,1,2))
7640 call matvec2(auxmat(1,1),Ub2(1,j),
7641 & AEAb2derx(1,lll,kkk,iii,1,2))
7642 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
7643 & AEAb1derx(1,lll,kkk,iii,2,2))
7644 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7645 & AEAb2derx(1,lll,kkk,iii,2,2))
7652 C Antiparallel orientation of the two CA-CA-CA frames.
7654 iti=itype2loc(itype(i))
7658 itk1=itype2loc(itype(k+1))
7659 itl=itype2loc(itype(l))
7660 itj=itype2loc(itype(j))
7661 if (j.lt.nres-1) then
7662 itj1=itype2loc(itype(j+1))
7666 C A2 kernel(j-1)T A1T
7667 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7668 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7669 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7670 C Following matrices are needed only for 6-th order cumulants
7671 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7672 & j.eq.i+4 .and. l.eq.i+3)) THEN
7673 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7674 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7675 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7676 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7677 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7678 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7679 & ADtEAderx(1,1,1,1,1,1))
7680 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7681 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7682 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7683 & ADtEA1derx(1,1,1,1,1,1))
7685 C End 6-th order cumulants
7686 call transpose2(EUgder(1,1,k),auxmat(1,1))
7687 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7688 call transpose2(EUg(1,1,k),auxmat(1,1))
7689 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7690 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7694 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7695 & EAEAderx(1,1,lll,kkk,iii,1))
7699 C A2T kernel(i+1)T A1
7700 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7701 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7702 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7703 C Following matrices are needed only for 6-th order cumulants
7704 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7705 & j.eq.i+4 .and. l.eq.i+3)) THEN
7706 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7707 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7708 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7709 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7710 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7711 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7712 & ADtEAderx(1,1,1,1,1,2))
7713 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7714 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7715 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7716 & ADtEA1derx(1,1,1,1,1,2))
7718 C End 6-th order cumulants
7719 call transpose2(EUgder(1,1,j),auxmat(1,1))
7720 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7721 call transpose2(EUg(1,1,j),auxmat(1,1))
7722 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7723 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7727 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7728 & EAEAderx(1,1,lll,kkk,iii,2))
7733 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7734 C They are needed only when the fifth- or the sixth-order cumulants are
7736 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7737 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7738 call transpose2(AEA(1,1,1),auxmat(1,1))
7739 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7740 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7741 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7742 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7743 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7744 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7745 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7746 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7747 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7748 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7749 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7750 call transpose2(AEA(1,1,2),auxmat(1,1))
7751 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
7752 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7753 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7754 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7755 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
7756 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7757 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
7758 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
7759 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7760 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7761 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7762 C Calculate the Cartesian derivatives of the vectors.
7766 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7767 call matvec2(auxmat(1,1),b1(1,i),
7768 & AEAb1derx(1,lll,kkk,iii,1,1))
7769 call matvec2(auxmat(1,1),Ub2(1,i),
7770 & AEAb2derx(1,lll,kkk,iii,1,1))
7771 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7772 & AEAb1derx(1,lll,kkk,iii,2,1))
7773 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7774 & AEAb2derx(1,lll,kkk,iii,2,1))
7775 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7776 call matvec2(auxmat(1,1),b1(1,l),
7777 & AEAb1derx(1,lll,kkk,iii,1,2))
7778 call matvec2(auxmat(1,1),Ub2(1,l),
7779 & AEAb2derx(1,lll,kkk,iii,1,2))
7780 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
7781 & AEAb1derx(1,lll,kkk,iii,2,2))
7782 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7783 & AEAb2derx(1,lll,kkk,iii,2,2))
7792 C---------------------------------------------------------------------------
7793 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7794 & KK,KKderg,AKA,AKAderg,AKAderx)
7798 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7799 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7800 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7805 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7807 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7810 cd if (lprn) write (2,*) 'In kernel'
7812 cd if (lprn) write (2,*) 'kkk=',kkk
7814 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7815 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7817 cd write (2,*) 'lll=',lll
7818 cd write (2,*) 'iii=1'
7820 cd write (2,'(3(2f10.5),5x)')
7821 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7824 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7825 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7827 cd write (2,*) 'lll=',lll
7828 cd write (2,*) 'iii=2'
7830 cd write (2,'(3(2f10.5),5x)')
7831 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7838 C---------------------------------------------------------------------------
7839 double precision function eello4(i,j,k,l,jj,kk)
7840 implicit real*8 (a-h,o-z)
7841 include 'DIMENSIONS'
7842 include 'DIMENSIONS.ZSCOPT'
7843 include 'COMMON.IOUNITS'
7844 include 'COMMON.CHAIN'
7845 include 'COMMON.DERIV'
7846 include 'COMMON.INTERACT'
7847 include 'COMMON.CONTACTS'
7848 include 'COMMON.CONTMAT'
7849 include 'COMMON.CORRMAT'
7850 include 'COMMON.TORSION'
7851 include 'COMMON.VAR'
7852 include 'COMMON.GEO'
7853 double precision pizda(2,2),ggg1(3),ggg2(3)
7854 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7858 cd print *,'eello4:',i,j,k,l,jj,kk
7859 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7860 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7861 cold eij=facont_hb(jj,i)
7862 cold ekl=facont_hb(kk,k)
7864 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7866 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7867 gcorr_loc(k-1)=gcorr_loc(k-1)
7868 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7870 gcorr_loc(l-1)=gcorr_loc(l-1)
7871 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7873 gcorr_loc(j-1)=gcorr_loc(j-1)
7874 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7879 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7880 & -EAEAderx(2,2,lll,kkk,iii,1)
7881 cd derx(lll,kkk,iii)=0.0d0
7885 cd gcorr_loc(l-1)=0.0d0
7886 cd gcorr_loc(j-1)=0.0d0
7887 cd gcorr_loc(k-1)=0.0d0
7889 cd write (iout,*)'Contacts have occurred for peptide groups',
7890 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7891 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7892 if (j.lt.nres-1) then
7899 if (l.lt.nres-1) then
7907 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7908 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7909 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7910 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7911 cgrad ghalf=0.5d0*ggg1(ll)
7912 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7913 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7914 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7915 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7916 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7917 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7918 cgrad ghalf=0.5d0*ggg2(ll)
7919 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7920 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7921 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7922 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7923 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7924 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7928 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7933 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7938 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7943 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7947 cd write (2,*) iii,gcorr_loc(iii)
7951 cd write (2,*) 'ekont',ekont
7952 cd write (iout,*) 'eello4',ekont*eel4
7955 C---------------------------------------------------------------------------
7956 double precision function eello5(i,j,k,l,jj,kk)
7957 implicit real*8 (a-h,o-z)
7958 include 'DIMENSIONS'
7959 include 'DIMENSIONS.ZSCOPT'
7960 include 'COMMON.IOUNITS'
7961 include 'COMMON.CHAIN'
7962 include 'COMMON.DERIV'
7963 include 'COMMON.INTERACT'
7964 include 'COMMON.CONTACTS'
7965 include 'COMMON.CONTMAT'
7966 include 'COMMON.CORRMAT'
7967 include 'COMMON.TORSION'
7968 include 'COMMON.VAR'
7969 include 'COMMON.GEO'
7970 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7971 double precision ggg1(3),ggg2(3)
7972 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7977 C /l\ / \ \ / \ / \ / C
7978 C / \ / \ \ / \ / \ / C
7979 C j| o |l1 | o | o| o | | o |o C
7980 C \ |/k\| |/ \| / |/ \| |/ \| C
7981 C \i/ \ / \ / / \ / \ C
7983 C (I) (II) (III) (IV) C
7985 C eello5_1 eello5_2 eello5_3 eello5_4 C
7987 C Antiparallel chains C
7990 C /j\ / \ \ / \ / \ / C
7991 C / \ / \ \ / \ / \ / C
7992 C j1| o |l | o | o| o | | o |o C
7993 C \ |/k\| |/ \| / |/ \| |/ \| C
7994 C \i/ \ / \ / / \ / \ C
7996 C (I) (II) (III) (IV) C
7998 C eello5_1 eello5_2 eello5_3 eello5_4 C
8000 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8002 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8003 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8008 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8010 itk=itype2loc(itype(k))
8011 itl=itype2loc(itype(l))
8012 itj=itype2loc(itype(j))
8017 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8018 cd & eel5_3_num,eel5_4_num)
8022 derx(lll,kkk,iii)=0.0d0
8026 cd eij=facont_hb(jj,i)
8027 cd ekl=facont_hb(kk,k)
8029 cd write (iout,*)'Contacts have occurred for peptide groups',
8030 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8032 C Contribution from the graph I.
8033 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8034 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8035 call transpose2(EUg(1,1,k),auxmat(1,1))
8036 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8037 vv(1)=pizda(1,1)-pizda(2,2)
8038 vv(2)=pizda(1,2)+pizda(2,1)
8039 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8040 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8042 C Explicit gradient in virtual-dihedral angles.
8043 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8044 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8045 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8046 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8047 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8048 vv(1)=pizda(1,1)-pizda(2,2)
8049 vv(2)=pizda(1,2)+pizda(2,1)
8050 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8051 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8052 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8053 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8054 vv(1)=pizda(1,1)-pizda(2,2)
8055 vv(2)=pizda(1,2)+pizda(2,1)
8057 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8058 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8059 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8061 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8062 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8063 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8065 C Cartesian gradient
8069 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8071 vv(1)=pizda(1,1)-pizda(2,2)
8072 vv(2)=pizda(1,2)+pizda(2,1)
8073 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8074 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8075 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8082 C Contribution from graph II
8083 call transpose2(EE(1,1,k),auxmat(1,1))
8084 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8085 vv(1)=pizda(1,1)+pizda(2,2)
8086 vv(2)=pizda(2,1)-pizda(1,2)
8087 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
8088 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8090 C Explicit gradient in virtual-dihedral angles.
8091 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8092 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8093 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8094 vv(1)=pizda(1,1)+pizda(2,2)
8095 vv(2)=pizda(2,1)-pizda(1,2)
8097 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8098 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8099 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8101 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8102 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8103 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8105 C Cartesian gradient
8109 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8111 vv(1)=pizda(1,1)+pizda(2,2)
8112 vv(2)=pizda(2,1)-pizda(1,2)
8113 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8114 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
8115 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8124 C Parallel orientation
8125 C Contribution from graph III
8126 call transpose2(EUg(1,1,l),auxmat(1,1))
8127 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8128 vv(1)=pizda(1,1)-pizda(2,2)
8129 vv(2)=pizda(1,2)+pizda(2,1)
8130 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8131 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8133 C Explicit gradient in virtual-dihedral angles.
8134 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8135 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8136 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8137 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8138 vv(1)=pizda(1,1)-pizda(2,2)
8139 vv(2)=pizda(1,2)+pizda(2,1)
8140 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8141 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8142 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8143 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8144 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8145 vv(1)=pizda(1,1)-pizda(2,2)
8146 vv(2)=pizda(1,2)+pizda(2,1)
8147 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8148 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8149 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8150 C Cartesian gradient
8154 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8156 vv(1)=pizda(1,1)-pizda(2,2)
8157 vv(2)=pizda(1,2)+pizda(2,1)
8158 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8159 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8160 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8165 C Contribution from graph IV
8167 call transpose2(EE(1,1,l),auxmat(1,1))
8168 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8169 vv(1)=pizda(1,1)+pizda(2,2)
8170 vv(2)=pizda(2,1)-pizda(1,2)
8171 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
8172 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8173 C Explicit gradient in virtual-dihedral angles.
8174 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8175 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8176 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8177 vv(1)=pizda(1,1)+pizda(2,2)
8178 vv(2)=pizda(2,1)-pizda(1,2)
8179 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8180 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
8181 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8182 C Cartesian gradient
8186 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8188 vv(1)=pizda(1,1)+pizda(2,2)
8189 vv(2)=pizda(2,1)-pizda(1,2)
8190 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8191 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
8192 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8198 C Antiparallel orientation
8199 C Contribution from graph III
8201 call transpose2(EUg(1,1,j),auxmat(1,1))
8202 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8203 vv(1)=pizda(1,1)-pizda(2,2)
8204 vv(2)=pizda(1,2)+pizda(2,1)
8205 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8206 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8208 C Explicit gradient in virtual-dihedral angles.
8209 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8210 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8211 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8212 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8213 vv(1)=pizda(1,1)-pizda(2,2)
8214 vv(2)=pizda(1,2)+pizda(2,1)
8215 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8216 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8217 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8218 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8219 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8220 vv(1)=pizda(1,1)-pizda(2,2)
8221 vv(2)=pizda(1,2)+pizda(2,1)
8222 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8223 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8224 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8225 C Cartesian gradient
8229 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8231 vv(1)=pizda(1,1)-pizda(2,2)
8232 vv(2)=pizda(1,2)+pizda(2,1)
8233 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8234 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8235 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8241 C Contribution from graph IV
8243 call transpose2(EE(1,1,j),auxmat(1,1))
8244 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8245 vv(1)=pizda(1,1)+pizda(2,2)
8246 vv(2)=pizda(2,1)-pizda(1,2)
8247 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
8248 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8250 C Explicit gradient in virtual-dihedral angles.
8251 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8252 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8253 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8254 vv(1)=pizda(1,1)+pizda(2,2)
8255 vv(2)=pizda(2,1)-pizda(1,2)
8256 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8257 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
8258 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8259 C Cartesian gradient
8263 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8265 vv(1)=pizda(1,1)+pizda(2,2)
8266 vv(2)=pizda(2,1)-pizda(1,2)
8267 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8268 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
8269 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8276 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8277 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8278 cd write (2,*) 'ijkl',i,j,k,l
8279 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8280 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8282 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8283 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8284 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8285 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8287 if (j.lt.nres-1) then
8294 if (l.lt.nres-1) then
8304 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8305 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8306 C summed up outside the subrouine as for the other subroutines
8307 C handling long-range interactions. The old code is commented out
8308 C with "cgrad" to keep track of changes.
8310 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8311 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8312 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8313 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8314 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8315 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8316 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8317 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8318 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8319 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8321 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8322 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8323 cgrad ghalf=0.5d0*ggg1(ll)
8325 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8326 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8327 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8328 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8329 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8330 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8331 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8332 cgrad ghalf=0.5d0*ggg2(ll)
8334 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
8335 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8336 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
8337 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8338 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8339 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8345 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8346 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8351 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8352 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8358 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8363 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8367 cd write (2,*) iii,g_corr5_loc(iii)
8370 cd write (2,*) 'ekont',ekont
8371 cd write (iout,*) 'eello5',ekont*eel5
8374 c--------------------------------------------------------------------------
8375 double precision function eello6(i,j,k,l,jj,kk)
8376 implicit real*8 (a-h,o-z)
8377 include 'DIMENSIONS'
8378 include 'DIMENSIONS.ZSCOPT'
8379 include 'COMMON.IOUNITS'
8380 include 'COMMON.CHAIN'
8381 include 'COMMON.DERIV'
8382 include 'COMMON.INTERACT'
8383 include 'COMMON.CONTACTS'
8384 include 'COMMON.CONTMAT'
8385 include 'COMMON.CORRMAT'
8386 include 'COMMON.TORSION'
8387 include 'COMMON.VAR'
8388 include 'COMMON.GEO'
8389 include 'COMMON.FFIELD'
8390 double precision ggg1(3),ggg2(3)
8391 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8396 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8404 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8405 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8409 derx(lll,kkk,iii)=0.0d0
8413 cd eij=facont_hb(jj,i)
8414 cd ekl=facont_hb(kk,k)
8420 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8421 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8422 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8423 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8424 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8425 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8427 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8428 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8429 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8430 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8431 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8432 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8436 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8438 C If turn contributions are considered, they will be handled separately.
8439 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8440 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8441 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8442 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8443 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8444 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8445 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8448 if (j.lt.nres-1) then
8455 if (l.lt.nres-1) then
8463 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8464 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8465 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8466 cgrad ghalf=0.5d0*ggg1(ll)
8468 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8469 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8470 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8471 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8472 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8473 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8474 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8475 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8476 cgrad ghalf=0.5d0*ggg2(ll)
8477 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8479 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8480 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8481 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8482 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8483 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8484 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8490 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8491 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8496 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8497 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8503 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8508 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8512 cd write (2,*) iii,g_corr6_loc(iii)
8515 cd write (2,*) 'ekont',ekont
8516 cd write (iout,*) 'eello6',ekont*eel6
8519 c--------------------------------------------------------------------------
8520 double precision function eello6_graph1(i,j,k,l,imat,swap)
8521 implicit real*8 (a-h,o-z)
8522 include 'DIMENSIONS'
8523 include 'DIMENSIONS.ZSCOPT'
8524 include 'COMMON.IOUNITS'
8525 include 'COMMON.CHAIN'
8526 include 'COMMON.DERIV'
8527 include 'COMMON.INTERACT'
8528 include 'COMMON.CONTACTS'
8529 include 'COMMON.CONTMAT'
8530 include 'COMMON.CORRMAT'
8531 include 'COMMON.TORSION'
8532 include 'COMMON.VAR'
8533 include 'COMMON.GEO'
8534 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8538 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8540 C Parallel Antiparallel C
8546 C \ j|/k\| / \ |/k\|l / C
8551 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8552 itk=itype2loc(itype(k))
8553 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8554 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8555 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8556 call transpose2(EUgC(1,1,k),auxmat(1,1))
8557 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8558 vv1(1)=pizda1(1,1)-pizda1(2,2)
8559 vv1(2)=pizda1(1,2)+pizda1(2,1)
8560 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8561 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
8562 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
8563 s5=scalar2(vv(1),Dtobr2(1,i))
8564 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8565 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8567 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8568 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8569 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8570 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8571 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8572 & +scalar2(vv(1),Dtobr2der(1,i)))
8573 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8574 vv1(1)=pizda1(1,1)-pizda1(2,2)
8575 vv1(2)=pizda1(1,2)+pizda1(2,1)
8576 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
8577 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
8579 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8580 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8581 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8582 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8583 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8585 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8586 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8587 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8588 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8589 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8591 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8592 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8593 vv1(1)=pizda1(1,1)-pizda1(2,2)
8594 vv1(2)=pizda1(1,2)+pizda1(2,1)
8595 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8596 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8597 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8598 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8607 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8608 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8609 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8610 call transpose2(EUgC(1,1,k),auxmat(1,1))
8611 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8613 vv1(1)=pizda1(1,1)-pizda1(2,2)
8614 vv1(2)=pizda1(1,2)+pizda1(2,1)
8615 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8616 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
8617 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
8618 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
8619 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
8620 s5=scalar2(vv(1),Dtobr2(1,i))
8621 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8628 c----------------------------------------------------------------------------
8629 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8630 implicit real*8 (a-h,o-z)
8631 include 'DIMENSIONS'
8632 include 'DIMENSIONS.ZSCOPT'
8633 include 'COMMON.IOUNITS'
8634 include 'COMMON.CHAIN'
8635 include 'COMMON.DERIV'
8636 include 'COMMON.INTERACT'
8637 include 'COMMON.CONTACTS'
8638 include 'COMMON.CONTMAT'
8639 include 'COMMON.CORRMAT'
8640 include 'COMMON.TORSION'
8641 include 'COMMON.VAR'
8642 include 'COMMON.GEO'
8644 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8645 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8648 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8650 C Parallel Antiparallel C
8656 C \ j|/k\| \ |/k\|l C
8661 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8662 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8663 C AL 7/4/01 s1 would occur in the sixth-order moment,
8664 C but not in a cluster cumulant
8666 s1=dip(1,jj,i)*dip(1,kk,k)
8668 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8669 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8670 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8671 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8672 call transpose2(EUg(1,1,k),auxmat(1,1))
8673 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8674 vv(1)=pizda(1,1)-pizda(2,2)
8675 vv(2)=pizda(1,2)+pizda(2,1)
8676 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8677 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8679 eello6_graph2=-(s1+s2+s3+s4)
8681 eello6_graph2=-(s2+s3+s4)
8684 C Derivatives in gamma(i-1)
8688 s1=dipderg(1,jj,i)*dip(1,kk,k)
8690 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8691 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8692 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8693 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8695 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8697 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8699 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8701 C Derivatives in gamma(k-1)
8703 s1=dip(1,jj,i)*dipderg(1,kk,k)
8705 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8706 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8707 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8708 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8709 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8710 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8711 vv(1)=pizda(1,1)-pizda(2,2)
8712 vv(2)=pizda(1,2)+pizda(2,1)
8713 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8715 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8717 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8719 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8720 C Derivatives in gamma(j-1) or gamma(l-1)
8723 s1=dipderg(3,jj,i)*dip(1,kk,k)
8725 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8726 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8727 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8728 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8729 vv(1)=pizda(1,1)-pizda(2,2)
8730 vv(2)=pizda(1,2)+pizda(2,1)
8731 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8734 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8736 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8739 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8740 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8742 C Derivatives in gamma(l-1) or gamma(j-1)
8745 s1=dip(1,jj,i)*dipderg(3,kk,k)
8747 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8748 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8749 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8750 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8751 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8752 vv(1)=pizda(1,1)-pizda(2,2)
8753 vv(2)=pizda(1,2)+pizda(2,1)
8754 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8757 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8759 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8762 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8763 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8765 C Cartesian derivatives.
8767 write (2,*) 'In eello6_graph2'
8769 write (2,*) 'iii=',iii
8771 write (2,*) 'kkk=',kkk
8773 write (2,'(3(2f10.5),5x)')
8774 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8784 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8786 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8789 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8791 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8792 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8794 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8795 call transpose2(EUg(1,1,k),auxmat(1,1))
8796 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8798 vv(1)=pizda(1,1)-pizda(2,2)
8799 vv(2)=pizda(1,2)+pizda(2,1)
8800 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8801 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8803 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8805 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8808 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8810 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8818 c----------------------------------------------------------------------------
8819 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8820 implicit real*8 (a-h,o-z)
8821 include 'DIMENSIONS'
8822 include 'DIMENSIONS.ZSCOPT'
8823 include 'COMMON.IOUNITS'
8824 include 'COMMON.CHAIN'
8825 include 'COMMON.DERIV'
8826 include 'COMMON.INTERACT'
8827 include 'COMMON.CONTACTS'
8828 include 'COMMON.CONTMAT'
8829 include 'COMMON.CORRMAT'
8830 include 'COMMON.TORSION'
8831 include 'COMMON.VAR'
8832 include 'COMMON.GEO'
8833 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8835 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8837 C Parallel Antiparallel C
8843 C j|/k\| / |/k\|l / C
8848 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8850 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8851 C energy moment and not to the cluster cumulant.
8852 iti=itortyp(itype(i))
8853 if (j.lt.nres-1) then
8854 itj1=itype2loc(itype(j+1))
8858 itk=itype2loc(itype(k))
8859 itk1=itype2loc(itype(k+1))
8860 if (l.lt.nres-1) then
8861 itl1=itype2loc(itype(l+1))
8866 s1=dip(4,jj,i)*dip(4,kk,k)
8868 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
8869 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8870 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
8871 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8872 call transpose2(EE(1,1,k),auxmat(1,1))
8873 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8874 vv(1)=pizda(1,1)+pizda(2,2)
8875 vv(2)=pizda(2,1)-pizda(1,2)
8876 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8877 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8878 cd & "sum",-(s2+s3+s4)
8880 eello6_graph3=-(s1+s2+s3+s4)
8882 eello6_graph3=-(s2+s3+s4)
8885 C Derivatives in gamma(k-1)
8887 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
8888 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8889 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8890 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8891 C Derivatives in gamma(l-1)
8892 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
8893 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8894 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8895 vv(1)=pizda(1,1)+pizda(2,2)
8896 vv(2)=pizda(2,1)-pizda(1,2)
8897 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8898 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8899 C Cartesian derivatives.
8905 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8907 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8910 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8912 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8913 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8915 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8916 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8918 vv(1)=pizda(1,1)+pizda(2,2)
8919 vv(2)=pizda(2,1)-pizda(1,2)
8920 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8922 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8924 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8927 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8929 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8931 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8938 c----------------------------------------------------------------------------
8939 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8940 implicit real*8 (a-h,o-z)
8941 include 'DIMENSIONS'
8942 include 'DIMENSIONS.ZSCOPT'
8943 include 'COMMON.IOUNITS'
8944 include 'COMMON.CHAIN'
8945 include 'COMMON.DERIV'
8946 include 'COMMON.INTERACT'
8947 include 'COMMON.CONTACTS'
8948 include 'COMMON.CONTMAT'
8949 include 'COMMON.CORRMAT'
8950 include 'COMMON.TORSION'
8951 include 'COMMON.VAR'
8952 include 'COMMON.GEO'
8953 include 'COMMON.FFIELD'
8954 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8955 & auxvec1(2),auxmat1(2,2)
8957 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8959 C Parallel Antiparallel C
8965 C \ j|/k\| \ |/k\|l C
8970 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8972 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8973 C energy moment and not to the cluster cumulant.
8974 cd write (2,*) 'eello_graph4: wturn6',wturn6
8975 iti=itype2loc(itype(i))
8976 itj=itype2loc(itype(j))
8977 if (j.lt.nres-1) then
8978 itj1=itype2loc(itype(j+1))
8982 itk=itype2loc(itype(k))
8983 if (k.lt.nres-1) then
8984 itk1=itype2loc(itype(k+1))
8988 itl=itype2loc(itype(l))
8989 if (l.lt.nres-1) then
8990 itl1=itype2loc(itype(l+1))
8994 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8995 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8996 cd & ' itl',itl,' itl1',itl1
8999 s1=dip(3,jj,i)*dip(3,kk,k)
9001 s1=dip(2,jj,j)*dip(2,kk,l)
9004 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9005 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9007 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
9008 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9010 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
9011 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9013 call transpose2(EUg(1,1,k),auxmat(1,1))
9014 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9015 vv(1)=pizda(1,1)-pizda(2,2)
9016 vv(2)=pizda(2,1)+pizda(1,2)
9017 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9018 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9020 eello6_graph4=-(s1+s2+s3+s4)
9022 eello6_graph4=-(s2+s3+s4)
9024 C Derivatives in gamma(i-1)
9029 s1=dipderg(2,jj,i)*dip(3,kk,k)
9031 s1=dipderg(4,jj,j)*dip(2,kk,l)
9034 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9036 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
9037 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9039 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
9040 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9042 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9043 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9044 cd write (2,*) 'turn6 derivatives'
9046 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9048 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9052 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9054 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9058 C Derivatives in gamma(k-1)
9061 s1=dip(3,jj,i)*dipderg(2,kk,k)
9063 s1=dip(2,jj,j)*dipderg(4,kk,l)
9066 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9067 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9069 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
9070 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9072 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
9073 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9075 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9076 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9077 vv(1)=pizda(1,1)-pizda(2,2)
9078 vv(2)=pizda(2,1)+pizda(1,2)
9079 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9080 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9082 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9084 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9088 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9090 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9093 C Derivatives in gamma(j-1) or gamma(l-1)
9094 if (l.eq.j+1 .and. l.gt.1) then
9095 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9096 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9097 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9098 vv(1)=pizda(1,1)-pizda(2,2)
9099 vv(2)=pizda(2,1)+pizda(1,2)
9100 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9101 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9102 else if (j.gt.1) then
9103 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9104 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9105 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9106 vv(1)=pizda(1,1)-pizda(2,2)
9107 vv(2)=pizda(2,1)+pizda(1,2)
9108 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9109 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9110 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9112 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9115 C Cartesian derivatives.
9122 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9124 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9128 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9130 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9134 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9136 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9138 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9139 & b1(1,j+1),auxvec(1))
9140 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
9142 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9143 & b1(1,l+1),auxvec(1))
9144 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
9146 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9148 vv(1)=pizda(1,1)-pizda(2,2)
9149 vv(2)=pizda(2,1)+pizda(1,2)
9150 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9152 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9154 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9157 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9160 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9163 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9165 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9167 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9171 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9173 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9176 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9178 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9187 c----------------------------------------------------------------------------
9188 double precision function eello_turn6(i,jj,kk)
9189 implicit real*8 (a-h,o-z)
9190 include 'DIMENSIONS'
9191 include 'DIMENSIONS.ZSCOPT'
9192 include 'COMMON.IOUNITS'
9193 include 'COMMON.CHAIN'
9194 include 'COMMON.DERIV'
9195 include 'COMMON.INTERACT'
9196 include 'COMMON.CONTACTS'
9197 include 'COMMON.CONTMAT'
9198 include 'COMMON.CORRMAT'
9199 include 'COMMON.TORSION'
9200 include 'COMMON.VAR'
9201 include 'COMMON.GEO'
9202 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9203 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9205 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9206 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9207 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9208 C the respective energy moment and not to the cluster cumulant.
9217 iti=itype2loc(itype(i))
9218 itk=itype2loc(itype(k))
9219 itk1=itype2loc(itype(k+1))
9220 itl=itype2loc(itype(l))
9221 itj=itype2loc(itype(j))
9222 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9223 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9224 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9229 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9231 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9235 derx_turn(lll,kkk,iii)=0.0d0
9242 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9244 cd write (2,*) 'eello6_5',eello6_5
9246 call transpose2(AEA(1,1,1),auxmat(1,1))
9247 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9248 ss1=scalar2(Ub2(1,i+2),b1(1,l))
9249 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9251 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9252 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9253 s2 = scalar2(b1(1,k),vtemp1(1))
9255 call transpose2(AEA(1,1,2),atemp(1,1))
9256 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9257 call matvec2(Ug2(1,1,i+2),dd(1,1,k+1),vtemp2(1))
9258 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2(1))
9260 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9261 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9262 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9264 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9265 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9266 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9267 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9268 ss13 = scalar2(b1(1,k),vtemp4(1))
9269 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9271 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9277 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9278 C Derivatives in gamma(i+2)
9283 call transpose2(AEA(1,1,1),auxmatd(1,1))
9284 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9285 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9286 call transpose2(AEAderg(1,1,2),atempd(1,1))
9287 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9288 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
9290 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9291 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9292 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9298 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9299 C Derivatives in gamma(i+3)
9301 call transpose2(AEA(1,1,1),auxmatd(1,1))
9302 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9303 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
9304 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9306 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
9307 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9308 s2d = scalar2(b1(1,k),vtemp1d(1))
9310 call matvec2(Ug2der(1,1,i+2),dd(1,1,k+1),vtemp2d(1))
9311 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2d(1))
9313 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9315 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9316 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9317 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9325 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9326 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9328 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9329 & -0.5d0*ekont*(s2d+s12d)
9331 C Derivatives in gamma(i+4)
9332 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9333 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9334 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9336 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9337 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9338 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9346 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9348 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9350 C Derivatives in gamma(i+5)
9352 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9353 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9354 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9356 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
9357 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9358 s2d = scalar2(b1(1,k),vtemp1d(1))
9360 call transpose2(AEA(1,1,2),atempd(1,1))
9361 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9362 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
9364 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9365 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9367 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9368 ss13d = scalar2(b1(1,k),vtemp4d(1))
9369 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9377 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9378 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9380 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9381 & -0.5d0*ekont*(s2d+s12d)
9383 C Cartesian derivatives
9388 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9389 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9390 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9392 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9393 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9395 s2d = scalar2(b1(1,k),vtemp1d(1))
9397 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9398 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9399 s8d = -(atempd(1,1)+atempd(2,2))*
9400 & scalar2(cc(1,1,l),vtemp2(1))
9402 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9404 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9405 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9412 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9415 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9419 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9420 & - 0.5d0*(s8d+s12d)
9422 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9431 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9433 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9434 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9435 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9436 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9437 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9439 ss13d = scalar2(b1(1,k),vtemp4d(1))
9440 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9441 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9445 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9446 cd & 16*eel_turn6_num
9448 if (j.lt.nres-1) then
9455 if (l.lt.nres-1) then
9463 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9464 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9465 cgrad ghalf=0.5d0*ggg1(ll)
9467 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9468 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9469 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9470 & +ekont*derx_turn(ll,2,1)
9471 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9472 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9473 & +ekont*derx_turn(ll,4,1)
9474 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9475 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9476 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9477 cgrad ghalf=0.5d0*ggg2(ll)
9479 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9480 & +ekont*derx_turn(ll,2,2)
9481 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9482 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9483 & +ekont*derx_turn(ll,4,2)
9484 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9485 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9486 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9491 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9496 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9502 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9507 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9511 cd write (2,*) iii,g_corr6_loc(iii)
9514 eello_turn6=ekont*eel_turn6
9515 cd write (2,*) 'ekont',ekont
9516 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9520 crc-------------------------------------------------
9521 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9522 subroutine Eliptransfer(eliptran)
9523 implicit real*8 (a-h,o-z)
9524 include 'DIMENSIONS'
9525 include 'DIMENSIONS.ZSCOPT'
9526 include 'COMMON.GEO'
9527 include 'COMMON.VAR'
9528 include 'COMMON.LOCAL'
9529 include 'COMMON.CHAIN'
9530 include 'COMMON.DERIV'
9531 include 'COMMON.INTERACT'
9532 include 'COMMON.IOUNITS'
9533 include 'COMMON.CALC'
9534 include 'COMMON.CONTROL'
9535 include 'COMMON.SPLITELE'
9536 include 'COMMON.SBRIDGE'
9537 C this is done by Adasko
9541 C--bordliptop-- buffore starts
9542 C--bufliptop--- here true lipid starts
9544 C--buflipbot--- lipid ends buffore starts
9545 C--bordlipbot--buffore ends
9547 c write (iout,*) "Eliptransfer peplipran",pepliptran
9551 if (itype(i).eq.ntyp1) cycle
9553 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
9554 if (positi.le.0) positi=positi+boxzsize
9556 C first for peptide groups
9557 c for each residue check if it is in lipid or lipid water border area
9558 if ((positi.gt.bordlipbot)
9559 &.and.(positi.lt.bordliptop)) then
9560 C the energy transfer exist
9561 if (positi.lt.buflipbot) then
9562 C what fraction I am in
9564 & ((positi-bordlipbot)/lipbufthick)
9565 C lipbufthick is thickenes of lipid buffore
9566 sslip=sscalelip(fracinbuf)
9567 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9568 eliptran=eliptran+sslip*pepliptran
9569 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
9570 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
9571 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
9572 elseif (positi.gt.bufliptop) then
9573 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
9574 sslip=sscalelip(fracinbuf)
9575 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9576 eliptran=eliptran+sslip*pepliptran
9577 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
9578 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
9579 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
9580 C print *, "doing sscalefor top part"
9581 C print *,i,sslip,fracinbuf,ssgradlip
9583 eliptran=eliptran+pepliptran
9584 C print *,"I am in true lipid"
9587 C eliptran=elpitran+0.0 ! I am in water
9590 C print *, "nic nie bylo w lipidzie?"
9591 C now multiply all by the peptide group transfer factor
9592 C eliptran=eliptran*pepliptran
9593 C now the same for side chains
9596 if (itype(i).eq.ntyp1) cycle
9597 positi=(mod(c(3,i+nres),boxzsize))
9598 if (positi.le.0) positi=positi+boxzsize
9599 c write(iout,*) "i",i," positi",positi,bordlipbot,buflipbot,
9601 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
9602 c for each residue check if it is in lipid or lipid water border area
9603 C respos=mod(c(3,i+nres),boxzsize)
9604 C print *,positi,bordlipbot,buflipbot
9605 if ((positi.gt.bordlipbot)
9606 & .and.(positi.lt.bordliptop)) then
9607 C the energy transfer exist
9608 if (positi.lt.buflipbot) then
9610 & ((positi-bordlipbot)/lipbufthick)
9611 c write (iout,*) "i",i,itype(i)," fracinbuf",fracinbuf
9612 c write (iout,*) "i",i," liptranene",liptranene(itype(i))
9613 C lipbufthick is thickenes of lipid buffore
9614 sslip=sscalelip(fracinbuf)
9615 c write (iout,*) "sslip",sslip
9616 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9617 eliptran=eliptran+sslip*liptranene(itype(i))
9618 gliptranx(3,i)=gliptranx(3,i)
9619 &+ssgradlip*liptranene(itype(i))
9620 gliptranc(3,i-1)= gliptranc(3,i-1)
9621 &+ssgradlip*liptranene(itype(i))
9622 C print *,"doing sccale for lower part"
9623 elseif (positi.gt.bufliptop) then
9625 &((bordliptop-positi)/lipbufthick)
9626 sslip=sscalelip(fracinbuf)
9627 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9628 eliptran=eliptran+sslip*liptranene(itype(i))
9629 gliptranx(3,i)=gliptranx(3,i)
9630 &+ssgradlip*liptranene(itype(i))
9631 gliptranc(3,i-1)= gliptranc(3,i-1)
9632 &+ssgradlip*liptranene(itype(i))
9633 C print *, "doing sscalefor top part",sslip,fracinbuf
9635 eliptran=eliptran+liptranene(itype(i))
9636 C print *,"I am in true lipid"
9638 endif ! if in lipid or buffor
9640 C eliptran=elpitran+0.0 ! I am in water
9641 c write (iout,*) "eliptran",eliptran
9647 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9649 SUBROUTINE MATVEC2(A1,V1,V2)
9650 implicit real*8 (a-h,o-z)
9651 include 'DIMENSIONS'
9652 DIMENSION A1(2,2),V1(2),V2(2)
9656 c 3 VI=VI+A1(I,K)*V1(K)
9660 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9661 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9666 C---------------------------------------
9667 SUBROUTINE MATMAT2(A1,A2,A3)
9668 implicit real*8 (a-h,o-z)
9669 include 'DIMENSIONS'
9670 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9671 c DIMENSION AI3(2,2)
9675 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9681 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9682 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9683 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9684 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9692 c-------------------------------------------------------------------------
9693 double precision function scalar2(u,v)
9695 double precision u(2),v(2)
9698 scalar2=u(1)*v(1)+u(2)*v(2)
9702 C-----------------------------------------------------------------------------
9704 subroutine transpose2(a,at)
9706 double precision a(2,2),at(2,2)
9713 c--------------------------------------------------------------------------
9714 subroutine transpose(n,a,at)
9717 double precision a(n,n),at(n,n)
9725 C---------------------------------------------------------------------------
9726 subroutine prodmat3(a1,a2,kk,transp,prod)
9729 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9731 crc double precision auxmat(2,2),prod_(2,2)
9734 crc call transpose2(kk(1,1),auxmat(1,1))
9735 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9736 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9738 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9739 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9740 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9741 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9742 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9743 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9744 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9745 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9748 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9749 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9751 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9752 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9753 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9754 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9755 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9756 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9757 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9758 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9761 c call transpose2(a2(1,1),a2t(1,1))
9764 crc print *,((prod_(i,j),i=1,2),j=1,2)
9765 crc print *,((prod(i,j),i=1,2),j=1,2)
9769 C-----------------------------------------------------------------------------
9770 double precision function scalar(u,v)
9772 double precision u(3),v(3)
9782 C-----------------------------------------------------------------------
9783 double precision function sscale(r)
9784 double precision r,gamm
9785 include "COMMON.SPLITELE"
9786 if(r.lt.r_cut-rlamb) then
9788 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9789 gamm=(r-(r_cut-rlamb))/rlamb
9790 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
9796 C-----------------------------------------------------------------------
9797 C-----------------------------------------------------------------------
9798 double precision function sscagrad(r)
9799 double precision r,gamm
9800 include "COMMON.SPLITELE"
9801 if(r.lt.r_cut-rlamb) then
9803 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9804 gamm=(r-(r_cut-rlamb))/rlamb
9805 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
9811 C-----------------------------------------------------------------------
9812 C-----------------------------------------------------------------------
9813 double precision function sscalelip(r)
9814 double precision r,gamm
9815 include "COMMON.SPLITELE"
9816 C if(r.lt.r_cut-rlamb) then
9818 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9819 C gamm=(r-(r_cut-rlamb))/rlamb
9820 sscalelip=1.0d0+r*r*(2*r-3.0d0)
9826 C-----------------------------------------------------------------------
9827 double precision function sscagradlip(r)
9828 double precision r,gamm
9829 include "COMMON.SPLITELE"
9830 C if(r.lt.r_cut-rlamb) then
9832 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9833 C gamm=(r-(r_cut-rlamb))/rlamb
9834 sscagradlip=r*(6*r-6.0d0)
9841 C-----------------------------------------------------------------------
9842 subroutine set_shield_fac
9843 implicit real*8 (a-h,o-z)
9844 include 'DIMENSIONS'
9845 include 'DIMENSIONS.ZSCOPT'
9846 include 'COMMON.CHAIN'
9847 include 'COMMON.DERIV'
9848 include 'COMMON.IOUNITS'
9849 include 'COMMON.SHIELD'
9850 include 'COMMON.INTERACT'
9851 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
9852 double precision div77_81/0.974996043d0/,
9853 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
9855 C the vector between center of side_chain and peptide group
9856 double precision pep_side(3),long,side_calf(3),
9857 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
9858 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
9859 C the line belowe needs to be changed for FGPROC>1
9861 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
9863 Cif there two consequtive dummy atoms there is no peptide group between them
9864 C the line below has to be changed for FGPROC>1
9867 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
9871 C first lets set vector conecting the ithe side-chain with kth side-chain
9872 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
9874 C and vector conecting the side-chain with its proper calfa
9875 side_calf(j)=c(j,k+nres)-c(j,k)
9876 C side_calf(j)=2.0d0
9877 pept_group(j)=c(j,i)-c(j,i+1)
9878 C lets have their lenght
9879 dist_pep_side=pep_side(j)**2+dist_pep_side
9880 dist_side_calf=dist_side_calf+side_calf(j)**2
9881 dist_pept_group=dist_pept_group+pept_group(j)**2
9883 dist_pep_side=dsqrt(dist_pep_side)
9884 dist_pept_group=dsqrt(dist_pept_group)
9885 dist_side_calf=dsqrt(dist_side_calf)
9887 pep_side_norm(j)=pep_side(j)/dist_pep_side
9888 side_calf_norm(j)=dist_side_calf
9890 C now sscale fraction
9891 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
9892 C print *,buff_shield,"buff"
9894 if (sh_frac_dist.le.0.0) cycle
9895 C If we reach here it means that this side chain reaches the shielding sphere
9896 C Lets add him to the list for gradient
9897 ishield_list(i)=ishield_list(i)+1
9898 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
9899 C this list is essential otherwise problem would be O3
9900 shield_list(ishield_list(i),i)=k
9901 C Lets have the sscale value
9902 if (sh_frac_dist.gt.1.0) then
9903 scale_fac_dist=1.0d0
9905 sh_frac_dist_grad(j)=0.0d0
9908 scale_fac_dist=-sh_frac_dist*sh_frac_dist
9909 & *(2.0*sh_frac_dist-3.0d0)
9910 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
9911 & /dist_pep_side/buff_shield*0.5
9912 C remember for the final gradient multiply sh_frac_dist_grad(j)
9913 C for side_chain by factor -2 !
9915 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
9916 C print *,"jestem",scale_fac_dist,fac_help_scale,
9917 C & sh_frac_dist_grad(j)
9920 C if ((i.eq.3).and.(k.eq.2)) then
9921 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
9925 C this is what is now we have the distance scaling now volume...
9926 short=short_r_sidechain(itype(k))
9927 long=long_r_sidechain(itype(k))
9928 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
9931 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
9934 costhet_grad(j)=costhet_fac*pep_side(j)
9936 C remember for the final gradient multiply costhet_grad(j)
9937 C for side_chain by factor -2 !
9938 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9939 C pep_side0pept_group is vector multiplication
9940 pep_side0pept_group=0.0
9942 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9944 cosalfa=(pep_side0pept_group/
9945 & (dist_pep_side*dist_side_calf))
9946 fac_alfa_sin=1.0-cosalfa**2
9947 fac_alfa_sin=dsqrt(fac_alfa_sin)
9948 rkprim=fac_alfa_sin*(long-short)+short
9950 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
9951 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
9954 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9955 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9956 &*(long-short)/fac_alfa_sin*cosalfa/
9957 &((dist_pep_side*dist_side_calf))*
9958 &((side_calf(j))-cosalfa*
9959 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9961 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9962 &*(long-short)/fac_alfa_sin*cosalfa
9963 &/((dist_pep_side*dist_side_calf))*
9965 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9968 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
9971 C now the gradient...
9972 C grad_shield is gradient of Calfa for peptide groups
9973 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
9975 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
9976 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
9978 grad_shield(j,i)=grad_shield(j,i)
9979 C gradient po skalowaniu
9980 & +(sh_frac_dist_grad(j)
9981 C gradient po costhet
9982 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
9983 &-scale_fac_dist*(cosphi_grad_long(j))
9984 &/(1.0-cosphi) )*div77_81
9986 C grad_shield_side is Cbeta sidechain gradient
9987 grad_shield_side(j,ishield_list(i),i)=
9988 & (sh_frac_dist_grad(j)*(-2.0d0)
9989 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
9990 & +scale_fac_dist*(cosphi_grad_long(j))
9991 & *2.0d0/(1.0-cosphi))
9992 & *div77_81*VofOverlap
9994 grad_shield_loc(j,ishield_list(i),i)=
9995 & scale_fac_dist*cosphi_grad_loc(j)
9996 & *2.0d0/(1.0-cosphi)
9997 & *div77_81*VofOverlap
9999 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
10001 fac_shield(i)=VolumeTotal*div77_81+div4_81
10002 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
10006 C--------------------------------------------------------------------------
10007 C first for shielding is setting of function of side-chains
10008 subroutine set_shield_fac2
10009 implicit real*8 (a-h,o-z)
10010 include 'DIMENSIONS'
10011 include 'DIMENSIONS.ZSCOPT'
10012 include 'COMMON.CHAIN'
10013 include 'COMMON.DERIV'
10014 include 'COMMON.IOUNITS'
10015 include 'COMMON.SHIELD'
10016 include 'COMMON.INTERACT'
10017 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
10018 double precision div77_81/0.974996043d0/,
10019 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
10021 C the vector between center of side_chain and peptide group
10022 double precision pep_side(3),long,side_calf(3),
10023 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
10024 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
10025 C the line belowe needs to be changed for FGPROC>1
10027 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
10029 Cif there two consequtive dummy atoms there is no peptide group between them
10030 C the line below has to be changed for FGPROC>1
10033 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
10037 C first lets set vector conecting the ithe side-chain with kth side-chain
10038 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
10039 C pep_side(j)=2.0d0
10040 C and vector conecting the side-chain with its proper calfa
10041 side_calf(j)=c(j,k+nres)-c(j,k)
10042 C side_calf(j)=2.0d0
10043 pept_group(j)=c(j,i)-c(j,i+1)
10044 C lets have their lenght
10045 dist_pep_side=pep_side(j)**2+dist_pep_side
10046 dist_side_calf=dist_side_calf+side_calf(j)**2
10047 dist_pept_group=dist_pept_group+pept_group(j)**2
10049 dist_pep_side=dsqrt(dist_pep_side)
10050 dist_pept_group=dsqrt(dist_pept_group)
10051 dist_side_calf=dsqrt(dist_side_calf)
10053 pep_side_norm(j)=pep_side(j)/dist_pep_side
10054 side_calf_norm(j)=dist_side_calf
10056 C now sscale fraction
10057 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
10058 C print *,buff_shield,"buff"
10060 if (sh_frac_dist.le.0.0) cycle
10061 C If we reach here it means that this side chain reaches the shielding sphere
10062 C Lets add him to the list for gradient
10063 ishield_list(i)=ishield_list(i)+1
10064 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
10065 C this list is essential otherwise problem would be O3
10066 shield_list(ishield_list(i),i)=k
10067 C Lets have the sscale value
10068 if (sh_frac_dist.gt.1.0) then
10069 scale_fac_dist=1.0d0
10071 sh_frac_dist_grad(j)=0.0d0
10074 scale_fac_dist=-sh_frac_dist*sh_frac_dist
10075 & *(2.0d0*sh_frac_dist-3.0d0)
10076 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
10077 & /dist_pep_side/buff_shield*0.5d0
10078 C remember for the final gradient multiply sh_frac_dist_grad(j)
10079 C for side_chain by factor -2 !
10081 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
10082 C sh_frac_dist_grad(j)=0.0d0
10083 C scale_fac_dist=1.0d0
10084 C print *,"jestem",scale_fac_dist,fac_help_scale,
10085 C & sh_frac_dist_grad(j)
10088 C this is what is now we have the distance scaling now volume...
10089 short=short_r_sidechain(itype(k))
10090 long=long_r_sidechain(itype(k))
10091 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
10092 sinthet=short/dist_pep_side*costhet
10096 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
10097 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
10098 C & -short/dist_pep_side**2/costhet)
10099 C costhet_fac=0.0d0
10101 costhet_grad(j)=costhet_fac*pep_side(j)
10103 C remember for the final gradient multiply costhet_grad(j)
10104 C for side_chain by factor -2 !
10105 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
10106 C pep_side0pept_group is vector multiplication
10107 pep_side0pept_group=0.0d0
10109 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
10111 cosalfa=(pep_side0pept_group/
10112 & (dist_pep_side*dist_side_calf))
10113 fac_alfa_sin=1.0d0-cosalfa**2
10114 fac_alfa_sin=dsqrt(fac_alfa_sin)
10115 rkprim=fac_alfa_sin*(long-short)+short
10119 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
10121 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
10122 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
10123 & dist_pep_side**2)
10126 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
10127 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
10128 &*(long-short)/fac_alfa_sin*cosalfa/
10129 &((dist_pep_side*dist_side_calf))*
10130 &((side_calf(j))-cosalfa*
10131 &((pep_side(j)/dist_pep_side)*dist_side_calf))
10132 C cosphi_grad_long(j)=0.0d0
10133 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
10134 &*(long-short)/fac_alfa_sin*cosalfa
10135 &/((dist_pep_side*dist_side_calf))*
10137 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
10138 C cosphi_grad_loc(j)=0.0d0
10140 C print *,sinphi,sinthet
10141 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
10144 C now the gradient...
10146 grad_shield(j,i)=grad_shield(j,i)
10147 C gradient po skalowaniu
10148 & +(sh_frac_dist_grad(j)*VofOverlap
10149 C gradient po costhet
10150 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
10151 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
10152 & sinphi/sinthet*costhet*costhet_grad(j)
10153 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
10155 C grad_shield_side is Cbeta sidechain gradient
10156 grad_shield_side(j,ishield_list(i),i)=
10157 & (sh_frac_dist_grad(j)*(-2.0d0)
10159 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
10160 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
10161 & sinphi/sinthet*costhet*costhet_grad(j)
10162 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
10165 grad_shield_loc(j,ishield_list(i),i)=
10166 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
10167 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
10168 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
10172 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
10174 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
10175 c write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i),
10176 c & " wshield",wshield
10177 c write(2,*) "TU",rpp(1,1),short,long,buff_shield
10181 C--------------------------------------------------------------------------
10182 double precision function tschebyshev(m,n,x,y)
10184 include "DIMENSIONS"
10186 double precision x(n),y,yy(0:maxvar),aux
10187 c Tschebyshev polynomial. Note that the first term is omitted
10188 c m=0: the constant term is included
10189 c m=1: the constant term is not included
10193 yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
10202 C--------------------------------------------------------------------------
10203 double precision function gradtschebyshev(m,n,x,y)
10205 include "DIMENSIONS"
10207 double precision x(n+1),y,yy(0:maxvar),aux
10208 c Tschebyshev polynomial. Note that the first term is omitted
10209 c m=0: the constant term is included
10210 c m=1: the constant term is not included
10214 yy(i)=2*y*yy(i-1)-yy(i-2)
10218 aux=aux+x(i+1)*yy(i)*(i+1)
10219 C print *, x(i+1),yy(i),i
10221 gradtschebyshev=aux
10224 c----------------------------------------------------------------------------
10225 double precision function sscale2(r,r_cut,r0,rlamb)
10227 double precision r,gamm,r_cut,r0,rlamb,rr
10229 c write (2,*) "r",r," r_cut",r_cut," r0",r0," rlamb",rlamb
10230 c write (2,*) "rr",rr
10231 if(rr.lt.r_cut-rlamb) then
10233 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
10234 gamm=(rr-(r_cut-rlamb))/rlamb
10235 sscale2=1.0d0+gamm*gamm*(2*gamm-3.0d0)
10241 C-----------------------------------------------------------------------
10242 double precision function sscalgrad2(r,r_cut,r0,rlamb)
10244 double precision r,gamm,r_cut,r0,rlamb,rr
10246 if(rr.lt.r_cut-rlamb) then
10248 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
10249 gamm=(rr-(r_cut-rlamb))/rlamb
10251 sscalgrad2=gamm*(6*gamm-6.0d0)/rlamb
10253 sscalgrad2=-gamm*(6*gamm-6.0d0)/rlamb
10260 c----------------------------------------------------------------------------
10261 subroutine e_saxs(Esaxs_constr)
10263 include 'DIMENSIONS'
10264 include 'DIMENSIONS.ZSCOPT'
10265 include 'DIMENSIONS.FREE'
10268 include "COMMON.SETUP"
10271 include 'COMMON.SBRIDGE'
10272 include 'COMMON.CHAIN'
10273 include 'COMMON.GEO'
10274 include 'COMMON.LOCAL'
10275 include 'COMMON.INTERACT'
10276 include 'COMMON.VAR'
10277 include 'COMMON.IOUNITS'
10278 include 'COMMON.DERIV'
10279 include 'COMMON.CONTROL'
10280 include 'COMMON.NAMES'
10281 include 'COMMON.FFIELD'
10282 include 'COMMON.LANGEVIN'
10283 include 'COMMON.SAXS'
10285 double precision Esaxs_constr
10286 integer i,iint,j,k,l
10287 double precision PgradC(maxSAXS,3,maxres),
10288 & PgradX(maxSAXS,3,maxres),Pcalc(maxSAXS)
10290 double precision PgradC_(maxSAXS,3,maxres),
10291 & PgradX_(maxSAXS,3,maxres),Pcalc_(maxSAXS)
10293 double precision dk,dijCACA,dijCASC,dijSCCA,dijSCSC,
10294 & sigma2CACA,sigma2CASC,sigma2SCCA,sigma2SCSC,expCACA,expCASC,
10295 & expSCCA,expSCSC,CASCgrad,SCCAgrad,SCSCgrad,aux,auxC,auxC1,
10296 & auxX,auxX1,CACAgrad,Cnorm
10297 double precision sss2,ssgrad2,rrr,sscalgrad2,sscale2
10298 double precision dist
10300 c SAXS restraint penalty function
10302 write(iout,*) "------- SAXS penalty function start -------"
10303 write (iout,*) "nsaxs",nsaxs
10304 write (iout,*) "Esaxs: iatsc_s",iatsc_s," iatsc_e",iatsc_e
10305 write (iout,*) "Psaxs"
10307 write (iout,'(i5,e15.5)') i, Psaxs(i)
10310 Esaxs_constr = 0.0d0
10315 PgradC(k,l,j)=0.0d0
10316 PgradX(k,l,j)=0.0d0
10320 do i=iatsc_s,iatsc_e
10321 if (itype(i).eq.ntyp1) cycle
10322 do iint=1,nint_gr(i)
10323 do j=istart(i,iint),iend(i,iint)
10324 if (itype(j).eq.ntyp1) cycle
10327 dijCASC=dist(i,j+nres)
10328 dijSCCA=dist(i+nres,j)
10329 dijSCSC=dist(i+nres,j+nres)
10330 sigma2CACA=2.0d0/(pstok**2)
10331 sigma2CASC=4.0d0/(pstok**2+restok(itype(j))**2)
10332 sigma2SCCA=4.0d0/(pstok**2+restok(itype(i))**2)
10333 sigma2SCSC=4.0d0/(restok(itype(j))**2+restok(itype(i))**2)
10336 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
10337 if (itype(j).ne.10) then
10338 expCASC = dexp(-0.5d0*sigma2CASC*(dijCASC-dk)**2)
10342 if (itype(i).ne.10) then
10343 expSCCA = dexp(-0.5d0*sigma2SCCA*(dijSCCA-dk)**2)
10347 if (itype(i).ne.10 .and. itype(j).ne.10) then
10348 expSCSC = dexp(-0.5d0*sigma2SCSC*(dijSCSC-dk)**2)
10352 Pcalc(k) = Pcalc(k)+expCACA+expCASC+expSCCA+expSCSC
10354 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
10356 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
10357 CASCgrad = sigma2CASC*(dijCASC-dk)*expCASC
10358 SCCAgrad = sigma2SCCA*(dijSCCA-dk)*expSCCA
10359 SCSCgrad = sigma2SCSC*(dijSCSC-dk)*expSCSC
10362 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
10363 PgradC(k,l,i) = PgradC(k,l,i)-aux
10364 PgradC(k,l,j) = PgradC(k,l,j)+aux
10366 if (itype(j).ne.10) then
10367 aux = CASCgrad*(C(l,j+nres)-C(l,i))/dijCASC
10368 PgradC(k,l,i) = PgradC(k,l,i)-aux
10369 PgradC(k,l,j) = PgradC(k,l,j)+aux
10370 PgradX(k,l,j) = PgradX(k,l,j)+aux
10373 if (itype(i).ne.10) then
10374 aux = SCCAgrad*(C(l,j)-C(l,i+nres))/dijSCCA
10375 PgradX(k,l,i) = PgradX(k,l,i)-aux
10376 PgradC(k,l,i) = PgradC(k,l,i)-aux
10377 PgradC(k,l,j) = PgradC(k,l,j)+aux
10380 if (itype(i).ne.10 .and. itype(j).ne.10) then
10381 aux = SCSCgrad*(C(l,j+nres)-C(l,i+nres))/dijSCSC
10382 PgradC(k,l,i) = PgradC(k,l,i)-aux
10383 PgradC(k,l,j) = PgradC(k,l,j)+aux
10384 PgradX(k,l,i) = PgradX(k,l,i)-aux
10385 PgradX(k,l,j) = PgradX(k,l,j)+aux
10391 sigma2CACA=scal_rad**2*0.25d0/
10392 & (restok(itype(j))**2+restok(itype(i))**2)
10394 IF (saxs_cutoff.eq.0) THEN
10397 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
10398 Pcalc(k) = Pcalc(k)+expCACA
10399 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
10401 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
10402 PgradC(k,l,i) = PgradC(k,l,i)-aux
10403 PgradC(k,l,j) = PgradC(k,l,j)+aux
10407 rrr = saxs_cutoff*2.0d0/dsqrt(sigma2CACA)
10410 c write (2,*) "ijk",i,j,k
10411 sss2 = sscale2(dijCACA,rrr,dk,0.3d0)
10412 if (sss2.eq.0.0d0) cycle
10413 ssgrad2 = sscalgrad2(dijCACA,rrr,dk,0.3d0)
10414 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)*sss2
10415 Pcalc(k) = Pcalc(k)+expCACA
10417 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
10419 CACAgrad = -sigma2CACA*(dijCACA-dk)*expCACA+
10420 & ssgrad2*expCACA/sss2
10423 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
10424 PgradC(k,l,i) = PgradC(k,l,i)+aux
10425 PgradC(k,l,j) = PgradC(k,l,j)-aux
10434 if (nfgtasks.gt.1) then
10435 call MPI_Reduce(Pcalc(1),Pcalc_(1),nsaxs,MPI_DOUBLE_PRECISION,
10436 & MPI_SUM,king,FG_COMM,IERR)
10437 if (fg_rank.eq.king) then
10439 Pcalc(k) = Pcalc_(k)
10442 call MPI_Reduce(PgradC(k,1,1),PgradC_(k,1,1),3*maxsaxs*nres,
10443 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10444 if (fg_rank.eq.king) then
10448 PgradC(k,l,i) = PgradC_(k,l,i)
10454 call MPI_Reduce(PgradX(k,1,1),PgradX_(k,1,1),3*maxsaxs*nres,
10455 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10456 if (fg_rank.eq.king) then
10460 PgradX(k,l,i) = PgradX_(k,l,i)
10469 if (fg_rank.eq.king) then
10473 Cnorm = Cnorm + Pcalc(k)
10475 Esaxs_constr = dlog(Cnorm)-wsaxs0
10477 if (Pcalc(k).gt.0.0d0)
10478 & Esaxs_constr = Esaxs_constr - Psaxs(k)*dlog(Pcalc(k))
10480 write (iout,*) "k",k," Esaxs_constr",Esaxs_constr
10484 write (iout,*) "Cnorm",Cnorm," Esaxs_constr",Esaxs_constr
10494 & auxC = auxC +Psaxs(k)*PgradC(k,l,i)/Pcalc(k)
10495 auxC1 = auxC1+PgradC(k,l,i)
10497 auxX = auxX +Psaxs(k)*PgradX(k,l,i)/Pcalc(k)
10498 auxX1 = auxX1+PgradX(k,l,i)
10501 gsaxsC(l,i) = auxC - auxC1/Cnorm
10503 gsaxsX(l,i) = auxX - auxX1/Cnorm
10505 c write (iout,*) "l i",l,i," gradC",wsaxs*(auxC - auxC1/Cnorm),
10506 c * " gradX",wsaxs*(auxX - auxX1/Cnorm)
10514 c----------------------------------------------------------------------------
10515 subroutine e_saxsC(Esaxs_constr)
10517 include 'DIMENSIONS'
10518 include 'DIMENSIONS.ZSCOPT'
10519 include 'DIMENSIONS.FREE'
10522 include "COMMON.SETUP"
10525 include 'COMMON.SBRIDGE'
10526 include 'COMMON.CHAIN'
10527 include 'COMMON.GEO'
10528 include 'COMMON.LOCAL'
10529 include 'COMMON.INTERACT'
10530 include 'COMMON.VAR'
10531 include 'COMMON.IOUNITS'
10532 include 'COMMON.DERIV'
10533 include 'COMMON.CONTROL'
10534 include 'COMMON.NAMES'
10535 include 'COMMON.FFIELD'
10536 include 'COMMON.LANGEVIN'
10537 include 'COMMON.SAXS'
10539 double precision Esaxs_constr
10540 integer i,iint,j,k,l
10541 double precision PgradC(3,maxres),PgradX(3,maxres),Pcalc,logPtot
10543 double precision gsaxsc_(3,maxres),gsaxsx_(3,maxres),logPtot_
10545 double precision dk,dijCASPH,dijSCSPH,
10546 & sigma2CA,sigma2SC,expCASPH,expSCSPH,
10547 & CASPHgrad,SCSPHgrad,aux,auxC,auxC1,
10549 c SAXS restraint penalty function
10551 write(iout,*) "------- SAXS penalty function start -------"
10552 write (iout,*) "nsaxs",nsaxs," isaxs_start",isaxs_start,
10553 & " isaxs_end",isaxs_end
10554 write (iout,*) "nnt",nnt," ntc",nct
10556 write(iout,'(a6,i5,3f10.5,5x,2f10.5)')
10557 & "CA",i,(C(j,i),j=1,3),pstok,restok(itype(i))
10560 write(iout,'(a6,i5,3f10.5)')"CSaxs",i,(Csaxs(j,i),j=1,3)
10563 Esaxs_constr = 0.0d0
10565 do j=isaxs_start,isaxs_end
10577 dijCASPH=dijCASPH+(C(l,i)-Csaxs(l,j))**2
10579 if (itype(i).ne.10) then
10581 dijSCSPH=dijSCSPH+(C(l,i+nres)-Csaxs(l,j))**2
10584 sigma2CA=2.0d0/pstok**2
10585 sigma2SC=4.0d0/restok(itype(i))**2
10586 expCASPH = dexp(-0.5d0*sigma2CA*dijCASPH)
10587 expSCSPH = dexp(-0.5d0*sigma2SC*dijSCSPH)
10588 Pcalc = Pcalc+expCASPH+expSCSPH
10590 write(*,*) "processor i j Pcalc",
10591 & MyRank,i,j,dijCASPH,dijSCSPH, Pcalc
10593 CASPHgrad = sigma2CA*expCASPH
10594 SCSPHgrad = sigma2SC*expSCSPH
10596 aux = (C(l,i+nres)-Csaxs(l,j))*SCSPHgrad
10597 PgradX(l,i) = PgradX(l,i) + aux
10598 PgradC(l,i) = PgradC(l,i)+(C(l,i)-Csaxs(l,j))*CASPHgrad+aux
10603 gsaxsc(l,i)=gsaxsc(l,i)+PgradC(l,i)/Pcalc
10604 gsaxsx(l,i)=gsaxsx(l,i)+PgradX(l,i)/Pcalc
10607 logPtot = logPtot - dlog(Pcalc)
10608 c print *,"me",me,MyRank," j",j," logPcalc",-dlog(Pcalc),
10609 c & " logPtot",logPtot
10612 if (nfgtasks.gt.1) then
10613 c write (iout,*) "logPtot before reduction",logPtot
10614 call MPI_Reduce(logPtot,logPtot_,1,MPI_DOUBLE_PRECISION,
10615 & MPI_SUM,king,FG_COMM,IERR)
10617 c write (iout,*) "logPtot after reduction",logPtot
10618 call MPI_Reduce(gsaxsC(1,1),gsaxsC_(1,1),3*nres,
10619 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10620 if (fg_rank.eq.king) then
10623 gsaxsC(l,i) = gsaxsC_(l,i)
10627 call MPI_Reduce(gsaxsX(1,1),gsaxsX_(1,1),3*nres,
10628 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10629 if (fg_rank.eq.king) then
10632 gsaxsX(l,i) = gsaxsX_(l,i)
10638 Esaxs_constr = logPtot