      PROGRAM QV7_PC
C     READ AND PRINT LMRF6 DATA ON A PC
C
      IMPLICIT INTEGER(A-E,G-Z)
C
      PARAMETER(DIM BUF=6)
      DIMENSION BUF(DIM BUF)
C
      CHARACTER RPT*64
C
      CHARACTER*8 FIELD,FORMAT
      PARAMETER(NUMBER=73)
      COMMON /LMR6/FIELD(NUMBER),FTRUEL(NUMBER),FTRUEU(NUMBER)
     +,FUNITS(NUMBER),FBASE(NUMBER),BITS(NUMBER),OFFSET(NUMBER)
     +,FORMAT(NUMBER),RPTID,INDXCK
C
      DIMENSION CODED(NUMBER),FTRUE(NUMBER)
C
      DIMENSION AL(15),AD(255,15)
      DIMENSION TRFLG(23)
C
      DATA AL(2)/16/
      DATA UNIT/1/,FMISS/-9999./
C
      DATA (BUF(I),I=1,6)/6*0/,DEOF/0/
C
      OPEN(UNIT,FILE='lmrf_dat',FORM='UNFORMATTED',
     +     ACCESS='DIRECT',RECL=LEN(RPT))

C-----READ REPORT
  100 READ(UNIT,REC=BUF(2)+1,IOSTAT=EOF)RPT

c     swap each 4 byte word for PC word order
      call cswap_4(rpt,len(rpt))
      IF(EOF.NE.0)GOTO 900
      DEOF=0
      IF(BUF(2).EQ.0)THEN
        PRINT*,'PROGRAM QV7_PC OUTPUT <-----'
        CALL PRNFLD(FIELD,FORMAT,NUMBER)
      ENDIF
      BUF(2)=BUF(2)+1
C
C-----UNPACK REPORT AND CONVERT CODED TO TRUE VALUES
      CALL GETRPT(RPT,CODED,FTRUE,FMISS
     +,FUNITS,FBASE,BITS,OFFSET,NUMBER,RPTID,INDXCK)

C-----PRINT REPORT AND TRIMMING ATTACHMENT FOR THE FIRST 10 RECORDS
      IF(BUF(2).LE.10)THEN
      CALL PRNRPT(FTRUE,FMISS,FUNITS,FORMAT,NUMBER)
C-----GET TRIMMING ATTACHMENT
      CALL GBYTES(RPT,AD(1,2),448,4,0,16)
      CALL GETTRF(AL,AD,TRFLG)
c     PRINT *,'TRIM ATT: "',TRFLG,'"'
      WRITE(*,1001)(TRFLG(i),i=1,23)
 1001 FORMAT('TRIM ATT: ',I5,22I3)
      ENDIF

      IF(BUF(2).GT.10.AND.MOD(BUF(2),5000).EQ.0)THEN
      PRINT*,'PROCESSING RECORDS NUMBER : ',BUF(2)
      ENDIF

C     STOP PROCESS AFTER 10 RECORDS, FOR FULL FILE READ REMOVE THIS STATEMENT
      IF(BUF(2).GE.10)STOP 'PROCESSING STOPPED AFTER 10 RECORDS'
      GOTO 100
C
  900 PRINT *,' REPORTS ',BUF(2),', EOF ',EOF
      DEOF=DEOF+1
      IF(DEOF.LT.2)GOTO 100
      END
C-----------------------------------------------------------------------3456789 
      BLOCK DATA BDLMR6
      IMPLICIT INTEGER(A-E,G-Z)
C
      CHARACTER*8 FIELD,FORMAT
      PARAMETER(NUMBER=73)
      COMMON /LMR6/FIELD(NUMBER),FTRUEL(NUMBER),FTRUEU(NUMBER)
     +,FUNITS(NUMBER),FBASE(NUMBER),BITS(NUMBER),OFFSET(NUMBER)
     +,FORMAT(NUMBER),RPTID,INDXCK
