51 lines
1.8 KiB
Fortran
51 lines
1.8 KiB
Fortran
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
|