	SUBROUTINE PHBOX2 (TSC, PDREF, STATUS)
C
C	   Routine to produce interchange format cards for Box 2,
C	   the powder pattern information area, of the new style
C	   PDF Card (25&26).   TSC = .TRUE. to include typesetting codes,
C	   .FALSE. otherwise  10/22/85
C
C	   By: Mark Holomany, JCPDS     Date: 15-Feb-1984
C
C	   Revisions:
C	    7-May-85 MAH Shorten "Graph Mono." and "Quartz Mono."
C	                 to "Mono." so it wil fit on card.
C	   15-Jun-87 SJK RET5 Modifications
C	   19-JUL-87 MAH Pass PDFEF as CALL parameter to control len
C
C============================================================================
  
	IMPLICIT INTEGER (A-Z)

	CHARACTER*5   CUTOFF
	CHARACTER*8   IICOR
	CHARACTER*12  DSPSRC, FILTER, TEMP
	CHARACTER*14  INTSRC
	CHARACTER*(*) PDREF
	LOGICAL	      TSC

D	INCLUDE 'CURCRD.CMN'
D	INCLUDE 'IORET.CMN'
D	INCLUDE 'PDFDATA.CMN'
D	INCLUDE 'RET3.CMN'

C\$INCLUDE:'CURCRD.CMN'
C\$INCLUDE:'IORET.CMN'
C\$INCLUDE:'PDFDATA.CMN'
C\$INCLUDE:'RET3.CMN'

	CALL ESTMOD ('PHBOX2')
	STATUS = 0

C=======================================================================
C
C	   Working on Card 7 -- Powder Pattern Information
C
C=======================================================================

	IF(NUMC(15).EQ.0) THEN
	   FILTER = ' '
	   DSPSRC = ' '
	   CUTOFF = ' '
	   GO TO 100
	ENDIF
C
C	... Do d-spacing stuff; lambda and filter
	CALL LEFT(CARDF(7:15),SIZE)

	IF(CARDF(23:28) .NE. ' ') THEN
	   FILTER = CARDF(23:28)
C
C==>5/2/85 MAH	   TEMP = FILTER
C==>5/2/85 MAH	   CALL UPPER(TEMP)
C==>5/2/85 MAH	   IF(TEMP .EQ. 'QUARTZ') FILTER = 'SiO#2'
C
	ELSE
	   FILTER = ' '
	ENDIF

	L = LENGTH(FILTER)
	IF(L .GT. 0) L=L+1
	IF     (CARDF(21:21) .EQ. 'F') THEN
	   IF(L .EQ. 0) FILTER = 'Beta'
	ELSE IF(CARDF(21:21) .EQ. 'M') THEN
	   FILTER(L+1:) = 'Mono.'
	ELSE IF(CARDF(21:21) .EQ. 'S') THEN
	   FILTER(L+1:) = 'S.S. Det.'
	ENDIF
C
C	... Check if FILTER field might be too long to typeset
	IF(LENGTH(FILTER) .GT. 12) THEN
	   CALL ERRTXT ('W', 
	1     'FILTER field may be too long to typeset: "' // FILTER // 
	2     '"')
	ENDIF

C
C	... Do "Dsp." -- source of d-spacing measurements
	IF     (CARDF(41:41) .EQ. 'D') THEN
	   DSPSRC = 'Diff.'
	ELSE IF(CARDF(41:41) .EQ. 'F') THEN
	   DSPSRC = 'Gandolfi'
	ELSE IF(CARDF(41:41) .EQ. 'G') THEN
	   DSPSRC = 'Guinier'
	   IF(CARDF(43:47).NE.' ') THEN
C	      .. add camera diameter
	      CALL LEFT(CARDF(43:47),SIZE)
	      IF(SIZE.GT.4) THEN
	         DSPSRC = 'Guin. -' // CARDF(43:47)

	      ELSE
	         DSPSRC(8:) = '-' // CARDF(43:46)
	      ENDIF
	   ENDIF

	ELSE IF(CARDF(41:41) .EQ. 'S') THEN
	   DSPSRC = 'D.S.'
	   IF(CARDF(43:47).NE.' ') THEN
C	      .. add camera diameter
	      DSPSRC(6:) = '-' // CARDF(43:47)
	   ENDIF

	ELSE IF(CARDF(41:41) .EQ. 'X') THEN
	   DSPSRC = ' '
