	SUBROUTINE PDF2PRT (LOUT)
C
C	Minor modification of PRTCRD (see below) The order of PHBOX5
C	was changed so routine prints comments correctly, if used
C	before PDFCRD (PDF2ANSI/PDF2DUMB)		B.H. Toby 6/88
C
C	     Routine to produce a nicely formatted, compact printed
C	     output for the PDF Card retrieval/display system.
C
C	        LOUT - Local output unit number for writes
C
C	     By: Mark Holomany, JCPDS     Date: 20-Jul-1987
C
C=======================================================================
 
	IMPLICIT INTEGER (A-Z)
 
C	  ... Maximum characters per line of output to left-hand side
C	  ... of printed 132-col card
D	PARAMETER    (MAXCPL = 85)
C\	 PARAMETER    (MAXCPL = 85)
	CHARACTER*(2*MAXCPL-5)  REFBUF
 
	CHARACTER*1   TEMP
	CHARACTER*5   LGLSP
	CHARACTER*6   FMTS(4)
	CHARACTER*9   SPHEAD(5)
        character*12  user
	REAL          SPIN, SPOUT

	CHARACTER*1   QUALTY, REPLY, XCHAR, DELCD
	CHARACTER*3   PICODE
	CHARACTER*8   CARDNO
	CHARACTER*80  LINE1(2), LINE2(2), LINE
	CHARACTER     SG*20, A*13,B*13,C*13, Z*8,MP*25,DX*8,DM*8
	LOGICAL       OPDATA, LOPREF, DONE, EXIST
	REAL          MATRIX(9)
 
	COMMON /CDEQPD/ EQCELS
	LOGICAL         EQCELS
 
D	INCLUDE 'CURCRD.CMN'
D	INCLUDE 'CVTSP.CMN'
D	INCLUDE 'IORET.CMN'
D	INCLUDE 'LINEDR.CMN'
D	INCLUDE 'PDFDATA.CMN'
D	INCLUDE 'PICDS.CMN'
D	INCLUDE 'REFTRK.CMN'
D	INCLUDE 'SWITCH.CMN'

C\$INCLUDE:'CURCRD.CMN'
C\$INCLUDE:'CVTSP.CMN'
C\$INCLUDE:'IORET.CMN'
C\$INCLUDE:'LINEDR.CMN'
C\$INCLUDE:'PDFDATA.CMN'
C\$INCLUDE:'PICDS.CMN'
C\$INCLUDE:'REFTRK.CMN'
C\$INCLUDE:'SWITCH.CMN'

	COMMON /COMCRD/  CCARD, NUMPHC, CHPHC, CDCNT, FSTCRD, LINKCM,
	1                 STCRD, NUMCD
	CHARACTER        CCARD*1760
	INTEGER          CDCNT(30), FSTCRD(30), LINKCM(20)
	INTEGER          STCRD(30)
 
	CHARACTER*12 DOLLAR_CODES
	CHARACTER*29 GRAPH(2)
	CHARACTER*7  DELTD(2)
	LOGICAL      DIGIT
 
	COMMON /DIH/ DSPACE,INTEN,HKAYL,SUB
	CHARACTER*9  DSPACE(200)
	CHARACTER*4  INTEN(200)
	CHARACTER*22 HKAYL(200)
	INTEGER*2    SUB

CCCCC	COMMON /PRIDSP/ DSP, FOOTCODES, FOOTNOTE
CCCCC     	CHARACTER*44    DSP(200)
CCCCC     	CHARACTER*5     FOOTCODES
CCCCC     	CHARACTER*1     FOOTNOTE(5)
 
	DATA  DOLLAR_CODES /'$DA$DD$SE$PG'/
	DATA  GRAPH /'Card has diffractometer trace', ' '/
	DATA  DELTD /'DELETED', ' '/
 
	DATA  LGLSP /'12SQD'/
	DATA  FMTS  /'(F7.3)', '(F7.3)', '(F7.5)', '(F7.5)'/
	DATA  SPHEAD /'  theta  ', ' 2-theta ', ' sin2 th ',
	1             '   Q A   ', '   d A   '/

