	SUBROUTINE MOUT(INDEX,RETCD)
C COPYRIGHT (C) 1983 GLENN EVERHART
C PERMISSION IS GIVEN TO ANYONE TO USE, DISTRIBUTE, OR COPY THIS
C PROGRAM FREELY BUT NOT TO SELL IT COMMERICALLY.
	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 *      SUBROUTINE  MOUT (INDEX,RETCD)            *
C *                                                *
C **************************************************
C
C
C THIS ROUTINE OUTPUTS VALUE OF A MULTIPLE PRECISION VARIABLE
C
C
C
C     RETCD    MEANING
C
C      1         O.K.
C      2         ERROR
C
C
C  MODIFICATION CLASSES:  M1,M3
C
C
C
C
C MOUT CALLS
C
C  ERRMSG    PRINTS ERROR MESSAGES
C  PRTCON    CONVERTS 1-10 TO PRINTABLE 1,2,...9,0
C
C
C
C
C MOUT IS CALLED BY VAROUT
C
C
C
C MODIFIED 5-DEC-1979 P.B.
C  FIXED PROBLEM FOR COMPILERS WHOSE RUN-TIME SYSTEM DOESN'T ALLOW
C  EXTRA COMMAS IN DYNAMICALLY CREATED FORMAT STATEMENTS
C
C
C
C
C
C
C      VARIABLE        USE
C
C    BVEC(3)      HOLDS BASE VALUES TO BE INDEXED BY IBASE AND PRINTED
C                 UNDER I2 FORMAT.
C    DIGITS(16,3) PRINTABLE ASCII DIGITS.
C    FORHEX       HOLDS OUTPUT FORMAT STATEMENT WHEN OUTPUTTING HEXADECIMAL
C                 NUMBERS (SEPARATES GROUPS OF 4 DIGITS WITH COMMAS).
C    FORMAT       HOLDS OUTPUT FORMAT STATEMENT WHEN OUTPUTTING NUMBERS WITH
C                 COMMAS EVERY 3 DIGITS. FIRST PART IS USED WHEN LESS THAN
C                 4 DIGITS OR HEXADECIMAL AND EXACTLY 4 DIGITS IS OUTPUT.
C    I,I1,I2      TEMPORARY VALUES
C    IBASE        CODES BASE: 1=BASE 10, 2=BASE 8, 3=BASE 16
C    IGRP         NUMBER OF COMMAS NEEDED TO SEPARATE DIGITS.
C    INDEX        POINTER TO VARIABLE TO BE OUTPUT.
C    LOG1         LOGICAL*1 USED AS ARGUMENT IN PRTCON CALLS.
C    NONE         NUMBER OF DIGITS TO BE PRINTED.
C    RPAR         ')'
C    SIGN(2)      VECTOR USED TO PRINT APPROPRIATE SIGN ('+' OR '-')
C    TYPE         HOLDS TYPE OF EACH VARIABLE.
C
C
C
C
C	SUBROUTINE MOUT(INDEX,RETCD)
C
C
C INDEX POINTS TO AN ELEMENT IN VBLS TO BE OUTPUT
C (A MULTIPLE PRECISION NUMBER BASE 10, 8, OR 16)
C
C
C
	InTEgeR*4 RETCD,VLEN(9)
	InTEgeR*4 TYPE(RRWP,RCLP)
	InTEgeR*4 BVEC(3)
	InTEgeR*4 I,I1,I2
	InTEgeR*4 IBASE,INDEX,NONE,IGRP
C
C
	LOGICAL*1 AVBLS(20,27),LOG1
	LOGICAL*1 VBLS(8,RRWP,RCLP)
	LOGICAL*1 PRTCON
	LOGICAL*1 SIGN(2),FORMAT(24),FORHEX(24),RPAR,COMMA
C
C
	COMMON /V/ TYPE,AVBLS,VBLS,VLEN
C
C
	DATA COMMA/','/
	DATA BVEC/10,8,16/
	DATA SIGN/' ','-'/, RPAR/')'/
	DATA FORMAT/'(', '1', 'X', ',', '1', 'A', '1', ',', ' ',
     2  'A', '1', ',', ' ', ' ', '(', '''', ',', '''', ',', '3',
     3  'A', '1', ')', ')'/
C
C
	DATA FORHEX/'(', '1', 'X', ',', '1', 'A', '1', ',', ' ',
     2  'A', '1', ',', ' ', ' ', '(', '''', ',', '''', ',', '4',
     3  'A', '1', ')', ')'/
C
C
C SET DEFAULT RETURN CODE (O.K.)
	RETCD=1
C
C IBASE = 1  IF BASE 10,   2 IF BASE 8,   3 IF BASE 16
	CALL TYPGET(INDEX,1,TYPE(1,1))
	IBASE=TYPE(1,1)-4
