714b8ae84d
- Fixed many things in DIFRAC subsystem:
* Recoded tcentr.f etc so that the course centering will work and will not
go into an endless loop.
* fixed boundary overwrites which occurred when yesno or alfnum where
uset to get a single character and several were given.
* Addeded documentation for DIFRAC
- Added tcl-files which support the WWW status system
49 lines
1.8 KiB
Fortran
49 lines
1.8 KiB
Fortran
C-----------------------------------------------------------------------
|
|
C Routine YESNO to get Yes/No (Y or N) answers to questions.
|
|
C It is called with two parameters :--
|
|
C 1. DEFOLT is set to 'Y', 'N' or '$' by the caller depending
|
|
C on the expected default;
|
|
C 2. ANSWER is the value of the returned answer.
|
|
C
|
|
C Responses are filtered so that only blank, null (i.e. CR ), Y, y,
|
|
C N or n are acceptable answers at the terminal.
|
|
C If DEFOLT is set to '$' the typed answer must be Y, y, N or n,
|
|
C no default is allowed.
|
|
C If the character typed is a question mark the routine exits to the
|
|
C system monitor.
|
|
C
|
|
C Version modified to support non-Fortran screen I/O
|
|
C-----------------------------------------------------------------------
|
|
SUBROUTINE YESNO (DEFOLT,ANS)
|
|
COMMON /IOUASS/ IOUNIT(12)
|
|
CHARACTER*132 COUT(20)
|
|
COMMON /IOUASC/ COUT
|
|
CHARACTER DEFOLT*1,ANS*1,LINE*80
|
|
ITR = IOUNIT(5)
|
|
ITP = IOUNIT(6)
|
|
C-----------------------------------------------------------------------
|
|
C This code gets round IBM VM/CMS limitations
|
|
C-----------------------------------------------------------------------
|
|
100 CALL GWRITE (ITP,'$')
|
|
CALL GETLIN (LINE)
|
|
ANS=LINE(1:1)
|
|
IF (ANS .EQ. '?') STOP
|
|
IF (ANS .EQ. 'y') ANS = 'Y'
|
|
IF (ANS .EQ. 'n') ANS = 'N'
|
|
IF ((DEFOLT .EQ. 'Y' .OR. DEFOLT .EQ. 'N') .AND. ANS .EQ. ' ')
|
|
$ ANS = DEFOLT
|
|
IF (ANS .EQ. 'Y' .OR. ANS .EQ. 'N') RETURN
|
|
IF (DEFOLT .EQ. '$') THEN
|
|
WRITE (COUT,11000)
|
|
GO TO 100
|
|
ELSE
|
|
WRITE (COUT,12000)
|
|
GO TO 100
|
|
ENDIF
|
|
10000 FORMAT (A)
|
|
11000 FORMAT (' The typed response must be Y, y, N or n. Try again',
|
|
$ ' please.')
|
|
12000 FORMAT (' The typed response must be Y, y, N, n or <CR>.',
|
|
$ ' Try again please.')
|
|
END
|