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