C------------------------------------------------------------------------------
      SUBROUTINE PEXP
C------------------------------------------------------------------------------
C  4 May 2009 - replaced REAL*8 with DOUBLE PRECISION
c 24 Mar 2008 - Factored out Z in PPR calculation
C 13 Mar 2008 - Corrected length in common block /PCONST/
C------------------------------------------------------------------------------
C
C     SCALE HEIGHT PRESSURE MODEL
C
      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
      DOUBLE PRECISION 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
     1 ,MO2,MN2,MO,MN,MH2O,MO3                        ! 9 Mar 2007 ! 13 Mar 2008
      DOUBLE PRECISION MO2,MN2,MO,MN,MH2O,MO3                      ! 13 Mar 2008
      COMMON/MCONST/PI,PIT2,PID2,DEGS,RAD,ALN10
C     COMMON DECK "PP" INSERTED HERE
      DOUBLE PRECISION 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                           
C------------------------------------------------------------------------------

      ENTRY SETPRES
      PRMX=PFMX             
      CALL IMOVE(PRNTBL,PFNTBL,10)  
      CALL IMOVE(PRITBL,PFITBL,10)  
      CALL IMOVE(PRFRMTB,PFFRMTB,10)
      CALL SETPPRES
      RETURN                        
C
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
C------------------------------------------------------------------------------

      ENTRY PRES
      Z=R-EARTHR
      EX=-Z/HSCALE
      P=P0*EXP(EX)
      PPT=0.d0
C      PPR=P*EX/Z
      PPR=-P/HSCALE                                                ! 24 Mar 2008
      PPTH=0.d0
      PPPH=0.d0
      CALL PPRES
      RETURN
C------------------------------------------------------------------------------
      END SUBROUTINE PEXP
C------------------------------------------------------------------------------
