dtrmm.c

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

/*<                      END IF >*/
                        }
/*<    40             CONTINUE >*/
/* L40: */
                    }
/*<    50          CONTINUE >*/
/* L50: */
                }
/*<             ELSE >*/
            } else {
/*<                DO 80, J = 1, N >*/
                i__1 = *n;
                for (j = 1; j <= i__1; ++j) {
/*<                   DO 70 K = M, 1, -1 >*/
                    for (k = *m; k >= 1; --k) {
/*<                      IF( B( K, J ).NE.ZERO )THEN >*/
                        if (b[k + j * b_dim1] != 0.) {
/*<                         TEMP      = ALPHA*B( K, J ) >*/
                            temp = *alpha * b[k + j * b_dim1];
/*<                         B( K, J ) = TEMP >*/
                            b[k + j * b_dim1] = temp;
/*<    >*/
                            if (nounit) {
                                b[k + j * b_dim1] *= a[k + k * a_dim1];
                            }
/*<                         DO 60, I = K + 1, M >*/
                            i__2 = *m;
                            for (i__ = k + 1; i__ <= i__2; ++i__) {
/*<                            B( I, J ) = B( I, J ) + TEMP*A( I, K ) >*/
                                b[i__ + j * b_dim1] += temp * a[i__ + k * 
                                        a_dim1];
/*<    60                   CONTINUE >*/
/* L60: */
                            }
/*<                      END IF >*/
                        }
/*<    70             CONTINUE >*/
/* L70: */
                    }
/*<    80          CONTINUE >*/
/* L80: */
                }
/*<             END IF >*/
            }
/*<          ELSE >*/
        } else {

/*           Form  B := alpha*A'*B. */

/*<             IF( UPPER )THEN >*/
            if (upper) {
/*<                DO 110, J = 1, N >*/
                i__1 = *n;
                for (j = 1; j <= i__1; ++j) {
/*<                   DO 100, I = M, 1, -1 >*/
                    for (i__ = *m; i__ >= 1; --i__) {
/*<                      TEMP = B( I, J ) >*/
                        temp = b[i__ + j * b_dim1];
/*<    >*/
                        if (nounit) {
                            temp *= a[i__ + i__ * a_dim1];
                        }
/*<                      DO 90, K = 1, I - 1 >*/
                        i__2 = i__ - 1;
                        for (k = 1; k <= i__2; ++k) {
/*<                         TEMP = TEMP + A( K, I )*B( K, J ) >*/
                            temp += a[k + i__ * a_dim1] * b[k + j * b_dim1];
/*<    90                CONTINUE >*/
/* L90: */
                        }
/*<                      B( I, J ) = ALPHA*TEMP >*/
                        b[i__ + j * b_dim1] = *alpha * temp;
/*<   100             CONTINUE >*/
/* L100: */
                    }
/*<   110          CONTINUE >*/
/* L110: */
                }
/*<             ELSE >*/
            } else {
/*<                DO 140, J = 1, N >*/
                i__1 = *n;
                for (j = 1; j <= i__1; ++j) {
/*<                   DO 130, I = 1, M >*/
                    i__2 = *m;
                    for (i__ = 1; i__ <= i__2; ++i__) {
/*<                      TEMP = B( I, J ) >*/
                        temp = b[i__ + j * b_dim1];
/*<    >*/
                        if (nounit) {
                            temp *= a[i__ + i__ * a_dim1];
                        }
/*<                      DO 120, K = I + 1, M >*/
                        i__3 = *m;
                        for (k = i__ + 1; k <= i__3; ++k) {
/*<                         TEMP = TEMP + A( K, I )*B( K, J ) >*/
                            temp += a[k + i__ * a_dim1] * b[k + j * b_dim1];
/*<   120                CONTINUE >*/
/* L120: */
                        }
/*<                      B( I, J ) = ALPHA*TEMP >*/
                        b[i__ + j * b_dim1] = *alpha * temp;
/*<   130             CONTINUE >*/
/* L130: */
                    }
/*<   140          CONTINUE >*/
/* L140: */
                }
/*<             END IF >*/
            }
/*<          END IF >*/
        }
