Quellcode-Bibliothek

^© Kompilation durch diese Firma

[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]

Datei: snrm2.cob Sprache: Cobol

Original von: verschiedene^©

       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.19 Sekunden (vorverarbeitet) ¤

Download des Quellennavigators
Download des sprechenden Kalenders
in der Quellcodebibliothek suchen

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.