C @(#)iosubs.for	19.1 (ES0-DMD) 02/25/03 13:23:49
C===========================================================================
C Copyright (C) 1995 European Southern Observatory (ESO)
C
C This program is free software; you can redistribute it and/or 
C modify it under the terms of the GNU General Public License as 
C published by the Free Software Foundation; either version 2 of 
C the License, or (at your option) any later version.
C
C This program is distributed in the hope that it will be useful,
C but WITHOUT ANY WARRANTY; without even the implied warranty of
C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C GNU General Public License for more details.
C
C You should have received a copy of the GNU General Public 
C License along with this program; if not, write to the Free 
C Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, 
C MA 02139, USA.
C
C Corresponding concerning ESO-MIDAS should be addressed as follows:
C	Internet e-mail: midas@eso.org
C	Postal address: European Southern Observatory
C			Data Management Division 
C			Karl-Schwarzschild-Strasse 2
C			D 85748 Garching bei Muenchen 
C			GERMANY
C===========================================================================
C
C
C=======================================================================
C
C This file contains subroutines which prompt the user neatly to enter
C needed information via the terminal keyboard.
C
C            OFFICIAL DAO VERSION:  1991 April 18
C
C***********************************************************************
C
C Current contents
C
C   INQUIR  right justifies a prompting string to an arbitrary column
C   GETNAM  asks (neatly) for a filename, offering a default.
C   GETFIL  asks for the name and opens the file
C   GETDAT  asks (neatly) for real-number input.
C   GETYN   asks (neatly) for an answer, and accepts only 'Y', 'y',
C           'N', 'n', 'E', or 'e'.
C   GETCHR  asks (neatly) for a Character string
C
C If CTRL-Z is entered as input to any of the above, the routine will
C return directly to the calling routine, with a unique response.
C
C   TBLANK  types a blank line on the terminal.
C   SWITCH  removes the filename extension from an input filename and
C           attaches another character string in its place.
C   EXTEND  checks to see whether an input filename contains a filename
C           extension and, if not, attaches a default filename
C           extension.
C
C***********************************************************************
C
      SUBROUTINE  INQUIR (PROMPT, N)
C
C=======================================================================
C
C Simply type a prompting character string on the terminal,
C right-justified to column N and followed by a single blank, and
C suppress the carriage return.
C
C Argument
C
C PROMPT  (INPUT) is the character string.
C      N  (INPUT) is the column number to contain the last character.
C
C=======================================================================
C
      IMPLICIT NONE
      INTEGER MIN0
      CHARACTER PROMPT*(*), P*132, LINE*132
      INTEGER I, J, K, L, M, N
C
C-----------------------------------------------------------------------
C
C Find the last printing character in the prompt.
C
      M = MIN0(132, N)
      L = MIN0(132, LEN(PROMPT))
      P = PROMPT
 1000 K = 0
      DO I=1,L
         J = ICHAR(P(I:I))
         IF ((J .GE. 33) .AND. (J .LE.126)) K=I
      END DO
C
C K is the position of the last valid character in the
C prompt.  If K is greater than M, the prompt won't fit in one
C line. Find the last blank before position M; this
C will serve as a line break.
C
      IF (K .GT. M) THEN
         DO J=M,1,-1
            IF (P(J:J) .EQ. ' ') GO TO 1500
         END DO
 1500    WRITE (6,600) P(1:J)
 600     FORMAT (1X, A)
         P = P(J+1:K)
         GO TO 1000
      ELSE
         J = 0
      END IF
      LINE = ' '
C
C Now right justify to column M whatever is left
C in the prompting string.
C
      L = M
      DO I=K,J+1,-1
         LINE(L:L) = P(I:I)
         L = L-1
      END DO
C
      WRITE (6,601) LINE(1:M)//' '
  601 FORMAT (1X, A, $)
      RETURN
      END!
C
C#######################################################################
C
      SUBROUTINE  GETNAM (PROMPT, FILE)
C
C=======================================================================
C
C Prompt the user neatly to type in a filename.
C
C Arguments
C
C PROMPT  (INPUT) the character string to be typed on the terminal
C         (right-justified to column 50).
C
C   FILE  (INPUT/OUTPUT) the filename.  On input, it is the default
C         filename, if any, to be offered to the user.  On output,
C         it is what the user wants.
C
C=======================================================================
C
      IMPLICIT NONE
      CHARACTER*(*) PROMPT, FILE
      CHARACTER*132 LINE
      CHARACTER*30 IFILE, SWITCH
      CHARACTER*1 PUNC
      INTEGER I, J, M, N, IERR
C
C If the input character string FILE is all non-printing characters,
C or if it C is 'END OF FILE', no default filename is to be offered.
C Special case: the filename is automatically truncated at a semicolon
C to erase VMS version numbers.
C
      IF (FILE(1:11) .EQ. 'END OF FILE') GO TO 1220
      N = 0
      DO I=1,LEN(FILE)
         J = ICHAR(FILE(I:I))
         IF (J .EQ. 59) GO TO 1210
         IF ((J .GE. 33) .AND. (J .LE. 126)) N = I
      END DO
C
C N marks the position of the last valid character (before the
C semicolon, if any).
C
 1210 IF (N .GT. 0) GO TO 1230
C
C No default filename is to be offered.
C
 1220 CALL INQUIR (PROMPT, 50)
      READ (5,501,END=9100,IOSTAT=IERR) FILE
  501 FORMAT (A)
      IF (IERR .NE. 0) THEN
         CALL STUPID ('Error reading filename.')
         GO TO 1220
      END IF
      RETURN                                             ! Normal return
C
 1230 CONTINUE
C
C A default filename is to be offered.  This is a bit more difficult.
C
C First find the last non-blank character of the prompt.  If this
C has an ascii code outside the ranges 65-90 and 97-122 regard it as
C punctuation.  Otherwise add a colon to the end of the prompt.
C
      M = 0
      DO I=1,LEN(PROMPT)
         J = ICHAR(PROMPT(I:I))
         IF ((J .NE. 0) .AND. (J .NE. 32)) M=I
      END DO
      J = ICHAR(PROMPT(M:M))
      IF ( ((J.GE.63).AND.(J.LE.90)) .OR. ((J.GE.97).AND.(J.LE.122)) )
     .     THEN
         PUNC = ':'
      ELSE
         PUNC = PROMPT(M:M)
         M = M-1
      END IF
C
C M now marks the last non-blank, non-null character before the terminal
C punctuation.  We are now ready to prompt for input.
C
 1240 CONTINUE
CCC      IF (M+N+12 .LE. 50) THEN
         LINE = PROMPT(1:M)//' (default '//FILE(1:N)//')'//PUNC
         CALL INQUIR (LINE, 50)
CCC      ELSE
CCC         CALL INQUIR (PROMPT(1:M)//' ('//FILE(1:N)//')'//PUNC, 50)
CCC      END IF
      READ (5,501,IOSTAT=IERR,END=9100) IFILE
      IF (IERR .NE. 0) THEN
         CALL STUPID ('Error reading filename.')
         GO TO 1240
      END IF
      IF (FILE(1:11) .EQ. 'END OF FILE') GO TO 9100
C
C If IFILE is blank, use the default.
C
      IF (IFILE .EQ. ' ') THEN
         FILE = FILE(1:N)
         RETURN
      END IF
C
C At this point there are three possibilities.  If the first character
C is a period ('.'), the input is to be treated as a filename extension
C which is to be substituted for that of the default.
C
      IF (IFILE(1:1) .EQ. '.') THEN
         FILE = SWITCH(FILE, IFILE)
         RETURN
      END IF
C
C Otherwise, if IFILE contains a period other than in the first
C position, it is to be adopted verbatim.
C
      DO I=1,30
         J = ICHAR(IFILE(I:I))
         IF (J .EQ. 46) THEN
            FILE = IFILE
            RETURN
         END IF
      END DO
C
C Now we are left with the trickiest possibility.  The input file name
C contains no period, so the extension from the input file is to be
C transferred (if any).
C
C Extract the filename extension from the default.  The extension is
C is any text after the last period.
C
      DO J=N,1,-1
         IF (FILE(J:J) .EQ. '.') GO TO 1250
      END DO
C
C No period was found.  The default has no extension, either, so adopt
C the input as the final filename.
C
      FILE = IFILE
      RETURN
C
 1250 FILE = SWITCH(IFILE, FILE(J:N))
      RETURN
C
C CTRL-Z or END OF FILE was entered.
C
 9100 FILE='END OF FILE'
      RETURN
C
      END!
C
C#######################################################################
C
      SUBROUTINE  GETFIL (PROMPT, FILE, LUN, STATUS)
      IMPLICIT NONE
      CHARACTER PROMPT*(*), FILE*(*), STATUS*1
      INTEGER LUN, ISTAT
C
 1000 CALL GETNAM (PROMPT, FILE)
      IF ((STATUS .EQ. 'N') .OR. (STATUS .EQ. 'n')) THEN
         CALL OUTFIL (LUN, FILE, ISTAT)
      ELSE
         CALL INFILE (LUN, FILE, ISTAT)
      END IF
      IF (ISTAT .NE. 0) GO TO 1000
      RETURN
      END!
C
C#######################################################################
C
      SUBROUTINE  GETDAT (PROMPT, DATA, N)
C
C=======================================================================
C
C Prompt the user to input numerical data.
C
C Arguments
C
C PROMPT  (INPUT) is the prompting character string to be typed out,
C         right-justified to column 50.
C
C   DATA  (OUTPUT) is a vector of dimension N, to return the numerical
C         values entered by the user to the calling program.
C
C      N  (INPUT) is the number of individual data items the user
C         is required to enter.
C
C Accept only numerical data, or CTRL-Z.  If CTRL-Z is entered, DATA(1)
C is returned to the calling program equal to -1.1E38.
C
C=======================================================================
C
      IMPLICIT NONE
      CHARACTER PROMPT*(*), LINE*80
      INTEGER N
      REAL DATA(N)
      INTEGER I, IERR
C
C-----------------------------------------------------------------------
C
 1000 CALL INQUIR (PROMPT, 50)
      READ (5,501,IOSTAT=IERR,END=9100) LINE
  501 FORMAT (A)
      IF (IERR .NE. 0) THEN
         CALL STUPID ('Error reading data.')
         GO TO 1000
      END IF
      IF ((LINE(1:1) .EQ. 'E') .OR. (LINE(1:1) .EQ. 'e')) GO TO 9100
      READ (LINE,*,IOSTAT=IERR) (DATA(I), I=1,N)
      IF (IERR .NE. 0) THEN
         CALL STUPID ('Error reading data.')
         GO TO 1000
      END IF
      RETURN
C
C CTRL-Z was entered
C
 9100 DATA(1)=-1.1E38
      RETURN
C
      END!
C
C#######################################################################
C
      SUBROUTINE  GETYN (PROMPT, ANSWER)
C
C=======================================================================
C
C A subroutine to get the user's response to a yes/no question.
C
C Arguments
C
C PROMPT  (INPUT) is the prompting character string, to be typed out
C         right-justified to column 50.
C
C ANSWER  (OUTPUT) is the user's response to the question.
C
C Accept only 'Y', 'y', 'N', 'n', or CTRL-Z as a valid response:
C If 'Y' or 'y', return ANSWER = 'Y' to the calling routine.
C If 'N' or 'n', return ANSWER = 'N' to the calling routine.
C If CTRL-Z, return ANSWER = 'E' to the calling routine.
C
C=======================================================================
C
      IMPLICIT NONE
      CHARACTER PROMPT*(*), ANSWER*1
      INTEGER IERR
C
 1000 CALL INQUIR (PROMPT, 50)
      READ (5,510,IOSTAT=IERR,END=9100) ANSWER
  510 FORMAT (A1)
      IF (IERR .NE. 0) THEN
         CALL STUPID ('Error reading answer.')
         GO TO 1000
      END IF
      IF (ANSWER .EQ. 'y') ANSWER='Y'
      IF (ANSWER .EQ. 'n') ANSWER='N'
      IF (ANSWER .EQ. 'e') ANSWER='E'
      IF ((ANSWER .NE. 'Y') .AND. (ANSWER .NE. 'N') .AND.
     .     (ANSWER .NE. 'E')) THEN
         CALL STUPID ('Error understanding answer.')
         GO TO 1000
      END IF
      RETURN                                             ! Normal return
C
C CTRL-Z was entered.
C
 9100 ANSWER='E'
      RETURN
C
      END!
C
C#######################################################################
C
      SUBROUTINE  GETCHR (PROMPT, ANSWER, N)
C
C=======================================================================
C
C A subroutine to get a character string from the user.
C
C Arguments
C
C PROMPT  (INPUT) is the prompting character string, to be typed out
C         right-justified to column 50.
C
C ANSWER  (OUTPUT) is the user's response.
C
C      N  (OUTPUT) is the number of characters in the user's response.
C
C Accept about anything.
C
C=======================================================================
C
      IMPLICIT NONE
      CHARACTER*(*) PROMPT, ANSWER
      INTEGER I, J, N, IERR
C
 1000 CALL INQUIR (PROMPT, 50)
      READ (5,510,IOSTAT=IERR,END=9000) ANSWER
  510 FORMAT (A)
      IF (IERR .NE. 0) THEN
         CALL STUPID ('Error reading input.')
         GO TO 1000
      END IF
      N = 0
      DO I = 1,LEN(ANSWER)
         J = ICHAR(ANSWER(I:I))
         IF ((J .NE. 0) .AND. (J .NE. 32)) N=I
      END DO
      RETURN
 9000 N = -1
      RETURN
C
      END!
C
C#######################################################################
C
      SUBROUTINE  TBLANK
C
C=======================================================================
C
C A subroutine to type a blank line on the terminal.
C
C=======================================================================
C
      IMPLICIT NONE
      WRITE (6,*)
      RETURN
C
      END!
C
C#######################################################################
C
      CHARACTER*30  FUNCTION  SWITCH  (FILE, ADDEND)
C
C=======================================================================
C
C Subroutine to chop off a filename extension from an input filename
C character string, and append a new character string to the end.
C
C Arguments
C
C   FILE (INPUT) is a character string containing a filename.
C
C ADDEND (INPUT) is the character string to be pasted onto the end
C        of the character string obtained by removing a directory
C        name and the period and all that follows from the input
C        filename.
C
C SWITCH is the filename part of NAFILE, with any directory name
C        contained in brackets chopped off from the front, and with
C        the character string ADDEND substituted for the period and
C        filename extension of the input string.
C
C=======================================================================
C
      IMPLICIT NONE
      INTEGER LEN
C
      CHARACTER*(*) FILE, ADDEND
      INTEGER I, L, LAST
      L = LEN(FILE)
      I=0
 1000 I=I+1
      IF (I .GT. L) GO TO 9000
C
C If a left bracket is detected, then a directory name is present.
C Find the corresponding right bracket (ignoring any periods met along
C the way).
C
      IF ((FILE(I:I) .EQ. '[') .OR. (FILE(I:I) .EQ. '<')) THEN
 1001    I=I+1
         IF (I .GT. 30) GO TO 9100
         IF ((FILE(I:I) .NE. ']') .AND. (FILE(I:I) .NE. '>')) GO TO 1001
         GO TO 1000
      ELSE IF (FILE(I:I) .EQ. '.') THEN
         SWITCH=FILE(1:I-1)//ADDEND
         RETURN
      ELSE IF (FILE(I:I) .EQ. ' ') THEN
         GO TO 1000
      ELSE
         LAST=I
         GO TO 1000
      END IF
C
 9000 CONTINUE
      SWITCH=FILE(1:LAST)//ADDEND
      RETURN
C
 9100 CONTINUE
      WRITE (6,691) CHAR(7), FILE, ADDEND
  691 FORMAT (/' Error creating file name: ', A1, 5X, A30, 5X, A10/)
      CALL BYEBYE
      END!
C
C#######################################################################
C
      CHARACTER*30  FUNCTION  EXTEND (FILE,EXT)
C
C=======================================================================
C
C A function to see whether a filename contained in an input character
C string contains a filename extension.  If it does, leave it alone.
C If not, then attach the filename extension contained in EXT.
C
C Arguments:
C
C FILE a character string presumably containing a filename.
C
C  EXT a character string containing a default filename extension.
C
C=======================================================================
C
      IMPLICIT NONE
      INTEGER LEN
C
      CHARACTER*(*) FILE, EXT
      INTEGER I, J, L
      L = LEN(FILE)
      I=0
 1000 I=I+1
      IF (I .GT. L) GO TO 9100
      IF ((FILE(I:I) .EQ. '[') .OR. (FILE(I:I) .EQ. '<')) THEN
C
C If a left bracket is found then a directory name is present.  Find the
C corresponding right bracket, ignoring any periods met along the way.
C
 1001    I=I+1
         IF ((FILE(I:I) .NE. ']') .AND. (FILE(I:I) .NE. '>')) GO TO 1001
         GO TO 1000
      ELSE
C
C If a period is found, then a filename extension is present.
C
         IF (FILE(I:I) .EQ. '.') THEN
            EXTEND=FILE
            RETURN
         END IF
C
C If a non-blank, non-null character is found, then the filename
C continues to at least this point in the string.
C
         IF ((FILE(I:I) .NE. ' ') .AND. (FILE(I:I) .NE. CHAR(0))) J=I
         IF (I .LT. L) GO TO 1000
      END IF
C
C No period was found, so append "." and EXT to the end of the
C character string.
C
      EXTEND=FILE(1:J)//'.'//EXT
      RETURN
 9100 WRITE (6,691) CHAR(7), FILE, EXT
  691 FORMAT (/' Error creating file name: ', A1, 5X, A30, 5X, A3/)
      CALL BYEBYE
      END!
C
C#######################################################################
C
      SUBROUTINE  RDSTAR (LU, NL, ID, X, Y, AMAG, SKY)
C
C=======================================================================
C
C Read in an ID number, x and y coordinates, magnitude, and sky value
C for the next star in the input file, whatever the file type (i.e.,
C NL = 1, 2, or 3).  If an end of file is encountered, set the star ID
C to a negative number and return; if a blank line is encountered, the
C star ID will be zero.  LU is the logical unit number to be used; the
C other arguments are obvious.
C
C=======================================================================
C
      IMPLICIT NONE
      CHARACTER*133 LINE
      REAL X, Y, AMAG, SKY, DUMMY
      INTEGER LU, N, ISTAT, ID, NL
C
  900 CALL RDCHAR (LU, LINE, N, ISTAT)
      IF (ISTAT .GT. 0) THEN
         ID = -1   !  ID = -1 means END OF FILE
         RETURN
      ELSE IF (ISTAT .LT. 0) THEN
         CALL STUPID ('Unable to read line from input file')
         CALL OOPS
      END IF
C
      IF (N .LE. 1) THEN
         ID = 0                 ! Blank line
         RETURN
      END IF
C
      N = N+1
      LINE(N:N) = '/'
      IF (NL .EQ. 1) THEN
         READ (LINE(2:N),*,ERR=1000) ID, X, Y, AMAG, DUMMY, SKY
      ELSE IF (NL .EQ. 2) THEN
         READ (LINE(2:N),*,ERR=1000,END=2000) ID, X, Y, AMAG
         IF (ID .NE. 0) READ(LU,*,ERR=1000) SKY
      ELSE IF (NL .EQ. 3) THEN
         READ (LINE(2:N),*,ERR=1000) ID, X, Y, AMAG, SKY
      END IF
      RETURN                                             ! Normal return
 1000 CALL STUPID
     .     ('WARNING:  Corrupt star data encountered in input.')
      GO TO 900
C
C-----------------------------------------------------------------------
C
C End of file was encountered.
C
 2000 ID=-1
      RETURN
C
      END!
C
C#######################################################################
C
      SUBROUTINE  RDHEAD (LUN, NL, NCOL, NROW, LOBAD, HIBAD,
     .     THRESH, AP1, PHPADU, READNS, FRAD)
C
C=======================================================================
C
C Read file header from a sequential data file on the disk.  If the
C file has no header, rewind to beginning.
C
C Input argument
C
C    LUN  is the logical unit number of the disk file.
C
C     NL  if NL is greater than zero on input, then in the event that
C         the header is missing from the input file, the missing
C         header information will be requested via the keyboard.
C         If NL is equal to zero on input, only NCOL and NROW
C         will be requrested.  If NL is a negative number on input,
C         missing information will NOT be requested of the user.
C
C Output arguments
C
C     NL  is a code indicating the file type:
C            NL = 3 a group file
C            NL = 2 an aperture photometry file
C            NL = 1 other (output from FIND, PEAK, or NSTAR)
C            NL = 0 a file without a header
C
C    NCOL  is the number of columns in the picture (length in x)
C
C    NROW  is the number of rows in the picture (length in y)
C
C  THRESH  is the star-finding threshold that was used (from FIND)
C
C     AP1  is the radius of the first aperture (from PHOT)
C
C  PHPADU  is the number of photons per ADU that was given(from PHOT)
C
C  READNS  is the readout noise per pixel in ADU (from PHOT)
C
C   LOBAD  is the low bad pixel limit that was used (from FIND)
C
C   HIBAD  is the high bad pixel limit that was used (from FIND)
C
C    FRAD  is the fitting radius (from OPTION, used by PSF, PEAK,
C          and NSTAR)
C
C=======================================================================
C
      IMPLICIT NONE
      CHARACTER*133 LINE
      CHARACTER*4 FIRST4, TEST
      REAL LOBAD, HIBAD, THRESH, AP1, PHPADU, READNS, FRAD, X
      INTEGER LUN, NL, NCOL, NROW, N, ISTAT, NLIN
C
      READ (LUN,900) FIRST4, TEST
  900 FORMAT (A4, 9X, A4)
      IF (FIRST4 .NE. ' NL ') GO TO 8000               ! No header lines
      IF (TEST .EQ. '  LO') THEN
C
C Latest DAOPHOT II file header.
C
         CALL RDCHAR (LUN, LINE, N, ISTAT)
         N = N+1
         LINE(N:N) = '/'
         READ (LINE,*) NL, NCOL, NROW, LOBAD, HIBAD, THRESH,
     .        AP1, PHPADU, READNS, FRAD
      ELSE IF ((TEST .NE. 'LOWB') .AND. (TEST .NE. 'OWBA')) THEN
C
C Obsolete file header.
C
         READ (LUN,901) NLIN, NCOL, NROW, THRESH, AP1, PHPADU, READNS,
     .        LOBAD, FRAD
  901    FORMAT (1X, I2, 2I4, 7F8.1)
         IF (NL .GE. 0) THEN
            IF (AP1 .LE. 0.) THEN
 1010          CALL GETDAT ('Lowest good data-value:', LOBAD, 1)
               IF (LOBAD .LE. -1.E38) GO TO 1010
            END IF
 1020       CALL GETDAT ('Highest good data-value:', HIBAD, 1)
            IF (HIBAD .LE. 0.) GO TO 1020
         END IF
         NL=NLIN
      ELSE
         READ (LUN,901) NL, NCOL, NROW, LOBAD, HIBAD, THRESH, AP1,
     .        PHPADU, READNS, FRAD
      END IF
      READ (LUN,900)
      RETURN                                           ! Normal return
C
 8000 REWIND (LUN)
      IF (NL .GE. 0) THEN
 8001    CALL GETDAT ('Number of columns in the image:', X, 1)
         IF (X .LT. 0.5) GO TO 8001
         NCOL = NINT(X)
 8002    CALL GETDAT ('Number of rows in the image:', X, 1)
         IF (X .LT. 0.5) GO TO 8002
         NROW = NINT(X)
      END IF
C
      IF (NL .GT. 0) THEN
 8003    CALL GETDAT ('Readout noise (ADU):', READNS, 1)
         IF (READNS .LE. 0.) GO TO 8003
 8006    CALL GETDAT ('Gain (photons per ADU):', PHPADU, 1)
         IF (PHPADU .LE. 0.) GO TO 8006
 8010    CALL GETDAT ('Lowest good data-value:', LOBAD, 1)
         IF (LOBAD .LE. -1.E38) GO TO 8010
 8020    CALL GETDAT ('Highest good data-value:', HIBAD, 1)
         IF (HIBAD .LE. -1.E38) GO TO 8020
      END IF
      NL=0
      RETURN
C
      END!
C
C#######################################################################
C
      SUBROUTINE  WRHEAD (LUN, NL, NCOL, NROW, ITEMS, LOBAD, HIBAD,
     .     THRESH, AP1, PHPADU, READNS, FRAD)
C
C=======================================================================
C
C Subroutine to write a standard header into an output sequential
C data file on the disk.  Same as RDHEAD, except that all the output
C arguments are now input arguments.  ITEMS tells how many of the
C individual arguments are to be written into the header.
C
C              Latest DAOPHOT II version:  1991 January 15
C=======================================================================
C
      IMPLICIT NONE
      CHARACTER*8 HEAD(7)
      REAL A(7)
C
      REAL LOBAD, HIBAD, THRESH, AP1, PHPADU, READNS, FRAD
      INTEGER LUN, NL, NCOL, NROW, ITEMS, I
      DATA HEAD /'  LOWBAD', ' HIGHBAD', '  THRESH', '     AP1',
     .     '  PH/ADU', '  RNOISE', '    FRAD'/
C
C-----------------------------------------------------------------------
C
      A(1)=LOBAD
      A(2)=HIBAD
      A(3)=THRESH
      A(4)=AP1
      A(5)=PHPADU
      A(6)=READNS
      A(7)=FRAD
      WRITE (LUN,900) (HEAD(I), I=1,ITEMS)
  900 FORMAT (' NL   NX   NY', 8A8)
      WRITE (LUN,901) NL, NCOL, NROW, (A(I), I=1,ITEMS)
  901 FORMAT (1X, I2, 2I5, 2F8.1, 5F8.2)
      WRITE (LUN,901)                             ! Write a blank line
      RETURN                                        ! Normal return
C
      END!
C
C#######################################################################
C
      SUBROUTINE RDCHAR (LUN, LINE, N, ISTAT)
      IMPLICIT NONE
      CHARACTER*(*) LINE
      INTEGER LUN, N, ISTAT, I, J
C
      READ (LUN,1,END=8000,ERR=9000) LINE
    1 FORMAT (A)
      N = 0
      DO I=1,LEN(LINE)
         J = ICHAR(LINE(I:I))
         IF ((J .GE. 33) .AND. (J .LE. 126)) N = I
      END DO
      ISTAT = 0
      RETURN
 8000 LINE = ' '
      N = 0
      ISTAT = 1  ! ISTAT = 1 means END OF FILE
      RETURN
 9000 LINE = ' '
      N = 0
      ISTAT = -1  ! ISTAT = -1 means ERROR
      RETURN
      END!
C
C#######################################################################
C
      FUNCTION EXTRCT (STRING, IFLAG)
      IMPLICIT NONE
      INTEGER LEN
      CHARACTER*(*) STRING
      REAL EXTRCT
      INTEGER L, IFLAG
C
      L = LEN(STRING)
      READ (STRING, *, ERR=9000) EXTRCT
      IFLAG = 0
      RETURN
 9000 EXTRCT = -1.1E38
      IFLAG = -1
      RETURN
      END!
C
C#######################################################################
C
      SUBROUTINE  STUPID (MESSAG)
      IMPLICIT NONE
      CHARACTER*(*) MESSAG
      CHARACTER*1 BELL
      BELL = CHAR(7)
      WRITE (6,601) MESSAG, BELL
  601 FORMAT (/1X, A, A1/)
      RETURN
      END!
C
C#######################################################################
C
      INTEGER  FUNCTION  ICNVRT (ASTRING)
C
C=======================================================================
C
C This little function is supposed to take two ASCII characters and
C express them as an integer in the range 0-(32**2-1) without
C distinguishing upper and lower case:
C
C AA = Aa = aA = aa = 0, AB = Ab = aB = ab = 1, BA = Ba = bA = ba = 32,
C etc.
C
C Argument
C
C ASTRING is a character string containing two ASCII characters.
C
C=======================================================================
C
      IMPLICIT NONE
      CHARACTER*2 ASTRING
C
C-----------------------------------------------------------------------
C
      ICNVRT=32*MOD(ICHAR(ASTRING(1:1))-1,32)+
     .     MOD(ICHAR(ASTRING(2:2))-1,32)
      RETURN
C
      END!
C
C#######################################################################
C
      SUBROUTINE  OPTION (OPTFIL, NOPT, LBL, OPT, OMIN,
     .     OMAX, PROMPT, ISTAT)
C
C=======================================================================
C
C Acquire a set of optimization parameters, either from a disk file
C or from the keyboard.
C
C              OFFICIAL DAO VERSION:  1985 October 25
C
C Arguments
C
C OPTFIL (INPUT) a character string containing either (a) the name of
C         a disk file which will be offered as the default file from
C         which the parameter definitions are to be read (if OPTFIL =
C         ' ', no default file name will be offered; if OPTFIL =
C         'daophot.opt' and this file does not exist, no error message
C         is to be produced and the current contents of OPT are to be
C         left alone), or (b) the string 'KEYBOARD INPUT', in which
C         case the user is to be prompted to define parameter values
C         via the terminal.
C
C     OPT (INPUT/OUTPUT) numerical values for the NOPT user-definable
C         parameters.
C
C=======================================================================
C
      IMPLICIT NONE
      INTEGER MAXOPT, NOPT
      PARAMETER  (MAXOPT=100)
C
C Parameter:
C
C NOPT is the number of user-specifiable optional parameters.
C
      CHARACTER*26 LBL(NOPT)
      REAL OPT(NOPT), OMIN(NOPT), OMAX(NOPT)
      INTEGER IDOPT(MAXOPT)
C
      REAL EXTRCT
      INTEGER ICNVRT
C
      CHARACTER*80 OLINE
      CHARACTER*30 CASE
      CHARACTER*(*) OPTFIL, PROMPT
      INTEGER ISTAT, NPRO, I, J, INUNIT, N, IOPT
      LOGICAL CHANGE
C
C-----------------------------------------------------------------------
C
C Get ready to interpret the option.  For each of the defined labels,
C convert the first two non-blank characters to a number.
C
 1000 NPRO = LEN(PROMPT)
      DO 1010 I=1,NOPT
         DO J=1,26
            IF (LBL(I)(J:J) .NE. ' ') GO TO 1010
         END DO
 1010 IDOPT(I)=ICNVRT(LBL(I)(J:J+1))
C
C If OPTFIL equals anything but 'KEYBOARD INPUT', then treat it as a
C filename and try to open it and read the commands from it, then
C display the results; if it happens to be daophot.opt, return quietly
C afterwards; otherwise, after displaying what you've read, go back
C and prompt for new keyboard input.
C
      IF (OPTFIL .EQ. 'KEYBOARD INPUT') THEN
         INUNIT = 5
         CALL TBLANK
         WRITE (6,610) (LBL(I), OPT(I), I=1,NOPT)
  610    FORMAT (1X, A26, ' =', F9.2, 4X, A26, ' =', F9.2)
         CALL TBLANK
         CHANGE = .FALSE.
         GO TO 2000
      END IF
C
      INUNIT = 2
      CALL INFILE (2, OPTFIL, ISTAT)
      IF (ISTAT .NE. 0) GO TO 3000
C
C-----------------------------------------------------------------------
C
C SECTION 2
C
C Loop to read and interpret commands one at a time.
C
 2000 IF (INUNIT .EQ. 5) CALL INQUIR (PROMPT, NPRO)
      CALL RDCHAR (INUNIT, OLINE, N, ISTAT)
      IF (ISTAT .GT. 0) THEN
         IF (INUNIT .EQ. 5) RETURN
         GO TO 3000
      END IF
      IF (ISTAT .LT. 0) GO TO 2000
      IF (N .LE. 3) GO TO 3000
C
C Now interpret this command line.
C
C First find the equals sign.  Set J to its numerical position in the
C string.
C
      DO 2010 J=3,N
      IF (OLINE(J:J) .EQ. '=') GO TO 2020
 2010 CONTINUE
      CALL STUPID ('The equals sign is missing.')
      GO TO 2000
C
C Now identify the parameter.
C
 2020 IOPT=ICNVRT(OLINE(1:2))
      DO 2030 I=1,NOPT
      IF (IOPT .EQ. IDOPT(I)) GO TO 2040
 2030 CONTINUE
      CALL STUPID ('Unrecognized parameter: '//OLINE(1:J-1))
      GO TO 2000
C
C Now decode the numeric constant and set the appropriate option to this
C value.  Then go back and obtain the next command line.
C
 2040 OPT(I) = EXTRCT (OLINE(J+1:N), ISTAT)
      IF (ISTAT .NE. 0) THEN
         CALL STUPID
     .        ('Invalid numeric constant: '//OLINE(J+1:N))
         ELSE
            CHANGE = .TRUE.
      END IF
      GO TO 2000
C
C-----------------------------------------------------------------------
C
C SECTION 3
C
C If file is neither 'daophot.opt' nor 'KEYBOARD INPUT', allow
C the user to enter modifications by hand.
C
 3000 IF (INUNIT .EQ. 2) THEN
         CALL CLFILE (2)
         IF (OPTFIL .NE. CASE('daophot.opt')) THEN
            CALL TBLANK
            WRITE (6,610) (LBL(I), OPT(I), I=1,NOPT)
            CALL TBLANK
            INUNIT = 5
            CHANGE = .FALSE.
            GO TO 2000
         END IF
      END IF
C
C Check that all parameters are acceptable.
C
      DO 3010 I=1,NOPT
      IF ((OPT(I) .LT. OMIN(I)) .OR. (OPT(I) .GT. OMAX(I))) GO TO 4000
 3010 CONTINUE
C
C Type out all parameter values.
C
      IF (CHANGE) THEN
         CALL TBLANK
         WRITE (6,610) (LBL(I), OPT(I), I=1,NOPT)
      END IF
      ISTAT = 0
      RETURN
C
C-----------------------------------------------------------------------
C
C SECTION 4
C
C There was some problem with one of the parameters.  Type it out and
C ask for the problem to be corrected.
C
 4000 CALL STUPID ('Value unacceptable --- please re-enter')
      CALL INQUIR (LBL(I)//' =', 50)
      CALL RDCHAR (5, OLINE, N, ISTAT)
      IF (N .LE. 0) CALL OOPS
      IF (ISTAT .GT. 0) GO TO 3000
      IF (ISTAT .LT. 0) GO TO 4000
C
C Decode the constant.
C
      OPT(I) = EXTRCT(OLINE(1:N), ISTAT)
      IF (ISTAT .NE. 0) GO TO 4000
      GO TO 3000
C
C-----------------------------------------------------------------------
C
C ERROR:  unable to open the disk file.
C
C If the file name is 'daophot.opt', no problem-- just check the
C default values for validity and return to the main program.
C Otherwise, type an error message and ask for a new file name.
C
C 9000 IF (OPTFIL .EQ. CASE('daophot.opt')) GO TO 3000
C      OLINE = 'Error opening input file '//OPTFIL
C      CALL STUPID (OLINE)
C      OPTFIL='KEYBOARD INPUT'
C      GO TO 1000
C
      END!
C
C#######################################################################
C
      SUBROUTINE CHECK(LUN,NL)
C
C Check whether an input file has a DAOPHOT data file header.
C
      IMPLICIT NONE
      CHARACTER*4 FIRST4
      INTEGER NL, LUN
C
      NL=1
      READ(LUN,200)FIRST4
  200 FORMAT(A4)
      IF(FIRST4.NE.' NL ')GO TO 1000
      READ(LUN,201)NL
  201 FORMAT(1X,I2)
      READ(LUN,200)
      RETURN
 1000 REWIND(LUN)
      RETURN
      END!
