mirror of
https://git.planet-casio.com/Lephenixnoir/OpenLibm.git
synced 2025-01-01 06:23:39 +01:00
65 lines
2 KiB
Fortran
65 lines
2 KiB
Fortran
*DECK PRWVIR
|
|
SUBROUTINE PRWVIR (KEY, IPAGE, LPG, SX, IX)
|
|
C***BEGIN PROLOGUE PRWVIR
|
|
C***SUBSIDIARY
|
|
C***PURPOSE Subsidiary to SPLP
|
|
C***LIBRARY SLATEC
|
|
C***TYPE SINGLE PRECISION (PRWVIR-S, DPRWVR-D)
|
|
C***AUTHOR Hanson, R. J., (SNLA)
|
|
C Wisniewski, J. A., (SNLA)
|
|
C***DESCRIPTION
|
|
C
|
|
C PRWVIR LIMITS THE TYPE OF STORAGE TO A SEQUENTIAL SPARSE MATRIX
|
|
C STORAGE SCHEME. THE PAGE STORAGE IS ON RANDOM ACCESS DISK.
|
|
C PRWVIR IS PART OF THE SPARSE LP PACKAGE, SPLP.
|
|
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 SPLP
|
|
C***ROUTINES CALLED SOPENM, SREADP, SWRITP
|
|
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 PRWVIR
|
|
DIMENSION IX(*)
|
|
REAL SX(*),ZERO,ONE
|
|
LOGICAL FIRST
|
|
SAVE ZERO, ONE
|
|
DATA ZERO,ONE/0.E0,1.E0/
|
|
C***FIRST EXECUTABLE STATEMENT PRWVIR
|
|
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 SREADP(IPAGEF,IX(ISTART),SX(ISTART),LPG,IADDR)
|
|
GO TO 20006
|
|
20005 IF (.NOT.(KEY.EQ.2)) GO TO 10001
|
|
CALL SWRITP(IPAGEF,IX(ISTART),SX(ISTART),LPG,IADDR)
|
|
10001 CONTINUE
|
|
20006 RETURN
|
|
END
|