      PROGRAM MONAVG                                                                                                                
C     PROGRAM MONAVG(XIN,       XOUT,       INPUT,       OUTPUT,        )       C2                                                  
C    1         TAPE1=XIN, TAPE2=XOUT, TAPE5=INPUT, TAPE6=OUTPUT)                                                                    
C     ----------------------------------------------------------                C2                                                  
C                                                                               C2                                                  
C                                                                               C2                                                  
CMONAVG  - CALCULATE MONTHLY MEANS FROM DAILY (MULTI-LEVEL) DATA.       1  1 C  C1                                                  
C                                                                               C3                                                  
CAUTHOR  - S.KHARIN                                                             C3                                                  
C                                                                               C3                                                  
CPURPOSE - CALCULATE MONTHLY MEANS FROM DAILY (MULTI-LEVEL) DATA.               C3                                                  
C          TIME STEP FORMAT MUST BE PROVIDED IN THE INPUT CARD.                 C3                                                  
C                                                                               C3                                                  
CINPUT FILE...                                                                  C3                                                  
C                                                                               C3                                                  
C      XIN  = INPUT FILE WITH DAILY DATA.                                       C3                                                  
C                                                                               C3                                                  
COUTPUT FILE...                                                                 C3                                                  
C                                                                               C3                                                  
C      XOUT = OUTPUT FILE WITH MONTHLY DATA.                                    C3                                                  
C                                                                                                                                   
CINPUT PARAMETERS...                                                                                                                
C                                                                               C5                                                  
C   DATEFMT = TIMESTEP FORMAT OF INPUT DATA:                                    C5                                                  
C               '  YYYYMMDD' OR 'YYYYMMDDHH'                                    C5                                                  
C                                                                               C5                                                  
CEXAMPLE OF INPUT CARD...                                                       C5                                                  
C                                                                               C5                                                  
C*MONAVG  YYYYMMDDHH                                                            C5                                                  
C-----------------------------------------------------------------------------                                                      
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      REAL A(6534100),B(65341)                                                                                                      
      CHARACTER*10 DATEFMT                                                                                                          
C                                                                                                                                   
      LOGICAL OK,SPEC                                                                                                               
      COMMON/ICOM/IBUF(8),IDAT(65341)                                                                                               
      INTEGER LEV(100)                                                                                                              
      DATA MAXX,MAXL,MAXRSZ/65341,100,65341/                                                                                        
      DATA MAXG/6534100/                                                                                                            
C---------------------------------------------------------------------                                                              
      NFF=4                                                                                                                         
      CALL JCLPNT(NFF,1,2,5,6)                                                                                                      
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
C                                                                                                                                   
C     * READ TIME STEP FORMAT FROM CARD.                                                                                            
C                                                                                                                                   
      READ(5,5010,END=900) DATEFMT                                              C4                                                  
      WRITE(6,6010) DATEFMT                                                                                                         
      IF (DATEFMT.EQ.'  YYYYMMDD'.OR.DATEFMT.EQ.'    YYMMDD') THEN                                                                  
        IDIV=100                                                                                                                    
      ELSE IF (DATEFMT.EQ.'YYYYMMDDHH'.OR.DATEFMT.EQ.'  YYMMDDHH') THEN                                                             
        IDIV=10000                                                                                                                  
      ELSE                                                                                                                          
        WRITE(6,6015)                                                                                                               
        CALL                                       XIT('MONAVG',-1)                                                                 
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * FIND THE NUMBER OF LEVELS, TYPE OF DATA, ETC...                                                                             
C                                                                                                                                   
      CALL FILEV(LEV,NLEV,IBUF,1)                                                                                                   
      IF (NLEV.EQ.0) THEN                                                                                                           
        WRITE(6,6020)                                                                                                               
        CALL                                       XIT('MONAVG',-2)                                                                 
      ENDIF                                                                                                                         
      IF (NLEV.GT.MAXL) CALL                       XIT('MONAVG',-3)                                                                 
      KIND=IBUF(1)                                                                                                                  
      NAME=IBUF(3)                                                                                                                  
      NWDS=IBUF(5)*IBUF(6)                                                                                                          
      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('MONAVG',-4)                                                                 
      WRITE(6,6030) NAME,NLEV,(LEV(NL),NL=1,NLEV)                                                                                   
      CALL PRTLAB(IBUF)                                                                                                             
      REWIND 1                                                                                                                      
                                                                                                                                    
      IF(KIND.EQ.NC4TO8("TIME")) CALL              XIT('MONAVG',-5)                                                                 
                                                                                                                                    
C                                                                                                                                   
C     * READ THE FIRST DAY                                                                                                          
C                                                                                                                                   
      NINP=0                                                                                                                        
      NOUT=0                                                                                                                        
      NMON=0                                                                                                                        
      NL1=1                                                                                                                         
 100  CONTINUE                                                                                                                      
      DO NL=NL1,NLEV                                                                                                                
        IW=(NL-1)*NWDS                                                                                                              
        CALL GETFLD2(1,A(IW+1),-1,-1,-1,LEV(NL),IBUF,MAXX,OK)                                                                       
        IF(.NOT.OK) CALL                           XIT('MONAVG',-6)                                                                 
        NINP=NINP+1                                                                                                                 
        IF(NL.EQ.1)THEN                                                                                                             
          IDATE=IBUF(2)/IDIV                                                                                                        
          MON0=MOD(IDATE,100)                                                                                                       
        ENDIF                                                                                                                       
      ENDDO                                                                                                                         
      LMON=1                                                                                                                        
