      PROGRAM STATSAV                                                                                                               
C     PROGRAM STATSAV (MSK,       X1,...,      GP,      XP,      STAT2ND,       C2                                                  
C                                                                OUTPUT)        C2                                                  
C    1           TAPE1=MSK,TAPE10=X1,...,TAPE2=GP,TAPE3=XP,      STAT2ND        C2                                                  
C    2                                                     TAPE6=OUTPUT)        C2                                                  
C     ----------------------------------------------------------------          C2                                                  
C                                                                               C2                                                  
C     JAN 27/14 - F.MAJAESS (INCREASE ARGUMENT STRING LENGTH LIMIT FROM 128     C2                                                  
C                            TO 256 CHARACTERS)                                 C2                                                  
C     NOV 17/08 - S.KHARIN                                                                                                          
C                                                                               C2                                                  
CSTATSAV  - COMPUTES TIME MEANS AND VARIANCES OF INPUT FILES.         200  2    C1                                                  
C                                                                               C3                                                  
CAUTHOR  - S.KHARIN                                                             C3                                                  
C                                                                               C3                                                  
CPURPOSE - COMPUTES TIME MEANS AND VARIANCES OF INPUT FILES.                    C3                                                  
C          THIS FORTRAN PROGRAM IS EQUIVALENT TO SHELL SCRIPT STATSAV.          C3                                                  
C                                                                               C3                                                  
CINPUT FILE...                                                                  C3                                                  
C                                                                               C3                                                  
C  MASK=MSK = (OPTIONAL) USE MASK FILE FMSK (0=MISSING VALUE)                   C3                                                  
C        X1 = TIME SERIES OF THE FIRST VARIABLE.                                C3                                                  
C        X2 = (OPTIONAL) TIME SERIES OF 2ND VARIABLE,                           C3                                                  
C        ...  UP TO 200 INPUT FILES CAN BE SPECIFED.                            C3                                                  
C   STAT2ND = (OPTIONAL SWITCH)                                                 C3                                                  
C           = ON, COMPUTE 2ND ORDER STATISTICS (DEFAULT, IF NOT SPECIFED)       C3                                                  
C           = OFF, DON'T COMPUTE 2ND-ORDER STATISTICS,                          C3                                                  
C           = TIMMAX, COMPUTE TIME MAXIMUM,                                     C3                                                  
C           = TIMMIN, COMPUTE TIME MINIMUM.                                     C3                                                  
C                                                                               C3                                                  
COUTPUT FILE...                                                                 C3                                                  
C                                                                               C3                                                  
C        GP = TIME MEANS AND VARIANCES OF GRIDS.                                C3                                                  
C        XP = ZONAL AVERAGES.                                                   C3                                                  
C                                                                               C3                                                  
CEXAMPLES:                                                                      C3                                                  
C     statsav mask=msk x1 x2 gp xp on                                           C3                                                  
C     statsav  x1 x2 gp xp timmax                                               C3                                                  
C     statsav  x1 x2 gp xp timmin                                               C3                                                  
C-----------------------------------------------------------------------------                                                      
C                                                                                                                                   
                                                                                                                                    
      IMPLICIT NONE                                                                                                                 
                                                                                                                                    
      REAL XAVG(6534100),XVAR(6534100),FMSK(6534100),                                                                               
     +     X(65341),F(65341),GAVG(100),GMSK(100),                                                                                   
     +     ZX(36100),ZX2(36100),ZXV(36100)                                                                                          
      REAL ZXJ,ZDJ,ZVJ                                                                                                              
                                                                                                                                    
      INTEGER IARG,NARGS,I,J,I1,I2,IJ,IL,NINP,L,NLEV,NSETS,K,LEN,                                                                   
     +     NLG,NLGM,NLAT,NWDS,N                                                                                                     
      INTEGER KIND,NC4TO8,NPACK,LFILE,NAME,IOS                                                                                      
                                                                                                                                    
                                                                                                                                    
