1 subroutine etotal_long(energia)
2 implicit real*8 (a-h,o-z)
5 c Compute the long-range slow-varying contributions to the energy
10 cMS$ATTRIBUTES C :: proc_proc
15 double precision weights_(n_ene)
17 include 'COMMON.SETUP'
18 include 'COMMON.IOUNITS'
19 double precision energia(0:n_ene)
20 include 'COMMON.FFIELD'
21 include 'COMMON.DERIV'
22 include 'COMMON.INTERACT'
23 include 'COMMON.SBRIDGE'
24 include 'COMMON.CHAIN'
26 include 'COMMON.LOCAL'
28 include 'COMMON.CONTROL'
29 c write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot
30 if (modecalc.eq.12.or.modecalc.eq.14) then
32 c if (fg_rank.eq.0) call int_from_cart1(.false.)
34 call int_from_cart1(.false.)
38 c write(iout,*) "ETOTAL_LONG Processor",fg_rank,
39 c & " absolute rank",myrank," nfgtasks",nfgtasks
41 if (nfgtasks.gt.1) then
43 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
44 if (fg_rank.eq.0) then
45 call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR)
46 c write (iout,*) "Processor",myrank," BROADCAST iorder"
48 C FG master sets up the WEIGHTS_ array which will be broadcast to the
49 C FG slaves as WEIGHTS array.
70 C FG Master broadcasts the WEIGHTS_ array
71 call MPI_Bcast(weights_(1),n_ene,
72 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
74 C FG slaves receive the WEIGHTS array
75 call MPI_Bcast(weights(1),n_ene,
76 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
98 call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION,
100 time_Bcast=time_Bcast+MPI_Wtime()-time00
101 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
102 c call chainbuild_cart
103 c call int_from_cart1(.false.)
105 c write (iout,*) 'Processor',myrank,
106 c & ' calling etotal_short ipot=',ipot
108 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
110 cd print *,'nnt=',nnt,' nct=',nct
112 C Compute the side-chain and electrostatic interaction energy
114 goto (101,102,103,104,105,106) ipot
115 C Lennard-Jones potential.
116 101 call elj_long(evdw)
117 cd print '(a)','Exit ELJ'
119 C Lennard-Jones-Kihara potential (shifted).
120 102 call eljk_long(evdw)
122 C Berne-Pechukas potential (dilated LJ, angular dependence).
123 103 call ebp_long(evdw)
125 C Gay-Berne potential (shifted LJ, angular dependence).
126 104 call egb_long(evdw)
128 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
129 105 call egbv_long(evdw)
131 C Soft-sphere potential
132 106 call e_softsphere(evdw)
134 C Calculate electrostatic (H-bonding) energy of the main chain.
138 c write (iout,*) "etotal_long: shield_mode",shield_mode
139 if (shield_mode.eq.1) then
141 else if (shield_mode.eq.2) then
147 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
148 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
149 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
150 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
152 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
153 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
154 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
155 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
157 call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
166 c write (iout,*) "Soft-spheer ELEC potential"
167 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
171 C Calculate excluded-volume interaction energy between peptide groups
176 call escp_long(evdw2,evdw2_14)
182 call escp_soft_sphere(evdw2,evdw2_14)
185 C 12/1/95 Multi-body terms
189 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
190 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
191 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
192 c write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
193 c &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
200 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
201 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
204 C If performing constraint dynamics, call the constraint energy
205 C after the equilibration time
206 if(usampl.and.totT.gt.eq_time) then
209 call Econstr_back_qlike
225 energia(2)=evdw2-evdw2_14
242 energia(8)=eello_turn3
243 energia(9)=eello_turn4
245 energia(20)=Uconst+Uconst_back
246 energia(27)=ehomology_constr
251 call sum_energy(energia,.true.)
252 c write (iout,*) "Exit ETOTAL_LONG"
256 c------------------------------------------------------------------------------
257 subroutine etotal_short(energia)
258 implicit real*8 (a-h,o-z)
261 c Compute the short-range fast-varying contributions to the energy
266 cMS$ATTRIBUTES C :: proc_proc
271 double precision weights_(n_ene)
273 include 'COMMON.SETUP'
274 include 'COMMON.IOUNITS'
275 double precision energia(0:n_ene)
276 include 'COMMON.FFIELD'
277 include 'COMMON.DERIV'
278 include 'COMMON.INTERACT'
279 include 'COMMON.SBRIDGE'
280 include 'COMMON.CHAIN'
282 include 'COMMON.LOCAL'
283 include 'COMMON.CONTROL'
284 include 'COMMON.TORCNSTR'
286 c write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
288 if (modecalc.eq.12.or.modecalc.eq.14) then
290 if (fg_rank.eq.0) call int_from_cart1(.false.)
292 call int_from_cart1(.false.)
302 c write(iout,*) "ETOTAL_SHORT Processor",fg_rank,
303 c & " absolute rank",myrank," nfgtasks",nfgtasks
305 if (nfgtasks.gt.1) then
307 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
308 if (fg_rank.eq.0) then
309 call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR)
310 c write (iout,*) "Processor",myrank," BROADCAST iorder"
312 C FG master sets up the WEIGHTS_ array which will be broadcast to the
313 C FG slaves as WEIGHTS array.
334 weights_(29)=wdfa_tor
335 weights_(30)=wdfa_nei
336 weights_(31)=wdfa_beta
337 C FG Master broadcasts the WEIGHTS_ array
338 call MPI_Bcast(weights_(1),n_ene,
339 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
341 C FG slaves receive the WEIGHTS array
342 call MPI_Bcast(weights(1),n_ene,
343 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
365 c write (iout,*),"Processor",myrank," BROADCAST weights"
366 call MPI_Bcast(c(1,1),maxres6,MPI_DOUBLE_PRECISION,
368 c write (iout,*) "Processor",myrank," BROADCAST c"
369 call MPI_Bcast(dc(1,1),maxres6,MPI_DOUBLE_PRECISION,
371 c write (iout,*) "Processor",myrank," BROADCAST dc"
372 call MPI_Bcast(dc_norm(1,1),maxres6,MPI_DOUBLE_PRECISION,
374 c write (iout,*) "Processor",myrank," BROADCAST dc_norm"
375 call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION,
377 c write (iout,*) "Processor",myrank," BROADCAST theta"
378 call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION,
380 c write (iout,*) "Processor",myrank," BROADCAST phi"
381 call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION,
383 c write (iout,*) "Processor",myrank," BROADCAST alph"
384 call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION,
386 c write (iout,*) "Processor",myrank," BROADCAST omeg"
387 call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION,
389 c write (iout,*) "Processor",myrank," BROADCAST vbld"
390 call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION,
392 time_Bcast=time_Bcast+MPI_Wtime()-time00
393 c write (iout,*) "Processor",myrank," BROADCAST vbld_inv"
395 c write (iout,*) 'Processor',myrank,
396 c & ' calling etotal_short ipot=',ipot
398 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
400 c call int_from_cart1(.false.)
402 C Compute the side-chain and electrostatic interaction energy
404 goto (101,102,103,104,105,106) ipot
405 C Lennard-Jones potential.
406 101 call elj_short(evdw)
407 cd print '(a)','Exit ELJ'
409 C Lennard-Jones-Kihara potential (shifted).
410 102 call eljk_short(evdw)
412 C Berne-Pechukas potential (dilated LJ, angular dependence).
413 103 call ebp_short(evdw)
415 C Gay-Berne potential (shifted LJ, angular dependence).
416 104 call egb_short(evdw)
418 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
419 105 call egbv_short(evdw)
421 C Soft-sphere potential - already dealt with in the long-range part
423 c 106 call e_softsphere_short(evdw)
425 C Calculate electrostatic (H-bonding) energy of the main chain.
429 c Calculate the short-range part of Evdwpp
431 call evdwpp_short(evdw1)
433 c Calculate the short-range part of ESCp
436 call escp_short(evdw2,evdw2_14)
439 c Calculate the bond-stretching energy
443 C Calculate the disulfide-bridge and other energy and the contributions
444 C from other distance constraints.
447 C Calculate the virtual-bond-angle energy.
449 if (wang.gt.0d0) then
450 if (tor_mode.eq.0) then
453 C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
461 if (with_theta_constr) call etheta_constr(ethetacnstr)
463 C Calculate the SC local energy.
468 C Calculate the virtual-bond torsional energy.
470 if (wtor.gt.0.0d0) then
471 if (tor_mode.eq.0) then
474 C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
482 if (ndih_constr.gt.0) call etor_constr(edihcnstr)
483 c print *,"Processor",myrank," computed Utor"
485 C 6/23/01 Calculate double-torsional energy
487 if ((wtor_d.gt.0.0d0).and.(tor_mode.eq.0)) then
493 c Homology restraints
495 if (constr_homology.ge.1) then
496 call e_modeller(ehomology_constr)
498 ehomology_constr=0.0d0
501 C BARTEK for dfa test!
502 if (wdfa_dist.gt.0) then
507 c print*, 'edfad is finished!', edfadis
508 if (wdfa_tor.gt.0) then
513 c print*, 'edfat is finished!', edfator
514 if (wdfa_nei.gt.0) then
519 c print*, 'edfan is finished!', edfanei
520 if (wdfa_beta.gt.0) then
525 c print*, 'edfab is finished!', edfabet
528 C 21/5/07 Calculate local sicdechain correlation energy
530 if (wsccor.gt.0.0d0) then
531 call eback_sc_corr(esccor)
535 c write (iout,*) "nsaxs",nsaxs," saxs_mode",saxs_mode
536 if (nsaxs.gt.0 .and. saxs_mode.eq.0) then
537 call e_saxs(Esaxs_constr)
538 c write (iout,*) "From Esaxs: Esaxs_constr",Esaxs_constr
539 else if (nsaxs.gt.0 .and. saxs_mode.gt.0) then
540 call e_saxsC(Esaxs_constr)
541 c write (iout,*) "From EsaxsC: Esaxs_constr",Esaxs_constr
546 C Put energy components into an array
553 energia(2)=evdw2-evdw2_14
570 energia(8)=eello_turn3
571 energia(9)=eello_turn4
579 energia(19)=edihcnstr
582 energia(24)=ethetacnstr
584 energia(26)=Esaxs_constr
585 energia(27)=ehomology_constr
590 c write (iout,*) "ETOTAL_SHORT before SUM_ENERGY"
592 call sum_energy(energia,.true.)
593 c write (iout,*) "Exit ETOTAL_SHORT"