	SUBROUTINE PHBOX4 (TSC, OPREF, STATUS, OPDATA, LOPREF)
C
C	   Routine to produce the Photocomp PDF Card Interchange Format
C	   cards for Box 4, the Optical Data.
C	   Interchange cards 15-17. TSC is .TRUE. to include type setting
C	   codes, .FALSE. otherwise.
C
C	   LOPREF is .TRUE. if an optical reference is found, .FALSE.
C	   otherwise.  LOPREF is tested in PHOTO$MAIN to determine if
C	   the line for the optical reference has been used or if it is
C	   available for use in the comments box.
C
C	   By: Mark Holomany, JCPDS     Date: 15-Feb-1984
C
C	   Revised:
C	   15-Jul-87 SJK Modified for RET5
C	   19-JUL-87 MAH Pass OPREF as CALL argument to control len
C
C==========================================================================

	IMPLICIT INTEGER (A-Z)

	CHARACTER*80  CARD
	CHARACTER*(*) OPREF
	LOGICAL       OPDATA,LOPREF
	LOGICAL       TSC

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

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

	CALL ESTMOD ('PHBOX4')

	STATUS = 0

C=======================================================================
C
C	   Working on Card 15 -- Optical Data
C
C=======================================================================

	OPDATA = .FALSE.
	LOPREF  = .FALSE.
	IF(NUMC(11).EQ.0) GO TO 7000

	DO 4001 N=1,NUMC(11)
	IF(CARDB(N)(68:69) .EQ. 'OP') THEN
	   CALL PHOPTI(CARDB(N)(1:67), 'MDB', IRET, CARD)
	   IF(IRET .NE. 0) THEN
	      IF(IRET .NE. 2) CARD = ' '
	      STATUS = IRET
	   ENDIF
	   RETCRD(15) = CARD
	   OPDATA = .TRUE.
	   GO TO 100
	ENDIF
4001	CONTINUE

	RETCRD(15) = ' '

C=======================================================================
C
C	   Working on Cards 16&17 -- Optical Data Reference
C
C=======================================================================

100	CONTINUE
	CALL DOREFS ('OP', .FALSE., .TRUE., IRET, OPREF, LENREF)

	IF(LENREF .GT. 0) THEN
C
C	   .. Drop the OP ref if 'Ibid.' to save space in Box 4 of the
C	   .. PDF Card.  (the photocomp program will not print the
C	   .. 'Ref" line if there is no reference)
	   IF(OPREF(1:5) .EQ. 'Ibid.') THEN
	      RETCRD(16) = ' '
	      RETCRD(17) = ' '
	   ELSE
	      IF(LENREF .LT. LEN(OPREF)) OPREF(LENREF+1:) = ' '
	      RETCRD(16) = OPREF(1:80)
	      RETCRD(17) = OPREF(81:LEN(OPREF))
	      LOPREF = .TRUE.
	   ENDIF
	   GO TO 9000
	ENDIF
C
C	... Check if "Ibid." is implied, ie. if there was Optical Data
	IF(OPDATA) THEN
	   RETCRD(16) = 'Ibid.'
	   RETCRD(17) = ' '
	   LOPREF = .TRUE.
	ELSE
           RETCRD(16) = ' '
           RETCRD(17) = ' '
	ENDIF

	GO TO 9000

C
C	... There is no Optical Data; Write out blank cards for 15-17
7000	CONTINUE
	RETCRD(15) = ' '
	RETCRD(16) = ' '
	RETCRD(17) = ' '

9000	CONTINUE
	CALL DESMOD ('PHBOX4')
	RETURN
	END
