      PROGRAM GGSTAT                                                                                                                
C     PROGRAM GGSTAT (GGA,       OUTPUT,                                )       A2                                                  
C    1          TAPE1=GGA, TAPE6=OUTPUT)                                                                                            
C     ----------------------------------                                        A2                                                  
C                                                                               A2                                                  
C     JUN 13/11 - F.MAJAESS(SET AMIN/AMAX TO SPVAL IF ALL ELEMENTS ARE BYPASSED)A2                                                  
C     NOV 23/10 - S.KHARIN (FORMAT STATEMENT ADJUSTMENTS)                                                                           
C     MAY 26/10 - F.MAJAESS (REVISED TO SUPPORT 4321X2161 DIMENSION)                                                                
C     SEP 18/06 - S.KHARIN (IMPROVE SPECIAL VALUE HANDLING)                                                                         
C     JAN 11/06 - F.MAJAESS (REVISED TO OUTPUT EXPECTED FILE SIZE)                                                                  
C     NOV 02/04 - S.KHARIN (PRINT OUT STATISTICS ON SPECIAL VALUES 1.E+38)                                                          
C     JUL 14/03 - F.MAJAESS (INCREASE "NUMBER OF RECORD FORMAT" TO I6 FROM I5)                                                      
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)                                                           
C     MAR 05/02 - F.MAJAESS (REVISED TO HANDLE "CHAR" KIND RECORDS)                                                                 
C     DEC 21/94 - F.MAJAESS (ADJUST FORMAT STATEMENTS)                                                                              
C     FEB 21/92 - E. CHAN   (ADD PRINTING OUT OF SUPERLABELS AND PRINT                                                              
C                            STATISTICS OUT WITH TWO EXTRA SIG FIGS)                                                                
C     JAN 29/92 - E. CHAN   (CONVERT HOLLERITH LITERALS TO ASCII)                                                                   
C     JUN 27/89 - F.ZWIERS. (ADD "SUBA" KIND )                                                                                      
C     MAY 11/83 - R.LAPRISE.                                                                                                        
C     MAR 25/80 - J.D.HENDERSON.                                                                                                    
C                                                                               A2                                                  
CGGSTAT  - PRINTS STATISTICS FOR EACH FIELD IN A GRID/SPEC FILE         1  0    A1                                                  
C                                                                               A3                                                  
CAUTHOR  - J.D.HENDERSON                                                        A3                                                  
C                                                                               A3                                                  
CPURPOSE - PRINTS SIMPLE STATISTICS FOR EACH FIELD IN A FILE.                   A3                                                  
C          IF THE DATA IS REAL THE PROGRAM PRINTS THE MIN, MAX,                 A3                                                  
C          MEAN AND VARIANCE OF THE FIELD. IF THE DATA IS COMPLEX               A3                                                  
C          THE MEAN ONLY IS PRINTED.                                            A3                                                  
C          NOTE - ONE LINE IS PRINTED FOR EACH RECORD IN THE FILE,              A3                                                  
C                 THIS MAY RESULT IN A LARGE PRINTER OUTPUT.                    A3                                                  
C                                                                               A3                                                  
CINPUT FILE...                                                                  A3                                                  
C                                                                               A3                                                  
C      GGA = INPUT FILE (REAL OR COMPLEX)                                       A3                                                  
C--------------------------------------------------------------------------                                                         
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
                                                                                                                                    
C     * MAXIMUM 2-D GRID SIZE: 4321 X 2161 --> IJM                                                                                  
                                                                                                                                    
      PARAMETER (IM=4321,JM=2161,IJM=IM*JM,IJMV=IJM*1)                                                                              
                                                                                                                                    
                                                                                                                                    
      CHARACTER*64 SLABL                                                                                                            
      CHARACTER*8  CBUF(1)                                                                                                          
      LOGICAL OK                                                                                                                    
C                                                                                                                                   
      COMMON/BLANCK/A(IJM)                                                                                                          
      COMMON /MACHTYP/ MACHINE,INTSIZE                                                                                              
      COMMON/ICOM/IBUF(8),IDAT(IJMV)                                                                                                
      EQUIVALENCE (SLABL,IDAT),(CBUF,IDAT)                                                                                          
