Subroutine to return the response to a prompt from the calling program
that can be answered by a single character.
It read the users answer, checks to see if it falls within known
limits, and returns the one character response indicating the results.
A list of acceptable responses are passed to the subroutine.
If a default response is acceptable, surround the respnse with [ ]
Any other response is unrecognized. Responses can be in either
capital or small letters.
"a" = argument, "r" = referenced, "s" = set
call yesno (with the following arguments)
Acceptable [variable char*(*) r]
Response [variable char*1 asr]
Acceptable = character string of allowed answers.
Response = a one character capital letter response.
changecase (shared DRS external routine)
stringlen (shared DRS external routine)
index (FORTRAN intrinsic function)
Any program calling this subroutine should be able to handle all of
the response flag values. However, this does not mean the program
must have a help facility. If it doesn't, it should consider the 'H'
response as invalid and loop back to query the question again. A
possible code segment to handle YESNO might look something like:
print *, '<some-question> (Y, [N
call yesno ('Y[N]H', Response)
Although this program has been used by the U.S. Geological Survey,
no warranty, expressed or implied, is made by the Survey as to the
accuracy and functioning of the program and related program
material nor shall the fact of distribution constitute any such
warranty, and no responsibility is assured by the Survey in
Clint Steele .for
Ed Maple 8/28/87
Modified to handle help and unrecognized responses. Also puts
the responsibility of reprompting of an unrecognized response
on the calling program. Also changed returned argument to a
Jean Riordan 1/18/88 Modified for DRS$SHARE cleanup and
Clint Steele 3/7/88 Added ability to pass default values.
Clint Steele 9/27/88 Changed * i/o to units 5 and 6
Clint Steele 9/30/88 Changed input from unit 5 to *
read (*, '(a1)') Response
write (6, '(4x,a1)') (CapitalAccept
* (LoopCount:LoopCount), LoopCount = 1, Length)
call changecase ('CAPITAL', CapitalAccept)
call stringlen (CapitalAccept, Length)
call changecase ('CAPITAL', Response)