mirror of
https://git.planet-casio.com/Lephenixnoir/OpenLibm.git
synced 2025-01-01 06:23:39 +01:00
59 lines
1.9 KiB
Fortran
59 lines
1.9 KiB
Fortran
*DECK DWNLT2
|
|
LOGICAL FUNCTION DWNLT2 (ME, MEND, IR, FACTOR, TAU, SCALE, WIC)
|
|
C***BEGIN PROLOGUE DWNLT2
|
|
C***SUBSIDIARY
|
|
C***PURPOSE Subsidiary to WNLIT
|
|
C***LIBRARY SLATEC
|
|
C***TYPE DOUBLE PRECISION (WNLT2-S, DWNLT2-D)
|
|
C***AUTHOR Hanson, R. J., (SNLA)
|
|
C Haskell, K. H., (SNLA)
|
|
C***DESCRIPTION
|
|
C
|
|
C To test independence of incoming column.
|
|
C
|
|
C Test the column IC to determine if it is linearly independent
|
|
C of the columns already in the basis. In the initial tri. step,
|
|
C we usually want the heavy weight ALAMDA to be included in the
|
|
C test for independence. In this case, the value of FACTOR will
|
|
C have been set to 1.E0 before this procedure is invoked.
|
|
C In the potentially rank deficient problem, the value of FACTOR
|
|
C will have been set to ALSQ=ALAMDA**2 to remove the effect of the
|
|
C heavy weight from the test for independence.
|
|
C
|
|
C Write new column as partitioned vector
|
|
C (A1) number of components in solution so far = NIV
|
|
C (A2) M-NIV components
|
|
C And compute SN = inverse weighted length of A1
|
|
C RN = inverse weighted length of A2
|
|
C Call the column independent when RN .GT. TAU*SN
|
|
C
|
|
C***SEE ALSO DWNLIT
|
|
C***ROUTINES CALLED (NONE)
|
|
C***REVISION HISTORY (YYMMDD)
|
|
C 790701 DATE WRITTEN
|
|
C 890620 Code extracted from WNLIT and made a subroutine. (RWC))
|
|
C 900604 DP version created from SP version. (RWC)
|
|
C***END PROLOGUE DWNLT2
|
|
DOUBLE PRECISION FACTOR, SCALE(*), TAU, WIC(*)
|
|
INTEGER IR, ME, MEND
|
|
C
|
|
DOUBLE PRECISION RN, SN, T
|
|
INTEGER J
|
|
C
|
|
C***FIRST EXECUTABLE STATEMENT DWNLT2
|
|
SN = 0.E0
|
|
RN = 0.E0
|
|
DO 10 J=1,MEND
|
|
T = SCALE(J)
|
|
IF (J.LE.ME) T = T/FACTOR
|
|
T = T*WIC(J)**2
|
|
C
|
|
IF (J.LT.IR) THEN
|
|
SN = SN + T
|
|
ELSE
|
|
RN = RN + T
|
|
ENDIF
|
|
10 CONTINUE
|
|
DWNLT2 = RN .GT. SN*TAU**2
|
|
RETURN
|
|
END
|