C
C	 ... Set up printer for compressed print, 8 lpi
C\	CALL SETPRN ('COMP1')
C\	CALL SETPRN ('8LPI')
C
C	... Reset switches for routines that must be re-executed due
C	... to special character translation (PITRAN)
	SWPBX1 = .FALSE.
	SWPBX3 = .FALSE.
	SWPBX4 = .FALSE.
	SWPBX5 = .FALSE.
C
C	... Make sure PITRAN uses only printable ASCII characters
	ASCII = .TRUE.

C
C	  ... Check if PD and CD cells are equivalent.  To do this, check
C	  ... if the transformation matrix on CARDC is the identity matrix.
C	  ... This was suggested by C. R. Hubbard.
	EQCELS = .FALSE.
 
	IF(NUMC(12).EQ.1) THEN
	   READ (CARDC, 1803) MATRIX
1803 	   FORMAT(6X,3( 3(F5.2,1X), 1X))
	   DO 4100 N=1,9,4
	   IF(MATRIX(N) .NE. 1.0) GO TO 30
4100 	   CONTINUE
	   DO 4200 N=2,4
	   IF(MATRIX(N) .NE. 0.0  .OR.  MATRIX(N+4) .NE. 0.0) GO TO 30
4200 	   CONTINUE
	   EQCELS = .TRUE.
	ENDIF
30   	CONTINUE
 
 
C========================================================================
 
 
CCCCC	DO 10 I=1,200
CCCCC     	DSP(I)(11:13) = ' | '
CCCCC     	DSP(I)(20:21) = ' | '
CCCCC10   	DSP(I)(44:44) = '|'
CCCCC 
CCCCC3000 	CONTINUE
CCCCC	DO 4000 I=2,28
CCCCC	IF(I .GE. 19) THEN
CCCCCC    	     .. Check for and translate footnote codes
 
C????????????????????? CHECK FOR AND FIX COMMENTS
 
C>>>     IF(PATERN(I)(1:1) .EQ. '$') THEN
C>>>        NFOOT = (INDEX (DOLLAR_CODES, PATERN(I)(1:3)) + 2)  /  3
C>>>        IF(NFOOT .GE. 1) PATERN(I)(1:3) = FOOTNOTE(NFOOT+1)
C>>>     ENDIF
C>>>	ENDIF
C>>>4000 	CONTINUE
 
C>>>	CALL GETDSP (NDSP)

C
C       .. Reset counts/existence indicators for footnotes
	IF(.NOT. SWTRFN) THEN
	   CALL TRFNCH ('RESET_ALL', .TRUE., IRET, XCHAR, PICODE, COUNT)
	   SWTRFN = .TRUE.
	ENDIF
C
C	... Do general comments now for same order as in PDFCRD
!	IF(.NOT. SWPBX5) THEN
!	   CALL PHBOX5 (STATUS)
!	   SWPBX5 = .TRUE.
!	ENDIF
C
C       ... Format d-spacings
	IF(.NOT. SWDSP) THEN
	   CALL PHDSP (STATUS)
	   SWDSP = .TRUE.
	ENDIF
C
C	 ... Blank out DSPACE, INTEN and HKAYL up to 25 if there are less
C	 ... than 25 dspacings.  Most patterns have > 25 dspacings, plus
C	 ... this vastly simlifies the logic of this program
	NDPLS1 = SUB + 1
	IF(SUB .LE. 0) NDPLS1 = 1
	DO 4010 N=NDPLS1,25
	DSPACE(N) = ' '
	INTEN(N)  = ' '
	HKAYL(N)  = ' '
