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