mirror of
https://git.planet-casio.com/Lephenixnoir/OpenLibm.git
synced 2025-01-01 06:23:39 +01:00
79 lines
2.5 KiB
Fortran
79 lines
2.5 KiB
Fortran
*DECK DPRWPG
|
|
SUBROUTINE DPRWPG (KEY, IPAGE, LPG, SX, IX)
|
|
C***BEGIN PROLOGUE DPRWPG
|
|
C***SUBSIDIARY
|
|
C***PURPOSE Subsidiary to DSPLP
|
|
C***LIBRARY SLATEC
|
|
C***TYPE DOUBLE PRECISION (PRWPGE-S, DPRWPG-D)
|
|
C***AUTHOR Hanson, R. J., (SNLA)
|
|
C Wisniewski, J. A., (SNLA)
|
|
C***DESCRIPTION
|
|
C
|
|
C DPRWPG 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 DPRWPG() 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 DSPLP
|
|
C***ROUTINES CALLED DPRWVR, 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 DPRWPG
|
|
DOUBLE PRECISION SX(*)
|
|
DIMENSION IX(*)
|
|
C***FIRST EXECUTABLE STATEMENT DPRWPG
|
|
C
|
|
C CHECK IF IPAGE IS IN RANGE.
|
|
C
|
|
IF (IPAGE.LT.1) THEN
|
|
CALL XERMSG ('SLATEC', 'DPRWPG',
|
|
+ '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', 'DPRWPG',
|
|
+ '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 DPRWVR(KEY,IPAGE,LPG,SX,IX)
|
|
ELSE IF (KEY.EQ.2) THEN
|
|
C
|
|
C CODE TO DO A PAGE WRITE.
|
|
C
|
|
CALL DPRWVR(KEY,IPAGE,LPG,SX,IX)
|
|
ELSE
|
|
CALL XERMSG ('SLATEC', 'DPRWPG',
|
|
+ 'THE VALUE OF KEY (READ-WRITE FLAG) WAS NOT 1 OR 2.', 55, 1)
|
|
ENDIF
|
|
RETURN
|
|
END
|