PROGRAM QV7_SUN C READ AND PRINT LMRF6 C IMPLICIT INTEGER(A-E,G-Z) C DATA UNIT/1/,FMISS/-9999./ C PARAMETER(DIM BUF=6) DIMENSION BUF(DIM BUF) DATA (BUF(I),I=1,6)/6*0/,DEOF/0/ 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) DATA AL(2)/16/ DIMENSION TRFLG(23) C C OPEN(UNIT,FILE='/tmp/lmrf_jan80',FORM='UNFORMATTED', + ACCESS='DIRECT',RECL=LEN(RPT)) C-----READ REPORT 100 READ(UNIT,REC=BUF(2)+1,IOSTAT=EOF)RPT IF(EOF.NE.0)GOTO 900 DEOF=0 IF(BUF(2).EQ.0)THEN PRINT*,'PROGRAM QV7_SUN 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(*,'("TRIM ATT: ",I5,22I3)')(TRFLG(i),i=1,23) 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(2:2)),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,FORMAT DIMENSION FIELD(*),FORMAT(*) 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*8 FORMAT DIMENSION FTRUE(*),FUNITS(*),FORMAT(*) CHARACTER*8 ATRUE(104) C DO 190 I=1,NUMBER IF(FTRUE(I).EQ.FMISS)THEN ATRUE(I)=' ' ELSE IF(FORMAT(I)(2:2).EQ.' ')THEN ATRUE(I)(1:1)=CHAR(NINT(FTRUE(I))) ELSE WRITE(ATRUE(I),'(I'//FORMAT(I)(3:3)//')') + NINT(FTRUE(I)/FUNITS(I)) ENDIF 190 CONTINUE C WRITE(*,FORMAT)(ATRUE(I),I=1,NUMBER) 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 Get bytes - unpack bits: Extract arbitrary size values from a C packed bit string, right justifying each value in the unpacked C array. DIMENSION IN(*), IOUT(*) C IN = packed array input C IO = unpacked array output C ISKIP = initial number of bits to skip C NBYTE = number of bits to take C NSKIP = additional number of bits to skip on each iteration C N = number of iterations C************************************** MACHINE SPECIFIC CHANGES START HERE C Machine dependent information required: C LMWD = Number of bits in a word on this machine C MASKS = Set of word masks where the first element has only the C right most bit set to 1, the second has the two, ... C LEFTSH = Shift left bits in word M to the by N bits C RGHTSH = Shift right C OR = Logical OR (add) on this machine. C AND = Logical AND (multiply) on this machine C This is for Sun UNIX Fortran, DEC Alpha, and RS6000 PARAMETER (LMWD=32) DIMENSION MASKS(LMWD) SAVE MASKS DATA MASKS /'1'X,'3'X,'7'X,'F'X, '1F'X,'3F'X,'7F'X,'FF'X, +'1FF'X,'3FF'X,'7FF'X,'FFF'X, '1FFF'X,'3FFF'X,'7FFF'X,'FFFF'X, +'1FFFF'X, '3FFFF'X, '7FFFF'X, 'FFFFF'X, +'1FFFFF'X, '3FFFFF'X, '7FFFFF'X, 'FFFFFF'X, +'1FFFFFF'X, '3FFFFFF'X, '7FFFFFF'X, 'FFFFFFF'X, +'1FFFFFFF'X, '3FFFFFFF'X, '7FFFFFFF'X, 'FFFFFFFF'X/ C +'1FFFFFFFF'X, '3FFFFFFFF'X, '7FFFFFFFF'X, 'FFFFFFFFF'X, C +'1FFFFFFFFF'X, '3FFFFFFFFF'X, '7FFFFFFFFF'X, 'FFFFFFFFFF'X, C +'1FFFFFFFFFF'X, '3FFFFFFFFFF'X, '7FFFFFFFFFF'X, 'FFFFFFFFFFF'X, C +'1FFFFFFFFFFF'X,'3FFFFFFFFFFF'X,'7FFFFFFFFFFF'X,'FFFFFFFFFFFF'X, C +'1FFFFFFFFFFFF'X, '3FFFFFFFFFFFF'X, '7FFFFFFFFFFFF'X, C + 'FFFFFFFFFFFFF'X, C +'1FFFFFFFFFFFFF'X, '3FFFFFFFFFFFFF'X, '7FFFFFFFFFFFFF'X, C 'FFFFFFFFFFFFFF'X, C +'1FFFFFFFFFFFFFF'X, '3FFFFFFFFFFFFFF'X, '7FFFFFFFFFFFFFF'X, C 'FFFFFFFFFFFFFFF'X, C +'1FFFFFFFFFFFFFFF'X,'3FFFFFFFFFFFFFFF'X,'7FFFFFFFFFFFFFFF'X, C 'FFFFFFFFFFFFFFFF'X/ C IBM PC using Microsoft Fortran uses different syntax: C DATA MASKS/16#1,16#3,16#7,16#F,16#1F,16#3F,16#7F,16#FF, C + 16#1FF,16#3FF,16#7FF,16#FFF,16#1FFF,16#3FFF,16#7FFF,16#FFFF, C + 16#1FFFF,16#3FFFF,16#7FFFF,16#FFFFF,16#1FFFFF,16#3FFFFF, C + 16#7FFFFF,16#FFFFFF,16#1FFFFFF,16#3FFFFFF,16#7FFFFFF,16#FFFFFFF, C + 16#1FFFFFFF,16#3FFFFFFF,16#7FFFFFFF,16#FFFFFFFF/ INTEGER RGHTSH, OR, AND LEFTSH(M,N) = ISHFT(M,N) RGHTSH(M,N) = ISHFT(M,-N) C OR(M,N) = M.OR.N C AND(M,N) = M.AND.N C************************************** MACHINE SPECIFIC CHANGES END HERE C History: written by Robert C. Gammill, jul 1972. C NBYTE must be less than or equal to LMWD ICON = LMWD-NBYTE IF (ICON.LT.0) RETURN MASK = MASKS (NBYTE) C INDEX = number of words into IN before the next "byte" appears C II = number of bits the "byte" is from the left side of the word C ISTEP = number of bits from the start of one "byte" to the next C IWORDS = number of words to skip from one "byte" to the next C IBITS = number of bits to skip after skipping IWORDS C MOVER = number of bits to the right, a byte must be moved to be C right adjusted INDEX = ISKIP/LMWD II = MOD (ISKIP,LMWD) ISTEP = NBYTE+NSKIP IWORDS= ISTEP/LMWD IBITS = MOD (ISTEP,LMWD) DO 6 I=1,N MOVER = ICON-II IF (MOVER) 2,3,4 C The "byte" is split across a word break. 2 MOVEL = -MOVER MOVER = LMWD-MOVEL NP1 = LEFTSH (IN(INDEX+1),MOVEL) NP2 = RGHTSH (IN(INDEX+2),MOVER) IOUT(I) = AND (OR (NP1,NP2) , MASK) GO TO 5 C The "byte" is already right adjusted. 3 IOUT(I) = AND (IN (INDEX+1) , MASK) GO TO 5 C Right adjust the "byte". 4 IOUT(I) = AND (RGHTSH (IN (INDEX+1),MOVER) , MASK) 5 II = II+IBITS INDEX = INDEX+IWORDS IF (II .LT. LMWD) GO TO 6 II = II-LMWD INDEX = INDEX+1 6 CONTINUE RETURN END SUBROUTINE SBYTES (IOUT,IN,ISKIP,NBYTE,NSKIP,N) C Store bytes - pack bits: Put arbitrary size values into a C packed bit string, taking the low order bits from each value C in the unpacked array. DIMENSION IN(*), IOUT(*) C IOUT = packed array output C IN = unpacked array input C ISKIP = initial number of bits to skip C NBYTE = number of bits to pack C NSKIP = additional number of bits to skip on each iteration C N = number of iterations C************************************** MACHINE SPECIFIC CHANGES START HERE C Machine dependent information required: C LMWD = Number of bits in a word on this machine C MASKS = Set of word masks where the first element has only the C right most bit set to 1, the second has the two, ... C LEFTSH = Shift left bits in word M to the by N bits C RGHTSH = Shift right C OR = Logical OR (add) on this machine C AND = Logical AND (multiply) on this machine C NOT = Logical NOT (negation) on this machine C This is for Sun UNIX Fortran PARAMETER (LMWD=32) DIMENSION MASKS(LMWD) SAVE MASKS DATA MASKS /'1'X,'3'X,'7'X,'F'X, '1F'X,'3F'X,'7F'X,'FF'X, +'1FF'X,'3FF'X,'7FF'X,'FFF'X, '1FFF'X,'3FFF'X,'7FFF'X,'FFFF'X, +'1FFFF'X, '3FFFF'X, '7FFFF'X, 'FFFFF'X, +'1FFFFF'X, '3FFFFF'X, '7FFFFF'X, 'FFFFFF'X, +'1FFFFFF'X, '3FFFFFF'X, '7FFFFFF'X, 'FFFFFFF'X, +'1FFFFFFF'X, '3FFFFFFF'X, '7FFFFFFF'X, 'FFFFFFFF'X/ INTEGER RGHTSH, OR, AND LEFTSH(M,N) = ISHFT(M,N) RGHTSH(M,N) = ISHFT(M,-N) C OR(M,N) = M.OR.N C AND(M,N) = M.AND.N C NOT(M) = .NOT.M C*********************************************************************** C NBYTE must be less than or equal to LMWD ICON = LMWD-NBYTE IF (ICON .LT. 0) RETURN MASK = MASKS(NBYTE) C INDEX = number of words into IOUT the next "byte" is to be stored C II = number of bits in from the left side of the word to store it C ISTEP = number of bits from the start of one "byte" to the next C IWORDS = number of words to skip from one "byte" to the next C IBITS = number of bits to skip after skipping IWORDS C MOVER = number of bits to the right, a byte must be moved to be C right adjusted INDEX = ISKIP/LMWD II = MOD(ISKIP,LMWD) ISTEP = NBYTE+NSKIP IWORDS = ISTEP/LMWD IBITS = MOD(ISTEP,LMWD) DO 6 I=1,N J = AND (MASK,IN(I)) MOVEL = ICON-II IF (MOVEL) 2,3,4 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(LMWD+MOVEL),IOUT(INDEX+2)) IOUT(INDEX+2) = OR(ITEMP,LEFTSH(J,LMWD+MOVEL)) GO TO 5 C The "byte" is to be stored right-adjusted 3 IOUT(INDEX+1) = OR ( AND (NOT(MASK),IOUT(INDEX+1)) , J) GO TO 5 C The "byte" is to be stored in middle of word, so 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. LMWD) GO TO 6 II = II-LMWD INDEX = INDEX+1 6 CONTINUE RETURN END