      PROGRAM CHABIN                                                                                                                
C     PROGRAM CHABIN (CHAR,       BIN,       OUTPUT,                    )       B2                                                  
C    1          TAPE1=CHAR, TAPE2=BIN, TAPE6=OUTPUT)                                                                                
C     ----------------------------------------------                            B2                                                  
C                                                                               B2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       B2                                                  
C     DEC 18/02 - F.MAJAESS (REVISE FOR 128-CHARACTERS/LINE IN "CHAR" RECORDS)  B2                                                  
C     MAR 05/02 - F.MAJAESS (REVISED TO HANDLE "CHAR" KIND RECORDS)                                                                 
C     AUG 21/00 - F.MAJAESS (ENSURE FIELD DIMENSION CHECK VERSUS "MAXRSZ")                                                          
C     JUL 21/92 - E. CHAN   (REPLACE UNFORMATTED I/O WITH I/O ROUTINES)                                                             
C     FEB 17/92 - E. CHAN   (FLAG UNIT 1 FOR FORMATTED READ IN CALL TO JCLPNT)                                                      
C     JAN 29/92 - E. CHAN   (CONVERT HOLLERITH LITERALS TO ASCII)                                                                   
C     OCT 30/91 - F.MAJAESS (ALLOW RESTORATION OF THE ORIGINAL PACKING DENSITY)                                                     
C     OCT 04/89 - F.MAJAESS (ELIMINATE BACKSPACE ON UNIT #1)                                                                        
C     JUN 23/83 - R.LAPRISE, S.J.LAMBERT.                                                                                           
C                                                                               B2                                                  
CCHABIN  - RESTORE A CHARACTER CODED FILE BACK TO BINARY                1  1    B1                                                  
C                                                                               B3                                                  
CAUTHORS - R.LAPRISE, S.J.LAMBERT                                               B3                                                  
C                                                                               B3                                                  
CPURPOSE - RESTORE A CCRN CHARACTER CODED FILE WRITTEN BY PROGRAM BINACH        B3                                                  
C          BACK TO BINARY FORM, WITH PACKING OF 1 TO 3.                         B3                                                  
C          SUPERLABELS ARE RECOGNIZED AS SUCH.                                  B3                                                  
C                                                                               B3                                                  
CINPUT FILE...                                                                  B3                                                  
C                                                                               B3                                                  
C      CHAR = CODED CHARACTER FILE. WHEN READIND A TAPE, THIS FILE              B3                                                  
C             SHOULD BE DECLARED AS BLOCKED, FIXED LENGTH RECORDS,              B3                                                  
C             OF LENGTH 80.  UNDER SCOPE, THE JCL FOR THIS IS...                B3                                                  
C             FILE(CHAR,BT=K,RT=F,RB=200,FL=80,MBL=16000,CM=YES,PD=INPUT)       B3                                                  
C                                                                               B3                                                  
COUTPUT FILE...                                                                 B3                                                  
C                                                                               B3                                                  
C      BIN = BINARY (PACKED) STANDARD CCRN FILE.                                B3                                                  
C--------------------------------------------------------------------------                                                         
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      COMMON/LCM/F(65341)                                                                                                           
C                                                                                                                                   
      COMMON/BUFCOM/IBUF(8),IDAT(65341)                                                                                             
      CHARACTER*80 ISUP                                                                                                             
      CHARACTER*8  CBUF(1)                                                                                                          
      EQUIVALENCE (IDAT,ISUP),(IDAT,CBUF)                                                                                           
C                                                                                                                                   
      COMMON/MACHTYP/MACHINE,INTSIZE                                                                                                
      DATA MAXX/65341/                                                                                                              
      DATA MAXRSZ /65341/                                                                                                           
C-----------------------------------------------------------------------                                                            
      NFF=3                                                                                                                         
      CALL JCLPNT(NFF,-1,2,6)                                                                                                       
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
      NRECS=0                                                                                                                       
C                                                                                                                                   
C     * FIRST READ IN LABEL TO FIND NATURE OF FIELD.                                                                                
C                                                                                                                                   
  100 READ(1,1000,END=901) IBUF                                                                                                     
      NWDS=IBUF(5)*IBUF(6)                                                                                                          
      IF(IBUF(1).EQ.NC4TO8("SPEC").OR.                                                                                              
     +   IBUF(1).EQ.NC4TO8("FOUR")    ) NWDS=NWDS*2                                                                                 
      IF(NWDS.GT.MAXRSZ) CALL                      XIT('CHABIN',-1)                                                                 
      IBUF(8)=ABS(IBUF(8))                                                                                                          
      IF(IBUF(1).EQ.NC4TO8("LABL")) THEN                                                                                            
C                                                                                                                                   
C       * CASE WHERE FIELD CONTAINS A SUPERLABEL (TEXT).                                                                            
C                                                                                                                                   
        DO 220 I=1,80                                                                                                               
          ISUP(I:I)=' '                                                                                                             
  220   CONTINUE                                                                                                                    
        READ(1,1020,END=903) ISUP                                                                                                   
        IBUF(5)=10                                                                                                                  
        CALL FBUFOUT(2,IBUF,10*MACHINE+8,K)                                                                                         
C                                                                                                                                   
      ELSE                                                                                                                          
C                                                                                                                                   
        IF(IBUF(1).EQ.NC4TO8("CHAR")) THEN                                                                                          
C                                                                                                                                   
C         * CASE WHERE FIELD CONTAINS JUST TEXT STRING.                                                                             
C                                                                                                                                   
          READ(1,1030,END=903) (CBUF(I),I=1,NWDS)                                                                                   
C         * EITHER OF FBUFOUT OR PUTFLD2 WORKED.                                                                                    
C         CALL FBUFOUT(2,IBUF,NWDS*MACHINE+8,K)                                                                                     
          CALL PUTFLD2(2,CBUF,IBUF,MAXX)                                                                                            
                                                                                                                                    
        ELSE                                                                                                                        
C                                                                                                                                   
C         * CASE WHERE FIELD CONTAINS DATA.                                                                                         
C                                                                                                                                   
          READ(1,1010,END=903) (F(I),I=1,NWDS)                                                                                      
          CALL PUTFLD2(2,F,IBUF,MAXX)                                                                                               
C                                                                                                                                   
        ENDIF                                                                                                                       
C                                                                                                                                   
      ENDIF                                                                                                                         
C                                                                                                                                   
      NRECS=NRECS+1                                                                                                                 
      GO TO 100                                                                                                                     
C                                                                                                                                   
C     * E.O.F. ON FILE CHAR.                                                                                                        
C                                                                                                                                   
  901 IF(NRECS.EQ.0) CALL                          XIT('CHABIN',-2)                                                                 
      WRITE(6,6000) NRECS                                                                                                           
      CALL                                         XIT('CHABIN',0)                                                                  
  903 CALL                                         XIT('CHABIN',-3)                                                                 
C                                                                                                                                   
C-----------------------------------------------------------------------                                                            
 1000 FORMAT(1X,A4,I10,1X,A4,5I10,10X)                                                                                              
 1010 FORMAT(1P6E22.15)                                                                                                             
 1020 FORMAT(A80)                                                                                                                   
 1030 FORMAT(16A8)                                                                                                                  
 6000 FORMAT('0 CHABIN CONVERTED ',I5,' RECORDS.')                                                                                  
      END                                                                                                                           
