SUBROUTINE W3AI41(KFLD,KOUT,KLEN,KNUM,KOFF) C$$$ SUBPROGRAM DOCUMENTATION BLOCK *** C . . . . C SUBPROGRAM: W3AI41 CONSTANT SIZE BINARY STRING UNPACKER C PRGMMR: ALLARD, R. ORG: W342 DATE: 80-04-01 C C ABSTRACT: UNPACK CONSECUTIVE BINARY STRINGS OF THE SAME SIZE FROM C ONE USER SUPPLIED ARRAY AND STORE THEM IN THE SAME ORDER RIGHT C ALIGNED IN ANOTHER ARRAY. W3AI41 IS THE REVERSE OF W3AI40. (SEE C C PROGRAM HISTORY LOG: C 80-04-01 R.ALLARD (ORIGINAL AUTHOR) ASMEMBLER LANGUAGE VERSION. C 84-07-05 R.E.JONES RECOMPILED FOR NAS-9050 C 88-07-05 R.E.JONES WROTE FORTRAN VERSION OF W3AI41 TO UNPACK C VARIABLE SIZE BINARY STRINGS, ADDED CODE TO C REVERSE ORFER OF BYTES. C 89-11-04 R.E.JONES CONVERT TO CRAF CFT77 FORTRAN C 98-03-10 B. VUONG REMOVE THE CDIR$ INTEGER=64 DIRECTIVE C C USAGE: CALL W3AI41 (KFLD, KOUT, KLEN, KNUM, KOFF) C C INPUT: C KFLD - INTEGER ARRAY CONTINING BINARY STRING(S) C KLEN - INTEGER NUMBER OF BITS PER STRING (0 < KLEN < 65) C KNUM - INTEGER NUMBER OF STRINGS TO UNPACK. THIS VALUE MUST * NOT EXCEED THE DIMENSION OF 'KOUT'. C KOFF - INTEGER NUMBER SPECIFYING THE BIT OFFSET OF THE C FIRST STRING 'KFLD'. THE OFFSET VALUE IS RESET TO C INCLUDE THE LOW ORDER BIT OF THE LAST STRING UNPACKED C ('KOFF' > 0 ) C OUTPUT: C KOUT - INTEGER*4 ARRAY HOLDING UNPACKED STRING(S) C C EXIT STATES: C ERROR - 'KOFF' < 0 IF 'KLEN' HAS AN ILLEGAL VALUE OR 'KNUM' < 1 C THEN 'KOUT' HAS NO STRINGS STORED. C C EXTERNAL REFERENCES: NONE C C REMARKS: THIS SUBROUTINE SHOULD BE WRITTEN IN ASSEMBLER LANGUAGE. C THE FORTRAN VERSION RUNS TWO OR THREE TIMES SLOWER THAN THE ASEMBLER C VERSION. THE FORTRAN VERSION CAN BE CONVERTED TO RUN ON OTHER C COMPUTERS WITH A FEW CHANGES. THE BIT MANIPULATION FUNCTIONS ARE THE C SAME IN IBM370 VS FORTRAN 4.1, MICROSOFT FORTRAN 4.10, VAX FORTRAN. C MOST MODERN FORTRAN COMPILER HAVE AND, OR, SHIFT FUNCTIONS. IF YOU C ARE RUNNING ON A PC, VAX AND YOUR INPUT WAS MADE ON A IBM370, APOLLO C SUN, H.P.. ETC. YOU MAY HAVE TO ADD MORE CODE TO REVERSE THE ORDER O C BYTES IN AN INTEGER WORD. NCAR GBYTES CAN BE USED INSTEAD OF THIS C SUBROUTINE. C C ATTRIBUTES: C LANGUAGE: CRAY CFT77 FORTRAN C MACHINE: CRAY Y-MP8/832 C C$$$ C INTEGER KFLD(*) INTEGER KOUT(*) INTEGER BITSET INTEGER OFFSET INTEGER WRDSET C OFFSET = KOFF IF (OFFSET.LT.0) RETURN IF (KLEN.GT.64.OR.KLEN.LT.1) THEN KOFF = -1 RETURN ENDIF C IF (KNUM.LT.1) THEN KOFF = -1 RETURN ENDIF C JCOUNT = KLEN - 64 LENGTH = KLEN C DO 100 I = 1,KNUM WRDSET = ISHFT(OFFSET,-6) BITSET = MOD(OFFSET,64) ITEMP = KFLD(WRDSET+1) NTEMP = KFLD(WRDSET+2) ITEMP = ISHFT(ITEMP,BITSET) NTEMP = ISHFT(NTEMP,BITSET-64) KOUT(I) = ISHFT(IOR(ITEMP,NTEMP),JCOUNT) OFFSET = OFFSET + LENGTH 100 CONTINUE KOFF = OFFSET RETURN END