      PROGRAM GLOBAVW                                                                                                               
C     PROGRAM GLOBAVW(FIELD,       WT,       AVG,        SUM,                   C2                                                  
C    1                                       AVG1,       SUM1,      OUTPUT,)    C2                                                  
C    2          TAPE1=FIELD, TAPE2=WT, TAPE3=AVG,  TAPE4=SUM,                   C2                                                  
C    3                                TAPE13=AVG1,TAPE14=SUM1,TAPE6=OUTPUT)                                                         
C     -----------------------------------------------------------------         C2                                                  
C                                                                               C2                                                  
C     FEB 24/2010 - F.MAJAESS (ALLOW USE ON OTHER THAN FIELDS WITH ODD/CYCLICAL C2                                                  
C                              LONGITUDE)                                       C2                                                  
C     NOV 23/2009 - S.KHARIN (ADD OPTIONAL OUTPUT FILES WITH A SINGLE AVG VALUE)                                                    
C     SEP 21/2009 - D.YANG (REVISED TO ALLOW TIME SERIES' TIME STAMPS                                                               
C                           IN THE OUTPUT FILE)                                                                                     
C     JUL 03/2003 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)                                                         
C     MAR 05/2002 - F.MAJAESS (REVISED FOR "CHAR" KIND RECORDS)                                                                     
C     JUN 06/2001 - B. MIVILLE - ORIGINAL VERSION                                                                                   
C                                                                               C2                                                  
CGLOBAVW - CALCULATES HORIZONTAL GLOBAL WEIGHTED AVERAGE OF ANY FIELD   2  1    C1                                                  
C                                                                               C3                                                  
CAUTHOR  - B. MIVILLE                                                           C3                                                  
C                                                                               C3                                                  
CPURPOSE - CALCULATES THE HORIZONTAL GLOBAL WEIGHTED AVERAGE OF FIELD           C3                                                  
C          NOTE: REPEATED LONGITUDE IS EXCLUDED FROM COMPUTING THE AVERAGE      C3                                                  
C                IF FIRST AND LAST LONGITUDE VALUES ARE EQUAL AND NUMBER        C3                                                  
C                OF LONGITUDE IS ODD (CYCLICAL LONGITUDE CASE),                 C3                                                  
C                OTHERWISE ALL FIELD VALUES ARE USED.                           C3                                                  
C                                                                               C3                                                  
C                                                                               C3                                                  
CINPUT FILES...                                                                 C3                                                  
C                                                                               C3                                                  
C      FIELD = INPUT FILE OF FIELDS TO BE AVERAGED                              C3                                                  
C      WT    = WEIGHTS TO BE USED IN THE GLOBAL AVERAGE AND SUM                 C3                                                  
C                                                                               C3                                                  
COUTPUT FILES...                                                                C3                                                  
C                                                                               C3                                                  
C      AVG   = GLOBAL HORIZONTAL WEIGHTED AVERAGE OF FIELD                      C3                                                  
C      SUM   = GLOBAL HORIZONTAL WEIGHTED SUM OF FIELD                          C3                                                  
C                                                                               C3                                                  
C-------------------------------------------------------------------------------                                                    
C                                                                                                                                   
C     * MAXIMUM 2-D GRID SIZE (I+2)*(J+2)=IM*JM --> IJM                                                                             
C     * FOR MAX GRID SIZE OF I*J PLUS ONE MORE ON EACH SIDE.                                                                        
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      PARAMETER (IM=771,JM=386,IJM=IM*JM,IJMV=IJM*1)                                                                                
      REAL AVG(IJM),WT(IJM),FIELD(IJM),GSUM(IJM)                                                                                    
      INTEGER IBUF3,IBUF3P,K,LEVEL,LEVELP,IBUF2,IBUF7,NWDS                                                                          
C                                                                                                                                   
      LOGICAL OK,SPEC                                                                                                               
      COMMON/ICOM/IBUF(8),IDAT(IJMV)                                                                                                
      DATA MAXX/IJMV/                                                                                                               
