subroutine etotal_long(energia) implicit none include 'DIMENSIONS' c c Compute the long-range slow-varying contributions to the energy c #ifndef ISNAN external proc_proc #ifdef WINPGI cMS$ATTRIBUTES C :: proc_proc #endif #endif #ifdef MPI include "mpif.h" double precision weights_(n_ene) double precision time00 integer ierror,ierr #endif include 'COMMON.SETUP' include 'COMMON.IOUNITS' double precision energia(0:n_ene) include 'COMMON.FFIELD' include 'COMMON.DERIV' include 'COMMON.INTERACT' include 'COMMON.SBRIDGE' include 'COMMON.CHAIN' include 'COMMON.VAR' include 'COMMON.LOCAL' include 'COMMON.QRESTR' include 'COMMON.MD' include 'COMMON.CONTROL' include 'COMMON.TIME1' double precision evdw,evdw1,evdw2,evdw2_14,ees,eel_loc, & eello_turn3,eello_turn4,edfadis,estr,ehpb,ebe,ethetacnstr, & escloc,etors,edihcnstr,etors_d,esccor,ecorr,ecorr5,ecorr6,eturn6, & eliptran,Eafmforce,Etube, & esaxs_constr,ehomology_constr,edfator,edfanei,edfabet integer i,n_corr,n_corr1 c write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot #ifdef TIMING_ENE double precision time01 #endif if (modecalc.eq.12.or.modecalc.eq.14) then #ifdef MPI c if (fg_rank.eq.0) call int_from_cart1(.false.) #else call int_from_cart1(.false.) #endif endif #ifdef MPI edfadis=0.0d0 edfator=0.0d0 edfanei=0.0d0 edfabet=0.0d0 ehomology_constr=0.0d0 Uconst=0.0d0 Uconst_back=0.0d0 c write(iout,*) "ETOTAL_LONG Processor",fg_rank, c & " absolute rank",myrank," nfgtasks",nfgtasks c call flush(iout) if (nfgtasks.gt.1) then time00=MPI_Wtime() C FG slaves call the following matching MPI_Bcast in ERGASTULUM if (fg_rank.eq.0) then call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR) c write (iout,*) "Processor",myrank," BROADCAST iorder" c call flush(iout) C FG master sets up the WEIGHTS_ array which will be broadcast to the C FG slaves as WEIGHTS array. weights_(1)=wsc weights_(2)=wscp weights_(3)=welec weights_(4)=wcorr weights_(5)=wcorr5 weights_(6)=wcorr6 weights_(7)=wel_loc weights_(8)=wturn3 weights_(9)=wturn4 weights_(10)=wturn6 weights_(11)=wang weights_(12)=wscloc weights_(13)=wtor weights_(14)=wtor_d weights_(15)=wstrain weights_(16)=wvdwpp weights_(17)=wbond weights_(18)=scal14 weights_(21)=wsccor weights_(22)=wliptran weights_(25)=wtube weights_(26)=wsaxs weights_(28)=wdfa_dist weights_(29)=wdfa_tor weights_(30)=wdfa_nei weights_(31)=wdfa_beta C FG Master broadcasts the WEIGHTS_ array call MPI_Bcast(weights_(1),n_ene, & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) else C FG slaves receive the WEIGHTS array call MPI_Bcast(weights(1),n_ene, & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) wsc=weights(1) wscp=weights(2) welec=weights(3) wcorr=weights(4) wcorr5=weights(5) wcorr6=weights(6) wel_loc=weights(7) wturn3=weights(8) wturn4=weights(9) wturn6=weights(10) wang=weights(11) wscloc=weights(12) wtor=weights(13) wtor_d=weights(14) wstrain=weights(15) wvdwpp=weights(16) wbond=weights(17) scal14=weights(18) wsccor=weights(21) wliptran=weights(22) wtube=weights(25) wsaxs=weights(26) wdfa_dist=weights(28) wdfa_tor=weights(29) wdfa_nei=weights(30) wdfa_beta=weights(31) endif call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION, & king,FG_COMM,IERR) time_Bcast=time_Bcast+MPI_Wtime()-time00 time_Bcastw=time_Bcastw+MPI_Wtime()-time00 c call chainbuild_cart c call int_from_cart1(.false.) endif c write (iout,*) 'Processor',myrank, c & ' calling etotal_short ipot=',ipot c call flush(iout) c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct if (nfgtasks.gt.1) then call MPI_Bcast(itime_mat,1,MPI_INT,king,FG_COMM,IERROR) endif if (mod(itime_mat,imatupdate).eq.0) then #ifdef TIMING_ENE time01=MPI_Wtime() #endif call make_SCp_inter_list_RESPA call make_SCSC_inter_list_RESPA call make_pp_inter_list call make_pp_vdw_inter_list_RESPA #ifdef TIMING_ENE time_list=time_list+MPI_Wtime()-time01 #endif endif #endif cd print *,'nnt=',nnt,' nct=',nct C C Compute the side-chain and electrostatic interaction energy C #ifdef TIMING_ENE time01=MPI_Wtime() #endif goto (101,102,103,104,105,106) ipot C Lennard-Jones potential. 101 call elj_long(evdw) cd print '(a)','Exit ELJ' goto 107 C Lennard-Jones-Kihara potential (shifted). 102 call eljk_long(evdw) goto 107 C Berne-Pechukas potential (dilated LJ, angular dependence). 103 call ebp_long(evdw) goto 107 C Gay-Berne potential (shifted LJ, angular dependence). 104 call egb_long(evdw) goto 107 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence). 105 call egbv_long(evdw) goto 107 C Soft-sphere potential 106 call e_softsphere(evdw) C C Calculate electrostatic (H-bonding) energy of the main chain. C 107 continue #ifdef TIMING_ENE time_evdw_long=time_evdw_long+MPI_Wtime()-time01 #endif #ifdef TIMING time01=MPI_Wtime() #endif call vec_and_deriv #ifdef TIMING time_vec=time_vec+MPI_Wtime()-time01 #endif c write (iout,*) "etotal_long: shield_mode",shield_mode #ifdef TIMING_ENE time01=MPI_Wtime() #endif if (shield_mode.eq.1) then call set_shield_fac else if (shield_mode.eq.2) then call set_shield_fac2 endif if (ipot.lt.6) then #ifdef SPLITELE if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then #else if (welec.gt.0d0.or.wel_loc.gt.0d0.or. & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then #endif call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4) else ees=0 evdw1=0 eel_loc=0 eello_turn3=0 eello_turn4=0 endif else c write (iout,*) "Soft-spheer ELEC potential" call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3, & eello_turn4) endif #ifdef TIMING_ENE time_eelec_long=time_eelec_long+MPI_Wtime()-time01 #endif C C Calculate excluded-volume interaction energy between peptide groups C and side chains. C #ifdef TIMING_ENE time01=MPI_Wtime() #endif if (ipot.lt.6) then if(wscp.gt.0d0) then call escp_long(evdw2,evdw2_14) else evdw2=0 evdw2_14=0 endif else call escp_soft_sphere(evdw2,evdw2_14) endif #ifdef TIMING_ENE time_escp_long=time_escp_long+MPI_Wtime()-time01 #endif #ifdef FOURBODY C C 12/1/95 Multi-body terms C n_corr=0 n_corr1=0 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1) c write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1, c &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6 else ecorr=0.0d0 ecorr5=0.0d0 ecorr6=0.0d0 eturn6=0.0d0 endif if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) else ecorr=0.0d0 ecorr5=0.0d0 ecorr6=0.0d0 eturn6=0.0d0 endif #else ecorr=0.0d0 ecorr5=0.0d0 ecorr6=0.0d0 eturn6=0.0d0 #endif C C If performing constraint dynamics, call the constraint energy C after the equilibration time if(usampl.and.totT.gt.eq_time) then call EconstrQ if (loc_qlike) then call Econstr_back_qlike else call Econstr_back endif else Uconst=0.0d0 Uconst_back=0.0d0 endif C C Sum the energies C do i=1,n_ene energia(i)=0.0d0 enddo energia(1)=evdw #ifdef SCP14 energia(2)=evdw2-evdw2_14 energia(18)=evdw2_14 #else energia(2)=evdw2 energia(18)=0.0d0 #endif #ifdef SPLITELE energia(3)=ees energia(16)=evdw1 #else energia(3)=ees+evdw1 energia(16)=0.0d0 #endif energia(4)=ecorr energia(5)=ecorr5 energia(6)=ecorr6 energia(7)=eel_loc energia(8)=eello_turn3 energia(9)=eello_turn4 energia(10)=eturn6 energia(20)=Uconst+Uconst_back energia(27)=ehomology_constr energia(28)=edfadis energia(29)=edfator energia(30)=edfanei energia(31)=edfabet call sum_energy(energia,.true.) c write (iout,*) "Exit ETOTAL_LONG" c call flush(iout) return end c------------------------------------------------------------------------------ subroutine etotal_short(energia) implicit real*8 (a-h,o-z) include 'DIMENSIONS' c c Compute the short-range fast-varying contributions to the energy c #ifndef ISNAN external proc_proc #ifdef WINPGI cMS$ATTRIBUTES C :: proc_proc #endif #endif #ifdef MPI include "mpif.h" double precision weights_(n_ene) double precision time00 integer ierror,ierr #endif include 'COMMON.SETUP' include 'COMMON.IOUNITS' double precision energia(0:n_ene) include 'COMMON.FFIELD' include 'COMMON.DERIV' include 'COMMON.INTERACT' include 'COMMON.SBRIDGE' include 'COMMON.CHAIN' include 'COMMON.VAR' include 'COMMON.LOCAL' include 'COMMON.CONTROL' include 'COMMON.SAXS' include 'COMMON.TORCNSTR' include 'COMMON.TIME1' double precision evdw,evdw1,evdw2,evdw2_14,ees,eel_loc, & eello_turn3,eello_turn4,edfadis,estr,ehpb,ebe,ethetacnstr, & escloc,etors,edihcnstr,etors_d,esccor,ecorr,ecorr5,ecorr6,eturn6, & eliptran,Eafmforce,Etube, & esaxs_constr,ehomology_constr,edfator,edfanei,edfabet integer i,n_corr,n_corr1 #ifdef TIMING_ENE double precision time01 #endif c write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot c call flush(iout) if (modecalc.eq.12.or.modecalc.eq.14) then #ifdef MPI if (fg_rank.eq.0) call int_from_cart1(.false.) #else call int_from_cart1(.false.) #endif endif #ifdef MPI #ifndef DFA edfadis=0.0d0 edfator=0.0d0 edfanei=0.0d0 edfabet=0.0d0 #endif evdw=0.0d0 ees=0.0d0 evdw1=0.0d0 eel_loc=0.0d0 eello_turn3=0.0d0 eello_turn4=0.0d0 evdw2=0 evdw2_14=0 ecorr=0.0d0 ecorr5=0.0d0 ecorr6=0.0d0 eturn6=0.0d0 c write(iout,*) "ETOTAL_SHORT Processor",fg_rank, c & " absolute rank",myrank," nfgtasks",nfgtasks c call flush(iout) if (nfgtasks.gt.1) then time00=MPI_Wtime() C FG slaves call the following matching MPI_Bcast in ERGASTULUM if (fg_rank.eq.0) then call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR) c write (iout,*) "Processor",myrank," BROADCAST iorder" c call flush(iout) C FG master sets up the WEIGHTS_ array which will be broadcast to the C FG slaves as WEIGHTS array. weights_(1)=wsc weights_(2)=wscp weights_(3)=welec weights_(4)=wcorr weights_(5)=wcorr5 weights_(6)=wcorr6 weights_(7)=wel_loc weights_(8)=wturn3 weights_(9)=wturn4 weights_(10)=wturn6 weights_(11)=wang weights_(12)=wscloc weights_(13)=wtor weights_(14)=wtor_d weights_(15)=wstrain weights_(16)=wvdwpp weights_(17)=wbond weights_(18)=scal14 weights_(21)=wsccor weights_(26)=wsaxs weights_(29)=wdfa_tor weights_(30)=wdfa_nei weights_(31)=wdfa_beta C FG Master broadcasts the WEIGHTS_ array call MPI_Bcast(weights_(1),n_ene, & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) else C FG slaves receive the WEIGHTS array call MPI_Bcast(weights(1),n_ene, & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) wsc=weights(1) wscp=weights(2) welec=weights(3) wcorr=weights(4) wcorr5=weights(5) wcorr6=weights(6) wel_loc=weights(7) wturn3=weights(8) wturn4=weights(9) wturn6=weights(10) wang=weights(11) wscloc=weights(12) wtor=weights(13) wtor_d=weights(14) wstrain=weights(15) wvdwpp=weights(16) wbond=weights(17) scal14=weights(18) wsccor=weights(21) wsaxs=weights(26) endif c write (iout,*),"Processor",myrank," BROADCAST weights" call MPI_Bcast(c(1,1),6*nres,MPI_DOUBLE_PRECISION, & king,FG_COMM,IERR) c write (iout,*) "Processor",myrank," BROADCAST c" call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION, & king,FG_COMM,IERR) c write (iout,*) "Processor",myrank," BROADCAST dc" call MPI_Bcast(dc_norm(1,1),6*nres,MPI_DOUBLE_PRECISION, & king,FG_COMM,IERR) c write (iout,*) "Processor",myrank," BROADCAST dc_norm" call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION, & king,FG_COMM,IERR) c write (iout,*) "Processor",myrank," BROADCAST theta" call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION, & king,FG_COMM,IERR) c write (iout,*) "Processor",myrank," BROADCAST phi" call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION, & king,FG_COMM,IERR) c write (iout,*) "Processor",myrank," BROADCAST alph" call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION, & king,FG_COMM,IERR) c write (iout,*) "Processor",myrank," BROADCAST omeg" call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION, & king,FG_COMM,IERR) c write (iout,*) "Processor",myrank," BROADCAST vbld" call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION, & king,FG_COMM,IERR) time_Bcast=time_Bcast+MPI_Wtime()-time00 c write (iout,*) "Processor",myrank," BROADCAST vbld_inv" endif c write (iout,*) 'Processor',myrank, c & ' calling etotal_short ipot=',ipot c call flush(iout) c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct #endif c call int_from_cart1(.false.) C C Compute the side-chain and electrostatic interaction energy C #ifdef TIMING_ENE time01=MPI_Wtime() #endif goto (101,102,103,104,105,106) ipot C Lennard-Jones potential. 101 call elj_short(evdw) cd print '(a)','Exit ELJ' goto 107 C Lennard-Jones-Kihara potential (shifted). 102 call eljk_short(evdw) goto 107 C Berne-Pechukas potential (dilated LJ, angular dependence). 103 call ebp_short(evdw) goto 107 C Gay-Berne potential (shifted LJ, angular dependence). 104 call egb_short(evdw) goto 107 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence). 105 call egbv_short(evdw) goto 107 C Soft-sphere potential - already dealt with in the long-range part 106 evdw=0.0d0 c 106 call e_softsphere_short(evdw) C C Calculate electrostatic (H-bonding) energy of the main chain. C 107 continue #ifdef TIMING_ENE time_evdw_short=time_evdw_short+MPI_Wtime()-time01 #endif c c Calculate the short-range part of Evdwpp c #ifdef TIMING_ENE time01=MPI_Wtime() #endif call evdwpp_short(evdw1) #ifdef TIMING_ENE time_eelec_short=time_eelec_short+MPI_Wtime()-time01 #endif c c Calculate the short-range part of ESCp c #ifdef TIMING_ENE time01=MPI_Wtime() #endif if (ipot.lt.6) then call escp_short(evdw2,evdw2_14) endif #ifdef TIMING_ENE time_escp_short=time_escp_short+MPI_Wtime()-time01 #endif c c Calculate the bond-stretching energy c call ebond(estr) C C Calculate the disulfide-bridge and other energy and the contributions C from other distance constraints. call edis(ehpb) C C Calculate the virtual-bond-angle energy. C if (wang.gt.0d0) then if (tor_mode.eq.0) then call ebend(ebe) else C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the C energy function call ebend_kcc(ebe) endif else ebe=0.0d0 endif ethetacnstr=0.0d0 if (with_theta_constr) call etheta_constr(ethetacnstr) C C Calculate the SC local energy. C #ifdef TIMING time01=MPI_Wtime() #endif call vec_and_deriv #ifdef TIMING time_vec=time_vec+MPI_Wtime()-time01 #endif call esc(escloc) C C Calculate the virtual-bond torsional energy. C if (wtor.gt.0.0d0) then if (tor_mode.eq.0) then call etor(etors) else C etor kcc is Kubo cumulant clustered rigorous attemp to derive the C energy function call etor_kcc(etors) endif else etors=0.0d0 endif edihcnstr=0.0d0 c Lipid transfer if (wliptran.gt.0) then call Eliptransfer(eliptran) else eliptran=0.0d0 endif if (AFMlog.gt.0) then call AFMforce(Eafmforce) else if (selfguide.gt.0) then call AFMvel(Eafmforce) else Eafmforce=0.0d0 endif if (TUBElog.eq.1) then C print *,"just before call" call calctube(Etube) elseif (TUBElog.eq.2) then call calctube2(Etube) else Etube=0.0d0 endif if (ndih_constr.gt.0) call etor_constr(edihcnstr) c print *,"Processor",myrank," computed Utor" C C 6/23/01 Calculate double-torsional energy C if ((wtor_d.gt.0.0d0).and.(tor_mode.eq.0)) then call etor_d(etors_d) else etors_d=0 endif c c Homology restraints c if (constr_homology.ge.1) then call e_modeller(ehomology_constr) else ehomology_constr=0.0d0 endif #ifdef DFA C BARTEK for dfa test! if (wdfa_dist.gt.0) then call edfad(edfadis) else edfadis=0.0 endif c print*, 'edfad is finished!', edfadis if (wdfa_tor.gt.0) then call edfat(edfator) else edfator=0.0 endif c print*, 'edfat is finished!', edfator if (wdfa_nei.gt.0) then call edfan(edfanei) else edfanei=0.0 endif c print*, 'edfan is finished!', edfanei if (wdfa_beta.gt.0) then call edfab(edfabet) else edfabet=0.0 endif c print*, 'edfab is finished!', edfabet #endif C C 21/5/07 Calculate local sicdechain correlation energy C if (wsccor.gt.0.0d0) then call eback_sc_corr(esccor) else esccor=0.0d0 endif c write (iout,*) "nsaxs",nsaxs," saxs_mode",saxs_mode if (nsaxs.gt.0 .and. saxs_mode.eq.0) then call e_saxs(Esaxs_constr) c write (iout,*) "From Esaxs: Esaxs_constr",Esaxs_constr else if (nsaxs.gt.0 .and. saxs_mode.gt.0) then call e_saxsC(Esaxs_constr) c write (iout,*) "From EsaxsC: Esaxs_constr",Esaxs_constr else Esaxs_constr = 0.0d0 endif C C Put energy components into an array C do i=1,n_ene energia(i)=0.0d0 enddo energia(1)=evdw #ifdef SCP14 energia(2)=evdw2-evdw2_14 energia(18)=evdw2_14 #else energia(2)=evdw2 energia(18)=0.0d0 #endif #ifdef SPLITELE energia(3)=ees energia(16)=evdw1 #else energia(3)=ees+evdw1 energia(16)=0.0d0 #endif energia(4)=ecorr energia(5)=ecorr5 energia(6)=ecorr6 energia(7)=eel_loc energia(8)=eello_turn3 energia(9)=eello_turn4 energia(10)=eturn6 energia(11)=ebe energia(12)=escloc energia(13)=etors energia(14)=etors_d energia(15)=ehpb energia(17)=estr energia(19)=edihcnstr energia(21)=esccor energia(22)=eliptran energia(24)=ethetacnstr energia(25)=Etube energia(26)=Esaxs_constr energia(27)=ehomology_constr energia(28)=edfadis energia(29)=edfator energia(30)=edfanei energia(31)=edfabet c write (iout,*) "ETOTAL_SHORT before SUM_ENERGY" c call flush(iout) call sum_energy(energia,.true.) c write (iout,*) "Exit ETOTAL_SHORT" c call flush(iout) return end