      PROGRAM BINSML                                                                                                                
C     PROGRAM BINSML(X,       XB,       INPUT,       OUTPUT,            )       H2                                                  
C    1         TAPE1=X, TAPE2=XB, TAPE5=INPUT, TAPE6=OUTPUT)                                                                        
C     -----------------------------------------------------                     H2                                                  
C                                                                               H2                                                  
C     MAY 18/10 - S.KHARIN (RESTRICT YYYYMM TO YYYY CONVERSION FOR "NBIN.GE.12")H2                                                  
C     SEP 21/09 - D.YANG (1. EXTENDED TO WEIGHTED MEAN;                         H2                                                  
C                         2. WHEN NBIN=12, OUTPUT TIMESTEP ONLY CONTAINS YEARS  H2                                                  
C                         3. IGNORED SUPERLABLES)                               H2                                                  
C     JUN 27/05 - F.MAJAESS (SUPPORT AVERAGING OVER ALL (MULTI-LEVEL) RECORDS;                                                      
C                            "NSKP" (MULTI-LEVEL) RECORDS EXCLUDED)                                                                 
C     JAN 26/05 - S.KHARIN (BASED ON BINS)                                                                                          
C                                                                               H2                                                  
CBINSML  - MULTI-LEVEL VERSION OF THE BINNING PROGRAM BINS.             1  1 C  H1                                                  
C                                                                               H3                                                  
CAUTHOR  - S.KHARIN                                                             H3                                                  
C                                                                               H3                                                  
CPURPOSE - MULTI-LEVEL VERSION OF THE BINNING PROGRAM BINS.                     H3                                                  
C          NOTE -X MAY BE REAL OR COMPLEX OR MULTI-LEVEL.                       H3                                                  
C                                                                               H3                                                  
CINPUT FILE...                                                                  H3                                                  
C                                                                               H3                                                  
C      X  = FILE OF REAL OR COMPLEX (MULTI-LEVEL) FIELDS                        H3                                                  
C                                                                               H3                                                  
COUTPUT FILE...                                                                 H3                                                  
C                                                                               H3                                                  
C      XB = AVERAGE OF "NBIN" CONSECUTIVE INPUT RECORDS                         H3                                                  
C                                                                                                                                   
CINPUT PARAMETERS...                                                                                                                
C                                                                               H5                                                  
C      NBIN = NUMBER OF VALUES PER BIN                                          H5                                                  
C             (NBIN=-1; AVERAGE OVER ALL (MULTI-LEVEL) RECORDS;                 H5                                                  
C                       "NSKP" (MULTI-LEVEL) RECORDS EXCLUDED)                  H5                                                  
C      NSKP = SKIP THE FIRST NSKP (MULTI-LEVEL) RECORDS (DEFAULT NSKP=0)        H5                                                  
C      LAST = 0, ALWAYS SAVE THE LAST BIN, EVEN IF IT IS INCOMPLETE (DEFAULT)   H5                                                  
C                OTHERWISE DO NOT SAVE THE LAST INCOMPLETE BIN.                 H5                                                  
C      NWT  = 0, UN-WEIGHTED NEAN.                                              H5                                                  
C           > 0, UMBER OF WEIGHTS (<= 20),                                      H5                                                  
C             E.G. WHEN COMPUTING ANNUAL MEAN FROM MONTHLY MEANS, USE NWT=12    H5                                                  
C             AND 12 WEIGHTS 31 28 31 30 31 30 31 31 30 31 30 31 SPECIFIED IN   H5                                                  
C             THE SECONT INPUT CARD.                                            H5                                                  
C 2ND INPUT CARD (OPTIONAL, ONLY NEEDED IF NWT>0).                              H5                                                  
C      MID  = WEIGHTS, EXPRESSED AS I5 INTEGER NUMBERS (E.G. MONTH LENGTHS).    H5                                                  
C                                                                               H5                                                  
CEXAMPLE OF INPUT CARD...                                                       H5                                                  
C                                                                               H5                                                  
C* BINSML     3                                                                 H5                                                  
C (UNWEIGHTED 3-TIMESTEP BINNING, STARTING FROM RECORD 1)                       H5                                                  
C                                                                               H5                                                  
C* BINSML    12                                                                 H5                                                  
C (UNWEIGHTED 12-TIMESTEP BINNING WITHOUT WEIGHTS)                              H5                                                  
C                                                                               H5                                                  
C* BINSML    -1                                                                 H5                                                  
C (AVERAGE OVER ALL (MULTI-LEVEL) RECORDS)                                      H5                                                  
C                                                                               H5                                                  
C* BINSML     3    2    1                                                       H5                                                  
C (3-TIMESTEP BINNING SKIPPING THE FIRST 2 RECORDS.                             H5                                                  
C  THE FIRST 2 (MULTI-LEVEL) RECORDS ARE SKIPPED.                               H5                                                  
C  DON'T SAVE THE LAST INCOMPLETE BIN.)                                         H5                                                  
C                                                                               H5                                                  
C* BINSML     3    0    1     3                                                 H5                                                  
C            31   30   31                                                       H5                                                  
C (WEIGHTED 3-TIMESTEP BINNING, E.G FOR MAM SEASONAL MEAN COMPUTATION.          H5                                                  
C  WEIGHTS ARE PROPORTIONAL TO INTEGERS IN THE INPUT LINE.                      H5                                                  
C  DON'T SAVE THE LAST INCOMPLETE BIN.)                                         H5                                                  
C                                                                               H5                                                  
C* BINSML    12    0    0   12                                                  H5                                                  
C            31   28   31   30   31   30   31   31   30   31   30   31          H5                                                  
C (12-TIMESTEP BINNING WITH 12 WEIGHTS FOR ANNUAL MEAN COMPUTATIONS.)           H5                                                  
C                                                                               H5                                                  
C* BINSML    -1    0    0    12                                                 H5                                                  
C            31   28   31   30   31   30   31   31   30   31   30   31          H5                                                  
C (WEIGHTED AVERAGE OVER ALL (MULTI-LEVEL) RECORDS.)                            H5                                                  
C                                                                               H5                                                  
C* BINSML     3    2    1    12                                                 H5                                                  
C            31   28   31   30   31   30   31   31   30   31   30   31          H5                                                  
C (WEIGHTED SEASONAL AVERAGES.                                                  H5                                                  
C  THE FIRST 2 (MULTI-LEVEL) RECORDS ARE SKIPPED.                               H5                                                  
C  DON'T SAVE THE LAST INCOMPLETE BIN.)                                         H5                                                  
C----------------------------------------------------------------------------                                                       
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      PARAMETER (IM=193,JM=96,IJM=IM*JM,IJMV=IJM*1)                                                                                 
      PARAMETER (IJMLEV=IJM*100,MIDM=20)                                                                                            
                                                                                                                                    
      REAL A(IJMLEV),B(IJM)                                                                                                         
C                                                                                                                                   
      LOGICAL OK,SPEC                                                                                                               
      COMMON/ICOM/IBUF(8),IDAT(IJMV)                                                                                                
      INTEGER LEV(100),JBUF(8),MID(MIDM)                                                                                            
      DATA MAXX,MAXG,MAXL,MAXRSZ/IJMV,IJMLEV,100,IJM/                                                                               
C---------------------------------------------------------------------                                                              
      NFF=4                                                                                                                         
      CALL JCLPNT(NFF,1,2,5,6)                                                                                                      
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
C                                                                                                                                   
C     * READ INPUT CARD.                                                                                                            
C                                                                                                                                   
      READ(5,5010,END=900) NBIN,NSKP,LAST,NWT                                   H4                                                  
      WRITE(6,6010) NBIN,NSKP,LAST,NWT                                                                                              
      IF((NBIN.LE.0.AND.NBIN.NE.-1)  .OR.                                                                                           
     1                   NWT.LT.0    .OR.                                                                                           
     2   (NWT.GE.0 .AND. NWT.GT.MIDM).OR.                                                                                           
     3                          NSKP.LT.0) CALL    XIT('BINSML',-1)                                                                 
      IF(LAST.EQ.0)THEN                                                                                                             
        WRITE(6,6011)                                                                                                               
      ELSE                                                                                                                          
        WRITE(6,6012)                                                                                                               
      ENDIF                                                                                                                         
      IF(NWT.NE.0) READ(5,5020)(MID(I),I=1,NWT)                                 H4                                                  
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('BINSML',-2)                                                                 
      ENDIF                                                                                                                         
      IF (NLEV.GT.MAXL) CALL                       XIT('BINSML',-3)                                                                 
      KIND=IBUF(1)                                                                                                                  
      NAME=IBUF(3)                                                                                                                  
      NWDS=IBUF(5)*IBUF(6)                                                                                                          
      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('BINSML',-4)                                                                 
      WRITE(6,6030) NAME,NLEV,(LEV(NL),NL=1,NLEV)                                                                                   
      CALL PRTLAB(IBUF)                                                                                                             
      REWIND 1                                                                                                                      
C                                                                                                                                   
C     * SKIP FIRST NSKP (MULTI-LEVEL) RECORDS                                                                                       
C                                                                                                                                   
      DO N=1,NSKP                                                                                                                   
        DO NL=1,NLEV                                                                                                                
          CALL RECGET(1,KIND,-1,-1,LEV(NL),IBUF,MAXX,OK)                                                                            
          IF(.NOT.OK) CALL                         XIT('BINSML',-5)                                                                 
        ENDDO                                                                                                                       
      ENDDO                                                                                                                         
C                                                                                                                                   
C     * READ THE FIRST RECORD IN THE BIN                                                                                            
C                                                                                                                                   
      NR=NSKP                                                                                                                       
      NB=0                                                                                                                          
 100  CONTINUE                                                                                                                      
      DO NL=1,NLEV                                                                                                                  
        IW=(NL-1)*NWDS                                                                                                              
        CALL GETFLD2(1,A(IW+1),KIND,-1,-1,LEV(NL),IBUF,MAXX,OK)                                                                     
        IF(.NOT.OK)THEN                                                                                                             
          IF(NL.NE.1) CALL                         XIT('BINSML',-6)                                                                 
          IF(NR.EQ.NSKP) CALL                      XIT('BINSML',-7)                                                                 
          WRITE(6,6040) NR,NB,NF                                                                                                    
          CALL                                     XIT('BINSML',0)                                                                  
        ENDIF                                                                                                                       
        IF(NR.EQ.NSKP.AND.NL.EQ.1) CALL PRTLAB(IBUF)                                                                                
C       WRITE(6,*) MID(1),NL,LEV(NL)                                                                                                
        IF(NWT.NE.0.AND.NBIN.NE.1) THEN                                                                                             
          WT=FLOAT(MID(1))                                                                                                          
        ELSE                                                                                                                        
          WT=1.                                                                                                                     
        ENDIF                                                                                                                       
        DO I=1,NWDS                                                                                                                 
          A(IW+I)=A(IW+I)*WT                                                                                                        
        ENDDO                                                                                                                       
      ENDDO                                                                                                                         
      DO I=1,8                                                                                                                      
        JBUF(I)=IBUF(I)                                                                                                             
      ENDDO                                                                                                                         
      NR=NR+1                                                                                                                       
      NB=NB+1                                                                                                                       
      NF=1                                                                                                                          
      LWT=1                                                                                                                         
      TWT=WT                                                                                                                        
                                                                                                                                    
C                                                                                                                                   
C     * READ AND ACCUMULATE NBIN (MULTI-LEVEL) RECORDS                                                                              
C                                                                                                                                   
      IF (NBIN.EQ.1) GO TO 110                                                                                                      
 105  CONTINUE                                                                                                                      
      DO NL=1,NLEV                                                                                                                  
        IW=(NL-1)*NWDS                                                                                                              
        CALL GETFLD2(1,B,-1,-1,-1,LEV(NL),IBUF,MAXX,OK)                                                                             
        IF(.NOT.OK) THEN                                                                                                            
          IF(NL.NE.1) CALL                         XIT('BINSML',-8)                                                                 
          GO TO 110                                                                                                                 
        ENDIF                                                                                                                       
C                                                                                                                                   
C       * MAKE SURE THAT THE FIELDS ARE THE SAME KIND AND SIZE.                                                                     
C                                                                                                                                   
        CALL CMPLBL(0,IBUF,0,JBUF,OK)                                                                                               
        IF(.NOT.OK)THEN                                                                                                             
          CALL PRTLAB (IBUF)                                                                                                        
          CALL PRTLAB (JBUF)                                                                                                        
          CALL                                     XIT('BINSML',-9)                                                                 
        ENDIF                                                                                                                       
C       WRITE(6,*)LWT+1,MID(LWT+1)                                                                                                  
                                                                                                                                    
        DO I=1,NWDS                                                                                                                 
          IF(NWT.NE.0) THEN                                                                                                         
            WT=FLOAT(MID(LWT+1))                                                                                                    
          ELSE                                                                                                                      
            WT=1.                                                                                                                   
          ENDIF                                                                                                                     
          A(IW+I)=A(IW+I)+B(I)*WT                                                                                                   
        ENDDO                                                                                                                       
      ENDDO                                                                                                                         
      NF=NF+1                                                                                                                       
      NR=NR+1                                                                                                                       
      IF((LWT+1).LT.NWT) THEN                                                                                                       
        LWT = LWT + 1                                                                                                               
      ELSE                                                                                                                          
        LWT=0                                                                                                                       
      ENDIF                                                                                                                         
      TWT = TWT + WT                                                                                                                
C     WRITE(6,*) TWT                                                                                                                
      IF(NF.LT.NBIN.OR.NBIN.EQ.-1) GO TO 105                                                                                        
C                                                                                                                                   
C     * GET BIN AVERAGE                                                                                                             
C                                                                                                                                   
 110  CONTINUE                                                                                                                      
      IF(NBIN.EQ.-1) NBIN=NF                                                                                                        
      IF(LAST.EQ.0.OR.(LAST.NE.0.AND.NF.EQ.NBIN)) THEN                                                                              
        IF(NBIN.EQ.1) TWT=1.0                                                                                                       
        IF(NWT.NE.0) THEN                                                                                                           
          FAC=1.0E0/TWT                                                                                                             
        ELSE                                                                                                                        
          FAC=1.0E0/FLOAT(NF)                                                                                                       
        ENDIF                                                                                                                       
C       WRITE(6,*) TWT                                                                                                              
        DO NL=1,NLEV                                                                                                                
          IW=(NL-1)*NWDS                                                                                                            
          DO I=1,NWDS                                                                                                               
            A(IW+I)=A(IW+I)*FAC                                                                                                     
          ENDDO                                                                                                                     
C                                                                                                                                   
C         * SAVE THE RESULT WITH IBUF THAT OF THE FIRST                                                                             
C         * RECORD IN THE BIN.                                                                                                      
C                                                                                                                                   
          IF(NWT.EQ.12.AND.(NBIN.EQ.-1.OR.NBIN.GE.12)) THEN                                                                         
            IBUF(2)=JBUF(2)/100                                                                                                     
          ELSE                                                                                                                      
            IBUF(2)=JBUF(2)                                                                                                         
          ENDIF                                                                                                                     
          IBUF(4)=LEV(NL)                                                                                                           
          CALL PUTFLD2(2,A(IW+1),IBUF,MAXX)                                                                                         
        ENDDO                                                                                                                       
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * INFORMATION OUTPUT AT END OF LAST BIN                                                                                       
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                                                                               
        CALL PRTLAB (IBUF)                                                                                                          
        WRITE(6,6040) NR,NB,NF                                                                                                      
        IF(LAST.NE.0.AND.NF.NE.NBIN) WRITE(6,6015)                                                                                  
        CALL                                       XIT('BINSML',0)                                                                  
      ENDIF                                                                                                                         
C                                                                                                                                   
      GO TO 100                                                                                                                     
C                                                                                                                                   
C     * E.O.F. ON INPUT.                                                                                                            
C                                                                                                                                   
 900  CALL                                         XIT('BINSML',-10)                                                                
C---------------------------------------------------------------------                                                              
 5010 FORMAT(10X,4I5)                                                          H4                                                   
 5020 FORMAT(10X,20I5)                                                         H4                                                   
 6010 FORMAT(' BIN SIZE=',I5,'  NSKP=',I5,' LAST=',I5,' LWT=',I2)                                                                   
 6011 FORMAT('LAST BIN WILL BE SAVED EVEN IF IT IS INCOMPLETE.')                                                                    
 6012 FORMAT('LAST BIN WILL BE SAVED ONLY IF IT IS COMPLETE.')                                                                      
 6015 FORMAT('0THE LAST INCOMPLETE BIN IS NOT SAVED.')                                                                              
 6020 FORMAT('0..BIN *** ERROR: INPUT FILE IS EMPTY.')                                                                              
 6030 FORMAT('0NAME =',A4/'0NLEVS =',I5/                                                                                            
     1       '0LEVELS = ',15I6/100(10X,15I6/))                                                                                      
 6040 FORMAT('0BINSML READ',I10,' (MULTI-LEVEL) RECORDS.',                                                                          
     1     ' SAVED',I10,' BINS.   NO. IN LAST BIN=',I5)                                                                             
 6050 FORMAT(' ',A4,2X,A4)                                                                                                          
      END                                                                                                                           