4010	CONTINUE
C
C	... Convert spacings to non-d representation if user requested
	SPTYPE = INDEX(LGLSP, ISPACG)
	IF(ISPACG .NE. 'D') THEN
	   SWDSP = .FALSE.
C
C	    ... Save array DSPACE since the conversion to other units
C	    ... looses the original info.  Read back in at end of routine.
	   OPEN (UNIT=NFTMP1, FILE='DSPACE.SAV', STATUS='UNKNOWN',
	1        FORM='UNFORMATTED', ACCESS='SEQUENTIAL')
	   WRITE(NFTMP1) DSPACE
	   CLOSE (UNIT=NFTMP1, STATUS='KEEP')

	   DO 4015 N=1,SUB
	   READ (DSPACE(N), '(F9.0)', ERR=200) SPIN
	   GO TO 250
200	   L = LENGTH(DSPACE(N))
	   TEMP = DSPACE(N)(L:L)
	   DSPACE(N)(L:L) = ' '
	   IF(DSPACE(N)(1:1) .EQ. '[') THEN
	      READ (DSPACE(N)(2:8), '(F7.0)') SPIN
	   ELSE
	      READ (DSPACE(N)(1:8), '(F8.0)') SPIN
	   ENDIF
	   DSPACE(N)(L:L) = TEMP

250	   CALL DSPCVT (ISPACG, CONST, SPIN, SPOUT)
	   WRITE(DSPACE(N)(2:8), FMTS(SPTYPE)) SPOUT
4015	   CONTINUE
	ENDIF
C
C       ... Format Box 1
	IF(.NOT. SWPBX1) THEN
	   CALL PHBOX1 (STATUS)
	   SWPBX1 = .TRUE.
	ENDIF

C
C	  ... First line - heading
	QUALTY = RETCRD(1)(9:9)
C
C	... Deleted pattern?
	NDELTD = 2
	IF(RETCRD(1)(10:10) .EQ. 'D') NDELTD = 1
C
C	  ... Graphical pattern?
	NGRAPH = 2
	IF(RETCRD(1)(11:11) .EQ. 'G') NGRAPH = 1
 
	WRITE(LOUT,1201) RETCRD(1)(1:8), CONST*2, QUALTY,
	1                 DELTD(NDELTD), GRAPH(NGRAPH)
1201 	FORMAT(/' ',A,3X,'JCPDS-ICDD Copyright (c) 1990',
	1       4X,'Radiation:',F9.5,'  Quality: ',A, 5X,A,4X,A)
	WRITE(LOUT,1250)
1250 	FORMAT(' ',12('----------'), '-------')
C
C	  ... Chem. Formula & Dot Formula
	CALL SHFORM (RETCRD(2), LINE1(1), LINE2(1), SIZE1)
	CALL SHFORM (RETCRD(3), LINE1(2), LINE2(2), SIZE2)
	IF(SIZE1 .LT. 1) THEN
	   SIZE1 = 1
	   LINE1(1)(1:1) = ' '
	   LINE2(1)(1:1) = ' '
	ENDIF
	IF(SIZE2 .LT. 1) THEN
	   SIZE2 = 1
	   LINE1(2)(1:1) = ' '
	   LINE2(2)(1:1) = ' '
	ENDIF
 
	WRITE(LOUT,1208) SPHEAD(SPTYPE)
1208 	FORMAT(' | ',T89,'|',A9,'| Int.|',
	1      '         h k l        |')

	WRITE(LOUT,1202) LINE1(1)(1:SIZE1),LINE1(2)(1:SIZE2)
1202 	FORMAT(' | ',A,T47,A,T89,'|', 9('-'), '+', 5('-'), '+',
	1      22('-'),'|')
	WRITE(LOUT,1252) LINE2(1)(1:SIZE1),LINE2(2)(1:SIZE2)
1252 	FORMAT(' | ',A,T47,A,T89,'|',9X,'|',5X,'|',22X,'|')
 
	WRITE(LOUT,1253) DSPACE(1), INTEN(1), HKAYL(1)
