	SUBROUTINE PHDSP (STATUS)
C
C========================================================================
C
C	   Routine to convert the d-spacings in the current pattern
C	   and write them out in the Standard JCPDS PDF Card Interchange
C	   Format for Photocomping.
C
C	   By: Mark Holomany, JCPDS     Date: 13-Feb-1984
C
C	   Revised:
C	      19-Jul-84 MAH - Correct the number of decimal places printed
C	      29-Apr-85 MAH - hkl's generated by computer (AIDS), coded
C	                      with a 'C', are now coded with a 'c' on the
C	                      PDF Card rather than being bracketed [].
C	                      Variable 'LHKCDC' is available to turn off
C	                      the coding of hkl's with 'c'.  A blank
C	                      is substituted.
C	      30-Apr-85 MAH - added logic to issue correct remark codes
C	                      for >1 footnotes.
C	      12-Jan-86 MAH - allow hkl values >99 to be formatted correctly;
C	                      check for hkl of 000 for second index of mult.
C	                      indexed lines.
C	      20-Feb-86 MAH - Pass hkl ed remark code of 'L'; blank-out
C	                      the l-value for those hkl's marked 'L'
C	      27-Feb-86 MAH - Modify footnote code translation logic to
C	                      reflect changes in TRFNCH (mapping).
C	      29-Aug-87 MAH - Switch logical value USENEW in call to TRFNCH
C	                      from that in the photocomp routines to allow
C	                      PHDSP to be called after PHBOX5.  Add a 
C	                      'RESET_COUNTS' call to TRFNCH.
C
C========================================================================

	IMPLICIT INTEGER (A-Z)


D	INCLUDE 'IORET.CMN'
D	INCLUDE 'PDFDATA.CMN'
D	INCLUDE 'DSPCDS.CMN'
	
C\$INCLUDE:'DSPCDS.CMN'
C\$INCLUDE:'IORET.CMN'
C\$INCLUDE:'PDFDATA.CMN'

	PARAMETER (MAXOBS = 201)
	PARAMETER (MINDEC = 1, MAXDEC = 4)

	CHARACTER    DBRACK,DSPREM,HBRACK,HKLREM,INTREM,LTGT
	CHARACTER    HKLED(MAXOBS),INTED(MAXOBS),DSPED(MAXOBS)
	CHARACTER    CHAR, PICODE
	CHARACTER*3  CINT, ALTBY3(3), CBY3(3)
	CHARACTER*4  TMPNUM
	CHARACTER*7  LASTD
	CHARACTER*9  ALTHKL(2), CHKL(2), TMPNM2
	CHARACTER*10 TN10A, TN10B
	CHARACTER*50 PHFMT
	CHARACTER*80 CARD
	INTEGER*2    HKL(MAXOBS,3),INT(MAXOBS),SUB
	INTEGER      FROM(2),TO(2)
	REAL         DSP(MAXOBS),FN2,PWL
	REAL         CNST1,CNST2,D1,D2,D3,DD,DT
	LOGICAL      DIGIT,FANCY,DOLLAR
	LOGICAL      LHKCDC

	
	EQUIVALENCE  (  CHKL(1),   CBY3(1)),
	1            (ALTHKL(1), ALTBY3(1))

	CHARACTER*9 DSPACE(200)
	CHARACTER*4  INTEN(200)
	CHARACTER*22 HKAYL(200),CTRHKL
C
	COMMON /DIH/ DSPACE,INTEN,HKAYL,SUB

	CHARACTER    PHDRC(0:10), PHHRC(0:8), PHIRC(0:16)
	CHARACTER    AIDDRC*10  , AIDHRC*8  , AIDIRC*16
	CHARACTER    NUMS(0:9)
