*	MAKCOEF.FOR

*	Create a binary data file containing transformation
*	coefficients for the spectrum routine.

*	David E. Hess
*	Fluid Flow Group - Process Measurements Division
*	Chemical Science and Technology Laboratory
*	National Institute of Standards and Technology
*	April 15, 1992

*	This routine reads an ASCII input data file and rewrites
*	the data into a binary data file which can be
*	processed by the SPECTRUM calculation program. The routine
*	first prompts the user for information necessary to create the
*	file header and then the rewriting procedure begins. Extensive
*	error checking is included in an attempt to make the
*	transformation process as painless as possible. Refer to the
*	section in the user's manual for further details.

*	IFMAX and NUMCON in the parameter statement below MUST match
*	the values for IFMAX and NUMCON in the spectrum routine.

*			File Extensions
*			---------------
*	.ASC - ASCII input data file (no header, just numbers)
*	.DAT - Binary coefficient file (with file header)

*			Header Information
*			------------------
*	NSTART	: coefficient sets will be consecutively
*		  associated to files starting from this #
*	NUMCON	: # of coefficients in polynomial (must be 5)
*	NUMSETS	: # of sets of coefficients in data file

	IMPLICIT	REAL*4 (A-H,O-Z), INTEGER*2 (I-N)
	PARAMETER	(NUMI=2,NUMO=3,NMAX=16384,IFMAX=100)
	PARAMETER	(NUMCON=5)
	LOGICAL*1	ONECHAN,TWOCHAN
	REAL*4		CONST[ALLOCATABLE](:,:)
	CHARACTER	INSFX *4 /'.ASC'/, OSFX1 *7 /'CON.DAT'/
	CHARACTER	OSFX2 *8 /'CON2.DAT'/
	CHARACTER*1	FIRST,LETTER
	CHARACTER*4	INNAM
	CHARACTER*8	INFIL,OUTFIL
	CHARACTER*9	OUTFL2

*	Get the first letter.

10	WRITE (*,'(/1X,A/1X,A\)') 'Enter first letter of data file to',
     +                 'which these coefficients will be associated : '
	READ (*,'(A)') FIRST
	IF (ICHAR(FIRST) .GE. 97 .AND. ICHAR(FIRST) .LE. 122) THEN
	  IHOLD=ICHAR(FIRST)-32
	  FIRST=CHAR(IHOLD)
	ENDIF
	IF (ICHAR(FIRST) .LT. 65 .OR. ICHAR(FIRST) .GT. 90) THEN
	  WRITE (*,'(1X,A/)') 'Enter an alphabetic character (A-Z).'
	  GO TO 10
	ENDIF

*	Get channel #.

20	WRITE (*,'(/1X,A\)')
     +     'Are these coefficients for channel (1 or 2) : '
	READ (*,*) ICHANS
	ONECHAN=(ICHANS .EQ. 1)
	TWOCHAN=(ICHANS .EQ. 2)
	IF (.NOT. ONECHAN .AND. .NOT. TWOCHAN) GO TO 20

*	Get # of sets of coefficients.

30	WRITE (*,'(/1X,A\)') 'Enter # of sets of coefficients : '
	READ (*,*) NUMSETS
	IF (NUMSETS .GT. IFMAX) THEN
	  WRITE (*,'(/1X,A,I3)') 
     +      'Current maximum number of sets = ',IFMAX
	  GO TO 30
	ENDIF

*	Get starting file number to associate coefficients to.

	WRITE (*,'(/1X,A\)') 'Enter starting file number : '
	READ (*,*) NSTART
	IF (NUMSETS+NSTART-1 .GT. IFMAX) THEN
	  WRITE (*,'(/1X,A/1X,A/1X,A,I3)')
     +      'Your choice of number of sets and',
     +      'starting file number must satisfy',
     +      'NUMSETS + NSTART - 1 <= ',IFMAX 
	  GO TO 30
	ENDIF

*	Get input file name.

40	WRITE (*,'(/1X,A\)') 'Enter ASCII input file name (4 chars) : '
	READ (*,'(A)') INNAM

