integer*4    cols,                                                     
     ^                rows,                                                     
     ^                interlace,                                                
     ^                result,                                                   
     ^                redrow,                                                   
     ^                greenrow,                                                 
     ^                bluerow                                                   
         character*1  image( 921600 ),                                          
     ^                c( 1282 )                                                 
         integer*4    i                                                         
         integer*4    d2gdims, d2reqil, d2gimg                                  
         character*64 ddname                                                    
                                                                                
         integer*2    size                                                      
         character*1  sizec( 2 )                                                
                                                                                
         equivalence  ( sizec( 1 ), size )                                      
                                                                                
         character*1  rowpad( 8 )                                               
                                                                                
         ddname = 'dd:input'                                                    
         result = d2gdims( ddname, cols, rows, interlace )                      
            write( 6,* ) 'return code from DF24getdims is ', result             
            write( 6,* ) 'cols= ', cols, ' rows= ', rows                        
            write( 6,* ) 'interlace= ', interlace                               
                                                                                
         result = d2reqil( 1 )                                                  
            write( 6,* ) 'return code from DF24reqil= ', result                 
                                                                                
         result = d2gimg( ddname, image, cols, rows )                           
            write( 6,* ) 'return code from DF24getimage is', result             
                                                                                
*        /******************************************************/               
*        /* go down the array getting a redrow, a greenrow and */               
*        /* a blue row each time                               */               
*        /******************************************************/               
                                                                                
         redrow   = 1                                                           
         greenrow = redrow   + cols                                             
         bluerow  = greenrow + cols                                             
                                                                                
*        /**********************************************************/           
*        /* open the output file                                   */           
*        /**********************************************************/           
                                                                                
         open( 1, file='output' )                                               
                                                                                
         do 1, i = 1, rows                                                      
            call compr( image( redrow ), cols, size, c )                        
               call put( c, size )                                              
            call compr( image( greenrow ), cols, size, c )                      
               call put( c, size )                                              
            call compr( image( bluerow ), cols, size, c )                       
               call put( c, size )                                              
                                                                                
            redrow   = bluerow  + cols                                          
            greenrow = redrow   + cols                                          
            bluerow  = greenrow + cols                                          
1        continue                                                               
                                                                                
         close( 1 )                                                             
                                                                                
         stop                                                                   
         end                                                                    
*                                                                               
         subroutine compr( row, cols, size, comprow )                           
                                                                                
         character*1   row( 640 ),                                              
     ^                 comprow( 1282 )                                          
         integer*4     cols,                                                    
     ^                 i,                                                       
     ^                 ptr                                                      
                                                                                
         integer*2     size,                                                    
     ^                 size2,                                                   
     ^                 count                                                    
         character*1   s( 2 ),                                                  
     ^                 c( 2 )                                                   
         equivalence   ( s(1),size2  )                                          
         equivalence   ( c(1),count )                                           
                                                                                
         ptr   = 3                                                              
         count = 0                                                              
         do 1, i = 2, cols                                                      
            if( row( i ) .eq. row( i-1 ) .and. count .lt. 255 ) then            
               count = count + 1                                                
            else                                                                
               comprow( ptr   ) = c( 2 )                                        
               comprow( ptr+1 ) = row( i-1 )                                    
               ptr = ptr + 2                                                    
               count = 0                                                        
            end if                                                              
1        continue                                                               
                                                                                
        comprow( ptr   ) = c( 2 )                                               
        comprow( ptr+1 ) = row( i-1 )                                           
        ptr = ptr + 2                                                           
                                                                                
        size  = ptr - 1                                                         
        size2 = ptr - 3                                                         
        comprow( 1 ) = s( 1 )                                                   
        comprow( 2 ) = s( 2 )                                                   
                                                                                
        return                                                                  
        end                                                                     
*                                                                               
          subroutine put( buf, len )                                            
                                                                                
          integer*2   len                                                       
          character*1 buf(1282)                                                 
                                                                                
          integer*4  bstart /   1 /,                                            
     ^               bleft  / 512 /,                                            
     ^               j,                                                         
     ^               offset                                                     
                                                                                
          character*1 buffer( 512 )                                             
                                                                                
          offset = 0                                                            
                                                                                
4         if( len .lt. bleft ) then                                             
             do 1, j = 1, len                                                   
                buffer( bstart + j - 1 ) = buf( offset + j )                    
1            continue                                                           
             bleft = bleft - len                                                
             bstart = bstart + len                                              
          else if( len .eq. bleft ) then                                        
             do 2, j = 1, len                                                   
                buffer( bstart + j - 1 ) = buf( offset + j )                    
2            continue                                                           
             write( 1,11 ) buffer                                               
11           format( 100a1, 100a1, 100a1, 100a1, 100a1, 12a1 )                  
             bleft = 512                                                        
             bstart = 1                                                         
          else                                                                  
             do 3, j = 1, bleft                                                 
                buffer( bstart + j - 1 ) = buf( offset + j )                    
3            continue                                                           
             write( 1,11 ) buffer                                               
             len = len - bleft                                                  
             offset = offset + bleft                                            
             bleft = 512                                                        
             bstart = 1                                                         
             go to 4                                                            
          end if                                                                
          end