subroutine qp_xpxpr
     a  (foe,yme,hme,fof1,ymf1,hmf1,fof2,ymf2,hmf2,hsf,hsf2,
     a   fnmax,ymax,hmax,invqp)
c	s/r to calculate the values of X and PXPR for a multi-segment
c	QP layer, as set up by QPAR.
c	Used by the prog QP_3D.
c
c	written by leo mcnamara 1-jun-88
c-----	last modified 24-oct-90 (sort out single & double precision)
c
c++++++	    requires s/rs QLFNH & XPXPR_QPAR
c
ccc	implicit real*8 (a-h,o-z)
	character*8 modx,id
	real*8 x_dp,pxpr_dp,pxpth,pxpph,pxpt,hmaxf2,rz,w0,w,freq,r,rrr
	common r(6) /ww/ id(10),w0,w(400)
	common /xx/ modx(2),x_dp,pxpr_dp,pxpth,pxpph,pxpt,hmaxf2
	equivalence (rz,w(2)), (freq,w(6)),(rrr,r(1))
	data modx / 'qpar', '    ' /
	data ipass / 0 /
c
	r0 = sngl(rz)
	rr = sngl(rrr)
	f = sngl(freq)
	hh = rr - r0
	fn = 0.
	x = 0.
	pxpr = 0.
	pxpth = 0.
	pxpph = 0.
	pxpt = 0.
	x_dp = 0.d0
	pxpr_dp = 0.d0
c
	if(ipass.eq.0)
     a  print*,' Profile data ',foe,yme,hme,fof1,ymf1,hmf1,fof2,ymf2,
     a  hmf2,hsf,hsf2,fnmax,ymax,hmax,invqp
	ipass = 1
c
c	check for point below base of layer
	rme = r0 + hme
	rbe = rme - yme
	if(rr.lt.rbe) return
c
c	check for point above the layer
	if(rr.gt.r0+hmf2) return
c
c	HMAXF2 to be returned to RAYTRACE
	hmaxF2 = hmf2
c
c	the point could be in any of the 3 layers or E-F slab
c
	if(hh.gt.hme) go to 20
c	point is within the E layer
	call xpxpr_qpar(r0,rr,foe,hme,yme,-1,f,x,pxpr)
	x_dp = dble(x)
	pxpr_dp = dble(pxpr)
	return
20	if(hh.gt.hsf) go to 30
c	point is within the E-F valley slab
	x = (foe/f)**2
	pxpr = 0.
	x_dp = dble(x)
	pxpr_dp = dble(pxpr)
	return
c
30	if(hh.gt.hsf2) go to 50
c	point is in the F1 layer - could be positive or negative QP
c	(invqp = -/+1), or QL layer (invqp=0)
c	do quasi-linear layer first
	if(invqp.ne.0) go to 40
	call qlfnh (r0,foe,hsf,fof1,hsf2,hh,a,b,fn)
	x = (fn / f) **2
	rb = r0 + hsf
	pxpfn = 2. * fn / f /f
	pfnpr = a * rr / fn / rb / rb
	pxpr = pxpfn * pfnpr
	x_dp = dble(x)
	pxpr_dp = dble(pxpr)
	return
c
40	continue
c	quasi-parabolic layer
	call xpxpr_qpar(r0,rr,fnmax,hmax,ymax,invqp,f,x,pxpr)
	x_dp = dble(x)
	pxpr_dp = dble(pxpr)
	return
c
50	if(hh.gt.hmf2) stop 'NO WAY, JOSE!'
	call xpxpr_qpar(r0,rr,fof2,hmf2,ymf2,-1,f,x,pxpr)
	x_dp = dble(x)
	pxpr_dp = dble(pxpr)
c
	return
	end