c/* @(#)expera.f	1.4      latest revision 6/14/90 13:53:52 */
      subroutine expera(xx,k0,neles,za,zb,zc,zd,ze,zf,tr,ti,sefz,scoul)
************************************************************************

c     Calculation of experimental quantities in Bystricky
c     Lehar and Winternitz, Journal de Physique, 39 (1978) p.11

      implicit real*8 (a-h, k,  o-y)
      implicit complex*16 (z)

      dimension tr(100,12),ti(100,12)
      dimension sefz(25), nifty(20), scoul(100)
 
      common /switch/ nifty
      common /vopt/ v10(2), v1m1(2), v01(2), v11(2), v00(2), vss(2),
     &              v1s(2), vsum1, vsum2

      data normf/0/

c >>> FIRST EXECUTABLE STATEMENT <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

      pi = 3.141593d+0
      zi = (0.,1.0)

c     determine normalization for f ampl by value of e at 10 degrees
c     znormf =+ E(0)/Ue(0) ... factors of 2 in Ue def
c            scale by (1+nifty(12)/10) as test

      if (normf .eq. 0) then
c        zf not yet normalized
c ********      .99 = 8  degrees  *tm 7/11/91*
c        cth = 0.99
c        normf= 1
c        call thep (cth,k0,neles,za,zb,zc,zd,ze,zf,tr,ti)
c        call voptth (k0, k0, k0, cth)
c       all factors of 2 now in voptth
c 
      endif
          call thep (xx,k0,neles,za,zb,zc,zd,ze,zf,tr,ti,scoul)

***************    Temporary write of AMPS to tape 11  *******
************* tm amps 9/19/91 ************************
c       chuck = acos(xx) * 180.0 /pi
c       write(11,1966) chuck, za, zb, zc, zd, ze, zf
c1966  format( f6.2, 6(e10.4,e10.4))
************ ******************** **********************

c *** Conjugates ***

c       ************************************************************
      zac = CONJG( za )
      zbc = CONJG( zb )
      zcc = CONJG( zc )
      zdc = CONJG( zd )
      zec = CONJG( ze )
      zfc = CONJG( zf )
      ab  = ABS( za )
      bb  = ABS( zb )
      cb  = ABS( zc )
      db  = ABS( zd )
      eb  = ABS( ze )
      fb  = ABS( zf )
      a2  = ab * ab
      b2  = bb * bb
      c2  = cb * cb
      d2  = db * db
      e2  = eb * eb
      f2  = fb * fb
      zapb = za + zb
      amasb = ABS( zapb )
      amasb2 = amasb * amasb
      sefz(11) = 0.5 * amasb2
c
c	rhl mod 6/89 here and elsewhere to include f ampitude
c
      ai000 = (a2 + b2 + c2 + d2 + e2 + f2)/2.
      a00nn = (a2 - b2 - c2 + d2 + e2 - f2)/2./ai000
      pn000 = (zac * ze + zbc*zf)/ai000
c      tm      6/90 include 2' observable as sefz(15)
      p0n00 = (zac * ze - zbc*zf)/ai000
      k0lm0 = -zi * (zcc * ze -zdc * zf)/ai000
      clm00 = -zi * (zdc * ze +zcc * zf)/ai000
      Dn0n0 = (a2 + b2 - c2 - d2 + e2 + f2)/2./ai000
      Dl0m0 = -zi * (zbc * ze + zac * zf)/ai000
      Dm0m0 = (zac * zb  +  zcc * zd - zec * zf)/ai000
      Dl0l0 = (zac * zb  -  zcc * zd - zec * zf)/ai000
c
      a00lm = zi * (zdc * ze + zcc * zf)/ai000
      a00ml = zi * (zdc * ze - zcc * zf)/ai000
      a00mm = (zac * zd + zbc * zc)/ai000
      a00ll = -(zac * zd - zbc * zc)/ai000
c
      sefz(1) = ai000
      sefz(2) = a00nn
      sefz(3) = pn000
      sefz(4) = k0lm0
      sefz(5) = clm00
      sefz(6) = Dn0n0
      sefz(7) = Dl0m0
      sefz(8) = Dm0m0
      sefz(9) = Dl0l0
c
      sefz(20) = a00lm
      sefz(21) = a00ml
      sefz(22) = a00mm
      sefz(23) = a00ll
c
      sefz(10) = 0.25 * e2
      sefz(15) = p0n00

c *** Still need to convert to millibarns ***

c *** Computes the total cross sections using the
c *** optical theorem, that is for xx = 1.0

      IF (xx .le. .99) go to 70
      fac = 2. * pi/k0
      sig0t = -zi * fac * (za + zb)
      sig1t = -zi * fac * (zc + zd)
      sig2t = -2. * fac * zi * zd
      sefz(16) = sig0t
      sefz(17) = sig1t
      sefz(18) = sig2t

 70   RETURN
      end