C                                                                                                                                   
C     * READ NEXT DAY                                                                                                               
C                                                                                                                                   
 110  CONTINUE                                                                                                                      
      DO NL=1,NLEV                                                                                                                  
        CALL GETFLD2(1,B,-1,-1,-1,LEV(NL),IBUF,MAXX,OK)                                                                             
        IF(.NOT.OK) THEN                                                                                                            
          IF(NL.NE.1) CALL                         XIT('MONAVG',-7)                                                                 
C                                                                                                                                   
C         * SAVE THE PREVIOUS MONTH AND EXIT                                                                                        
C                                                                                                                                   
          FACT=1.E0/FLOAT(LMON)                                                                                                     
          IBUF(2)=IDATE                                                                                                             
          IBUF(8)=NPACK                                                                                                             
          DO L=1,NLEV                                                                                                               
            IW=(L-1)*NWDS                                                                                                           
            DO I=1,NWDS                                                                                                             
              A(IW+I)=A(IW+I)*FACT                                                                                                  
            ENDDO                                                                                                                   
            IBUF(4)=LEV(L)                                                                                                          
            CALL PUTFLD2(2,A(IW+1),IBUF,MAXX)                                                                                       
            NOUT=NOUT+1                                                                                                             
          ENDDO                                                                                                                     
          NMON=NMON+1                                                                                                               
          CALL PRTLAB(IBUF)                                                                                                         
          WRITE(6,6040) NINP,NOUT,NMON                                                                                              
          CALL                                     XIT('MONAVG',0)                                                                  
        ENDIF                                                                                                                       
                                                                                                                                    
        NINP=NINP+1                                                                                                                 
        IDATE1=IBUF(2)/IDIV                                                                                                         
        MON1=MOD(IDATE1,100)                                                                                                        
                                                                                                                                    
        IF(MON1.EQ.MON0)THEN                                                                                                        
C                                                                                                                                   
C         * ACCUMULATE THE SAME MONTH                                                                                               
C                                                                                                                                   
          IW=(NL-1)*NWDS                                                                                                            
          DO I=1,NWDS                                                                                                               
            A(IW+I)=A(IW+I)+B(I)                                                                                                    
          ENDDO                                                                                                                     
          IF (NL.EQ.1)LMON=LMON+1                                                                                                   
        ELSE                                                                                                                        
C                                                                                                                                   
C         * NEXT MONTH STARTED...                                                                                                   
C                                                                                                                                   
          IF(NL.NE.1) CALL                         XIT('MONAVG',-8)                                                                 
C                                                                                                                                   
C         * SAVE THE PREVIOUS MONTH AND CONTINUE                                                                                    
C                                                                                                                                   
          FACT=1.E0/FLOAT(LMON)                                                                                                     
          IBUF(2)=IDATE                                                                                                             
          IBUF(8)=NPACK                                                                                                             
          DO L=1,NLEV                                                                                                               
            IW=(L-1)*NWDS                                                                                                           
            DO I=1,NWDS                                                                                                             
              A(IW+I)=A(IW+I)*FACT                                                                                                  
            ENDDO                                                                                                                   
            IBUF(4)=LEV(L)                                                                                                          
            CALL PUTFLD2(2,A(IW+1),IBUF,MAXX)                                                                                       
            NOUT=NOUT+1                                                                                                             
          ENDDO                                                                                                                     
          NMON=NMON+1                                                                                                               
          DO I=1,NWDS                                                                                                               
            A(I)=B(I)                                                                                                               
          ENDDO                                                                                                                     
          MON0=MON1                                                                                                                 
          IDATE=IDATE1                                                                                                              
          NL1=2                                                                                                                     
          GOTO 100                                                                                                                  
        ENDIF                                                                                                                       
      ENDDO                                                                                                                         
      GO TO 110                                                                                                                     
C                                                                                                                                   
C     * E.O.F. ON INPUT.                                                                                                            
C                                                                                                                                   
 900  CALL                                         XIT('MONAVG',-9)                                                                 
C---------------------------------------------------------------------                                                              
 5010 FORMAT(10X,1A10)                                                          C4                                                  
 6010 FORMAT('0MONAVG DATE FORMAT=',A10)                                                                                            
 6015 FORMAT('0MONAVG ***ERROR: ILLEGAL INPUT FORMAT.')                                                                             
 6020 FORMAT('0..MONAVG *** ERROR: INPUT FILE IS EMPTY.')                                                                           
 6030 FORMAT('0NAME =',A4/'0NLEVS =',I5/                                                                                            
     1       '0LEVELS = ',15I6/100(10X,15I6/))                                                                                      
 6040 FORMAT('0MONAVG READ  ',I10,' RECORDS.'/                                                                                      
     1       '0MONAVG WROTE ',I10,' RECORDS, ',I10,' MONTHLY MEANS.')                                                               
      END                                                                                                                           