1253 	FORMAT(' | ',T89,'|',A9,'|',1X,A4,'|',A22,'|')
C
C	  ... Chem. Name & Mineral Name
	WRITE(LOUT,1254) RETCRD(4), DSPACE(2), INTEN(2), HKAYL(2)
	WRITE(LOUT,1254) RETCRD(5), DSPACE(3), INTEN(3), HKAYL(3)
	WRITE(LOUT,1254) RETCRD(6), DSPACE(4), INTEN(4), HKAYL(4)
1254 	FORMAT(' | ',A,T89,'|',A9,'|',1X,A4,'|',A22,'|')
 
	WRITE(LOUT,1255) DSPACE(5), INTEN(5), HKAYL(5)
1255 	FORMAT(' |',86('-'),T89,'|',A9,'|',1X,A4,'|',A22,'|')
C
C	  ... Box 2 -- Rad, lambda, filter, d-sp, cutoff, int, I/Icor, ref
	IF(.NOT. SWPBX2) THEN
	   CALL PHBOX2 (.FALSE., REFBUF, STATUS)
	   SWPBX2 = .TRUE.
	ENDIF

	WRITE(LOUT,1210) RETCRD(7)( 1: 9), RETCRD(7)(10:17),
	1                RETCRD(7)(18:29), RETCRD(7)(30:41)
1210 	FORMAT(' | ','Rad: ',A,2X, 'Lambda: ',A,9X, 'Filter: ',A,2X,
	1  'd-sp: ',A, T89,'|',9X,'|',5X,'|',22X,'|')
 
	WRITE(LOUT,1266) RETCRD(7)(42:46), RETCRD(7)(47:60),
	1                RETCRD(7)(61:68), 
	2                DSPACE(6), INTEN(6), HKAYL(6)
1266 	FORMAT(' | ','Cutoff: ',A,3X, 'Int: ',A,6X, 'I/Icor: ',A,
	1  T89,'|',A9,'|',1X,A4,'|',A22,'|')
                 
    	WRITE(LOUT,1268) RETCRD(8), DSPACE(7), INTEN(7), HKAYL(7)
1268 	FORMAT(' | ','Ref: ',A,T89,'|',A9,'|',1X,A4,'|',A22,'|')

	WRITE(LOUT,1261) RETCRD(9), DSPACE(8), INTEN(8), HKAYL(8)
1261 	FORMAT(' | ',        A,T89,'|',A9,'|',1X,A4,'|',A22,'|')
                  
	WRITE(LOUT,1207) DSPACE(9), INTEN(9), HKAYL(9)
1207 	FORMAT(' |',86('-'),T89,'|',A9,'|',1X,A4,'|',A22,'|')
C                     
C	  ... Box 3 -- sys,sg,a,b,c,A,C,A,B,C,Z,ref
	IF(.NOT. SWPBX3) THEN
	   CALL PHBOX3 (.FALSE., REFBUF, STATUS)
	   SWPBX3 = .TRUE.
	ENDIF

	SG = ' ' // RETCRD(10)(19:30)
	IF(RETCRD(10)(31:33) .NE. ' ')
	1  SG(15:) = '(' // RETCRD(10)(31:33) // ')'
	IF(RETCRD(10)(34:34) .EQ. 'B') THEN
	   SG(1:1) = '['
	   SG(20:20) = ']'
	ENDIF
	CALL CMPRES (SG,SIZE)
	I = INDEX(SG, '(')
	IF(I .NE. 0) THEN
	   DO 4090 JI=LEN(SG)-1,I,-1
4090 	   SG(JI+1:JI+1) = SG(JI:JI)
	   SG(I:I) = ' '
	ENDIF
 
	WRITE(LOUT,1262) RETCRD(10)(1:18), SG, 
	1                DSPACE(10), INTEN(10), HKAYL(10)
