c---------------------------------------------------------------------------
c       Copyright (c) 1996 Southeastern Universities Research Association,
c       Thomas Jefferson National Accelerator Facility
c
c       This software was developed under a United States Government
c       license described in the NOTICE file included as part of this
c       distribution.
c
c       Eddy A.J.M. Offermann, 12000 Jefferson Ave., Newport News, VA 23606
c       Email: offerman@cebaf.gov  Tel: (757) 249-7544  Fax: (757) 249-5800
c---------------------------------------------------------------------------
c
      subroutine ext_tar_cor(beam,sptr,spdet)

c Calculates the correction to the momentum due to the extended target.
c This subroutine serves as an interface between the extended target 
c calculations and ESPACE.

      implicit none

      include 'parameter.h'
      include 'espace_type.h'

      record /onespectrotr/ sptr
      record /onespectrodet/ spdet
      record /raster/ beam

      logical correct_fp

      real*8 ray(6),rv_b(3),txy(2),p3v(3),dx
      real*8 xtg
      real*8 delth,deldp
      integer i,ispectro
      real dsiev(2)
      data dsiev / DSIEVE_E, DSIEVE_H /

      if (.not.sptr.ok) return

      ispectro = sptr.index

c Reaction point in the beam system:

      do i = 1,3
         rv_b(i) = 100.*beam.react.v(i)       ! in [cm]
      enddo

c First get the reconstructed particle 3-momentum in the beam coordinate
c system. Then calculate the reaction point in the z=0 plane of the
c spectrometer.

      call transport_to_beam(ispectro,sptr.particle.pmom,
     >                      sptr.particle.tg.th,sptr.particle.tg.ph,p3v)
      call beam_to_transport(ispectro,rv_b,p3v,sptr.p_centr,txy,ray)

c Get rid of unphysical values:
c
c
      if (abs(ray(1)).lt.0.1.and.abs(ray(2)).lt.1.0.and.
     >    abs(ray(3)).lt.0.1.and.abs(ray(4)).lt.1.0.and.
     >    abs(ray(6)).lt.1.0) then
         xtg=ray(1)
         sptr.particle.tg.x = ray(1)
         delth= THT_XTG_COR*xtg    
         deldp = xtg/DEL_XTG_COR
        sptr.particle.tg.th = sptr.particle.tg.th + delth 
c        write(*,'(i2,9(1x,f9.5))')  ispectro,
c     > ray(2),sptr.particle.tg.th,delth,xtg
c     >,ray(1),ray(3),sptr.particle.tg.y,ray(4),sptr.particle.tg.ph
        sptr.particle.tg.dp = sptr.particle.tg.dp + deldp
        sptr.particle.pmom = sptr.p_centr*(1+sptr.particle.tg.dp)
      call transport_to_beam(ispectro,sptr.particle.pmom,
     >                      sptr.particle.tg.th,sptr.particle.tg.ph,p3v)
      call beam_to_transport(ispectro,rv_b,p3v,sptr.p_centr,txy,ray)
         sptr.particle.tg.x = ray(1)
      ysieve(ispectro) = sptr.particle.tg.y
     *     + sptr.particle.tg.ph * dsiev(ispectro)
      xsieve(ispectro) = sptr.particle.tg.x
     >     + sptr.particle.tg.th * dsiev(ispectro)
      endif

      return
      end