C @(#)asker.for	17.1.1.1 (ES0-DMD) 01/25/02 17:17:16
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  @(#)asker.for	17.1.1.1  (ESO-IPG)  01/25/02  17:17:16
      SUBROUTINE ASK(QUERY,REPLY)
C
C       Copyright (C) Andrew T. Young, 1990
C       Copyright (C) European Southern Observatory, 1992
C
C                                               FEB.6,1987
C  ASKS THE QUERY ON THE TERMINAL SCREEN AND
C  ACCEPTS REPLY FROM KEYBOARD.
C
C  QUITS IF REPLY IS 'Q' OR 'QUIT'.
C
      IMPLICIT NONE
      INTEGER ISTAT, NACTEL, IUNIT, NULLS, LWORD, IDIFF, IA, I
C
      CHARACTER *(*) QUERY,REPLY, A*1
      CHARACTER*80 BUFIN, BUFOUT
C
C
      LOGICAL MATCH
      EXTERNAL MATCH
C
        BUFIN=QUERY
    1   CALL STTPUT(' ',ISTAT)
    2   CALL STKPRC (BUFIN, 'INPUTC', 1, 1, 80,
     1              NACTEL, BUFOUT, IUNIT, NULLS, ISTAT)
        REPLY=BUFOUT
        IF (ISTAT.NE.0) THEN
                CALL STTPUT ( 'REPLY was:', ISTAT)
                CALL STTPUT ( REPLY, ISTAT)
                CALL STTPUT ('Please try again:', ISTAT)
                GO TO 99
        END IF
        IF(LWORD(REPLY).EQ.0) GOTO 1
C       modified to convert replies to upper case:
        IDIFF=ICHAR('A') - ICHAR('a')
        IA=ICHAR('a')
        DO 10 I=1, LWORD(REPLY)
   10   IF (ICHAR(REPLY(I:I)).GE.IA) REPLY(I:I)=
     1          CHAR(ICHAR(REPLY(I:I)) + IDIFF)
       IF(MATCH(REPLY,'QUIT'))THEN
      CALL STKPRC ('DO YOU WANT TO QUIT?','INPUTC', 1, 1, 1,
     1              NACTEL, A, IUNIT, NULLS, ISTAT)
      IF(A.EQ.'Y'.OR.A.EQ.'Q'.OR.A.EQ.'y'.OR.A.EQ.'q') THEN
        CALL TV('ABANDONED.')
        CALL STETER (9000,
     1     'Program abandoned.  You can IGNORE the "error" message.')
      END IF
      GO TO 1
       END IF
      RETURN
C
   99 CALL NOEOF
      GO TO 1
C
      ENTRY ASKN(QUERY,REPLY)
C
C  SIMILAR, BUT DOESN'T SPACE BEFORE LINE.
C
      BUFIN=QUERY
      GO TO 2
C
      END
      SUBROUTINE TV(MESAGE)
C
C  SHOWS THE MESSAGE ON THE TERMINAL SCREEN.
C
      IMPLICIT NONE
      INTEGER ISTAT
C
      CHARACTER *(*) MESAGE
C
C
    1 CALL STTPUT(' ',ISTAT)
    2 CALL STTPUT(MESAGE,ISTAT)
      IF (ISTAT.NE.0) THEN
        CALL STTPUT('ERROR in writing to screen!',ISTAT)
         GO TO 1
      END IF
      RETURN
C
      ENTRY TVN(MESAGE)
      GO TO 2
C
      END
      SUBROUTINE QF(Q,F)
C
C  ASKS QUERY Q ON THE TERMINAL SCREEN AND        18 FEB.1987
C  ACCEPTS FLOATING-POINT VALUE F FROM KEYBOARD.
C
      IMPLICIT NONE
      REAL F
      INTEGER ISTAT, I1SAV, I2SAV, I3SAV, NACTEL, IUNIT, NULLS
C
      CHARACTER *(*) Q
        CHARACTER*80 BUFIN
C
C
        BUFIN=Q
    1   CALL STTPUT(' ',ISTAT)
        CALL STECNT ('GET', I1SAV, I2SAV, I3SAV)
        CALL STECNT ('PUT', 1, 0, 0)
        CALL STKPRR (BUFIN, 'INPUTR', 1, 1,
     1              NACTEL, F, IUNIT, NULLS, ISTAT)
        IF (ISTAT.NE.0 .OR. NACTEL.NE.1) THEN
                CALL STTPUT ('Failed to obtain REAL value', ISTAT)
                CALL STTPUT ('Please try again:',ISTAT)
                GO TO 99
        END IF
      CALL STECNT ('PUT', I1SAV, I2SAV, I3SAV)
      RETURN
C
   99 CALL NOEOF
      GO TO 1
C
      END
      SUBROUTINE NOEOF
C
C  CANCELS EOF FROM KEYBOARD AND RE-STARTS INPUT FILE.
C
C ***
C This version does nothing.
      RETURN
      END
      SUBROUTINE CENTER(STRING)
C
C  Centers the input string in output.
C
      IMPLICIT NONE
C
      CHARACTER *(*) STRING
      CHARACTER *79 CARD
C
      INTEGER LEN
C
      INTEGER LWORD
C
C
      LEN=(79-LWORD(STRING))/2
      CARD(:LEN)=' '
      CARD(LEN:)=STRING
      CALL TV(CARD)
C
      RETURN
      END