      PROGRAM ZONCOV                                                                                                                
C     PROGRAM ZONCOV (DEVA,       DEVB,       COVAR,       OUTPUT,      )       D2                                                  
C    1          TAPE1=DEVA, TAPE2=DEVB, TAPE3=COVAR, TAPE6=OUTPUT)                                                                  
C     ------------------------------------------------------------              D2                                                  
C                                                                               D2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       D2                                                  
C     NOV 06/95 - F.MAJAESS (REVISE DEFAULT PACKING DENSITY VALUE)                                                                  
C     JAN 29/92 - E. CHAN  (CONVERT HOLLERITH LITERALS TO ASCII)                                                                    
C     MAY 14/83 - R.LAPRISE.                                                                                                        
C     FEB 26/80 - J.D.HENDERSON                                                                                                     
C                                                                               D2                                                  
CZONCOV  - COMPUTES ZONAL COVARIANCE OF TWO GRID SETS                   2  1    D1                                                  
C                                                                               D3                                                  
CAUTHOR  - J.D.HENDERSON                                                        D3                                                  
C                                                                               D3                                                  
CPURPOSE - COMPUTES THE ZONAL COVARIANCE OF TWO GRID FILES WHICH                D3                                                  
C          CONTAIN DEVIATIONS FROM THEIR RESPECTIVE ZONAL MEANS.                D3                                                  
C                                                                               D3                                                  
CINPUT FILES...                                                                 D3                                                  
C                                                                               D3                                                  
C      DEVA  = FIRST  GRID FILE OF DEVIATIONS.                                  D3                                                  
C      DEVB  = SECOND GRID FILE OF DEVIATIONS.                                  D3                                                  
C                                                                               D3                                                  
COUTPUT FILE...                                                                 D3                                                  
C                                                                               D3                                                  
C      COVAR = ZONAL COVARIANCE WITH EACH RECORD CONSISTING OF A                D3                                                  
C              VECTOR RUNNING NORTH TO SOUTH.                                   D3                                                  
C----------------------------------------------------------------------------                                                       
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      COMMON/BLANCK/COV(96),F(18528),G(18528)                                                                                       
C                                                                                                                                   
      LOGICAL OK                                                                                                                    
      COMMON/ICOM/ IBUF(8),IDAT(18528)                                                                                              
      COMMON/JCOM/ JBUF(8),JDAT(18528)                                                                                              
      DATA MAXX/18528/                                                                                                              
C--------------------------------------------------------------------                                                               
      NFF=4                                                                                                                         
      CALL JCLPNT(NFF,1,2,3,6)                                                                                                      
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
      REWIND 3                                                                                                                      
C                                                                                                                                   
C     * READ THE NEXT PAIR OF RECORDS.                                                                                              
C                                                                                                                                   
      NR=0                                                                                                                          
  110 CALL GETFLD2(1,F,NC4TO8("GRID"),-1,-1,-1,IBUF,MAXX,OK)                                                                        
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6030) NR                                                                                                            
        IF(NR.EQ.0) CALL                           XIT('ZONCOV',-1)                                                                 
        CALL                                       XIT('ZONCOV',0)                                                                  
      ENDIF                                                                                                                         
      IF(NR.EQ.0) THEN                                                                                                              
        CALL PRTLAB (IBUF)                                                                                                          
        NPACK=MIN(2,IBUF(8))                                                                                                        
      ENDIF                                                                                                                         
      LEVEL=IBUF(4)                                                                                                                 
      CALL GETFLD2(2,G,NC4TO8("GRID"), -1, -1 ,LEVEL,JBUF,MAXX,OK)                                                                  
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6030) NR                                                                                                            
        CALL                                       XIT('ZONCOV',-2)                                                                 
      ENDIF                                                                                                                         
      IF(NR.EQ.0) THEN                                                                                                              
        CALL PRTLAB (JBUF)                                                                                                          
        NPACK=MIN(NPACK,JBUF(8))                                                                                                    
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * MAKE SURE THAT THE FIELDS ARE THE SAME KIND AND SIZE.                                                                       
C                                                                                                                                   
      CALL CMPLBL(0,IBUF,0,JBUF,OK)                                                                                                 
      IF(.NOT.OK)THEN                                                                                                               
        CALL PRTLAB (IBUF)                                                                                                          
        CALL PRTLAB (JBUF)                                                                                                          
        CALL                                       XIT('ZONCOV',-3)                                                                 
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * COMPUTE THE ZONAL COVARIANCE FOR THIS GRID PAIR.                                                                            
C     * REMEMBER THAT THE LAST VALUE IN EACH ROW IS A COPY OF THE FIRST.                                                            
C                                                                                                                                   
      NLG=IBUF(5)                                                                                                                   
      NLAT=IBUF(6)                                                                                                                  
      NLGM=NLG-1                                                                                                                    
C                                                                                                                                   
      DO 150 J=1,NLAT                                                                                                               
      N=(J-1)*NLG                                                                                                                   
      CV=0.E0                                                                                                                       
      DO 140 I=1,NLGM                                                                                                               
  140 CV=CV+F(N+I)*G(N+I)                                                                                                           
      COV(J)=CV/FLOAT(NLGM)                                                                                                         
  150 CONTINUE                                                                                                                      
C                                                                                                                                   
C     * WRITE THE ZONAL COVARIANCE VECTOR ONTO FILE 3.                                                                              
C                                                                                                                                   
      CALL SETLAB(IBUF,NC4TO8("ZONL"),-1,NC4TO8(" COV"),-1,                                                                         
     +                                     NLAT,1,-1,NPACK)                                                                         
      CALL PUTFLD2(3,COV,IBUF,MAXX)                                                                                                 
      IF(NR.EQ.0) CALL PRTLAB (IBUF)                                                                                                
      NR=NR+1                                                                                                                       
      GO TO 110                                                                                                                     
C--------------------------------------------------------------------                                                               
 6030 FORMAT('0  ZONCOV PROCESSED',I5,'  PAIRS OF RECORDS')                                                                         
      END                                                                                                                           
