.TITLE	ENCODE SFGL70 ROUTINE TO ENCODE A FLOATING PT. #

.IDENT	'ENCO00'

.PSECT	ENCODE

;	KEN DEMERS
;	UTRC
;	OCT 1979

;	THIS ROUTINE ENCODES THE FLOATING POINT NUMBER
;	PASSED TO IT INTO G17.6 F$ORMAT.
;	THE ENCODE IS ACCOMPLISHED USING FORTRAN
;	OTS ROUTINES.

;	CALLING FORMAT:

;	CALL ENCODE(NUMBER)
;	WHERE:
;	NUMBER = FLOATING POINT NUMBER TO BE ENCODED



;	INTERNAL GLOBALS

.GLOBL	E$NCODE

;	EXTERNAL GLOBALS

.GLOBL	$SEQC,ENF$,IOAR$,EOLST$
.GLOBL	$OTSVA,RCI$
.GLOBL	R$STARG,S$AVARG
.GLOBL	C$BUFF,S$TRLEN,F$ORMAT
.GLOBL	G$FLEN,B$UFLEN





E$NCODE: CALL	S$AVARG		;SAVE REGS
	MOV	#C$BUFF,R0	;R0= A(C$BUFF)
	MOV	#B$UFLEN,R1	;INIT GET BUFF LEN IN WRDS
ENC10:	CLR	(R0)+		;INIT BUFFER
	SOB	R1,ENC10	;LOOP UNTIL DONE
	MOV	#-4,$SEQC	;OTS ROUTINE
	MOV	#G$FLEN,-(SP)	;MAX LEN OF CHAR BUFF
	MOV	#F$ORMAT,-(SP)	;ADDR OF F$ORMAT STATEMENT
	MOV	#C$BUFF,-(SP)	;ADDR OF BUFFER TO STORE E$NCODED CHARS
	CALL	ENF$		;OTS ROUTINE
	MOV	2(R5),-(SP)	;ADDR OF # TO BE E$NCODED
	CALL	IOAR$		;OTS ROUTINE
	CALL	EOLST$		;OTS ROUTINE
	MOV	#C$BUFF,R0	;THIS CODE GETS RID OF
	MOV	R0,R1		;LEADING AND TRAILING SPACES
ENC20:	TSTB	(R0)		;END OF STRING?
	BEQ	ENC30		;YES
	CMPB	#' ,(R0)+	;LEADING OR TRAILING SPACE?
	BEQ	ENC20		;YES IGNORE IT
	MOVB	-1(R0),(R1)+	;MOVE CHAR TO FRONT OF BUFFER
	BR	ENC20		;CONTINUE
ENC30:	CMPB	#'0,-(R1)	;TRAILING ZERO?
	BNE	ENC40		;NO
	CMP	#C$BUFF,R1	;START OF BUFF?
	BLT	ENC30		;NO
ENC40:	CLRB	1(R1)		;PUT IN A TERMINATING 0
	MOV	R1,R5		;SAVE ADDR OF LAST CHAR
	SUB	#C$BUFF-1,R1	;GET LENGTH OF ENCODED STRING
	MOV	#3,R4		;INIT # OF CHARS TO BE MOVED CNT
ENC50:	CMPB	#'E,-(R5)	;IS THERE AN 'E' IN THE STRING?
	BEQ	ENC60		;YES
	CMP	#C$BUFF,R5	;START OF BUFF?
	BGE	ENC100		;YES
	INC	R4		;BUMP # OF BYTES TO BE MOVED
	BR	ENC50
ENC60:	MOV	R5,R3		;SAVE ADDR OF 'E'
ENC65:	CMPB	#'0,-(R5)	;'E' PRECEEDED BY A 0?
	BNE	ENC70		;NO
	CMP	#C$BUFF,R5	;START OF BUF?
	BLT	ENC65		;NO
ENC70:	INC	R5		;PT TO LOC TO STORE 'E'
ENC80:	MOVB	(R3)+,(R5)+	;MOV 'E...'
	SOB	R4,ENC80	;LOOP UNTIL DONE
ENC90:	SUB	#C$BUFF+1,R5	;GET # CHARS IN STRING
	MOV	R5,R1		;SAVE IT
ENC100:	MOV	R1,S$TRLEN	;SAVE IT
ENC110:	CALL	R$STARG		;RESTORE REGS
	RETURN

	.END