C     * SET IN "NARGSMAX" THE MAXIMUM NUMBER OF ARGUMENTS WHICH CAN                                                                 
C     * BE PROCESSED FROM THE COMMAND LINE.                                                                                         
                                                                                                                                    
      INTEGER NARGSMAX                                                                                                              
      PARAMETER (NARGSMAX=204)                                                                                                      
      INTEGER*4 IARGC,I4                                                                                                            
      CHARACTER*256 ARG(NARGSMAX),FILE,LABL                                                                                         
      CHARACTER*3 RCM                                                                                                               
                                                                                                                                    
      LOGICAL OK,SPEC,LMASK,LTIMMAX,LTIMMIN,LTIMVAR                                                                                 
      INTEGER LEV(100),JBUF(8)                                                                                                      
                                                                                                                                    
      INTEGER IBUF,IDAT                                                                                                             
      COMMON/ICOM/IBUF(8),IDAT(65341)                                                                                               
                                                                                                                                    
      INTEGER IBL(28)                                                                                                               
      CHARACTER SLABL*80                                                                                                            
      EQUIVALENCE (IBL(9),SLABL)                                                                                                    
                                                                                                                                    
      INTEGER MACHINE,INTSIZE,ME32O64,INTEFLT,IDUMMY                                                                                
      COMMON /MACHTYP/ MACHINE,INTSIZE                                                                                              
                                                                                                                                    
      INTEGER MAXX,MAXG,MAXL,MAXRSZ                                                                                                 
      DATA MAXX,MAXG,MAXL /65341,6534100,100/                                                                                       
      DATA MAXRSZ /65341/                                                                                                           
C---------------------------------------------------------------------                                                              
C                                                                                                                                   
C     * DETERMINE THE MACHINE TYPE.                                                                                                 
C                                                                                                                                   
      MACHINE = ME32O64(IDUMMY)                                                                                                     
      INTSIZE = INTEFLT(IDUMMY)                                                                                                     
                                                                                                                                    
C     * PARSE THE COMMAND LINE                                                                                                      
                                                                                                                                    
      NARGS=IARGC()                                                                                                                 
C     WRITE(6,*)'NARGS=',NARGS                                                                                                      
      IF(NARGS.GT.NARGSMAX) CALL                   XIT('STATSAV',-1)                                                                
      DO I=1,NARGS                                                                                                                  
        I4=I                                                                                                                        
        CALL GETARG(I4,ARG(I))                                                                                                      
      ENDDO                                                                                                                         
                                                                                                                                    
C     * GET "rcm" ENVIRONMENT VARIABLE SETTING                                                                                      
                                                                                                                                    
      CALL GETENV('rcm',RCM)                                                                                                        
      IF(RCM.EQ.' on' ) RCM='on '                                                                                                   
C     WRITE(6,*)'RCM=',RCM                                                                                                          
                                                                                                                                    
C     * CHECK FOR MASK FILE                                                                                                         
C                                                                                                                                   
      I1=1                                                                                                                          
      LMASK=.FALSE.                                                                                                                 
      IF(ARG(1)(1:5).EQ.'mask=')THEN                                                                                                
        LFILE=LEN_TRIM(ARG(1))                                                                                                      
        OPEN(1,FILE=ARG(1)(6:LFILE), FORM='UNFORMATTED')                                                                            
        REWIND 1                                                                                                                    
        I1=I1+1                                                                                                                     
        LMASK=.TRUE.                                                                                                                
        WRITE(6,'(2A)')' MASK=',ARG(1)(6:LFILE)                                                                                     
      ENDIF                                                                                                                         
      WRITE(6,'(A,L1)')' LMASK=',LMASK                                                                                              
C                                                                                                                                   
C     * CHECK FOR THE LAST STAT2ND SWITCH                                                                                           
C                                                                                                                                   
      I2=NARGS                                                                                                                      
      LTIMVAR=.TRUE.                                                                                                                
      LTIMMAX=.FALSE.                                                                                                               
      LTIMMIN=.FALSE.                                                                                                               
      IF(ARG(NARGS).EQ.'on')THEN                                                                                                    
        I2=NARGS-1                                                                                                                  
      ELSEIF(ARG(NARGS).EQ.'off')THEN                                                                                               
        LTIMVAR=.FALSE.                                                                                                             
        I2=NARGS-1                                                                                                                  
      ELSEIF(ARG(NARGS).EQ.'timmax')THEN                                                                                            
        LTIMMAX=.TRUE.                                                                                                              
        LTIMVAR=.FALSE.                                                                                                             
        I2=NARGS-1                                                                                                                  
      ELSEIF(ARG(NARGS).EQ.'timmin')THEN                                                                                            
        LTIMMIN=.TRUE.                                                                                                              
        LTIMVAR=.FALSE.                                                                                                             
        I2=NARGS-1                                                                                                                  
      ENDIF                                                                                                                         
      WRITE(6,'(A,L1)')' LTIMVAR=',LTIMVAR                                                                                          
      WRITE(6,'(A,L1)')' LTIMMAX=',LTIMMAX                                                                                          
      WRITE(6,'(A,L1)')' LTIMMIN=',LTIMMIN                                                                                          
