SUBROUTINE VAROUT (INDEX,IX2)
	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   +            CALC    VERSION  X01-06             +
C   +  PETER BAUM  1-SEP-77                          +
C   ++++++++++++++++++++++++++++++++++++++++++++++++++
C     LAST MODIFIED  26-SEP-77  P.B. 11/12/82 GCE
C
C **************************************************
C *                                                *
C *       SUBROUTINE   VAROUT                      *
C *                                                *
C **************************************************
C
C
C
C  OUTPUTS THE VALUE OF THE VARIABLE POINTED TO BY INDEX.
C
C  ASCII     A1 FORMAT UNLESS THE ASCII VALUE IS LESS THAN 32.
C            IN SUCH CASES, 32 IS ADDED TO THE VALUE AND THE
C            CHARACTER IS OUTPUT  SO THAT IT IS PRECEDED BY THE
C            CHARACTER '^'.
C
C  DECIMAL   A COMPUTED F FORMAT.
C
C  HEXADECIMAL  LEADING ZEROES, "BASE 16" QUE.
C
C  INTEGER   I12 FORMAT
C
C  OCTAL     LEADING ZEROES, "BASE 8" QUE
C
C  REAL      D25.18 FORMAT
C
C
C  MODIFICATION CLASSES: M1,M4,M8
C
C
C
C  VAROUT CALLS
C
C ERRMSG   PRINTS OUT ERROR MESSAGES
C MOUT     OUTPUTS MULTIPLE PRECISION NUMBERS
C
C
C
C
C
C VAROUT IS CALLED BY CALC AND POSTVL
C
C
C
C  VARIABLE   USE
C
C  DEC        HOLDS NUMBER OF DIGITS TO THE RIGHT OF THE
C             DECIMAL POINT IN F FORMAT SPECIFICATION.
C  DFORM(11)  HOLDS FORMAT SPECIFICATION FOR F FORMAT
C             (OUTPUTTING VALUE OF VARIABLES WITH DECIMAL DATA TYPE).
C  DIGITS     HOLDS THE ASCII CHARACTERS FOR VARIOUS DIGITS.
C  EIGHT(8)   USED TO PICK OFF REAL*8 'S FROM VBLS.
C             ALSO HOLDS HEXADECIMAL DIGITS IF # IS DATA TYPE HEX.
C  FOUR(4)    USED TO PICK OFF INTEGER*4'S FROM VBLS.
C  I,K        HOLDS TEMPORARY VALUES.
C  I1         HOLDS THE FIRST DIGIT IN CREATING AN F FORMAT SPECIFICATION.
C  I2         HOLDS THE SECOND DIGIT IN CREATING AN F FORMAT SPEC.
C  INDEX      POINTS TO VARIABLE BEING OUTPUT.
C  IPT        POINTER FOR DFORM.
C  ISV        POINTER FOR VECTOR SIGN(2).
C  ITWO       TWO IS USED TO PICK OFF A BYTE OF THE INTEGER
C  TWO(2)     REPRESENTATION. THEN ITWO IS USED AS
C             THE VALUE. THIS IS DONE BECAUSE OTHERWISE
C             SOME COMPILERS WOULD FORCE A SIGN EXTEND.
C  L          TEMPORARY VALUES. POINTER FOR EIGHT(8).
C  LEVIN(11)  HOLDS PRINTABLE ASCII CHARACTERS WHICH REPRESENT
C             AN OCTAL NUMBER. EQUIVALENCED WITH EIGHT(8).
C  M1         HOLDS HIGH ORDER HEXADECIMAL DIGIT.
C  M2         HOLDS LOW ORDER HEXADECIMAL DIGIT.
C  MAG        HOLDS THE MAGNITUDE OF A REAL*8 NUMBER
C  P10        REAL*8 THAT HOLDS POWERS OF 10. (DECIMAL)
C  RETCD      HOLDS RETURN CODE FROM CALL TO MOUT.
C  RPAR       ')'
C  SIGN(2)    HOLDS PRINTABLE ASCII CHARACTERS FOR OUTPUTTING THE
C             SIGN OF A NUMBER.
C  STAR1      HOLDS A SINGLE CHARACTER.
C  VBLS(100,27)  HOLDS VALUE FOR EACH VARIABLE.
C  WIDTH      WIDTH SPECIFICATION FOR F FORMAT.
C
C
C
C	SUBROUTINE VAROUT (INDEX,IX2)
C
C NOTE THAT VAROUT IS USED TO DUMP ONLY VALUES FROM AVBLS, NOT
C VBLS (IX2=1 ALWAYS AT CALLS). THUS DON'T BOTHER TO PICK UP
C ANY FURTHER INFO FROM VBLS HERE.
	REAL*8 REAL,MAG,P10
