      PROGRAM BINS                                                                                                                  
C     PROGRAM BINS (X,       XB,       INPUT,       OUTPUT,             )       H2                                                  
C    1        TAPE1=X, TAPE2=XB, TAPE5=INPUT, TAPE6=OUTPUT)                                                                         
C     -----------------------------------------------------                     H2                                                  
C                                                                               H2                                                  
C     JUN 27/05 - F.MAJAESS (SUPPORT AVERAGING OVER ALL THE RECORDS)            H2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)                                                           
C     JAN 29/92 - E. CHAN  (CONVERT HOLLERITH LITERALS TO ASCII)                                                                    
C     JAN   /91 - G.J.B. - ALLOW BIN SIZE OF 1 (IE NO CHANGE TO FILE)                                                               
C     NOV   /85 - G.J.BOER                                                                                                          
C                                                                               H2                                                  
CBINS    - SIMPLE BINNING PROGRAM                                       1  1 C  H1                                                  
C                                                                               H3                                                  
CAUTHOR  - G.J.BOER                                                             H3                                                  
C                                                                               H3                                                  
CPURPOSE - SIMPLE BINNING PROGRAM                                               H3                                                  
C          NOTE -  X AND XB MAY BE BOTH REAL OR COMPLEX.                        H3                                                  
C                                                                               H3                                                  
CINPUT FILES...                                                                 H3                                                  
C                                                                               H3                                                  
C      X  = FILE OF REAL OR COMPLEX FIELDS                                      H3                                                  
C                                                                               H3                                                  
COUTPUT FILES...                                                                H3                                                  
C                                                                               H3                                                  
C      XB = AVERAGE OF "NBIN" CONSEQUTIVE INPUT VALUES                          H3                                                  
C                                                                                                                                   
CINPUT PARAMETER...                                                                                                                 
C                                                                               H5                                                  
C      NBIN = NUMBER OF VALUES PER BIN (NBIN=1 NO CHANGE TO FILE)               H5                                                  
C             (NBIN=-1; AVERAGE OVER ALL THE RECORDS IN FILE "X")               H5                                                  
C                                                                               H5                                                  
CEXAMPLE OF INPUT CARD...                                                       H5                                                  
C                                                                               H5                                                  
C* BINS       3                                                                 H5                                                  
C----------------------------------------------------------------------------                                                       
C                                                                                                                                   
C                                                                                                                                   
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      COMMON/BLANCK/A(18528),B(18528)                                                                                               
C                                                                                                                                   
      LOGICAL OK,SPEC                                                                                                               
      COMMON/ICOM/IBUF(8),IDAT(18528)                                                                                               
      COMMON/JCOM/JBUF(8),JDAT(18528)                                                                                               
      DATA MAXX/18528/                                                                                                              
C---------------------------------------------------------------------                                                              
      NFF=4                                                                                                                         
      CALL JCLPNT(NFF,1,2,5,6)                                                                                                      
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
C                                                                                                                                   
C     * READ NUMBER OF VALUES PER BIN FROM CARD.                                                                                    
C     * IF NBIN=1 THEN FILE UNCHANGED.                                                                                              
C                                                                                                                                   
      READ(5,5010,END=900) NBIN                                                 H4                                                  
      WRITE(6,6005) NBIN                                                                                                            
      IF(NBIN.LE.0.AND.NBIN.NE.-1) CALL            XIT('BINS',-1)                                                                   
C                                                                                                                                   
      IF(NBIN.EQ.1) GOTO 300                                                                                                        
C                                                                                                                                   
      NR=0                                                                                                                          
      NB=0                                                                                                                          
C                                                                                                                                   
C     * READ THE FIRST RECORD IN THE BIN                                                                                            
C                                                                                                                                   
  140 CALL GETFLD2(1,A, -1 ,0,0,0,IBUF,MAXX,OK)                                                                                     
      IF(.NOT.OK)THEN                                                                                                               
        IF(NR.EQ.0) CALL                           XIT('BINS',-2)                                                                   
        WRITE(6,6010) NR,NB,NF                                                                                                      
        CALL                                       XIT('BINS',0)                                                                    
      ENDIF                                                                                                                         
      IF(NR.EQ.0) CALL PRTLAB(IBUF)                                                                                                 