C                                                                                                                                   
C     * THERE SHOULD BE AT LEAST THREE FILES ON THE COMMAND LINE                                                                    
C                                                                                                                                   
      IF(I2-I1+1.LT.3) CALL                        XIT('STATSAV',-2)                                                                
      NINP=I2-I1-1                                                                                                                  
      WRITE(6,'(A,I3)')' NINP=',NINP                                                                                                
C                                                                                                                                   
C     * THE LAST TWO FILES ARE GP AND XP                                                                                            
C     * (OPEN IN APPEND MODE)                                                                                                       
C                                                                                                                                   
      WRITE(6,'(2A)')' GP=',ARG(I2-1)                                                                                               
      WRITE(6,'(2A)')' XP=',ARG(I2)                                                                                                 
      CALL OFAPPND(2,ARG(I2-1),'UNFORMATTED',IOS)                                                                                   
      IF(RCM(1:2).NE.'on')THEN                                                                                                      
        CALL OFAPPND(3,ARG(I2),'UNFORMATTED',IOS)                                                                                   
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * THE REMAINING FILES ARE INPUT FILES                                                                                         
C                                                                                                                                   
      DO IARG=1,NINP                                                                                                                
        FILE=ARG(IARG+I1-1)                                                                                                         
        WRITE(6,'(2A)')' PROCESS FILE=',FILE                                                                                        
        OPEN(10,FILE=FILE,FORM='UNFORMATTED')                                                                                       
        REWIND 10                                                                                                                   
C                                                                                                                                   
C       * FIND THE NUMBER OF LEVELS, TYPE OF DATA, ETC...                                                                           
C                                                                                                                                   
        CALL FILEV(LEV,NLEV,IBUF,10)                                                                                                
        CALL PRTLAB(IBUF)                                                                                                           
        IF (NLEV.EQ.0) THEN                                                                                                         
          WRITE(6,6010)                                                                                                             
          CALL                                     XIT('STATSAV',-3)                                                                
        ENDIF                                                                                                                       
        IF (NLEV.GT.MAXL) CALL                     XIT('STATSAV',-4)                                                                
        NLG=IBUF(5)                                                                                                                 
        NLAT=IBUF(6)                                                                                                                
        NLGM=NLG-1                                                                                                                  
        NWDS=NLG*NLAT                                                                                                               
        KIND=IBUF(1)                                                                                                                
        IF (KIND.EQ.NC4TO8("TIME")) CALL           XIT('STATSAV',-5)                                                                
        NAME=IBUF(3)                                                                                                                
        WRITE(6,6020) NAME,NLEV,(LEV(L),L=1,NLEV)                                                                                   
        NPACK=MIN(2,IBUF(8))                                                                                                        
        SPEC=(KIND.EQ.NC4TO8("FOUR").OR.KIND.EQ.NC4TO8("SPEC"))                                                                     
        IF (SPEC) NWDS=NWDS*2                                                                                                       
        IF (NWDS.GT.MAXRSZ.OR.NWDS*NLEV.GT.MAXG)                                                                                    
     +       CALL                                  XIT('STATSAV',-6)                                                                
        DO I=1,8                                                                                                                    
          JBUF(I)=IBUF(I)                                                                                                           
        ENDDO                                                                                                                       
C                                                                                                                                   
C       * REWIND MASK FOR EACH INPUT FILE                                                                                           
C                                                                                                                                   
        IF(LMASK) REWIND 1                                                                                                          
C                                                                                                                                   
C       * READ THE FIRST TIME STEP.                                                                                                 
C                                                                                                                                   
        DO L=1,NLEV                                                                                                                 
          IJ=(L-1)*NWDS                                                                                                             
          CALL GETFLD2(10,XAVG(IJ+1),-1,-1,-1,LEV(L),IBUF,MAXX,OK)                                                                  
          IF (.NOT.OK) THEN                                                                                                         