C                                                                                                                                   
      DATA MAXX/IJMV/,SPVAL/1.E+38/,EPS/1.E-6/                                                                                      
C---------------------------------------------------------------------                                                              
                                                                                                                                    
C     * SETUP IN "SPVALT" THE TOLERANCE TO CHECK "SPVAL" AGAINST.                                                                   
                                                                                                                                    
      SPVALT=EPS*SPVAL                                                                                                              
                                                                                                                                    
      NFF=2                                                                                                                         
      CALL JCLPNT(NFF,1,6)                                                                                                          
      REWIND 1                                                                                                                      
C                                                                                                                                   
C     * GET THE NEXT FIELD. LABELS ARE JUST PRINTED.                                                                                
C                                                                                                                                   
      NR=0                                                                                                                          
      ND=0                                                                                                                          
      NB=0                                                                                                                          
  150 CALL RECGET(1,-1,-1,-1,-1,IBUF,MAXX,OK)                                                                                       
      IF(.NOT.OK) THEN                                                                                                              
        IF(NR.GT.0) THEN                                                                                                            
         WRITE(6,6025)NB                                                                                                            
         CALL                                      XIT('GGSTAT',0)                                                                  
        ELSE                                                                                                                        
         WRITE(6,6030)                                                                                                              
         CALL                                      XIT('GGSTAT',-1)                                                                 
        ENDIF                                                                                                                       
      ENDIF                                                                                                                         
      NR=NR+1                                                                                                                       
      CALL LBLCHK(LR,NWDS,NPACK,IBUF)                                                                                               
C     "*8" TO CONVERT TO BYTES, "+16" FOR 8-BYTES RECORD HEADER/TRAILER                                                             
      IF ( INTSIZE .EQ. 1 ) THEN                                                                                                    
       NB=NB+(LR*(8*INTSIZE/MACHINE))+16                                                                                            
      ELSE                                                                                                                          
       NB=NB+(LR*(8/INTSIZE))+16                                                                                                    
      ENDIF                                                                                                                         
      IF(IBUF(1).EQ.NC4TO8("LABL") .OR. IBUF(1).EQ.NC4TO8("CHAR") ) THEN                                                            
        IF(IBUF(1).EQ.NC4TO8("LABL") ) THEN                                                                                         
          WRITE(6,6012) NR,IBUF,SLABL                                                                                               
        ELSE                                                                                                                        
                                                                                                                                    
C         * FOR "CHAR" KIND, LIMIT DISPLAY TO UP TO 64 CHARACTERS                                                                   
C         *                  (8 * 8 BYTES).                                                                                         
                                                                                                                                    
          NWDS=MIN(IBUF(5)*IBUF(6),8)                                                                                               
          WRITE(6,6013) NR,IBUF,(CBUF(I),I=1,NWDS)                                                                                  
        ENDIF                                                                                                                       
        GO TO 150                                                                                                                   
      ENDIF                                                                                                                         
      ND=ND+1                                                                                                                       
      CALL RECUP2(A,IBUF)                                                                                                           
      LA=IBUF(5)*IBUF(6)                                                                                                            
C                                                                                                                                   
C     * DETERMINE THE KIND OF FIELD.                                                                                                
C                                                                                                                                   
      KIND=IBUF(1)                                                                                                                  
      IF(KIND.EQ.NC4TO8("GRID").OR.KIND.EQ.NC4TO8("ZONL").OR.                                                                       
     1   KIND.EQ.NC4TO8("SUBA").OR.KIND.EQ.NC4TO8("TIME"))                                                                          
     2                                              GO TO 210                                                                       
      IF(KIND.EQ.NC4TO8("SPEC").OR.KIND.EQ.NC4TO8("FOUR"))                                                                          
     1                                              GO TO 410                                                                       
      WRITE(6,6010)NR,IBUF                                                                                                          
      GO TO 150                                                                                                                     
C                                                                                                                                   
C     * GRID SECTION.                                                                                                               
C                                                                                                                                   
  210 IF(ND.EQ.1) WRITE(6,6006)                                                                                                     