/*<       ELSE >*/
    } else {
/*<          IF( LSAME( TRANSA, 'N' ) )THEN >*/
        if (lsame_(transa, "N", (ftnlen)1, (ftnlen)1)) {

/*           Form  B := alpha*B*A. */

/*<             IF( UPPER )THEN >*/
            if (upper) {
/*<                DO 180, J = N, 1, -1 >*/
                for (j = *n; j >= 1; --j) {
/*<                   TEMP = ALPHA >*/
                    temp = *alpha;
/*<    >*/
                    if (nounit) {
                        temp *= a[j + j * a_dim1];
                    }
/*<                   DO 150, I = 1, M >*/
                    i__1 = *m;
                    for (i__ = 1; i__ <= i__1; ++i__) {
/*<                      B( I, J ) = TEMP*B( I, J ) >*/
                        b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1];
/*<   150             CONTINUE >*/
/* L150: */
                    }
/*<                   DO 170, K = 1, J - 1 >*/
                    i__1 = j - 1;
                    for (k = 1; k <= i__1; ++k) {
/*<                      IF( A( K, J ).NE.ZERO )THEN >*/
                        if (a[k + j * a_dim1] != 0.) {
/*<                         TEMP = ALPHA*A( K, J ) >*/
                            temp = *alpha * a[k + j * a_dim1];
/*<                         DO 160, I = 1, M >*/
                            i__2 = *m;
                            for (i__ = 1; i__ <= i__2; ++i__) {
/*<                            B( I, J ) = B( I, J ) + TEMP*B( I, K ) >*/
                                b[i__ + j * b_dim1] += temp * b[i__ + k * 
                                        b_dim1];
/*<   160                   CONTINUE >*/
/* L160: */
                            }
/*<                      END IF >*/
                        }
/*<   170             CONTINUE >*/
/* L170: */
                    }
/*<   180          CONTINUE >*/
/* L180: */
                }
/*<             ELSE >*/
            } else {
/*<                DO 220, J = 1, N >*/
                i__1 = *n;
                for (j = 1; j <= i__1; ++j) {
/*<                   TEMP = ALPHA >*/
                    temp = *alpha;
/*<    >*/
                    if (nounit) {
                        temp *= a[j + j * a_dim1];
                    }
/*<                   DO 190, I = 1, M >*/
                    i__2 = *m;
                    for (i__ = 1; i__ <= i__2; ++i__) {
/*<                      B( I, J ) = TEMP*B( I, J ) >*/
                        b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1];
/*<   190             CONTINUE >*/
/* L190: */
                    }
/*<                   DO 210, K = J + 1, N >*/
                    i__2 = *n;
                    for (k = j + 1; k <= i__2; ++k) {
/*<                      IF( A( K, J ).NE.ZERO )THEN >*/
                        if (a[k + j * a_dim1] != 0.) {
/*<                         TEMP = ALPHA*A( K, J ) >*/
                            temp = *alpha * a[k + j * a_dim1];
/*<                         DO 200, I = 1, M >*/
                            i__3 = *m;
                            for (i__ = 1; i__ <= i__3; ++i__) {
/*<                            B( I, J ) = B( I, J ) + TEMP*B( I, K ) >*/
                                b[i__ + j * b_dim1] += temp * b[i__ + k * 
                                        b_dim1];
/*<   200                   CONTINUE >*/
/* L200: */
                            }
/*<                      END IF >*/
                        }
/*<   210             CONTINUE >*/
/* L210: */
                    }
/*<   220          CONTINUE >*/
/* L220: */
                }
/*<             END IF >*/
            }