C                                                                                                                                   
C     * IUA/IUST  - ARRAY KEEPING TRACK OF UNITS ASSIGNED/STATUS.                                                                   
C                                                                                                                                   
      INTEGER IUA(100),IUST(100)                                                                                                    
      COMMON /JCLPNTU/ IUA,IUST                                                                                                     
                                                                                                                                    
      REAL SPVAL,SPVALT                                                                                                             
      DATA SPVAL/1.E38/,SPVALT/1.E32/                                                                                               
C-------------------------------------------------------------------                                                                
C                                                                                                                                   
      NF=7                                                                                                                          
      CALL JCLPNT(NF,1,2,3,4,13,14,6)                                                                                               
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
      LAVG=0                                                                                                                        
      IF (IUST(3).EQ.1) THEN                                                                                                        
        REWIND 3                                                                                                                    
        LAVG=1                                                                                                                      
      ENDIF                                                                                                                         
      LSUM=0                                                                                                                        
      IF (IUST(4).EQ.1) THEN                                                                                                        
        REWIND 4                                                                                                                    
        LSUM=1                                                                                                                      
      ENDIF                                                                                                                         
      LAVG1=0                                                                                                                       
      IF (IUST(13).EQ.1) THEN                                                                                                       
        REWIND 13                                                                                                                   
        LAVG1=1                                                                                                                     
      ENDIF                                                                                                                         
      LSUM1=0                                                                                                                       
      IF (IUST(14).EQ.1) THEN                                                                                                       
        REWIND 14                                                                                                                   
        LSUM1=1                                                                                                                     
      ENDIF                                                                                                                         
C                                                                                                                                   
C    * SET COUNTER TO ZERO                                                                                                          
C                                                                                                                                   
      NR = 0                                                                                                                        
      LEVELP=999999                                                                                                                 
C                                                                                                                                   
C     * GET THE NEXT RECORD OF TYPE GRID                                                                                            
C                                                                                                                                   
 100  CALL GETFLD2 (1,FIELD,NC4TO8("GRID"),-1,-1,-1,IBUF,MAXX,OK)                                                                   
      IF (.NOT.OK)THEN                                                                                                              
        IF (NR.EQ.0) CALL                          XIT('GLOBAVW',-1)                                                                
        CALL                                       XIT('GLOBAVW',0)                                                                 
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * SAVE FIELD GRID INFO                                                                                                        
C                                                                                                                                   
      LEVEL = IBUF(4)                                                                                                               
      IBUF3 = IBUF(3)                                                                                                               
      IBUF2 = IBUF(2)                                                                                                               
C                                                                                                                                   
      IF(NR.EQ.0)THEN                                                                                                               
         ILON = IBUF(5)                                                                                                             
         ILAT = IBUF(6)                                                                                                             
         IBUF7 = IBUF(7)                                                                                                            
      ELSE                                                                                                                          
C                                                                                                                                   
C       * IF LEVEL IS LOWER THAN PREVIOUS LEVEL THEN                                                                                
C       * REWIND WEIGHTS FILE.                                                                                                      
C                                                                                                                                   
C         IF (LEVEL.LT.LEVELP) THEN                                                                                                 
             REWIND 2                                                                                                               
C          ENDIF                                                                                                                    
C                                                                                                                                   
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * READ IN THE WEIGHTS                                                                                                         
C                                                                                                                                   
      IF(LEVEL.NE.LEVELP)THEN                                                                                                       
C         CALL GETFLD2 (2,WT,-1,-1,-1,LEVEL,IBUF,MAXX,OK)                                                                           
         CALL GETFLD2 (2,WT,-1,-1,-1,-1,IBUF,MAXX,OK)                                                                               
         IF (.NOT.OK)THEN                                                                                                           
C            WRITE(6,6035) 'WT    LEVEL: ',IBUF(4),                                                                                 
C     1           ' COULD BE THE PROBLEM'                                                                                           
C            WRITE(6,6030) 'FIELD LEVEL: ',LEVEL                                                                                    
            CALL                                   XIT('GLOBAVW',-2)                                                                
         ENDIF                                                                                                                      
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * CHECK DATA                                                                                                                  
C                                                                                                                                   
      IF (NR.EQ.0) THEN                                                                                                             
