C******************** START FILE UPMASG.FOR ; GROUP USPARM *************
C----------------------------------------------------------------
C&  UPMASG   ASSIGN CHARACTER VALUE TO UREAD STRING PARAMETER
C          CARRY OUT REQUEST TO ASSIGN VALUE TO NEW LOCAL OR
C          GLOBAL PARAMETER, OR DELETE OLD PARAMETER
C
C  ZLINE   INPUT DATA LINE FROM WHICH TO PARSE REQUESTS
C  LLINE   LENGTH OF ZLINE (ZLINE IS 1 CHAR PER WORD UNPACKED)
C  ISTART  INDEX LOCATION AT WHICH TO START PARSE
C
C  MODIFIED D. MC CUNE 4 APR 1983-- ALLOW INTEGER ARITHMETIC
C   /NAME=+VALUE
C  CAUSES THE (INTEGER) VALUE TO BE ADDED TO THE (INTEGER) VALUE
C  ALREADY ASSIGNED TO THE PARAMETER /NAME.  IF /NAME IS NOT DEFINED
C  THIS LINE IS EQUIVALENT TO "/NAME=VALUE".  BUT AN ERROR OCCURS IF
C  EITHER "VALUE" OR /NAME'S OLD DEFINITION CANNOT BE DECODED AS
C  INTEGERS
C   OPERATIONS SUPPORTED: - + * / SUBTRACTION ADDITION MULTIPLY DIVIDE
C
C
      SUBROUTINE UPMASG(ZLINE,ISTART,LLINE,IER)
      USE USERIO
C
      PARAMETER (INOPS=4)
      CHARACTER*1 ZLINE(LLINE)
      CHARACTER*16 ZNAM
      CHARACTER*96 ZVAL,ZVALP
      CHARACTER*4 ZDEL,ZTES
      CHARACTER*1 ZBLANK,ZOPS(INOPS)
      EQUIVALENCE(ZVAL,ZTES)
      DATA ZDEL/'$DEL'/
      DATA ZBLANK/' '/
      DATA ZOPS/'+','-','*','|'/
C
C----------------------------------------------
C
      IER=0
C
      ISEMI=ISTART
      CALL UFCHAR(ZLINE,MSEMI,ISEMI,LLINE)
      IF(ISEMI.GT.0) THEN
        ILINE=ISEMI-1
      ELSE
        ILINE=LLINE
      ENDIF
C
      IST2=ISTART
C  LOOP:  MORE THAN ONE ASSIGN STATEMENT PER LINE PERMITTED
 10   CONTINUE
      ISTART=IST2
C  EXIT TEST
      IF((ISTART.LE.0).OR.(ISTART.GT.ILINE)) GO TO 200
C  FIND NEXT "/"; START OF NEXT ASSIGN
      INDF2=ISTART+1
 12   CALL UFCHAR(ZLINE,MSLASH,INDF2,ILINE)
      IST2=INDF2
      IFIN=IST2-1
      IF(IFIN.LT.0) IFIN=ILINE
      INIT=ISTART+1
C
C  STRING OF FORM "NAME=(=)VALUE" SHOULD BE LOCATED IN ZLINE
C  FROM ZLINE(INIT) TO ZLINE(IFIN)
C
      IEQS=INIT
C  FIND "="
      CALL UFCHAR(ZLINE,MEQS,IEQS,IFIN)
      IF((IEQS.EQ.0).OR.(IEQS.LE.INIT)) GO TO 190
      IEQS2=IEQS
      IGLOBL=0
      IF(IEQS.LT.ILINE) THEN
        IF(ZLINE(IEQS+1).EQ.MEQS) IEQS2=IEQS2+1
      ENDIF
      IF(IEQS2.GT.IEQS) IGLOBL=1
C
C  INTERACTIVE ASSIGNMENT LINES ARE ALSO MADE TO GLOBAL
C  (DMC mod -- applies to all in line -- Apr 2011)
C
      IF(.NOT.NLINDI) IGLOBL=1
C
C  **  CHECK 1ST NON-BLANK FOR INTEGER ARITHMETIC OPERATION
      ITESO=INNBLK(ZLINE,ILINE,IEQS2)
C
C  MOD DMC - CHECK FOR PARAMETER VALUE WHICH ITSELF USES THE
C  PARAMETER DEFINITION/INVOKATION CHARACTER
      IF(ITESO.EQ.IST2) THEN
        ISTFIN=IST2+1
        CALL UFCHAR(ZLINE,MSLASH,ISTFIN,ILINE)
        IST2=ISTFIN
        IFIN=IST2-1
        IF(IFIN.LT.0) IFIN=ILINE
        GO TO 41
      ENDIF
