C------------------------------------------------------------------------------
      SUBROUTINE PEXP
C------------------------------------------------------------------------------
C
C     SCALE HEIGHT PRESSURE MODEL
C
C     Compile with options /c (compile only) and /4Yb (error tracing)
      implicit double precision (a-h,o-z)
C     COMMON DECK "WW" INSERTED HERE
      COMMON/WW/ dum(10),MAXW,W(1000)
      EQUIVALENCE (EARTHR,W(1))
C
C     PRESSURE        550-574
      EQUIVALENCE (W(550),PMODEL),(W(551),PFORM),(W(552),PID)
C
C     COMMON DECK "RKAM" INSERTED HERE
      real*8 KR,KTH,KPH
      COMMON//R,TH,PH,KR,KTH,KPH,RKVARS(14),TPULSE,CSTEP,DRDT(20)
C     COMMON DECK "CONST" INSERTED HERE
      COMMON/PCONST/CREF,RGAS,GAMMA
      COMMON/MCONST/PI,PIT2,PID2,DEGS,RAD,ALN10
C     COMMON DECK "PP" INSERTED HERE
      real*8 MODP
      COMMON/PP/MODP(4),P,PPT,PPR,PPTH,PPPH
C
      EQUIVALENCE (W(553),P0),(W(554),HSCALE)
C
C     COMMON DECK "CB19" INSERTED HERE
      INTEGER PRMX,PRNTBL,PRITBL,PRFRMTB,IDSPR(10)
      COMMON/B19/PRMX,PRNTBL(10),PRITBL(10),PRFRMTB(10),PRGP(11)
      EQUIVALENCE (PRGP,IDSPR),(ANP,PRGP(11))
      INTEGER PFMX,PFNTBL(10),PFITBL(10),PFFRMTB(10)
      DATA PFMX/1/
      DATA PFNTBL/1,11,8*0/
      DATA PFITBL/1,9*0/
      DATA PFFRMTB/1,9*0/
      DATA RECOGP/1.d0/
C                           
      ENTRY SETPRES
      PRMX=PFMX             
      CALL IMOVE(PRNTBL,PFNTBL,10)  
      CALL IMOVE(PRITBL,PFITBL,10)  
      CALL IMOVE(PRFRMTB,PFFRMTB,10)
      CALL SETPPRES
      RETURN                        
C
      ENTRY IPRES
      IF(idint(RECOGP) .NE. idint(PMODEL))
     1    CALL RERROR('PRESUR ','WRNG MODEL',RECOGP)

      MODP(1)=4HPEXP
      MODP(2)=PID
      CALL IPPRES
      RETURN
C
      ENTRY PRES
      Z=R-EARTHR
      EX=-Z/HSCALE
      P=P0*EXP(EX)
      PPT=0.d0
      PPR=P*EX/Z
      PPTH=0.d0
      PPPH=0.d0
      CALL PPRES
      RETURN
      END