C==>	   WRITE(NOUT,1602) CARD1(1)(73:78)     !MAH 2-26-86
C==>1602	   FORMAT(' %PHBOX2-W-OTHER ',A,'-"Other" used for dsp or ',
C==>	1    'Int source, will be blank on card.')
	ELSE IF(CARDF(41:41) .EQ. 'C') THEN
	   DSPSRC = 'Calculated'
	ELSE
	   DSPSRC = ' '
	ENDIF
C
C	... Do d-spacing Cutoff value
	CALL LEFT(CARDF(33:37),SIZE)
	CUTOFF =  CARDF(33:37)
	IF(CUTOFF.NE.' ' .AND. CARDF(30:30).NE.'D')
	1  CALL ERRTXT ('W', 'Cutoff value may not be in angstroms')

C=====================================================================

100	CONTINUE
	IF(NUMC(16).EQ.0) THEN
	   INTSRC = ' '
	   IICOR  = ' '
	   GO TO 200
	ENDIF
C
C	... Do Intensity stuff; first "Int." then "I/Icor."
	IF     (CARDG(1:1) .EQ. 'D') THEN
	   INTSRC = 'Diffractometer'
	ELSE IF(CARDG(1:1) .EQ. 'F') THEN
	   INTSRC = 'Densitometer'
	ELSE IF(CARDG(1:1) .EQ. 'V') THEN
	   INTSRC = 'Visual'
	ELSE IF(CARDG(1:1) .EQ. 'X') THEN
	   INTSRC = ' '
C==>	   WRITE(NOUT,1602) CARD1(1)(73:78)     !MAH 2-26-86
	ELSE IF(CARDG(1:1) .EQ. 'C') THEN
	   INTSRC = 'Calculated'
	ELSE
	   INTSRC = ' '
	ENDIF

	IICOR = CARDG(5:10)
	CALL LEFT(IICOR,L)
	IF(CARDG(12:15).NE.' ') THEN
	   CALL LEFT(CARDG(12:15),SIZE)
	   SIZE = LENGTH(CARDG(12:15))
	   L    = LENGTH(IICOR)
	   IICOR(L+1:) = '(' // CARDG(12:12+SIZE-1) // ')'
	   IF(L+SIZE+2 .GT. 8) THEN
	      CALL ERRTXT ('W', 
	1     'I/Icor + Esd. too long; truncated on card')
	      STATUS = 1
	   ENDIF
	ENDIF
C
C	   Write out Card 7
C
200     WRITE(RETCRD(7),1107) CARDF(1:5),CARDF(7:14),FILTER,
	1                     DSPSRC,CUTOFF,INTSRC,IICOR
1107	FORMAT(A9,A8,A12,A12,A5,A14,A8,12X)

C=======================================================================
C
C	   Working on Cards 8&9 -- Powder Pattern Reference
C
C=======================================================================

	IF(DBSW .EQ. 'PDF2') THEN
	   CALL DOREFS ('  ', .FALSE., .TRUE., IRET, PDREF, LENREF)
	ELSE IF(DBSW .EQ. 'CDIF') THEN
	   CALL DOREFS ('CD', .FALSE., .TRUE., IRET, PDREF, LENREF)
	ENDIF
C
C	... Primary reference not typeset.  Might be absent OR might be
C	... too long for box.  Will try possibility of "000PDF" reference
C	... first; otherwise, assume too large.
	IF(LENREF .EQ. 0) THEN
C	   ... Use "000PDF" reference, if one exists
	   CALL DOREFS ('JC', .FALSE. , .TRUE., IRET, PDREF, LENREF)
	   IF(LENREF .GT. 0) THEN
C	      ... Found "000PDF"
	      IF(LENREF .LT. LEN(PDREF)) PDREF(LENREF+1:) = ' '
	   ELSE
C	      ... Didn't find "000PDF"
	      IF(NUMC(9) .GE. 1) THEN
 	         PDREF = 
	1     'See comments box for primary powder pattern reference.  '
	         LENREF = 56
	      ELSE
	         PDREF = ' '
	      ENDIF
	   ENDIF
	ENDIF
C
C	 ... Add secondary powder reference, if one exists
	CALL DOREFS ('PD', .TRUE. , .TRUE., IRET, PDREF, LENREF)
	IF(LENREF .LT. LEN(PDREF)) PDREF(LENREF+1:) = ' '

	RETCRD(8) = PDREF(1:80)
	RETCRD(9) = PDREF(81:LEN(PDREF))

8000	CONTINUE
	GO TO 9000

9000	CONTINUE
	CALL DESMOD ('PHBOX2')
	RETURN
	END
