	subroutine qpar_test
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 Jones prog
c	written by leo mcnamara 1-jun-88
c-----	last modified 21-sep-88
c
c++++++	    requires s/rs QLFNH & XPXPR_QPAR
c
	implicit real*8 (a-h,o-z)
	character*8 modx,id
	common r(6) /ww/ id(10),w0,w(400)
	common /xx/ modx(2),x,pxpr,pxpth,pxpph,pxpt,hmaxf2
	equivalence (r0,w(2)), (f,w(6)),(rr,r(1))
ccc	data modx / 'qpar-', 'test' /
	data ipass / 0 /
	modx(1) = 'qpar-'
	modx(2) = 'test'
c
c................................
	entry ELECTX
c................................
c
	hh = rr - r0
	fn = 0.d0
	x = 0.d0
	pxpr = 0.d0
	pxpth = 0.d0
	pxpph = 0.d0
	pxpt = 0.d0
c
c-------	for testing QPAR, read data from ROSE.DAT
	open(unit=20,file='ROSE.dat',status='old')
	if(ipass.eq.0)
     a  read(20,2020) foe,yme,hme,fof1,ymf1,hmf1,fof2,ymf2,hmf2,
     a  hsf,hsf2,fnmax,hmax,ymax
	if(ipass.eq.0)
     a  read(20,2021) invqp
2020	format(10f8.2)
2021	format(i3)
	if(ipass.eq.0)
     a  print*,' Profile data ',foe,yme,hme,fof1,ymf1,hmf1,fof2,ymf2,
     a  hmf2,hsf,hsf2,fnmax,hmax,ymax,invqp
	ipass = 1
c-------	for testing QPAR, read data from ROSE.DAT
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)
	return
20	if(hh.gt.hsf) go to 30
c	point is within the E-F valley slab
	x = (foe/f)**2
	pxpr = 0.
	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.d0 * fn / f /f
	pfnpr = a * rr / fn / rb / rb
	pxpr = pxpfn * pfnpr
	return
c
40	continue
c	quasi-parabolic layer
	call xpxpr_qpar(r0,rr,fnmax,hmax,ymax,invqp,f,x,pxpr)
	return
50	if(hh.gt.hmf2) stop 'NO WAY, JOSE!'
	call xpxpr_qpar(r0,rr,fof2,hmf2,ymf2,-1,f,x,pxpr)
c
	return
	end

