      PROGRAM ZXDEVP                                                                                                                
C     PROGRAM ZXDEVP (ZXIN,       ZXOUT,       INPUT,       OUTPUT,     )       F2                                                  
C    1          TAPE1=ZXIN, TAPE2=ZXOUT, TAPE5=INPUT, TAPE6=OUTPUT)                                                                 
C     -------------------------------------------------------------             F2                                                  
C                                                                               F2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       F2                                                  
C     JAN 15/93 - E. CHAN  (DECODE LEVELS IN 8-WORD LABEL)                                                                          
C     JAN 29/92 - E. CHAN  (CONVERT HOLLERITH LITERALS TO ASCII)                                                                    
C     MAY 14/83 - R.LAPRISE.                                                                                                        
C     NOV 05/80 - J.D.HENDERSON                                                                                                     
C                                                                               F2                                                  
CZXDEVP  - CROSS-SECTION DEVIATION FROM PRESSURE MEAN.                  1  1   GF1                                                  
C                                                                               F3                                                  
CAUTHOR  - J.D.HENDERSON                                                        F3                                                  
C                                                                               F3                                                  
CPURPOSE - COMPUTES DEVIATIONS FROM THE VERTICAL PRESSURE MEAN FOR A FILE       F3                                                  
C          OF CROSS-SECTIONS.                                                   F3                                                  
C          NOTE - MAX LATITUDES IS $XIJ$, MAX LEVELS IS $L$ AND AT              F3                                                  
C                 INPUT THE CROSS-SECTION IS ORDERED FROM S TO N AND TOP        F3                                                  
C                 TO BOTTOM.                                                    F3                                                  
C                                                                               F3                                                  
CINPUT FILE...                                                                  F3                                                  
C                                                                               F3                                                  
C      ZXIN  = CROSS-SECTIONS                                                   F3                                                  
C                                                                               F3                                                  
COUTPUT FILE...                                                                 F3                                                  
C                                                                               F3                                                  
C      ZXOUT = DEVIATION CROSS-SECTIONS                                         F3                                                  
C-----------------------------------------------------------------------------                                                      
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      COMMON/XS/XA(193,100)                                                                                                         
C                                                                                                                                   
      LOGICAL OK                                                                                                                    
      INTEGER LEV(100)                                                                                                              
      REAL PR(100),PRH(101)                                                                                                         
      REAL G(193)                                                                                                                   
      COMMON/ICOM/IBUF(8),IDAT(193)                                                                                                 
C                                                                                                                                   
      DATA MAXX/193/, MAXL/100/ , MAXJ/193/                                                                                         
C---------------------------------------------------------------------                                                              
      NFF=3                                                                                                                         
      CALL JCLPNT(NFF,1,2,6)                                                                                                        
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
C                                                                                                                                   
C     * READ THE NEXT CROSS-SECTION. STOP AT EOF.                                                                                   
C     * LEV WILL CONTAIN THE PRESSURE LEVEL VALUES IN MILLIBARS.                                                                    
C     * PR,PRH ARE SET TO N/M**2.                                                                                                   
C                                                                                                                                   
      NSETS=0                                                                                                                       
  150 CALL GETZX2(1,XA,MAXJ,LEV,NLEV,IBUF,MAXX,OK)                                                                                  
      IF(.NOT.OK)THEN                                                                                                               
        IF(NSETS.EQ.0) CALL                        XIT('ZXDEVP',-1)                                                                 
        WRITE(6,6010) NSETS                                                                                                         
        CALL                                       XIT('ZXDEVP',0)                                                                  
      ENDIF                                                                                                                         
      IF(NSETS.EQ.0) WRITE(6,6025) IBUF                                                                                             
      IF((NLEV.LT.1).OR.(NLEV.GT.MAXL)) CALL       XIT('ZXDEVP',-2)                                                                 
      NLAT=IBUF(5)                                                                                                                  
      CALL LVDCODE(PR,LEV,NLEV)                                                                                                     
      DO 120 L=1,NLEV                                                                                                               
  120 PR(L)=PR(L)*100.E0                                                                                                            
C                                                                                                                                   
C     * COMPUTE PRESSURE HALF LEVELS FOR INTEGRAL IN P.                                                                             
C     * BOTTOM BOUNDARY IS CHOSEN TO BE 1013.3 MB.                                                                                  
C                                                                                                                                   
      PRH(1)=PR(1)*0.5E0                                                                                                            
      DO 130 L=2,NLEV                                                                                                               
  130 PRH(L)=0.5E0*(PR(L-1)+PR(L))                                                                                                  
      PRH(NLEV+1)=1013.3E0*100.E0                                                                                                   
      PDIF=PRH(NLEV+1)-PRH(1)                                                                                                       
C                                                                                                                                   
C     * INTEGRATE EACH LATITUDE IN PRESSURE.                                                                                        
C                                                                                                                                   
      DO 410 J=1,NLAT                                                                                                               
      G(J)=0.E0                                                                                                                     
      DO 405 L=1,NLEV                                                                                                               
  405 G(J)=G(J)+XA(J,L)*(PRH(L+1)-PRH(L))                                                                                           
      G(J)=G(J)/PDIF                                                                                                                
  410 CONTINUE                                                                                                                      
C                                                                                                                                   
C     * COMPUTE DEVIATIONS FROM PRESSURE MEAN AT EACH LEVEL AND SAVE.                                                               
C                                                                                                                                   
      DO 460 L=1,NLEV                                                                                                               
      DO 430 J=1,NLAT                                                                                                               
  430 XA(J,L)=XA(J,L)-G(J)                                                                                                          
      IBUF(3)=NC4TO8("DEVP")                                                                                                        
      IBUF(4)=LEV(L)                                                                                                                
      CALL PUTFLD2(2,XA(1,L),IBUF,MAXX)                                                                                             
      IF(NSETS.EQ.0) WRITE(6,6025) IBUF                                                                                             
  460 CONTINUE                                                                                                                      
C                                                                                                                                   
      NSETS=NSETS+1                                                                                                                 
      GO TO 150                                                                                                                     
C---------------------------------------------------------------------                                                              
 6010 FORMAT(' ',I6,' SETS PROCESSED')                                                                                              
 6025 FORMAT(' ',A4,I10,1X,A4,I10,4I6)                                                                                              
      END                                                                                                                           
