      PROGRAM CHABIN2                                                                                                               
C     PROGRAM CHABIN2 (CHAR,        BIN,       OUTPUT,                  )       B2                                                  
C    1          TAPE11=CHAR, TAPE12=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     JAN 29/92 - E. CHAN   (CONVERT HOLLERITH LITERALS TO ASCII)                                                                   
C     OCT 04/89 - F. MAJAESS - BASED ON CHABIN PROGRAM                                                                              
C                                                                               B2                                                  
CCHABIN2 - RESTORE A CHARACTER CODED FILE BACK TO BINARY                        B1                                                  
C          (NO CALL TO JCLPNT)                                          1  1    B1                                                  
C                                                                               B3                                                  
CAUTHORS - R.LAPRISE, S.J.LAMBERT                                               B3                                                  
C                                                                               B3                                                  
CPURPOSE - THIS PROGRAM IS USED TO READ FOREIGN DATASETS AND/OR TO              B3                                                  
C          RESTORE A CCRN CHARACTER CODED FILE WRITTEN BY PROGRAM               B3                                                  
C          BINACH2 BACK TO BINARY FORM.                                         B3                                                  
C          SUPERLABELS ARE RECOGNIZED AS SUCH.                                  B3                                                  
C          NOTE - FORTRAN TAPE UNITS 6, 11 AND 12 ASSIGNMENTS HAS TO BE         B3                                                  
C                 DONE BEFORE RUNNING CHABIN2. FOR EXAMPLE, WHEN READING        B3                                                  
C                 A  VMS  STANDARD ASCII FILE WITH FIXED LENGTH RECORDS,        B3                                                  
C                 HAVING  80 CHARACTERS/RECORD   AND  400 RECORDS/BLOCK;        B3                                                  
C                 THE UNIT #12 FILE ASSIGNMENT CAN BE DONE BY:                  B3                                                  
C                 ASSIGN(DN=...,FD=VMS,CS=AS,RF=F,CV=ON,MBS=32000,RS=80,        B3                                                  
C                                                       LM=60000,A=FT11)        B3                                                  
C                                                                               B3                                                  
CINPUT FILE...                                                                  B3                                                  
C                                                                               B3                                                  
C      CHAR = CODED CHARACTER FILE.(SEE ASSIGNMENT NOTE ABOVE)                  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-----------------------------------------------------------------------                                                            
      REWIND 12                                                                                                                     
      NRECS=0                                                                                                                       
C                                                                                                                                   
C     * FIRST READ IN LABEL TO FIND NATURE OF FIELD.                                                                                
C                                                                                                                                   
  100 READ(11,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('CHABIN2',-1)                                                                
      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(11,1020,END=903) ISUP                                                                                                  
        IBUF(5)=10                                                                                                                  
        CALL FBUFOUT(12,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(11,1030,END=903) (CBUF(I),I=1,NWDS)                                                                                  
C         * EITHER OF FBUFOUT OR PUTFLD2 WORKED.                                                                                    
C         CALL FBUFOUT(12,IBUF,NWDS*MACHINE+8,K)                                                                                    
          CALL PUTFLD2(12,CBUF,IBUF,MAXX)                                                                                           
                                                                                                                                    
        ELSE                                                                                                                        
C                                                                                                                                   
C         * CASE WHERE FIELD CONTAINS DATA.                                                                                         
C                                                                                                                                   
          READ(11,1010,END=903) (F(I),I=1,NWDS)                                                                                     
          IBUF(8)=2                                                                                                                 
          CALL PUTFLD2(12,F,IBUF,MAXX)                                                                                              
        ENDIF                                                                                                                       
      ENDIF                                                                                                                         
      NRECS=NRECS+1                                                                                                                 
      GO TO 100                                                                                                                     
C                                                                                                                                   
C     * E.O.F. ON FILE CHAR.                                                                                                        
C                                                                                                                                   
  901 IF(NRECS.EQ.0) CALL                          XIT('CHABIN2',-2)                                                                
      WRITE(6,6000) NRECS                                                                                                           
      CALL                                         XIT('CHABIN2',0)                                                                 
  903 CALL                                         XIT('CHABIN2',-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 CHABIN2 CONVERTED ',I5,' RECORDS.')                                                                                 
      END                                                                                                                           
