*
* $Id: btmove.F,v 1.1.1.1 1996/02/15 17:47:43 mclareni Exp $
*
* $Log: btmove.F,v $
* Revision 1.1.1.1  1996/02/15 17:47:43  mclareni
* Kernlib
*
*
#include "kernbit/pilot.h"
#if defined(CERNLIB_CDC)
      SUBROUTINE BTMOVE(IS,ISBIT,IT,ITBIT,NBIT)
C--- BIT MOVE ROUTINE, CDC VERSION
C--- AUTHOR H. GROTE / CERN-DD  13.10.80
C--- ROUTINE MOVES -NBIT- BITS FROM ARRAY IS TO ARRAY IT,
C--- STARTING AT BITS ISBIT IN IS, AND ITBIT IN IT.
C--- BITS ARE COUNTED FROM LEFT TO RIGHT, 1 TO INFINITY.
C--- FOR NBIT LE 0, NO TRANSFER.
      DIMENSION IS(2),IT(2)
C--- MBIT IS THE NUMBER OF BITS / WORD
      DATA MBIT/ 60 /
      IF(NBIT.LE.0)  GOTO 500
C--- FIRST AND LAST WORD IN ARRAY IS
      KSW1=(ISBIT-1)/MBIT+1
      KSW2=(ISBIT+NBIT-2)/MBIT+1
C--- FIRST BIT IN IS(KSW1) AND LAST IN IS(KSW2)
      IBS1=ISBIT-MBIT*(KSW1-1)
      IBS2=ISBIT+NBIT-1-MBIT*(KSW2-1)
C--- FIRST AND LAST WORD IN ARRAY IT
      KTW1=(ITBIT-1)/MBIT+1
      KTW2=(ITBIT+NBIT-2)/MBIT+1
C--- FIRST BIT IN IT(KTW1), LAST IN IT(KTW2)
      IBT1=ITBIT-MBIT*(KTW1-1)
      IBT2=ITBIT+NBIT-1-MBIT*(KTW2-1)
C--- NO. OF WORDS TO SHIFT
      NW=MAX(KTW2-KTW1,KSW2-KSW1)+1
C--- KEEP FIRST AND LAST TWO WORD OF IT
      KEEP1=IT(KTW1)
      KEEP2=IT(KTW2)
C--- SHIFT IN SOURCE ARRAY
      CALL SHLONG(IS(KSW1),NW,IBS1-IBT1)
C--- MOVE WORDS INTO IT
      CALL UCOPY(IS(KSW1),IT(KTW1),KTW2+1-KTW1)
C--- SHIFT BACK
      CALL SHLONG(IS(KSW1),NW,IBT1-IBS1)
C--- CORRECT FIRST AND LAST (ONE OR TWO) WORDS
      MASK1=MASK(IBT1-1)
      MASK2=MASK(IBT2)
      IT(KTW1)=OR(AND(MASK1,KEEP1),AND(COMPL(MASK1),IT(KTW1)))
      IT(KTW2)=OR(AND(MASK2,IT(KTW2)),AND(COMPL(MASK2),KEEP2))
  500 RETURN
      END
#endif