C                                                                                                                                   
C           * SET IN INPUT FILE IS NOT COMPLETE. ABORT.                                                                             
C                                                                                                                                   
            CALL PRTLAB (IBUF)                                                                                                      
            WRITE(6,6050) IBUF(3),LEV(L)                                                                                            
            CALL                                   XIT('STATSAV',-7)                                                                
          ENDIF                                                                                                                     
C                                                                                                                                   
C         * MAKE SURE THAT ALL RECORDS HAVE THE SAME NAME, KIND AND DIMENSIONS                                                      
C                                                                                                                                   
          CALL CMPLBL(0,IBUF,0,JBUF,OK)                                                                                             
          IF (.NOT.OK .OR. IBUF(3).NE.JBUF(3)) THEN                                                                                 
            CALL PRTLAB (IBUF)                                                                                                      
            CALL PRTLAB (JBUF)                                                                                                      
            CALL                                   XIT('STATSAV',-8)                                                                
          ENDIF                                                                                                                     
          NPACK=MIN(NPACK,IBUF(8))                                                                                                  
C                                                                                                                                   
C         * READ MASK                                                                                                               
C                                                                                                                                   
          IF(LMASK)THEN                                                                                                             
            CALL GETFLD2(1,FMSK(IJ+1),-1,-1,-1,LEV(L),IBUF,MAXX,OK)                                                                 
            IF (.NOT.OK) THEN                                                                                                       
C                                                                                                                                   
C             * SET IN INPUT FILE IS NOT COMPLETE. ABORT.                                                                           
C                                                                                                                                   
              CALL PRTLAB (IBUF)                                                                                                    
              WRITE(6,6050) IBUF(3),LEV(L)                                                                                          
              CALL                                 XIT('STATSAV',-9)                                                                
            ENDIF                                                                                                                   
C                                                                                                                                   
C           * MAKE SURE THAT MASK HAVE THE SAME KIND AND DIMENSIONS                                                                 
C                                                                                                                                   
            CALL CMPLBL(0,IBUF,0,JBUF,OK)                                                                                           
            IF (.NOT.OK) THEN                                                                                                       
              CALL PRTLAB (IBUF)                                                                                                    
              CALL PRTLAB (JBUF)                                                                                                    
              CALL                                 XIT('STATSAV',-10)                                                               
            ENDIF                                                                                                                   
C                                                                                                                                   
C           * APPLY MASK                                                                                                            
C                                                                                                                                   
            DO I=1,NWDS                                                                                                             
              XAVG(IJ+I)=XAVG(IJ+I)*FMSK(IJ+I)                                                                                      
            ENDDO                                                                                                                   
          ELSE                  ! LMASK                                                                                             
            DO I=1,NWDS                                                                                                             
              FMSK(IJ+I)=1.E0                                                                                                       
            ENDDO                                                                                                                   
          ENDIF                 ! LMASK                                                                                             
C                                                                                                                                   
C         * CALCULATE THE AVERAGED VALUE AT EACH LEVEL FOR THE FIRST SET.                                                           
C         * WE SUBSTRACT THIS VALUE FROM ALL OTHER FIELDS TO INCREASE NUMERICAL                                                     
C         * ACCURACY OF VARIANCE COMPUTATIONS.                                                                                      
C                                                                                                                                   
          IF (LTIMVAR) THEN                                                                                                         
            GAVG(L)=0.E0                                                                                                            
            GMSK(L)=0.E0                                                                                                            
            DO I=1,NWDS                                                                                                             
              GAVG(L)=GAVG(L)+XAVG(IJ+I)                                                                                            
              GMSK(L)=GMSK(L)+FMSK(IJ+I)                                                                                            
            ENDDO                                                                                                                   
            IF(GMSK(L).GT.0.E0)THEN                                                                                                 
              GAVG(L)=GAVG(L)/GMSK(L)                                                                                               
            ENDIF                                                                                                                   
            DO I=1,NWDS                                                                                                             
              XVAR(IJ+I)=(XAVG(IJ+I)-GAVG(L))**2*FMSK(IJ+I)                                                                         
            ENDDO                                                                                                                   
          ENDIF                                                                                                                     
        ENDDO                   ! NLEV                                                                                              
C                                                                                                                                   
C       * TIMESTEP AND LEVEL LOOPS.                                                                                                 
C                                                                                                                                   
        NSETS=1                                                                                                                     
 200    CONTINUE                                                                                                                    
        DO L=1,NLEV                                                                                                                 
          IJ=(L-1)*NWDS                                                                                                             
