1      SUBROUTINE SPLPUP(USRMAT,MRELAS,NVARS,PRGOPT,DATTRV,
2     *     BL,BU,IND,INFO,AMAT,IMAT,SIZEUP,ASMALL,ABIG)
3C***BEGIN PROLOGUE  SPLPUP
4C***REFER TO  SPLP
5C     THE EDITING REQUIRED TO CONVERT THIS SUBROUTINE FROM SINGLE TO
6C     DOUBLE PRECISION INVOLVES THE FOLLOWING CHARACTER STRING CHANGES.
7C
8C     USE AN EDITING COMMAND (CHANGE) /STRING-1/(TO)STRING-2/.
9C     /REAL (12 BLANKS)/DOUBLE PRECISION/,/ABS(/DABS(/.
10C
11C     REVISED 810613-1130
12C     REVISED YYMMDD-HHMM
13C
14C     THIS SUBROUTINE COLLECTS INFORMATION ABOUT THE BOUNDS AND MATRIX
15C     FROM THE USER.  IT IS PART OF THE SPLP( ) PACKAGE.
16C***ROUTINES CALLED  PCHNGS,PNNZRS,XERROR,XERRWV
17C***END PROLOGUE  SPLPUP
18      REAL             ABIG,AIJ,AMAT(*),AMN,AMX,ASMALL,BL(*),
19     * BU(*),DATTRV(*),PRGOPT(*),R1,R2,XVAL,ZERO
20      INTEGER IFLAG(10),IMAT(*),IND(*)
21      LOGICAL SIZEUP,FIRST
22C
23C***FIRST EXECUTABLE STATEMENT  SPLPUP
24      IOPT=1
25      ZERO=0.E0
26      GO TO 30001
2720002 CONTINUE
28      GO TO 30002
2920003 IF (.NOT.(SIZEUP .AND. .NOT. FIRST)) GO TO 20004
30      IF (.NOT.(AMN.LT.ASMALL .OR. AMX.GT.ABIG)) GO TO 20007
31      NERR=22
32      CALL XERROR( 'SPLP( ). A MATRIX ELEMENT''S SIZE IS OUT OF THE SPEC
33     *IFIED RANGE.',63,NERR,IOPT)
34      INFO=-NERR
35      RETURN
3620007 CONTINUE
3720008 CONTINUE
3820004 CONTINUE
39C
4020005 RETURN
41C
42C     PROCEDURE (CHECK USER-SUPPLIED BOUNDS)
43C
44C     CHECK THAT IND(*) VALUES ARE 1,2,3 OR 4.
45C     ALSO CHECK CONSISTENCY OF UPPER AND LOWER BOUNDS.
4630001 J=1
47      N20010=NVARS
48      GO TO 20011
4920010 J=J+1
5020011 IF ((N20010-J).LT.0) GO TO 20012
51      IF (.NOT.(IND(J).LT.1 .OR. IND(J).GT.4)) GO TO 20014
52      NERR=10
53      CALL XERRWV('SPLP( ). INDEPENDENT VARIABLE (I1) IS NOT DEFINED.',
54     *50,NERR,IOPT,1,J,I2,0,R1,R2)
55      INFO=-NERR
56      RETURN
5720014 IF (.NOT.(IND(J).EQ.3)) GO TO 10001
58      IF (.NOT.(BL(J).GT.BU(J))) GO TO 20017
59      NERR=11
60      CALL  XERRWV(   'SPLP( ).  LOWER BOUND (R1) AND UPPER BOUND (R2) F
61     *OR INDEP. VARIABLE   (I1) ARE NOT CONSISTENT.', 94,NERR,IOPT,1,J,
62     * I2, 2,BL(J),BU(J))
63      INFO=-NERR
64      RETURN
6520017 CONTINUE
6620018 CONTINUE
6710001 CONTINUE
6820015 GO TO 20010
6920012 I=NVARS+1
70      N20020=NVARS+MRELAS
71      GO TO 20021
7220020 I=I+1
7320021 IF ((N20020-I).LT.0) GO TO 20022
74      IF (.NOT.(IND(I).LT.1 .OR. IND(I).GT.4)) GO TO 20024
75      NERR=12
76      CALL XERRWV('SPLP( ). DEPENDENT VARIABLE (I1) IS NOT DEFINED.',
77     * 48,NERR,IOPT,1,I-NVARS,I2,0,R1,R2)
78      INFO=-NERR
79      RETURN
8020024 IF (.NOT.(IND(I).EQ.3)) GO TO 10002
81      IF (.NOT.(BL(I).GT.BU(I))) GO TO 20027
82      NERR=13
83      CALL XERRWV(  'SPLP( ).  LOWER BOUND (R1) AND UPPER BOUND (R2) FOR
84     * DEP. VARIABLE (I1) ARE NOT CONSISTENT.',90,NERR,IOPT,1,I,I2,2,
85     * BL(I),BU(I))
86      INFO=-NERR
87      RETURN
8820027 CONTINUE
8920028 CONTINUE
9010002 CONTINUE
9120025 GO TO 20020
9220022 CONTINUE
9331001 GO TO 20002
94C     PROCEDURE (GET UPDATES OR DATA FOR MATRIX FROM THE USER)
95C
96C     GET THE ELEMENTS OF THE MATRIX FROM THE USER.  IT WILL BE STORED
97C     BY COLUMNS USING THE SPARSE STORAGE CODES OF RJ HANSON AND
98C     JA WISNIEWSKI.
9930002 IFLAG(1)=1
100C
101C     KEEP ACCEPTING ELEMENTS UNTIL THE USER IS FINISHED GIVING THEM.
102C     LIMIT THIS LOOP TO 2*NVARS*MRELAS ITERATIONS.
103      ITMAX=2*NVARS*MRELAS+1
104      ITCNT=0
105      FIRST=.TRUE.
106C
107C     CHECK ON THE ITERATION COUNT.
10820030 ITCNT=ITCNT+1
109      IF (.NOT.(ITCNT.GT.ITMAX)) GO TO 20032
110      NERR=07
111      CALL XERROR(  'SPLP( ). MORE THAN 2*NVARS*MRELAS ITERS. DEFINING O
112     *R UPDATING MATRIX  DATA.',75,NERR,IOPT)
113      INFO=-NERR
114      RETURN
11520032 AIJ=ZERO
116      CALL USRMAT(I,J,AIJ,INDCAT,PRGOPT,DATTRV,IFLAG)
117      IF (.NOT.(IFLAG(1).EQ.1)) GO TO 20035
118      IFLAG(1)=2
119      GO TO 20030
120C
121C     CHECK TO SEE THAT THE SUBSCRIPTS I AND J ARE VALID.
12220035 IF (.NOT.(I.LT.1 .OR. I.GT.MRELAS .OR. J.LT.1 .OR. J.GT.NVARS)) GO
123     * TO 20038
124      IF (.NOT.(IFLAG(1).EQ.3)) GO TO 20041
125      ASSIGN 20044 TO NPR003
126      GO TO 30003
12720044 GO TO 20031
12820041 CONTINUE
12920042 NERR=08
130      CALL XERRWV(  'SPLP( ). ROW INDEX (I1) OR COLUMN INDEX (I2) IS OUT
131     * OF RANGE.',61,NERR,IOPT,2,I,J,0,R1,R2)
132      INFO=-NERR
133      RETURN
134C
135C    IF INDCAT=0 THEN SET A(I,J)=AIJ.
136C    IF INDCAT=1 THEN ACCUMULATE ELEMENT, A(I,J)=A(I,J)+AIJ.
13720038 IF (.NOT.(INDCAT.EQ.0)) GO TO 20045
138      CALL PCHNGS(I,AIJ,IPLACE,AMAT,IMAT,J)
139      GO TO 20046
14020045 IF (.NOT.(INDCAT.EQ.1)) GO TO 10003
141      INDEX=-(I-1)
142      CALL PNNZRS(INDEX,XVAL,IPLACE,AMAT,IMAT,J)
143      IF (INDEX.EQ.I) AIJ=AIJ+XVAL
144      CALL PCHNGS(I,AIJ,IPLACE,AMAT,IMAT,J)
145      GO TO 20046
14610003 NERR=09
147      CALL XERRWV(  'SPLP( ). INDICATION FLAG (I1) FOR MATRIX DATA MUST
148     *BE EITHER 0 OR 1.',68,NERR,IOPT,1,INDCAT,I2,0,R1,R2)
149      INFO=-NERR
150      RETURN
15120046 ASSIGN 20048 TO NPR003
152      GO TO 30003
15320048 IF (.NOT.(IFLAG(1).EQ.3)) GO TO 20049
154      GO TO 20031
15520049 GO TO 20030
15620031 CONTINUE
15731002 GO TO 20003
158C     PROCEDURE (CHECK ON SIZE OF MATRIX DATA)
159C
160C     RECORD THE LARGEST AND SMALLEST(IN MAGNITUDE) NONZERO ELEMENTS.
16130003 IF (.NOT.(SIZEUP .AND. ABS(AIJ).NE.ZERO)) GO TO 20052
162      IF (.NOT.(FIRST)) GO TO 20055
163      AMX=ABS(AIJ)
164      AMN=ABS(AIJ)
165      IAMX=I
166      JAMX=J
167      IAMN=I
168      JAMN=J
169      FIRST=.FALSE.
170      GO TO 20056
17120055 IF (.NOT.(ABS(AIJ).GT.AMX)) GO TO 10004
172      AMX=ABS(AIJ)
173      IAMX=I
174      JAMX=J
175      GO TO 20056
17610004 IF (.NOT.(ABS(AIJ).LT.AMN)) GO TO 10005
177      AMN=ABS(AIJ)
178      IAMN=I
179      JAMN=J
18010005 CONTINUE
18120056 CONTINUE
18220052 CONTINUE
18320053 CONTINUE
18431003 GO TO NPR003, (20044,20048)
185      END
186