C
      IF(ITESO.GT.(ILINE-1)) GO TO 41
C
      DO 40 IOP=1,INOPS
      IF((ZLINE(ITESO).EQ.'.').AND.(ZLINE(ITESO+1).EQ.ZOPS(IOP)))
     >      GO TO 42
 40   CONTINUE
C  NOT AN ARITHMETIC OPERATOR
 41   CONTINUE
      IOP=0
      GO TO 45
C  INTEGER OPERATION REQUESTED.  ASSIGN DEFAULT PRIOR VALUE TO
C  OPERAND
 42   CONTINUE
      ITESO=ITESO+1
      ZVALP='                              '
      ZVALP(1:1)='0'
      IF(IOP.GT.2) ZVALP(1:1)='1'
      IEQS2=ITESO
 45   CONTINUE
C
C  CHECK NAME AND VALUE
C
      INAMF=IEQS-1
      IVALI=IEQS2+1
      CALL USPLNM(ZLINE,ILINE,INIT,INAMF,ZNAM,IER1)
      CALL USPLVL(ZLINE,ILINE,IVALI,IFIN,ZVAL,IER2)
      IF((IER1.NE.0).OR.(IER2.NE.0)) GO TO 190
C  CHECK FOR DELETION
      IF(ZTES.EQ.ZDEL) GO TO 150
C  NAME AND VALUE LEGAL; CHECK IF PARAMETER NAME ALREADY KNOWN
      CALL USPLOC(ZNAM,ITYP,INUM)
      IF(ITYP.EQ.0) GO TO 100
C  DELETE NAME AFTER WARNING MESSAGE
      IF(NLECHO) WRITE(LUNTRM,4001) ZNAM
 4001 FORMAT(' % PREVIOUS DEFINITION OF PARAMETER "',A16,
     >  '" REPLACED'/)
CX	CALL UPAUST(1)
C  IF GOING TO PERFORM ARITHMETIC OPERATION, SAVE VALUE
      IF(IOP.GT.0) THEN
        IF(ITYP.EQ.1) ZVALP=PLCVAL(INUM,MAX0(NLUNIN,NLUNIO))
        IF(ITYP.EQ.2) ZVALP=PGLVAL(INUM)
      ENDIF
      IF(ITYP.EQ.2) CALL USPDGL(INUM)
      IF(ITYP.EQ.1) CALL USPDLO(INUM)
C  STORE NEW PARAMETER DEFINITION
 100  CONTINUE
C  STRAIGHT PARAMETER DEFINITION:
      IF(IOP.EQ.0) THEN
        IF(IGLOBL.EQ.0) CALL UPSADL(ZNAM,ZVAL)
        IF(IGLOBL.EQ.1) CALL UPSADG(ZNAM,ZVAL)
                   ELSE
C  ARITHMETIC
        CALL UPSART(ZNAM,ZVALP,ZVAL,IOP,IGLOBL)
      ENDIF
      GO TO 10
C  DELETE PARAMETER (IF IT EXISTS)
 150  CONTINUE
      CALL USPLOC(ZNAM,ITYP,INUM)
      IF(ITYP.NE.0) GO TO 160
C  ERROR
      IER=IER+1
      WRITE(LUNTRM,4002) ZNAM
 4002 FORMAT(' % ATTEMPT TO DELETE NON-EXISTANT PARAMETER "',
     >  A16,'" IGNORED.'/)
      CALL UPAUST(1)
      GO TO 10
C
 160  CONTINUE
      IF(ITYP.EQ.1) CALL USPDLO(INUM)
      IF(ITYP.EQ.2) CALL USPDGL(INUM)
      GO TO 10
C-----------------
C  ERROR MESSAGE
 190  CONTINUE
      IER=IER+1
      WRITE(LUNTRM,4005) (ZLINE(I),I=1,MIN(128,ILINE)),INIT,IFIN
 4005 FORMAT(' % ERROR PARSING PARAMETER ASSIGNMENT REQUEST LINE:'/
     >  1X,128A1/'   CHARACTERS # ',I3,' TO ',I3/
     >  '   INTENDED ASSIGNMENTS IN THIS CHARACTER RANGE NOT PERFORMED'
     >  /)
      CALL UPAUST(1)
      CALL UCLEAR
      GO TO 10
C-----------------------------
C  LOOP EXIT
 200  CONTINUE
      RETURN
      	END
C******************** END FILE UPMASG.FOR ; GROUP USPARM ***************