C                                                                                                                                   
C         * GET THE NEXT FIELD AND CHECK THE LABEL.                                                                                 
C                                                                                                                                   
          CALL GETFLD2(10,X,-1,-1,-1,LEV(L),IBUF,MAXX,OK)                                                                           
          IF (.NOT.OK) THEN                                                                                                         
            IF (L.EQ.1) GO TO 300                                                                                                   
C                                                                                                                                   
C           * SET IN FILE 10 IS NOT COMPLETE. ABORT.                                                                                
C                                                                                                                                   
            CALL PRTLAB (IBUF)                                                                                                      
            WRITE(6,6050) NAME,LEV(L)                                                                                               
            CALL                                   XIT('STATSAV',-11)                                                               
          ENDIF                                                                                                                     
C                                                                                                                                   
C         * MAKE SURE THAT ALL RECORDS HAVE THE SAME NAME, KIND AND DIMENSIONS                                                      
C                                                                                                                                   
          CALL CMPLBL(0,IBUF,0,JBUF,OK)                                                                                             
          IF (.NOT.OK .OR. IBUF(3).NE.JBUF(3)) THEN                                                                                 
            CALL PRTLAB (IBUF)                                                                                                      
            CALL PRTLAB (JBUF)                                                                                                      
            CALL                                   XIT('STATSAV',-12)                                                               
          ENDIF                                                                                                                     
          NPACK=MIN(NPACK,IBUF(8))                                                                                                  
C                                                                                                                                   
C         * GET THE NEXT MASK AND CHECK THE LABEL.                                                                                  
C                                                                                                                                   
          IF(LMASK) THEN                                                                                                            
            CALL GETFLD2(1,F,-1,-1,-1,LEV(L),IBUF,MAXX,OK)                                                                          
            IF (.NOT.OK) THEN                                                                                                       
C                                                                                                                                   
C             * SET IN FILE 1 IS NOT COMPLETE. ABORT.                                                                               
C                                                                                                                                   
              CALL PRTLAB (IBUF)                                                                                                    
              WRITE(6,6050) NAME,LEV(L)                                                                                             
              CALL                                 XIT('STATSAV',-13)                                                               
            ENDIF                                                                                                                   
C                                                                                                                                   
C           * MAKE SURE THAT ALL RECORDS HAVE THE SAME KIND AND DIMENSIONS                                                          
C                                                                                                                                   
            CALL CMPLBL(0,IBUF,0,JBUF,OK)                                                                                           
            IF (.NOT.OK) THEN                                                                                                       
              CALL PRTLAB (IBUF)                                                                                                    
              CALL PRTLAB (JBUF)                                                                                                    
              CALL                                 XIT('STATSAV',-14)                                                               
            ENDIF                                                                                                                   
          ELSE                                                                                                                      
            DO I=1,NWDS                                                                                                             
              F(I)=1.E0                                                                                                             
            ENDDO                                                                                                                   
          ENDIF                 ! LMASK                                                                                             
C                                                                                                                                   
C         * FIND MAXIMUM                                                                                                            
C                                                                                                                                   
          IF(LTIMMAX)THEN                                                                                                           
            DO I=1,NWDS                                                                                                             
              IF(X(I).GT.XAVG(IJ+I))XAVG(IJ+I)=X(I)                                                                                 
            ENDDO                                                                                                                   
          ELSE IF(LTIMMIN)THEN                                                                                                      
C                                                                                                                                   
C           * FIND MINIMUM                                                                                                          
C                                                                                                                                   
            DO I=1,NWDS                                                                                                             
              IF(X(I).LT.XAVG(IJ+I))XAVG(IJ+I)=X(I)                                                                                 
            ENDDO                                                                                                                   
          ELSE                                                                                                                      
C                                                                                                                                   
C           * CALCULATE THE TIME AVERAGE BY ACCUMULATING THE CURRENT FIELD.                                                         
C                                                                                                                                   
            DO I=1,NWDS                                                                                                             
              XAVG(IJ+I)=XAVG(IJ+I)+X(I)*F(I)                                                                                       
              FMSK(IJ+I)=FMSK(IJ+I)+F(I)                                                                                            
            ENDDO                                                                                                                   
