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 include 'COMMON.SHIELD'
30 c write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot
31 if (modecalc.eq.12.or.modecalc.eq.14) then
33 c if (fg_rank.eq.0) call int_from_cart1(.false.)
35 call int_from_cart1(.false.)
39 c write(iout,*) "ETOTAL_LONG Processor",fg_rank,
40 c & " absolute rank",myrank," nfgtasks",nfgtasks
42 if (nfgtasks.gt.1) then
44 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
45 if (fg_rank.eq.0) then
46 call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR)
47 c write (iout,*) "Processor",myrank," BROADCAST iorder"
49 C FG master sets up the WEIGHTS_ array which will be broadcast to the
50 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)
97 call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION,
99 time_Bcast=time_Bcast+MPI_Wtime()-time00
100 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
101 c call chainbuild_cart
102 c call int_from_cart1(.false.)
104 c write (iout,*) 'Processor',myrank,
105 c & ' calling etotal_short ipot=',ipot
107 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
109 cd print *,'nnt=',nnt,' nct=',nct
111 C Compute the side-chain and electrostatic interaction energy
113 goto (101,102,103,104,105,106) ipot
114 C Lennard-Jones potential.
115 101 call elj_long(evdw)
116 cd print '(a)','Exit ELJ'
118 C Lennard-Jones-Kihara potential (shifted).
119 102 call eljk_long(evdw)
121 C Berne-Pechukas potential (dilated LJ, angular dependence).
122 103 call ebp_long(evdw)
124 C Gay-Berne potential (shifted LJ, angular dependence).
125 104 call egb_long(evdw)
127 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
128 105 call egbv_long(evdw)
130 C Soft-sphere potential
131 106 call e_softsphere(evdw)
133 C Calculate electrostatic (H-bonding) energy of the main chain.
137 if (shield_mode.eq.1) then
139 else if (shield_mode.eq.2) then
141 if (nfgtasks.gt.1) then
144 write(iout,*) "befor reduce fac_shield reduce"
146 write(2,*) "fac",itype(i),fac_shield(i),grad_shield(1,i)
147 write(2,*) "list", shield_list(1,i),ishield_list(i),
148 & grad_shield_side(1,1,i),grad_shield_loc(1,1,i)
151 call MPI_Allgatherv(fac_shield(ivec_start),ivec_count(fg_rank1),
152 & MPI_DOUBLE_PRECISION,fac_shield(1),ivec_count(0),ivec_displ(0),
153 & MPI_DOUBLE_PRECISION,FG_COMM,IERR)
154 call MPI_Allgatherv(shield_list(1,ivec_start),
155 & ivec_count(fg_rank1),
156 & MPI_I50,shield_list(1,1),ivec_count(0),
158 & MPI_I50,FG_COMM,IERR)
159 call MPI_Allgatherv(ishield_list(ivec_start),
160 & ivec_count(fg_rank1),
161 & MPI_INTEGER,ishield_list(1),ivec_count(0),
163 & MPI_INTEGER,FG_COMM,IERR)
164 call MPI_Allgatherv(grad_shield(1,ivec_start),
165 & ivec_count(fg_rank1),
166 & MPI_UYZ,grad_shield(1,1),ivec_count(0),
168 & MPI_UYZ,FG_COMM,IERR)
169 call MPI_Allgatherv(grad_shield_side(1,1,ivec_start),
170 & ivec_count(fg_rank1),
171 & MPI_SHI,grad_shield_side(1,1,1),ivec_count(0),
173 & MPI_SHI,FG_COMM,IERR)
174 call MPI_Allgatherv(grad_shield_loc(1,1,ivec_start),
175 & ivec_count(fg_rank1),
176 & MPI_SHI,grad_shield_loc(1,1,1),ivec_count(0),
178 & MPI_SHI,FG_COMM,IERR)
180 write(iout,*) "after reduce fac_shield reduce"
182 write(2,*) "fac",itype(i),fac_shield(i),grad_shield(1,i)
183 write(2,*) "list", shield_list(1,i),ishield_list(i),
184 & grad_shield_side(1,1,i),grad_shield_loc(1,1,i)
193 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
194 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
195 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
196 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
198 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
199 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
200 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
201 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
203 call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
212 c write (iout,*) "Soft-spheer ELEC potential"
213 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
217 C Calculate excluded-volume interaction energy between peptide groups
222 call escp_long(evdw2,evdw2_14)
228 call escp_soft_sphere(evdw2,evdw2_14)
231 C 12/1/95 Multi-body terms
235 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
236 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
237 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
238 c write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
239 c &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
246 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
247 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
250 C if (wliptran.gt.0) then
251 C call Eliptransfer(eliptran)
255 C If performing constraint dynamics, call the constraint energy
256 C after the equilibration time
257 if(usampl.and.totT.gt.eq_time) then
272 energia(2)=evdw2-evdw2_14
289 energia(8)=eello_turn3
290 energia(9)=eello_turn4
292 energia(20)=Uconst+Uconst_back
293 call sum_energy(energia,.true.)
295 C write (iout,*) "Exit ETOTAL_LONG"
299 c------------------------------------------------------------------------------
300 subroutine etotal_short(energia)
301 implicit real*8 (a-h,o-z)
304 c Compute the short-range fast-varying contributions to the energy
309 cMS$ATTRIBUTES C :: proc_proc
314 double precision weights_(n_ene)
316 include 'COMMON.SETUP'
317 include 'COMMON.IOUNITS'
318 double precision energia(0:n_ene)
319 include 'COMMON.FFIELD'
320 include 'COMMON.DERIV'
321 include 'COMMON.INTERACT'
322 include 'COMMON.SBRIDGE'
323 include 'COMMON.CHAIN'
325 include 'COMMON.LOCAL'
326 include 'COMMON.CONTROL'
327 include 'COMMON.SHIELD'
328 c write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
330 if (modecalc.eq.12.or.modecalc.eq.14) then
332 if (fg_rank.eq.0) call int_from_cart1(.false.)
334 call int_from_cart1(.false.)
338 c write(iout,*) "ETOTAL_SHORT Processor",fg_rank,
339 c & " absolute rank",myrank," nfgtasks",nfgtasks
341 if (nfgtasks.gt.1) then
343 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
344 if (fg_rank.eq.0) then
345 call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR)
346 c write (iout,*) "Processor",myrank," BROADCAST iorder"
348 C FG master sets up the WEIGHTS_ array which will be broadcast to the
349 C FG slaves as WEIGHTS array.
369 C FG Master broadcasts the WEIGHTS_ array
370 call MPI_Bcast(weights_(1),n_ene,
371 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
373 C FG slaves receive the WEIGHTS array
374 call MPI_Bcast(weights(1),n_ene,
375 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
396 c write (iout,*),"Processor",myrank," BROADCAST weights"
397 call MPI_Bcast(c(1,1),maxres6,MPI_DOUBLE_PRECISION,
399 c write (iout,*) "Processor",myrank," BROADCAST c"
400 call MPI_Bcast(dc(1,1),maxres6,MPI_DOUBLE_PRECISION,
402 c write (iout,*) "Processor",myrank," BROADCAST dc"
403 call MPI_Bcast(dc_norm(1,1),maxres6,MPI_DOUBLE_PRECISION,
405 c write (iout,*) "Processor",myrank," BROADCAST dc_norm"
406 call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION,
408 c write (iout,*) "Processor",myrank," BROADCAST theta"
409 call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION,
411 c write (iout,*) "Processor",myrank," BROADCAST phi"
412 call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION,
414 c write (iout,*) "Processor",myrank," BROADCAST alph"
415 call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION,
417 c write (iout,*) "Processor",myrank," BROADCAST omeg"
418 call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION,
420 c write (iout,*) "Processor",myrank," BROADCAST vbld"
421 call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION,
423 time_Bcast=time_Bcast+MPI_Wtime()-time00
424 c write (iout,*) "Processor",myrank," BROADCAST vbld_inv"
426 c write (iout,*) 'Processor',myrank,
427 c & ' calling etotal_short ipot=',ipot
429 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
431 c call int_from_cart1(.false.)
433 C Compute the side-chain and electrostatic interaction energy
435 goto (101,102,103,104,105,106) ipot
436 C Lennard-Jones potential.
437 101 call elj_short(evdw)
438 cd print '(a)','Exit ELJ'
440 C Lennard-Jones-Kihara potential (shifted).
441 102 call eljk_short(evdw)
443 C Berne-Pechukas potential (dilated LJ, angular dependence).
444 103 call ebp_short(evdw)
446 C Gay-Berne potential (shifted LJ, angular dependence).
447 104 call egb_short(evdw)
449 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
450 105 call egbv_short(evdw)
452 C Soft-sphere potential - already dealt with in the long-range part
454 c 106 call e_softsphere_short(evdw)
456 C Calculate electrostatic (H-bonding) energy of the main chain.
460 C if (shield_mode.eq.1) then
461 C call set_shield_fac
462 C else if (shield_mode.eq.2) then
463 C call set_shield_fac2
464 C if (nfgtasks.gt.1) then
467 C write(iout,*) "befor reduce fac_shield reduce"
469 C write(2,*) "fac",itype(i),fac_shield(i),grad_shield(1,i)
470 C write(2,*) "list", shield_list(1,i),ishield_list(i),
471 C & grad_shield_side(1,1,i),grad_shield_loc(1,1,i)
474 C call MPI_Allgatherv(fac_shield(ivec_start),ivec_count(fg_rank1),
475 C & MPI_DOUBLE_PRECISION,fac_shield(1),ivec_count(0),ivec_displ(0),
476 C & MPI_DOUBLE_PRECISION,FG_COMM,IERR)
477 C call MPI_Allgatherv(shield_list(1,ivec_start),
478 C & ivec_count(fg_rank1),
479 C & MPI_I50,shield_list(1,1),ivec_count(0),
481 C & MPI_I50,FG_COMM,IERR)
482 C call MPI_Allgatherv(ishield_list(ivec_start),
483 C & ivec_count(fg_rank1),
484 C & MPI_INTEGER,ishield_list(1),ivec_count(0),
486 C & MPI_INTEGER,FG_COMM,IERR)
487 C call MPI_Allgatherv(grad_shield(1,ivec_start),
488 C & ivec_count(fg_rank1),
489 C & MPI_UYZ,grad_shield(1,1),ivec_count(0),
491 C & MPI_UYZ,FG_COMM,IERR)
492 C call MPI_Allgatherv(grad_shield_side(1,1,ivec_start),
493 C & ivec_count(fg_rank1),
494 C & MPI_SHI,grad_shield_side(1,1,1),ivec_count(0),
496 C & MPI_SHI,FG_COMM,IERR)
497 C call MPI_Allgatherv(grad_shield_loc(1,1,ivec_start),
498 C & ivec_count(fg_rank1),
499 C & MPI_SHI,grad_shield_loc(1,1,1),ivec_count(0),
501 C & MPI_SHI,FG_COMM,IERR)
503 C write(iout,*) "after reduce fac_shield reduce"
505 C write(2,*) "fac",itype(i),fac_shield(i),grad_shield(1,i)
506 C write(2,*) "list", shield_list(1,i),ishield_list(i),
507 C & grad_shield_side(1,1,i),grad_shield_loc(1,1,i)
514 C if (ipot.lt.6) then
516 C if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
517 C & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
518 C & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
519 C & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
521 C if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
522 C & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
523 C & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
524 C & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
526 C call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
535 c write (iout,*) "Soft-spheer ELEC potential"
536 C call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
541 c Calculate the short-range part of Evdwpp
543 call evdwpp_short(evdw1)
545 c Calculate the short-range part of ESCp
548 call escp_short(evdw2,evdw2_14)
551 c Calculate the bond-stretching energy
555 C Calculate the disulfide-bridge and other energy and the contributions
556 C from other distance constraints.
559 C Calculate the virtual-bond-angle energy.
561 call ebend(ebe,ethetcnstr)
563 C Calculate the SC local energy.
568 C Calculate the virtual-bond torsional energy.
570 call etor(etors,edihcnstr)
572 C 6/23/01 Calculate double-torsional energy
576 C 21/5/07 Calculate local sicdechain correlation energy
578 if (wsccor.gt.0.0d0) then
579 call eback_sc_corr(esccor)
583 if (wliptran.gt.0) then
584 call Eliptransfer(eliptran)
588 C print *,eliptran,wliptran
590 C Put energy components into an array
597 energia(2)=evdw2-evdw2_14
614 energia(8)=eello_turn3
615 energia(9)=eello_turn4
623 energia(19)=edihcnstr
626 C write (iout,*) "ETOTAL_SHORT before SUM_ENERGY"
628 call sum_energy(energia,.true.)
629 C write (iout,*) "Exit ETOTAL_SHORT"