C
C>>>	DATA  PHFMT
C>>>	1  /'(F7.*,A1,A1, A3,A1,I1.0, A9,A9,A1,A1,6X)'/
	DATA  PHFMT
	1  /'(F7.*)'/
	DATA  ALTHKL(2) /'         '/
	DATA  CHKL(2)   /'         '/
	DATA  FROM /  1, 41 /
	DATA  TO   / 40, 80 /
	DATA
	1     PHDRC  /' ',
	2             '1', '2', '3', '4', '5', '6', '7', '8', '9', '$'/,
	3     AIDDRC /'123456789$'/
	DATA             
	1     PHHRC  /' ',
C>>>>>>	2             'c', ' ', ' ', 'n', ' ', ' ', '*', 'L'/,
	2             'c', ' ', ' ', 'n', ' ', ' ', '*', ' '/,
	3     AIDHRC /'CEMNU+*L'/
	DATA
	1     PHIRC  /' ',
	2             'b', ' ', ' ', 'n', ' ', 'x', ' ',
	3             '1', '2', '3', '4', '5', '6', '7', '8', '9'/,
	4     AIDIRC /'BGLNUX*123456789'/
	DATA  NUMS /'0', '1', '2', '3', '4', '5', '6', '7', '8', '9'/
C
C>>>	... LBRCOK = .true. if hkl's marked 'C' should be bracketed
C>>>	LOGICAL  LBRCOK
C>>>	DATA     LBRCOK /.TRUE./


	CALL ESTMOD ('PHDSP')
C
C	... Initialize counters.  
C	... NUMCRD is the number of interchange format cards in the pattern
	NUMCRD = 0
	LASTD  = '       '
	DOLLAR = .FALSE.
C
C	... Reset the counts of # of times each footnote character
C	... has been encountered.  Necessary to check for different
C	... footnotes with the same character code which will result
C	... in an ambiguity on the PDF Card.
	CALL TRFNCH
	1  ('RESET_COUNTS', .FALSE., IRET, CHAR, PICODE, COUNT)
C       
C
CCCCC       ...Initialize INTEN array
CCCC        Do 2444 J = 1,200
CCCC	INTEN(J)= ' '
CCCC2444	CONTINUE
C
C	... Convert spacings from CARDI(n) to Floating/Integer/Alpha
	IF(NUMC(18).LT.1) THEN
	   STATUS = 1
	   GO TO 8000
	ENDIF

	NUMOBS = 0
	DO 4000 NCARD=1,NUMC(18)

	DO 4005 ISP=1,69,23
	NUMOBS = NUMOBS + 1
	READ (UNIT=CARDI(NCARD) (ISP:ISP+22), FMT=1800)
	1  DSP(NUMOBS),   INT(NUMOBS),   INTED(NUMOBS),
	2  HKL(NUMOBS,1), HKL(NUMOBS,2), HKL(NUMOBS,3), HKLED(NUMOBS),
	3  DSPED(NUMOBS)  
1800	FORMAT(F7.4,I3,A1,3I3,A1,1X,A1)
	IF(DSP(NUMOBS) .EQ. 0.0) NUMOBS = NUMOBS - 1
4005	CONTINUE

4000	CONTINUE

C-->	write(6,529) 
C-->	1  (DSP(LN), INT(LN), INTED(LN),
C-->	2   HKL(LN,1), HKL(LN,2), HKL(LN,3), HKLED(LN),
C-->	3   DSPED(LN), LN=1,numobs)
C-->529	FORMAT( (' ',2(F7.4,I3,A1,3I3,A1,1X,A1)) )
C-->	type *,' '

C
C	... The number of decimal places for d-spacings is determined by:
C
C		1) Patterns where the original data were d-values are
C		   allowed from 1-4 decimal places.  The exact number
C		   is determined by printing at least the number of
C		   decimal places used in the previous d-spacing
C		   (or MINDEC for first pattern), and then adding more
C		   figures until either trailing zeros or MAXDEC is
C		   reached.
C
C		2) Patterns where the original data were NOT d-values
C		   follow the rules in the Editorial Policy Manual if
C		   the pattern has no xl system, or is based upon the
C		   average delta two theta if it does have a xl system.
C
C		3) If two adjacent d-spacings become equivalent due to
C		   rounding, then the number of decimal places is increased
C		   by one to make them unique.
C
C		NUMDEC is always the number of decimal places to print
C

	NUMDEC = MINDEC
