subroutine rotation(en,x0,y0,z0,x1,y1,z1,zstart,throt)

      implicit none

      include 'const.inc'

      double precision en, throt, pl, IntBz0, IntBz1
      double precision x0, y0, z0, x1, y1, z1, zstart
	double precision, external :: rsqrt,ratan
c

cc     zstart is zt1 in target/empty and ztar1 in Main.  It is the starting
cc       position of target 1 i.e., z=23.7 for the Int_Bz subroutine 


c	if ((10.0*(z1-zstart).lt.-50).or.(10.0*(z1-zstart).gt.1050))
c     &     	write(6,*) ' IntBz out of range ',z1,zstart

cccccccccccccc  target rotation

c   path length during this section.  
            pl = rsqrt((x1-x0)**2+(y1-y0)**2+(z1-z0)**2) 

************Bz GRADIENT*******************************
*
      if (bzgradnum.eq.0) then
	      throt = gy*mag_b*pl*0.1/rsqrt(2.*en/m_n)
c	write(6,*)  ' 0.1mG th,pl  ,',throt,pl

	  else if (bzgradnum.eq.1) then
****************************************************************
c Field profile for gradient systematic runs. Elog Sim. post 13 -KG


		  call int_Bz(10.0*(z0-zstart)+23.7,IntBz0)
c            if(IntBz0.lt.165.01.or.IntBz0.gt.2189.40)
c     &       write(6,*) 'IntBz=', IntBz0,' out of range 165.01~2189.39'
            call int_Bz(10.0*(z1-zstart)+23.7,IntBz1)
c            if(IntBz1.lt.165.01.or.IntBz1.gt.2189.40) 
c     &       write(6,*) 'IntBz=', IntBz1,' out of range 165.01~2189.39'

        throt=gy*(IntBz1-IntBz0)/(10.0*(z1-z0))*pl*0.1/rsqrt(2.*en/m_n)
c	write(6,*) z0,z1,zstart
c	write(6,*)  ' Bz.dat th,pl  ,',throt,pl
c	write(6,*) ' IB1',IntBz1,' IB0',IntBz0
c
c     IntBz=165.01(mG*mm)@23.7mm where 1st Tgt begins, 2189.39 @439.7mm at the end  
	  else if (bzgradnum.eq.2) then
****************************************************************
c     Field profile for large uniform field systematic runs. -KG
c
		  call int_Bz(10.0*(z0-zstart)+23.7,IntBz0)
c            if(IntBz0.lt.190.59.or.IntBz0.gt.3714.64)
c     &       write(6,*) 'IntBz=', IntBz0,' out of range 190.59~3714.64'
            call int_Bz(10.0*(z1-zstart)+23.7,IntBz1)
c            if(IntBz1.lt.190.59.or.IntBz1.gt.3714.64) 
c     &       write(6,*) 'IntBz=', IntBz1,' out of range 190.59~3714.64'

        throt=gy*(IntBz1-IntBz0)/(10.0*(z1-z0))*pl*0.1/rsqrt(2.*en/m_n)
c	write(6,*)  ' LrgFld th,pl  ,',throt,pl
c IntBz=190.59(mG*mm)@23.7mm where 1st Tgt begins, 3714.64 @439.7mm at the end  

	  else if (bzgradnum.eq.3) then

***********************************************************************
c Gradient field profile for data run 1154 (biggest recorded gradient)
		  call int_Bz(10.0*(z0-zstart)+23.7,IntBz0)
c            if(IntBz0.lt.-60.0.or.IntBz0.gt.-1.0)
c     &       write(6,*) 'IntBz=', IntBz0,' out of range -60.0~-1'
            call int_Bz(10.0*(z1-zstart)+23.7,IntBz1)
c            if(IntBz1.lt.-60.0.or.IntBz1.gt.-1.0) 
c     &       write(6,*) 'IntBz=', IntBz1,' out of range -60.0~-1'

        throt=gy*(IntBz1-IntBz0)/(10.0*(z1-z0))*pl*0.1/rsqrt(2.*en/m_n)
c	write(6,*)  ' 1154 th,pl  ,',throt,pl
cc IntBz=-35.84(mG*mm)@23.7mm where 1st Tgt begins, -39.54 @439.7mm at the end  
**************************************************************************
	  else if (bzgradnum.eq.4) then

c Gradient field profile for data run 1449 (flipping gradient)
		  call int_Bz(10.0*(z0-zstart)+23.7,IntBz0)
c            if(IntBz0.lt.-26.75.or.IntBz0.gt.2511.6)
c     &    write(6,*) 'IntBz=', IntBz0,' out of range -26.75~2511.6'
            call int_Bz(10.0*(z1-zstart)+23.7,IntBz1)
c            if(IntBz1.lt.-26.75.or.IntBz1.gt.2511.6) 
c     &    write(6,*) 'IntBz=', IntBz1,' out of range -26.75~2511.6'

        throt=gy*(IntBz1-IntBz0)/(10.0*(z1-z0))*pl*0.1/rsqrt(2.*en/m_n)
c	write(6,*)  ' 1449 th,pl  ,',throt,pl
cc IntBz=-70.5959(mG*mm)@23.7mm where 1st Tgt begins, -2450.75898 @439.7mm at the end 
*********************************************************************** 
	end if


c         if (pl.gt.50) write(6,*) 'target 1 ',pl
         if (throt.gt.1e9) 
     &       write(6,*) ' throt ', throt, ',  pl ',pl, ' en ',en

cccccccccc end  target rotation





      return
      end