1*DECK DFULMT 2 SUBROUTINE DFULMT (I, J, AIJ, INDCAT, PRGOPT, DATTRV, IFLAG) 3C***BEGIN PROLOGUE DFULMT 4C***SUBSIDIARY 5C***PURPOSE Subsidiary to DSPLP 6C***LIBRARY SLATEC 7C***TYPE DOUBLE 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 DFULMT( ). 16C EXAMPLE-- (FOR USE TOGETHER WITH DSPLP().) 17C EXTERNAL DUSRMT 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 DSPLP( ... DFULMT INSTEAD OF DUSRMT...) 27C 28C***SEE ALSO DSPLP 29C***ROUTINES CALLED XERMSG 30C***REVISION HISTORY (YYMMDD) 31C 811215 DATE WRITTEN 32C 890531 Changed all specific intrinsics to generic. (WRB) 33C 891214 Prologue converted to Version 4.0 format. (BAB) 34C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) 35C 900328 Added TYPE section. (WRB) 36C***END PROLOGUE DFULMT 37 DOUBLE PRECISION AIJ,ZERO,DATTRV(*),PRGOPT(*) 38 INTEGER IFLAG(10) 39 SAVE ZERO 40C***FIRST EXECUTABLE STATEMENT DFULMT 41 IF (.NOT.(IFLAG(1).EQ.1)) GO TO 50 42C INITIALIZE POINTERS TO PROCESS FULL TWO-DIMENSIONAL FORTRAN 43C ARRAYS. 44 ZERO = 0.D0 45 LP = 1 46 10 NEXT = PRGOPT(LP) 47 IF (.NOT.(NEXT.LE.1)) GO TO 20 48 NERR = 29 49 LEVEL = 1 50 CALL XERMSG ('SLATEC', 'DFULMT', 51 + 'IN DSPLP, ROW DIM., MRELAS, NVARS ARE MISSING FROM PRGOPT.', 52 + NERR, LEVEL) 53 IFLAG(1) = 3 54 GO TO 110 55 20 KEY = PRGOPT(LP+1) 56 IF (.NOT.(KEY.NE.68)) GO TO 30 57 LP = NEXT 58 GO TO 10 59 30 IF (.NOT.(PRGOPT(LP+2).EQ.ZERO)) GO TO 40 60 LP = NEXT 61 GO TO 10 62 40 IFLAG(2) = 1 63 IFLAG(3) = 1 64 IFLAG(4) = PRGOPT(LP+3) 65 IFLAG(5) = PRGOPT(LP+4) 66 IFLAG(6) = PRGOPT(LP+5) 67 GO TO 110 68 50 IF (.NOT.(IFLAG(1).EQ.2)) GO TO 100 69 60 I = IFLAG(2) 70 J = IFLAG(3) 71 IF (.NOT.(J.GT.IFLAG(6))) GO TO 70 72 IFLAG(1) = 3 73 GO TO 110 74 70 IF (.NOT.(I.GT.IFLAG(5))) GO TO 80 75 IFLAG(2) = 1 76 IFLAG(3) = J + 1 77 GO TO 60 78 80 AIJ = DATTRV(IFLAG(4)*(J-1)+I) 79 IFLAG(2) = I + 1 80 IF (.NOT.(AIJ.EQ.ZERO)) GO TO 90 81 GO TO 60 82 90 INDCAT = 0 83 GO TO 110 84 100 CONTINUE 85 110 RETURN 86 END 87