C
      DATA (FIELD(I),FTRUEL(I),FTRUEU(I),FUNITS(I),FBASE(I)
     +,BITS(I),OFFSET(I),FORMAT(I),I= 1,10)
     1/'B10 ',      1.,    648.,      1.,      0.,  10,  16,'(A4 '
     2,'YR  ',   1770.,   2024.,      1.,   1769.,   8,  26,',A4 '
     3,'MO  ',      1.,     12.,      1.,      0.,   4,  34,',A2 '
     4,'DY  ',      1.,     31.,      1.,      0.,   5,  38,',A2 '
     5,'HR  ',    0.00,   23.99,    0.01,   -1.00,  12,  43,',A4 '
     6,'TI  ',      0.,      3.,      1.,     -1.,   4,  55,',A1 '
     7,'LON ',    0.00,  359.99,    0.01,   -1.00,  16,  59,',A5 '
     8,'LAT ',  -90.00,   90.00,    0.01,-9001.00,  15,  75,',A5 '
     9,'LI  ',      0.,      6.,      1.,     -1.,   4,  90,',A1 '
     1,'DCK ',      0.,    999.,      1.,     -1.,  10,  94,',A3 '/
      DATA (FIELD(I),FTRUEL(I),FTRUEU(I),FUNITS(I),FBASE(I)
     +,BITS(I),OFFSET(I),FORMAT(I),I=11,20)
     1/'SID ',      0.,     80.,      1.,     -1.,   8, 104,',A2 '
     2,'PT  ',      0.,     15.,      1.,     -1.,   5, 112,',A2 '
     3,'QI  ',      0.,      2.,      1.,     -1.,   2, 117,',A1 '
     4,'DS  ',      0.,     13.,      1.,     -1.,   5, 119,',A2 '
     5,'DC  ',      0.,      2.,      1.,     -1.,   4, 124,',A2 '
     6,'TC  ',      0.,      1.,      1.,     -1.,   3, 128,',A1 '
     7,'PB  ',      0.,      2.,      1.,     -1.,   2, 131,',A1 '
     8,'DI  ',      0.,      6.,      1.,     -1.,   4, 133,',A1 '
     9,'D   ',      1.,    362.,      1.,      0.,   9, 137,',A3 '
     2,'WI  ',      0.,      8.,      1.,     -1.,   4, 146,',A1 '/
      DATA (FIELD(I),FTRUEL(I),FTRUEU(I),FUNITS(I),FBASE(I)
     +,BITS(I),OFFSET(I),FORMAT(I),I=21,30)
     1/'W   ',     0.0,   102.2,     0.1,    -1.0,  10, 150,',A4 '
     2,'VI  ',      0.,      2.,      1.,     -1.,   2, 160,',A1 '
     3,'VV  ',     90.,     99.,      1.,     89.,   4, 162,',A2 '
     4,'WW  ',      0.,     99.,      1.,     -1.,   7, 166,',A2 '
     5,'W1  ',      0.,      9.,      1.,     -1.,   4, 173,',A1 '
     6,'W2  ',      0.,      9.,      1.,     -1.,   4, 177,',A1 '
     7,'SLP ',   870.0,  1074.6,     0.1,  8699.0,  11, 181,',A5 '
     8,'T1  ',      0.,      9.,      1.,     -1.,   4, 192,',A1 '
     9,'AT  ',   -99.9,    99.9,     0.1, -1000.0,  11, 196,',A4 '
     3,'WBT ',   -99.9,    99.9,     0.1, -1000.0,  11, 207,',A4 '/
      DATA (FIELD(I),FTRUEL(I),FTRUEU(I),FUNITS(I),FBASE(I)
     +,BITS(I),OFFSET(I),FORMAT(I),I=31,40)
     1/'DPT ',   -99.9,    99.9,     0.1, -1000.0,  11, 218,',A4 '
     2,'SST ',   -99.9,    99.9,     0.1, -1000.0,  11, 229,',A4 '
     3,'SI  ',      0.,     12.,      1.,     -1.,   4, 240,',A2 '
     4,'N   ',      0.,      9.,      1.,     -1.,   4, 244,',A1 '
     5,'NH  ',      0.,      9.,      1.,     -1.,   4, 248,',A1 '
     6,'CL  ',      0.,     10.,      1.,     -1.,   4, 252,',A2 '
     7,'HI  ',      0.,      1.,      1.,     -1.,   2, 256,',A1 '
     8,'H   ',      0.,     10.,      1.,     -1.,   4, 258,',A2 '
     9,'CM  ',      0.,     10.,      1.,     -1.,   4, 262,',A2 '
     4,'CH  ',      0.,     10.,      1.,     -1.,   4, 266,',A2 '/
      DATA (FIELD(I),FTRUEL(I),FTRUEU(I),FUNITS(I),FBASE(I)
     +,BITS(I),OFFSET(I),FORMAT(I),I=41,50)
     1/'WD  ',      0.,     38.,      1.,     -1.,   6, 270,',A2 '
     2,'WP  ',      0.,     30.,      1.,     -1.,   5, 276,',A2 '
     3,'WH  ',      0.,    49.5,     0.5,     -1.,   7, 281,',A2 '
     4,'SD  ',      0.,     38.,      1.,     -1.,   6, 288,',A2 '
     5,'SP  ',      0.,     30.,      1.,     -1.,   5, 294,',A2 '
     6,'SH  ',      0.,    49.5,     0.5,     -1.,   7, 299,',A2 '
     7,'C1  ',      0.,     40.,      1.,     -1.,   7, 306,',A2 '
     8,'C2  ',      0.,     40.,      1.,     -1.,   7, 313,',A2 '
     9,'SC  ',      0.,      9.,      1.,     -1.,   4, 320,',A1 '
     5,'SS  ',      0.,      9.,      1.,     -1.,   4, 324,',A1 '/
      DATA (FIELD(I),FTRUEL(I),FTRUEU(I),FUNITS(I),FBASE(I)
     +,BITS(I),OFFSET(I),FORMAT(I),I=51,60)
     1/'A   ',      0.,      8.,      1.,     -1.,   4, 328,',A1 '
     2,'PPP ',     0.0,    51.0,     0.1,    -1.0,   9, 332,',A3 '
     3,'IS  ',      1.,      5.,      1.,      0.,   3, 341,',A1 '
     4,'ES  ',      0.,     99.,      1.,     -1.,   7, 344,',A2 '
     5,'RS  ',      0.,      4.,      1.,     -1.,   3, 351,',A1 '
     6,'II  ',      0.,     10.,      1.,     -1.,   4, 354,',A2 '
     7,'ID1 ',     33.,     95.,      1.,     32.,   6, 358,', A1'
     8,'ID2 ',     33.,     95.,      1.,     32.,   6, 364,', A1'
     9,'ID3 ',     33.,     95.,      1.,     32.,   6, 370,', A1'
     6,'ID4 ',     33.,     95.,      1.,     32.,   6, 376,', A1'/
      DATA (FIELD(I),FTRUEL(I),FTRUEU(I),FUNITS(I),FBASE(I)
     +,BITS(I),OFFSET(I),FORMAT(I),I=61,70)
     1/'ID5 ',     33.,     95.,      1.,     32.,   6, 382,', A1'
     2,'ID6 ',     33.,     95.,      1.,     32.,   6, 388,', A1'
     3,'ID7 ',     33.,     95.,      1.,     32.,   6, 394,', A1'
     4,'ID8 ',     33.,     95.,      1.,     32.,   6, 400,', A1'
     5,'OS  ',      0.,      6.,      1.,     -1.,   4, 406,',A1 '
     6,'OP  ',      0.,      9.,      1.,     -1.,   4, 410,',A1 '
     7,'T2  ',      0.,      6.,      1.,     -1.,   3, 414,',A1 '
     8,'IX  ',      1.,      6.,      1.,      0.,   4, 417,',A1 '
     9,'WX  ',      1.,      1.,      1.,      0.,   1, 421,',A1 '
     7,'SX  ',      1.,      1.,      1.,      0.,   1, 422,',A1 '/
      DATA (FIELD(I),FTRUEL(I),FTRUEU(I),FUNITS(I),FBASE(I)
     +,BITS(I),OFFSET(I),FORMAT(I),I=71,73)
     1/'IRD ',      1.,    255.,      1.,      0.,   8, 423,',A3 '
     2,'A6  ',      0.,      1.,      1.,     -1.,   2, 431,',A1 '
     3,'CK  ',      0.,     30.,      1.,      0.,   5, 443,',A2)'/
