| 7666 | } /* dger_ */ |
| 7667 | |
| 7668 | doublereal dnrm2_(integer *n, doublereal *x, integer *incx) |
| 7669 | { |
| 7670 | /* System generated locals */ |
| 7671 | integer i__1, i__2; |
| 7672 | doublereal ret_val, d__1; |
| 7673 | |
| 7674 | /* Local variables */ |
| 7675 | static integer ix; |
| 7676 | static doublereal ssq, norm, scale, absxi; |
| 7677 | |
| 7678 | |
| 7679 | /* |
| 7680 | Purpose |
| 7681 | ======= |
| 7682 | |
| 7683 | DNRM2 returns the euclidean norm of a vector via the function |
| 7684 | name, so that |
| 7685 | |
| 7686 | DNRM2 := sqrt( x'*x ) |
| 7687 | |
| 7688 | Further Details |
| 7689 | =============== |
| 7690 | |
| 7691 | -- This version written on 25-October-1982. |
| 7692 | Modified on 14-October-1993 to inline the call to DLASSQ. |
| 7693 | Sven Hammarling, Nag Ltd. |
| 7694 | |
| 7695 | ===================================================================== |
| 7696 | */ |
| 7697 | |
| 7698 | /* Parameter adjustments */ |
| 7699 | --x; |
| 7700 | |
| 7701 | /* Function Body */ |
| 7702 | if (*n < 1 || *incx < 1) { |
| 7703 | norm = 0.; |
| 7704 | } else if (*n == 1) { |
| 7705 | norm = abs(x[1]); |
| 7706 | } else { |
| 7707 | scale = 0.; |
| 7708 | ssq = 1.; |
| 7709 | /* |
| 7710 | The following loop is equivalent to this call to the LAPACK |
| 7711 | auxiliary routine: |
| 7712 | CALL DLASSQ( N, X, INCX, SCALE, SSQ ) |
| 7713 | */ |
| 7714 | |
| 7715 | i__1 = (*n - 1) * *incx + 1; |
| 7716 | i__2 = *incx; |
| 7717 | for (ix = 1; i__2 < 0 ? ix >= i__1 : ix <= i__1; ix += i__2) { |
| 7718 | if (x[ix] != 0.) { |
| 7719 | absxi = (d__1 = x[ix], abs(d__1)); |
| 7720 | if (scale < absxi) { |
| 7721 | /* Computing 2nd power */ |
| 7722 | d__1 = scale / absxi; |
| 7723 | ssq = ssq * (d__1 * d__1) + 1.; |
| 7724 | scale = absxi; |
| 7725 | } else { |