C******************** START FILE URDSPC.FOR ; GROUP UREAD5 ******************
C--------------------------------------------------------------------
C&  URDSPC-- PROCESS UREAD SPECIAL CHARACTERS
C
      SUBROUTINE URDSPC(ISELEC,IRET,IEOFL,IERC)
C
C  PREVIOUSLY PART OF UREAD SUBROUTINE
C
      USE USERIO
C
C  PARAMETER DEFN TEST
      CHARACTER*16 ZTNAM
      CHARACTER*96 ZTVAL
      character*1 zchar
C
C  TYPEAHEAD CLEAR FLAG
      IF(NLHOLD.OR.NLSKIP) THEN
        ICLEAR=1
      ELSE
        ICLEAR=0
      ENDIF
C  INITIALLY ASSUME SUCCESS ***
      IERC=0
C  BRANCH ACCORDING TO COMMAND/ SPECIAL CHARACTER TYPE
      GO TO (410,420,430,440,450,460,470) ISELEC
C-----------------------------------------------------------
C  ";" = COMMENT
 410  CONTINUE
C  COMMENT CARDS CAN COME ONLY ON INPUT CHANNEL
      IF(LCMDIN.EQ.2) THEN
        IF(NLINDO) THEN
          WRITE(LUNIDO,2001) CBUFF(1:NCHARC)
 2001 FORMAT(A)
        ELSE
          IF(NLECHO) WRITE(LUNTRM,2002) CBUFF(1:NCHARC)
 2002 FORMAT(1X,A)
        ENDIF
        ICLEAR=1
        GO TO 499
      ENDIF
C
C  NO TYPEAHEAD PAST A COMMENT
C
      ICLEAR=1
C
C  IS A COMMENT CARD; CHECK FOR MATCH WITH PROMPT
C   (INDIRECT FILES ONLY; THIS IS TO MAKE SURE THAT
C    INDIRECT FILE COMMAND SEQUENCE MESHES WITH CALLING
C    PROGRAM STRUCTURE)
C  IS A CHECK REQUIRED?
      IF(LREADY.EQ.1) GO TO 499
C  IF NLSKIP IS SET AND LOOKING FOR MARKER, DONT CHECK PROMPTS
      IF(NLSKIP.AND.(LMARKN.GT.0)) GO TO 499
C  CHECK FOR PROMPT MATCH
      CALL UCMPPR
      GO TO 499
C----------------------------------------------------------------
 420  CONTINUE
C  "@" SYMBOL ENCOUNTERED -- ESTABLISH COMMUNICATIONS WITH NAMED
C  INDIRECT INPUT FILE (IF POSSIBLE)
C    ... IGNORE IF NLSKIP IS SET
      IF(NLSKIP) GO TO 499
C
C  TYPEAHEAD PAST FILE INDIRECT FILE INVOCATION IS POSSIBLE BUT
C  MUST BE DEFERRED UNTIL AFTER THE INDIRECT FILE IS READ AND CLOSED
      ICLEAR=1
C
C  ATTEMPT TO OPEN INPUT FILE
C
      CALL UINDIN(URFILE,0,IER)
C
      IF(NLINDI.AND.(IER.NE.0)) THEN
        CALL URDERR(2)
      ENDIF
      IF(IER.NE.0) THEN
        IERC=1
        GO TO 499
      ENDIF
C  REQUIRE PROMPT MATCHES FOR INDIRECT INPUT
      IF((NCHARA.GT.0).OR.(LCMDIN.EQ.2)) CALL UREADY(0)
      GO TO 499
C
C---------------------------------------------------------
C  ">" -- CREATE OR CLOSE INDIRECT OUTPUT FILE
C  IGNORE IF READING FROM INDIRECT INPUT FILE
 430  CONTINUE
      IF(NLSKIP) GO TO 499
      CALL UDELIM(CBUFF(2:2),JCODE)
      IF(NLINDI) THEN
C  DMC JAN 1985
C   INDIRECT INPUT FILE IS OPEN
C   ">" IS TREATED AS IN INDIRECT FILE INPUT REFERENCE, IF A
C   FILENAME FOLLOWS; OTHERWISE IT IS END-OF-LINE
C
        ICLEAR=1
        IF(LCMDIN.EQ.2) THEN
          CALL UERMSG(
     >'% CANNOT ACCESS OUTPUT FILE WITH INDIRECT INPUT FILE IN CONTROL',
     >                  ' ',1)
          IERC=1
        ELSE
          IF((JCODE.LT.1).OR.(JCODE.GT.2)) THEN  ! ">" HAS ARGUMENT
            CBUFF(1:1)=MFILI
            GO TO 420
          ENDIF
        ENDIF
      ELSE
C  OPEN OR CLOSE OUTPUT FILE...
        ICLEAR=1
        IF((JCODE.LT.1).OR.(JCODE.GT.2)) THEN  ! ">" HAS ARGUMENT
          CALL UINDIN(URFILE,1,IER)
          IF(IER.NE.0) IERC=1
        ELSE
C  CLOSE...
          IF(NLUNIO.EQ.0) THEN
            CALL UERMSG(' % NO OUTPUT FILES OPEN',' ',1)
          ELSE
            CALL URDEOF(IDUM)
          ENDIF
C  USE TYPEAHEAD POPPED FROM STACK (IF ANY)
          ICLEAR=0
        ENDIF
      ENDIF
      GO TO 499
