*-----------------------------------------------------------------------
*     BITPIC
*-----------------------------------------------------------------------
*     Copyright (C) 2000-2022 GFD Dennou Club. All rights reserved.
*-----------------------------------------------------------------------
      SUBROUTINE BITPIC(IP,CP)

      CHARACTER CP*(*)

      PARAMETER (NB=32)

      INTEGER   MASK(NB)
      LOGICAL   LFST

      SAVE

      EXTERNAL  ISHIFT

      DATA      LFST/.TRUE./


      IF (LFST) THEN
        CALL GLIGET('NBITSPW',NBITPW)
        IF (NBITPW.NE.NB) THEN
          CALL MSGDMP('E','BITPIC',
     +      'NUMBER OF BITS PER ONE WORD IS INVALID / '//
     +      'CHECK NB IN THE PARAMETER STATEMENT OF BITPIC '//
     +      'AND CHANGE IT CORRECTLY.')
        END IF
        MASK(1)=1
        DO 10 I=2,NB
          MASK(I)=ISHIFT(MASK(I-1),1)
   10   CONTINUE
        LFST=.FALSE.
      END IF

      NBC=LEN(CP)
      DO 15 I=1,MIN(NBC,NB)
        II=NBC-I+1
        IF (IAND(MASK(I),IP).EQ.0) THEN
          CP(II:II)='0'
        ELSE
          CP(II:II)='1'
        END IF
   15 CONTINUE

      END