C
      DATA INDXCK/NUMBER/,RPTID/6/
      END
C-----------------------------------------------------------------------3456789 
      SUBROUTINE GETRPT(RPT,CODED,FTRUE,FMISS
     +,FUNITS,FBASE,BITS,OFFSET,NUMBER,RPTID,INDXCK)
C     UNPACK REPORT AND CONVERT CODED TO TRUE VALUES
C
      IMPLICIT INTEGER(A-E,G-Z)
C
      CHARACTER*(*) RPT
      DIMENSION CODED(*),FTRUE(*),FUNITS(*),FBASE(*),BITS(*),OFFSET(*)
C
      IF(MOD(ICHAR(RPT(3:3)),16).NE.RPTID)STOP 'RPTID'
C
      CODED(INDXCK)=0
      DO 190 I=1,NUMBER
        IF(I.EQ.INDXCK)GOTO 190
        CALL GBYTE(RPT,CODED(I),OFFSET(I),BITS(I))
        IF(CODED(I).EQ.0)THEN 
          FTRUE(I)=FMISS
        ELSE
          FTRUE(I)=(CODED(I)+FBASE(I))*FUNITS(I)
          CODED(INDXCK)=CODED(INDXCK)+CODED(I)
        ENDIF
  190 CONTINUE
      I=INDXCK
      FTRUE(I)=MOD(CODED(I),2**BITS(I)-1)
      CALL GBYTE(RPT,CODED(I),OFFSET(I),BITS(I))
      IF(FTRUE(I).NE.CODED(I))STOP 'CHECKSUM'
      END
