csyr2k.f.html

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

</span><span class="comment">*</span><span class="comment">     Test the input parameters.
</span><span class="comment">*</span><span class="comment">
</span>      IF (<a name="LSAME.158"></a><a href="lsame.f.html#LSAME.1">LSAME</a>(TRANS,<span class="string">'N'</span>)) THEN
          NROWA = N
      ELSE
          NROWA = K
      END IF
      UPPER = <a name="LSAME.163"></a><a href="lsame.f.html#LSAME.1">LSAME</a>(UPLO,<span class="string">'U'</span>)
<span class="comment">*</span><span class="comment">
</span>      INFO = 0
      IF ((.NOT.UPPER) .AND. (.NOT.<a name="LSAME.166"></a><a href="lsame.f.html#LSAME.1">LSAME</a>(UPLO,<span class="string">'L'</span>))) THEN
          INFO = 1
      ELSE IF ((.NOT.<a name="LSAME.168"></a><a href="lsame.f.html#LSAME.1">LSAME</a>(TRANS,<span class="string">'N'</span>)) .AND.
     +         (.NOT.<a name="LSAME.169"></a><a href="lsame.f.html#LSAME.1">LSAME</a>(TRANS,<span class="string">'T'</span>))) THEN
          INFO = 2
      ELSE IF (N.LT.0) THEN
          INFO = 3
      ELSE IF (K.LT.0) THEN
          INFO = 4
      ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
          INFO = 7
      ELSE IF (LDB.LT.MAX(1,NROWA)) THEN
          INFO = 9
      ELSE IF (LDC.LT.MAX(1,N)) THEN
          INFO = 12
      END IF
      IF (INFO.NE.0) THEN
          CALL <a name="XERBLA.183"></a><a href="xerbla.f.html#XERBLA.1">XERBLA</a>(<span class="string">'<a name="CSYR2K.183"></a><a href="csyr2k.f.html#CSYR2K.1">CSYR2K</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 ((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 when  alpha.eq.zero.
</span><span class="comment">*</span><span class="comment">
</span>      IF (ALPHA.EQ.ZERO) THEN
          IF (UPPER) THEN
              IF (BETA.EQ.ZERO) THEN
                  DO 20 J = 1,N
                      DO 10 I = 1,J
                          C(I,J) = ZERO
   10                 CONTINUE
   20             CONTINUE
              ELSE
                  DO 40 J = 1,N
                      DO 30 I = 1,J
                          C(I,J) = BETA*C(I,J)
   30                 CONTINUE
   40             CONTINUE
              END IF
          ELSE
              IF (BETA.EQ.ZERO) THEN
                  DO 60 J = 1,N
                      DO 50 I = J,N
                          C(I,J) = ZERO
   50                 CONTINUE
   60             CONTINUE
              ELSE
                  DO 80 J = 1,N
                      DO 70 I = J,N
                          C(I,J) = BETA*C(I,J)
   70                 CONTINUE
   80             CONTINUE
              END IF
          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 (<a name="LSAME.229"></a><a href="lsame.f.html#LSAME.1">LSAME</a>(TRANS,<span class="string">'N'</span>)) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Form  C := alpha*A*B' + alpha*B*A' + C.
</span><span class="comment">*</span><span class="comment">
</span>          IF (UPPER) THEN
              DO 130 J = 1,N
                  IF (BETA.EQ.ZERO) THEN
                      DO 90 I = 1,J
                          C(I,J) = ZERO
   90                 CONTINUE
                  ELSE IF (BETA.NE.ONE) THEN
                      DO 100 I = 1,J
                          C(I,J) = BETA*C(I,J)
  100                 CONTINUE
                  END IF
                  DO 120 L = 1,K
                      IF ((A(J,L).NE.ZERO) .OR. (B(J,L).NE.ZERO)) THEN
                          TEMP1 = ALPHA*B(J,L)
                          TEMP2 = ALPHA*A(J,L)
                          DO 110 I = 1,J
                              C(I,J) = C(I,J) + A(I,L)*TEMP1 +
     +                                 B(I,L)*TEMP2
  110                     CONTINUE
                      END IF
  120             CONTINUE
  130         CONTINUE
          ELSE
              DO 180 J = 1,N
                  IF (BETA.EQ.ZERO) THEN
                      DO 140 I = J,N
                          C(I,J) = ZERO
  140                 CONTINUE
                  ELSE IF (BETA.NE.ONE) THEN
                      DO 150 I = J,N
                          C(I,J) = BETA*C(I,J)
  150                 CONTINUE
                  END IF
                  DO 170 L = 1,K
                      IF ((A(J,L).NE.ZERO) .OR. (B(J,L).NE.ZERO)) THEN
                          TEMP1 = ALPHA*B(J,L)
                          TEMP2 = ALPHA*A(J,L)
                          DO 160 I = J,N
                              C(I,J) = C(I,J) + A(I,L)*TEMP1 +
     +                                 B(I,L)*TEMP2
  160                     CONTINUE
                      END IF
  170             CONTINUE
  180         CONTINUE
          END IF
      ELSE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Form  C := alpha*A'*B + alpha*B'*A + C.
</span><span class="comment">*</span><span class="comment">
</span>          IF (UPPER) THEN
              DO 210 J = 1,N
                  DO 200 I = 1,J
                      TEMP1 = ZERO
                      TEMP2 = ZERO
                      DO 190 L = 1,K
                          TEMP1 = TEMP1 + A(L,I)*B(L,J)
                          TEMP2 = TEMP2 + B(L,I)*A(L,J)
  190                 CONTINUE
                      IF (BETA.EQ.ZERO) THEN
                          C(I,J) = ALPHA*TEMP1 + ALPHA*TEMP2
                      ELSE
                          C(I,J) = BETA*C(I,J) + ALPHA*TEMP1 +
     +                             ALPHA*TEMP2
                      END IF
  200             CONTINUE
  210         CONTINUE
          ELSE
              DO 240 J = 1,N
                  DO 230 I = J,N
                      TEMP1 = ZERO
                      TEMP2 = ZERO
                      DO 220 L = 1,K
                          TEMP1 = TEMP1 + A(L,I)*B(L,J)
                          TEMP2 = TEMP2 + B(L,I)*A(L,J)
  220                 CONTINUE
                      IF (BETA.EQ.ZERO) THEN
                          C(I,J) = ALPHA*TEMP1 + ALPHA*TEMP2
                      ELSE
                          C(I,J) = BETA*C(I,J) + ALPHA*TEMP1 +
     +                             ALPHA*TEMP2
                      END IF
  230             CONTINUE
  240         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="CSYR2K.321"></a><a href="csyr2k.f.html#CSYR2K.1">CSYR2K</a>.
</span><span class="comment">*</span><span class="comment">
</span>      END

</pre>

 </body>
</html>