	SUBROUTINE PHFORM (INFORM, PFORM, LENGTH, STATUS)
C
C	   Routine to convert the chemical formula as found in the
C	   MDB to a format compatible with Photo-Typesetting.  That
C	   is, codes for super/sub-scripting are added along with
C	   the empty site box; additionally, all blanks are removed.
C
C		INFORM - the formula to be converted, in AIDS format
C		PFORM  - the converted formula ready for Photo-
C		         Typesetting
C		STATUS - status code returned to the calling program
C		            =0 if successful
C		            =1 if error during conversion
C		LENGTH - length of the photo-typeset ready formula PFORM
C
C	   By: Mark Holomany, JCPDS     Date: 31-Jan-1984
C
C	   Revisions:
C	   24-Apr-85 MAH Allowed subscripts to follow a vacancy
C	                 symbol (a "*")
C	   19-Jul-87 MAH Make sure that all of formula is returned, even
C	                 if a an error occurs
C	    7-Jan-88 MAH Routine no longer prints any error messages,
C	                 just returns error STATUS
C
C=========================================================================

	IMPLICIT INTEGER (A-Z)
	CHARACTER INFORM*(*), PFORM*(*)
	CHARACTER TOKEN*20, STRING*40
	LOGICAL   DIGIT, ERRFLG

	CALL ESTMOD ('PHFORM')
	ERRFLG = .FALSE.
C
C	... Initialize the SCANER subprogram so that it can return
C	... successive fields from the formula delimited by blanks
	CALL SCANIN(INFORM,' ')
C
C======================================================================
C
C	Now examine each field.  The rules used are detailed below.
C	Where square brackets enclose an n, ie. [n], they denote
C	the optional repetition of the enclosed character(s).
C
C	The first character of each field is examined to determine the
C	correct action to take.
C
C	1) The following are copied, verbatim, to PFORM:
C
C		(	==>	(
C		[	==>	[
C		,	==>	,
C		[n]	==>	[n]		0.5	==>	0.5
C		![n]	==>	![n]		!10	==>	!10
C
C	2) Charges (valence) must be superscripted:
C
C		+[n]	==>	@+[@n]		+3	==>	@+@3
C		-[n]	==>	@-[@n]		-1	==>	@-@1
C
C	   (Note: a '-' surrounded by blanks is presumed to be an indication
C	   of uncertain stoichiometry; therefore the '-' is NOT super-
C	   scripted)
C
C	3) Characters after a closing parenthesis/square bracket are always
C	   subscripted:
C
C		)[n]	==>	)[#n]		)6	==>	)#6
C		][n]	==>	][#n]		]	==>	]
C
C	4) An element symbol begins with a capital letter and has an optional
C	   lower case letter following ('x' and 'z' are not valid in this
C	   context; therefore, they must be regarded as variable subscripts).
C	   All characters following the element symbol are subscripted.
C
C		L[n]	==>	L[#n]		H22	==>	H#2#2
C		Ll[n]	==>	Ll[n]		Fe2	==>	Fe2
C						O0.25	==>	O#0#.#2#5
C						Nx-z	==>	N#x#-#z
C						Fe2-x	==>	Fe#2#-#x
C
C	5) A '*' denotes an vacant empty site.  It is translated to an
C	   empty square box as a SED PI code of '$XS'.
C
C		*	==>	$XS
C                   
C===========================================================================
C
	STATUS = 0
	PTR = 1
	LENGTH = 0

3000	CONTINUE
	CALL SCANER(TOKEN,SIZE)
	IF(SIZE.EQ.-1) THEN
	   LENGTH = PTR - 1
C	   .. blank pad the remainder of PFORM
	   IF(PTR.LE.LEN(PFORM)) PFORM(PTR:) = ' '
	   GO TO 9000
	ENDIF
	IF(PTR.GT.LEN(PFORM)) GO TO 8000
C
C	... First character is a *
	IF(TOKEN(1:1) .EQ. '*') THEN
	   PFORM(PTR:PTR) = '*'
	   PTR = PTR + 1
	   IF(PTR .GT. LEN(PFORM)) GO TO 8000
C
C	   .. convert and copy the optional subscript
	   IF(SIZE .GT. 1) THEN
	      CALL ALTRNT (TOKEN(2:SIZE), STRING, '#')
	      IF(STRING(1:1) .EQ. ' ') THEN
	         STRING = TOKEN(2:SIZE) // '?'
	         ERRFLG = .TRUE.
	      ENDIF
	      END = PTR + 2*(SIZE - 1) - 1
	      IF(END .GT. LEN(PFORM)) GO TO 8000
	      PFORM(PTR:END) = STRING(1:2*(SIZE-2+1))
	      PTR = END + 1
	   ENDIF

