      PROGRAM VPINTL                                                                                                                
C     PROGRAM VPINTL (XIN,       XOUT,       OUTPUT,                    )       C2                                                  
C    1          TAPE1=XIN, TAPE2=XOUT, TAPE6=OUTPUT)                                                                                
C     ----------------------------------------------                            C2                                                  
C                                                                               C2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       C2                                                  
C     JAN 14/93 - E. CHAN  (DECODE LEVELS IN 8-WORD LABEL)                                                                          
C     JAN 29/92 - E. CHAN  (CONVERT HOLLERITH LITERALS TO ASCII)                                                                    
C     FEB 12/86 - B.DUGAS                                                                                                           
C                                                                               C2                                                  
CVPINTL  - VERTICAL PRESSURE INTEGRAL OF FIELDS LEVEL BY LEVEL          1  1    C1                                                  
C                                                                               C3                                                  
CAUTHOR  - D.NEELIN                                                             C3                                                  
C                                                                               C3                                                  
CPURPOSE - VERTICAL INTEGRATION OF A FILE OF PRESSURE LEVEL SETS. RESULTS       C3                                                  
C          ARE SAVED LEVEL BY LEVEL. QUADRATURE IS TRAPEZOIDAL FROM 0. MB       C3                                                  
C          TO THE BOTTOM LEVEL AVAILABLE, (IE. EACH OUTPUT LEVEL CONTAINS       C3                                                  
C          THE INTEGRAL FROM 0 MB DOWN TO THAT LEVEL).                          C3                                                  
C          NOTE -FILE MAY CONTAIN SEVERAL FIELDS.                               C3                                                  
C                MINIMUM NUMBER OF LEVELS IS 2, MAX IS $PL$.                    C3                                                  
C                                                                               C3                                                  
CINPUT FILE..                                                                   C3                                                  
C                                                                               C3                                                  
C      XIN  = FILE OF PRESSURE LEVEL SETS.                                      C3                                                  
C                                                                               C3                                                  
COUTPUT FILE...                                                                 C3                                                  
C                                                                               C3                                                  
C      XOUT = OUTPUT SERIES OF MULTI-LEVEL PRESSURE SETS WITH EACH LEVEL        C3                                                  
C             CONTAINING THE INTEGRAL OF XIN FROM 0 TO THAT LEVEL.              C3                                                  
C------------------------------------------------------------------------------                                                     
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      COMMON/BLANCK/GG(37056),ACC(18528)                                                                                            
                                                                                                                                    
      LOGICAL OK,SPEC                                                                                                               
      INTEGER LEV(100)                                                                                                              
      REAL PR(100)                                                                                                                  
                                                                                                                                    
      COMMON/ICOM/IBUF(8),IDAT(18528)                                                                                               
      DATA MAXX/18528/, MAXL/100/                                                                                                   
                                                                                                                                    
C---------------------------------------------------------------------                                                              
      NF = 3                                                                                                                        
      CALL JCLPNT(NF,1,2,6)                                                                                                         
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
                                                                                                                                    
      GINV = 1.E0/9.80616E0                                                                                                         
                                                                                                                                    
C     * FIND HOW MANY LEVELS THERE ARE.                                                                                             
                                                                                                                                    
      CALL FILEV(LEV,NLEV,IBUF,1)                                                                                                   
      IF (NLEV.LT.2 .OR. NLEV.GT.MAXL) CALL        XIT('VPINTL',-1)                                                                 
      WRITE(6,6025) IBUF                                                                                                            
      WRITE(6,6005) NLEV,(LEV(I),I=1,NLEV)                                                                                          
                                                                                                                                    
C     * DETERMINE THE FIELD SIZE.                                                                                                   
                                                                                                                                    
      KIND = IBUF(1)                                                                                                                
      SPEC = (KIND.EQ.NC4TO8("SPEC") .OR. KIND.EQ.NC4TO8("FOUR"))                                                                   
      NWDS = IBUF(5)*IBUF(6)                                                                                                        
      IF (SPEC) NWDS = NWDS*2                                                                                                       
                                                                                                                                    
