subroutine etotal_long(energia) implicit real*8 (a-h,o-z) 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 include 'COMMON.IOUNITS' double precision energia(0:n_ene),energia1(0:n_ene+1) include 'COMMON.FFIELD' include 'COMMON.DERIV' include 'COMMON.INTERACT' include 'COMMON.SBRIDGE' include 'COMMON.CHAIN' include 'COMMON.VAR' call int_from_cart1(.false.) cd print '(a,i2)','Calling etotal ipot=',ipot cd print *,'nnt=',nnt,' nct=',nct C C Compute the side-chain and electrostatic interaction energy C goto (101,102,103,104,105,106) ipot C Lennard-Jones potential. 101 call elj(evdw) cd print '(a)','Exit ELJ' goto 107 C Lennard-Jones-Kihara potential (shifted). 102 call eljk(evdw) goto 107 C Berne-Pechukas potential (dilated LJ, angular dependence). 103 call ebp(evdw) goto 107 C Gay-Berne potential (shifted LJ, angular dependence). 104 call egb(evdw) goto 107 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence). 105 call egbv(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 c print *,"Processor",myrank," computed USCSC" call vec_and_deriv c print *,"Processor",myrank," left VEC_AND_DERIV" 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) then #else if (welec.gt.0d0.or.wel_loc.gt.0d0.or. & wturn3.gt.0d0.or.wturn4.gt.0d0) then #endif call eelec(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 C C Calculate excluded-volume interaction energy between peptide groups C and side chains. C if (ipot.lt.6) then call escp(evdw2,evdw2_14) else c write (iout,*) "Soft-sphere SCP potential" call escp_soft_sphere(evdw2,evdw2_14) endif 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) endif C C Sum the energies C #ifdef SPLITELE etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1 & +wcorr*ecorr+wcorr5*ecorr5 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d #else etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) & +wcorr*ecorr+wcorr5*ecorr5 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d #endif energia(0)=etot 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(12)=escloc c detecting NaNQ #ifdef ISNAN c if (isnan(etot)) energia(0)=1.0d+99 #else i=0 #ifdef WINPGI idumm=proc_proc(etot,i) #else call proc_proc(etot,i) #endif c if(i.eq.1)energia(0)=1.0d+99 #endif C C Sum up the components of the Cartesian gradient. C return #ifdef SPLITELE do i=1,nct do j=1,3 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+ & welec*gelc(j,i)+wvdwpp*gvdwpp(j,i)+ & wcorr*gradcorr(j,i)+ & wel_loc*gel_loc(j,i)+ & wturn3*gcorr3_turn(j,i)+ & wturn4*gcorr4_turn(j,i)+ & wcorr5*gradcorr5(j,i)+ & wcorr6*gradcorr6(j,i)+ & wturn6*gcorr6_turn(j,i) gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ & wcorr*gradxorr(j,i) enddo #else do i=1,nct do j=1,3 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+ & welec*gelc(j,i)+ & wcorr*gradcorr(j,i)+ & wel_loc*gel_loc(j,i)+ & wturn3*gcorr3_turn(j,i)+ & wturn4*gcorr4_turn(j,i)+ & wcorr5*gradcorr5(j,i)+ & wcorr6*gradcorr6(j,i)+ & wturn6*gcorr6_turn(j,i) gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ & wcorr*gradxorr(j,i) enddo #endif cd print '(i3,9(1pe12.4))',i,(gvdwc(k,i),k=1,3),(gelc(k,i),k=1,3), cd & (gradc(k,i),k=1,3) enddo c write (iout,*) "Cartesian gradient" c write (iout,*) "gradcorr5" c do i=1,nres c write (iout,*) i,(gradcorr5(j,i),j=1,3) c enddo c write (iout,*) "gradcorr6" c do i=1,nres c write (iout,*) i,(gradcorr6(j,i),j=1,3) c enddo do i=1,nres-3 cd write (iout,*) i,g_corr5_loc(i) gloc(i,icg)=wcorr*gcorr_loc(i) & +wcorr5*g_corr5_loc(i) & +wcorr6*g_corr6_loc(i) & +wturn4*gel_loc_turn4(i) & +wturn3*gel_loc_turn3(i) & +wturn6*gel_loc_turn6(i) & +wel_loc*gel_loc_loc(i) enddo 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) #endif 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' 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 write(iout,*) "ETOTAL_SHORT Processor",fg_rank, & " absolute rank",myrank," nfgtasks",nfgtasks 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(0,1,MPI_INTEGER,king,FG_COMM,IERROR) write (iout,*) "Processor",myrank," BROADCAST iorder" 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 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) endif write (iout,*),"Processor",myrank," BROADCAST weights" call MPI_Bcast(c(1,1),maxres6,MPI_DOUBLE_PRECISION, & king,FG_COMM,IERR) write (iout,*) "Processor",myrank," BROADCAST c" call MPI_Bcast(dc(1,1),maxres6,MPI_DOUBLE_PRECISION, & king,FG_COMM,IERR) write (iout,*) "Processor",myrank," BROADCAST dc" call MPI_Bcast(dc_norm(1,1),maxres6,MPI_DOUBLE_PRECISION, & king,FG_COMM,IERR) write (iout,*) "Processor",myrank," BROADCAST dc_norm" call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION, & king,FG_COMM,IERR) write (iout,*) "Processor",myrank," BROADCAST theta" call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION, & king,FG_COMM,IERR) write (iout,*) "Processor",myrank," BROADCAST phi" call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION, & king,FG_COMM,IERR) write (iout,*) "Processor",myrank," BROADCAST alph" call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION, & king,FG_COMM,IERR) write (iout,*) "Processor",myrank," BROADCAST omeg" call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION, & king,FG_COMM,IERR) 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 write (iout,*) "Processor",myrank," BROADCAST vbld_inv" endif write (iout,*) 'Processor',myrank, & ' calling etotal_short ipot=',ipot call flush(iout) print *,'Processor',myrank,' nnt=',nnt,' nct=',nct #endif c call int_from_cart1(.false.) 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 call ebend(ebe) C C Calculate the SC local energy. C call vec_and_deriv call esc(escloc) C C Calculate the virtual-bond torsional energy. C call etor(etors,edihcnstr) C C 6/23/01 Calculate double-torsional energy C call etor_d(etors_d) etot=wang*ebe+wtor*etors+wscloc*escloc+wtor_d*etors_d+wbond*estr & +edihcnstr+wstrain*ehpb+nss*ebr energia(0)=etot energia(11)=ebe energia(12)=escloc energia(13)=etors energia(14)=etors_d energia(15)=ehpb energia(17)=estr c detecting NaNQ #ifdef ISNAN c if (isnan(etot)) energia(0)=1.0d+99 #else i=0 #ifdef WINPGI idumm=proc_proc(etot,i) #else call proc_proc(etot,i) #endif c if(i.eq.1)energia(0)=1.0d+99 #endif C C Sum up the components of the Cartesian gradient. C return do i=1,nct do j=1,3 #ifdef CRYST_SC gradc(j,i,icg)=wbond*gradb(j,i)+wstrain*ghpbc(j,i) gradx(j,i,icg)=wbond*gradbx(j,i)+wstrain*ghpbx(j,i) #else gradc(j,i,icg)=wbond*gradb(j,i)+wstrain*ghpbc(j,i)+ & +wscloc*gscloc(j,i) gradx(j,i,icg)=wbond*gradbx(j,i)+wstrain*ghpbx(j,i) & +wscloc*gsclocx(j,i) #endif enddo enddo return end