	SUBROUTINE PHREF (TSC, NCARD, STRING, STATUS, L2AUTH)

C-----------------------------------------------------------------------
C
C	   Routine to Photocomp the PDF card References.  It accepts
C	   the starting card of card type 9 (NCARD) and returns
C	   the STATUS.
C
C		NCARD  - Position of first card of reference to
C		         prep for photocomp in array CARD9
C		STRING - A character string returned
C		         with the photocomp ready reference
C		STATUS - Completion status of PHREF:
C		           0 if successful
C		           1 if CODEN wasn't found in the CODENS file
C		           2 if couldn't read CODENS file
C		           3 if reference longer than LEN(STRING) characters
C		           4 if >2 cards used for Authors
C
C		L2AUTH - .TRUE. to allow at most 2 author's names, .FALSE.
C		         to return as many as exist.  If restricted, retruned
C		         string is of the form "name., et al."
C
C		TSC    -   .TRUE. if type setting codes are to be inserted
C                          into the STRING, .FALSE. otherwise.
C
C	   By: Mark Holomany, JCPDS     Date: 13-Feb-1984
C
C	   Revised:
C	   22-Mar-84 MAH -- Words nolonger split across card bundaries;
C	                    warning issued if reference is too long.
C
C	   28-Feb-86 MAH -- Keep track of which refferences are photocomped
C	                    so that those that are not can be added to the
C	                    comments box.
C
C	    4-Mar-86 MAH -- Commented-out code to inhibit fixup of words
C	                    crossing card boundaries, allow STRING to be
C	                    of any length.
C
C	    5-Apr-86 MAH -- Allow reduction to at most 2 author's names
C
C	    3-Mar-86 MAH -- Allow up to 3 cards (first plus 2 continuations
C	                    in reference; check for stuff at end of mult
C	                    authors, ie. '(to be published)'
C
C          15-Jul-87 SJK -- RET5MDB Modifications
C___________________________________________________________________________

	IMPLICIT  INTEGER (A-Z)

	CHARACTER 	STRING*(*)
	CHARACTER*4	VOL,YEAR
	CHARACTER*5	STR5,PAGE
	CHARACTER*7	JUNK
	CHARACTER*71	JOURNL
	LOGICAL         L2AUTH,TSC

D	INCLUDE 'IORET.CMN'
D	INCLUDE 'PDFDATA.CMN'
D	INCLUDE 'REFTRK.CMN'

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

	CALL ESTMOD ('PHREF')

	MAXREF = LEN(STRING)
C
C	... Keep track of those references that are photocomposed
	REFCNT(NCARD) = .TRUE.
C
C	   Author(s) -- maximum of three cards
C
C	... NCHAR is the number of characters used in STRING
	STRING = CARD9(NCARD)(22:67)
	NCHAR = 46
	IF(CARD9(NCARD)(70:70) .EQ. 'C')  THEN

C	   .. Continuation card #1
	   NCHAR = LENGTH(STRING(1:46))
	   STRING(NCHAR+1 : NCHAR+1) = ' '
	   NCHAR = NCHAR + 1
	   STRING(NCHAR+1 : NCHAR+46) = CARD9(NCARD+1)(22:67)
	   NCHAR = NCHAR + 46
	   IF(CARD9(NCARD+1)(70:70) .EQ. 'C') THEN

C	      .. Continuation card #2
	      NCHAR = LENGTH(STRING(1:NCHAR))
	      STRING(NCHAR+1 : NCHAR+1) = ' '
	      NCHAR = NCHAR + 1
	      L3 = LENGTH (CARD9(NCARD+2)(22:67))
	      IF(NCHAR+L3 .LE. MAXREF) THEN
	         STRING(NCHAR+1 : NCHAR+L3) = CARD9(NCARD+2)(22:L3+21)
	      ELSE
	         CALL ERRTXT ('W',
	1          'Second continuation ref card truncated')
	         STRING(NCHAR+1:) = CARD9(NCARD+2)(22:L3+21)
	      ENDIF
	      NCHAR = NCHAR + L3
	      IF(CARD9(NCARD+2)(70:70) .EQ. 'C') THEN
	         CALL ERRTXT ('W', 
	1          'Authors on cards 4+ will not appear on the card')
	         STATUS = 4
	      ENDIF
	   ENDIF
	ENDIF
C
C	... Handle "Ibid." or "IBID." or ...
	STR5 = STRING(1:5)
	CALL UPPER(STR5)
	IF(STR5 .EQ. 'IBID.') THEN
	   STRING(NCHAR:) = ' '
	   STATUS = 0
	   GO TO 9000
	ENDIF
C
C	... Check for excessive number of author's names
	NCHAR = LENGTH(STRING(1:NCHAR))
	IF(.NOT. L2AUTH) GO TO 100
	IF(NCHAR .LT. 0) GO TO 100
	IF(CARD9(NCARD)(1:6) .EQ. '00GRNT' .OR.
	1  CARD9(NCARD)(1:6) .EQ. '0PCOMC' .OR.
	2  CARD9(NCARD)(1:6) .EQ. 'JACGAR' .OR.
	3  CARD9(NCARD)(1:6) .EQ. 'ACCRA9'      ) GO TO 100

	FSTDC = 0
	KNTDC = 0
	POSDC = 0
C
C	.. Search for dot-comma combination that should signal end of
C	.. each author's name.  Rules for card are: as is if there
C	.. two (2) or fewer authors, or first author plus " et al."
C	.. if there are three (3) or more authors
	DO 4050 LOOK=1,NCHAR-1
	IF(STRING(LOOK:LOOK+1) .EQ. '.,') THEN
	   KNTDC = KNTDC + 1
	   IF(KNTDC .LE. 2) THEN
	      POSDC = LOOK
	      IF(KNTDC .EQ. 1) FSTDC = LOOK
	   ELSE
C	      .. Third occurrence of '.,' found (ie. >2 authors here)
	      POSDC = FSTDC
	      STRING(POSDC+1:POSDC+7) = ' et al.'
C
C	      .. Check for '(to be published)' at end of mult authors
	      POSTBP = INDEX( STRING(LOOK:NCHAR), '(' )
	      IF(POSTBP .NE. 0) THEN
	         IF(STRING(NCHAR:NCHAR) .EQ. '.') NCHAR = NCHAR - 1
	         LTBP = (NCHAR - LOOK + 1) - POSTBP + 1
	         STRING(POSDC+8:) = ' ' // STRING(LOOK+POSTBP-1:NCHAR)
	         NCHAR = POSDC + 7 + 1 + LTBP
	      ELSE
	         NCHAR = POSDC + 7
	         STRING(NCHAR+1:) = ' '
	      ENDIF

C>>>	      CALL ERRTXT 
C>>>	1       ('I', 'Mult authors reduced to one plus et al.')
	      GO TO 100
	   ENDIF
	ENDIF
4050	CONTINUE

100	CONTINUE
C
C	... If the last char is a '.' and the one before a lc letter,
C	... delete the '.'
	IF(NCHAR .GT. 0) THEN
	   IF(STRING(NCHAR:NCHAR) .EQ. '.'  .AND.
	1    (STRING(NCHAR-1:NCHAR-1).GE.'a' .AND.
	2     STRING(NCHAR-1:NCHAR-1).LE.'z')      ) THEN
	         IF(NCHAR .GE. 6) THEN
	            IF(STRING(NCHAR-5:NCHAR) .EQ. 'et al.')
	1             NCHAR = NCHAR + 1
	         ENDIF
	         NCHAR = NCHAR - 1
	   ENDIF
	ENDIF
C
C	... Add a "," and switch to Italics
	IF(NCHAR.EQ.0) THEN
	   IF(TSC) THEN
	      STRING(1:3) = '\IT'
	      NCHAR = 3
	   ENDIF
	ELSE
	   IF(TSC) THEN
	      STRING(NCHAR+1 : NCHAR+5) = ', \IT'
	      NCHAR = NCHAR + 5
	   ELSE
              STRING(NCHAR+1 : NCHAR+2) = ', '
	      NCHAR = NCHAR +2
	   ENDIF
	ENDIF
C
C	   Journal -- get journal from CODEN then format correctly
C
C>>>	READ (UNIT=NFIN, KEYEQ=CARD9(NCARD)(1:6), KEYID=0, IOSTAT=IOS)
C>>>	1  JUNK,JOURNL

        CALL SEEKX (CARD9(NCARD)(1:6), JOURNL, STATUS)

	IF(STATUS .EQ. 1) THEN
	   CALL ERRTXT ('W', 
	1    'CODEN "' // CARD9(NCARD)(1:6) // '" not found in file')
           STATUS = 1
	   GO TO 8000
	ELSE IF(STATUS .NE. 0) THEN
	   CALL ERRTXT ('E', 'Unable to read CODEN file')
	   STATUS = 2
	   GO TO 8000
	ENDIF

	L = MAX0(1, LENGTH(JOURNL))
	IF(NCHAR+L .LE. MAXREF) THEN
	   STRING(NCHAR+1 : NCHAR+L) = JOURNL(1:L)
	   NCHAR = NCHAR + L
	ELSE
	   GO TO 8001
	ENDIF
C
C	... Got Journal; make certain that a "," is not the last char
	IF(STRING(NCHAR:NCHAR) .EQ. ',') THEN
	   NCHAR = NCHAR - 1
	ENDIF
C
C	... Turn off Italics and add a ", "  --  save this position
C	... to blank out the "," if there is no volume, page or year.
	IF(NCHAR+5 .LE. MAXREF) THEN
	   IF(TSC) THEN
	      STRING(NCHAR+1 : NCHAR+5) = '\RG, '
	      NCHAR = NCHAR + 5
	      SAVE = NCHAR
	   ELSE
	      STRING(NCHAR+1 : NCHAR+2) = ', '
	      NCHAR = NCHAR + 2
	      SAVE = NCHAR
	   ENDIF
	ELSE
	   GO TO 8001
	ENDIF
C
C	   Volume -- photocomp it in BOLD face
C
	VOL = CARD9(NCARD)(7:10)
	CALL LEFT(VOL, SIZE)
	IF(SIZE.GT.0) THEN
	   IF(NCHAR+SIZE+7 .LE. MAXREF) THEN
	      IF(TSC) THEN
	         STRING(NCHAR+1 : NCHAR+SIZE+7) =
	1          '\BF' // VOL(1:SIZE) // '\RG '
	         NCHAR = NCHAR + SIZE + 7
	      ELSE
	         STRING(NCHAR+1 : NCHAR+SIZE+1) =
	1           VOL(1:SIZE) // ' '	        
	         NCHAR = NCHAR + SIZE + 1
	      ENDIF
	   ELSE
	      GO TO 8001
	   ENDIF
	ENDIF
C
C	   Page
C
	PAGE = CARD9(NCARD)(11:15)
	CALL LEFT(PAGE, SIZE)
	IF(SIZE.GT.0) THEN
	   IF(NCHAR+SIZE+1 .LE. MAXREF) THEN
	      STRING(NCHAR+1 : NCHAR+SIZE+1) =
	1       PAGE(1:SIZE) // ' '
	      NCHAR = NCHAR + SIZE + 1
	   ELSE
	      GO TO 8001
	   ENDIF
	ENDIF
C
C	   Year
C
	YEAR = CARD9(NCARD)(17:20)
	CALL LEFT(YEAR, SIZE)
	IF(SIZE.GT.0) THEN
	   IF(NCHAR+SIZE+2 .LE. MAXREF) THEN
	      STRING(NCHAR+1 : NCHAR+SIZE+2) = 
	1       '(' // YEAR(1:SIZE) // ')'
	      NCHAR = NCHAR + SIZE + 2
	   ELSE
	      GO TO 8001
	    ENDIF
	ENDIF
C
C	... Remove last "," if there was no volume, page or year.
	IF(SAVE.EQ.NCHAR) NCHAR = NCHAR - 2

C************************************************************************
C
C	... Following code deleted 4-Mar-1986 after writting DOREFS which
C	... handles words crossing card boundaries itself, layers above
C	... PHREF

C
C>>>	... Fixup if a word crosses the card boundary
C>>>	IF(NCHAR.GT.80 .AND. STRING(80:80).NE.' ') THEN
C-->	   type *,'-------------------- ',CARD1(1)(73:78),
C->	1  ' ----------------------------'
C-->	   type *,string( 1:80)
C-->	   type *,string(81:nchar)
C>>>    	   IF(STRING(81:81) .EQ. ' ') THEN
C>>>    	      CALL LEFT(STRING(81:NCHAR),SIZE)
C>>>	      NCHAR = 80 + SIZE
C-->	      type *,'BLANK AT COL. 81'
C>>>	   ELSE
C>>>    	      DO 4000 I=79,1,-1
C>>>    	      IF(STRING(I:I) .EQ. ' ') GO TO 10
C>>>4000	      CONTINUE
C>>>    	      WRITE(NOUT,1605) CARD1(1)(73:78)
C>>>1605	      FORMAT(' %PHREF-W-NOBLKS ',A,'-Reference crosses card ',
C>>>    	1       'boundary, no blanks in 1-81')
C>>>    	      STATUS = 5
C>>>    	      GO TO 8000
C>>>
C>>>10  	      IF(NCHAR-I .GT. 80) GO TO 8001
C>>>	      DELTA = 80 - I
C>>>  	      DO 4010 N=NCHAR,I+1,-1
C>>>4010	      STRING(N+DELTA : N+DELTA) = STRING(N:N)
C>>>    	      STRING(I+1 : 80) = ' '
C>>>    	      NCHAR = NCHAR + DELTA
C-->	      type *,'BLANK AT COL',I,';  NCHAR=',NCHAR,';  DELTA=',
C-->	1       DELTA
C>>>	   ENDIF
C-->	   type *,string( 1:80)
C-->	   type *,string(81:nchar)
C>>>	ENDIF
C************************************************************************

C
C	... Blank fill the rest of the STRING
	IF(NCHAR .LT. LEN(STRING)) STRING(NCHAR+1:) = ' '
	STATUS = 0
	GO TO 9000

8000	CONTINUE
	GO TO 9000

8001	CONTINUE
	CALL ERRTXT ('W', 
	1  'Reference beyond 160 characters will be truncated')
	STATUS = 3

9000	CONTINUE
	CALL DESMOD ('PHREF')
	RETURN
	END
