zlascl.c

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

/*<       SMLNUM = DLAMCH( 'S' ) >*/
    smlnum = dlamch_("S", (ftnlen)1);
/*<       BIGNUM = ONE / SMLNUM >*/
    bignum = 1. / smlnum;

/*<       CFROMC = CFROM >*/
    cfromc = *cfrom;
/*<       CTOC = CTO >*/
    ctoc = *cto;

/*<    10 CONTINUE >*/
L10:
/*<       CFROM1 = CFROMC*SMLNUM >*/
    cfrom1 = cfromc * smlnum;
/*<       CTO1 = CTOC / BIGNUM >*/
    cto1 = ctoc / bignum;
/*<       IF( ABS( CFROM1 ).GT.ABS( CTOC ) .AND. CTOC.NE.ZERO ) THEN >*/
    if (abs(cfrom1) > abs(ctoc) && ctoc != 0.) {
/*<          MUL = SMLNUM >*/
        mul = smlnum;
/*<          DONE = .FALSE. >*/
        done = FALSE_;
/*<          CFROMC = CFROM1 >*/
        cfromc = cfrom1;
/*<       ELSE IF( ABS( CTO1 ).GT.ABS( CFROMC ) ) THEN >*/
    } else if (abs(cto1) > abs(cfromc)) {
/*<          MUL = BIGNUM >*/
        mul = bignum;
/*<          DONE = .FALSE. >*/
        done = FALSE_;
/*<          CTOC = CTO1 >*/
        ctoc = cto1;
/*<       ELSE >*/
    } else {
/*<          MUL = CTOC / CFROMC >*/
        mul = ctoc / cfromc;
/*<          DONE = .TRUE. >*/
        done = TRUE_;
/*<       END IF >*/
    }