C     * CONVERT MB TO PASCALS (DIVIDE BY G ONCE AND FOR ALL).                                                                       
                                                                                                                                    
      CALL LVDCODE(PR,LEV,NLEV)                                                                                                     
      DO 110 L=1,NLEV                                                                                                               
         PR(L) = GINV*PR(L)*100.E0                                                                                                  
  110 CONTINUE                                                                                                                      
                                                                                                                                    
C     * READ THE NEXT SET.                                                                                                          
                                                                                                                                    
      NSETS = 0                                                                                                                     
  150 CALL GETFLD2(1,GG,KIND,-1,-1,LEV(1),IBUF,MAXX,OK)                                                                             
                                                                                                                                    
      IF (.NOT. OK)                                         THEN                                                                    
          IF (NSETS.EQ.0)                                   THEN                                                                    
              WRITE(6,6010)                                                                                                         
              CALL                                 XIT('VPINTL',-2)                                                                 
          END IF                                                                                                                    
          WRITE(6,6020) NSETS                                                                                                       
          CALL                                     XIT('VPINTL',0)                                                                  
      END IF                                                                                                                        
                                                                                                                                    
      ITIM = IBUF(2)                                                                                                                
      NAME = IBUF(3)                                                                                                                
                                                                                                                                    
C     * INTEGRATE THE GRIDS IN THE VERTICAL USING THE TRAPEZOIDAL RULE                                                              
C     * AND OUTPUT THE RESULTS ON UNIT 2. FIRST INTEGRAL FROM 0 TO LEV(1).                                                          
                                                                                                                                    
      DP=PR(1)/2                                                                                                                    
      DO 200 I=1,NWDS                                                                                                               
         ACC(I) = GG(I)*DP                                                                                                          
  200 CONTINUE                                                                                                                      
      CALL PUTFLD2(2,ACC,IBUF,MAXX)                                                                                                 
                                                                                                                                    
C     * INTEGRATE THE OTHER LEVELS. IW1 POINTS TO THE LAST LEVEL                                                                    
C     * AND IW2 THE CURRENT LEVEL.                                                                                                  
                                                                                                                                    
      INDEX1 = 2                                                                                                                    
      INDEX2 = 1                                                                                                                    
      DO 500 L=2,NLEV                                                                                                               
                                                                                                                                    
         INDEX1 = MOD(INDEX1,2)+1                                                                                                   
         INDEX2 = MOD(INDEX2,2)+1                                                                                                   
         IW1    =    (INDEX1-1)*NWDS                                                                                                
         IW2    =    (INDEX2-1)*NWDS                                                                                                
                                                                                                                                    
         CALL GETFLD2(1,GG(IW2+1),KIND,ITIM,NAME,LEV(L),IBUF,MAXX,OK)                                                               
         IF (.NOT.OK) CALL                         XIT(' VPINTL',-10-L)                                                             
                                                                                                                                    
         DP=(PR(L)-PR(L-1))/2                                                                                                       
         DO 400 I=1,NWDS                                                                                                            
            ACC(I) = ACC(I)+(GG(IW1+I)+GG(IW2+I))*DP                                                                                
  400    CONTINUE                                                                                                                   
                                                                                                                                    
         CALL PUTFLD2(2,ACC,IBUF,MAXX)                                                                                              
                                                                                                                                    
  500 CONTINUE                                                                                                                      
                                                                                                                                    
      NSETS = NSETS+1                                                                                                               
      GOTO 150                                                                                                                      
                                                                                                                                    
C---------------------------------------------------------------------                                                              
 6005 FORMAT('0 VPINTL ON ',I5,' LEVELS =',20I5/(26X,20I5)/)                                                                        
 6010 FORMAT('0.. VPINTL INPUT FILE IS EMPTY')                                                                                      
 6020 FORMAT('0',I6,' SETS WERE PROCESSED')                                                                                         
 6025 FORMAT(' ',A4,I10,2X,A4,I10,4I6)                                                                                              
      END                                                                                                                           
