C$$$  SUBPROGRAM DOCUMENTATION BLOCK                                            
C                .      .    .                                       .          
C SUBPROGRAM:    PGM-BARPEE  COMPUTES PRESS. AVG. OF A QUANTITY.                
C   PRGMMR: FINNICAN         ORG: W/NMC42      DATE: 88-04-01                   
C                                                                               
C ABSTRACT: COMPUTES PRESSURE AVERAGE OF A QUANTITY.                            
C                                                                               
C PROGRAM HISTORY LOG:                                                          
C   70-02-17  EDWRD GROSS                                                       
C   YY-MM-DD  MODIFIER1   DESCRIPTION OF CHANGE                                 
C   YY-MM-DD  MODIFIER2   DESCRIPTION OF CHANGE                                 
C                                                                               
C USAGE:    CALL BARPEE(P1,P2,QBARP)                                            
C   INPUT ARGUMENT LIST:                                                        
C     INARG1   - P1 - HIGHER PRESSURE (WHOLE MB)                                
C     INARG2   - P2 - LOWER PRESSURE (WHOLE MB)                                 
C                                                                               
C   OUTPUT ARGUMENT LIST:      (INCLUDING WORK ARRAYS)                          
C     WRKARG   - QBARP (PRESSURE AVERAGE OF QUANTITY,TEMP,R.H...ETC)            
C     OUTARG1  - IF QBARP = 9999,DATA IS MISSING. RETURN                        
C     ERRFLAG  - EVEN IF MANY LINES ARE NEEDED                                  
C                                                                               
C ATTRIBUTES:                                                                   
C   LANGUAGE: FORTRAN 90
C                                                                               
C$$$                                                                            
      SUBROUTINE BARPEE(P1,P2,QBARP)
      PARAMETER(INUM=350)
C                                                                               
C     COMPUTES PRESSURE AVERAGE OF QUANTITY IN                                  
C     COMMON/BARP/ QUANT(200), P(200), NQ                                       
C     P(I) PRESSURE LEVELS OF QUANT(I), NQ NO OF VALUES                         
C      P1 LOWER ALTITUDE  HIGHER PRESSURE  WHOLE MB                             
C     P2 LOWER PRESSURE  WHOLE MB                                               
C     QBARP  RESULT                                                             
C     MISSING DATA ASSUMED INDICATED  BY 9999.                                  
C     AND CORRECTLY ACCOUNTED FOR C                                             
C     QUANTITIES ARE ASSUMED TO VARY LINEARLY WITH LN(P)                        
C                                                                               
      COMMON /BARP/ QUANT(200), P(200), NQ
      DIMENSION QU(200), PQU(200)
C                                                                               
C     BEGIN " OBTAIN QUANTITY VALUE AT P1                                       
C     BY INTERPOLATION, EXACT VALUE OR IF NECESSARY BY EXTRAPOLAT               
C                                                                               
      PQU(1)=P1
      DO 10 I=1,NQ
      IF(ABS(QUANT(I)).GT.150.) GO TO 10
cvvvvvdak
cdak  IF(P(I)-P1)30,20,10
      IF(NINT(P(I)*10.)-NINT(P1*10.))30,20,10
caaaaadak
   10 CONTINUE
      I=NQ
      GO TO 65
   20 continue
      QU(1)=QUANT(I)
      NP1=I+1
      GO TO 70
   30 continue
      IL=I
   40 continue
      IL=IL-1
      IF(IL.LE.0) GO TO 50
cvvvvvdak
cdak  IF(P(IL).EQ.9999..OR.QUANT(IL).EQ.9999.) GO TO 40
      IF(NINT(P(IL)*10.).EQ.99990.OR.QUANT(IL).EQ.9999.) GO TO 40
caaaaadak
C                                                                               
C     INTERPOLATE TO P1                                                         
C                                                                               
      QU(1) = QUANT(IL)+ALOG(P1/P(IL))*((QUANT(I)-QUANT(IL))/
     2                      ALOG(P(I)/P(IL)))
      NP1=I
      GO TO 70
C                                                                               
C     EXTRAPOLATE DOWN TO P1                                                    
C                                                                               
   50 continue
      IP=I
   60 continue
      IP=IP+1
      IF(IP.GT.NQ) GO TO 65
cvvvvvdak
      IF(NINT(P(IP)*10.).EQ.99990.OR.QUANT(IP).EQ.9999.) GO TO 60
caaaaadak
      QU(1) = QUANT(I)-ALOG(P(I)/P1)*((QUANT(IP)-QUANT(I))/
     2                              ALOG(P(IP)/P(I)))
      NP1=I
      GO TO 70
C                                                                               
C     EXTRAPOLATE UP TO P1                                                      
   65 continue
      IL=I
      IL=IL-1
      I=I+1
  651 continue
      I=I-1
      IL=IL+1
   66 continue
      IL=IL-1
      IF(I.EQ.IL) IL=IL-1
      IF(IL.LE.0) GO TO 190
