C FUNCTION TO EXTRACT PARTS OF I*4 NUMBERS C AS IF THEY WERE PART OF 36 BIT NUMBERS INTEGER*4 FUNCTION BITS(IDAT,I1STBT,NBITS) INTEGER*2 I1(2),I2(2) INTEGER*4 ITP1,ITP2,IDAT EQUIVALENCE (I1(1),ITP1),(I2(1),ITP2) C PICK OUT NBITS STARTING AT I1STBT COUNTING FROM 1 FROM C THE LEFT IN A 36 BIT WORD. NENER ACTUALLY USE MORE C THAN LOW 24 OR 32 BITS SO FORGET THE REST. ISKPBT=I1STBT-5 !NUMBER BITS TO SKIP IF (ISKPBT.LT.0)ISKPBT=0 IOUTSK=32-NBITS !OUTPUT LEADING 0 BITS TO LEAVE IF (IOUTSK.LT.0)IOUTSK=0 I1S=1 !INITIALLY USE 1ST WORD OF I*2 NUMBERS I2S=1 ITP1=IDAT !COPY INPUT DATA SO AS NOT TO MESS UP IDAT C HAVE TO SWAP WORDS AS NPUT EXPECTS EARLY WORDS=MOST C SIGNIFICANT PARTS IT=I1(1) I1(1)=I1(2) I1(2)=IT ITP2=0 ! CLEAR ALL BITS OF ITP2 INITIALLY C SKIP BITS MUST BE IN THE RANGE 0-15. SO FIX UP SUB C FOR ADDRESS IF NOT OK NOW. DO FOR BOTH INPUT AND C OUTPUT. IF (ISKPBT.LE.15) GO TO 1 I1S=2 ISKPBT=ISKPBT-16 ! SKIP BIT 1 CONTINUE IF (IOUTSK.LE.15) GO TO 2 I2S=2 IOUTSK=IOUTSK-16 C ADJUST OUTPUT SUBSCRIPT IF NECC. ABOVE 2 CONTINUE CALL NPUT(I2(I2S),IOUTSK,NBITS,I1(I1S),ISKPBT) C NPUT ISA GENERAL FIELD-MOVE ROUTINE C NOW SWAP OUTPUT WORDS FOR FORTRAN REPRESENTATION WHERE C FIRST NUMBER IS LOW ORDER. IT=I2(1) I2(1)=I2(2) I2(2)=IT C RETURN VALUE NOW BITS=ITP2 RETURN END SUBROUTINE SNIP(IIII) C MAKE ARGUMENT POSITIVE FOR TARGET MACHINE C NEEDED IF CROSS COMPILER 1'S COMP AND TGT 2'S COMP OR C VICE VERSA. INTEGER * 4 IIII IF (IIII.LT.0)IIII=-IIII RETURN END SUBROUTINE SAMBO(NOUT,DP) C CONVERT FLOATING POINT NUMBER TO BINARY PATTERN C LEAVE 1ST ELEMENT OF NOUT ZERO, FILLING IN THE OTHERS. DIMENSION NNOUT(5) INTEGER *4 NNOUT REAL *8 DDP DIMENSION NOUT(5) C JUST EQUIVALENCE THE BITS AND HOPE! DIMENSION LOUT(10),KOUT(8) REAL *8 DP EQUIVALENCE (DDP,KOUT) EQUIVALENCE (NNOUT,LOUT) INTEGER *2 KOUT,LOUT INTEGER *4 NOUT DDP=DP C WE MUST HERE SET THE LOW 16 BITS OF THE OUTPUT C TO PART OF THE REAL NUMBER. SET THE HIGH ONES C TO ZERO. II2=0 DO 1 I=1,7,2 II2=II2+1 II3=I+1 LOUT(II3)=0 1 LOUT(I)=KOUT(II2) DO 2 I=1,4 III=I+1 2 NOUT(III)=NNOUT(I) NOUT(1)=0 RETURN END