      PROGRAM BINNING                                                                                                               
C     PROGRAM BINNING (TSIN,      MEANTS,      COLAPSE,      INPUT,             H2                                                  
C    1                                                       OUTPUT,    )       H2                                                  
C    2           TAPE1=TSIN,TAPE2=MEANTS,TAPE3=COLAPSE,TAPE5=INPUT,                                                                 
C    3                                                 TAPE6=OUTPUT)                                                                
C     --------------------------------------------------------------            H2                                                  
C                                                                               H2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       H2                                                  
C     JUL 22/92 - E. CHAN  (REPLACE UNFORMATTED I/O WITH I/O ROUTINES)                                                              
C     JAN 29/92 - E. CHAN  (CONVERT HOLLERITH LITERALS TO ASCII)                                                                    
C     OCT 22/85 - B.DUGAS.                                                                                                          
C                                                                               H2                                                  
CBINNING - IDENTIFIES MEAN PROPRETIES BY THE BIN METHOD.                1  2 C  H1                                                  
C                                                                               H3                                                  
CAUTHOR  - B. DUGAS                                                             H3                                                  
C                                                                               H3                                                  
CPURPOSE - DETERMINE UNE MOYENNE A  LONG TERME EN  UTILISANT LA METHODE DES     H3                                                  
C          BOITES. LE PROGRAMME LIT  SUR INPUT LE NOMBRE DE CYCLES CY ET LE     H3                                                  
C          NOMBRE DESIRE DE BOITES DISTINCTES BC PAR CYCLES. UNE BOITE DIS-     H3                                                  
C          TINCTE PEUT ETRE UNE JOURNEE OU CINQ JOURNEES OU ...; CES BOITES     H3                                                  
C          DOIVENT TOUTES CORRESPONDRE A PLUS D'UN POINT DE TSIN.               H3                                                  
C                                                                               H3                                                  
CINPUT FILE...                                                                  H3                                                  
C                                                                               H3                                                  
C      TSIN   = EST N'IMPORTE QUEL FICHIER DE SERIES TEMPORELLES. CES SERIES    H3                                                  
C               DOIVENT PAR CONTRE ETRE TOUTES DE MEME SORTE, NOM ET NIVEAU.    H3                                                  
C                                                                               H3                                                  
COUTPUT FILES...                                                                H3                                                  
C                                                                               H3                                                  
C      MEANTS = CONTIENT DES SERIES TEMPORELLES SE COMPOSANT TOUTES DE CY       H3                                                  
C               CYCLES IDENTIQUES. CES SERIES SONT DE LONGUEUR CY*BC. CES       H3                                                  
C               CYCLES SONT LA MOYENNE DES CY CYCLES DE TSIN.                   H3                                                  
C                                                                               H3                                                  
C      COLAPSE= EST UN FICHIER DE SERIES TEMPORELLES DE MEME LONGUEUR QUE       H3                                                  
C               MEANTS. CHAQUE POINT DE CHAQUE CYCLE EST LA MOYENNE D'UNE       H3                                                  
C               BOITE DANS LE CYCLE CORRESPONDANT DE TSIN.                      H3                                                  
C                                                                                                                                   
CINPUT PARAMETERS...                                                                                                                
C                                                                               H5                                                  
C       CY = NOMBRE DE CYCLES COMPLET DANS LES SERIES D'ENTREES.                H5                                                  
C       BC = NOMBRE DE BOITES DISTINCTES DANS CHAQUE CYCLE.                     H5                                                  
C                                                                               H5                                                  
CEXAMPLE OF INPUT CARD...                                                       H5                                                  
C                                                                               H5                                                  
C*BINNING    20  365                                                            H5                                                  
C-----------------------------------------------------------------------------                                                      
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      LOGICAL OK                                                                                                                    
                                                                                                                                    
      INTEGER CY, BC, OU(18528), TYPE                                                                                               
      REAL MEANTS(18528), TSIN(18528), COLAPSE(18528)                                                                               
                                                                                                                                    
      COMMON /ICOM/ IBUF(8), IDAT(18528)                                                                                            
                                                                                                                                    
      DATA  MAXX / 18528 /                                                                                                          
      DATA ZERO /   0.0E0 /                                                                                                         
                                                                                                                                    
