C @(#)instr.for	17.1.1.1 (ES0-DMD) 01/25/02 17:17:32
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
         PROGRAM INSTRM
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C.COPYRIGHT (c)
C.IDENT         INSTR.FOR
C.MODULE
C.AUTHOR        Andrew T. Young
C.KEYWORD
C.LANGUAGE      FORTRAN 77
C.PURPOSE       Make or check the instrument-description table file.
C.COMMENTS
C.VERSION       0.0
C               0.5     921202, KB
C               4.5     930317. aty
C               5.2     930406. aty
C.RETURNS
C.ENVIRONMENT
C.
C-----------------------------------------------------------------------------
C
C
C       Notation: table-column variables begin with K.
C
C  BEGIN Declarations:
C
      IMPLICIT NONE
C
      INTEGER MXSLOT, MXDETS
      PARAMETER (MXSLOT=60, MXDETS=20)
C
        CHARACTER*72 INSTNAM
        CHARACTER*8 REPLY, CODE, BAND
        CHARACTER*80 INSTRTBL, ALTNAME, C80, SPRTBL, FILTCAT
        CHARACTER SNUMBER*9, MODE*20
        CHARACTER*12 FMT,DEDTYP,COOLING
        CHARACTER*12 DETNAM(MXSLOT),DTNAM(MXDETS)
C
        LOGICAL NULL, FEXIST, CCD, HASND
C
      DOUBLE PRECISION DNULL
      REAL RNULL
      INTEGER INULL
C
      INTEGER J_CONT,J_LOG,J_DISP
      COMMON/FLAGS/J_CONT,J_LOG,J_DISP
C
      INTEGER LWORD
      EXTERNAL LWORD
C
        LOGICAL MATCH, HELP
        EXTERNAL MATCH, HELP
C
C
      REAL TEMP, DEDTIM, DEDERR, RATEMX, RLSIZE, XNDVAL
C
      INTEGER NCOLS, NROW, NROWS, NSORTC, NWPRAL, NROWSAL,
     1        NVALS, IUNIT, NULLS, NFCDFS, NDET, NDETS, NDETRO,
     2        NFC, NSLOT, NSLOTS, MAXNAME, NUMNAME, NFILT,
     3        KOLS
C
        INTEGER KFLTCD(25)
C
C       Column pointers:
C
      INTEGER KDET, KBAND, KDETNM, KNDET, KCOOLING, KCOOL, KND,
     1        KSNUMB, KMODE, KDEDTYP, KDEDTM, KDEDER, KSPRTBL, KBLURSP,
     2        KDTEMP, KNBAND, KNDETU, KRL, KRLTYP, KMAKER
C
      INTEGER ITBL, ISTAT
C
C
C  Set up MIDAS declarations:
C
        INTEGER MADRID(1)
C
        COMMON /VMR/ MADRID
C
        INCLUDE 'MID_INCLUDE:ST_DEF.INC'
        INCLUDE 'MID_INCLUDE:ST_DAT.INC'
C
C
C
C  END Declarations.
C
C
C
C
C  ********************  PROLOGUE  ********************
C
        CALL STSPRO ('INSTRM')
C
C     get NULL values:
C
      CALL TBMNUL (INULL, RNULL, DNULL)
C
C     save error settings:
      CALL STECNT('GET', J_CONT,J_LOG,J_DISP)
C     reset error settings:
      CALL STECNT('PUT', 1,2,2)
C
C  Real program begins here:
C
C
C       AskAscii:
    1   CONTINUE
        CALL ASK('Is the instrument already in a MIDAS table file?',
     1                  REPLY)
C       *****
        IF (REPLY(:1) .EQ. 'Y') THEN
C       *****
C
C   AskName:
    2   CONTINUE
        CALL ASKFIL('What is the name of the file?',INSTRTBL)
C
C See if instrum.tbl is available locally...
C
C   Fexist:
    3   CONTINUE
        INQUIRE (FILE=INSTRTBL, EXIST=FEXIST)
C               ***
                IF (.NOT.FEXIST) THEN
C               ***                       Not found.
C
C       Maybe user forgot the suffix:
        ALTNAME=INSTRTBL(:LWORD(INSTRTBL))//'.tbl'
        INQUIRE (FILE=ALTNAME, EXIST=FEXIST)
        IF (FEXIST) THEN
            INSTRTBL=ALTNAME
            C80='(Actually, it''s '//INSTRTBL(:LWORD(INSTRTBL))//
     1                         ' because of the suffix.)'
            CALL TV (C80)
            CALL SPACE2
            GOTO 3
        ENDIF
C
        C80='No file named '//INSTRTBL(:LWORD(INSTRTBL))//
     1                         ' in your local directory.'
        CALL TV(C80)
    5   CONTINUE
        C80='Is '//INSTRTBL(:LWORD(INSTRTBL))//' the correct name?'
        CALL ASK(C80,REPLY)
        IF(REPLY(:1) .EQ. 'N')THEN
            CALL SPACE
            GOTO 2
        ELSEIF(REPLY(:1) .EQ. 'Y')THEN
            CALL TV('Maybe it''s in another directory.')
            CALL TVN('Please find the file, and try again.')
            CALL STECNT('PUT', J_CONT,J_LOG,J_DISP)
            CALL STETER(5,' ')
        ELSE
            CALL TV('Please reply Yes or No.')
            GOTO 5
        ENDIF
C
C               ***
                ELSE
C               ***
C
C       File exists.  Use it:
        CALL TV('Please check this description of the instrument:')
        CALL TBTOPN (INSTRTBL, 1,  ITBL, ISTAT)
        IF (ISTAT.NE.0)THEN
            CALL TERROR(ITBL,5,'Could not open table.')
        END IF
        CALL TBIGET (ITBL,  NCOLS, NROWS, NSORTC, NWPRAL, NROWSAL,ISTAT)
        IF (ISTAT.NE.0)THEN
            CALL TERROR(ITBL,5,'Could not get basic table data.')
        END IF
C
C       READ/TABLE {instrtbl}
        CALL READT(ITBL)
C
C    Read DESCRIPTORS:
C
C       Look at INSTNAM:
        CALL STDRDC (ITBL, 'INSTNAM', 1, 1, 72,
     1                NVALS, INSTNAM, IUNIT, NULLS, ISTAT)
        IF (ISTAT.NE.0) THEN
            CALL TERROR(ITBL,6,'Could not find descriptor INSTNAM')
        END IF
        CALL TV('Instrument is:')
        CALL TV(INSTNAM)
C
C       Look at FILTCAT:
        CALL STDRDC (ITBL, 'FILTCAT', 1, 1, 80,
     1                NVALS, FILTCAT, IUNIT, NULLS, ISTAT)
        IF (ISTAT.NE.0) THEN
            CALL TERROR(ITBL,6,'Could not find descriptor FILTCAT')
        END IF
        IF (FILTCAT(:1).EQ.' ') THEN
C               No catalog.
                CALL TV('No filter catalog.')
        ELSE
                CALL TV('Filter catalog: ')
                CALL TVN(FILTCAT)
        END IF
C
C       Look at NFILTCAR:
        CALL STDRDI (ITBL, 'NFILTCAR', 1, 1,
     1                NVALS, NFCDFS, IUNIT, NULLS, ISTAT)
        IF (ISTAT.NE.0) THEN
            CALL TERROR(ITBL,6,'Could not find descriptor NFILTCAR')
        END IF
        WRITE(C80,'(I6,A19)')NFCDFS, ' filter code fields'
C       a singular correction...
        IF (NFCDFS.EQ.1) C80(25:25)=' '
        CALL TV(C80)
C
C       Look at FILTSTAT:
        CALL STDRDC (ITBL, 'FILTSTAT', 1, 1, 9,
     1                NVALS, C80, IUNIT, NULLS, ISTAT)
        IF (ISTAT.NE.0) THEN
            CALL TERROR(ITBL,6,'Could not find descriptor FILTSTAT')
        END IF
        IF (C80(:1).EQ.'R') THEN
C               Filter temp. Regulated.
                CALL STDRDR (ITBL, 'FILTTEMP', 1, 1,
     1                   NVALS, TEMP, IUNIT, NULLS, ISTAT)
                WRITE(C80,
     1            '(''Filter temperature regulated at '',F5.1,'' K'')')
     2                  TEMP
                CALL TV(C80)
        ELSE IF (C80(:1).EQ.'M') THEN
C               Filter temp. Measured.
                CALL TV('Filter temperature MEASURED, not regulated.')
        ELSE IF (C80(:1).EQ.'D') THEN
C               Filter temp. = ambient.
                CALL TV('Filters at DOME temperature')
        ELSE
                CALL TV('Unrecognized string in descriptor FILTSTAT:')
                CALL TVN(C80)
        END IF
C
C       Look at NDETS:
        CALL STDRDI (ITBL, 'NDETS', 1, 1,
     1                NVALS, NDETS, IUNIT, NULLS, ISTAT)
        IF (ISTAT.NE.0)THEN
            CALL TERROR(ITBL,6,'Could not find descriptor NDETS')
        END IF
        WRITE(C80,'(I6,A18)')NDETS, ' detector channels'
        IF (NDETS.EQ.1) C80(24:24)=' '
        CALL TV(C80)
C
C       Get required-column pointers:
C
        CALL TBLSER (ITBL, 'DET',  KDET, ISTAT)
        IF (ISTAT.NE.0) THEN
            CALL TERROR(ITBL,6,'Could not find column DET')
        END IF
        CALL TBLSER (ITBL, 'BAND',  KBAND, ISTAT)
        IF (ISTAT.NE.0) THEN
            CALL TERROR(ITBL,6,'Could not find column BAND')
        END IF
        CALL TBLSER (ITBL, 'DETNAME',  KDETNM, ISTAT)
        IF (ISTAT.NE.0) THEN
            CALL TERROR(ITBL,6,'Could not find column DETNAME')
        END IF
        CALL TBLSER (ITBL, 'NDET',  KNDET, ISTAT)
        IF (ISTAT.NE.0) THEN
            CALL TERROR(ITBL,6,'Could not find column NDET')
        END IF
        CALL TBLSER (ITBL, 'COOLING',  KCOOLING, ISTAT)
        IF (ISTAT.NE.0) THEN
            CALL TERROR(ITBL,6,'Could not find column COOLING')
        END IF
C
C       Look at detectors:
C
        DO 9 NDET=1,NDETS
C           find row containing NDET:
            DO 7 NROW=1,NROWS
            CALL TBERDI (ITBL, NROW, KNDET,  NDETRO, NULL, ISTAT)
            IF (ISTAT.NE.0)THEN
                CALL TERROR(ITBL,7,'Could not read column NDET')
            END IF
            IF (.NOT.NULL)THEN
                IF (NDET.EQ.NDETRO) GO TO 8
            END IF
    7       CONTINUE
            WRITE(C80,'(''Could not locate data for NDET ='',I2)') NDET
            CALL TERROR(ITBL,8,C80)
    8       CONTINUE
            IF (NDETS.GT.1)THEN
                IF (KDETNM.GT.0)THEN
                    CALL TBERDC (ITBL, NROW, KDETNM,
     1                           DTNAM(NDET), NULL, ISTAT)
                    IF (ISTAT.NE.0)THEN
                        CALL TERROR(ITBL,8,
     1                              'Could not read DETNAME column.')
                    END IF
                    WRITE(C80,'(''   *****  '',A,'' channel  *****'')')
     1                          DTNAM(NDET)(:LWORD(DTNAM(NDET)))
                ELSE
                    WRITE(C80,'(''   *****  detector'',I3,''  *****'')')
     1                          NDET
                END IF
                CALL TV(C80)
            END IF
C
C           Look at DET:
C
            CALL TBERDC (ITBL, NROW, KDET,  REPLY, NULL, ISTAT)
            IF (ISTAT.NE.0)THEN
                CALL TERROR(ITBL,8,'Could not read DET column.')
            END IF
            IF (REPLY(:1).EQ.'P') THEN
C               we have DET = PMT
C
                CALL TBLSER (ITBL, 'SNUMBER',  KSNUMB, ISTAT)
                IF (ISTAT.NE.0) THEN
                    CALL TERROR(ITBL,8,'Could not find column SNUMBER')
                END IF
                CALL TBERDC (ITBL, NROW, KSNUMB,  SNUMBER, NULL, ISTAT)
                IF (ISTAT.NE.0)THEN
                    CALL TERROR(ITBL,8,'Could not read SNUMBER column.')
                END IF
C
                CALL TBLSER (ITBL, 'MODE',  KMODE, ISTAT)
                IF (ISTAT.NE.0) THEN
                    CALL TERROR(ITBL,8,'Could not find column MODE')
                END IF
                CALL TBERDC (ITBL, NROW, KMODE,  MODE, NULL, ISTAT)
                IF (ISTAT.NE.0)THEN
                    CALL TERROR(ITBL,8,'Could not read MODE column.')
                END IF
C
                MODE(3:)=' '
                IF (MODE(:2).EQ.'PC') THEN
                        MODE='Pulse-counting'
                ELSE IF (MODE(:2).EQ.'DC') THEN
                ELSE IF (MODE(:2).EQ.'CI') THEN
                        MODE='Charge-integrating'
                ELSE
                        MODE='unrecognized'
                END IF
                WRITE (C80,'(A)') SNUMBER(:LWORD(SNUMBER))//
     1                ' PMT used in '//MODE(:LWORD(MODE))//' mode'
                CALL TV(C80)
                IF (MODE(:1).EQ.'P')THEN
                        CALL TBLSER (ITBL, 'DEADTYPE',  KDEDTYP, ISTAT)
                        IF (ISTAT.NE.0) THEN
                            CALL TERROR(ITBL,8,
     1                            'Could not find column DEADTYPE')
                        END IF
                        CALL TBERDC (ITBL, NROW, KDEDTYP,
     1                                 DEDTYP, NULL, ISTAT)
                        IF (ISTAT.NE.0)THEN
                            CALL TERROR(ITBL,8,
     1                             'Could not read DEADTYPE column.')
                        END IF
C
                        IF (DEDTYP(:1).EQ.'E') THEN
                                DEDTYP='EXTENDING'
                        ELSE IF (DEDTYP(:1).EQ.'N') THEN
                                DEDTYP='NON-EXTENDING'
                        ELSE IF (DEDTYP(:1).EQ.'U') THEN
                                DEDTYP='UNKNOWN type of'
                        ELSE
                                CALL TV('Unrecognized dead-time type.')
                                DEDTYP='incorrectly coded'
                        END IF
C
                        CALL TBLSER (ITBL, 'DEADTIME',  KDEDTM, ISTAT)
                        IF (ISTAT.NE.0) THEN
                            CALL TERROR(ITBL,8,
     1                            'Could not find column DEADTIME')
                        END IF
                        CALL TBERDR (ITBL, NROW, KDEDTM,
     1                                 DEDTIM, NULL, ISTAT)
                        IF (ISTAT.NE.0)THEN
                            CALL TERROR(ITBL,8,
     1                             'Could not read DEADTIME column.')
                        END IF
C
                        CALL TBLSER (ITBL,'DEADTIMEERROR',KDEDER,ISTAT)
                        IF (ISTAT.NE.0) THEN
                            CALL TERROR(ITBL,8,
     1                            'Could not find column DEADTIMEERROR')
                        END IF
                        CALL TBERDR (ITBL, NROW, KDEDER,
     1                                 DEDERR, NULL, ISTAT)
                        IF (ISTAT.NE.0)THEN
                            CALL TERROR(ITBL,8,
     1                           'Could not read DEADTIMEERROR column.')
                        END IF
C
                        WRITE(C80,'(''with'',F6.1,'' +/-'',F5.1,A)')
     1                   DEDTIM*1.E9,DEDERR*1.E9,' ns '//
     2                      DEDTYP(:LWORD(DEDTYP))//' dead time'
                        CALL TVN(C80)
                ELSE
                END IF
            ELSE IF (REPLY(:1).EQ.'S' .OR. REPLY(:1).EQ.'O') THEN
C               we have DET = SILICON (or OTHER)
C
                CALL TBLSER (ITBL, 'SPECTRESPTBL',  KSPRTBL, ISTAT)
                IF (ISTAT.NE.0) THEN
                    CALL TERROR(ITBL,8,
     1                  'Could not find column SPECTRESPTBL')
                END IF
C
                IF (REPLY(:1).EQ.'S' .AND. KSPRTBL.EQ.-1) THEN
C                   look for BLUERESP:
                    CALL TBLSER (ITBL, 'BLUERESP',  KBLURSP, ISTAT)
                    IF (ISTAT.NE.0) THEN
                        CALL TERROR(ITBL,8,
     1                         'Could not find column BLUERESP')
                    END IF
                    CALL TBERDC (ITBL, NROW, KBLURSP,  REPLY,NULL,ISTAT)
                    IF (ISTAT.NE.0 .AND. .NOT.NULL)THEN
                        CALL TERROR(ITBL,8,
     1                          'Could not read BLUERESP column.')
                    END IF
C
                    IF (REPLY(:1).EQ.'F') THEN
C                       Front:
                        C80='Front-illuminated Silicon detector'
                    ELSE IF (REPLY(:1).EQ.'B') THEN
C                       Back:
                        C80='Back-illuminated Silicon detector'
                    ELSE IF (REPLY(:1).EQ.'P') THEN
C                       Phosphor:
                        C80='Phosphor-coated Silicon detector'
                    ELSE IF (REPLY(:1).EQ.'E') THEN
C                       Enhanced:
                        C80='UV-enhanced Silicon detector'
                    ELSE
                        CALL TV('Unknown code in descriptor BLUERESP:')
                        CALL TVN(REPLY)
                        C80='Silicon detector'
                    END IF
                ELSE IF (REPLY(:1).EQ.'S') THEN
                    C80='Silicon detector'
                ELSE IF (REPLY(:1).EQ.'O') THEN
C                   we have DET = OTHER
                    C80='Non-standard detector type.'
                END IF
C
                CALL TV(C80)
C
                IF (KSPRTBL.GT.0)THEN
                    CALL TBERDC (ITBL, NROW,KSPRTBL,  SPRTBL,NULL,ISTAT)
                    IF (ISTAT.NE.0)THEN
                        CALL TERROR(ITBL,8,
     1                      'Could not read SPECTRESPTBL column.')
                    END IF
                    IF (SPRTBL(:1).NE.' ') THEN
                        CALL TVN('spectral response in file:')
                        CALL TVN(SPRTBL)
                    ELSE
                        CALL TVN('without spectral response table,')
                    END IF
                ELSE
                    CALL TVN('without spectral response table,')
                END IF
            ELSE
                CALL TV('Unrecognized string in DET.')
            END IF
C
C       Look at COOLING:
C
        CALL TBLSER (ITBL, 'COOLING',  KCOOL, ISTAT)
        IF (ISTAT.NE.0) THEN
            CALL TERROR(ITBL,8,'Could not find column COOLING')
        END IF
        CALL TBERDC (ITBL, NROW, KCOOL,  MODE, NULL, ISTAT)
        IF (ISTAT.NE.0)THEN
            CALL TERROR(ITBL,8,'Could not read COOLING column.')
         END IF
C
        IF(MODE(:1).EQ.'R') THEN
C           detector temperature Regulated.
            CALL TBLSER (ITBL, 'DETTEMP',  KDTEMP, ISTAT)
            IF (ISTAT.NE.0) THEN
                CALL TERROR(ITBL,8,'Could not find column DETTEMP')
            END IF
            CALL TBERDR (ITBL, NROW, KDTEMP,  TEMP, NULL, ISTAT)
            IF (ISTAT.NE.0)THEN
                CALL TERROR(ITBL,8,'Could not read DETTEMP column.')
             END IF
C
            WRITE(C80,
     1            '(''Detector temp. regulated at '',F5.1,'' K'')')
     2                  TEMP
            CALL TVN(C80)
        ELSE IF(MODE(:1).EQ.'U') THEN
C           Unregulated detector cooling.
            CALL TVN('Detector cooled, but not regulated.')
        ELSE IF(MODE(:1).EQ.'D') THEN
C           detector cooled with Dry ice.
            CALL TVN('Detector cooled with DRY ICE.')
        ELSE IF(MODE(:1).EQ.'I') THEN
C           detector cooled with ordinary Ice.
            CALL TVN('Detector cooled with ordinary water ICE.')
        ELSE IF(MODE(:1).EQ.'M') THEN
C           detector temperature Measured.
            CALL TVN('Detector temperature MEASURED.')
        ELSE IF(MODE(:1).EQ.'N') THEN
C           detector Not cooled (at ambient temp.)
            CALL TVN('Detector not cooled; assumed at dome temp.')
        ELSE
            CALL TV('Unrecognized string in COOLING.')
        END IF
C
    9   CONTINUE
C
C       Look at CONDITION:
        MODE=' '
        CALL STDRDC (ITBL, 'CONDITION', 1, 1, 7,
     1                NVALS, MODE, IUNIT, NULLS, ISTAT)
        WRITE(C80,'(A)') 'Optics are in '//MODE(:LWORD(MODE))//
     1                     ' condition.'
        CALL TV(C80)
        CALL SPACE2
C
C               ***
                ENDIF
C               ***
C                       (Finished with existing file here.)
C       .....................................................................
C       *****
        ELSEIF (REPLY(:1) .EQ. 'N') THEN
C       *****                                    *****  MAKE NEW TABLE  *****
C
        CALL SPACE2
        CALL TV ('NOTE:  Help is available here.')
        CALL TVN('If you do not understand a question, reply')
        CALL TV ('     HELP')
        CALL TVN('or')
        CALL TVN('       ?')
        CALL TV ('and help will be provided.  Please refer to')
        CALL TVN('the Appendix on File Formats for details.')
        CALL SPACE2
        CALL ASKFIL('What do you want to call the table file?',INSTRTBL)
C       Create the table:
   10   CONTINUE
        CALL TBTINI (INSTRTBL, 0, 0, 1, 1,  ITBL, ISTAT)
        IF (ISTAT.NE.0) THEN
                CALL TV('Unable to create table...')
                CALL STECNT('PUT', J_CONT,J_LOG,J_DISP)
                CALL STETER(10,' ')
        ENDIF
C
        CALL TVN('   ... new table file created.')
C
        CALL ASKFIL('Enter the name of the instrument: ',INSTNAM)
C
        CALL TBCINI (ITBL, D_I1_FORMAT, 1, 'I5', ' ', 'NBAND',
     1               KNBAND, ISTAT)
        IF (ISTAT.NE.0) THEN
                CALL TERROR(ITBL,10,'Could not create NBAND Column')
        ENDIF
C
        CALL TBCINI (ITBL, D_C_FORMAT, 8, 'A8', ' ', 'BAND',
     1               KBAND, ISTAT)
        IF (ISTAT.NE.0) THEN
                CALL TERROR(ITBL,10,'Could not create BAND Column')
        ENDIF
C
      HASND=.FALSE.
      C80='Does '//INSTNAM(:LWORD(INSTNAM))
      CALL TV(C80)
      CALL ASKN('use "neutral" attenuators (e.g., filters)?',REPLY)
      IF (MATCH(REPLY,'YES')) THEN
         HASND=.TRUE.
         CALL TBCINI (ITBL, D_R4_FORMAT, 1, 'F7.3', ' ', 'NDVALUE',
     1               KND, ISTAT)
         IF (ISTAT.NE.0) THEN
                CALL TERROR(ITBL,10,'Could not create NDVALUE Column')
         ENDIF
      ELSE IF (MATCH(REPLY,'NO')) THEN
C        OK.
      ELSE
C        problem?
         CALL TV('No neutral filters assumed.')
      END IF
C
      CALL SPACE2
      CALL TV('Please supply information about FILTER CODING:')
      CALL TVN('programs must be able to identify passbands in your')
      CALL TVN('MIDAS table-format data files.')
C
      CALL TV('In SINGLE-CHANNEL data, we expect 1 filter-code field')
      CALL TVN('in raw data files, with one filter CODE per passband.')
      CALL TVN('Two filter wheels in series can often be treated as')
      CALL TVN('a single field in data, if their codes are adjacent.')
C
      CALL TV('MULTI-CHANNEL instruments may use separate FILTER-CODE')
      CALL TVN('fields for each detector; then enter the number of')
      CALL TVN('FIELDS used.  But if they put data from different')
      CALL TVN('detectors in different DATA fields, and use no filter')
      CALL TVN('coding at all (one fixed passband per detector, as in')
      CALL TVN('some spectrometric instruments), enter 0.  Remember to')
      CALL TVN('count Dark and Neutral-density filter codes.')
   11   CONTINUE
        CALL ASK('How many FILTER-code FIELDS in raw data?',REPLY)
        IF (HELP(REPLY)) THEN
           CALL TV('This is the number of COLUMNS (not the number of')
           CALL TVN('different data codes) your data files will use')
           CALL TVN('to indicate filter positions.  If the shutter')
            CALL TVN('position is encoded in a different PLACE in the')
           CALL TVN('data, it counts as a separate filter-code field.')
           CALL TVN('Likewise, if there is a separate code field for')
           CALL TVN('neutral-density filters, add that to the count.')
           CALL TVN('But if dark positions are in your regular filter')
           CALL TVN('wheel, they do not count as separate FIELDS.')
           CALL TV ('See Tables 13 - 15 in the Appendix for examples.')
           GO TO 11
        END IF
        READ (REPLY,'(I2)', ERR=11) NFCDFS
        CALL STDWRI (ITBL, 'NFILTCAR', NFCDFS, 1, 1, IUNIT,  ISTAT)
        IF (ISTAT.NE.0) THEN
             CALL TERROR(ITBL,11,'Could not write descriptor NFILTCAR')
        ENDIF
C
        DO 12 NFC=1,NFCDFS
        IF (NFC.LE.9) THEN
            WRITE(MODE,'(''FILTCODE_'',I1)') NFC
        ELSE
            WRITE(MODE,'(''FILTCODE'',I2)') NFC
        END IF
        CALL TBCINI (ITBL, D_C_FORMAT, 8, 'A10', ' ', MODE,
     1               KFLTCD(NFC), ISTAT)
        IF (ISTAT.NE.0) THEN
                C80='Could not create '//MODE(:LWORD(MODE))//' column'
                CALL TERROR(ITBL,12,C80)
        ENDIF
   12   CONTINUE
C
C       13 is error return on reading internal file REPLY.
   13   CONTINUE
        CALL ASK('How many DETECTORS or signal channels?',REPLY)
        READ (REPLY,'(I2)', ERR=13) NDETS
        CALL STDWRI (ITBL,'NDETS',NDETS, 1, 1, IUNIT,  ISTAT)
        IF (ISTAT.NE.0) THEN
             CALL TERROR(ITBL,13,'Could not write descriptor NDETS')
        ENDIF
C
        IF (NDETS.GT.MXDETS) THEN
           C80='Sorry -- program is dimensioned for only'
           WRITE(C80(41:),'(I3)') MXDETS
           C80(44:)='detectors.'
           CALL TV(C80)
           CALL TVN('Raise Parameter MXDETS in instr.for & recompile.')
           CALL TERROR(ITBL,13,'Too many detectors.')
        END IF
C
        IF (NDETS.GT.1) THEN
            CALL TBCINI (ITBL, D_I1_FORMAT, 1, 'I8', ' ', 'NDETUSED',
     1               KNDETU, ISTAT)
            IF (ISTAT.NE.0) THEN
                CALL TERROR(ITBL,13,'Could not create NDETUSED column')
            ENDIF
            CALL TBCINI(ITBL,D_C_FORMAT,12,'A12',' ','DETNAME',
     1                 KDETNM,ISTAT)
            IF (ISTAT.NE.0) THEN
                CALL TERROR(ITBL,14,'Could not create DETNAME column')
            ENDIF
        ELSE
            KNDETU=-1
        END IF
        CALL SPACE2
C
C                       *****  Prepare PASSBAND sub-table  *****
C     ------
      IF (NFCDFS.EQ.1) THEN
C     ------
C               only 1 filter-code FIELD.
C
   14   CONTINUE
        CALL ASK(
     1     'How many distinct FILTER CODES (including ND and dark)?',
     2          REPLY)
        IF (HELP(REPLY)) THEN
          CALLTV('This asks how many differently-coded POSITIONS there')
          CALLTVN('are in the filter mechanism.')
           GO TO 14
        END IF
        READ (REPLY,'(I2)', ERR=14) NSLOTS
C
      DO 18 NSLOT = 1, NSLOTS
        CALL SPACE2
        IF (NSLOT.LE.9)THEN
            WRITE (C80,'(A43,I1,''?'')')
     1        'What is the filter CODE in position number ',NSLOT
        ELSE
            WRITE (C80,'(A43,I2,''?'')')
     1        'What is the filter CODE in position number ',NSLOT
        ENDIF
        CALL ASKFIL(C80, CODE)
        CALL TBEWRC(ITBL, NSLOT, KFLTCD(1), CODE,  ISTAT)
        IF (ISTAT.NE.0) THEN
            CALLTERROR(ITBL,15,'Could not write to FILTCODE_1 Column')
        ENDIF
C
   16   IF (NSLOT.LE.9)THEN
            WRITE (C80,'(A42,I1,''?'')')
     1        '    What is the passband NAME in position ',NSLOT
        ELSE
            WRITE (C80,'(A42,I2,''?'')')
     1        '    What is the passband NAME in position ',NSLOT
        ENDIF
        CALL ASKFIL (C80, BAND)
        IF (HELP(BAND)) THEN
            CALL BNDHLP
            GO TO 16
        ENDIF
        CALL TBEWRI(ITBL, NSLOT, KNBAND, NSLOT,  ISTAT)
        IF (ISTAT.NE.0) THEN
                CALL TERROR(ITBL,16,'Could not write to NBAND Column')
        ENDIF
        CALL TBEWRC(ITBL, NSLOT, KBAND, BAND,  ISTAT)
        IF (ISTAT.NE.0) THEN
                CALL TERROR(ITBL,17,'Could not write to BAND Column')
        ENDIF
        IF (HASND) THEN
C         Get XNDVAL.
          IF (LWORD(BAND).GT.2 .AND.
     1        (INDEX(BAND,'ND').EQ.LWORD(BAND)-1 .OR.
     2         INDEX(BAND,'ND').EQ.LWORD(BAND)-2) ) THEN
   17       CALL TV(
     1         'What is the attenuation factor of this neutral filter?')
            CALL TVN('   (enter 1.0 if no attenuation.)')
            CALL QF('?', XNDVAL)
            IF (XNDVAL.GT.0. .AND. XNDVAL.LT.1.) THEN
              CALL TV('Program expects a value greater than unity.')
              XNDVAL=1./XNDVAL
              WRITE(C80,'(F8.3,'' will be used.  OK?'')') XNDVAL
              CALL ASK(C80,REPLY)
              IF (MATCH(REPLY,'YES') .OR. MATCH(REPLY,'OK')) THEN
C               OK.
              ELSE IF (MATCH(REPLY,'NO') .OR. HELP(REPLY)) THEN
                CALL TV('That''s the reciprocal of what you entered.')
                CALL TV(BAND)
                GO TO 17
              ELSE
                CALL TV(BAND)
                GO TO 17
              END IF
            ELSE IF (XNDVAL.LE.0.) THEN
              CALL TV('Please try again:')
              GO TO 17
            END IF
          ELSE
C           no attenuation.
            XNDVAL=1.0
          END IF
C         Write value to table.
          CALL TBEWRR(ITBL, NSLOT, KND, XNDVAL,  ISTAT)
          IF (ISTAT.NE.0) THEN
                CALL TERROR(ITBL,18,'Could not write to NDVALUE Column')
          ENDIF
        END IF
   18 CONTINUE
C
C      Check table:
C
      CALL READT(ITBL)
C
   20 CONTINUE
      CALL ASK('Is this correct?',REPLY)
C
      IF(REPLY(:1) .EQ. 'Y')THEN
        CALL TVN('Thanks for checking.')
      ELSEIF(REPLY(:1) .EQ. 'N')THEN
        CALL TV('Please correct the table.')
        GOTO 11
      ELSE
        CALL TV('Please answer yes, no, or quit.')
        GOTO 20
      ENDIF
C
      INQUIRE (FILE=INSTRTBL, EXIST=FEXIST)
      IF (.NOT.FEXIST) THEN
C       not found, so add suffix:
        WRITE (ALTNAME,'(A80)') INSTRTBL//'.tbl'
        INSTRTBL=ALTNAME
      ENDIF
C
C     ------
      ELSE IF (NFCDFS.GT.1) THEN
C     ------
C                Multiple filter-code FIELDS:
   21 CONTINUE
      CALL TV('In answering the next question, note that DARK and')
      CALL TVN('ND positions must be counted in the total number of')
      CALL TVN('band codes.')
      CALLASK('How many band or filter positions do you measure?',REPLY)
      READ (REPLY,'(I2)', ERR=21) NSLOTS
C
      IF (NSLOTS.GT.MXSLOT) THEN
        CALL SPACE
         CALL TV('Sorry -- too many possibilities.  Increase Parameter')
        CALL TVN('MXSLOT in incr.for and recompile.')
        CALL TERROR(ITBL,21,'Too many filter positions.')
      END IF
C
      IF (NDETS.GT.1) THEN
        CALL SPACE2
        CALLTV('If one filter-code field goes only with one detector,')
        CALL TVN('and another filter code goes with another detector,')
        CALL TVN('enter "any" for the filter code in the irrelevant')
        CALL TVN('filter code field for a given passband.')
      END IF
C
      MAXNAME=0
C
      DO 29 NSLOT=1,NSLOTS
        CALL SPACE2
        WRITE(C80,
     1 '(''Which is the STANDARD NAME of band number '',I2,'' ?'')')
     2     NSLOT
   22   CALL ASKFIL(C80,BAND)
        IF (HELP(BAND)) THEN
                CALL BNDHLP
                GO TO 22
        ENDIF
        CALL TBEWRI(ITBL, NSLOT, KNBAND, NSLOT,  ISTAT)
        IF (ISTAT.NE.0) THEN
                CALL TERROR(ITBL,22,'Could not write to NBAND Column')
        ENDIF
        CALL TBEWRC(ITBL, NSLOT, KBAND, BAND,  ISTAT)
        IF (ISTAT.NE.0) THEN
                CALL TERROR(ITBL,22,'Could not write to BAND Column')
        ENDIF
C
        DO 23 NFILT=1,NFCDFS
          WRITE(C80,
     1  '(''         What is the CODE for '',A,'' in field'',I2,''?'')')
     2                            BAND(:LWORD(BAND)),     NFILT
          CALL ASKFIL(C80,CODE)
          CALL TBEWRC(ITBL, NSLOT, KFLTCD(NFILT), CODE,  ISTAT)
          IF (ISTAT.NE.0) THEN
            WRITE(C80,
     1        '(''Could not write to FILTCODE_'',I1,'' COLUMN'')') NFILT
            CALLTERROR(ITBL,23,C80)
          ENDIF
   23   CONTINUE
C
        IF (HASND) THEN
C         Get XNDVAL.
          IF (LWORD(BAND).GT.2 .AND.
     1        (INDEX(BAND,'ND').EQ.LWORD(BAND)-1 .OR.
     2         INDEX(BAND,'ND').EQ.LWORD(BAND)-2) ) THEN
   24       CALL TV(
     1         'What is the attenuation factor of this neutral filter?')
            CALL TVN('   (enter 1.0 if no attenuation.)')
            CALL QF('?', XNDVAL)
            IF (XNDVAL.GT.0. .AND. XNDVAL.LT.1.) THEN
              CALL TV('Program expects a value GREATER than unity.')
              XNDVAL=1./XNDVAL
              WRITE(C80,'(F8.3,'' will be used.  OK?'')') XNDVAL
              CALL ASK(C80,REPLY)
              IF (MATCH(REPLY,'YES') .OR. MATCH(REPLY,'OK')) THEN
              ELSE
                CALL TV(BAND)
                GO TO 24
              END IF
            ELSE IF (XNDVAL.LE.0.) THEN
              CALL TV('   Please try again:')
              GO TO 24
            END IF
          ELSE
C           no attenuation.
            XNDVAL=1.0
          END IF
C         Write value to table.
          CALL TBEWRR(ITBL, NSLOT, KND, XNDVAL,  ISTAT)
          IF (ISTAT.NE.0) THEN
                CALL TERROR(ITBL,24,'Could not write to NDVALUE Column')
          ENDIF
        END IF
C
C       Detector names:
C
C       variable DTNAM(n)      holds name of detector #n.
C       variable DETNAM(nband) holds name of detector for n-th band.
C
C       column DETNAME         holds name of det. for n-th band in row NSLOT.
C
   25 IF (NDETS.GT.1) THEN
          IF (MAXNAME.GT.1) THEN
              CALL TV('   Known detector names are:')
              CALL SPACE
              DO 26 NUMNAME=1,MAXNAME
                WRITE(C80,'(I10,'':  '',A)') NUMNAME,DTNAM(NUMNAME)
                CALL TVN(C80)
   26         CONTINUE
              CALL TV('(use one of these names, or a new name)')
              CALL TVN('(If you make a mistake, enter GO BACK )')
              CALL SPACE
          END IF
          WRITE(C80,
     1      '(''Which DETECTOR (name) is used to measure '',A,''?'')')
     2             BAND(:LWORD(BAND))
          CALL ASKFIL(C80,DETNAM(NSLOT))
          IF(DETNAM(NSLOT).EQ.'GO BACK') GO TO 21
C       Do I know you?
          DO 27 NUMNAME=1,MAXNAME
C       Yes. Old name:
              IF(DETNAM(NSLOT).EQ.DTNAM(NUMNAME)) GO TO 28
   27     CONTINUE
C       No. New name:
          MAXNAME=MAXNAME+1
          IF (MAXNAME.GT.NDETS) THEN
              CALL SPACE2
              CALL TV('Oops!  More detector names than detectors!')
              CALL SPACE
              CALL TV('Do you want to:')
              CALL SPACE
              CALL TV('    1:  Start over, or')
              CALL TV('    2:  Correct that last name')
              CALL SPACE
              CALL ASK('?',REPLY)
              CALL SPACE
              IF (REPLY(:1).EQ.'1' .OR. MATCH(REPLY,'START')) THEN
                 GO TO 21
              ELSE IF (REPLY(:1).EQ.'2' .OR. MATCH(REPLY,'CORRECT'))THEN
                 GO TO 25
              ELSE
                 CALL TV('Please try again from the beginning:')
                 GO TO 21
              END IF
          ELSE IF (MAXNAME.GT.MXDETS) THEN
              CALL TV('Too many detectors.  Increase parameter')
              CALL TVN('MXDETS in instr.for and recompile.')
              CALL TERROR(ITBL,27,'Parameter MXDETS exceeded.')
          END IF
          DTNAM(MAXNAME)=DETNAM(NSLOT)
          NUMNAME=MAXNAME
          CALL TBEWRC (ITBL, NUMNAME, KDETNM, DETNAM(NSLOT),  ISTAT)
          IF (ISTAT.NE.0) THEN
                CALL TERROR(ITBL,28,'Could not write to DETNAME Column')
          ENDIF
C       Name known here:
   28     CONTINUE
          CALL TBEWRI (ITBL, NSLOT, KNDETU, NUMNAME,  ISTAT)
          IF (ISTAT.NE.0) THEN
               CALL TERROR(ITBL,29,'Could not write to NDETUSED Column')
          ENDIF
      END IF
   29 CONTINUE
C
C     ------
      ELSE IF (NFCDFS.EQ.0) THEN
C     ------
C               No filter codes in data.
C
C     Just make NBAND, BAND, and NDETUSED columns.
C
        NSLOTS=NDETS
C
   30 CONTINUE
      DO 32 NSLOT=1,NSLOTS
        IF (NSLOT.LE.9)THEN
            WRITE (C80,'(A41,I1,''?'')')
     1        '    What is the passband NAME in channel ',NSLOT
        ELSE
            WRITE (C80,'(A41,I2,''?'')')
     1        '    What is the passband NAME in channel ',NSLOT
        ENDIF
        CALL ASKFIL (C80, BAND)
        IF (HELP(BAND)) THEN
            CALL BNDHLP
            GO TO 30
        ENDIF
        CALL TBEWRI(ITBL, NSLOT, KNBAND, NSLOT,  ISTAT)
        IF (ISTAT.NE.0) THEN
                CALL TERROR(ITBL,31,'Could not write to NBAND Column')
        ENDIF
        CALL TBEWRC(ITBL, NSLOT, KBAND, BAND,  ISTAT)
        IF (ISTAT.NE.0) THEN
                CALL TERROR(ITBL,32,'Could not write to BAND Column')
        ENDIF
        CALL TBEWRI (ITBL, NSLOT, KNDETU, NUMNAME,  ISTAT)
        IF (ISTAT.NE.0) THEN
            CALL TERROR(ITBL,33,'Could not write to NDETUSED Column')
        ENDIF
   32 CONTINUE
C
C      Check table:
C
      CALL READT(ITBL)
C
C
C     ------
      ELSE
C     ------
C
          CALL TV('No negative value makes sense!')
          GO TO 10
C
C     ------
      END IF
C     ------
C
C     If we get here, table is OK.  Add descriptors.
C
      CALL STDWRC (ITBL,'INSTNAM',1,INSTNAM, 1, 72, IUNIT,  ISTAT)
      IF (ISTAT.NE.0) THEN
          CALL TERROR(ITBL,34,'Could not write descriptor INSTNAM')
      END IF
      CALL STDWRC (ITBL,'FILTSTAT',1,'         ', 1, 9, IUNIT,  ISTAT)
      IF (ISTAT.NE.0) THEN
          CALL TERROR(ITBL,35,'Could not write descriptor FILTSTAT')
      END IF
      CALL STDWRC (ITBL,'CONDITION',1,'       ', 1, 7, IUNIT, ISTAT)
      IF (ISTAT.NE.0) THEN
          CALL TERROR(ITBL,36,'Could not write descriptor CONDITION')
      END IF
C
C     make required detector columns.
C
      CALL TBCINI(ITBL,D_I1_FORMAT,1,'I5',' ','NDET',KNDET,ISTAT)
      IF (ISTAT.NE.0) THEN
            CALL TERROR(ITBL,38,'Could not create NDET column')
      ENDIF
      CALL TBCINI (ITBL, D_C_FORMAT, 8, 'A8', ' ', 'DET',KDET,  ISTAT)
      IF (ISTAT.NE.0) THEN
            CALL TERROR(ITBL,39,'Could not create DET column')
      ENDIF
      CALL TBCINI (ITBL, D_C_FORMAT, 12, 'A12', ' ', 'COOLING',
     1                 KCOOL, ISTAT)
      IF (ISTAT.NE.0) THEN
            CALL TERROR(ITBL,40,'Could not create COOLING column')
      ENDIF
C
   40 CONTINUE
      CALL SPACE2
      CALL ASK('Do you have a catalog of filter curves?',REPLY)
      IF(REPLY(:1) .EQ. 'Y')THEN
        CALL ASKFIL('What is the name of the catalog?',FILTCAT)
        CALL STDWRC (ITBL, 'FILTCAT',1,FILTCAT, 1, 80, IUNIT,  ISTAT)
        IF (ISTAT.NE.0) THEN
            CALL TERROR(ITBL,40,'Could not write descriptor FILTCAT')
        END IF
      ELSEIF(REPLY(:1) .EQ. 'N') THEN
        CALL STDWRC (ITBL, 'FILTCAT',1,' ', 1, 80, IUNIT,  ISTAT)
        IF (ISTAT.NE.0) THEN
            CALL TERROR(ITBL,41,'Could not write descriptor FILTCAT')
        END IF
      ELSE
        CALL TV('Please answer yes or no.')
        GOTO 40
      ENDIF
C
      CALL SPACE2
   42 CONTINUE
      CALL ASK('Is the filter temperature CONTROLLED?',REPLY)
      IF (REPLY(:1) .EQ. 'Y') THEN
        CALL STDWRC (ITBL,'FILTSTAT',1,'REGULATED', 1, 9, IUNIT,  ISTAT)
        IF (ISTAT.NE.0) THEN
            CALL TERROR(ITBL,42,'Could not write descriptor FILTSTAT')
        END IF
   44   CALL ASK('At what value (please include K, C, or F): ?',REPLY)
   45   IF (INDEX(REPLY,'C').GT.0) THEN
            KOLS=INDEX(REPLY,'C')-1
            WRITE(FMT,'(''(BN,F'',I1,''.0)'')') KOLS
            READ(REPLY(:KOLS),FMT) TEMP
            TEMP=TEMP+273.15
            WRITE(C80,'(''   That''''s'',F6.1,'' K'')') TEMP
            CALL TV(C80)
        ELSE IF (INDEX(REPLY,'K').GT.0) THEN
            KOLS=INDEX(REPLY,'K')-1
            WRITE(FMT,'(''(BN,F'',I1,''.0)'')') KOLS
            READ(REPLY(:KOLS),FMT) TEMP
        ELSEIF (INDEX(REPLY,'F').GT.0) THEN
            KOLS=INDEX(REPLY,'F')-1
            WRITE(FMT,'(''(BN,F'',I1,''.0)'')') KOLS
            READ(REPLY(:KOLS),FMT) TEMP
            TEMP=(5./9.)*(TEMP+40.)+273.15-40.
            WRITE(C80,'(''   That''''s'',F6.1,'' K'')') TEMP
            CALL TV(C80)
        ELSE
            READ(REPLY,'(F8.0)', ERR=44) TEMP
            CALL ASK('Is that degrees Kelvin?',REPLY)
            IF (REPLY(:1).EQ.'Y') THEN
C               we are OK.
            ELSE IF (REPLY(:1).EQ.'C' .OR. REPLY(:1).EQ.'F')THEN
                FMT=REPLY(:1)
                WRITE(REPLY,'(F5.1,A1)') TEMP,FMT
                GO TO 45
            ELSE
                CALL TV('Please re-enter your response, specifying')
                CALL TVN('the temperature scale:')
                 GO TO 44
            END IF
        ENDIF
C       Temp. is now available, deg.K.
        CALL STDWRR (ITBL, 'FILTTEMP', TEMP, 1, 1, IUNIT,  ISTAT)
        IF (ISTAT.NE.0) THEN
            CALL TERROR(ITBL,47,'Could not write descriptor FILTTEMP')
        END IF
      ELSEIF (REPLY(:1) .EQ. 'N') THEN
        CALL TV('No filter temperature regulation.')
   48   CONTINUE
        CALL ASK('Is the filter temperature MEASURED?',REPLY)
        IF (REPLY(:1) .EQ. 'Y') THEN
            CALL STDWRC (ITBL,'FILTSTAT',1,'MEASURED', 1, 9, IUNIT,
     1                   ISTAT)
            IF (ISTAT.NE.0) THEN
                CALL TERROR(ITBL,48,'Could not write descriptor FILTSTAT
     1')
            END IF
        ELSEIF (REPLY(:1) .EQ. 'N') THEN
            CALL STDWRC (ITBL, 'FILTSTAT',1,'DOME', 1, 9, IUNIT,
     1                   ISTAT)
            IF (ISTAT.NE.0) THEN
            CALL TERROR(ITBL,49,'Could not write descriptor FILTSTAT')
            END IF
            CALL TV('No filter temperature measurements.')
            CALL TVN('Assume filters are at ambient temperature.')
        ELSE
            CALL TV('Please answer yes or no.')
            GOTO 48
        ENDIF
      ELSE
        CALL TV('Please answer yes or no.')
        GOTO 42
      ENDIF
C
C               *****  END Filters;  BEGIN Detectors  *****
C
      DO 78 NDET=1,NDETS
      CALL TBEWRI (ITBL, NDET, KNDET, NDET,  ISTAT)
      IF (ISTAT.NE.0) THEN
           CALL TERROR(ITBL,49,'Could not write to column NDET')
      END IF
      CALL SPACE2
   50 CONTINUE
C
C     Detector names:
C
C       variable DTNAM(n)      holds name of detector #n.
C       variable DETNAM(nband) holds name of detector for n-th band.
C
C       column DETNAME         holds name of det. for n-th band in row NSLOT.
C
      IF (NDETS.EQ.1) THEN
          CALL TV('What kind of DETECTOR is used?')
      ELSE
          WRITE(C80,'(''What kind of DETECTOR is used in channel'',
     +          I2,'' ('',A,'')?'')') 
     +          NDET, DTNAM(NDET)(:LWORD(DTNAM(NDET)))
          CALL TV(C80)
      END IF
C
      CALL TV('       Photomultiplier (PMT)')
      CALL TV('       Silicon diode or CCD')
      CALL TV('       Other')
      CALL ASK('?',REPLY)
C
C                               ******  BEGIN  If-block for DET  ******
C     ***
      IF (REPLY(:1) .EQ. 'P') THEN
C     ***
C                              *** DET = PMT ***
C
        CALL TBEWRC (ITBL, NDET, KDET, 'PMT',  ISTAT)
        IF (ISTAT.NE.0) THEN
            CALL TERROR(ITBL,27,'Could not write to DET column')
        ENDIF
C
   52   CONTINUE
C       see if columns exist; if not, create them.
        CALL TBLSER (ITBL, 'SNUMBER',  KSNUMB, ISTAT)
        IF (ISTAT.NE.0) THEN
            CALL TERROR(ITBL,52,'Could not find column SNUMBER')
        END IF
        IF (KSNUMB.EQ.-1) THEN
          CALL TBCINI (ITBL, D_C_FORMAT, 9, 'A9', ' ', 'SNUMBER',
     1                 KSNUMB, ISTAT)
          IF (ISTAT.NE.0) THEN
                CALL TERROR(ITBL,54,'Could not create SNUMBER column')
          ENDIF
        END IF
        CALL TBLSER (ITBL, 'MODE',  KMODE, ISTAT)
        IF (ISTAT.NE.0) THEN
            CALL TERROR(ITBL,52,'Could not find column SMODE')
        END IF
        IF (KMODE.EQ.-1) THEN
          CALL TBCINI (ITBL, D_C_FORMAT, 9, 'A9', ' ', 'MODE',
     1                 KMODE, ISTAT)
          IF (ISTAT.NE.0) THEN
                CALL TERROR(ITBL,55,'Could not create MODE column')
          ENDIF
        END IF
C
        CALL TV
     2     ('Please enter the S-type or cathode type, if known; e.g.:')
        CALL SPACE
        CALL  TV
     2     ('   Entry    (examples)')
        CALL TVN
     2     ('   -----    ----------')
        CALL  TV
     2     ('   S-4      (1P21)')
        CALL  TV
     2     ('   S-11     (EMI 9502; Cs-Sb end-on cathode on glass)')
        CALL  TV
     2     ('   S-13     (EMI 6256; Cs-Sb end-on cathode on quartz)')
        CALL  TV
     2     ('   BIALKALI (EMI 9789; use QBIALKALI if quartz window)')
        CALL  TV
     2     ('   S-20     (trialkali)')
        CALL  TV
     2     ('   GaAs     (RCA or Hammamatsu)')
        CALL SPACE
        CALL  ASK
     2     ('(please enter S-4, BIALKALI, GaAs, QGaAs, etc.)',SNUMBER)

C       Fix up common error:
        IF (SNUMBER(:1) .EQ. 'S' .AND. SNUMBER(2:2) .NE. '-') THEN
C           Insert missing hyphen.
            C80=SNUMBER(2:8)
            SNUMBER(3:)=C80
            SNUMBER(2:2)='-'
        ENDIF
C
C       write table column.
        CALL TBEWRC (ITBL, NDET, KSNUMB, SNUMBER,  ISTAT)
        IF (ISTAT.NE.0) THEN
            CALL TERROR(ITBL,58,'Could not write column SNUMBER')
        END IF
        C80='    response adopted: '//SNUMBER
        CALL TV(C80)
   60   CONTINUE
        CALL ASK('Is this correct?',REPLY)
C
        IF (REPLY(:1) .EQ. 'Y') THEN
        ELSEIF (REPLY(:1) .EQ. 'N') THEN
            GOTO 52
        ELSE
             GOTO 60
        ENDIF
C
   62   CONTINUE
        C80='What mode of operation is used for '//DTNAM(NDET)
        NFC=LWORD(C80)+1
        C80(NFC:)='?'
        CALL TV(C80)
        CALL TV('      Enter  for....')
        CALL TVN('      -----  -------')
        CALL TV('       DC    DC operation')
        CALL TV('       CI    Charge Integration')
        CALL TV('       PC    Pulse Counting')
        CALL SPACE
        CALL ASK('?',REPLY)
C
        IF (REPLY(:1) .EQ. 'P') THEN
C
C              Pulse-counting:
C
            MODE='PC'
C           use table column.
            CALL TBEWRC (ITBL, NDET, KMODE, MODE(:2),  ISTAT)
            IF (ISTAT.NE.0) THEN
                CALL TERROR(ITBL,63,'Could not write column MODE')
            END IF
C
            CALL TBLSER (ITBL, 'DEADTYPE',  KDEDTYP, ISTAT)
            IF (ISTAT.NE.0) THEN
                CALL TERROR(ITBL,52,'Could not find column DEADTYPE')
            END IF
            IF (KDEDTYP.EQ.-1) THEN
                CALL TBCINI (ITBL, D_C_FORMAT,12,'A12', ' ', 'DEADTYPE',
     1                 KDEDTYP, ISTAT)
                IF (ISTAT.NE.0) THEN
                  CALLTERROR(ITBL,64,'Could not create DEADTYPE column')
                ENDIF
            END IF
C
            CALL TBLSER (ITBL, 'DEADTIME',  KDEDTM, ISTAT)
            IF (ISTAT.NE.0) THEN
                CALL TERROR(ITBL,52,'Could not find column DEADTIME')
            END IF
            IF (KDEDTM.EQ.-1) THEN
                CALL TBCINI (ITBL, D_R4_FORMAT, 1,'E8.3',' ','DEADTIME',
     1                 KDEDTM, ISTAT)
                IF (ISTAT.NE.0) THEN
                  CALLTERROR(ITBL,64,'Could not create DEADTIME column')
                ENDIF
            END IF
C
            CALL TBLSER (ITBL, 'DEADTIMEERROR',  KDEDER, ISTAT)
            IF (ISTAT.NE.0) THEN
              CALL TERROR(ITBL,52,'Could not find column DEADTIMEERROR')
            END IF
            IF (KDEDER.EQ.-1) THEN
                CALL TBCINI(ITBL,D_R4_FORMAT,1,'E13.2',' ',
     1                                  'DEADTIMEERROR',
     2                 KDEDER, ISTAT)
                IF (ISTAT.NE.0) THEN
                    CALL TERROR(ITBL,64,
     1                        'Could not create DEADTTIMEERROR column')
                ENDIF
            END IF
C
   64       CONTINUE
            C80='Do you know the type of dead time for '//DTNAM(NDET)
            NFC=LWORD(C80)+1
            C80(NFC:)='?'
            CALL TV(C80)
            CALL TV('      Enter    if...')
            CALL TVN('      -----    -----')
            CALL TV('    EXTENDING  paralysable counter')
            CALL TV('  NONEXTENDING non-paralysable counter')
            CALL TV('     UNKNOWN   you don''t know which it is')
            CALL ASK('?',REPLY)
C
            IF (REPLY(:1) .EQ. 'E' .OR. REPLY(:1) .EQ. 'X') THEN
                DEDTYP='EXTENDING'
            ELSEIF (REPLY(:1) .EQ. 'N') THEN
                DEDTYP='NONEXTENDING'
            ELSEIF (REPLY(:1) .EQ. 'U') THEN
                DEDTYP='UNKNOWN'
            ELSE IF (HELP(REPLY)) THEN
                CALL TV('See R.D.Evans''s book "The Atomic Nucleus"')
                CALL TVN('for a good explanation.')
                GO TO 64
            ELSE
                CALL TV(
     1              'Please enter EXTENDING, NONEXTENDING, or UNKNOWN.')
                GOTO 64
            ENDIF
C
            CALL TBEWRC (ITBL, NDET, KDEDTYP, DEDTYP, ISTAT)
            IF (ISTAT.NE.0) THEN
                CALL TERROR(ITBL,65,'Could not write column DEADTYPE')
            END IF
C
            IF (MATCH(SNUMBER,'GAAS')) THEN
                RATEMX=0.4
            ELSE
                RATEMX=2.
            END IF
C           Max. counting rate in MHz.
            CALL SETDED(RATEMX, DEDTIM,DEDERR)
C
            CALL TBEWRR (ITBL, NDET, KDEDTM, DEDTIM, ISTAT)
            IF (ISTAT.NE.0) THEN
                CALL TERROR(ITBL,66,'Could not write column DEADTIME')
            END IF
C
            CALL TBEWRR (ITBL, NDET, KDEDER, DEDERR, ISTAT)
            IF (ISTAT.NE.0) THEN
                CALL TERROR(ITBL,66,
     1                           'Could not write column DEADTIMEERROR')
            END IF
C
        ELSEIF (REPLY(:1) .EQ.'D') THEN
C
C           DC mode:
            MODE='DC'
C
        ELSEIF (REPLY(:1) .EQ.'C') THEN
C
C           Charge-integration:
            MODE='CI'
C
        ELSE
C
            CALL TV('Please enter DC, PC, or CI.')
            GOTO 62
C
        ENDIF
C
        IF(MODE.NE.'PC') THEN
             CALL TBEWRC (ITBL, NDET, KMODE, MODE,  ISTAT)
             IF (ISTAT.NE.0) THEN
                 CALL TERROR(ITBL,67,'Could not write column MODE')
             END IF
        ENDIF
C
C
C     ***
      ELSEIF (REPLY(:1) .EQ. 'S' .OR. REPLY(:1) .EQ. 'C') THEN
C     ***
C                       *** DET = SILICON ***
C
        CALL TBEWRC (ITBL, NDET, KDET, 'SILICON',  ISTAT)
        IF (ISTAT.NE.0) THEN
            CALL TERROR(ITBL,68,'Could not write to DET column')
        ENDIF
        CCD=.TRUE.
        GO TO 69
C
C     ***
      ELSEIF (REPLY(:1) .EQ. 'O') THEN
C     ***
C                       *** DET = OTHER ***
C
        CALL TBEWRC (ITBL, NDET, KDET, 'OTHER',  ISTAT)
        IF (ISTAT.NE.0) THEN
            CALL TERROR(ITBL,68,'Could not write to DET column')
        ENDIF
        CCD=.FALSE.
        GO TO 69
C
C     ***
      ELSE
C     ***
        CALL TV('Please reply either PMT, Si or CCD, or OTHER')
        GOTO 50
C
C     ***
      ENDIF
C     ***                       ******  END  If-block for DET  ******
      GO TO 72
C
C               ----  BEGIN Special block for non-PMT detectors  ---
   69 CONTINUE
      CALL ASKFIL('Do you have a spectral-response table?',SPRTBL)
C
      IF (MATCH(SPRTBL,'YES') .OR. MATCH(SPRTBL,'yes')) THEN
         CALL ASKFIL('WHAT IS THE NAME OF THE SPECTRAL-RESPONSE TABLE?',
     1              SPRTBL)
         CALL TBLSER (ITBL, 'SPECTRESPTBL',  KSPRTBL, ISTAT)
         IF (ISTAT.NE.0) THEN
               CALL TERROR(ITBL,52,'Could not find column SPECTRESPTBL')
         END IF
         IF (KSPRTBL.EQ.-1) THEN
             CALL TBCINI (ITBL, D_C_FORMAT,12,'A12', ' ','SPECTRESPTBL',
     1                 KSPRTBL, ISTAT)
             IF (ISTAT.NE.0) THEN
                  CALLTERROR(ITBL,71,
     1                          'Could not create SPECTRESPTBL column')
             ENDIF
         END IF
         CALL TBEWRC (ITBL, NDET, KSPRTBL, SPRTBL,  ISTAT)
         IF (ISTAT.NE.0) THEN
             CALL TERROR(ITBL,71,
     1                'Could not write column SPECTRESPTBL')
         END IF
C
      ELSE IF (MATCH(SPRTBL,'NO') .OR. MATCH(SPRTBL,'no')) THEN
   71   IF (CCD) THEN
            CALL TV('Then, indicate the approximate spectral response:')
            CALL TV('     Enter    if...')
            CALL TVN('     -----    -----')
            CALL TV('    ENHANCED  blue-enhanced CCD or Si diode')
            CALL TV('    PHOSPHOR  phosphor-coated CCD')
            CALL TV('      FRONT   front-side illuminated CCD or diode')
            CALL TV('      BACK    back-side illuminated thinned CCD')
            CALL ASK('?',REPLY)
C
            IF (REPLY(:1).EQ.'E') THEN
C               blue-enhanced.
                REPLY='ENHANCED'
            ELSE IF (REPLY(:1).EQ.'P') THEN
C               Phosphor-coated.
                REPLY='PHOSPHOR'
            ELSE IF (REPLY(:1).EQ.'F') THEN
C               Front (normal) Si detector.
                REPLY='FRONT'
            ELSE IF (REPLY(:1).EQ.'B') THEN
C               Back-side, thinned CCD.
                REPLY='BACK'
            ELSE
                CALL TV('Please enter 1 of the 4 words in caps.')
                GO TO 71
            END IF
C
            CALL TBLSER (ITBL, 'BLUERESP',  KBLURSP, ISTAT)
            IF (ISTAT.NE.0) THEN
                  CALL TERROR(ITBL,72,'Could not find column BLUERESP')
            END IF
            IF (KBLURSP.EQ.-1) THEN
                CALL TBCINI (ITBL, D_C_FORMAT,12,'A12', ' ', 'BLUERESP',
     1                 KBLURSP, ISTAT)
                IF (ISTAT.NE.0) THEN
                  CALLTERROR(ITBL,72,'Could not create BLUERESP column')
                ENDIF
            END IF
                CALL TBEWRC (ITBL, NDET, KBLURSP, REPLY,  ISTAT)
                IF (ISTAT.NE.0) THEN
                    CALL TERROR(ITBL,72,
     1                   'Could not write column BLUERESP')
                END IF
C
        END IF
C
      ELSE
C        assume entry is table name:
         CALL TBLSER (ITBL, 'SPECTRESPTBL',  KSPRTBL, ISTAT)
         IF (ISTAT.NE.0) THEN
               CALL TERROR(ITBL,72,'Could not find column SPECTRESPTBL')
         END IF
         IF (KSPRTBL.EQ.-1) THEN
             CALL TBCINI (ITBL, D_C_FORMAT,12,'A12', ' ','SPECTRESPTBL',
     1                 KSPRTBL, ISTAT)
             IF (ISTAT.NE.0) THEN
                  CALLTERROR(ITBL,72,
     1                          'Could not create SPECTRESPTBL column')
             ENDIF
         END IF
         CALL TBEWRC (ITBL, NDET, KSPRTBL, SPRTBL,  ISTAT)
         IF (ISTAT.NE.0) THEN
             CALL TERROR(ITBL,72,
     1                'Could not write column SPECTRESPTBL')
         END IF
C
      END IF
C
C               ----  END Special block for non-PMT detectors  ---
C
C
   72 CONTINUE
      C80='  We next need information on '//DTNAM(NDET)
      NFC=LWORD(C80)+1
      C80(NFC:)=' COOLING:'
      CALL TV(C80)
      CALL SPACE
      CALL TV('       Enter    if...')
      CALL TV('       -----    -----')
      CALL TV('     REGULATED  actively controlled')
      CALL TV('    UNREGULATED cooled, but not controlled')
      CALL TV(
     1'      DRYICE    cooled with solid CO2, no heat-transfer fluid')
      CALL TV('        ICE     cooled with water ice')
      CALLTV('     MEASURED   temperature measured, but not controlled')
      CALL TV(
     1'       NONE     ambient temperature, detector not measured')
      CALL SPACE
      CALL ASK('(Please see the Appendix for details):',REPLY)
C
      CALL TBLSER (ITBL, 'COOLING',  KCOOL, ISTAT)
      IF (ISTAT.NE.0) THEN
               CALL TERROR(ITBL,72,'Could not find column COOLING')
      END IF
C
      IF (REPLY(:1) .EQ. 'R') THEN
        COOLING='REGULATED'
   74   CALL ASK('At what value (please include K, C, or F): ?',REPLY)
   75   IF (INDEX(REPLY,'C').GT.0) THEN
            KOLS=INDEX(REPLY,'C')-1
            WRITE(FMT,'(''(BN,F'',I1,''.0)'')') KOLS
            READ(REPLY(:KOLS),FMT) TEMP
            TEMP=TEMP+273.15
            WRITE(C80,'(''   That''''s'',F6.1,'' K'')') TEMP
            CALL TV(C80)
        ELSE IF (INDEX(REPLY,'K').GT.0) THEN
            KOLS=INDEX(REPLY,'K')-1
            WRITE(FMT,'(''(BN,F'',I1,''.0)'')') KOLS
            READ(REPLY(:KOLS),FMT) TEMP
        ELSEIF (INDEX(REPLY,'F').GT.0) THEN
            KOLS=INDEX(REPLY,'F')-1
            WRITE(FMT,'(''(BN,F'',I1,''.0)'')') KOLS
            READ(REPLY(:KOLS),FMT) TEMP
            TEMP=(5./9.)*(TEMP+40.)+273.15-40.
            WRITE(C80,'(''   That''''s'',F6.1,'' K'')') TEMP
            CALL TV(C80)
        ELSE
            READ(REPLY,'(F8.0)', ERR=74) TEMP
            CALL ASK('Is that degrees Kelvin?',REPLY)
            IF (MATCH(REPLY,'YES')) THEN
C               we are OK.
            ELSE IF (REPLY(:1).EQ.'C' .OR. REPLY(:1).EQ.'F')THEN
                FMT=REPLY(:1)
                WRITE(REPLY,'(F5.1,A1)') TEMP,FMT
                GO TO 75
            ELSE
                CALL TV('Please re-enter your response, specifying')
                CALL TVN('the temperature scale:')
                GO TO 74
            END IF
        ENDIF
C       Temp. is now available, deg.K.
        CALL TBLSER (ITBL, 'DETTEMP',  KDTEMP, ISTAT)
        IF (ISTAT.NE.0) THEN
               CALL TERROR(ITBL,76,'Could not find column DETTEMP')
        END IF
        IF (KDTEMP.EQ.-1) THEN
             CALL TBCINI (ITBL, D_R4_FORMAT,1,'F7.1', ' ', 'DETTEMP',
     1                 KDTEMP, ISTAT)
             IF (ISTAT.NE.0) THEN
                  CALLTERROR(ITBL,76,
     1                          'Could not create DETTEMP column')
             ENDIF
        END IF
        CALL TBEWRR (ITBL, NDET, KDTEMP, TEMP, ISTAT)
        IF (ISTAT.NE.0) THEN
            CALL TERROR(ITBL,76,'Could not write column DETTEMP')
        END IF
      ELSEIF (REPLY(:1) .EQ. 'U') THEN
         COOLING='UNREGULATED'
      ELSEIF (REPLY(:1) .EQ. 'D') THEN
         COOLING='DRYICE'
      ELSEIF (REPLY(:1) .EQ. 'I') THEN
         COOLING='ICE'
      ELSEIF (REPLY(:1) .EQ. 'M') THEN
         COOLING='MEASURED'
      ELSEIF (REPLY(:1) .EQ. 'N') THEN
         COOLING='NONE'
      ELSE
        CALL TV('Please select one of the entries above.')
        GOTO 72
      ENDIF
C
      CALL TBEWRC (ITBL, NDET, KCOOL, COOLING,  ISTAT)
      IF (ISTAT.NE.0) THEN
             CALL TERROR(ITBL,77,
     1                'Could not write column COOLING')
      END IF
C
   78 CONTINUE
C
C               *****  END Detectors; BEGIN Redleaks  *****
C
C
      CALL SPACE2
      CALL TV('          Now for RED LEAK information...')
      CALL TBCINI (ITBL, D_C_FORMAT, 8, 'A8', ' ', 'REDLEAK',
     1               KRL, ISTAT)
        IF (ISTAT.NE.0) THEN
                CALL TERROR(ITBL,79,'Could not create REDLEAK Column')
        ENDIF
      CALL TBCINI (ITBL, D_C_FORMAT, 8, 'A8', ' ', 'RLTYPE',
     1               KRLTYP, ISTAT)
        IF (ISTAT.NE.0) THEN
                CALL TERROR(ITBL,79,'Could not create RLTYPE Column')
        ENDIF
      CALL TBCINI (ITBL, D_C_FORMAT, 8, 'A8', ' ', 'MAKER',
     1               KMAKER, ISTAT)
        IF (ISTAT.NE.0) THEN
                CALL TERROR(ITBL,79,'Could not create MAKER Column')
        ENDIF
      DO 90 NSLOT = 1, NSLOTS
        CALL SPACE
        CALL TBERDC(ITBL, NSLOT, KBAND, BAND, NULL, ISTAT)
        IF (ISTAT.NE.0) THEN
             CALL TERROR(ITBL,80,'Could not read BAND Column')
        ENDIF
C
        IF ( (INDEX(BAND,'RL').EQ.(LWORD(BAND)-1) .AND.
     1                                            INDEX(BAND,'RL').GT.0)
     2            .OR. BAND(:4).EQ.'DARK')THEN
            C80='   skipping band '//BAND(:LWORD(BAND))//'...'
            CALL TV(C80)
            RLSIZE=0.
        ELSE
            C80='   looking at band '//BAND(:LWORD(BAND))//'...'
            CALL TV(C80)
C          There should be some stuff here to decide whether the leak is
C          big enough to worry about.....
C          For now, force treatment for every band:
            RLSIZE = 0.01
        END IF
C
        IF (RLSIZE .GT. 0.0001) THEN
            C80='How do you treat the red leak in '//BAND(:LWORD(BAND))
     1                   //'?'
            CALL TV(C80)
   80       CONTINUE
            CALL ASK('(Enter MEASURED, BLOCKED, or IGNORED):',REPLY)
            IF (REPLY(:1) .EQ. 'M') THEN
                CALL TBEWRC(ITBL, NSLOT, KRL, 'MEASURED',  ISTAT)
                IF (ISTAT.NE.0) THEN
                 CALLTERROR(ITBL,82,'Could not write to REDLEAK Column')
                ENDIF
   82           CONTINUE
                CALL SPACE2
                CALL TV('How is the leak filter constructed?')
                CALL TV('       Enter   if...')
                CALL TVN('       -----   -----')
              CALLTV('      CEMENTED  components are cemented together')
                CALL TV('       LOOSE    components are not cemented')
                CALL TV('      UNKNOWN   you don''t know which')
                CALL ASK('?',REPLY)
C
                IF (REPLY(:1) .EQ. 'C') THEN
                    CALL TBEWRC(ITBL, NSLOT, KRLTYP, 'CEMENTED', ISTAT)
                ELSEIF (REPLY(:1) .EQ. 'L') THEN
                    CALL TBEWRC(ITBL, NSLOT, KRLTYP, 'LOOSE',  ISTAT)
                ELSEIF (REPLY(:1) .EQ. 'U') THEN
                    CALL TBEWRC(ITBL, NSLOT, KRLTYP, 'UNKNOWN',  ISTAT)
                ELSE
                    CALL TV('Please enter one of the 3 words above.')
                    GOTO 82
                ENDIF
C
                IF (ISTAT.NE.0) THEN
                 CALL TERROR(ITBL,83,'Could not write to RLTYPE Column')
                ENDIF
C
   83       C80='What glass type is used in the '//BAND(:LWORD(BAND))//
     1      ' red-leak isolator?'
            CALL TV(C80)
                CALL TV('      Enter     if...')
                CALL TVN('      -----     -----')
                CALL TV(
     1            '     SCHOTT     Schott or other glass clear at leak')
                CALL TV(
     1           '     CORNING    Corning or other Pyrex-like absorber')
                CALL TV(
     1            '     UNKNOWN    you don''t know whose glass is used')
                CALL ASK('?',REPLY)
C
                IF (REPLY(:1) .EQ. 'S') THEN
                    CALL TBEWRC(ITBL, NSLOT, KMAKER, 'SCHOTT',  ISTAT)
                ELSEIF (REPLY(:1) .EQ. 'C') THEN
                    CALL TBEWRC(ITBL, NSLOT, KMAKER, 'CORNING',  ISTAT)
                ELSEIF (REPLY(:1) .EQ. 'U') THEN
                    CALL TBEWRC(ITBL, NSLOT, KMAKER, 'UNKNOWN',  ISTAT)
                ELSEIF (HELP(REPLY)) THEN
                    CALL TV('Pyrex absorbs at 700 nm.')
                    GO TO 83
                ELSE
                    CALL TV('Please enter one of the 3 words above.')
                    GOTO 83
                ENDIF
C
            ELSEIF (REPLY(:1) .EQ. 'B') THEN
                CALL TBEWRC(ITBL, NSLOT, KRL, 'BLOCKED',  ISTAT)
                IF (ISTAT.NE.0) THEN
                 CALLTERROR(ITBL,84,'Could not write to REDLEAK Column')
                ENDIF
            ELSEIF (REPLY(:1) .EQ. 'I') THEN
                CALL TBEWRC(ITBL, NSLOT, KRL, 'IGNORED',  ISTAT)
                IF (ISTAT.NE.0) THEN
                 CALLTERROR(ITBL,85,'Could not write to REDLEAK Column')
                ENDIF
C       $$$$$ This is temporary fudge until 'RLsize' is set properly:
            ELSEIF (REPLY(:1) .EQ. 'N'  .OR. REPLY(:1) .EQ. 'A') THEN
                CALL TBEWRC(ITBL, NSLOT, KRL, 'ABSENT',  ISTAT)
                IF (ISTAT.NE.0) THEN
                 CALLTERROR(ITBL,86,'Could not write to REDLEAK Column')
                ENDIF
            ELSE IF (HELP(REPLY)) THEN
                CALL TV('We really should read the spectral-response')
                CALL TVN('data to judge whether a leak is significant.')
                CALL TVN('Until this lapse is corrected, you can reply')
                CALL TVN('ABSENT to indicate no significant leak.')
                GOTO 80
C       $$$$$ End temporary fudge.
            ELSE
                CALL TV('Please enter MEASURED, BLOCKED, or IGNORED.')
                GOTO 80
            ENDIF
        ELSE
C               Redleak does not apply (here if RLSIZE is small.).
                CALL TBEWRC(ITBL, NSLOT, KRL, 'ABSENT',  ISTAT)
                IF (ISTAT.NE.0) THEN
                 CALLTERROR(ITBL,87,'Could not write to REDLEAK Column')
                ENDIF
        ENDIF
   90 CONTINUE
C
C     Now ask about condition of optics:
C
   92 CONTINUE
      CALL SPACE2
      CALL TV('How dirty are the telescope optics?')
      CALL TV('     Enter   if...')
      CALL TVN('     -----   -----')
      CALL TV('     CLEAN   freshly aluminized or washed within 2 weeks'
     1)
      CALL TV('    AVERAGE  flashlight beam is plainly visible on optics
     1')
      CALL TVN('             (but they don''t look terribly bad)')
      CALL TV('     DIRTY   surfaces look horrible')
      CALL ASK('?',REPLY)
C
      IF (REPLY(:1).EQ.'C') THEN
C       Clean.
        CALL STDWRC (ITBL, 'CONDITION',1,'CLEAN', 1,7, IUNIT,  ISTAT)
      ELSE IF (REPLY(:1).EQ.'A') THEN
C        Average.
        CALL STDWRC (ITBL, 'CONDITION',1,'AVERAGE', 1,7, IUNIT,  ISTAT)
      ELSE IF (REPLY(:1).EQ.'D') THEN
C       Dirty.
        CALL STDWRC (ITBL, 'CONDITION',1,'DIRTY', 1,7, IUNIT,  ISTAT)
      ELSE IF (HELP(REPLY)) THEN
        CALL TV('Say AVERAGE for now, and check on this later.')
        GO TO 92
      ELSE
        CALL TV('Please reply CLEAN, AVERAGE, or DIRTY.')
        GO TO 92
      END IF
      IF (ISTAT.NE.0) THEN
          CALL TERROR(ITBL,92,'Could not write descriptor CONDITION')
      END IF
      CALL TV('Thanks for describing your instrument.  Please check')
      CALL TVN('the table entries for the filters:')
C
C     Check the table:
C
      CALL TV('Final table contents:')
C     READ/TABLE {instrtbl}
      CALL READT(ITBL)
C
   95 CONTINUE
      CALL ASK('Are these values OK?',REPLY)
      IF (MATCH(REPLY,'NO')) THEN
        CALL TBTCLO(ITBL,ISTAT)
        CALL TV('Please re-make the whole table:')
        CALL SPACE2
        GO TO 10
      ELSE IF (MATCH(REPLY,'YES') .OR. MATCH(REPLY,'OK')) THEN
        CALL TBTCLO(ITBL,ISTAT)
        CALL STSEPI
      ELSE IF (HELP(REPLY)) THEN
        CALL TV('One or two numerical errors can be fixed by using the')
        CALLTVN('EDIT/TABLE command.  Say NO if there are many errors.')
      ELSE
        CALL TV('Please reply YES or NO.')
        GO TO 95
      END IF
C
C       *****
        ELSE
C       *****
C
        CALL TV('Please answer yes or no.')
        GOTO 1
C
C       *****
        ENDIF
C       *****
C
        CALL STSEPI
        END
        SUBROUTINE READT(ITBL)
C
C       Reads MIDAS table file & displays in "READ/TABLE" style.
C       Assumes file is already open.
C               CAUTION: only works with std. FORTRAN fmt specs.!
C
C
      IMPLICIT NONE
C
      INTEGER ITBL, NCOL, NCOLS, NROW, NROWS, NSORTC, NWPRAL, NROWSAL,
     1        ISTAT, NCLBGN, NCLEND, LAST, LFIELD
C
      INTEGER MXCOLS
        PARAMETER (MXCOLS=36)
        CHARACTER*24 COLN(MXCOLS)
        CHARACTER*36 CDATA(MXCOLS)
        CHARACTER*80 C80,HEADER1,HEADER2
        CHARACTER*8 COLFMT(MXCOLS),FMT
C
        INTEGER IDATA(MXCOLS), ITYPE(MXCOLS), NBGN(MXCOLS), NEND(MXCOLS)
        REAL RDATA(MXCOLS)
        DOUBLE PRECISION DDATA(MXCOLS)
C
        LOGICAL NULL
C
      INTEGER LWORD
      EXTERNAL LWORD
C
        INCLUDE 'MID_INCLUDE:ST_DEF.INC'
        INCLUDE 'MID_INCLUDE:ST_DAT.INC'
C
C
      CALL TBIGET (ITBL,  NCOLS, NROWS, NSORTC, NWPRAL, NROWSAL, ISTAT)
      NCOL=1
C
    1 CONTINUE
      NCLBGN=NCOL
      LAST=10
      HEADER1='Sequence'
      HEADER2='--------'
C       Get column name:
    2   CALL TBLGET (ITBL, NCOL,  COLN(NCOL), ISTAT)
C       Get column format & type:
        CALL TBFGET (ITBL, NCOL,  FMT,LFIELD,ITYPE(NCOL),ISTAT)
        COLFMT(NCOL)='('//FMT(:LWORD(FMT))//')'
C       data for column NCOL begin in NBGN(ncol) and end in NEND(ncol).
        NBGN(NCOL)=LAST
        NEND(NCOL)=LAST+LFIELD-1
C     ***
      IF (NEND(NCOL).LT.80) THEN
C     ***
        HEADER1(NBGN(NCOL):NEND(NCOL))=COLN(NCOL)
        HEADER2(NBGN(NCOL):NEND(NCOL))='---------------------------'
        LAST=LAST+LFIELD+1
        NCOL=NCOL+1
        IF (NCOL.GT.NCOLS) GO TO 10
        GO TO 2
C     ***
      END IF
C     ***
   10 NCLEND=NCOL-1
      IF (NROWS.LT.50) CALL NEED(NROWS+3)
      CALL TV(HEADER1)
      CALL TVN(HEADER2)
      C80=' '
      DO 19 NROW=1,NROWS
        WRITE(C80(:8),'(I8)') NROW
        DO 18 NCOL=NCLBGN,NCLEND
        IF (ITYPE(NCOL).EQ.D_C_FORMAT) THEN
            CALL TBERDC(ITBL, NROW, NCOL, CDATA(NCOL), NULL, ISTAT)
            C80(NBGN(NCOL):NEND(NCOL))=CDATA(NCOL)
        ELSE IF (ITYPE(NCOL).EQ.D_R4_FORMAT) THEN
            CALL TBERDR(ITBL, NROW, NCOL, RDATA(NCOL), NULL, ISTAT)
            IF(NULL) THEN
               WRITE(C80(NBGN(NCOL):NEND(NCOL)),'(A)')' '
            ELSE
               WRITE(C80(NBGN(NCOL):NEND(NCOL)),COLFMT(NCOL))RDATA(NCOL)
            END IF
        ELSE IF (ITYPE(NCOL).EQ.D_I2_FORMAT) THEN
            CALL TBERDI(ITBL, NROW, NCOL, IDATA(NCOL), NULL, ISTAT)
            WRITE(C80(NBGN(NCOL):NEND(NCOL)),COLFMT(NCOL)) IDATA(NCOL)
        ELSE IF (ITYPE(NCOL).EQ.D_I4_FORMAT) THEN
            CALL TBERDI(ITBL, NROW, NCOL, IDATA(NCOL), NULL, ISTAT)
            WRITE(C80(NBGN(NCOL):NEND(NCOL)),COLFMT(NCOL)) IDATA(NCOL)
        ELSE IF (ITYPE(NCOL).EQ.D_I1_FORMAT) THEN
            CALL TBERDI(ITBL, NROW, NCOL, IDATA(NCOL), NULL, ISTAT)
            WRITE(C80(NBGN(NCOL):NEND(NCOL)),COLFMT(NCOL)) IDATA(NCOL)
        ELSE IF (ITYPE(NCOL).EQ.D_R8_FORMAT) THEN
            CALL TBERDD(ITBL, NROW, NCOL, DDATA(NCOL), NULL, ISTAT)
            IF(NULL) THEN
               WRITE(C80(NBGN(NCOL):NEND(NCOL)),'(A)')' '
            ELSE
               WRITE(C80(NBGN(NCOL):NEND(NCOL)),COLFMT(NCOL))DDATA(NCOL)
            END IF
        ELSE
            CALL TV('unknown data format for col.')
            WRITE (C80,*) ITYPE(NCOL)
            CALL TVN(C80)
            CALL STSEPI
        END IF
   18   CONTINUE
        CALL TVN(C80)
   19 CONTINUE
        CALL TVN(HEADER2)
      IF (NCLEND.EQ.NCOLS) RETURN
      NCOL=NCLEND+1
      GO TO 1
C
      END
      SUBROUTINE BNDHLP
C
      IMPLICIT NONE
C
      CALL SPACE
      CALL TV('Standard passband names are:')
      CALL SPACE
      CALL TV('     SYSTEM    Names:')
      CALL TVN('     ------    ------')
      CALL TV('     UBVRI     U, B, V, R, I')
      CALL TV('      uvby     u, v, b, y')
      CALL TV('     Hbeta     betaW, betaN')
      CALL TV('red leak in X  XRL')
      CALL TV('X + ND filter  XND')
      CALL TV('     dark      DARK')
      CALL SPACE
      RETURN
      END
      SUBROUTINE SETDED(RATEMX, DEADT,SDEDT)
C
C
      IMPLICIT NONE
C
      CHARACTER DMS*12, A, PAGE*79
      LOGICAL MATCH
      REAL RATEMX, DEADT, SDEDT
C
C
  205 CALL ASK('Do you know the Dead Time (ns)?',DMS)
       IF(MATCH(DMS,'NO'))THEN
      WRITE(PAGE,
     1'(''  Keep rate below'',F3.0,''MHz to avoid gain shift.'')')
     2  RATEMX
      CALL TV(PAGE)
      DEADT=16.
      SDEDT=DEADT
      GO TO 211
       END IF
      IF(MATCH(DMS,'YES')) CALL ASK('Dead time (nanoseconds) =',DMS)
  210 CALL FINDPM(DMS,DEADT,SDEDT)
      WRITE(PAGE,'('' Dead time ='',F6.1,'' +/-'',F6.1,'' ns'')')DEADT,
     1SDEDT
      CALL TV(PAGE)
      CALL ASK('OK?',A)
      IF(MATCH(A,'N'))GOTO 205
  211 SDEDT=SDEDT*1.E-9
      DEADT=DEADT*1.E-9
      IF(DEADT.EQ.0. .OR. SDEDT.EQ.0.)GOTO 210
C
      RETURN
      END