*DECK PRWPGE SUBROUTINE PRWPGE (KEY, IPAGE, LPG, SX, IX) C***BEGIN PROLOGUE PRWPGE C***SUBSIDIARY C***PURPOSE Subsidiary to SPLP C***LIBRARY SLATEC C***TYPE SINGLE PRECISION (PRWPGE-S, DPRWPG-D) C***AUTHOR Hanson, R. J., (SNLA) C Wisniewski, J. A., (SNLA) C***DESCRIPTION C C PRWPGE LIMITS THE TYPE OF STORAGE TO A SEQUENTIAL SCHEME. C VIRTUAL MEMORY PAGE READ/WRITE SUBROUTINE. C C DEPENDING ON THE VALUE OF KEY, SUBROUTINE PRWPGE() PERFORMS A PAGE C READ OR WRITE OF PAGE IPAGE. THE PAGE HAS LENGTH LPG. C C KEY IS A FLAG INDICATING WHETHER A PAGE READ OR WRITE IS C TO BE PERFORMED. C IF KEY = 1 DATA IS READ. C IF KEY = 2 DATA IS WRITTEN. C IPAGE IS THE PAGE NUMBER OF THE MATRIX TO BE ACCESSED. C LPG IS THE LENGTH OF THE PAGE OF THE MATRIX TO BE ACCESSED. C SX(*),IX(*) IS THE MATRIX TO BE ACCESSED. C C THIS SUBROUTINE IS A MODIFICATION OF THE SUBROUTINE LRWPGE, 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 PRWVIR, XERMSG C***REVISION HISTORY (YYMMDD) C 811215 DATE WRITTEN 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 900510 Fixed error messages and replaced GOTOs with C IF-THEN-ELSE. (RWC) C 910403 Updated AUTHOR and DESCRIPTION sections. (WRB) C***END PROLOGUE PRWPGE REAL SX(*) DIMENSION IX(*) C***FIRST EXECUTABLE STATEMENT PRWPGE C C CHECK IF IPAGE IS IN RANGE. C IF (IPAGE.LT.1) THEN CALL XERMSG ('SLATEC', 'PRWPGE', + 'THE VALUE OF IPAGE (PAGE NUMBER) WAS NOT IN THE RANGE' // + '1.LE.IPAGE.LE.MAXPGE.', 55, 1) ENDIF C C CHECK IF LPG IS POSITIVE. C IF (LPG.LE.0) THEN CALL XERMSG ('SLATEC', 'PRWPGE', + 'THE VALUE OF LPG (PAGE LENGTH) WAS NONPOSITIVE.', 55, 1) ENDIF C C DECIDE IF WE ARE READING OR WRITING. C IF (KEY.EQ.1) THEN C C CODE TO DO A PAGE READ. C CALL PRWVIR(KEY,IPAGE,LPG,SX,IX) ELSE IF (KEY.EQ.2) THEN C C CODE TO DO A PAGE WRITE. C CALL PRWVIR(KEY,IPAGE,LPG,SX,IX) ELSE CALL XERMSG ('SLATEC', 'PRWPGE', + 'THE VALUE OF KEY (READ-WRITE FLAG) WAS NOT 1 OR 2.', 55, 1) ENDIF RETURN END