C******************** START FILE UPSART.FOR ; GROUP USPARM ******************
C-------------------------------------------------------------
C&  UPSART  UREAD STRING PARAMETER ARITHMETIC
C
C  REDEFINE PARAMETER BY ARITHMETIC OPERATION
C  ZNAM-- PARAMETER NAME
C  ZVALP-- PARAMETER'S OLD VALUE
C     FIRST OPERAND OF ARITHMETIC OPERATION
C  ZVAL-- SECOND OPERAND OF ARITHMETIC OPERATION
C   RESULTANT VALUE = ZVALP  (OP)  ZVAL
C  WHERE OP = + (ADDITION) IF IOP=1
C             - (SUBTRACTION) IF IOP=2
C             * (MULTIPLICATION) IF IOP=3
C             / (DIVISION) IF IOP=4
C  IGLOBL-- FLAG WHETHER RESULT IS TO BE SAVED AS LOCAL OR GLOBAL
C  PARAMETER
C
      SUBROUTINE UPSART(ZNAM,ZVALP,ZVAL,IOP,IGLOBL)
C
      CHARACTER*16 ZNAM
      CHARACTER*96 ZVALP,ZVAL,ZANS
C
C  CHECK THAT OPERANDS ARE LEGAL INTEGERS
C
      LPVAL=LEN(ZVAL)
C
      IOP1=INTUSP(ZVALP,IER)
      IF(IER.NE.0) GO TO 900
      IOP2=INTUSP(ZVAL,IER)
      IF(IER.NE.0) GO TO 900
C  PERFORM OPERATION
      GO TO (100,200,300,400) IOP
C  ADDITION
 100  CONTINUE
      IANS=IOP1+IOP2
      GO TO 1000
C  SUBTRACTION
 200  CONTINUE
      IANS=IOP1-IOP2
      GO TO 1000
C  MULTIPLICATION
 300  CONTINUE
      IANS=IOP1*IOP2
      GO TO 1000
C  DIVISION-- CHECK
 400  CONTINUE
      IF(IOP2.EQ.0) THEN
        CALL UERMSG('PARAMETER ARITHMETIC - DIV BY ZERO ATTEMPTED',
     >      ZVAL,1)
        GO TO 900
      ENDIF
      IANS=IOP1/IOP2
      GO TO 1000
C
C  ERROR
C
 900  CONTINUE
C  NO ASSIGNMENT-- PARAMETER REMAINS UNDEFINED
      RETURN
C
C  NORMAL EXIT-- CARRY OUT PARAMETER ASSIGNMENT
C
 1000 CONTINUE
      ZANS='                                                '
      WRITE(ZANS,1001) IANS
 1001 FORMAT(I15)
C  LEFT-JUSTIFY
      ICT=0
      DO 1010 IC=1,LPVAL
          IF(ZANS(IC:IC).EQ.' ') GO TO 1010
          ICT=ICT+1
          ZANS(ICT:ICT)=ZANS(IC:IC)
 1010 CONTINUE
C
      ICTP1=ICT+1
          DO 1020 IC=ICTP1,LPVAL
          ZANS(IC:IC)=' '
 1020 CONTINUE
C
C  CARRY OUT ASSIGNMENT
C
      IF(IGLOBL.EQ.1) CALL UPSADG(ZNAM,ZANS)
      IF(IGLOBL.NE.1) CALL UPSADL(ZNAM,ZANS)
C
      RETURN
      END
C******************** END FILE UPSART.FOR ; GROUP USPARM ******************