C                                                                                                                                   
C           * ACCUMULATE SQUARED FIELDS                                                                                             
C                                                                                                                                   
            IF(LTIMVAR) THEN                                                                                                        
              DO I=1,NWDS                                                                                                           
                XVAR(IJ+I)=XVAR(IJ+I)+(X(I)-GAVG(L))**2*F(I)                                                                        
              ENDDO                                                                                                                 
            ENDIF                                                                                                                   
          ENDIF                                                                                                                     
        ENDDO                                                                                                                       
        NSETS=NSETS+1                                                                                                               
        GO TO 200                                                                                                                   
 300    CONTINUE                                                                                                                    
C                                                                                                                                   
C       * COMPLETE TIME MEAN CALCULATIONS                                                                                           
C                                                                                                                                   
        DO L=1,NLEV                                                                                                                 
          IJ=(L-1)*NWDS                                                                                                             
          IL=(L-1)*NLAT                                                                                                             
          DO I=1,NWDS                                                                                                               
            IF(FMSK(IJ+I).GT.0.E0)THEN                                                                                              
              XAVG(IJ+I)=XAVG(IJ+I)/FMSK(IJ+I)                                                                                      
            ENDIF                                                                                                                   
          ENDDO                                                                                                                     
C                                                                                                                                   
C         * ZONAL AVERAGES                                                                                                          
C                                                                                                                                   
          IF(RCM(1:2).NE.'on')THEN                                                                                                  
            DO J=1,NLAT                                                                                                             
              ZDJ=0.E0                                                                                                              
              ZXJ=0.E0                                                                                                              
              N=(J-1)*NLG                                                                                                           
              DO I=1,NLGM                                                                                                           
                ZDJ=ZDJ+FMSK(IJ+N+I)                                                                                                
                ZXJ=ZXJ+XAVG(IJ+N+I)*FMSK(IJ+N+I)                                                                                   
              ENDDO                                                                                                                 
              IF(ZDJ.GT.0.E0)THEN                                                                                                   
                ZX(IL+J)=ZXJ/ZDJ                                                                                                    
              ELSE                                                                                                                  
                ZX(IL+J)=0.E0                                                                                                       
              ENDIF                                                                                                                 
            ENDDO                                                                                                                   
          ENDIF                                                                                                                     
          IF(LTIMVAR)THEN                                                                                                           
C                                                                                                                                   
C           * COMPLETE VARIANCE CALCULATIONS                                                                                        
C                                                                                                                                   
            DO I=1,NWDS                                                                                                             
              IF(FMSK(IJ+I).GT.0.E0)THEN                                                                                            
                XVAR(IJ+I)=MAX(0.E0,XVAR(IJ+I)/FMSK(IJ+I)-                                                                          
     +               (XAVG(IJ+I)-GAVG(L))**2)                                                                                       
              ENDIF                                                                                                                 
            ENDDO                                                                                                                   
            IF(RCM(1:2).NE.'on')THEN                                                                                                
C                                                                                                                                   
C             * ZONAL AVERAGE OF VARIANCE AND STATIONARY EDDIES                                                                     
C                                                                                                                                   
              DO J=1,NLAT                                                                                                           
                ZDJ=0.E0                                                                                                            
                ZXJ=0.E0                                                                                                            
                ZVJ=0.E0                                                                                                            
                N=(J-1)*NLG                                                                                                         
                DO I=1,NLGM                                                                                                         
                  ZDJ=ZDJ+FMSK(IJ+N+I)                                                                                              
                  ZXJ=ZXJ+XVAR(IJ+N+I)*FMSK(IJ+N+I)                                                                                 
                  ZVJ=ZVJ+(XAVG(IJ+N+I)-ZX(IL+J))**2*FMSK(IJ+N+I)                                                                   
                ENDDO                                                                                                               
                IF(ZDJ.GT.0.E0)THEN                                                                                                 
                  ZXV(IL+J)=ZXJ/ZDJ                                                                                                 
                  ZX2(IL+J)=ZVJ/ZDJ                                                                                                 
                ELSE                                                                                                                
                  ZXV(IL+J)=0.E0                                                                                                    
                  ZX2(IL+J)=0.E0                                                                                                    
                ENDIF                                                                                                               
              ENDDO                                                                                                                 
            ENDIF                                                                                                                   
          ENDIF                 ! LTIMVAR                                                                                           
        ENDDO                   ! NLEV                                                                                              