C
C	... Case for original data = d-values
	IF(CARDF(30:30) .EQ. 'D') GO TO 10
C
C
C	... Set "Dn" values to determine no. of decimal places printed
C
C	... Begin by calculating d-spacing limits for printing with 1, 2, 3,
C	    and 4 decimal places
C
C	... Rules for those patterns without crystal systems.  They are
C	... from the "Editorial Policy Manual"
	IF(CARD1(1)(79:79) .EQ. 'X') THEN                                 
C	   .. Rules for Debye-Scherrer
	   IF(CARDF(41:41) .EQ. 'S') THEN
	      D1 = 10.0                                      
	      D2 =  3.0                                      
	      D3 =  0.0                                      
C	   .. Rules for all other instruments
	   ELSE
	      D1 = 10.0
	      D2 =  4.5
	      D3 =  1.8
	   ENDIF
	   GO TO 10
	ENDIF                                                
C
C	... Get PWL, the wavelength, from CARDF
	IF(NUMC(15).GE.1) THEN
	   READ (UNIT=CARDF, FMT=1805) PWL
1805	   FORMAT(T7,F9.5)
	   IF(PWL .EQ. 0.0) PWL = 1.5405
	ELSE
	   STATUS = 2
	   GO TO 8000
	ENDIF
C
C	... Get FN2, the average Delta 2-theta error in degrees, from
C	... CARDG for the determination of the number of decimal places
C	... for each d-spacing.  Rules for those patterns with crystal
C	... systems.
	IF(NUMC(16).GE.1) THEN
	   READ (UNIT=CARDG, FMT=1810) FN2
1810	   FORMAT(T40,F5.3)
	ELSE
	   STATUS = 3
	   GO TO 8000
	ENDIF
C
C
	CNST1 = 8.0/(PWL*PWL)                                
	DT = FN2/114.6                                       
	IF(FN2 .EQ. 0.0) DT=0.1/114.6                        
C	.. D1 = VALUE FOR CHANGE FROM 1 TO 2 DECIMAL PLACES     
	DD = 0.05                                            
	CNST2 = DD/DT                                        
	D1 = (1.0+SQRT(1.0+2.0*CNST1*CNST2*CNST2))/CNST1     
	D1 = SQRT(D1)                                        
C	.. SET SO THAT ATLEAST 3 SIGNIFICANT DIGITS ARE PRINTED 
	IF(D1.LT.10.0) D1 = 10.00                            
C	.. D2 = VALUE FOR CHANGE FROM 2 TO 3 DECIMAL PLACES     
	DD = 0.005                                           
	CNST2 = DD/DT                                        
	D2 = (1.0+SQRT(1.0+2.0*CNST1*CNST2*CNST2))/CNST1     
	D2 = SQRT(D2)                                        
C	.. D3 = VALUE FOR CHANGE FROM 3 TO 4 DECIMAL PLACES     
	DD = 0.0005                                          
	CNST2 = DD/DT                                        
	D3 = (1.0+SQRT(1.0+2.0*CNST1*CNST2*CNST2))/CNST1     
	D3 = SQRT(D3)                                        

C========================================================================
C
C	Begin converting and writing out the d-spacing cards
C
C========================================================================

10	CONTINUE
C
C       ...Initialize INTEN array
        Do 2444 J = 1,NUMOBS
	INTEN(J)= ' '
2444	CONTINUE

C
C	...SUB IS A SUBSCRIPT COUNTER FOR THE DSPACE,INTEN,AND HKAY ARRAY
C	...WHICH IS BUILT TO DISPLAY THEM ON THE SCREEN
C
	SUB = 1
	NDSP = 0
	NUMFLD = 1
	FANCY = .FALSE.
	UCOUNT = 0