C                                                                                                                                   
C        * ORIGINAL INPUT FIELD LABEL                                                                                               
C                                                                                                                                   
         IBUF3P=IBUF3                                                                                                               
C                                                                                                                                   
C        * WEIGHTS GRID SIZE                                                                                                        
C                                                                                                                                   
         IWT=IBUF(5)                                                                                                                
         JWT=IBUF(6)                                                                                                                
C                                                                                                                                   
C        * CHECK IF WEIGHTS AND FIELD ARE THE SAME DIMENSION                                                                        
C                                                                                                                                   
         IF((IWT.NE.ILON).OR.(JWT.NE.ILAT))THEN                                                                                     
            WRITE(6,6015)'INPUT WEIGHTS AND FIELDS NOT SAME DIMENSION'                                                              
            WRITE(6,6020)'WEIGHTS: ',IWT,' X ',JWT                                                                                  
            WRITE(6,6020)'FIELDS:  ',ILON,' X ',ILAT                                                                                
            CALL                                   XIT('GLOBAVW',-3)                                                                
         ENDIF                                                                                                                      
                                                                                                                                    
         NWDS=ILON*ILAT                                                                                                             
                                                                                                                                    
         IF(FIELD(1).EQ.FIELD(ILON).AND.MOD(ILON,2).NE.0) THEN                                                                      
                                                                                                                                    
C         * CYCLICAL LONGITUDE CASE                                                                                                 
C         * EXCLUDE REPEATED LONGITUDE FROM AVERAGE                                                                                 
C                                                                                                                                   
          WRITE(6,6015) 'CYCLICAL LONGITUDE FIELD CASE'                                                                             
          ILONM=ILON-1                                                                                                              
                                                                                                                                    
         ELSE                                                                                                                       
                                                                                                                                    
C         * NO CYCLICAL LONGITUDE CASE                                                                                              
C         * USE ALL FIELD ELEMENTS IN COMPUTING THE AVERAGE                                                                         
                                                                                                                                    
          WRITE(6,6015) 'NO CYCLICAL LONGITUDE FIELD CASE'                                                                          
          ILONM=ILON                                                                                                                
                                                                                                                                    
         ENDIF                                                                                                                      
C                                                                                                                                   
        WRITE(6,6000) IWT,JWT                                                                                                       
        WRITE(6,6002) ILON,ILAT                                                                                                     
C                                                                                                                                   
      ELSE                                                                                                                          
C                                                                                                                                   
C        * MAKE SURE THE FIELD DOES NOT CHANGE                                                                                      
C                                                                                                                                   
         IF(IBUF3P.NE.IBUF3) THEN                                                                                                   
            WRITE(6,6015) 'INPUT FIELD HAS CHANGED LABEL'                                                                           
            WRITE(6,6010) IBUF3                                                                                                     
            CALL                                   XIT('GLOBAVW',-4)                                                                
         ENDIF                                                                                                                      
C                                                                                                                                   
C        * MAKE SURE FIELD DOES NOT CHANGE DIMENSION                                                                                
C                                                                                                                                   
         IF((IBUF(5).NE.ILON).OR.(IBUF(6).NE.ILAT))THEN                                                                             
            WRITE(6,6015)'FIELD DIMENSION HAS CHANGED'                                                                              
            WRITE(6,6030)'RECORD NUMBER: ',NR                                                                                       
            CALL                                   XIT('GLOBAVW',-5)                                                                
         ENDIF                                                                                                                      
C                                                                                                                                   
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * SET SUM TO ZERO                                                                                                             
C                                                                                                                                   
      SUMF = 0.E0                                                                                                                   
      SUMW = 0.E0                                                                                                                   