C                                                                                                                                   
C       * SAVE STATISTICS                                                                                                           
C                                                                                                                                   
        IBUF(2)=NSETS                                                                                                               
        LFILE=LEN_TRIM(FILE)                                                                                                        
        IF (LFILE.EQ.1)THEN                                                                                                         
          LABL='   '//FILE(1:1)                                                                                                     
        ELSEIF(LFILE.EQ.2)THEN                                                                                                      
          LABL='  '//FILE(1:2)                                                                                                      
        ELSEIF(LFILE.EQ.3)THEN                                                                                                      
          LABL=' '//FILE(1:3)                                                                                                       
        ELSE                                                                                                                        
          LABL=FILE((LFILE-3):LFILE)                                                                                                
        ENDIF                                                                                                                       
        CALL LWRTUPR(LABL,4)                                                                                                        
        READ(LABL,'(A4)')IBUF(3)                                                                                                    
        IBUF(8)=NPACK                                                                                                               
        CALL SETLAB(IBL,NC4TO8("LABL"),0,NC4TO8("LABL"),0,10,1,0,1)                                                                 
        IF(LTIMMAX)THEN                                                                                                             
C                                                                                                                                   
C         * SAVE TIME MAXIMUM                                                                                                       
C                                                                                                                                   
          SLABL='    TIME MAXIMUM '//FILE                                                                                           
          CALL FBUFOUT(2,IBL,10*MACHINE+8,K)                                                                                        
          DO L=1,NLEV                                                                                                               
            IJ=(L-1)*NWDS                                                                                                           
            CALL PUTFLD2(2,XAVG(IJ+1),IBUF,MAXX)                                                                                    
          ENDDO                                                                                                                     
          IF(RCM(1:2).NE.'on')THEN                                                                                                  
C                                                                                                                                   
C         * SAVE ZONAL AVERAGE OF TIME MINIMUM                                                                                      
C                                                                                                                                   
            CALL SETLAB(IBUF,NC4TO8("ZONL"),-1,-1,-1,NLAT,1,-1,NPACK)                                                               
            SLABL='    (TIME MAXIMUM '//FILE(1:LFILE)//')'                                                                          
            CALL FBUFOUT(3,IBL,10*MACHINE+8,K)                                                                                      
            DO L=1,NLEV                                                                                                             
              IL=(L-1)*NLAT                                                                                                         
              IBUF(4)=LEV(L)                                                                                                        
              CALL PUTFLD2(3,ZX(IL+1),IBUF,MAXX)                                                                                    
            ENDDO                                                                                                                   
          ENDIF                                                                                                                     
        ELSEIF(LTIMMIN)THEN                                                                                                         
C                                                                                                                                   
C         * SAVE TIME MINIMUM                                                                                                       
C                                                                                                                                   
          SLABL='    TIME MINIMUM '//FILE                                                                                           
          CALL FBUFOUT(2,IBL,10*MACHINE+8,K)                                                                                        
          DO L=1,NLEV                                                                                                               
            IJ=(L-1)*NWDS                                                                                                           
            CALL PUTFLD2(2,XAVG(IJ+1),IBUF,MAXX)                                                                                    
          ENDDO                                                                                                                     
          IF(RCM(1:2).NE.'on')THEN                                                                                                  
C                                                                                                                                   
C         * SAVE ZONAL AVERAGE OF TIME MINIMUM                                                                                      
C                                                                                                                                   
            CALL SETLAB(IBUF,NC4TO8("ZONL"),-1,-1,-1,NLAT,1,-1,NPACK)                                                               
            SLABL='    (TIME MINIMUM '//FILE(1:LFILE)//')'                                                                          
            CALL FBUFOUT(3,IBL,10*MACHINE+8,K)                                                                                      
            DO L=1,NLEV                                                                                                             
              IL=(L-1)*NLAT                                                                                                         
              IBUF(4)=LEV(L)                                                                                                        
              CALL PUTFLD2(3,ZX(IL+1),IBUF,MAXX)                                                                                    
            ENDDO                                                                                                                   
          ENDIF                                                                                                                     
        ELSE                                                                                                                        
C                                                                                                                                   
C         * SAVE TIME MEAN                                                                                                          
C                                                                                                                                   
          SLABL='    '//FILE                                                                                                        
          CALL FBUFOUT(2,IBL,10*MACHINE+8,K)                                                                                        
          DO L=1,NLEV                                                                                                               
            IJ=(L-1)*NWDS                                                                                                           
            IBUF(4)=LEV(L)                                                                                                          
            CALL PUTFLD2(2,XAVG(IJ+1),IBUF,MAXX)                                                                                    
          ENDDO                                                                                                                     