C-----------------------------------------------------------------------3456789
      SUBROUTINE GETTRF(AL,AD,TRFLG)
C     GET TRIMMING ATTACHMENT
C
      IMPLICIT INTEGER(A-E,G-Z)
      DIMENSION AL(15),AD(255,15)
      DIMENSION TRFLG(23)
C
      IF(AL(2).EQ.16)THEN
        TRFLG( 1)=((AD( 1,2)*16+AD( 2,2))*16+AD( 3,2))*4+AD( 4,2)/4
        TRFLG( 2)=MOD(AD( 4,2)      ,4)
        TRFLG( 3)=    AD( 5,2)
        TRFLG( 4)=    AD( 6,2)
        TRFLG( 5)=    AD( 7,2)
        TRFLG( 6)=    AD( 8,2)
        TRFLG( 7)=    AD( 9,2)
        TRFLG( 8)=    AD(10,2)
        TRFLG( 9)=    AD(11,2)/4
        TRFLG(10)=MOD(AD(11,2)      ,4)
        TRFLG(11)=    AD(12,2)/4
        TRFLG(12)=MOD(AD(12,2)      ,4)
        TRFLG(13)=    AD(13,2)/4
        TRFLG(14)=MOD(AD(13,2)      ,4)
        TRFLG(15)=    AD(14,2)/4
        TRFLG(16)=MOD(AD(14,2)      ,4)
        TRFLG(17)=    AD(15,2)/4
        TRFLG(18)=MOD(AD(15,2)/2    ,2)
        TRFLG(19)=MOD(AD(15,2)      ,2)
        TRFLG(20)=    AD(16,2)/2/2/2
        TRFLG(21)=MOD(AD(16,2)/2/2  ,2)
        TRFLG(22)=MOD(AD(16,2)/2    ,2)
        TRFLG(23)=MOD(AD(16,2)      ,2)
      ELSE
        DO 190 I=1,23
          TRFLG(I)=0
  190   CONTINUE
      ENDIF
      END
C-----------------------------------------------------------------------3456789 
      SUBROUTINE PRNFLD(FIELD,FORMAT,NUMBER)