C
	INTEGER*4 INT,L,K
C
	INTEGER*2 ITWO,INDEX
	INTEGER*2 TYPE(RRW,RCL),WIDTH,DEC,VLEN(9),RETCD
C
	LOGICAL*1 AVBLS(100,27),STAR1,EIGHT(8),FOUR(4)
	LOGICAL*1 VBLS(8,RRW,RCL)
	LOGICAL*1 TWO(2)
	LOGICAL*1 DFORM(11),DIGITS(16,3),LEVIN(11)
	LOGICAL*1 SIGN(2)
	LOGICAL*1 ALPHA(27),COMMA,BLANK,RPAR,LPAR,EQ
	INTEGER*2 OSWIT,OCNTR
C NOTE: OSWIT NONZERO MEANS OUTPUT TO OARRY.
C OSWIT=2 MEANS NO ZEROING OF OARRY; NOTHING MUCH COMES OUT.
	LOGICAL*1 OARRY(100)
	COMMON/OAR/OSWIT,OCNTR,OARRY
C
	COMMON /V/ TYPE,AVBLS,VBLS,VLEN
	COMMON /DIGV/ DIGITS
	COMMON /CONS/ ALPHA,COMMA,BLANK,RPAR,LPAR,EQ
C
	EQUIVALENCE (TWO,ITWO)
	EQUIVALENCE (REAL,EIGHT),(INT,FOUR),(EIGHT,LEVIN)
C
	DATA SIGN/' ','-'/
	DATA DFORM /'(', '1', 'X', ',', 'F', ' ', ' ', '.', ' ', ' ',
     ;  ')'/
	DATA TWO/0,0/
C
C
C
	K=TYPE(INDEX,IX2)
	IF (K.GT.0) GOTO 10
	CALL ERRMSG (16)
	GOTO 10000
10	GOTO (100,200,300,400,500,600,700,800,900),K
	STOP 10
C
C
C
C
C **************************************************
C **************        ASCII        ***************
C **************************************************
100	STAR1=AVBLS(1,INDEX)
	IF(OSWIT.NE.0)GOTO 6006
	IF (STAR1.LT.32) GOTO 110
102	WRITE (1,103) STAR1
103	FORMAT (1X,A1)
	RETURN
110	STAR1=STAR1+32
	WRITE (1,112) STAR1
112	FORMAT (1X,'^',A1)
	RETURN
6006	OARRY(1)=STAR1
	OCNTR=1
	RETURN
C
C
C
C
C
C **************************************************
C ****************  DECIMAL   **********************
C **************************************************
200	CONTINUE
	DO 208 I=1,8
208	EIGHT(I)=AVBLS(I,INDEX)
	MAG=DABS(REAL)
	IF (MAG.LT.1.D0) GOTO 240
C
C
C COUNT THE # OF DIGITS TO THE LEFT OF THE DECIMAL POINT
	P10=1.D0
	DO 210 I=1,38
	P10=10.D0*P10
	IF (P10.GT.MAG) GOTO 212
210	CONTINUE
C
C I COUNTS THE # OF DIGITS TO THE LEFT OF THE DECIMAL POINT
	I=39
212	DEC=0
	WIDTH=17
	IF(I.GT.15)WIDTH=I+2
	IF(I.LE.15)DEC=15-I
C
C
C  CREATE PROPER FORMAT STATEMENT
215	I1=WIDTH/10
	I2=WIDTH-I1*10
	IF (I2.EQ.0) I2=10
	DFORM(6)=DIGITS(I1,1)
	DFORM(7)=DIGITS(I2,1)
	I1=DEC/10
	I2=DEC-I1*10
	IF (I1.EQ.0) I1=10
	IF (I2.EQ.0) I2=10
	IPT=9
	IF (I1.EQ.0) GOTO 220
	DFORM(9)=DIGITS(I1,1)
	IPT=IPT+1
220	DFORM(IPT)=DIGITS(I2,1)
	DFORM(IPT+1)=RPAR
C
C
C
C
C  OUTPUT REAL USING NEWLY CREATED
C  FORMAT STATEMENT HELD BY DFORM
	IF(OSWIT.NE.0)GOTO 6009
	WRITE (1,DFORM) REAL
	GOTO 10000
6009	CONTINUE
	IF(OSWIT.EQ.2) GOTO 6101
	IF(OSWIT.GT.3)GOTO 7101
	DO 6010 OCNTR=1,106
6010	OARRY(OCNTR)=0
6101	ENCODE(100,DFORM,OARRY)REAL
7101	OCNTR=100
	GOTO 10000
C
C
C  REAL LESS THAN 1.D0
240	P10=1.D0
	DO 245 I=1,38
	P10=P10*.1D0
	IF (MAG.GE.P10) GOTO 250