C                                                                                                                                   
C     * COMPUTE THE MIN,MAX AND MEAN.                                                                                               
C                                                                                                                                   
      ASUM=0.E0                                                                                                                     
      AMIN=+1.E+38                                                                                                                  
      AMAX=-1.E+38                                                                                                                  
      NSPV=0                                                                                                                        
      DO 220 I=1,LA                                                                                                                 
         IF(ABS(A(I)-SPVAL).GT.SPVALT) THEN                                                                                         
            IF(A(I).LT.AMIN) AMIN=A(I)                                                                                              
            IF(A(I).GT.AMAX) AMAX=A(I)                                                                                              
            ASUM=ASUM+A(I)                                                                                                          
         ELSE                                                                                                                       
            NSPV=NSPV+1                                                                                                             
         ENDIF                                                                                                                      
 220  CONTINUE                                                                                                                      
      IF(LA.EQ.NSPV) THEN                                                                                                           
        AMEAN=SPVAL                                                                                                                 
        AMIN=SPVAL                                                                                                                  
        AMAX=SPVAL                                                                                                                  
      ELSE                                                                                                                          
        AMEAN=ASUM/FLOAT(LA-NSPV)                                                                                                   
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * COMPUTE THE VARIANCE.                                                                                                       
C                                                                                                                                   
      IF(LA.EQ.NSPV) THEN                                                                                                           
        AVAR=SPVAL                                                                                                                  
      ELSE                                                                                                                          
        ASUM=0.E0                                                                                                                   
        DO 230 I=1,LA                                                                                                               
         IF(ABS(A(I)-SPVAL).GT.SPVALT) THEN                                                                                         
           ADIFF=A(I)-AMEAN                                                                                                         
           ASUM=ASUM+(ADIFF*ADIFF)                                                                                                  
         ENDIF                                                                                                                      
  230   CONTINUE                                                                                                                    
C                                                                                                                                   
        AVAR=ASUM/FLOAT(LA-NSPV)                                                                                                    
      ENDIF                                                                                                                         
      IF (NSPV.EQ.0)THEN                                                                                                            
        WRITE(6,6010) NR,IBUF,AMIN,AMAX,AMEAN,AVAR                                                                                  
      ELSE                                                                                                                          
        WRITE(6,6011) NR,IBUF,AMIN,AMAX,AMEAN,AVAR,NSPV                                                                             
      ENDIF                                                                                                                         
      GO TO 150                                                                                                                     
C                                                                                                                                   
C     * SPECTRAL SECTION.                                                                                                           
C                                                                                                                                   
  410 IF(ND.EQ.1) WRITE(6,6006)                                                                                                     
C                                                                                                                                   
      WRITE(6,6015) NR,IBUF,A(1),A(2),A(3),A(4)                                                                                     
      GO TO 150                                                                                                                     
C---------------------------------------------------------------------                                                              
 6006 FORMAT('0',7X,'KIND',62X,'MIN',11X,'MAX',10X,'MEAN',11X,'VAR'/)                                                               
 6010 FORMAT(I7,1X,A4,I10,2X,A4,I10,2I8,I9,I3,5X,1P4E14.6)                                                                          
 6011 FORMAT(I7,1X,A4,I10,2X,A4,I10,2I8,I9,I3,5X,1P4E14.6,                                                                          
     1     ' NSPVAL=',I10)                                                                                                          
 6012 FORMAT(I7,1X,A4,I10,2X,A4,I10,2I8,I9,I3,'  =',A64)                                                                            
 6013 FORMAT(I7,1X,A4,I10,2X,A4,I10,2I8,I9,I3,'  =',8A8)                                                                            
 6015 FORMAT(I7,1X,A4,I10,2X,A4,I10,2I8,I9,I3,5X,1P4E14.6)                                                                          
 6025 FORMAT('0EXPECTED FILE LENGTH (IN BYTES) IS:',I12)                                                                            
 6030 FORMAT('0 EMPTY OR INVALID FORMAT INPUT FILE!')                                                                               
      END                                                                                                                           
