relibc_openlibm/slatec/dprwpg.f

*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