C     PRINT FIELDS
C
      IMPLICIT INTEGER(A-E,G-Z)
      CHARACTER*8 FIELD
      CHARACTER FORMAT*584
      DIMENSION FIELD(*)
      CHARACTER FLD*1
      FLD(I,J)=FIELD(I)(J:J)
      WRITE(*,FORMAT)((FLD(I,MOD(J+INDEX(FIELD(I)(1:3)//' ',' ')-1,3)+1)
     +,I=1,NUMBER),J=0,2)
      WRITE(*,FORMAT)('-',I=1,NUMBER)
      END
C-----------------------------------------------------------------------3456789
      SUBROUTINE PRNRPT(FTRUE,FMISS,FUNITS,FORMAT,NUMBER)
C     PRINT REPORT
C
      IMPLICIT INTEGER(A-E,G-Z)
      CHARACTER FORMAT*584,ITC*1
      DIMENSION FTRUE(*),FUNITS(*)
      CHARACTER*8 ATRUE(104)
C
      DO 190 I=1,NUMBER
        IC=8*(I-1)
        IF(FTRUE(I).EQ.FMISS)THEN
          ATRUE(I)=' '
        ELSE IF(FORMAT(2+IC:2+IC).EQ.' ')THEN
          ATRUE(I)(1:1)=CHAR(NINT(FTRUE(I)))
        ELSE
          ITC=FORMAT(3+IC:3+IC)
          WRITE(ATRUE(I),'(I'//ITC//')')
     +    NINT(FTRUE(I)/FUNITS(I))
        ENDIF
  190 CONTINUE
C
      WRITE(*,FORMAT)(ATRUE(I),I=1,NUMBER)
      END

      subroutine cswap_4(crec,lrec)
      character*64 crec
      character*1 c
      if(lrec.ne.64)then
         print*,'length in cswap_4 is incompatabile',lrec
         stop
      endif
      do i=1,lrec,4
       c = crec(i:i)
       crec(i:i) = crec(i+3:i+3)
       crec(i+3:i+3) = c
       c = crec(i+1:i+1)
       crec(i+1:i+1)=crec(i+2:i+2)
       crec(i+2:i+2)=c
      enddo
      return
      end
      SUBROUTINE GBYTE(IN,IOUT,ISKIP,NBYTE)
      CALL GBYTES(IN,IOUT,ISKIP,NBYTE,0,1)
      RETURN
      END
      SUBROUTINE SBYTE(IOUT,IN,ISKIP,NBYTE)
      CALL SBYTES(IOUT,IN,ISKIP,NBYTE,0,1)
      RETURN
      END
      SUBROUTINE GBYTES(IN,IOUT,ISKIP,NBYTE,NSKIP,N)                            
C THIS PROGRAM WRITTEN BY.....                                                  
C             DR. ROBERT C. GAMMILL, CONSULTANT                                 
C             NATIONAL CENTER FOR ATMOSPHERIC RESEARCH                          
C             MAY 1972                                                          
C THIS IS THE FORTRAN VERSION OF GBYTES.                                        
      COMMON/MACHIN/NBITSW,NBITSC,MASK0,MASKS(32)                               
      DIMENSION IN(1),IOUT(1)                                                   
C  THE STATEMENTS BETWEEN ASTERISK LINES GIVE ALL NECESSARY MACHINE             
C  DEPENDENT INFORMATION                                                        
C***********************************************************************        
C THIS SPECIFICATION IS FOR IBM PC USING MICROSOFT FORTRAN
      INTEGER RGHTSH,OR,AND                                                     
      LEFTSH(M,N)=ISHFT(M,N)                                                      
      RGHTSH(M,N)=ISHFT(M,-N)                                                      
      OR(M,N)=IOR(M,N)                                                            
      AND(M,N)=IAND(M,N)
      DATA NBITSW/32/
      DATA MASK0/16#0/
      DATA MASKS/16#1,16#3,16#7,16#F,16#1F,16#3F,16#7F,16#FF,
     2 16#1FF,16#3FF,16#7FF,16#FFF,16#1FFF,16#3FFF,16#7FFF,16#FFFF,
     3 16#1FFFF,16#3FFFF,16#7FFFF,16#FFFFF,16#1FFFFF,16#3FFFFF,
     4 16#7FFFFF,16#FFFFFF,16#1FFFFFF,16#3FFFFFF,16#7FFFFFF,16#FFFFFFF,
     5 16#1FFFFFFF,16#3FFFFFFF,16#7FFFFFFF,16#FFFFFFFF/
C***********************************************************************        
C NBYTE MUST BE LESS THAN OR EQUAL TO NBITSW                                    
      ICON=NBITSW-NBYTE                                                         
      IF(ICON.LT.0) RETURN                                                      
      MASK=MASKS(NBYTE)                                                         
C INDEX TELLS HOW MANY WORDS INTO THE ARRAY 'IN' THE NEXT BYTE APPEARS.         
      INDEX=ISKIP/NBITSW                                                        
C II TELLS HOW MANY BITS THE BYTE IS FROM THE LEFT SIDE OF THE WORD.            
      II=MOD(ISKIP,NBITSW)                                                      
C ISTEP IS THE DISTANCE IN BITS FROM THE START OF ONE BYTE TO THE NEXT.         
      ISTEP=NBYTE+NSKIP                                                         
C IWORDS TELLS HOW MANY WORDS TO SKIP FROM ONE BYTE TO THE NEXT.                
      IWORDS=ISTEP/NBITSW                                                       
C IBITS TELLS HOW MANY BITS TO SKIP AFTER SKIPPING IWORDS.                      
      IBITS=MOD(ISTEP,NBITSW)                                                   
      DO 6 I=1,N                                                                
C MOVER SPECIFIES HOW FAR TO THE RIGHT A BYTE MUST BE MOVED IN ORDER            
C    TO BE RIGHT ADJUSTED.                                                      
      MOVER=ICON-II                                                             
      IF(MOVER) 2,3,4                                                           
C                                                                               
C THE BYTE IS SPLIT ACROSS A WORD BREAK.                                        
    2 MOVEL=-MOVER                                                              
      MOVER=NBITSW-MOVEL
C EXPAND STATEMENT SINCE MSFORTRAN SEEMS TO FAIL OTHERWISE
      NP1=LEFTSH(IN(INDEX+1),MOVEL)
      NP2=RGHTSH(IN(INDEX+2),MOVER)
C      NP3=OR(LEFTSH(IN(INDEX+1),MOVEL),RGHTSH(IN(INDEX+2),MOVER))
      IOUT(I)=AND(OR(NP1,NP2),MASK)
C      IOUT(I)=AND(OR(LEFTSH(IN(INDEX+1),MOVEL),RGHTSH(IN(INDEX+2),MOVER)        
C     1 ),MASK)                                                                  
      GO TO 5                                                                   
C                                                                               
C THE BYTE IS ALREADY RIGHT ADJUSTED.                                           
    3 IOUT(I)=AND(IN(INDEX+1),MASK)                                             
      GO TO 5                                                                   
C                                                                               
C RIGHT ADJUST THE BYTE.                                                        
    4 IOUT(I)=AND(RGHTSH(IN(INDEX+1),MOVER),MASK)                               
C                                                                               
C INCREMENT II AND INDEX.                                                       
    5 II=II+IBITS                                                               
      INDEX=INDEX+IWORDS                                                        
      IF(II.LT.NBITSW) GO TO 6                                                  
      II=II-NBITSW                                                              
      INDEX=INDEX+1                                                             
    6 CONTINUE                                                                  
      RETURN                                                                    
      END                                                                       
      SUBROUTINE SBYTES(IOUT,IN,ISKIP,NBYTE,NSKIP,N)                            
C THIS PROGRAM WRITTEN BY.....                                                  
C             DR. ROBERT C. GAMMILL, CONSULTANT                                 
C             NATIONAL CENTER FOR ATMOSPHERIC RESEARCH                          
C             JULY 1972                                                         
C THIS IS THE FORTRAN VERSIONS OF SBYTES.                                       
      COMMON/MACHIN/NBITSW,NBITSC,MASK0,MASKS(32)                               
      DIMENSION IN(1),IOUT(1)                                                   
C                                                                               
C  THE STATEMENTS BETWEEN ASTERISK LINES GIVE ALL NECESSARY MACHINE             
C  DEPENDENT INFORMATION                                                        
C***********************************************************************        
C THIS SPECIFICATION IS SUITABLE FOR CDC 6000 SERIES COMPUTERS.                 
      INTEGER RGHTSH,OR,AND                                                     
      OR(M,N)=IOR(M,N)                                                            
      AND(M,N)=IAND(M,N)                                                         
C                            
      LEFTSH(M,N)=ISHFT(M,N)                                                      
      RGHTSH(M,N)=ISHFT(M,-N)                                                      
C***********************************************************************        
C                                                                               
C NBYTE MUST BE LESS THAN OR EQUAL TO NBITSW                                    
      ICON=NBITSW-NBYTE                                                         
      IF(ICON.LT.0) RETURN                                                      
      MASK=MASKS(NBYTE)                                                         
C INDEX TELLS HOW MANY WORDS INTO IOUT THE NEXT BYTE IS TO BE STORED.           
      INDEX=ISKIP/NBITSW                                                        
C II TELLS HOW MANY BITS IN FROM THE LEFT SIDE OF THE WORD TO STORE IT.         
      II=MOD(ISKIP,NBITSW)                                                      
C ISTEP IS THE DISTANCE IN BITS FROM ONE BYTE POSITION TO THE NEXT.             
      ISTEP=NBYTE+NSKIP                                                         
C IWORDS TELLS HOW MANY WORDS TO SKIP FROM ONE BYTE TO THE NEXT.                
      IWORDS=ISTEP/NBITSW                                                       
C IBITS TELLS HOW MANY BITS TO SKIP AFTER SKIPPING IWORDS.                      
      IBITS=MOD(ISTEP,NBITSW)                                                   
      DO 6 I=1,N                                                                
      J=AND(MASK,IN(I))                                                         
      MOVEL=ICON-II                                                             
      IF(MOVEL) 2,3,4                                                           
C                                                                               
C THE BYTE IS TO BE SPLIT ACROSS A WORD BREAK.                                  
2     MSK=MASKS(NBYTE+MOVEL)                                                    
      IOUT(INDEX+1)=OR(AND(NOT(MSK),IOUT(INDEX+1)),RGHTSH(J,-MOVEL))            
      ITEMP=AND(MASKS(NBITSW+MOVEL),IOUT(INDEX+2))                              
      IOUT(INDEX+2)=OR(ITEMP,LEFTSH(J,NBITSW+MOVEL))                            
      GO TO 5                                                                   
C                                                                               
C BYTE IS TO BE STORED RIGHT-ADJUSTED.                                          
3     IOUT(INDEX+1)=OR(AND(NOT(MASK),IOUT(INDEX+1)),J)                          
      GO TO 5                                                                   
C                                                                               
C BYTE IS TO BE STORED IN MIDDLE OF WORD.  SHIFT LEFT.                          
4     MSK=LEFTSH(MASK,MOVEL)                                                    
      IOUT(INDEX+1)=OR(AND(NOT(MSK),IOUT(INDEX+1)),LEFTSH(J,MOVEL))             
5     II=II+IBITS                                                               
      INDEX=INDEX+IWORDS                                                        
      IF(II.LT.NBITSW) GO TO 6                                                  
      II=II-NBITSW                                                              
      INDEX=INDEX+1                                                             
6     CONTINUE                                                                  
      RETURN                                                                    
      END                                                                       
      SUBROUTINE SWAP4(IN,IO,NN)
      LOGICAL*1 IN(1),IO(1),IH
      DO 10 I=1,NN,4
      IH=IN(I)
      IO(I)=IN(I+3)
      IO(I+3)=IH
      IH=IN(I+1)
      IO(I+1)=IN(I+2)
      IO(I+2)=IH
  10  CONTINUE
      RETURN
      END