C
C
C
C MAKE SURE THE VARIABLE IS DEFINED
	CALL TYPGET(INDEX,1,TYPE(1,1))
	IF(TYPE(1,1).NE.0)GO TO 10
	STOP 10
C
C
C DETERMINE THE NUMBER OF DIGITS TO BE PRINTED.
10	DO 20 I=2,20
	NONE=21-I
	IF(AVBLS(NONE,INDEX).NE.0)GO TO 30
20	CONTINUE
	NONE=1
C
C NONE POINTS TO THE NUMBER OF DIGITS TO BE PRINTED
30	IF(NONE.GT.4.OR.(NONE.EQ.4.AND.IBASE.NE.3)) GOTO 50
C
C
C **************************************************
C ****** ONLY 1,2, OR 3 DIGITS (4 IF HEX) **********
C **************************************************
	LOG1=NONE
C
C PUT IN NUMBER OF DIGITS.
	FORMAT(9)=PRTCON(LOG1,1)
C
C END FORMAT STATEMENT.
C   IF RUN-TIME SYSTEM ALLOWS EXTRA COMMAS IN DYNAMICALLY CREATED
C   FORMAT STATEMENTS, USE
C	FORMAT(13)=RPAR
C    INSTEAD OF
	FORMAT(12)=RPAR
40	CONTINUE
C
C
C
C ///// WRITE NON-HEXADECIMAL NUMBER /////
	WRITE(1,FORMAT) SIGN(AVBLS(20,INDEX)+1),(PRTCON(AVBLS(
     2  NONE+1-I,INDEX),IBASE),I=1,NONE)
C
C NEED THE FOLLOWING ONLY IF
C	FORMAT(12)=RPAR
C INSTEAD OF
C	FORMAT(13)=RPAR
C ABOVE
	FORMAT(12)=COMMA
	GO TO 10000
C
C
C MORE THAN 3 DIGITS SO USE COMMAS TO SEPARATE GROUPS
50	IF(IBASE.EQ.3) GO TO 200
C
C
C ******************************************************
C **  DECIMAL OR OCTAL NUMBER WITH MORE THAN 3 DIGITS **
C ******************************************************
C
C FIRST CALCULATE THE NUMBER OF COMMAS NEEDED.
	IGRP=NONE/3
	LOG1=NONE-IGRP*3
	IF(LOG1.NE.0)GO TO 55
	IGRP=IGRP-1
	LOG1=3
C
C CONVERT GROUP COUNT TO PRINTABLE ASCII FOR FORMAT STATEMENT.
55	I1=IGRP/10
	I2=IGRP-I1*10
	FORMAT(9)=PRTCON(LOG1,1)
	LOG1=I1
	FORMAT(13)=PRTCON(LOG1,1)
	LOG1=I2
	FORMAT(14)=PRTCON(LOG1,1)
	GO TO 40
C
C
C
C
C **************************************************
C *** HEXADECIMAL NUMBER WITH MORE THAN 4 DIGITS ***
C **************************************************
C
C CALCULATE THE NUMBER OF COMMAS NEEDED.
200	IGRP=NONE/4
	LOG1=NONE-IGRP*4
	IF(LOG1.NE.0)GO TO 210
	IGRP=IGRP-1
	LOG1=4
C
C CONVERT GROUPT COUNT TO ASCII FOR FORMAT STATEMENT.
210	I1=IGRP/10
	I2=IGRP-I1*10
	FORHEX(9)=PRTCON(LOG1,1)
	LOG1=I1
	FORHEX(13)=PRTCON(LOG1,1)
	LOG1=I2
	FORHEX(14)=PRTCON(LOG1,1)
C
C
C ///// WRITE OUT HEXADECIMAL NUMBER /////
	WRITE(1,FORHEX) SIGN(AVBLS(20,INDEX)+1),
     2  (PRTCON(AVBLS(NONE+1-I,INDEX),IBASE),I=1,NONE)
	GO TO 10000
C
C
C
C
C *************************
C **** EXIT PROCESSING ****
C *************************
10000	CONTINUE
	WRITE(1,10010) BVEC(IBASE)
10010	FORMAT(' (BASE ',I2,')')
	RETURN
	END
C
C
C **********************************
C *                                *
C *    INTERNAL FUNCTION PRTCON    *
C *                                *
C **********************************
C CALLED BY MOUT ONLY
C CONVERTS 0 TO APPROPRIATE NUMBER FOR PRINTING WITH VECTOR DIGITS
	FUNCTION PRTCON(L1,IBASE)
	InTEgeR*4 BASE(3)
	InTEgeR*4 IBASE,K
	LOGICAL*1 L1,PRTCON,DIGITS(16,3)
	COMMON /DIGV/ DIGITS
	DATA BASE /10,8,16/
	PRTCON=L1
	IF(L1.EQ.0)PRTCON=BASE(IBASE)
	K=PRTCON
	PRTCON=DIGITS(K,IBASE)
	RETURN
	END
