mirror of
https://git.planet-casio.com/Lephenixnoir/OpenLibm.git
synced 2025-01-01 06:23:39 +01:00
105 lines
3 KiB
Fortran
105 lines
3 KiB
Fortran
*DECK DPINTM
|
|
SUBROUTINE DPINTM (M, N, SX, IX, LMX, IPAGEF)
|
|
C***BEGIN PROLOGUE DPINTM
|
|
C***SUBSIDIARY
|
|
C***PURPOSE Subsidiary to DSPLP
|
|
C***LIBRARY SLATEC
|
|
C***TYPE DOUBLE PRECISION (PINITM-S, DPINTM-D)
|
|
C***AUTHOR Hanson, R. J., (SNLA)
|
|
C Wisniewski, J. A., (SNLA)
|
|
C***DESCRIPTION
|
|
C
|
|
C DPINTM LIMITS THE TYPE OF STORAGE TO A SEQUENTIAL SCHEME.
|
|
C THE MATRIX IS STORED BY COLUMNS.
|
|
C SPARSE MATRIX INITIALIZATION SUBROUTINE.
|
|
C
|
|
C M=NUMBER OF ROWS OF THE MATRIX.
|
|
C N=NUMBER OF COLUMNS OF THE MATRIX.
|
|
C SX(*),IX(*)=THE WORK ARRAYS WHICH ARE USED TO STORE THE SPARSE
|
|
C MATRIX. THESE ARRAYS ARE AUTOMATICALLY MAINTAINED BY
|
|
C THE PACKAGE FOR THE USER.
|
|
C LMX=LENGTH OF THE WORK ARRAY SX(*).
|
|
C LMX MUST BE AT LEAST N+7 WHERE
|
|
C FOR GREATEST EFFICIENCY LMX SHOULD BE AT LEAST N+NZ+6
|
|
C WHERE NZ IS THE MAXIMUM NUMBER OF NONZEROES TO BE
|
|
C STORED IN THE MATRIX. VALUES OF LMX BETWEEN N+7 AND
|
|
C N+NZ+6 WILL CAUSE DEMAND PAGING TO OCCUR.
|
|
C THIS IS IMPLEMENTED BY THE PACKAGE.
|
|
C IX(*) MUST BE DIMENSIONED AT LEAST LMX
|
|
C IPAGEF=UNIT NUMBER WHERE DEMAND PAGES WILL BE STORED.
|
|
C
|
|
C THIS SUBROUTINE IS A MODIFICATION OF THE SUBROUTINE LINITM,
|
|
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 XERMSG
|
|
C***REVISION HISTORY (YYMMDD)
|
|
C 811215 DATE WRITTEN
|
|
C 890831 Modified array declarations. (WRB)
|
|
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 910403 Updated AUTHOR and DESCRIPTION sections. (WRB)
|
|
C***END PROLOGUE DPINTM
|
|
DOUBLE PRECISION SX(*),ZERO,ONE
|
|
DIMENSION IX(*)
|
|
SAVE ZERO, ONE
|
|
DATA ZERO,ONE /0.D0,1.D0/
|
|
C***FIRST EXECUTABLE STATEMENT DPINTM
|
|
IOPT=1
|
|
C
|
|
C CHECK FOR INPUT ERRORS.
|
|
C
|
|
IF (.NOT.(M.LE.0 .OR. N.LE.0)) GO TO 20002
|
|
NERR=55
|
|
CALL XERMSG ('SLATEC', 'DPINTM',
|
|
+ 'MATRIX DIMENSION M OR N .LE. 0', NERR, IOPT)
|
|
C
|
|
C VERIFY IF VALUE OF LMX IS LARGE ENOUGH.
|
|
C
|
|
20002 IF (.NOT.(LMX.LT.N+7)) GO TO 20005
|
|
NERR=55
|
|
CALL XERMSG ('SLATEC', 'DPINTM',
|
|
+ 'THE VALUE OF LMX IS TOO SMALL', NERR, IOPT)
|
|
C
|
|
C INITIALIZE DATA STRUCTURE INDEPENDENT VALUES.
|
|
C
|
|
20005 SX(1)=ZERO
|
|
SX(2)=ZERO
|
|
SX(3)=IPAGEF
|
|
IX(1)=LMX
|
|
IX(2)=M
|
|
IX(3)=N
|
|
IX(4)=0
|
|
SX(LMX-1)=ZERO
|
|
SX(LMX)=-ONE
|
|
IX(LMX-1)=-1
|
|
LP4=N+4
|
|
C
|
|
C INITIALIZE DATA STRUCTURE DEPENDENT VALUES.
|
|
C
|
|
I=4
|
|
N20008=LP4
|
|
GO TO 20009
|
|
20008 I=I+1
|
|
20009 IF ((N20008-I).LT.0) GO TO 20010
|
|
SX(I)=ZERO
|
|
GO TO 20008
|
|
20010 I=5
|
|
N20012=LP4
|
|
GO TO 20013
|
|
20012 I=I+1
|
|
20013 IF ((N20012-I).LT.0) GO TO 20014
|
|
IX(I)=LP4
|
|
GO TO 20012
|
|
20014 SX(N+5)=ZERO
|
|
IX(N+5)=0
|
|
IX(LMX)=0
|
|
C
|
|
C INITIALIZATION COMPLETE.
|
|
C
|
|
RETURN
|
|
END
|