OpenLibm/slatec/wnlt2.f
Viral B. Shah c977aa998f Add Makefile.extras to build libopenlibm-extras.
Replace amos with slatec
2012-12-31 16:37:05 -05:00

58 lines
1.8 KiB
Fortran

*DECK WNLT2
LOGICAL FUNCTION WNLT2 (ME, MEND, IR, FACTOR, TAU, SCALE, WIC)
C***BEGIN PROLOGUE WNLT2
C***SUBSIDIARY
C***PURPOSE Subsidiary to WNLIT
C***LIBRARY SLATEC
C***TYPE SINGLE 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 WNILT
C***ROUTINES CALLED (NONE)
C***REVISION HISTORY (YYMMDD)
C 790701 DATE WRITTEN
C 890620 Code extracted from WNLIT and made a subroutine. (RWC))
C***END PROLOGUE WNLT2
REAL FACTOR, SCALE(*), TAU, WIC(*)
INTEGER IR, ME, MEND
C
REAL RN, SN, T
INTEGER J
C
C***FIRST EXECUTABLE STATEMENT WNLT2
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
WNLT2 = RN .GT. SN*TAU**2
RETURN
END