Initial revision

difrac/alfnum.f

@@ -0,0 +1,51 @@
+C-----------------------------------------------------------------------
+C              Get an alphanumeric input string.  
+C  In general all alphabetic characters are converted to upper-case, 
+C  but if STRING contains "DONT DO IT" on input no conversion is done.
+C  This is useful to allow the input of file names in case sensitive 
+C  operating systems like UNIX.
+C  All null characters are converted to blanks
+C  The code should be general for ASCII and EBCDIC.
+C  If the first character is a question mark (?) the routine exits to 
+C  the system monitor.
+C-----------------------------------------------------------------------
+      SUBROUTINE ALFNUM (STRING)
+      COMMON /IOUASS/ IOUNIT(12)
+      CHARACTER STRING*(*),NULL*1
+      NULL = CHAR(0)
+      ITR = IOUNIT(5)
+      ITP = IOUNIT(6)
+      IDONT = 0
+      IF (LEN(STRING) .GE. 10 .AND. STRING(1:10) .EQ. 'DONT DO IT') 
+     $    IDONT = 1
+C-----------------------------------------------------------------------
+C  Write the prompt - if any - and get the answer
+C-----------------------------------------------------------------------
+      CALL GWRITE (ITP,'$')
+      STRING = ' '
+      ILEN = LEN(STRING)
+      IF (ILEN .GT. 80) ILEN = 80
+      CALL GETLIN (STRING)
+      IF (STRING(1:1) .EQ. '?') STOP
+      ILEN = LEN(STRING)
+      DO 120 I = 1,ILEN
+        IF (STRING(I:I) .EQ. NULL) STRING(I:I) = ' '
+  120 CONTINUE
+      IF (IDONT .EQ. 0) THEN
+        LITTLA = ICHAR('a')
+        LARGEA = ICHAR('A')
+        LITTLZ = ICHAR('z')
+        IDIFF = LITTLA - LARGEA
+        ILEN = LEN(STRING)
+        DO 130 I = 1,ILEN
+          ITHIS = ICHAR(STRING(I:I))
+          IF (ITHIS .GE. LITTLA .AND. ITHIS .LE. LITTLZ) THEN
+            ITHIS = ITHIS - IDIFF
+            STRING(I:I) = CHAR(ITHIS)
+          ENDIF
+  130   CONTINUE
+      ENDIF
+      RETURN
+10000 FORMAT (A)
+      END
+