C-----------------------------------------------------------
C  SPECIAL COMMAND FUNCTIONS INVOKED -- FIRST CHARACTER IS "*"
C
 440  CONTINUE
      IF(NLSKIP) GO TO 499
C
      CALL URDSPF(IER)
      IF(IER.NE.0) THEN
C  USER/PROGRAM DEFINED COMMAND?
        IRET=3
        GO TO 500
      ENDIF
      GO TO 499
C------------------------------------------------------------
C  "/" PARAMETER DEFINITION OR SUBSTITUTION LINE
C
 450  CONTINUE
      IF(NLSKIP) GO TO 499
      ISTART=1
      CALL USPCHK(DBUFF,LBUFF,ISTART,IFIN,INDEQ,IDUM)
      IF(IFIN.EQ.1) THEN
        CALL UROTOR(1)
        GO TO 499
      ENDIF
      IF(INDEQ.EQ.0) GO TO 455
C  PARAMETER DEFINITION (LINE OF FORM "/NAME=VALUE")
      INDSL=1
      CALL UPMASG(DBUFF,INDSL,IFIN,IERC)
      CALL UROTOR(IFIN)
C
      GO TO 499
C  PRE-DEFINED PARAMETER IS INVOKED
C  SUBSTITUTE PARAMETER VALUE FOR PARAMETER NAME
C  AND INTERPRET THROUGH UREAD LOGIC
 455  CONTINUE
C  MUST BE FILE INPUT
      IF(LCMDIN.EQ.2) THEN
C  SUBSTITUTION NOT MEANINGFUL...
          IF((CBUFF(1:5).NE.'/$LIS').AND.(CBUFF(1:5).NE.'/$DEL')) THEN
          ICLEAR=1
          IERC=1
          GO TO 499
        ENDIF
      ENDIF
C
      IF(NLSSUB) then
         !  a substitution was already performed; return to caller
         IRET=3
         GO TO 500
      endif
C
      CALL UPSSUB(DBUFF,IFIN,IFLAG,ZTVAL)
      IF(IFLAG.NE.0) GO TO 499
C  INSERT SUBSTITUTED VALUE
      CALL UROTOR(IFIN)
      CALL URDTTI(ZTVAL//' ')
      CALL UDECOD
      CALL UTTECH
      NLSSUB = .TRUE.
C  INTERPRET
      IRET=1
      RETURN
C
C--------------------------------------------------------------
C  "?" BRANCHING AND CONDITIONAL COMMAND EXECUTION
C
 460  CONTINUE
      IF(NLSKIP) GO TO 499
C
C  DMC 12/87
C  LONE "?" RETURNED TO CALLER - TIC APPLICATIONS COMPATIBILITY
      IF(NCHARC.EQ.1) THEN
        IRET=3
        GO TO 500
      ENDIF
C
C  MUST BE FILE INPUT
      IF(LCMDIN.EQ.2) THEN
        ICLEAR=1
        IERC=1
        GO TO 499
      ENDIF
C
      CALL URDQCD(INTRP)
C  INTERPRET INLINE CONDITIONAL COMMAND
      IF(INTRP.EQ.1) THEN
        CALL UTTECH
        IRET=1
        RETURN
      ENDIF
C  BRANCH TO MARKER; NO TYPEAHEAD
      ICLEAR=1
      IF(LMARKN.LE.0)  GO TO 499
      IEOFL=0
      NLSKIP=.TRUE.
      GO TO 499
C--------------------------------------------------------------
C  ":" MARKER LINE DETECTED
 470  CONTINUE
C  MAKES NO SENSE AS A CALLED COMMAND...
      IF(LCMDIN.EQ.2) THEN
        ICLEAR=1
        IERC=1
        GO TO 499
      ENDIF
C  IGNORE IF NOT LOOKING FOR MARKER
      IF(LMARKN.LE.0) GO TO 475
C
C  IS IT THE MARKER SOUGHT?
      DO 472 I=1,LMARKN
        IP1=I+1
        zchar=CBUFF(IP1:IP1)
        call uspcap(zchar)
        IF(zchar.NE.URMARK(I:I)) GO TO 475
 472  CONTINUE
      IP1=IP1+1
      IF(CBUFF(IP1:IP1).NE.' ') GO TO 475
C  MARKER FOUND
      IMARKN=LMARKN+1
      LMARKN=0
      NLSKIP=.FALSE.
      IF(NLECHO) WRITE(LUNTRM,3047) NCMND(NLUNIN)
 3047 FORMAT(' MARKER FOUND - RESUMING CONTROL AT RECORD ',I4)
      IEOFL=0
C
C ROTATE MARKER OUT
      IF(.NOT.NLHOLD) CALL UROTOR(IMARKN)
C
      GO TO 499
C  MARKER NOT CORRECT OR NONE SOUGHT-- ROTATE MARKER OUT
 475  CONTINUE
      CALL URWORD(CBUFF,1,ILENM,ILENR)
      CALL UROTOR(ILENR)
      GO TO 499
C
C
C------------------
C  CLEAR BUFFER, RESET TYPE-AHEAD, AND GET A NEW LINE
 499  CONTINUE
      IRET=2
 500  CONTINUE
      IF((IRET.LT.3).AND.(ICLEAR.EQ.1)) CALL UCLEAR
      RETURN
C------------------
      END
C******************** END FILE URDSPC.FOR ; GROUP UREAD5 ******************