1262 	FORMAT(' | ','Sys: ',A,5X, 'S.G.: ',A,T89,'|',
	1  A9,'|',1X,A4,'|',A22,'|')
 
	CALL ADDERR (A, RETCRD(10)(35:43), RETCRD(10)(44:45))
	CALL ADDERR (B, RETCRD(10)(46:54), RETCRD(10)(55:56))
	CALL ADDERR (C, RETCRD(10)(57:65), RETCRD(10)(66:67))
	WRITE(LOUT,1213) A,B,C,RETCRD(11)(1:8),RETCRD(11)(9:16)
1213 	FORMAT(' | ','a: ',A,2X, 'b: ',A,2X, 'c: ',A,2X,
	1  'A: ',A,2X, 'C: ',A, T89,'|',  9X,'|',5X,'|',22X,'|')
 
	CALL ADDERR (A, RETCRD(11)(17:24), RETCRD(11)(25:26))
	CALL ADDERR (B, RETCRD(11)(27:34), RETCRD(11)(35:36))
	CALL ADDERR (C, RETCRD(11)(37:44), RETCRD(11)(45:46))
	Z = ' ' // RETCRD(11)(47:52)
	IF(RETCRD(11)(53:53) .EQ. 'B') THEN
	   Z(1:1) = '['
	   Z(8:8) = ']'
	   CALL CMPRES(Z,SIZE)
	ENDIF

	WRITE(LOUT,1264) A,B,C,Z,RETCRD(11)(54:78),
	1                DSPACE(11), INTEN(11), HKAYL(11)
1264 	FORMAT(' | ','A: ',A,2X, 'B: ',A,2X, 'C: ',A,2X, 'Z: ',A,
	1  2X,'mp: ',A, T89,'|',A9,'|',1X,A4,'|',A22,'|')
 
	WRITE(LOUT,1267) RETCRD(12), DSPACE(12), INTEN(12), HKAYL(12)
1267 	FORMAT(' | ', 'Ref: ',A,T89,'|',A9,'|',1X,A4,'|',A22,'|')

	WRITE(LOUT,1265) RETCRD(13), DSPACE(13), INTEN(13), HKAYL(13)
1265 	FORMAT(' | ',         A,T89,'|',A9,'|',1X,A4,'|',A22,'|')
C
C	  ... Box 3 -- Physical constants: Dx,Dm,SS/FOM
	DX = ' ' // RETCRD(14)(1:6)
	IF(RETCRD(14)(7:7) .EQ. 'B') THEN
	   DX(1:1) = '['
	   DX(8:8) = ']'
	   CALL CMPRES(DX,SIZE)
	ENDIF
	DM = ' ' // RETCRD(14)(8:13)
	IF(RETCRD(14)(14:14) .EQ. 'B') THEN
	   DM(1:1) = '['
	   DM(8:8) = ']'
	   CALL CMPRES(DM,SIZE)
	ENDIF

	WRITE(LOUT,1220) DX,DM,RETCRD(14)(15:36),
	1                DSPACE(14), INTEN(14), HKAYL(14)
1220 	FORMAT(' | ','Dx: ',A,2X, 'Dm: ',A,2X, 'SS/FOM: ',A,
	1      T89,'|',A9,'|',1X,A4,'|',A22,'|')
 
	WRITE(LOUT,1255) DSPACE(15), INTEN(15), HKAYL(15)
C
C	  ... Box 4 -- Optical Data: ea,nwb,ey,sign,2v
	IF(.NOT. SWPBX4) THEN
	   CALL PHBOX4 (.FALSE., REFBUF, STATUS, OPDATA, LOPREF)
	   SWPBX4 = .TRUE.
	ENDIF

	WRITE(LOUT,1221) RETCRD(15)( 1:10), RETCRD(15)(11:20),
	1                RETCRD(15)(21:30), RETCRD(15)(31:33),
	2                RETCRD(15)(34:45)
