[u/mrichter/AliRoot.git] / MINICERN / packlib / kernlib / kerngen / tcgen / bitpos.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1996/02/15 17:49:41  mclareni
* Kernlib
*
*
#include "kerngen/pilot.h"
      SUBROUTINE BITPOS(I,N,K,M)
C
C CERN PROGLIB# M508    BITPOS          .VERSION KERNFOR  4.16  870601
C ORIG.  OCT 81,  M.METCALF, CERN/DD
C
C     TO INDICATE WHICH BITS IN A SERIES OF WORDS ARE SET.
C     BITS WITHIN A WORD ARE NUMBERED RIGHT-TO-LEFT, STARTING AT 0.
C
C     I=INPUT WORDS
C     N=NO. OF BITS TO BE TESTED
C     K=POSITION ARRAY
C     M=NO. OF SET BITS IN THE FIRST N POSITIONS
C
#include "kerngen/wordsize.inc"
      PARAMETER   (LBIT = NBITPW)
C
      INTEGER I(*),K(*)
      LOGICAL BTEST
C
C     INITIALIZE
      NWORD=(N-1)/LBIT+1
      M=0
      JND=1
      NBIT = LBIT
C
C     UNPACK EACH WORD
      DO 1 MM=1,NWORD
         NSET = 0
         IMM = I(MM)
         IF(MM.EQ.NWORD) NBIT=N-(NWORD-1)*LBIT
         JU = JND-1
C
C     LOCATE SET BITS
         DO 4 MMU = 1,NBIT
            IF (BTEST(IMM,0)) THEN
               JU = JU+1
               K(JU)=MMU-1
               NSET = NSET+1
            ENDIF
         IMM = ISHFT(IMM,-1)
    4    CONTINUE
    9    M = JU
         IF(MM.EQ.1) GO TO 2
C
C     BIAS WORDS OTHER THAN THE FIRST
         KND=JND+NSET-1
         IBIAS=(MM-1)*LBIT
         DO 3 NN=JND,KND
    3    K(NN)=K(NN)+IBIAS
    2    JND=JND+NSET
    1 CONTINUE
      END
Commit	Line	Data
fe4da5cc	1	*
	2	* $Id$
	3	*
	4	* $Log$
	5	* Revision 1.1.1.1 1996/02/15 17:49:41 mclareni
	6	* Kernlib
	7	*
	8	*
	9	#include "kerngen/pilot.h"
	10	SUBROUTINE BITPOS(I,N,K,M)
	11	C
	12	C CERN PROGLIB# M508 BITPOS .VERSION KERNFOR 4.16 870601
	13	C ORIG. OCT 81, M.METCALF, CERN/DD
	14	C
	15	C TO INDICATE WHICH BITS IN A SERIES OF WORDS ARE SET.
	16	C BITS WITHIN A WORD ARE NUMBERED RIGHT-TO-LEFT, STARTING AT 0.
	17	C
	18	C I=INPUT WORDS
	19	C N=NO. OF BITS TO BE TESTED
	20	C K=POSITION ARRAY
	21	C M=NO. OF SET BITS IN THE FIRST N POSITIONS
	22	C
	23	#include "kerngen/wordsize.inc"
	24	PARAMETER (LBIT = NBITPW)
	25	C
	26	INTEGER I(),K()
	27	LOGICAL BTEST
	28	C
	29	C INITIALIZE
	30	NWORD=(N-1)/LBIT+1
	31	M=0
	32	JND=1
	33	NBIT = LBIT
	34	C
	35	C UNPACK EACH WORD
	36	DO 1 MM=1,NWORD
	37	NSET = 0
	38	IMM = I(MM)
	39	IF(MM.EQ.NWORD) NBIT=N-(NWORD-1)*LBIT
	40	JU = JND-1
	41	C
	42	C LOCATE SET BITS
	43	DO 4 MMU = 1,NBIT
	44	IF (BTEST(IMM,0)) THEN
	45	JU = JU+1
	46	K(JU)=MMU-1
	47	NSET = NSET+1
	48	ENDIF
	49	IMM = ISHFT(IMM,-1)
	50	4 CONTINUE
	51	9 M = JU
	52	IF(MM.EQ.1) GO TO 2
	53	C
	54	C BIAS WORDS OTHER THAN THE FIRST
	55	KND=JND+NSET-1
	56	IBIAS=(MM-1)*LBIT
	57	DO 3 NN=JND,KND
	58	3 K(NN)=K(NN)+IBIAS
	59	2 JND=JND+NSET
	60	1 CONTINUE
	61	END