/*<          ELSE >*/
        } else {

/*           Form  B := alpha*B*A'. */

/*<             IF( UPPER )THEN >*/
            if (upper) {
/*<                DO 260, K = 1, N >*/
                i__1 = *n;
                for (k = 1; k <= i__1; ++k) {
/*<                   DO 240, J = 1, K - 1 >*/
                    i__2 = k - 1;
                    for (j = 1; j <= i__2; ++j) {
/*<                      IF( A( J, K ).NE.ZERO )THEN >*/
                        if (a[j + k * a_dim1] != 0.) {
/*<                         TEMP = ALPHA*A( J, K ) >*/
                            temp = *alpha * a[j + k * a_dim1];
/*<                         DO 230, I = 1, M >*/
                            i__3 = *m;
                            for (i__ = 1; i__ <= i__3; ++i__) {
/*<                            B( I, J ) = B( I, J ) + TEMP*B( I, K ) >*/
                                b[i__ + j * b_dim1] += temp * b[i__ + k * 
                                        b_dim1];
/*<   230                   CONTINUE >*/
/* L230: */
                            }
/*<                      END IF >*/
                        }
/*<   240             CONTINUE >*/
/* L240: */
                    }
/*<                   TEMP = ALPHA >*/
                    temp = *alpha;
/*<    >*/
                    if (nounit) {
                        temp *= a[k + k * a_dim1];
                    }
/*<                   IF( TEMP.NE.ONE )THEN >*/
                    if (temp != 1.) {
/*<                      DO 250, I = 1, M >*/
                        i__2 = *m;
                        for (i__ = 1; i__ <= i__2; ++i__) {
/*<                         B( I, K ) = TEMP*B( I, K ) >*/
                            b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1];
/*<   250                CONTINUE >*/
/* L250: */
                        }
/*<                   END IF >*/
                    }
/*<   260          CONTINUE >*/
/* L260: */
                }
/*<             ELSE >*/
            } else {
/*<                DO 300, K = N, 1, -1 >*/
                for (k = *n; k >= 1; --k) {
/*<                   DO 280, J = K + 1, N >*/
                    i__1 = *n;
                    for (j = k + 1; j <= i__1; ++j) {
/*<                      IF( A( J, K ).NE.ZERO )THEN >*/
                        if (a[j + k * a_dim1] != 0.) {
/*<                         TEMP = ALPHA*A( J, K ) >*/
                            temp = *alpha * a[j + k * a_dim1];
/*<                         DO 270, I = 1, M >*/
                            i__2 = *m;
                            for (i__ = 1; i__ <= i__2; ++i__) {
/*<                            B( I, J ) = B( I, J ) + TEMP*B( I, K ) >*/
                                b[i__ + j * b_dim1] += temp * b[i__ + k * 
                                        b_dim1];
/*<   270                   CONTINUE >*/
/* L270: */
                            }
/*<                      END IF >*/
                        }
/*<   280             CONTINUE >*/
/* L280: */
                    }
/*<                   TEMP = ALPHA >*/
                    temp = *alpha;
/*<    >*/
                    if (nounit) {
                        temp *= a[k + k * a_dim1];
                    }
/*<                   IF( TEMP.NE.ONE )THEN >*/
                    if (temp != 1.) {
/*<                      DO 290, I = 1, M >*/
                        i__1 = *m;
                        for (i__ = 1; i__ <= i__1; ++i__) {
/*<                         B( I, K ) = TEMP*B( I, K ) >*/
                            b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1];
/*<   290                CONTINUE >*/
/* L290: */
                        }
/*<                   END IF >*/
                    }
/*<   300          CONTINUE >*/
/* L300: */
                }
/*<             END IF >*/
            }
/*<          END IF >*/
        }
/*<       END IF >*/
    }

/*<       RETURN >*/
    return 0;

/*     End of DTRMM . */

/*<       END >*/
} /* dtrmm_ */

#ifdef __cplusplus
        }
#endif