| 1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465 |
- *DECK DPRWVR
- SUBROUTINE DPRWVR (KEY, IPAGE, LPG, SX, IX)
- C***BEGIN PROLOGUE DPRWVR
- C***SUBSIDIARY
- C***PURPOSE Subsidiary to DSPLP
- C***LIBRARY SLATEC
- C***TYPE DOUBLE PRECISION (PRWVIR-S, DPRWVR-D)
- C***AUTHOR Hanson, R. J., (SNLA)
- C Wisniewski, J. A., (SNLA)
- C***DESCRIPTION
- C
- C DPRWVR LIMITS THE TYPE OF STORAGE TO A SEQUENTIAL SPARSE MATRIX
- C STORAGE SCHEME. THE PAGE STORAGE IS ON RANDOM ACCESS DISK.
- C DPRWVR IS PART OF THE SPARSE LP PACKAGE, DSPLP.
- C
- C KEY IS A FLAG WHICH INDICATES WHETHER A READ OR WRITE
- C OPERATION IS TO BE PERFORMED. A VALUE OF KEY=1 INDICATES
- C A READ. A VALUE OF KEY=2 INDICATES A WRITE.
- C IPAGE IS THE PAGE OF MATRIX MN WE ARE ACCESSING.
- C LPG IS THE LENGTH OF THE PAGE.
- C SX(*),IX(*) IS THE MATRIX DATA.
- C
- C THIS SUBROUTINE IS A MODIFICATION OF THE SUBROUTINE LRWVIR,
- C SANDIA LABS. REPT. SAND78-0785.
- C MODIFICATIONS BY K.L. HIEBERT AND R.J. HANSON
- C
- C***SEE ALSO DSPLP
- C***ROUTINES CALLED DREADP, DWRITP, SOPENM
- C***REVISION HISTORY (YYMMDD)
- C 811215 DATE WRITTEN
- C 891009 Removed unreferenced variables. (WRB)
- C 891214 Prologue converted to Version 4.0 format. (BAB)
- C 900328 Added TYPE section. (WRB)
- C 910403 Updated AUTHOR and DESCRIPTION sections. (WRB)
- C***END PROLOGUE DPRWVR
- DIMENSION IX(*)
- DOUBLE PRECISION SX(*),ZERO,ONE
- LOGICAL FIRST
- SAVE ZERO, ONE
- DATA ZERO,ONE/0.D0,1.D0/
- C***FIRST EXECUTABLE STATEMENT DPRWVR
- C
- C COMPUTE STARTING ADDRESS OF PAGE.
- C
- IPAGEF=SX(3)
- ISTART = IX(3) + 5
- C
- C OPEN RANDOM ACCESS FILE NUMBER IPAGEF, IF FIRST PAGE WRITE.
- C
- FIRST=SX(4).EQ.ZERO
- IF (.NOT.(FIRST)) GO TO 20002
- CALL SOPENM(IPAGEF,LPG)
- SX(4)=ONE
- C
- C PERFORM EITHER A READ OR A WRITE.
- C
- 20002 IADDR = 2*IPAGE - 1
- IF (.NOT.(KEY.EQ.1)) GO TO 20005
- CALL DREADP(IPAGEF,IX(ISTART),SX(ISTART),LPG,IADDR)
- GO TO 20006
- 20005 IF (.NOT.(KEY.EQ.2)) GO TO 10001
- CALL DWRITP(IPAGEF,IX(ISTART),SX(ISTART),LPG,IADDR)
- 10001 CONTINUE
- 20006 RETURN
- END
|