/*<       IF( ITYPE.EQ.0 ) THEN >*/
    if (itype == 0) {

/*        Full matrix */

/*<          DO 30 J = 1, N >*/
        i__1 = *n;
        for (j = 1; j <= i__1; ++j) {
/*<             DO 20 I = 1, M >*/
            i__2 = *m;
            for (i__ = 1; i__ <= i__2; ++i__) {
/*<                A( I, J ) = A( I, J )*MUL >*/
                i__3 = i__ + j * a_dim1;
                i__4 = i__ + j * a_dim1;
                z__1.r = mul * a[i__4].r, z__1.i = mul * a[i__4].i;
                a[i__3].r = z__1.r, a[i__3].i = z__1.i;
/*<    20       CONTINUE >*/
/* L20: */
            }
/*<    30    CONTINUE >*/
/* L30: */
        }

/*<       ELSE IF( ITYPE.EQ.1 ) THEN >*/
    } else if (itype == 1) {

/*        Lower triangular matrix */

/*<          DO 50 J = 1, N >*/
        i__1 = *n;
        for (j = 1; j <= i__1; ++j) {
/*<             DO 40 I = J, M >*/
            i__2 = *m;
            for (i__ = j; i__ <= i__2; ++i__) {
/*<                A( I, J ) = A( I, J )*MUL >*/
                i__3 = i__ + j * a_dim1;
                i__4 = i__ + j * a_dim1;
                z__1.r = mul * a[i__4].r, z__1.i = mul * a[i__4].i;
                a[i__3].r = z__1.r, a[i__3].i = z__1.i;
/*<    40       CONTINUE >*/
/* L40: */
            }
/*<    50    CONTINUE >*/
/* L50: */
        }

/*<       ELSE IF( ITYPE.EQ.2 ) THEN >*/
    } else if (itype == 2) {

/*        Upper triangular matrix */

/*<          DO 70 J = 1, N >*/
        i__1 = *n;
        for (j = 1; j <= i__1; ++j) {
/*<             DO 60 I = 1, MIN( J, M ) >*/
            i__2 = min(j,*m);
            for (i__ = 1; i__ <= i__2; ++i__) {
/*<                A( I, J ) = A( I, J )*MUL >*/
                i__3 = i__ + j * a_dim1;
                i__4 = i__ + j * a_dim1;
                z__1.r = mul * a[i__4].r, z__1.i = mul * a[i__4].i;
                a[i__3].r = z__1.r, a[i__3].i = z__1.i;
/*<    60       CONTINUE >*/
/* L60: */
            }
/*<    70    CONTINUE >*/
/* L70: */
        }

/*<       ELSE IF( ITYPE.EQ.3 ) THEN >*/
    } else if (itype == 3) {

/*        Upper Hessenberg matrix */

/*<          DO 90 J = 1, N >*/
        i__1 = *n;
        for (j = 1; j <= i__1; ++j) {
/*<             DO 80 I = 1, MIN( J+1, M ) >*/
/* Computing MIN */
            i__3 = j + 1;
            i__2 = min(i__3,*m);
            for (i__ = 1; i__ <= i__2; ++i__) {
/*<                A( I, J ) = A( I, J )*MUL >*/
                i__3 = i__ + j * a_dim1;
                i__4 = i__ + j * a_dim1;
                z__1.r = mul * a[i__4].r, z__1.i = mul * a[i__4].i;
                a[i__3].r = z__1.r, a[i__3].i = z__1.i;
/*<    80       CONTINUE >*/
/* L80: */
            }
/*<    90    CONTINUE >*/
/* L90: */
        }

/*<       ELSE IF( ITYPE.EQ.4 ) THEN >*/
    } else if (itype == 4) {

/*        Lower half of a symmetric band matrix */

/*<          K3 = KL + 1 >*/
        k3 = *kl + 1;
/*<          K4 = N + 1 >*/
        k4 = *n + 1;
/*<          DO 110 J = 1, N >*/
        i__1 = *n;
        for (j = 1; j <= i__1; ++j) {
/*<             DO 100 I = 1, MIN( K3, K4-J ) >*/
/* Computing MIN */
            i__3 = k3, i__4 = k4 - j;
            i__2 = min(i__3,i__4);
            for (i__ = 1; i__ <= i__2; ++i__) {
/*<                A( I, J ) = A( I, J )*MUL >*/
                i__3 = i__ + j * a_dim1;
                i__4 = i__ + j * a_dim1;
                z__1.r = mul * a[i__4].r, z__1.i = mul * a[i__4].i;
                a[i__3].r = z__1.r, a[i__3].i = z__1.i;
/*<   100       CONTINUE >*/
/* L100: */
            }
/*<   110    CONTINUE >*/
/* L110: */
        }

/*<       ELSE IF( ITYPE.EQ.5 ) THEN >*/
    } else if (itype == 5) {

/*        Upper half of a symmetric band matrix */

/*<          K1 = KU + 2 >*/
        k1 = *ku + 2;
/*<          K3 = KU + 1 >*/
        k3 = *ku + 1;
/*<          DO 130 J = 1, N >*/
        i__1 = *n;
        for (j = 1; j <= i__1; ++j) {
/*<             DO 120 I = MAX( K1-J, 1 ), K3 >*/
/* Computing MAX */
            i__2 = k1 - j;
            i__3 = k3;
            for (i__ = max(i__2,1); i__ <= i__3; ++i__) {
/*<                A( I, J ) = A( I, J )*MUL >*/
                i__2 = i__ + j * a_dim1;
                i__4 = i__ + j * a_dim1;
                z__1.r = mul * a[i__4].r, z__1.i = mul * a[i__4].i;
                a[i__2].r = z__1.r, a[i__2].i = z__1.i;
/*<   120       CONTINUE >*/
/* L120: */
            }
/*<   130    CONTINUE >*/
/* L130: */
        }

/*<       ELSE IF( ITYPE.EQ.6 ) THEN >*/
    } else if (itype == 6) {

/*        Band matrix */

/*<          K1 = KL + KU + 2 >*/
        k1 = *kl + *ku + 2;
/*<          K2 = KL + 1 >*/
        k2 = *kl + 1;
/*<          K3 = 2*KL + KU + 1 >*/
        k3 = (*kl << 1) + *ku + 1;
/*<          K4 = KL + KU + 1 + M >*/
        k4 = *kl + *ku + 1 + *m;
/*<          DO 150 J = 1, N >*/
        i__1 = *n;
        for (j = 1; j <= i__1; ++j) {
/*<             DO 140 I = MAX( K1-J, K2 ), MIN( K3, K4-J ) >*/
/* Computing MAX */
            i__3 = k1 - j;
/* Computing MIN */
            i__4 = k3, i__5 = k4 - j;
            i__2 = min(i__4,i__5);
            for (i__ = max(i__3,k2); i__ <= i__2; ++i__) {
/*<                A( I, J ) = A( I, J )*MUL >*/
                i__3 = i__ + j * a_dim1;
                i__4 = i__ + j * a_dim1;
                z__1.r = mul * a[i__4].r, z__1.i = mul * a[i__4].i;
                a[i__3].r = z__1.r, a[i__3].i = z__1.i;
/*<   140       CONTINUE >*/
/* L140: */
            }
/*<   150    CONTINUE >*/
/* L150: */
        }

/*<       END IF >*/
    }

/*<    >*/
    if (! done) {
        goto L10;
    }

/*<       RETURN >*/
    return 0;

/*     End of ZLASCL */

/*<       END >*/
} /* zlascl_ */

#ifdef __cplusplus
        }
#endif