C
C	... First character is either  ( [ , !  or  numeric
	ELSE IF(TOKEN(1:1) .EQ. '('  .OR.
	1       TOKEN(1:1) .EQ. '['  .OR.
	2       TOKEN(1:1) .EQ. ','  .OR.
	3       TOKEN(1:1) .EQ. '!'  .OR.
	4	DIGIT(TOKEN(1:1))          ) THEN
	   IF(PTR+SIZE-1 .GT. LEN(PFORM)) GO TO 8000
C	   .. convert ! to center dot on IBM PC
C\	   IF(TOKEN(1:1) .EQ. '!') TOKEN(1:1) = CHAR(249)
C
C	   .. the following should be surrounded by blanks, error otherwise
	   IF( (TOKEN(1:1) .EQ. '('  .OR.
	1       TOKEN(1:1) .EQ. '['  .OR.
	2       TOKEN(1:1) .EQ. ','       ) .AND.
	3     SIZE .GT. 1) ERRFLG = .TRUE.
	   PFORM(PTR:PTR+SIZE-1) = TOKEN(1:SIZE)
	   PTR = PTR + SIZE
C
C	... Charge (valence) - first character is  +  or  -
	ELSE IF(TOKEN(1:1) .EQ. '+'  .OR.
	1       TOKEN(1:1) .EQ. '-'        ) THEN
 	   IF(SIZE.EQ.1 .AND. TOKEN(1:1).EQ.'-') THEN
C	      .. uncertain stoichiometry - don't superscript the -
	      PFORM(PTR:PTR) = TOKEN(1:1)
	      PTR = PTR + 1
	   ELSE
C	      .. charge (valence)
	      CALL ALTRNT(TOKEN(1:SIZE), STRING, '@')
	      END = PTR + 2*SIZE - 1
	      IF(END .GT. LEN(PFORM)) GO TO 8000
	      PFORM(PTR:END) = STRING(1:SIZE*2)
	      PTR = END + 1
	   ENDIF
C
C	... Closing parenthesis or square bracket -  )  or  ]
	ELSE IF(TOKEN(1:1) .EQ. ')'  .OR.
	1       TOKEN(1:1) .EQ. ']'        ) THEN
	   PFORM(PTR:PTR) = TOKEN(1:1)
	   PTR = PTR + 1
	   IF(SIZE.GE.2) THEN
	      CALL ALTRNT(TOKEN(2:SIZE), STRING, '#')
	      IF(STRING(1:1) .EQ. ' ') THEN
	         STRING = TOKEN(2:SIZE) // '?'
	         ERRFLG = .TRUE.
	      ENDIF
	      END = PTR + 2*(SIZE - 1) - 1
	      IF(END .GT. LEN(PFORM)) GO TO 8000
	      PFORM(PTR:END) = STRING(1:2*(SIZE-1))
	      PTR = END + 1
	   ENDIF
C
C	... Element symbol plus optional subscripted number(s)
	ELSE IF(TOKEN(1:1).GE.'A' .AND. TOKEN(1:1).LE.'Z')      THEN
	   IF( (TOKEN(2:2).GE.'a' .AND. TOKEN(2:2).LE.'y') .AND.
	1       TOKEN(2:2).NE.'x')  THEN
C	      .. two character element symbol
	      IF(PTR+1 .GT. LEN(PFORM)) GO TO 8000
	      PFORM(PTR:PTR+1) = TOKEN(1:2)
	      PTR = PTR + 2
	      NEXT = 3
	   ELSE
C	      .. one character element symbol
	      PFORM(PTR:PTR)   = TOKEN(1:1)
	      IF(PTR .GT. LEN(PFORM)) GO TO 8000
	      PTR = PTR + 1
	      NEXT = 2
	   ENDIF
C	   .. convert and copy the optional subscript
	   IF(NEXT.LE.SIZE) THEN
	      CALL ALTRNT(TOKEN(NEXT:SIZE), STRING, '#')
	      IF(STRING(1:1) .EQ. ' ') THEN
	         STRING = TOKEN(NEXT:SIZE) // '?'
	         ERRFLG = .TRUE.
	      ENDIF
	      END = PTR + 2*(SIZE - NEXT + 1) - 1
	      IF(END .GT. LEN(PFORM)) GO TO 8000
	      PFORM(PTR:END) = STRING(1:2*(SIZE-NEXT+1))
	      PTR = END + 1
	   ENDIF
C
C	... error
	ELSE
	   ERRFLG = .TRUE.
	   IF(PTR+SIZE .GT. LEN(PFORM)) GO TO 8000
	   PFORM(PTR:PTR+SIZE-1) = TOKEN(1:SIZE)
	   PFORM(PTR+SIZE:PTR+SIZE) = '?'
	   PTR = PTR + SIZE + 1
	ENDIF
C
C	... Get the next token
	GO TO 3000


8000	CONTINUE
	STATUS = 1

9000	CONTINUE
	CALL DESMOD ('PHFORM')
	IF(ERRFLG) THEN
C>>>	   CALL ERRTXT ('E', 'Invalid chemical formula')
C>>>	   CALL ERRTXT ('C', INFORM)
	   STATUS = 2
	ENDIF
	RETURN
	END
