SUBROUTINE BASCNG(RETCD)
	INCLUDE 'VKLUGPRM.FTN'
C	PARAMETER RRW = 32
C	PARAMETER RCL = 32
C RRW=MAX REAL ROWS
C RCL=MAX REAL COLS
C RRW MUST BE 1 LARGER TO HANDLE 1ST 27 VARIABLES IN AVBLS
C VBLS AND TYPE DIMENSIONED RRW,RCL
C   ++++++++++++++++++++++++++++++++++++++++++++++++++
C   +                                                +
C   +            CALC    VERSION  X01-06             +
C   +                                                +
C   ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C
C
C
C *******************************************************
C *                                                     *
C *       SUBROUTINE   BASCNG                           *
C *                                                     *
C *******************************************************
C
C
C SUBROUTINE BASCNG IS CALLED WHEN THE *B CALC COMMAND IS
C ENCOUNTERED. THIS COMMAND INDICATES THAT THE DEFAULT BASE
C FOR CONSTANTS IS TO BE CHANGED. THE ROUTINE READS IN ONE
C OR TWO DIGITS AND CHANGES THE DEFAULT BASE SPECIFICATION
C AS IS APPROPRIATE.
C
C
C
C MODIFICATION CLASS M2
C
C
C
C
C   BASCNG CALLS
C
C  ERRMSG  (PRINTS ERROR MESSAGES)
C  GETNNB  (GETS THE NEXT NON-BLANK IN INPUT LINE LINE(80))
C
C
C
C
C  BASCNG IS CALLED BY ROUTINE CMND WHICH IDENTIFIES THE COMMAND THAT
C  THE USER WANTS TO EXECUTE.
C
C
C
C
C
C    VARIABLE       USE
C
C    BASED       HOLDS THE DEFAULT BASE.
C    IPT         POINTS TO THE NEXT NON-BLANK IN LINE(80).
C    I1          BINARY VALUE OF FIRST DIGIT, VALUE OF NEW BASE.
C    I2          BINARY VALUE OF SECOND DIGIT.
C    NONBLK      POINTS TO THE LAST NON-BLANK IN LINE(80)
C    RETCD       RETURN CODE: 1=O.K.  2=ERROR.
C    RETCD2      HOLDS RETURN CODE FROM CALL TO GETNNB
C
C
C
C
C	SUBROUTINE BASCNG(RETCD)
C
C
C UPON ENTRANCE, NONBLK POINTS TO THE 'B' IN '*B' IN LINE
C
	INTEGER*2 IPT,I1,I2
	INTEGER*2 LEVEL,NONBLK,LEND
	INTEGER*2 RETCD,RETCD2,VIEWSW,BASED
C
	LOGICAL*1 DIGITS(16,3),LINE(80)
C
	COMMON /DIGV/ DIGITS
	COMMON LEVEL,LINE,NONBLK,LEND,VIEWSW,BASED
C
C
C
C
C IF NO ARGUMENT, RETURN WITH NORMAL RETURN CODE. THIS ALLOWS THE
C USER TO SEE WHAT THE PRESENT DEFAULT BASE IS.
	RETCD=1
	CALL GETNNB(IPT,RETCD2)
	IF(RETCD2.GT.1)GO TO 1000
C
C
C CHECK OUT FIRST DIGIT
	DO 300 I1=1,10
	IF(DIGITS(I1,1).EQ.LINE(IPT)) GO TO 400
300	CONTINUE
	GO TO 999
C
C
C SEE IF THERE IS A SECOND DIGIT
400	NONBLK=IPT
	IF(I1.EQ.10)I1=0
	CALL GETNNB(IPT,RETCD2)
	IF(RETCD2.EQ.1)GO TO 500
C
C
C IF NOT, CONVERT TO A TWO DIGIT NUMBER WITH A LEADING ZERO.
	I2=I1
	I1=0
	GO TO 700
C
C
C
C A SECOND CHARACTER WAS FOUND; FIGURE OUT WHAT THE BINARY
C VALUE IS (IF IT IS A DIGIT AT ALL).
500	DO 600 I2=1,10
	IF(DIGITS(I2,1).EQ.LINE(IPT))GO TO 700
600	CONTINUE
	GO TO 999
C
C
C
C CONVERT DIGITS TO A NUMBER IF IT IS LEGAL
700	IF(I2.EQ.10)I2=0
	I1=I1*10+I2
	IF(I1.NE.8.AND.I1.NE.10.AND.I1.NE.16) GO TO 999
	BASED=I1
	GO TO 1000
C
C
C ILLEGAL BASE SPECIFICATION
999	RETCD=2
	CALL ERRMSG(19)
C
C RETURN
1000	RETURN
	END