| 10571 | } /* dzasum_ */ |
| 10572 | |
| 10573 | doublereal dznrm2_(integer *n, doublecomplex *x, integer *incx) |
| 10574 | { |
| 10575 | /* System generated locals */ |
| 10576 | integer i__1, i__2, i__3; |
| 10577 | doublereal ret_val, d__1; |
| 10578 | |
| 10579 | /* Local variables */ |
| 10580 | static integer ix; |
| 10581 | static doublereal ssq, temp, norm, scale; |
| 10582 | |
| 10583 | |
| 10584 | /* |
| 10585 | Purpose |
| 10586 | ======= |
| 10587 | |
| 10588 | DZNRM2 returns the euclidean norm of a vector via the function |
| 10589 | name, so that |
| 10590 | |
| 10591 | DZNRM2 := sqrt( conjg( x' )*x ) |
| 10592 | |
| 10593 | Further Details |
| 10594 | =============== |
| 10595 | |
| 10596 | -- This version written on 25-October-1982. |
| 10597 | Modified on 14-October-1993 to inline the call to ZLASSQ. |
| 10598 | Sven Hammarling, Nag Ltd. |
| 10599 | |
| 10600 | ===================================================================== |
| 10601 | */ |
| 10602 | |
| 10603 | /* Parameter adjustments */ |
| 10604 | --x; |
| 10605 | |
| 10606 | /* Function Body */ |
| 10607 | if (*n < 1 || *incx < 1) { |
| 10608 | norm = 0.; |
| 10609 | } else { |
| 10610 | scale = 0.; |
| 10611 | ssq = 1.; |
| 10612 | /* |
| 10613 | The following loop is equivalent to this call to the LAPACK |
| 10614 | auxiliary routine: |
| 10615 | CALL ZLASSQ( N, X, INCX, SCALE, SSQ ) |
| 10616 | */ |
| 10617 | |
| 10618 | i__1 = (*n - 1) * *incx + 1; |
| 10619 | i__2 = *incx; |
| 10620 | for (ix = 1; i__2 < 0 ? ix >= i__1 : ix <= i__1; ix += i__2) { |
| 10621 | i__3 = ix; |
| 10622 | if (x[i__3].r != 0.) { |
| 10623 | i__3 = ix; |
| 10624 | temp = (d__1 = x[i__3].r, abs(d__1)); |
| 10625 | if (scale < temp) { |
| 10626 | /* Computing 2nd power */ |
| 10627 | d__1 = scale / temp; |
| 10628 | ssq = ssq * (d__1 * d__1) + 1.; |
| 10629 | scale = temp; |
| 10630 | } else { |