C******************** START FILE UPSINL.FOR ; GROUP UPSINL ******************
C--------------------------------------------------------
C&  UPSINL  PERFORM UREAD STRING PARAMETER SUBSTITUTION INLINE
C
C  PERFORM IN-LINE PARAMETER SUBSTITUTION
C
C  SUBSTITUTION CHARACTER IS SINGLE QUOTE (') - MSUB1 IN
C   USERIO COMMON
C
C  MODIF DMC JAN 1985
C   SECOND INLINE SUBSTITUTION TECHNIQUE - PAIR OF COMPLIMENTARY
C  CHARACTERS MSUB2(1),MSUB2(2) (WIGGLY BRACKETS) - RECURSIVE TECHNIQUE
C  I.E. MAY SUBSTITUTE A PARAM. TO FORM A NAME WHICH IN TURN GETS
C  REPLACED WITH THE FINAL VALUE-- MAKING PARAMETERS WORK LIKE
C  ARRAYS
C   BRACKETS MAY NOT APPEAR IN LINE UNLESS A SUBSTITUTION IS TO BE
C  PERFORMED
C
C
C  SUBSTITUTION REQUEST IS IGNORED IF STRING BETWEEN 2 SINGLE
C  QUOTES IS NOT A LEGAL PARAMETER NAME OR IF THE PARAMETER NAME
C  IS NOT RECOGNIZED.
C
C  SUBSTITUTION IS PERFORMED IN CBUFF ARRAY-- ERROR IF THERE IS
C  NOT SUFFICIENT SPACE
C
      SUBROUTINE UPSINL(IER)
C
      USE USERIO
C
      CHARACTER*16 ZNAM,ZNAM2
      CHARACTER*1 ZNAM1(16)
      CHARACTER*96 ZVAL
C
C-----------------------------------------
C  LOOK FOR SUBSTITUTION CHARACTER
C
      IER=0
C
      ILNAM=LEN(ZNAM)
      ILVAL=LEN(ZVAL)
C
      ISUB=0
C
      ILEV=1
C  SKIP IF A COMMENT
      IF(CBUFF(1:1).EQ.MCOMMT) GO TO 1000
C  SKIP IF SUBSTITUTION CHARACTER IS BLANKED
      IF(MSUB2(1).EQ.' ') GO TO 9
C
      ILEN=LEN(CBUFF)
 1    CONTINUE
C  ANY MORE SUBSTITUTIONS?
      IEVEN=1
      ISC=0
      CALL UPSINX(CBUFF,ISC,IEVEN)
      IF(ISC.EQ.0) GO TO 9
C  FIND LAST OCCURANCE OF SUBSTITUTION CHARACTER
 2    CONTINUE
      ISCP=ISC+1
      IF(ISCP.GT.ILEN) GO TO 1900
      IS=ISC
      CALL UPSINX(CBUFF,IS,IEVEN)
      IF(IS.EQ.ISC) GO TO 3
      ISC=IS
      GO TO 2
C  FOUND; FIND SUBSTITUTION TERMINATION CHARACTER
 3    CONTINUE
      ISC2=INDEX(CBUFF(ISCP:ILEN),MSUB2(2))+ISC
      IF(ISC2.LE.(ISC+1)) GO TO 1900
C
      ISUB1=ISC
      ISUB2=ISC2
      INM1=ISC+1
      INM2=ISC2-1
      INL=INM2-INM1+1
C
C
C  GO TO PERFORM SUBSTITUTION
C
      GO TO 30
C
 9    CONTINUE
C  SINGLE QUOTE SUBSTITUTION...
      IF(MSUB1.EQ.' ') GO TO 1000
      ILEV=2
      ISC=0
      IEVEN=1
C
 10   CONTINUE
      ISC=ISC+1
      IF(ISC.GT.ILEN) GO TO 1000
      IF(CBUFF(ISC:ISC).EQ.'"') IEVEN=1-IEVEN
      IF(CBUFF(ISC:ISC).NE.MSUB1) GO TO 10
C  FIRST QUOTE FOUND-- LOOK FOR MATCHING SECOND QOUTE; ABORT IF
C  END OF LINE WITHOUT FINDING SECOND QUOTE
      INC1=0
      IF(IEVEN.EQ.0) THEN
C  INSIDE DBL QUOTES, *2* CONSECUTIVE SNGL QUOTES NEEDED FOR SUBSTITUTION
        IF(ISC.EQ.ILEN) GO TO 1000
        ISCPL=ISC+1
        IF(CBUFF(ISCPL:ISCPL).NE.MSUB1) GO TO 10
        ISC=ISCPL
        INC1=1
      ENDIF
      ISC2=ISC
 20   CONTINUE
      ISC2=ISC2+1
      IF(ISC2.GT.ILEN) GO TO 1000
      IF(CBUFF(ISC2:ISC2).NE.MSUB1) GO TO 20
C  2ND QUOTE FOUND-- CHECK LENGTH OF NAME STRING INBETWEEN
      ISUB1=ISC-INC1
      INM1=ISC+1
      INM2=ISC2-1
      INL=INM2-INM1+1
      IF(INL.EQ.0) THEN
C  NOT A NAME BUT A "''".  RESUME SEARCH
        ISC=ISC2
        GO TO 20
      ENDIF
      ISUB2=ISC2
      IF((IEVEN.EQ.0).AND.(ISC2.LT.ILEN)) THEN
        ISCPL=ISC2+1
        IF(CBUFF(ISCPL:ISCPL).EQ.MSUB1) ISUB2=ISUB2+1
      ENDIF
      GO TO 30
C--------------------------------------------------
C  PARAMETER NAME FOUND FOR SUBSTITUTION
 30   CONTINUE
C  EXTRACT NAME
      INL=MIN0(LPNAM,INL)
      INM2=INM1+INL-1
C
      ZNAM='                '
      ZNAM(1:INL)=CBUFF(INM1:INM2)
      call uspcap(ZNAM)
      DO 31 IC=1,ILNAM
        ZNAM1(IC)=ZNAM(IC:IC)
 31   CONTINUE
C
      I1=1
      IINL=INL
      CALL USPLNM(ZNAM1,ILNAM,I1,IINL,ZNAM2,IER)
      IF(IER.NE.0) RETURN  ! *** NAME FIELD ERROR REPORTED
C
C  GET VALUE OF NAMED PARAMETER- SUPPLIED BY USER IF UNDEFINED
      CALL USPGET(ZNAM,ZVAL,IERL)
      ILENS=0
      IF(IERL.NE.0) CALL UPQUER(ZNAM,DBUFF,ILEN,ZVAL)
C
      DO 40 IC=ILVAL,1,-1
        IF(ZVAL(IC:IC).NE.' ') GO TO 42
 40   CONTINUE
      IC=1
 42   CONTINUE
      ILENS=IC
C  PERFORM SUBSTITUTION
 50   CONTINUE
      ISUB=1
      IF(NLECHO) THEN
        IF(ILENS.EQ.0) WRITE(LUNTRM,2001) CBUFF(INM1:INM2)
        IF(ILENS.GT.0)
     >    WRITE(LUNTRM,2002) CBUFF(INM1:INM2),ZVAL(1:ILENS)
 2001 FORMAT(' % UPSINL-- INLINE SUBSTITUTION'/
     >  '   ''',A,''' REPLACED BY NULL STRING')
 2002 FORMAT(' % UPSINL-- INLINE SUBSTITUTION'/
     >  '   ''',A,''' REPLACED BY STRING PARAMETER VALUE "',A,'"')
      ENDIF
C  CHECK AGAINST LINE OVERFLOW
      IDIF=ILENS-(ISUB2-ISUB1+1)
      IF(IDIF.LE.0) GO TO 60
      ILOSS=ILEN-IDIF+1
      DO 55 IL=ILOSS,ILEN
        IF(CBUFF(IL:IL).NE.' ') GO TO 59
 55   CONTINUE
C  OK
      GO TO 60
C  ERROR
 59   CONTINUE
      CALL UERMSG('? INLINE PARAMETER SUBSTITUTION OVERFLOWS LINE',
     >     ZVAL,1)
      IER=1
      RETURN
C
 60   CONTINUE
      ISP0=ISUB2+1
      ISP1=ISP0+IDIF
      IF(IDIF.GT.0) THEN
C  SHIFT OUT REMAINDER OF LINE TO MAKE ROOM FOR SUBSTITUTION
        DO 62 IP=ILEN,ISP0,-1
          INLOC=IP+IDIF
          IF(INLOC.GT.ILEN) GO TO 62
          CBUFF(INLOC:INLOC)=CBUFF(IP:IP)
 62     CONTINUE
      ELSE IF (IDIF.LT.0) THEN
C  SHIFT IN REMAINDER OF LINE, PAD WITH BLANKS
        DO 64 IP=ISP1,ILEN
          IOLOC=IP-IDIF
          CBUFF(IP:IP)=' '
          IF(IOLOC.LE.ILEN) CBUFF(IP:IP)=CBUFF(IOLOC:IOLOC)
 64     CONTINUE
      ENDIF
C  NOW SUBSTITUTE THE PARAMETER ITSELF
      ILS=ISUB2+IDIF
      CBUFF(ISUB1:ILS)=ZVAL(1:ILENS)
C
      ISC=ISUB1
C  RESUME SEARCH
      GO TO (1,10) ILEV
C
      CALL URDABO
C
C  NORMAL EXIT
C
 1000 CONTINUE
C
C  IF SUBSTITUTION WAS PERFORMED RESET LINE CHARACTER COUNT
C
      IF(ISUB.GT.0) CALL UDECOD
      RETURN
C
C  ERROR
C
 1900 CONTINUE
      CALL UERMSG(
     >'? INVALID USE OF RECURSIVE INLINE SUBSTITUTION CHARACTER',
     >MSUB2(1),1)
      IER=1
      RETURN
C
      END
C******************** END FILE UPSINL.FOR ; GROUP UPSINL ******************