C---------------------------------------------------------------------                                                              
      NF = 5                                                                                                                        
      CALL JCLPNT (NF,1,2,3,5,6)                                                                                                    
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
      REWIND 3                                                                                                                      
                                                                                                                                    
C     * LIRE LE PREMIER TAMPON D'INFORMATION DE TSIN.                                                                               
                                                                                                                                    
      CALL FBUFFIN(1,IBUF,-8,K,LEN)                                                                                                 
      IF (K.GE.0) GOTO 901                                                                                                          
      IF (IBUF(6).NE.1) CALL                       XIT('BINNING',-1)                                                                
      REWIND 1                                                                                                                      
                                                                                                                                    
C     * SAUVER CERTAINES VALEURS A DES FINS DE COMPARAISONS.                                                                        
                                                                                                                                    
      TYPE    = IBUF(1)                                                                                                             
      NOM     = IBUF(3)                                                                                                             
      NIVEAU  = IBUF(4)                                                                                                             
      LONG    = IBUF(5)                                                                                                             
                                                                                                                                    
      IF (LONG.GT.MAXX) CALL                       XIT('BINNING',-2)                                                                
                                                                                                                                    
C     * LIRE LA CARTE DE CONTROLE.                                                                                                  
                                                                                                                                    
      READ(5,5000,END=902)  CY, BC                                              H4                                                  
      IF (CY.LE.0 .OR. (CY*BC.GT.LONG .AND. BC.NE.0))                                                                               
     1    CALL                                     XIT('BINNING',-3)                                                                
      IF (BC.EQ.0) BC = LONG/CY                                                                                                     
      WRITE(6,6000) CY, BC                                                                                                          
      WRITE(6,6005) IBUF                                                                                                            
                                                                                                                                    
C     * NB EST LE NOMBRE DE BOITES.                                                                                                 
C     * PB EST LE NOMBRE DE POINTS DE TSIN PAR BOITE.                                                                               
                                                                                                                                    
      NB  = CY*BC                                                                                                                   
      PB  = FLOAT(LONG)/FLOAT(NB)                                                                                                   
      OCY = 1.0E0/FLOAT(CY)                                                                                                         
                                                                                                                                    
C     * DETERMINER QUELS POINTS VONT DANS QUELLE BOITE.                                                                             
                                                                                                                                    
      PO    = 0.0E0                                                                                                                 
      OU(1) = 0                                                                                                                     
      DO 100 N=2,NB                                                                                                                 
          PO    = PO + PB                                                                                                           
          OU(N) = INT(PO)                                                                                                           
  100 CONTINUE                                                                                                                      
      OU(NB+1) = LONG                                                                                                               
                                                                                                                                    
C---------------------------------------------------------------------                                                              
C     * ALLER CHERCHER LA PROCHAINE SERIE.                                                                                          
                                                                                                                                    
      NSERIE = 0                                                                                                                    
  200 CALL GETFLD2(1,TSIN,TYPE,-1,NOM,NIVEAU,IBUF,MAXX,OK)                                                                          
                                                                                                                                    
          IF (.NOT.OK)                                         THEN                                                                 
              WRITE(6,6010) NSERIE                                                                                                  
              IF (NSERIE.EQ.0) CALL                XIT('BINNING',-4)                                                                
              CALL                                 XIT('BINNING',0)                                                                 
          ENDIF                                                                                                                     
                                                                                                                                    
          IF (IBUF(5).NE.LONG .OR. IBUF(6).NE.1)               THEN                                                                 
              WRITE(6,6020) NSERIE+1, IBUF                                                                                          
              CALL                                 XIT('BINNING',-5)                                                                
          ENDIF                                                                                                                     
                                                                                                                                    