1221 	FORMAT(' | ','ea: ',A,2X, 'nwB: ',A,2X, 'ey: ',A,2X,
	1  'Sign: ',A,2X, '2V: ',A, T89,'|',9X,'|',5X,'|',22X,'|')
 
	WRITE(LOUT,1269) RETCRD(16), DSPACE(16), INTEN(16), HKAYL(16)
1269 	FORMAT(' | ','Ref: ', A,T89,'|',A9,'|',1X,A4,'|',A22,'|')

	WRITE(LOUT,1265) RETCRD(17), DSPACE(17), INTEN(17), HKAYL(17)
	WRITE(LOUT,1255) DSPACE(18), INTEN(18), HKAYL(18)
C
C	  ... Box 18 -- General Comments
C
C 
C	... Do general comments now for same order as in PDFCRD
	IF(.NOT. SWPBX5) THEN
	   CALL PHBOX5 (STATUS)
	   SWPBX5 = .TRUE.
	ENDIF
C	  ... First, initialize pointers for CCARD array; NCC is the
C	  ... starting position of the last comment card
	STCRD(NUMPHC+1) = 1760
	NCC = 0
 
	CALL NXTCOM (MAXCPL, NCC, BEGIN, LSTPOS, EXIST)
	END = LSTPOS
	CALL DELTSC (CCARD, BEGIN, END, LSTPOS)
	WRITE(LOUT,1280)  CCARD(BEGIN:LSTPOS), 
	1                 DSPACE(19), INTEN(19), HKAYL(19)

	CALL NXTCOM (MAXCPL, NCC, BEGIN, LSTPOS, EXIST)
	END = LSTPOS
	CALL DELTSC (CCARD, BEGIN, END, LSTPOS)
	WRITE(LOUT,1280)  CCARD(BEGIN:LSTPOS), 
	1                 DSPACE(20), INTEN(20), HKAYL(20)
 
	CALL NXTCOM (MAXCPL, NCC, BEGIN, LSTPOS, EXIST)
	END = LSTPOS
	CALL DELTSC (CCARD, BEGIN, END, LSTPOS)
	WRITE(LOUT,1232)  CCARD(BEGIN:LSTPOS)

	DO 4020 KNDSP=21,25
	CALL NXTCOM (MAXCPL, NCC, BEGIN, LSTPOS, EXIST)
	END = LSTPOS
	CALL DELTSC (CCARD, BEGIN, END, LSTPOS)
	WRITE(LOUT,1280) CCARD(BEGIN:LSTPOS), 
	1                DSPACE(KNDSP), INTEN(KNDSP), HKAYL(KNDSP)
4020 	CONTINUE
1280 	FORMAT(' | ',A, T89,'|',A9,'|',1X,A4,'|',A22,'|')
1232 	FORMAT(' | ',A, T89,'|',9X,'|',5X,'|',22X,'|')
 
	DO 4030 N=30,32
	CALL NXTCOM (MAXCPL, NCC, BEGIN, LSTPOS, EXIST)
	END = LSTPOS
	CALL DELTSC (CCARD, BEGIN, END, LSTPOS)
	WRITE(LOUT,1232) CCARD(BEGIN:LSTPOS)
4030 	CONTINUE
	WRITE(LOUT,1250)
 
C
C	  ... Done with the first 25 d-spacings
	IF(SUB .LE. 25) GO TO 9000
	WRITE(LOUT,'(1X)')
	ENDD = 25
	DX2  = 0
	MAXDLT = 30

100	STARTD = ENDD + DX2 + 1
	DELTA  = MIN0( (SUB - STARTD + 3)/3, MAXDLT)
	DELTA  = (DELTA + 4)/5*5
	ENDD   = DELTA + STARTD - 1
	DX1    = DELTA
	DX2    = DX1 + DELTA
        IF(ENDD .GT. SUB) ENDD = SUB

C
C	 ... Finish rest of d-spacings
	WRITE(LOUT,1296)
