c	s/r qparxdp
      SUBROUTINE QPARAB                                                 PARA001 
	implicit real*8 (a-h,o-z)
	character*8 modx,id
C        PLAIN PARABOLIC OR QUASI-PARABOLIC PROFILE                     PARA002 
C        W(104) = 0. FOR A PLAIN PARABOLIC PROFILE                      PARA003 
C               = 1. FOR A QUASI-PARABOLIC PROFILE                      PARA004 
      COMMON /XX/ MODX(2),X,PXPR,PXPTH,PXPPH,PXPT,HMAX                  PARA005 
      COMMON R(6) /WW/ ID(10),W0,W(400)                                 PARA006 
      EQUIVALENCE (EARTHR,W(2)),(F,W(6)),(FC,W(101)),(HM,W(102)),       PARA007 
     1 (YM,W(103)),(QUASI,W(104)),(PERT,W(150))                         PARA008 
	data ipass / 0 /
      ENTRY ELECTX                                                      PARA010 
	ipass = ipass + 1
	if(ipass.gt.10000) ipass = 2
	if(ipass.eq.1) return
      modx(1) = 'qparab'
      HMAX=HM                                                           PARA011 
	x = 0.d0
	pxpr = 0.d0
	pxpth = 0.d0
	pxpph = 0.d0
      H=R(1)-EARTHR                                                     PARA013 
	if(f.le.0.d0) print*,' W(6),f ',w(6),f
      FCF2=(FC/F)**2                                                    PARA014 
      CONST=1.d0                                                        PARA015 
      IF (QUASI.EQ.1.d0) CONST=(EARTHR+HM-YM)/R(1)                      PARA016 
      Z=(H-HM)/YM*CONST                                                 PARA017 
      X=dMAX1(0.d0,FCF2*(1.d0-Z*Z))                                     PARA018 
      IF (X.EQ.0.d0) GO TO 50                                           PARA019 
      IF (QUASI.EQ.1.d0) CONST=(EARTHR+HM)*(EARTHR+HM-YM)/R(1)**2       PARA020 
      PXPR=-2.d0*Z*FCF2/YM*CONST                                        PARA021 
   50 IF (PERT.NE.0.d0) CALL ELECT1                                     PARA022 
      RETURN                                                            PARA023 
         END                                                            PARA024-