mirror of
https://git.planet-casio.com/Lephenixnoir/OpenLibm.git
synced 2025-01-01 06:23:39 +01:00
69 lines
1.9 KiB
Fortran
69 lines
1.9 KiB
Fortran
*DECK USRMAT
|
|
SUBROUTINE USRMAT (I, J, AIJ, INDCAT, PRGOPT, DATTRV, IFLAG)
|
|
C***BEGIN PROLOGUE USRMAT
|
|
C***SUBSIDIARY
|
|
C***PURPOSE Subsidiary to SPLP
|
|
C***LIBRARY SLATEC
|
|
C***TYPE SINGLE PRECISION (USRMAT-S, DUSRMT-D)
|
|
C***AUTHOR (UNKNOWN)
|
|
C***DESCRIPTION
|
|
C
|
|
C The user may supply this code
|
|
C
|
|
C***SEE ALSO SPLP
|
|
C***ROUTINES CALLED (NONE)
|
|
C***REVISION HISTORY (YYMMDD)
|
|
C 811215 DATE WRITTEN
|
|
C 891214 Prologue converted to Version 4.0 format. (BAB)
|
|
C 900328 Added TYPE section. (WRB)
|
|
C***END PROLOGUE USRMAT
|
|
DIMENSION PRGOPT(*),DATTRV(*),IFLAG(10)
|
|
C
|
|
C***FIRST EXECUTABLE STATEMENT USRMAT
|
|
IF(IFLAG(1).EQ.1) THEN
|
|
C
|
|
C THIS IS THE INITIALIZATION STEP. THE VALUES OF IFLAG(K),K=2,3,4,
|
|
C ARE RESPECTIVELY THE COLUMN INDEX, THE ROW INDEX (OR THE NEXT COL.
|
|
C INDEX), AND THE POINTER TO THE MATRIX ENTRY'S VALUE WITHIN
|
|
C DATTRV(*). ALSO CHECK (DATTRV(1)=0.) SIGNIFYING NO DATA.
|
|
IF(DATTRV(1).EQ.0.) THEN
|
|
I = 0
|
|
J = 0
|
|
IFLAG(1) = 3
|
|
ELSE
|
|
IFLAG(2)=-DATTRV(1)
|
|
IFLAG(3)= DATTRV(2)
|
|
IFLAG(4)= 3
|
|
ENDIF
|
|
C
|
|
RETURN
|
|
ELSE
|
|
J=IFLAG(2)
|
|
I=IFLAG(3)
|
|
L=IFLAG(4)
|
|
IF(I.EQ.0) THEN
|
|
C
|
|
C SIGNAL THAT ALL OF THE NONZERO ENTRIES HAVE BEEN DEFINED.
|
|
IFLAG(1)=3
|
|
RETURN
|
|
ELSE IF(I.LT.0) THEN
|
|
C
|
|
C SIGNAL THAT A SWITCH IS MADE TO A NEW COLUMN.
|
|
J=-I
|
|
I=DATTRV(L)
|
|
L=L+1
|
|
ENDIF
|
|
C
|
|
AIJ=DATTRV(L)
|
|
C
|
|
C UPDATE THE INDICES AND POINTERS FOR THE NEXT ENTRY.
|
|
IFLAG(2)=J
|
|
IFLAG(3)=DATTRV(L+1)
|
|
IFLAG(4)=L+2
|
|
C
|
|
C INDCAT=0 DENOTES THAT ENTRIES OF THE MATRIX ARE ASSIGNED THE
|
|
C VALUES FROM DATTRV(*). NO ACCUMULATION IS PERFORMED.
|
|
INDCAT=0
|
|
RETURN
|
|
ENDIF
|
|
END
|