zgebal.c

DTMK软件开发包,此为开源软件,是一款很好的医学图像开发资源.

L40:
/*<    >*/
    if (l == 1) {
        goto L210;
    }
/*<       L = L - 1 >*/
    --l;

/*<    50 CONTINUE >*/
L50:
/*<       DO 70 J = L, 1, -1 >*/
    for (j = l; j >= 1; --j) {

/*<          DO 60 I = 1, L >*/
        i__1 = l;
        for (i__ = 1; i__ <= i__1; ++i__) {
/*<    >*/
            if (i__ == j) {
                goto L60;
            }
/*<    >*/
            i__2 = j + i__ * a_dim1;
            if (a[i__2].r != 0. || d_imag(&a[j + i__ * a_dim1]) != 0.) {
                goto L70;
            }
/*<    60    CONTINUE >*/
L60:
            ;
        }

/*<          M = L >*/
        m = l;
/*<          IEXC = 1 >*/
        iexc = 1;
/*<          GO TO 20 >*/
        goto L20;
/*<    70 CONTINUE >*/
L70:
        ;
    }

/*<       GO TO 90 >*/
    goto L90;

/*     Search for columns isolating an eigenvalue and push them left. */

/*<    80 CONTINUE >*/
L80:
/*<       K = K + 1 >*/
    ++k;

/*<    90 CONTINUE >*/
L90:
/*<       DO 110 J = K, L >*/
    i__1 = l;
    for (j = k; j <= i__1; ++j) {

/*<          DO 100 I = K, L >*/
        i__2 = l;
        for (i__ = k; i__ <= i__2; ++i__) {
/*<    >*/
            if (i__ == j) {
                goto L100;
            }
/*<    >*/
            i__3 = i__ + j * a_dim1;
            if (a[i__3].r != 0. || d_imag(&a[i__ + j * a_dim1]) != 0.) {
                goto L110;
            }
/*<   100    CONTINUE >*/
L100:
            ;
        }

/*<          M = K >*/
        m = k;
/*<          IEXC = 2 >*/
        iexc = 2;
/*<          GO TO 20 >*/
        goto L20;
/*<   110 CONTINUE >*/
L110:
        ;
    }

/*<   120 CONTINUE >*/
L120:
/*<       DO 130 I = K, L >*/
    i__1 = l;
    for (i__ = k; i__ <= i__1; ++i__) {
/*<          SCALE( I ) = ONE >*/
        scale[i__] = 1.;
/*<   130 CONTINUE >*/
/* L130: */
    }

/*<    >*/
    if (lsame_(job, "P", (ftnlen)1, (ftnlen)1)) {
        goto L210;
    }

/*     Balance the submatrix in rows K to L. */

/*     Iterative loop for norm reduction */

/*<       SFMIN1 = DLAMCH( 'S' ) / DLAMCH( 'P' ) >*/
    sfmin1 = dlamch_("S", (ftnlen)1) / dlamch_("P", (ftnlen)1);
/*<       SFMAX1 = ONE / SFMIN1 >*/
    sfmax1 = 1. / sfmin1;
/*<       SFMIN2 = SFMIN1*SCLFAC >*/
    sfmin2 = sfmin1 * 8.;
/*<       SFMAX2 = ONE / SFMIN2 >*/
    sfmax2 = 1. / sfmin2;
/*<   140 CONTINUE >*/
L140:
/*<       NOCONV = .FALSE. >*/
    noconv = FALSE_;