C                                                                                                                                   
C         * SAVE VARIANCE                                                                                                           
C                                                                                                                                   
          IF(LTIMVAR)THEN                                                                                                           
            SLABL='    '//FILE(1:LFILE)//'"2'                                                                                       
            CALL FBUFOUT(2,IBL,10*MACHINE+8,K)                                                                                      
            DO L=1,NLEV                                                                                                             
              IJ=(L-1)*NWDS                                                                                                         
              IBUF(4)=LEV(L)                                                                                                        
              CALL PUTFLD2(2,XVAR(IJ+1),IBUF,MAXX)                                                                                  
            ENDDO                                                                                                                   
          ENDIF                                                                                                                     
          IF(RCM(1:2).NE.'on')THEN                                                                                                  
C                                                                                                                                   
C           * SAVE ZONAL AVERAGE OF TIME MEAN                                                                                       
C                                                                                                                                   
            CALL SETLAB(IBUF,NC4TO8("ZONL"),-1,-1,-1,NLAT,1,-1,NPACK)                                                               
            SLABL='    ('//FILE(1:LFILE)//')'                                                                                       
            CALL FBUFOUT(3,IBL,10*MACHINE+8,K)                                                                                      
            DO L=1,NLEV                                                                                                             
              IL=(L-1)*NLAT                                                                                                         
              IBUF(4)=LEV(L)                                                                                                        
              CALL PUTFLD2(3,ZX(IL+1),IBUF,MAXX)                                                                                    
            ENDDO                                                                                                                   
            IF(LTIMVAR)THEN                                                                                                         
C                                                                                                                                   
C             * SAVE ZONAL AVERAGE OF VARIANCE                                                                                      
C                                                                                                                                   
              CALL SETLAB(IBUF,NC4TO8("ZONL"),-1,-1,-1,NLAT,1,-1,NPACK)                                                             
              SLABL='    ('//FILE(1:LFILE)//'"2)'                                                                                   
              CALL FBUFOUT(3,IBL,10*MACHINE+8,K)                                                                                    
              DO L=1,NLEV                                                                                                           
                IL=(L-1)*NLAT                                                                                                       
                IBUF(4)=LEV(L)                                                                                                      
                CALL PUTFLD2(3,ZXV(IL+1),IBUF,MAXX)                                                                                 
              ENDDO                                                                                                                 
C                                                                                                                                   
C             * SAVE ZONAL STATIONARY EDDIES                                                                                        
C                                                                                                                                   
              CALL SETLAB(IBUF,NC4TO8("ZONL"),-1,-1,-1,NLAT,1,-1,NPACK)                                                             
              SLABL='    ('//FILE(1:LFILE)//'*2)'                                                                                   
              CALL FBUFOUT(3,IBL,10*MACHINE+8,K)                                                                                    
              DO L=1,NLEV                                                                                                           
                IL=(L-1)*NLAT                                                                                                       
                IBUF(4)=LEV(L)                                                                                                      
                CALL PUTFLD2(3,ZX2(IL+1),IBUF,MAXX)                                                                                 
              ENDDO                                                                                                                 
            ENDIF                                                                                                                   
          ENDIF                                                                                                                     
        ENDIF                                                                                                                       
        WRITE(6,6060) NSETS,NAME                                                                                                    
        CALL PRTLAB (IBUF)                                                                                                          
        CLOSE (10)                                                                                                                  
      ENDDO                                                                                                                         
C                                                                                                                                   
C     * NORMAL EXIT.                                                                                                                
C                                                                                                                                   
      CALL                                         XIT('STATSAV',0)                                                                 
                                                                                                                                    
C---------------------------------------------------------------------                                                              
 6010 FORMAT(' ..STATSAV INPUT FILE IS EMPTY')                                                                                      
 6020 FORMAT(' NAME =',A4/' NLEVS =',I5/                                                                                            
     1     ' LEVELS = ',15I6/100(10X,15I6/))                                                                                        
 6050 FORMAT(' ..STATSAV INPUT ERROR - NAME,L=',2X,A4,I5)                                                                           
 6060 FORMAT(' STATSAV PROCESSED ',I10,' SETS OF ',A4)                                                                              
      END                                                                                                                           