C
C	... LHKCDC = .true. if hkl's marked 'C' should be coded as 'c'
C	...          on the JCPDS PDF Card.  If .false., then the hkl's
C	...          are coded with blanks.  Data before Set 33 was taken
C	...          from the old data base tapes from MACS and ALL hkl's
C	...          are marked 'C'.

	LHKCDC = .TRUE.
C>>>>>	IF(CARD1(1)(73:78) .LT. '33') LHKCDC = .FALSE.
	IF(CARD1(1)(73:74) .LT. '33') LHKCDC = .FALSE.
3000	CONTINUE
	NDSP = NDSP + 1
	IF(NDSP .GT. NUMOBS) THEN
	   STATUS = 0
	   GO TO 9000
	ENDIF
C
C	... Determine the number of decimal places where the original
C	... data were d-values
	IF(CARDF(30:30) .EQ. 'D') THEN
	   CURDEC = NDEC( DSP(NDSP) )
	   NUMDEC = MAX0( CURDEC, NUMDEC )
	   IF(NUMDEC .GT. MAXDEC) NUMDEC = MAXDEC
	   GO TO 30
	ENDIF
C
C	... Determine d format based on no. of decimal places for
C	... the case where the original data were NOT d-values
C
	IF     (DSP(NDSP) .GE. D1) THEN
	   NUMDEC = MAX0( NUMDEC,1 )
	ELSE IF(DSP(NDSP) .GE. D2) THEN
	   NUMDEC = MAX0( NUMDEC,2 )
	ELSE IF(DSP(NDSP) .GE. D3) THEN
	   NUMDEC = MAX0( NUMDEC,3 )
	ELSE
	   NUMDEC = MAX0( NUMDEC,4 )
	ENDIF
30	CONTINUE

C*************************************
C                                    *
C	   Intensity section         *
C                                    *
C*************************************

	TMPINT = INT(NDSP)
	IF(FANCY) THEN
	   NFANCY = 0
	   UCOUNT = UCOUNT - 1
	   IF(UCOUNT.LE.0) THEN
	      FANCY = .FALSE.
	   ELSE
	      TMPINT = 0
	      GO TO 60
	   ENDIF
	ENDIF

	IF(INTED(NDSP) .EQ. 'U') THEN
C	   .. Determine the range of this 'U' grouping (mult. d-sp
C	   .. bracketed to one intensity)
	   FANCY = .TRUE.
	   UCOUNT = 1
	   DO 4010 IND=NDSP+1,NUMOBS
	   IF(INTED(IND).EQ.'U' .AND. INT(IND).EQ.INT(IND-1)) THEN
	      IF(DSP(IND) .EQ. DSP(IND-1)) GO TO 4010
	      UCOUNT = UCOUNT + 1
	   ELSE
	      GO TO 50
	   ENDIF
4010	   CONTINUE
50	   CONTINUE
	   NFANCY = UCOUNT
	   WRITE (TMPNM2, '(F9.5)') DSP(NDSP)
	   IF(NFANCY .EQ. 1) CALL ERRTXT ('E',
	1    'Only 1 intensity marked "U" for ' // TMPNM2 //
	2    ' (must be >= 2)')