C         * INITIALISER COLAPSE A ZERO.                                                                                             
                                                                                                                                    
          DO 300 L=1,NB                                                                                                             
              COLAPSE(L) = ZERO                                                                                                     
  300     CONTINUE                                                                                                                  
                                                                                                                                    
C         * TROUVER LA VALEUR MOYENNE DE CHAQUE BOITE.                                                                              
C         * LA METTRE DANS LE CHAMPS COLAPSE.                                                                                       
                                                                                                                                    
          DO 400 I=1,NB                                                                                                             
              VA = 0.0E0                                                                                                            
              OP = 1.0E0/FLOAT(OU(I+1)-OU(I))                                                                                       
              DO 350 J=OU(I)+1,OU(I+1)                                                                                              
                  VA = VA + TSIN(J)                                                                                                 
  350         CONTINUE                                                                                                              
              COLAPSE(I) = VA*OP                                                                                                    
  400     CONTINUE                                                                                                                  
                                                                                                                                    
C         * CALCULER LA VALEUR MOYENNE DES BOITES CORRESPONDANTES DE                                                                
C         * CHAQUE CYCLE (MOYENNE DE CY BOITES...) ET LA METTRE DANS                                                                
C         * LE CHAMPS MEANTS.                                                                                                       
                                                                                                                                    
          DO 500 I=1,BC                                                                                                             
              MEANTS(I) = ZERO                                                                                                      
  500     CONTINUE                                                                                                                  
                                                                                                                                    
          DO 550 J=1,CY                                                                                                             
              IJ = (J-1)*BC                                                                                                         
              DO 550 I=1,BC                                                                                                         
                  MEANTS(I) = MEANTS(I) + COLAPSE(I+IJ)*OCY                                                                         
  550     CONTINUE                                                                                                                  
                                                                                                                                    
C         * REPETER CE PREMIER CYCLE CY FOIS.                                                                                       
                                                                                                                                    
          DO 600 J=2,CY                                                                                                             
              IJ = (J-1)*BC                                                                                                         
                                                                                                                                    
              DO 600 I=1,BC                                                                                                         
                  MEANTS(I+IJ) = MEANTS(I)                                                                                          
  600     CONTINUE                                                                                                                  
                                                                                                                                    
C         * SAUVER MEANTS ET COLAPSE.                                                                                               
                                                                                                                                    
          IBUF(5) = NB                                                                                                              
                                                                                                                                    
          CALL PUTFLD2 (2,MEANTS, IBUF,MAXX)                                                                                        
          CALL PUTFLD2 (3,COLAPSE,IBUF,MAXX)                                                                                        
                                                                                                                                    
          NSERIE = NSERIE+1                                                                                                         
                                                                                                                                    
      GOTO 200                                                                                                                      
                                                                                                                                    
C     * FIN PREMATUREE DU FICHIER TSIN.                                                                                             
                                                                                                                                    
  901 CALL                                         XIT('BINNING',-6)                                                                
                                                                                                                                    
C     * E.O.F. SUR INPUT (IN).                                                                                                      
                                                                                                                                    
  902 CALL                                         XIT('BINNING',-7)                                                                
                                                                                                                                    
C---------------------------------------------------------------------                                                              
 5000 FORMAT(10X,2I5)                                                           H4                                                  
 6000 FORMAT('0INPUT TIME SERIES CONSIST OF ',I5,                                                                                   
     1       ' CYCLES, EACH MADE OF ',I4,' BOXES. ')                                                                                
 6005 FORMAT('0BINNING ON : ',A4,1X,I10,1X,A4,I10,2I5,I10,I5)                                                                       
 6010 FORMAT('0BINNING READ ',I5,' SERIES.')                                                                                        
 6020 FORMAT('0RECORD NO,=',I5,', LABEL = ',A4,1X,I10,1X,                                                                           
     1                                      A4,I10,2I5,I10,I5)                                                                      
      END                                                                                                                           
