SUBROUTINE PTOLP
C
C	SUBROUTINE TO DUMP ALL COLOR SCOPE PARAMETERS TO LP:
C
	INTEGER*4 ALAB,C
	INTEGER	IDATE(10)
	COMMON /SCRAT/ALAB(46,3),A(46,3),IA(60),IPP(3)
	DATA	IDATE/10*' '/
	I	= 0
	IMAX	= 0				! MAX NUMBER COLOR PAGE
1	IPAGS	= 1
	ITST	= 0
	CALL DATE(IDATE)
	CALL TIME(IDATE(6))
	CALL ZERO(ALAB,46*6)			! NO DATA AT FIRST
5	IPAGE	= 0				! NON ZERO IF DATA THIS PAGE
	IPP(IPAGS)	= I			! SAVE PAGE #
	IL	= 0				! INITIALLY 0
10	CALL PSCAN(ITST,C,D,ISKP,ILIM)		! GET 1 PARAMETER
	IF(ITST .EQ. 0)GO TO 90			! DONE? IF SO 90
	IP	= IRAM(ITST,8,"17)		! PAGE # OF PARAMETER
	IF(IP .GT. IMAX)IMAX	= IP		! SAVE MAX PAGE #
	IF(IP .NE. I)GO TO 10			! NEXT PARAM IF NOT CORRECT PAGE
	IL	= IL + 1			! NEXT LOCATION
	IL	= IL + ISKP
	IF(IL .GT. 46)GO TO 90			! TOO MANY THIS PAGE
	IPAGE	= -1				! NOTE THAT FOUND DATA	1
	ALAB(IL,IPAGS)	= C			! SAVE LABEL
	A(IL,IPAGS)	= D			! SAVE VALUE
	GO TO 10				! LOOK FOR MORE PARAMS
90	CONTINUE
	IL	= 0				! Reset line number
	ITST	= 0
	I	= I + 1				! NEXT PAGE #
	IF(IPAGE .NE. 0)IPAGS	= IPAGS + 1	! NUMBER OF PAGES PROCESSED
	IF(I .LE. IMAX .AND. IPAGS .LE. 3)GO TO 5	! ONLY 3 MAY BE DONE
	IPAGS	= IPAGS - 1			! MAX # PAGES TO PRINT
	IF(IPAGS .LE. 0)RETURN
	WRITE(6,1001)				! INSERT BLANK LINE
	DO 99 J	= -1,22				! PRINT 24 LINES
	DO 91 K	= 1,60
91	IA(K)	= ' '				! ARRAY OF BLANKS
	IF(J .EQ. 0)CALL MOVE(IDATE,IA,10)
	DO 95 K	= 0,1
	DO 95 L	= 1,IPAGS			! PROCESS ALL PAGES
	IL	= J + K*24			! PARAMETER #
	M	= 1 + 10 * (2*(L-1) + K)	! INDEX IN ARRAY IA
	IF(IL .GE. 1)GO TO 93			! IF OUT OF RANGE NO PRINT
	IF(IL .EQ. -1)ENCODE(20,1003,IA(M))IPP(L)	! WRITE PAGE #
	IF(IL .EQ. 1)CALL MOVE(IDATE,IA(M),10)	! WRITE DATE,TIME
	GO TO 95
93	IF(ALAB(IL,L) .EQ. 0)GO TO 95		! NO PARAM! 
	ENCODE(20,1000,IA(M))ALAB(IL,L),A(IL,L)
95	CONTINUE
	WRITE(6,1001)IA				! PRINT 1 LINE
99	CONTINUE
	IF(I .LE. IMAX)GO TO 1			! IF MORE PAGES, CONTINUE
1000	FORMAT(A4,1P,G14.7)
1001	FORMAT(10X,60A2)
1003	FORMAT('COLOR PP#'I2 )
	END