*	Convert to uppercase and check first character alphabetic.

	DO J=4,1,-1
	  LETTER=INNAM(J:J)
	  IF (ICHAR(LETTER) .GE. 97 .AND. ICHAR(LETTER) .LE. 122) THEN
	    IHOLD=ICHAR(LETTER)-32
	    LETTER=CHAR(IHOLD)
	    INNAM(J:J)=LETTER
	  ENDIF
	ENDDO
	IF (ICHAR(LETTER) .LT. 65 .OR. ICHAR(LETTER) .GT. 90) THEN
	  WRITE (*,'(/1X,A,A,A/1X,A,A,A/1X,A)') 
     +      'Filename ',INNAM,' began with',
     +      'the nonalphabetic character ',LETTER,'.',
     +      'Re-enter the filename correctly.'
	  GO TO 40
	ENDIF

	INFIL=INNAM // INSFX
	IF (ONECHAN) OUTFIL=FIRST // OSFX1
	IF (TWOCHAN) OUTFL2=FIRST // OSFX2

*	Put message on screen.

	WRITE (*,'(/////////////////////10X,A,A)')
     +    'C O E F F I C I E N T   F I L E   ',
     +    'C R E A T I O N   U T I L I T Y'
	IF (ONECHAN)
     +       WRITE (*,'(/25X,''Creating '',A,'' now.'')') OUTFIL
	IF (TWOCHAN)
     +       WRITE (*,'(/25X,''Creating '',A,'' now.'')') OUTFL2

*	Open input ASCII file.

	OPEN (NUMI,FILE=INFIL,STATUS='OLD',ERR=100)

*	Open output data file and write header.

	IF (ONECHAN) OPEN (NUMO,FILE=OUTFIL,STATUS='UNKNOWN',
     +        ACCESS='SEQUENTIAL',FORM='BINARY',ERR=110)
	IF (TWOCHAN) OPEN (NUMO,FILE=OUTFL2,STATUS='UNKNOWN',
     +        ACCESS='SEQUENTIAL',FORM='BINARY',ERR=110)
	WRITE (NUMO) NUMSETS,NSTART

*	Allocate space for CONST array.

	ALLOCATE (CONST(NUMSETS,NUMCON), STAT=IERR)
	IF (IERR .NE. 0)
     +     STOP 'Problem allocating storage for CONST.  Aborting ...'

*	Display header information.

	WRITE (*,'(/25X,A,I3)')   '# sets of coeffs = ',NUMSETS
	WRITE (*,'(25X,A,I1)')    '# coeffs in each set = ',NUMCON
	WRITE (*,'(25X,A,I3)')    '# of starting file = ',NSTART

	READ (NUMI,*,ERR=120,END=140)
     +         ((CONST (I,J), J=1,NUMCON), I=1,NUMSETS)
	WRITE (NUMO,ERR=130)
     +         ((CONST (I,J), J=1,NUMCON), I=1,NUMSETS)

	CLOSE (NUMI,STATUS='KEEP')
	CLOSE (NUMO,STATUS='KEEP')

	WRITE (*,'( )')
	STOP '                        Program terminated successfully.'

*	Problem opening input ASCII file.

100	WRITE (*,'(/25X,A/)') 'Problem opening input ASCII file.'
	STOP '                       Program terminated unsuccessfully.'

*	Problem opening output data file.

110	WRITE (*,'(/25X,A/)') 'Problem opening output data file.'
	STOP '                       Program terminated unsuccessfully.'

*	Problem reading input ASCII file.

120	WRITE (*,'(/25X,A/)') 'Problem reading input ASCII file.'
	CLOSE (NUMI,STATUS='KEEP')
	CLOSE (NUMO,STATUS='KEEP')
	STOP '                       Program terminated unsuccessfully.'

*	Problem writing output data file.

130	WRITE (*,'(/25X,A/)') 'Problem writing output data file.'
	CLOSE (NUMI,STATUS='KEEP')
	CLOSE (NUMO,STATUS='KEEP')
	STOP '                       Program terminated unsuccessfully.'

*	Problem : reached end of file marker reading input ASCII file.

140	WRITE (*,'(/25X,A/)') 'Problem : reached end of file marker',
     +                     ' reading input ASCII file.'
	CLOSE (NUMI,STATUS='KEEP')
	CLOSE (NUMO,STATUS='KEEP')
	STOP '                       Program terminated unsuccessfully.'
	END