245	CONTINUE
	I=0
C
C I-1 REPRESENTS THE NUMBER OF LEADING ZEROS
250	DEC=14+I
	WIDTH=DEC+3
	GOTO 215
C
C
C
C
C
C **************************************************
C *************  HEXADECIMAL  **********************
C **************************************************
C  HEXADECIMAL
300	CONTINUE
	DO 302 I=1,4
302	FOUR(I)=AVBLS(I,INDEX)
	ISV=1
	IF (INT.LT.0) ISV=2
	INT=IABS(INT)
	L=8
	DO 304 I=1,4
C PICK UP A VALUE, THEN USE INTEGER*2 EQUIVALENT
C TO WORK WITH SO SIGN DOESN'T GET EXTENED.
	TWO(1)=FOUR(I)
	M1=ITWO/16
	M2=ITWO-M1*16
	IF(M1.EQ.0)M1=16
	IF(M2.EQ.0)M2=16
	EIGHT(L)=DIGITS(M2,3)
	L=L-1
	EIGHT(L)=DIGITS(M1,3)
	L=L-1
304	CONTINUE
	IF(OSWIT.NE.0)GOTO 6011
	WRITE (1,310) SIGN(ISV), EIGHT
310	FORMAT (1X,1A1,8A1,2X,'(BASE 16)')
	GOTO 10000
6011	CONTINUE
	IF(OSWIT.EQ.2)GOTO 6102
	IF(OSWIT.GT.3)GOTO 7102
	DO 6013 OCNTR=1,106
6013	OARRY(OCNTR)=0
6102	ENCODE(8,6012,OARRY)SIGN(ISV),EIGHT
6012	FORMAT(A1,8A1)
7102	OCNTR=9
	GOTO 10000
C
C
C
C
C
C **************************************************
C ***************   INTEGER   **********************
C **************************************************
400	DO 404 I=1,4
404	FOUR(I)=AVBLS(I,INDEX)
	IF(OSWIT.NE.0)GOTO 6014
	WRITE (1,410) INT
410	FORMAT (1X,I12)
	GOTO 10000
6014	CONTINUE
	IF(OSWIT.EQ.2)GOTO 6103
	IF(OSWIT.GT.3)GOTO 7104
	DO 6015 OCNTR=1,106
6015	OARRY(OCNTR)=0
6103	ENCODE(12,410,OARRY)INT
7104	OCNTR=12
	GOTO 10000
C
C
C
C
C
C **************************************************
C ***********    MULTIPLE PRECISION   **************
C **************************************************
C  MULTIPLE PRECISION
C  M10
500	CONTINUE
C
C  M8
600	CONTINUE
C
C  M16
700	CALL MOUT (INDEX,RETCD)
	GOTO 10000
C
C
C
C
C
C **************************************************
C ****************   OCTAL   ***********************
C **************************************************
C  OCTAL
800	DO 804 I=1,4
804	FOUR(I)=AVBLS(I,INDEX)
	ISV=1
	IF (INT.LT.0) ISV=2
	K=IABS(INT)
	DO 810 I=1,11
	L=K-K/8*8
C TAKE ABSOLUTE VALUE IN CASE FIRST IABS DIDN'T WORK ON -2**31
	L=IABS(L)
	IF(L.EQ.0)L=9
	LEVIN (12-I)=DIGITS(L,2)
	K=K/8
810	CONTINUE
	IF(OSWIT.NE.0)GOTO 6016
	WRITE (1,820) SIGN(ISV), LEVIN
820	FORMAT (1X,1A1,11A1,2X,'(BASE 8)')
	GOTO 10000
6016	CONTINUE
	IF(OSWIT.EQ.2)GOTO 6100
	IF(OSWIT.GT.3)GOTO 7105
	DO 6018 OCNTR=1,106
6018	OARRY(OCNTR)=0
6100	ENCODE(12,6017,OARRY)SIGN(ISV),LEVIN
6017	FORMAT(12A1)
7105	OCNTR=12
	GOTO 10000
C
C
C
C
C
C **************************************************
C ***************    REAL    ***********************
C **************************************************
900	DO 904 I=1,8
904	EIGHT(I)=AVBLS(I,INDEX)
	IF(OSWIT.NE.0)GOTO 6019
	WRITE (1,910) REAL
910	FORMAT (1X,D25.18)
	GOTO 10000
6019	CONTINUE
	IF (OSWIT.EQ.2)GOTO 6020
	IF(OSWIT.GT.3)GOTO 7106
	DO 6321 OCNTR=1,106
6321	OARRY(OCNTR)=0
6020	CONTINUE
	ENCODE(28,6021,OARRY)REAL
6021	FORMAT(D25.18)
7106	OCNTR=28
10000	RETURN
	END