C                                                                                                                                   
      KIND=IBUF(1)                                                                                                                  
      SPEC=(KIND.EQ.NC4TO8("SPEC") .OR. KIND.EQ.NC4TO8("FOUR"))                                                                     
      NWDS=IBUF(5)*IBUF(6)                                                                                                          
      IF(SPEC) NWDS=NWDS*2                                                                                                          
C                                                                                                                                   
      NR=NR+1                                                                                                                       
      NB=NB+1                                                                                                                       
      NF=1                                                                                                                          
C                                                                                                                                   
C     * READ SUBSEQUENT RECORDS IN BIN AND AVERAGE                                                                                  
C                                                                                                                                   
  150 CALL GETFLD2(1,B, -1 ,0,0,0,JBUF,MAXX,OK)                                                                                     
      IF(.NOT.OK) GO TO 215                                                                                                         
      NR=NR+1                                                                                                                       
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('BINS',-3)                                                                   
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * AVERAGE THE NBIN VALUES                                                                                                     
C                                                                                                                                   
      DO 210 I=1,NWDS                                                                                                               
  210 A(I)=A(I)+B(I)                                                                                                                
      NF=NF+1                                                                                                                       
      IF(NF.LT.NBIN.OR.NBIN.EQ.-1) GO TO 150                                                                                        
C                                                                                                                                   
C     * GET BIN AVERAGE                                                                                                             
C                                                                                                                                   
  215 FACT=1.0E0/FLOAT(NF)                                                                                                          
      DO 220 I=1,NWDS                                                                                                               
  220 A(I)=A(I)*FACT                                                                                                                
C                                                                                                                                   
C     * SAVE THE RESULT ON FILE XB WITH IBUF THAT OF THE FIRST                                                                      
C     * RECORD IN THE BIN.                                                                                                          
C                                                                                                                                   
      CALL PUTFLD2(2,A,IBUF,MAXX)                                                                                                   
C                                                                                                                                   
C     * INFORMATION OUTPUT AT END OF LAST BIN                                                                                       
      IF(.NOT.OK)THEN                                                                                                               
        CALL PRTLAB(JBUF)                                                                                                           
        WRITE(6,6010) NR,NB,NF                                                                                                      
        CALL                                       XIT('BINS',0)                                                                    
      ENDIF                                                                                                                         
C                                                                                                                                   
      GO TO 140                                                                                                                     
C                                                                                                                                   
C     * CASE FOR NBIN=1, SIMPLY WRITE OUT THE FILE AGAIN                                                                            
C                                                                                                                                   
  300 NR=0                                                                                                                          
  310   CALL RECGET(1,-1,-1,-1,-1,IBUF,MAXX,OK)                                                                                     
      IF(.NOT.OK)THEN                                                                                                               
        IF(NR.EQ.0) CALL                           XIT('BINS',-4)                                                                   
        CALL PRTLAB(IBUF)                                                                                                           
        WRITE(6,6015) NR                                                                                                            
        CALL                                       XIT('BINS',0)                                                                    
      ENDIF                                                                                                                         
      IF(NR.EQ.0) CALL PRTLAB(IBUF)                                                                                                 
C                                                                                                                                   
        CALL RECPUT(2,IBUF)                                                                                                         
        NR=NR+1                                                                                                                     
      GO TO 310                                                                                                                     
C                                                                                                                                   
  900 CALL                                         XIT('BINS',-5)                                                                   
C---------------------------------------------------------------------                                                              
 5010 FORMAT(10X,I5)                                                            H4                                                  
 6005 FORMAT(' BIN SIZE=', I5)                                                                                                      
 6010 FORMAT(' RECORDS=',I5,3X,'BINS=',I5,3X,'NO. IN LAST BIN=',I5)                                                                 
 6015 FORMAT(' RECORDS=',I5)                                                                                                        
      END                                                                                                                           
