*DECK PNNZRS SUBROUTINE PNNZRS (I, XVAL, IPLACE, SX, IX, IRCX) C***BEGIN PROLOGUE PNNZRS C***SUBSIDIARY C***PURPOSE Subsidiary to SPLP C***LIBRARY SLATEC C***TYPE SINGLE PRECISION (PNNZRS-S, DPNNZR-D) C***AUTHOR Hanson, R. J., (SNLA) C Wisniewski, J. A., (SNLA) C***DESCRIPTION C C PNNZRS LIMITS THE TYPE OF STORAGE TO A SEQUENTIAL SCHEME. C SPARSE MATRIX NON ZERO RETRIEVAL SUBROUTINE. C C SUBROUTINE PNNZRS() GETS THE NEXT NONZERO VALUE IN ROW OR COLUMN C +/- IRCX WITH AN INDEX GREATER THAN THE VALUE OF I. C C I ABSOLUTE VALUE OF THIS SUBSCRIPT IS TO BE EXCEEDED C IN THE SEARCH FOR THE NEXT NONZERO VALUE. A NEGATIVE C OR ZERO VALUE OF I CAUSES THE SEARCH TO START AT C THE BEGINNING OF THE VECTOR. A POSITIVE VALUE C OF I CAUSES THE SEARCH TO CONTINUE FROM THE LAST PLACE C ACCESSED. ON OUTPUT, THE ARGUMENT I C CONTAINS THE VALUE OF THE SUBSCRIPT FOUND. AN OUTPUT C VALUE OF I EQUAL TO ZERO INDICATES THAT ALL COMPONENTS C WITH AN INDEX GREATER THAN THE INPUT VALUE OF I ARE C ZERO. C XVAL VALUE OF THE NONZERO ELEMENT FOUND. ON OUTPUT, C XVAL=0. WHENEVER I=0. C IPLACE POINTER INFORMATION WHICH IS MAINTAINED BY THE PACKAGE. C SX(*),IX(*) THE WORK ARRAYS WHICH ARE USED TO STORE THE SPARSE C MATRIX. THESE ARRAY CONTENTS ARE AUTOMATICALLY C MAINTAINED BY THE PACKAGE FOR THE USER. C IRCX POINTS TO THE VECTOR OF THE MATRIX BEING SCANNED. A C NEGATIVE VALUE OF IRCX INDICATES THAT ROW -IRCX IS TO BE C SCANNED. A POSITIVE VALUE OF IRCX INDICATES THAT C COLUMN IRCX IS TO BE SCANNED. A ZERO VALUE OF IRCX IS C AN ERROR. C C THIS SUBROUTINE IS A MODIFICATION OF THE SUBROUTINE LNNZRS, C SANDIA LABS. REPT. SAND78-0785. C MODIFICATIONS BY K.L. HIEBERT AND R.J. HANSON C REVISED 811130-1000 C REVISED YYMMDD-HHMM C C***SEE ALSO SPLP C***ROUTINES CALLED IPLOC, XERMSG C***REVISION HISTORY (YYMMDD) C 811215 DATE WRITTEN C 890531 Changed all specific intrinsics to generic. (WRB) C 890605 Removed unreferenced labels. (WRB) C 891214 Prologue converted to Version 4.0 format. (BAB) C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) C 900328 Added TYPE section. (WRB) C 910403 Updated AUTHOR and DESCRIPTION sections. (WRB) C***END PROLOGUE PNNZRS DIMENSION IX(*) REAL XVAL,SX(*),ZERO SAVE ZERO DATA ZERO /0.E0/ C***FIRST EXECUTABLE STATEMENT PNNZRS IOPT=1 C C CHECK VALIDITY OF ROW/COL. INDEX. C IF (.NOT.(IRCX .EQ.0)) GO TO 20002 NERR=55 CALL XERMSG ('SLATEC', 'PNNZRS', 'IRCX=0.', NERR, IOPT) C C LMX IS THE LENGTH OF THE IN-MEMORY STORAGE AREA. C 20002 LMX = IX(1) IF (.NOT.(IRCX.LT.0)) GO TO 20005 C C CHECK SUBSCRIPTS OF THE ROW. THE ROW NUMBER MUST BE .LE. M AND C THE INDEX MUST BE .LE. N. C IF (.NOT.(IX(2).LT.-IRCX .OR. IX(3).LT.ABS(I))) GO TO 20008 NERR=55 CALL XERMSG ('SLATEC', 'PNNZRS', + 'SUBSCRIPTS FOR ARRAY ELEMENT TO BE ACCESSED WERE OUT OF ' // + 'BOUNDS.', NERR, IOPT) 20008 L=IX(3) GO TO 20006 C C CHECK SUBSCRIPTS OF THE COLUMN. THE COL. NUMBER MUST BE .LE. N AND C THE INDEX MUST BE .LE. M. C 20005 IF (.NOT.(IRCX.GT.IX(3) .OR. ABS(I).GT.IX(2))) GO TO 20011 NERR=55 CALL XERMSG ('SLATEC', 'PNNZRS', + 'SUBSCRIPTS FOR ARRAY ELEMENT TO BE ACCESSED WERE OUT OF ' // + 'BOUNDS.', NERR, IOPT) 20011 L=IX(2) C C HERE L IS THE LARGEST POSSIBLE SUBSCRIPT WITHIN THE VECTOR. C 20006 J=ABS(IRCX) LL=IX(3)+4 LPG = LMX - LL IF (.NOT.(IRCX.GT.0)) GO TO 20014 C C SEARCHING FOR THE NEXT NONZERO IN A COLUMN. C C INITIALIZE STARTING LOCATIONS.. IF (.NOT.(I.LE.0)) GO TO 20017 IF (.NOT.(J.EQ.1)) GO TO 20020 IPLACE=LL+1 GO TO 20021 20020 IPLACE=IX(J+3)+1 20021 CONTINUE C C THE CASE I.LE.0 SIGNALS THAT THE SCAN FOR THE ENTRY C IS TO BEGIN AT THE START OF THE VECTOR. C 20017 I = ABS(I) IF (.NOT.(J.EQ.1)) GO TO 20023 ISTART = LL+1 GO TO 20024 20023 ISTART=IX(J+3)+1 20024 IEND = IX(J+4) C C VALIDATE IPLACE. SET TO START OF VECTOR IF OUT OF RANGE. C IF (.NOT.(ISTART.GT.IPLACE .OR. IPLACE.GT.IEND)) GO TO 20026 IF (.NOT.(J.EQ.1)) GO TO 20029 IPLACE=LL+1 GO TO 20030 20029 IPLACE=IX(J+3)+1 20030 CONTINUE C C SCAN THROUGH SEVERAL PAGES, IF NECESSARY, TO FIND MATRIX ENTRY. C 20026 IPL = IPLOC(IPLACE,SX,IX) C C FIX UP IPLACE AND IPL IF THEY POINT TO PAGING DATA. C THIS IS NECESSARY BECAUSE THERE IS CONTROL INFORMATION AT THE C END OF EACH PAGE. C IDIFF = LMX - IPL IF (.NOT.(IDIFF.LE.1.AND.IX(LMX-1).GT.0)) GO TO 20032 C C UPDATE THE RELATIVE ADDRESS IN A NEW PAGE. C IPLACE = IPLACE + IDIFF + 1 IPL = IPLOC(IPLACE,SX,IX) 20032 NP = ABS(IX(LMX-1)) GO TO 20036 20035 IF (ILAST.EQ.IEND) GO TO 20037 20036 ILAST = MIN(IEND,NP*LPG+LL-2) C C THE VIRTUAL END OF THE DATA FOR THIS PAGE IS ILAST. C IL = IPLOC(ILAST,SX,IX) IL = MIN(IL,LMX-2) C C THE RELATIVE END OF DATA FOR THIS PAGE IS IL. C SEARCH FOR A NONZERO VALUE WITH AN INDEX .GT. I ON THE PRESENT C PAGE. C 20038 IF (.NOT.(.NOT.(IPL.GE.IL.OR.(IX(IPL).GT.I.AND.SX(IPL).NE.ZERO)))) * GO TO 20039 IPL=IPL+1 GO TO 20038 C C TEST IF WE HAVE FOUND THE NEXT NONZERO. C 20039 IF (.NOT.(IX(IPL).GT.I .AND. SX(IPL).NE.ZERO .AND. IPL.LE.IL)) GO *TO 20040 I = IX(IPL) XVAL = SX(IPL) IPLACE = (NP-1)*LPG + IPL RETURN C C UPDATE TO SCAN THE NEXT PAGE. 20040 IPL = LL + 1 NP = NP + 1 GO TO 20035 C C NO DATA WAS FOUND. END OF VECTOR ENCOUNTERED. C 20037 I = 0 XVAL = ZERO IL = IL + 1 IF(IL.EQ.LMX-1) IL = IL + 2 C C IF A NEW ITEM WOULD BE INSERTED, IPLACE POINTS TO THE PLACE C TO PUT IT. C IPLACE = (NP-1)*LPG + IL RETURN C C SEARCH A ROW FOR THE NEXT NONZERO. C FIND ELEMENT J=ABS(IRCX) IN ROWS ABS(I)+1,...,L. C 20014 I=ABS(I) C C CHECK FOR END OF VECTOR. C IF (.NOT.(I.EQ.L)) GO TO 20043 I=0 XVAL=ZERO RETURN 20043 I1 = I+1 II=I1 N20046=L GO TO 20047 20046 II=II+1 20047 IF ((N20046-II).LT.0) GO TO 20048 C C INITIALIZE IPPLOC FOR ORTHOGONAL SCAN. C LOOK FOR J AS A SUBSCRIPT IN ROWS II, II=I+1,...,L. C IF (.NOT.(II.EQ.1)) GO TO 20050 IPPLOC = LL + 1 GO TO 20051 20050 IPPLOC = IX(II+3) + 1 20051 IEND = IX(II+4) C C SCAN THROUGH SEVERAL PAGES, IF NECESSARY, TO FIND MATRIX ENTRY. C IPL = IPLOC(IPPLOC,SX,IX) C C FIX UP IPPLOC AND IPL TO POINT TO MATRIX DATA. C IDIFF = LMX - IPL IF (.NOT.(IDIFF.LE.1.AND.IX(LMX-1).GT.0)) GO TO 20053 IPPLOC = IPPLOC + IDIFF + 1 IPL = IPLOC(IPPLOC,SX,IX) 20053 NP = ABS(IX(LMX-1)) GO TO 20057 20056 IF (ILAST.EQ.IEND) GO TO 20058 20057 ILAST = MIN(IEND,NP*LPG+LL-2) IL = IPLOC(ILAST,SX,IX) IL = MIN(IL,LMX-2) 20059 IF (.NOT.(.NOT.(IPL.GE.IL .OR. IX(IPL).GE.J))) GO TO 20060 IPL=IPL+1 GO TO 20059 C C TEST IF WE HAVE FOUND THE NEXT NONZERO. C 20060 IF (.NOT.(IX(IPL).EQ.J .AND. SX(IPL).NE.ZERO .AND. IPL.LE.IL)) GO *TO 20061 I = II XVAL = SX(IPL) RETURN 20061 IF(IX(IPL).GE.J) ILAST = IEND IPL = LL + 1 NP = NP + 1 GO TO 20056 20058 GO TO 20046 C C ORTHOGONAL SCAN FAILED. THE VALUE J WAS NOT A SUBSCRIPT C IN ANY ROW. C 20048 I=0 XVAL=ZERO RETURN END