cvvvvvdak
cdak  IF(P(IL).EQ.9999..OR.QUANT(IL).EQ.9999.) GO TO 66
      IF(NINT(P(IL)*10.).EQ.99990.OR.QUANT(IL).EQ.9999.) GO TO 66
cdak  IF(P(I).EQ.9999..OR.QUANT(I).EQ.9999.) GO TO 651
      IF(NINT(P(I)*10.).EQ.99990.OR.QUANT(I).EQ.9999.) GO TO 651
caaaaadak
      QU(1) = QUANT(I)+ALOG(P1/P(I))*((QUANT(I)-QUANT(IL))/
     2                         ALOG(P(I)/P(IL)))
      NP1=I+1
C                                                                               
C     WORK UP FILLING IN VALUES TILL TIME TO LOOK                               
C     FOR P2 VALUE  LEAVE OUT MISSING DATA                                      
C                                                                               
   70 continue
cvvvvvdak
cdak  IF(P1.EQ.P2) GO TO 200
      IF(NINT(P1*10.).EQ.NINT(P2*10.)) GO TO 200
caaaaadak
      K=2
      IF(NP1.GT.NQ) GO TO 150
      DO 90 I=NP1,NQ
cvvvvvdak
cdak  IF(P(I).EQ.9999..OR.QUANT(I).EQ.9999.) GO TO 90
      IF(NINT(P(I)*10.).EQ.99990.OR.QUANT(I).EQ.9999.) GO TO 90
cdak  IF(P(I)-P2)110,100,80
      IF(NINT(P(I)*10.)-NINT(P2*10.))110,100,80
caaaaadak
   80 continue
      QU(K)=QUANT(I)
      PQU(K)=P(I)
      K=K+1
   90 continue
      CONTINUE
      IF(K.EQ.2)GO TO 190
      I=NQ
      GO TO 150
  100 continue
      QU(K)=QUANT(I)
      PQU(K)=P2
      GO TO 170
  110 continue
      IL=I
  120 continue
      IL=IL-1
      IF(IL.LE.0) GO TO 130
cvvvvvdak
cdak  IF(P(IL).EQ.9999..OR.QUANT(IL).EQ.9999.) GO TO 120
      IF(NINT(P(IL)*10.).EQ.99990.OR.QUANT(IL).EQ.9999.) GO TO 120
caaaaadak
C                                                                               
C     INTERPOLATE TO P2                                                         
C                                                                               
      QU(K) =QUANT(IL)+ALOG(P2/P(IL))*((QUANT(I)-QUANT(IL))/
     2                           ALOG(P(I)/P(IL)))
      GO  TO 170
C                                                                               
C     EXTRAPOLATE DOWN TO P2                                                    
C                                                                               
  130 continue
      IP=I
  140 continue
      IP=IP+1
      IF(IP.GT.NQ) GO TO 150
cvvvvvdak
cdak  IF(P(IP).EQ.9999..OR.QUANT(IP).EQ.9999.) GO TO 140
      IF(NINT(P(IP)*10.).EQ.99990.OR.QUANT(IP).EQ.9999.) GO TO 140
caaaaadak
      QU(K) = QUANT(I)-ALOG(P(I)/P2)*((QUANT(IP)-QUANT(I))/
     2                      ALOG(P(IP)/P(I)))
      GO TO 170
C                                                                               
C     EXTRAPOLATE UP TO P2                                                      
C                                                                               
  150 continue
      IL=I
      IL=IL-1
      I=I+1
  155 continue
      I=I-1
      IL=IL+1
  160 continue
      IL=IL-1
      IF(I.EQ.IL)  IL=IL-1
      IF(IL.LE.0) GO TO 190
cvvvvvdak
cdak  IF(P(IL).EQ.9999..OR.QUANT(IL).EQ.9999.) GO TO 160
      IF(NINT(P(IL)*10.).EQ.99990.OR.QUANT(IL).EQ.9999.) GO TO 160
cdak  IF(P(I).EQ.9999..OR.QUANT(I).EQ.9999.) GO TO 155
      IF(NINT(P(I)*10.).EQ.99990.OR.QUANT(I).EQ.9999.) GO TO 155
caaaaadak
      QU(K) = QUANT(I)+ALOG(P2/P(I))*((QUANT(I)-QUANT(IL))/
     2                     ALOG(P(I)/P(IL)))
C                                                                               
C     AVERAGE THE DATA                                                          
C                                                                               
  170 continue
      PQU(K)=P2
      QBARP=0.
      KL=K-1
      DO 180 I=1,KL
      QBARP=QBARP+((QU(I)+QU(I+1))/2.)*ALOG(PQU(I)/PQU(I+1))
  180 CONTINUE
      QBARP = QBARP/ALOG(P1/P2)
      RETURN
C                                                                               
C     TROUBLE                                                                   
C                                                                               
  190 continue
      QBARP=9999.
      RETURN
C                                                                               
C     P1=P2                                                                     
C                                                                               
  200 continue
      QBARP=QU(1)
      RETURN
      END