C==>	   IF(NFANCY .GE. 4) THEN
C==>	      WRITE (TMPNUM(1:1), '(I1)') NFANCY
C==>	      CALL ERRTXT ('W',          
C==>	1       TMPNUM(1:1) // ' lines bracketed to one intensity')
C==>	   ENDIF
	ENDIF
C
C	... Convert .gt. and .lt. edit flags to appropriate symbols
60	IF     (INTED(NDSP).EQ.'L') THEN
	   LTGT = '<'
	ELSE IF(INTED(NDSP).EQ.'G') THEN
	   LTGT = '>'
	ELSE
	   LTGT = ' '
	ENDIF

	WRITE(UNIT=CINT, FMT=1820) TMPINT
1820	FORMAT(I3.0)
	IF(LTGT.NE.' ') THEN
	   IF     (CINT(2:2).EQ.' ') THEN
	      CINT(2:2) = LTGT
	   ELSE IF(CINT(1:1).EQ.' ') THEN
	      CINT(1:1) = LTGT
	   ENDIF
	ENDIF
C
C	... The intensity remark codes are converted below just before
C	... writing out the spacing
C*************************************
C                                    *
C	   HKL section.              *
C                                    *
C*************************************
C
C	... Test for an hkl of 000 - set NCHKL accordingly
	IF(HKL(NDSP,1).EQ.0 .AND. HKL(NDSP,2).EQ.0 .AND.
	1  HKL(NDSP,3).EQ.0) THEN
	   NCHKL = 2
	ELSE 
	   NCHKL = 1
	ENDIF
C
C	... Construct HKL's for first index
	WRITE (UNIT=CHKL, FMT=1830) (HKL(NDSP,N), N=1,3)
1830	FORMAT(3I3)
C
C	... Fix-up minus signs so that they are left justified
C	... CBY3 and CHKL are EQUIVALENCED, respectively, 
C	... as C*3(3) and C*9
C==>	DO 4020 N=1,3
C==>	IF(CBY3(N)(2:2) .EQ. '-') CBY3(N)(1:2) = '- '
C==>4020	CONTINUE
C
C	... Initialize the bracketing designators in case this line
C	... is multi-indexed
	DBRACK = ' '
	HBRACK = ' '
	NALT   = 2
C            
C	... Test if this line is multi-indexed
     	IF(NDSP.LT.NUMOBS .AND. DSP(NDSP).EQ.DSP(NDSP+1)) THEN
C	   ... Multi-indexed 
C
C	   ... Test for an hkl of 000 - error message if found
C	   ...  -- second hkl
	   IF(HKL(NDSP+1,1).EQ.0 .AND. HKL(NDSP+1,2).EQ.0 .AND.
	1     HKL(NDSP+1,3).EQ.0) THEN
	      WRITE (TMPNM2, '(F9.5)') DSP(NDSP+1)
	      WRITE (TMPNUM, '(I4)')   INT(NDSP+1)
	      CALL ERRTXT ('E', 
	1       'Spacing ' // TMPNM2 // TMPNUM //
	2       ' has 000 as hkl for second index.  ' //
	3       'Second hkl omitted.')
	      GO TO 110
	   ELSE                   
	      NALT = 1
	   ENDIF
C
C	   ...  -- first hkl
	   IF(HKL(NDSP,1).EQ.0 .AND. HKL(NDSP,2).EQ.0 .AND.
	1     HKL(NDSP,3).EQ.0) THEN
	      WRITE (TMPNM2, '(F9.5)') DSP(NDSP)
	      WRITE (TMPNUM, '(I4)')   INT(NDSP)
	      CALL ERRTXT ('E', 
	1       'Spacing ' // TMPNM2 // TMPNUM //
	2       ' has 000 as hkl for first of multiple indexes.')
	   ENDIF

	   IF(INT(NDSP) .NE. INT(NDSP+1)) THEN
	      WRITE (TMPNM2, '(F9.5)') DSP(NDSP)
	      WRITE (TN10A,  '(I10)' ) INT(NDSP)
	      WRITE (TN10B,  '(I10)' ) INT(NDSP+1)
	      CALL ERRTXT ('E', 
	1       'Intensities of mult indexed lines differ: ' //
	2       TMPNM2 // TN10A // TN10B)
	   ENDIF
C
C	   ... Construct HKL's for alternate index
	   WRITE (UNIT=ALTHKL, FMT=1830) (HKL(NDSP+1,N), N=1,3)
C
C	   ... fixup minus signs so that they are left justified
C     	   ... ALTBY3  and ALTHKL are EQUIVALENCED, respectively, 
C	   ... as C*3(3) and C*9
C>>>>>	   DO 4030 N=1,3
C>>>>>	   IF(ALTBY3(N)(2:2) .EQ. '-') ALTBY3(N)(1:2) = '- '
4030	   CONTINUE
C
C	   .. Check for brackets on the second d-sp
	   IF(DSPED(NDSP+1).EQ.'E') DBRACK = 'B'
	   IF(HKLED(NDSP+1).EQ.'E') HBRACK = 'B'
C>>>	   IF(HKLED(NDSP+1).EQ.'C' .AND. LBRCOK) HBRACK = 'B'

C	   .. Check for >2 hkl indexes
	   DO 4040 I=NDSP+2,NUMOBS
	   IF(DSP(I).NE.DSP(I-1)) GO TO 100
4040	   CONTINUE
	   I = NUMOBS + 1
100	   CONTINUE
	   NDSP = I - 1

	ENDIF
110	CONTINUE

C
C	... Check and alter d-sp remark code
	DSPREM = PHDRC( INDEX(AIDDRC, DSPED(NDSP)) )
	IF(DIGIT(DSPREM) .OR. DSPREM.EQ.'$') THEN
	   CALL TRFNCH (DSPREM, .FALSE., IRET, CHAR, PICODE, COUNT)
	   DSPREM = CHAR
	ENDIF
	IF(DSPED(NDSP) .EQ. 'E') DBRACK = 'B'
C
C	... Check and alter intensity remark code
	INTREM = PHIRC( INDEX(AIDIRC, INTED(NDSP)) )
	IF(DIGIT(INTREM)) THEN
	   CALL TRFNCH (INTREM, .FALSE., IRET, CHAR, PICODE, COUNT)
	   INTREM = CHAR
	ENDIF
C
C	... Check and alter hkl remark code
	HKLREM = PHHRC( INDEX(AIDHRC, HKLED(NDSP)) )
	IF(HKLREM .EQ. '*') THEN
	   CALL TRFNCH (HKLREM, .FALSE., IRET, CHAR, PICODE, COUNT)
	   HKLREM = CHAR
	ENDIF
	IF(HKLED(NDSP).EQ.'C' .AND. (.NOT. LHKCDC)) HKLREM = ' '
	IF(HKLED(NDSP).EQ.'E') HBRACK = 'B'
C>>>	IF(HKLED(NDSP).EQ.'C' .AND. LBRCOK) HBRACK = 'B'
C
C	... Fix-up hkl's w/ ed rem code 'L' by blanking out the l-value
C>>>>>	IF(HKLREM .EQ. 'L') THEN
	IF(HKLED(NDSP) .EQ. 'L') THEN
	   CHKL  (NCHKL)(7:9) = ' '
	   ALTHKL(NALT) (7:9) = ' '
	ENDIF           
C
C>>>	... Write the spacing onto half of CARD
	IF(NUMFLD.EQ.1) NUMCRD = NUMCRD + 1

C>>>150	PHFMT(5:5) = NUMS(NUMDEC)
C
C>>>	WRITE(UNIT=DCARD(NUMCRD)(FROM(NUMFLD):TO(NUMFLD)), FMT=PHFMT)
C>>>	1       DSP(NDSP),  DSPREM,  DBRACK,
C>>>	2       CINT,       INTREM,  NFANCY,
C>>>	3       CHKL(NCHKL), ALTHKL(NALT), HKLREM, HBRACK
C
C	...BUILD DSPACE,INTENSITY, AND HKL ARRAYS IN SCREEN FORMAT
C       ...FOR SCREEN DISPLAY.
C
C       ------------
C       DSPACE ARRAY
C       ------------
C
	IF (DBRACK.EQ.'B') THEN
           DSPACE(SUB)(1:1) = '['
	ELSE
	   DSPACE(SUB)(1:1) = ' '
	ENDIF
150 	PHFMT(5:5) = NUMS(NUMDEC)
	WRITE(DSPACE(SUB)(2:),FMT=PHFMT) DSP(NDSP)
	CALL LEFT (DSPACE(SUB)(2:),LN)
	IF (DSPACE(SUB)(2:2) .EQ. '.') THEN
            DSPACE(SUB)(3:9) = DSPACE(SUB)(2:LN)
            DSPACE(SUB)(2:2) = '0'
	ENDIF

C
C	... Test if the last d-sp and this d-sp are equivalent
	IF(LASTD .EQ. DSPACE(SUB)(2:8)) THEN
	   NUMDEC = NUMDEC + 1
	   GO TO 150
	ENDIF
	LASTD = DSPACE(SUB)(2:8)

157	LD = LENGTH(DSPACE(SUB))
	IF (DBRACK.EQ.'B') THEN
            DSPACE(SUB)(LD+1:LD+1) = ']'
	ELSE
	    INX = INDEX('123456789',DSPREM)
            IF (INX.GT.0) DSPREM = DSPFNC(INX)
            DSPACE(SUB)(LD+1:LD+1) =  DSPREM
	ENDIF
C
C        ---------------
C	   INTENSITY
C        ---------------
C
	IF (INTEN(SUB)(1:4) .EQ. '  " ' ) GO TO 180
	IF (NFANCY .GT. 1) THEN
	    JCOUNT = 0
	    ISUB = SUB
	    ISUB = ISUB + 1
	    INTEN(SUB)(1:4) = CINT
            JCOUNT = JCOUNT + 1
159	    INTEN(ISUB)(1:4) = '  " '
            JCOUNT = JCOUNT + 1
	    IF (JCOUNT .NE. NFANCY) THEN
               ISUB = ISUB + 1     
               GO TO 159 	    
            ENDIF
	    GO TO 180
	ELSE
	    INTEN(SUB)(1:3) = CINT
	ENDIF
	INX = INDEX('123456789',INTREM)
	IF (INX.GT.0) INTREM = DSPFNC(INX)
	INTEN(SUB)(4:4) = INTREM
C
C	---------------
C        HKAYL ARRAY
C       ---------------
C
180	HKAYL(SUB) = ' '
	IF (HBRACK.EQ.'B') THEN
           HKAYL(SUB)(1:1) = '['
	ELSE
	   HKAYL(SUB)(1:1) = ' '
	ENDIF
 	HKAYL(SUB)(2:10)=CHKL(NCHKL)
	IF (ALTHKL(NALT).NE.'         ') THEN
	    HKAYL(SUB)(11:12) = ', '
	    HKAYL(SUB)(13:21) = ALTHKL(NALT)
	ENDIF
        LD = LENGTH(HKAYL(SUB))
	IF (HBRACK.EQ.'B') THEN
            HKAYL(SUB)(LD+1:LD+1) = ']'
	ELSE
           INX = INDEX('123456789',HKLREM)
           IF (INX.GT.0) HKLREM = DSPFNC(INX)
            HKAYL(SUB)(LD+1:LD+1) = HKLREM
	ENDIF
C
C	....CENTER THE HKL IF ONLY ONE IS PRESENT
C
	CTRHKL = ' '
	LD=LENGTH(HKAYL(SUB))
	IF (LD.EQ.22) GO TO 188
	ISTART= 11 - (LD / 2)
	K = ISTART
	DO 185 J = 1,LD
	CTRHKL(K:K) = HKAYL(SUB)(J:J)
	K = K+1
185	CONTINUE
	HKAYL(SUB) = CTRHKL

188	SUB= SUB + 1
C
	GO TO 3000


8000	CONTINUE
	SUB = 0

9000	CONTINUE
	SUB = SUB - 1
	CALL DESMOD ('PHDSP')
	RETURN
	END