/*<       DO 200 I = K, L >*/
    i__1 = l;
    for (i__ = k; i__ <= i__1; ++i__) {
/*<          C = ZERO >*/
        c__ = 0.;
/*<          R = ZERO >*/
        r__ = 0.;

/*<          DO 150 J = K, L >*/
        i__2 = l;
        for (j = k; j <= i__2; ++j) {
/*<    >*/
            if (j == i__) {
                goto L150;
            }
/*<             C = C + CABS1( A( J, I ) ) >*/
            i__3 = j + i__ * a_dim1;
            c__ += (d__1 = a[i__3].r, abs(d__1)) + (d__2 = d_imag(&a[j + i__ *
                     a_dim1]), abs(d__2));
/*<             R = R + CABS1( A( I, J ) ) >*/
            i__3 = i__ + j * a_dim1;
            r__ += (d__1 = a[i__3].r, abs(d__1)) + (d__2 = d_imag(&a[i__ + j *
                     a_dim1]), abs(d__2));
/*<   150    CONTINUE >*/
L150:
            ;
        }
/*<          ICA = IZAMAX( L, A( 1, I ), 1 ) >*/
        ica = izamax_(&l, &a[i__ * a_dim1 + 1], &c__1);
/*<          CA = ABS( A( ICA, I ) ) >*/
        ca = z_abs(&a[ica + i__ * a_dim1]);
/*<          IRA = IZAMAX( N-K+1, A( I, K ), LDA ) >*/
        i__2 = *n - k + 1;
        ira = izamax_(&i__2, &a[i__ + k * a_dim1], lda);
/*<          RA = ABS( A( I, IRA+K-1 ) ) >*/
        ra = z_abs(&a[i__ + (ira + k - 1) * a_dim1]);

/*        Guard against zero C or R due to underflow. */

/*<    >*/
        if (c__ == 0. || r__ == 0.) {
            goto L200;
        }
/*<          G = R / SCLFAC >*/
        g = r__ / 8.;
/*<          F = ONE >*/
        f = 1.;
/*<          S = C + R >*/
        s = c__ + r__;
/*<   160    CONTINUE >*/
L160:
/*<    >*/
/* Computing MAX */
        d__1 = max(f,c__);
/* Computing MIN */
        d__2 = min(r__,g);
        if (c__ >= g || max(d__1,ca) >= sfmax2 || min(d__2,ra) <= sfmin2) {
            goto L170;
        }
/*<          F = F*SCLFAC >*/
        f *= 8.;
/*<          C = C*SCLFAC >*/
        c__ *= 8.;
/*<          CA = CA*SCLFAC >*/
        ca *= 8.;
/*<          R = R / SCLFAC >*/
        r__ /= 8.;
/*<          G = G / SCLFAC >*/
        g /= 8.;
/*<          RA = RA / SCLFAC >*/
        ra /= 8.;
/*<          GO TO 160 >*/
        goto L160;

/*<   170    CONTINUE >*/
L170:
/*<          G = C / SCLFAC >*/
        g = c__ / 8.;
/*<   180    CONTINUE >*/
L180:
/*<    >*/
/* Computing MIN */
        d__1 = min(f,c__), d__1 = min(d__1,g);
        if (g < r__ || max(r__,ra) >= sfmax2 || min(d__1,ca) <= sfmin2) {
            goto L190;
        }
/*<          F = F / SCLFAC >*/
        f /= 8.;
/*<          C = C / SCLFAC >*/
        c__ /= 8.;
/*<          G = G / SCLFAC >*/
        g /= 8.;
/*<          CA = CA / SCLFAC >*/
        ca /= 8.;
/*<          R = R*SCLFAC >*/
        r__ *= 8.;
/*<          RA = RA*SCLFAC >*/
        ra *= 8.;
/*<          GO TO 180 >*/
        goto L180;

/*        Now balance. */

/*<   190    CONTINUE >*/
L190:
/*<    >*/
        if (c__ + r__ >= s * .95) {
            goto L200;
        }
/*<          IF( F.LT.ONE .AND. SCALE( I ).LT.ONE ) THEN >*/
        if (f < 1. && scale[i__] < 1.) {
/*<    >*/
            if (f * scale[i__] <= sfmin1) {
                goto L200;
            }
/*<          END IF >*/
        }
/*<          IF( F.GT.ONE .AND. SCALE( I ).GT.ONE ) THEN >*/
        if (f > 1. && scale[i__] > 1.) {
/*<    >*/
            if (scale[i__] >= sfmax1 / f) {
                goto L200;
            }
/*<          END IF >*/
        }
/*<          G = ONE / F >*/
        g = 1. / f;
/*<          SCALE( I ) = SCALE( I )*F >*/
        scale[i__] *= f;
/*<          NOCONV = .TRUE. >*/
        noconv = TRUE_;

/*<          CALL ZDSCAL( N-K+1, G, A( I, K ), LDA ) >*/
        i__2 = *n - k + 1;
        zdscal_(&i__2, &g, &a[i__ + k * a_dim1], lda);
/*<          CALL ZDSCAL( L, F, A( 1, I ), 1 ) >*/
        zdscal_(&l, &f, &a[i__ * a_dim1 + 1], &c__1);

/*<   200 CONTINUE >*/
L200:
        ;
    }

/*<    >*/
    if (noconv) {
        goto L140;
    }

/*<   210 CONTINUE >*/
L210:
/*<       ILO = K >*/
    *ilo = k;
/*<       IHI = L >*/
    *ihi = l;

/*<       RETURN >*/
    return 0;

/*     End of ZGEBAL */

/*<       END >*/
} /* zgebal_ */

#ifdef __cplusplus
        }
#endif