|
identification division.
program-id. snrm2.
* aus Pomberger, Dobler
* Algorithmen und Datenstrukturen, p91
author. "JD".
date-written. 3.6.2008.
date-compiled.
data division.
working-storage section.
*DECK SNRM2
* REAL FUNCTION SNRM2 (N, SX, INCX)
****BEGIN PROLOGUE SNRM2
****PURPOSE Compute the Euclidean length (L2 norm) of a vector.
****LIBRARY SLATEC (BLAS)
****CATEGORY D1A3B
****TYPE SINGLE PRECISION (SNRM2-S, DNRM2-D, SCNRM2-C)
****KEYWORDS BLAS, EUCLIDEAN LENGTH, EUCLIDEAN NORM, L2,
* LINEAR ALGEBRA, UNITARY, VECTOR
****AUTHOR Lawson, C. L., (JPL)
* Hanson, R. J., (SNLA)
* Kincaid, D. R., (U. of Texas)
* Krogh, F. T., (JPL)
****DESCRIPTION
*
* B L A S Subprogram
* Description of Parameters
*
* --Input--
* N number of elements in input vector(s)
* SX single precision vector with N elements
* INCX storage spacing between elements of SX
*
* --Output--
* SNRM2 single precision result (zero if N .LE. 0)
*
* Euclidean norm of the N-vector stored in SX with storage
* increment INCX .
* If N .LE. 0, return with result = 0.
* If N .GE. 1, then INCX must be .GE. 1
*
* Four Phase Method using two built-in constants that are
* hopefully applicable to all machines.
* *UTLO = maximum of SQRT(U/EPS) over all known machines
* *UTHI = minimum of SQRT(V) over all known machines
* where
* EPS = smallest no. such that EPS + 1. .GT. 1.
* U = smallest positive no. (underflow limit)
* V = largest no. (overflow limit)
*
* Brief Outline of Algorithm.
*
* Phase 1 scans zero components.
* Move to phase 2 when a component is nonzero and .LE. CUTLO
* Move to phase 3 when a component is .GT. CUTLO
* Move to phase 4 when a component is .GE. CUTHI/M
* where M = N for X() real and M = 2*N for complex.
*
* Values for CUTLO and CUTHI.
* From the environmental parameters listed in the IMSL convert
* document the limiting values are as follows:
* CUTLO, S.P. U/EPS = 2**(-102) for Honeywell. Close secon
* Univac and DEC at 2**(-103)
* Thus CUTLO = 2**(-51) = 4.44089E-16
* CUTHI, S.P. V = 2**127 for Univac, Honeywell, and DEC.
* Thus CUTHI = 2**(63.5) = 1.30438E19
* CUTLO, D.P. U/EPS = 2**(-67) for Honeywell and DEC.
* Thus CUTLO = 2**(-33.5) = 8.23181D-11
* CUTHI, D.P. same as S.P. CUTHI = 1.30438D19
* DATA CUTLO, CUTHI /8.232D-11, 1.304D19/
* DATA CUTLO, CUTHI /4.441E-16, 1.304E19/
*
****REFERENCES C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T
* Krogh, Basic linear algebra subprograms for Fort
* usage, Algorithm No. 539, Transactions on Mathem
* Software 5, 3 (September 1979), pp. 308-323.
****ROUTINES CALLED (NONE)
****REVISION HISTORY (YYMMDD)
* 791001 DATE WRITTEN
* 890531 Changed all specific intrinsics to generic. (WRB)
* 890831 Modified array declarations. (WRB)
* 890831 REVISION DATE from Version 3.2
* 891214 Prologue converted to Version 4.0 format. (BAB)
* 920501 Reformatted the REFERENCES section. (WRB)
****END PROLOGUE SNRM2
78 ZEROX PIC S9(8)V9(4) VALUE 0.0E0.
78 ONE PIC S9(8)V9(4) VALUE 1.0E0.
78 STAR PIC S9(8) VALUE 1000.
77 NEXXT PIC S9(4).
77 SX PIC S9(8)V9(4) OCCURS STAR.
77 CUTLO PIC S9(8)V9(4) VALUE 4.441E-16.
77 CUTHI PIC S9(8)V9(4) VALUE 1.304E19.
77 HITEST PIC S9(8)V9(4).
77 SUMME PIC S9(8)V9(4).
77 XMAX PIC S9(8)V9(4).
77 SAVE PIC S9(8)V9(4).
*
* DATA CUTLO, CUTHI /4.441E-16, 1.304E19/
****FIRST EXECUTABLE STATEMENT SNRM2
PROCEDURE DIVISION.
IF (N > 0) GO TO L10
COMPUTE SNRM2 = ZERO
GO TO L300.
*
L10.
MOVE 30 TO NEXXT
COMPUTE SUMME = ZEROX
COMPUTE NN = N * INCX
*
* BEGIN MAIN LOOP
*
COMPUTE I = 1
L20.
GO TO L30, L50, L70, L110 DEPENDING ON NEXXT.
L30.
IF (FUNCTION ABS(SX(I)) > CUTLO) GO TO L85
MOVE 50 TO NEXXT
COMPUTE XMAX = ZERO
*
* PHASE 1. SUMME IS ZERO
*
L50.
IF (SX(I) = ZERO) GO TO L200
IF (ABS(SX(I)) > CUTLO) GO TO L85.
*
* PREPARE FOR PHASE 2.
*
MOVE 70 TO NEXXT
GO TO L105
*
* PREPARE FOR PHASE 4.
*
L100.
COMPUTE I = J
MOVE L110 TO NEXXT
COMPUTE SUMME = (SUMME / SX(I)) / SX(I)
L105.
COMPUTE XMAX = ABS(SX(I))
GO TO L115
*
* PHASE 2. SUM IS SMALL.
* SCALE TO AVOID DESTRUCTIVE UNDERFLOW
*
L70.
IF (ABS(SX(I)) > CUTLO) GO TO L75
*
* *OMMON CODE FOR PHASES 2 AND 4.
* IN PHASE 4 SUM IS LARGE. SCALE TO AVOID OVE
*
L110.
IF (ABS(SX(I)) <= XMAX) GO TO L115
COMPUTE SUMME = ONE + SUMME * (XMAX / SX(I))**2
COMPUTE XMAX = ABS(SX(I))
GO TO L200
*
L115.
COMPUTE SUMME = SUMME + (SX(I)/XMAX)**2
GO TO L200
*
* PREPARE FOR PHASE 3.
*
L75.
COMPUTE SUMME = (SUMME * XMAX) * XMAX
*
* FOR REAL OR D.P. SET HITEST = CUTHI/N
* FOR COMPLEX SET HITEST = CUTHI/(2*N)
*
L85.
COMPUTE HITEST = CUTHI / N
*
* PHASE 3. SUM IS MID-RANGE. NO SCALING.
*
PERFORM VARYING J FROM I BY INCX UNTIL J>NN
IF (ABS(SX(J)) >= HITEST) GO TO L100
* L95
COMPUTE SUMME = SUMME + SX(J)**2
END-PERFORM.
COMPUTE SNRM2 = FUNCTION SQRT( SUMME )
GO TO L300
*
L200.
COMPUTE I = I + INCX
IF (I <= NN) GO TO L20
*
* END OF MAIN LOOP.
*
* *OMPUTE SQUARE ROOT AND ADJUST FOR SCALING.
*
COMPUTE SNRM2 = XMAX * FUNCTION SQRT(SUMME)
L300.
GOBACK
END PROGRAM
¤ Dauer der Verarbeitung: 0.40 Sekunden
(vorverarbeitet)
¤
|
Haftungshinweis
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung ist noch experimentell.
|