1296	FORMAT(' ',11('----------'), '--------')

	WRITE(LOUT,1290) SPHEAD(SPTYPE),SPHEAD(SPTYPE),SPHEAD(SPTYPE)
1290 	FORMAT(' |',A9,'| Int.|         h k l        |',
	1           A9,'| Int.|         h k l        |',
	2           A9,'| Int.|         h k l        |')

	WRITE(LOUT,1291)
1291	FORMAT(' |',  2(9('-'),'+',5('-'),'+',22('-'),'+'), 
	1  9('-'),'+',5('-'),'+',22('-'),'|')
    	WRITE(LOUT,1292)
1292	FORMAT(' |',  3(9X,'|',5X,'|',22X,'|'))
C
C	 ... Print 3 columns across, 30 spacings per column
	DO 4060 KNDSP=STARTD,ENDD
	IF(KNDSP+DX2 .LE. SUB) THEN
	   WRITE(LOUT,1293) DSPACE(KNDSP), INTEN(KNDSP), HKAYL(KNDSP),
	1       DSPACE(KNDSP+DX1), INTEN(KNDSP+DX1), HKAYL(KNDSP+DX1),
	2       DSPACE(KNDSP+DX2), INTEN(KNDSP+DX2), HKAYL(KNDSP+DX2)
1293 	   FORMAT(' |',A9,'|',1X,A4,'|',A22,'|',
	1              A9,'|',1X,A4,'|',A22,'|',
	2              A9,'|',1X,A4,'|',A22,'|')

	ELSE IF(KNDSP+DX1 .LE. SUB) THEN
	   WRITE(LOUT,1294) DSPACE(KNDSP), INTEN(KNDSP), HKAYL(KNDSP),
	1       DSPACE(KNDSP+DX1), INTEN(KNDSP+DX1), HKAYL(KNDSP+DX1)
1294 	   FORMAT(' |',A9,'|',1X,A4,'|',A22,'|',
	1              A9,'|',1X,A4,'|',A22,'|',
	2              9X,'|',   5X,'|',22X,'|')

	ELSE
	   WRITE(LOUT,1295) DSPACE(KNDSP), INTEN(KNDSP), HKAYL(KNDSP)
1295 	   FORMAT(' |',A9,'|',1X,A4,'|',A22,'|',
	1              9X,'|',   5X,'|',22X,'|',
	2              9X,'|',   5X,'|',22X,'|')
	ENDIF
	IF((KNDSP/5*5 .EQ. KNDSP) .AND. 
	1  (KNDSP .NE. ENDD)) WRITE(LOUT,1292)
4060	CONTINUE
	WRITE(LOUT,1296)

C
C	 ... More d-spacings?
	IF(SUB .GT. ENDD+DX2) THEN
	   MAXDLT = 60
	   WRITE(LOUT,1297)
1297	   FORMAT('1')
	   WRITE(LOUT,1201) RETCRD(1)(1:8), CONST*2, QUALTY,
	1                   DELTD(NDELTD), GRAPH(NGRAPH)
	   WRITE(LOUT,*) 'CONTINUED'
	   GO TO 100
	ENDIF
 
9000 	CONTINUE
!        call who(user)
!        write(lout,9999) user
!9999    format(///' this job was run by ',a12)
C
C	 ... Reset printer for non-compressed print, 6 lpi
C\	CALL SETPRN ('COMP0')
C\	CALL SETPRN ('6LPI')
 
C
C	 ... Revert back to original DSPACE array if conversion made.
	IF(ISPACG .NE. 'D') THEN
	   OPEN (UNIT=NFTMP1, FILE='DSPACE.SAV', STATUS='OLD',
	1        FORM='UNFORMATTED', ACCESS='SEQUENTIAL')
	   READ(NFTMP1) DSPACE
	   CLOSE (UNIT=NFTMP1, STATUS='DELETE')
	ENDIF
	RETURN
	END
