1*DECK FULMAT 2 SUBROUTINE FULMAT (I, J, AIJ, INDCAT, PRGOPT, DATTRV, IFLAG) 3C***BEGIN PROLOGUE FULMAT 4C***SUBSIDIARY 5C***PURPOSE Subsidiary to SPLP 6C***LIBRARY SLATEC 7C***TYPE SINGLE PRECISION (FULMAT-S, DFULMT-D) 8C***AUTHOR (UNKNOWN) 9C***DESCRIPTION 10C 11C DECODES A STANDARD TWO-DIMENSIONAL FORTRAN ARRAY PASSED 12C IN THE ARRAY DATTRV(IA,*). THE ROW DIMENSION IA AND THE 13C MATRIX DIMENSIONS MRELAS AND NVARS MUST SIMULTANEOUSLY BE 14C PASSED USING THE OPTION ARRAY, PRGOPT(*). IT IS AN ERROR 15C IF THIS DATA IS NOT PASSED TO FULMAT( ). 16C EXAMPLE-- (FOR USE TOGETHER WITH SPLP().) 17C EXTERNAL USRMAT 18C DIMENSION DATTRV(IA,*) 19C PRGOPT(01)=7 20C PRGOPT(02)=68 21C PRGOPT(03)=1 22C PRGOPT(04)=IA 23C PRGOPT(05)=MRELAS 24C PRGOPT(06)=NVARS 25C PRGOPT(07)=1 26C CALL SPLP( ... FULMAT INSTEAD OF USRMAT...) 27C 28C***SEE ALSO SPLP 29C***ROUTINES CALLED XERMSG 30C***REVISION HISTORY (YYMMDD) 31C 811215 DATE WRITTEN 32C 891214 Prologue converted to Version 4.0 format. (BAB) 33C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) 34C 900328 Added TYPE section. (WRB) 35C***END PROLOGUE FULMAT 36 REAL AIJ,ZERO,DATTRV(*),PRGOPT(*) 37 INTEGER IFLAG(10) 38 SAVE ZERO 39C***FIRST EXECUTABLE STATEMENT FULMAT 40 IF (.NOT.(IFLAG(1).EQ.1)) GO TO 50 41C INITIALIZE POINTERS TO PROCESS FULL TWO-DIMENSIONAL FORTRAN 42C ARRAYS. 43 ZERO = 0. 44 LP = 1 45 10 NEXT = PRGOPT(LP) 46 IF (.NOT.(NEXT.LE.1)) GO TO 20 47 NERR = 29 48 LEVEL = 1 49 CALL XERMSG ('SLATEC', 'FULMAT', 50 + 'IN SPLP PACKAGE, ROW DIM., MRELAS, NVARS ARE MISSING FROM ' // 51 + 'PRGOPT.', NERR, LEVEL) 52 IFLAG(1) = 3 53 GO TO 110 54 20 KEY = PRGOPT(LP+1) 55 IF (.NOT.(KEY.NE.68)) GO TO 30 56 LP = NEXT 57 GO TO 10 58 30 IF (.NOT.(PRGOPT(LP+2).EQ.ZERO)) GO TO 40 59 LP = NEXT 60 GO TO 10 61 40 IFLAG(2) = 1 62 IFLAG(3) = 1 63 IFLAG(4) = PRGOPT(LP+3) 64 IFLAG(5) = PRGOPT(LP+4) 65 IFLAG(6) = PRGOPT(LP+5) 66 GO TO 110 67 50 IF (.NOT.(IFLAG(1).EQ.2)) GO TO 100 68 60 I = IFLAG(2) 69 J = IFLAG(3) 70 IF (.NOT.(J.GT.IFLAG(6))) GO TO 70 71 IFLAG(1) = 3 72 GO TO 110 73 70 IF (.NOT.(I.GT.IFLAG(5))) GO TO 80 74 IFLAG(2) = 1 75 IFLAG(3) = J + 1 76 GO TO 60 77 80 AIJ = DATTRV(IFLAG(4)*(J-1)+I) 78 IFLAG(2) = I + 1 79 IF (.NOT.(AIJ.EQ.ZERO)) GO TO 90 80 GO TO 60 81 90 INDCAT = 0 82 GO TO 110 83 100 CONTINUE 84 110 RETURN 85 END 86