C                                                                                                                                   
C     * COMPUTE AVERAGE USING THE INPUTED WEIGTHS                                                                                   
C                                                                                                                                   
C     * HERE WE USE ILONM=ILON-1 FOR FIELD WITH REPEATED LONGITUDE                                                                  
C     *         AND ILONM=ILON   OTHERWISE                                                                                          
C     *      IN COMPUTING THE GLOBAL AVERAGE OR SUM                                                                                 
C                                                                                                                                   
      DO 120 J=1,ILAT                                                                                                               
         DO 110 I=1,ILONM                                                                                                           
            IJ = (J - 1) * ILON + I                                                                                                 
            IF(ABS(FIELD(IJ)-SPVAL).GT.SPVALT.AND.                                                                                  
     +         ABS(   WT(IJ)-SPVAL).GT.SPVALT)THEN                                                                                  
              SUMF = SUMF + WT(IJ)*FIELD(IJ)                                                                                        
              SUMW = SUMW + WT(IJ)                                                                                                  
            ENDIF                                                                                                                   
 110     CONTINUE                                                                                                                   
 120  CONTINUE                                                                                                                      
C                                                                                                                                   
      IF(SUMW.EQ.0.E0) THEN                                                                                                         
         FAVG=SPVAL                                                                                                                 
         SUMF=SPVAL                                                                                                                 
      ELSE                                                                                                                          
         FAVG=SUMF/SUMW                                                                                                             
      ENDIF                                                                                                                         
      NR = NR + 1                                                                                                                   
C                                                                                                                                   
C     * PUT THE GLOBAL AVERAGE VALUE INTO EVERY ELEMENT OF ARRAY AVG                                                                
C                                                                                                                                   
      DO 220 IJ=1,NWDS                                                                                                              
         AVG(IJ) = FAVG                                                                                                             
         GSUM(IJ) = SUMF                                                                                                            
 220  CONTINUE                                                                                                                      
C                                                                                                                                   
C     * WRITE RESULTS TO STANDARD OUTPUT                                                                                            
C                                                                                                                                   
      IF(NF.EQ.3)THEN                                                                                                               
      WRITE(6,6004) IBUF3                                                                                                           
      WRITE(6,6005) LEVEL                                                                                                           
      WRITE(6,6006) FAVG                                                                                                            
      WRITE(6,6007) SUMF                                                                                                            
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * WRITE AVG TO OUTPUT FILE                                                                                                    
C                                                                                                                                   
      CALL SETLAB(IBUF,NC4TO8("GRID"),IBUF2,IBUF3,LEVEL,ILON,                                                                       
     +                                          ILAT,IBUF7,1)                                                                       
C                                                                                                                                   
      IF(LAVG.EQ.1)CALL PUTFLD2(3,AVG,IBUF,MAXX)                                                                                    
      IF(LSUM.EQ.1)CALL PUTFLD2(4,GSUM,IBUF,MAXX)                                                                                   
      IBUF(5)=1                                                                                                                     
      IBUF(6)=1                                                                                                                     
      IF(LAVG1.EQ.1)CALL PUTFLD2(13,AVG(1),IBUF,MAXX)                                                                               
      IF(LSUM1.EQ.1)CALL PUTFLD2(14,GSUM(1),IBUF,MAXX)                                                                              
C                                                                                                                                   
C     * KEEP PREVIOUS VALUE OF LEVEL                                                                                                
C                                                                                                                                   
      LEVELP=LEVEL                                                                                                                  
C                                                                                                                                   
      GO TO 100                                                                                                                     
C                                                                                                                                   
C----------------------------------------------------------------                                                                   
 6000 FORMAT('FROM WEIGHTS     FILE: NLON= ',I5,'   NLAT= ',I5)                                                                     
 6002 FORMAT('FROM FIELD INPUT FILE: NLON= ',I5,'   NLAT= ',I5)                                                                     
 6004 FORMAT('FIELD= ',A4)                                                                                                          
 6005 FORMAT('LEVEL= ',I10)                                                                                                         
 6006 FORMAT('WEIGHTED AVERAGE= ',E17.9)                                                                                            
 6007 FORMAT('WEIGHTED     SUM= ',E17.9)                                                                                            
 6010 FORMAT('INPUT FIELD: ',A4)                                                                                                    
 6015 FORMAT(A)                                                                                                                     
 6020 FORMAT(A,I8,A,I8)                                                                                                             
 6030 FORMAT(A,I8)                                                                                                                  
 6035 FORMAT(A,I8,A)                                                                                                                
      END                                                                                                                           
