dgemm.f.html

来自「famous linear algebra library (LAPACK) p」· HTML 代码 · 共 338 行 · 第 1/2 页

</span><span class="comment">*</span><span class="comment">     Set  NOTA  and  NOTB  as  true if  A  and  B  respectively are not
</span><span class="comment">*</span><span class="comment">     transposed and set  NROWA, NCOLA and  NROWB  as the number of rows
</span><span class="comment">*</span><span class="comment">     and  columns of  A  and the  number of  rows  of  B  respectively.
</span><span class="comment">*</span><span class="comment">
</span>      NOTA = <a name="LSAME.155"></a><a href="lsame.f.html#LSAME.1">LSAME</a>(TRANSA,<span class="string">'N'</span>)
      NOTB = <a name="LSAME.156"></a><a href="lsame.f.html#LSAME.1">LSAME</a>(TRANSB,<span class="string">'N'</span>)
      IF (NOTA) THEN
          NROWA = M
          NCOLA = K
      ELSE
          NROWA = K
          NCOLA = M
      END IF
      IF (NOTB) THEN
          NROWB = K
      ELSE
          NROWB = N
      END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Test the input parameters.
</span><span class="comment">*</span><span class="comment">
</span>      INFO = 0
      IF ((.NOT.NOTA) .AND. (.NOT.<a name="LSAME.173"></a><a href="lsame.f.html#LSAME.1">LSAME</a>(TRANSA,<span class="string">'C'</span>)) .AND.
     +    (.NOT.<a name="LSAME.174"></a><a href="lsame.f.html#LSAME.1">LSAME</a>(TRANSA,<span class="string">'T'</span>))) THEN
          INFO = 1
      ELSE IF ((.NOT.NOTB) .AND. (.NOT.<a name="LSAME.176"></a><a href="lsame.f.html#LSAME.1">LSAME</a>(TRANSB,<span class="string">'C'</span>)) .AND.
     +         (.NOT.<a name="LSAME.177"></a><a href="lsame.f.html#LSAME.1">LSAME</a>(TRANSB,<span class="string">'T'</span>))) THEN
          INFO = 2
      ELSE IF (M.LT.0) THEN
          INFO = 3
      ELSE IF (N.LT.0) THEN
          INFO = 4
      ELSE IF (K.LT.0) THEN
          INFO = 5
      ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
          INFO = 8
      ELSE IF (LDB.LT.MAX(1,NROWB)) THEN
          INFO = 10
      ELSE IF (LDC.LT.MAX(1,M)) THEN
          INFO = 13
      END IF
      IF (INFO.NE.0) THEN
          CALL <a name="XERBLA.193"></a><a href="xerbla.f.html#XERBLA.1">XERBLA</a>(<span class="string">'<a name="DGEMM.193"></a><a href="dgemm.f.html#DGEMM.1">DGEMM</a> '</span>,INFO)
          RETURN
      END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Quick return if possible.
</span><span class="comment">*</span><span class="comment">
</span>      IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
     +    (((ALPHA.EQ.ZERO).OR. (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     And if  alpha.eq.zero.
</span><span class="comment">*</span><span class="comment">
</span>      IF (ALPHA.EQ.ZERO) THEN
          IF (BETA.EQ.ZERO) THEN
              DO 20 J = 1,N
                  DO 10 I = 1,M
                      C(I,J) = ZERO
   10             CONTINUE
   20         CONTINUE
          ELSE
              DO 40 J = 1,N
                  DO 30 I = 1,M
                      C(I,J) = BETA*C(I,J)
   30             CONTINUE
   40         CONTINUE
          END IF
          RETURN
      END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Start the operations.
</span><span class="comment">*</span><span class="comment">
</span>      IF (NOTB) THEN
          IF (NOTA) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Form  C := alpha*A*B + beta*C.
</span><span class="comment">*</span><span class="comment">
</span>              DO 90 J = 1,N
                  IF (BETA.EQ.ZERO) THEN
                      DO 50 I = 1,M
                          C(I,J) = ZERO
   50                 CONTINUE
                  ELSE IF (BETA.NE.ONE) THEN
                      DO 60 I = 1,M
                          C(I,J) = BETA*C(I,J)
   60                 CONTINUE
                  END IF
                  DO 80 L = 1,K
                      IF (B(L,J).NE.ZERO) THEN
                          TEMP = ALPHA*B(L,J)
                          DO 70 I = 1,M
                              C(I,J) = C(I,J) + TEMP*A(I,L)
   70                     CONTINUE
                      END IF
   80             CONTINUE
   90         CONTINUE
          ELSE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Form  C := alpha*A'*B + beta*C
</span><span class="comment">*</span><span class="comment">
</span>              DO 120 J = 1,N
                  DO 110 I = 1,M
                      TEMP = ZERO
                      DO 100 L = 1,K
                          TEMP = TEMP + A(L,I)*B(L,J)
  100                 CONTINUE
                      IF (BETA.EQ.ZERO) THEN
                          C(I,J) = ALPHA*TEMP
                      ELSE
                          C(I,J) = ALPHA*TEMP + BETA*C(I,J)
                      END IF
  110             CONTINUE
  120         CONTINUE
          END IF
      ELSE
          IF (NOTA) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Form  C := alpha*A*B' + beta*C
</span><span class="comment">*</span><span class="comment">
</span>              DO 170 J = 1,N
                  IF (BETA.EQ.ZERO) THEN
                      DO 130 I = 1,M
                          C(I,J) = ZERO
  130                 CONTINUE
                  ELSE IF (BETA.NE.ONE) THEN
                      DO 140 I = 1,M
                          C(I,J) = BETA*C(I,J)
  140                 CONTINUE
                  END IF
                  DO 160 L = 1,K
                      IF (B(J,L).NE.ZERO) THEN
                          TEMP = ALPHA*B(J,L)
                          DO 150 I = 1,M
                              C(I,J) = C(I,J) + TEMP*A(I,L)
  150                     CONTINUE
                      END IF
  160             CONTINUE
  170         CONTINUE
          ELSE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Form  C := alpha*A'*B' + beta*C
</span><span class="comment">*</span><span class="comment">
</span>              DO 200 J = 1,N
                  DO 190 I = 1,M
                      TEMP = ZERO
                      DO 180 L = 1,K
                          TEMP = TEMP + A(L,I)*B(J,L)
  180                 CONTINUE
                      IF (BETA.EQ.ZERO) THEN
                          C(I,J) = ALPHA*TEMP
                      ELSE
                          C(I,J) = ALPHA*TEMP + BETA*C(I,J)
                      END IF
  190             CONTINUE
  200         CONTINUE
          END IF
      END IF
<span class="comment">*</span><span class="comment">
</span>      RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     End of <a name="DGEMM.311"></a><a href="dgemm.f.html#DGEMM.1">DGEMM</a> .
</span><span class="comment">*</span><span class="comment">
</span>      END

</pre>

 </body>
</html>