Initial revision

difrac/yesno.f

@@ -0,0 +1,47 @@
+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
+      ITR = IOUNIT(5)
+      ITP = IOUNIT(6)
+C-----------------------------------------------------------------------
+C  This code gets round IBM VM/CMS limitations
+C-----------------------------------------------------------------------
+  100 CALL GWRITE (ITP,'$')
+      CALL GETLIN (ANS)
+      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