	SUBROUTINE CONCOM(STATUS)
C
C	   Routine to convert formulas and space groups in the free 
C	   format comments in preparation to photocomp the PDF Card.
C
C	   By: Mark Holomany, JCPDS     Date: 16-Feb-1984
C
C	   Revised:
C	   22-OCT-85 MAH Extended to also remove $xx, \xx and # and @ 
C	                 characters for use in RET3.
C	   10-Jan-86 MAH Max length of a photocomposed formula now 300 ch
C
C
	IMPLICIT INTEGER (A-Z)

	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        TCCARD*1760
	CHARACTER        INSPG*8, OUTSPG*12, NEWSTR*10
	LOGICAL          CHANGE

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

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

	CALL ESTMOD ('CONCOM')

	STATUS = 0
	NTC = 0
	CHANGE = .FALSE.

	N = 0
3000	N = N + 1
	IF(N.GT.CHPHC) GO TO 100

C
C	... Convert simple symbol notation to PI codes
C	...   from:    +/-     >/=     </=     ~/=
C	...   to:      $PM     $NF     $NE     $AP

C\	IF(N+2 .GT. CHPHC) GO TO 40
C
C\	IF     (CCARD(N:N+2) .EQ. '+/-') THEN
C\	   CCARD(N:N+2) = '  ' // CHAR(241)
C
C\	ELSE IF(CCARD(N:N+2) .EQ. '>/=') THEN
C==>	   WRITE(NOUT,1604) CARD1(1)(73:78),CCARD(N:NP2)
C\	   CCARD(N:N+2) = '  ' // CHAR(242)
C
C\	ELSE IF(CCARD(N:N) .EQ. '</=') THEN
C==>	   WRITE(NOUT,1604) CARD1(1)(73:78),CCARD(N:NP2)
C\	   CCARD(N:N+2) = '  ' // CHAR(243)
C
C\	ELSE IF(CCARD(N:N) .EQ. '~/=') THEN
C==>	   WRITE(NOUT,1604) CARD1(1)(73:78),CCARD(N:NP2)
C\	   CCARD(N:N+2) = '  ' // CHAR(247)
C\	ENDIF
C
C	... Convert chemical formulas appearing between back slashes
40	IF(CCARD(N:N) .EQ. '\') THEN
	   IF(N+2.LE.CHPHC .AND. 
	1  (CCARD(N:N+2).EQ.'\BA' .OR. CCARD(N:N+2).EQ.'\BF' .OR.
	2   CCARD(N:N+2).EQ.'\IT' .OR. CCARD(N:N+2).EQ.'\OS' .OR.
	3   CCARD(N:N+2).EQ.'\RG')) THEN

	      NTC = NTC + 1
	      TCCARD(NTC:NTC) = CCARD(N:N)
	      GO TO 3000
	   ENDIF

	   CHANGE = .TRUE.
	   END = N + INDEX(CCARD(N+1:CHPHC), '\')
	   IF(END.EQ.N) THEN
	      CALL ERRTXT ('E', 'Unmatched "\" in comments')
	      STATUS = 1
	      N = N + 1
	      GO TO 3000
	   ENDIF

	   CALL PHFORM(CCARD(N+1:END-1),
	1              TCCARD(NTC+1:MIN0(NTC+300,1760)), L, IRET)

C==>	TYPE *,'N=',N,'   NTC=',NTC
C==>	TYPE *,'END=',END
C==>	TYPE *,CCARD(N+1:END-1)
C==>	TYPE *,TCCARD(NTC+1:NTC+67)

	   IF(IRET.NE.0) THEN
	      CALL ERRTXT ('E', 'Bad comments formula: ')
	      DO  4001  SPOT=N+1, END-1, 132
4001	      CALL ERRTXT ('C', CCARD(SPOT:MIN0(SPOT+131,END-1)) )

	      N = END
	      STATUS = 1
	      GO TO 3000
	   ENDIF
	   N = END
	   NTC = NTC + L

C==>	TYPE *,'NEW INDEXES'
C==>	TYPE *,'N=',N,'   NTC=',NTC
C==>	TYPE *,' '
C==>	TYPE *,' '

C
C	... Convert Space Group symbols appearing between back apostrophes
	ELSE IF(CCARD(N:N) .EQ. '`') THEN
	   CHANGE = .TRUE.
	   END = N + INDEX(CCARD(N+1:CHPHC), '`')
	   IF(END.EQ.N) THEN
	      CALL ERRTXT ('E', 'Unmatched "`" in comments')
	      STATUS = 1
	      N = END
	      GO TO 3000
	   ENDIF

	   INSPG = CCARD(N+1:END-1)
	   CALL PHSPG(INSPG,OUTSPG)

	   IF(OUTSPG.EQ.' ') THEN
	      CALL ERRTXT ('E', 'Bad comments S.G.: ' // 
	1       CCARD(N+1:END-1) )
	      STATUS = 1
	      N = END
	      GO TO 3000
	   ENDIF

	   L = LENGTH(OUTSPG)
	   TCCARD(NTC+1:NTC+L) = OUTSPG(1:L)
	   N   = END
	   NTC = NTC + L
C
C	... Check for special codes
	ELSE IF(CCARD(N:N) .EQ. '$') THEN
	   CALL PITRAN (CCARD(N+1:N+2), NEWSTR, LEN)
	   CHANGE = .TRUE.
	   TCCARD(NTC+1:NTC+LEN) = NEWSTR(1:LEN)
	   NTC = NTC + LEN
	   N = N + 2

C==>	ELSE IF(CCARD(N:N) .EQ. '~') THEN
C==>	   CHANGE = .TRUE.
C==>	   TCCARD(NTC+1:NTC+3) = '$NC'
C==>	   NTC = NTC + 3

	ELSE
	   NTC = NTC + 1
	   TCCARD(NTC:NTC) = CCARD(N:N)
	ENDIF
	GO TO 3000

100	CONTINUE
	IF(CHANGE) THEN
	   CCARD(1:NTC) = TCCARD(1:NTC)
	   CHPHC = NTC
	ENDIF

	STATUS = 0
	CALL DESMOD ('CONCOM')
	RETURN
	END
