cherk.f.html

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

          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 (LDC.LT.MAX(1,N)) THEN
          INFO = 10
      END IF
      IF (INFO.NE.0) THEN
          CALL <a name="XERBLA.169"></a><a href="xerbla.f.html#XERBLA.1">XERBLA</a>(<span class="string">'<a name="CHERK.169"></a><a href="cherk.f.html#CHERK.1">CHERK</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 - 1
                          C(I,J) = BETA*C(I,J)
   30                 CONTINUE
                      C(J,J) = BETA*REAL(C(J,J))
   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
                      C(J,J) = BETA*REAL(C(J,J))
                      DO 70 I = J + 1,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.217"></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*conjg( A' ) + beta*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 - 1
                          C(I,J) = BETA*C(I,J)
  100                 CONTINUE
                      C(J,J) = BETA*REAL(C(J,J))
                  ELSE
                      C(J,J) = REAL(C(J,J))
                  END IF
                  DO 120 L = 1,K
                      IF (A(J,L).NE.CMPLX(ZERO)) THEN
                          TEMP = ALPHA*CONJG(A(J,L))
                          DO 110 I = 1,J - 1
                              C(I,J) = C(I,J) + TEMP*A(I,L)
  110                     CONTINUE
                          C(J,J) = REAL(C(J,J)) + REAL(TEMP*A(I,L))
                      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
                      C(J,J) = BETA*REAL(C(J,J))
                      DO 150 I = J + 1,N
                          C(I,J) = BETA*C(I,J)
  150                 CONTINUE
                  ELSE
                      C(J,J) = REAL(C(J,J))
                  END IF
                  DO 170 L = 1,K
                      IF (A(J,L).NE.CMPLX(ZERO)) THEN
                          TEMP = ALPHA*CONJG(A(J,L))
                          C(J,J) = REAL(C(J,J)) + REAL(TEMP*A(J,L))
                          DO 160 I = J + 1,N
                              C(I,J) = C(I,J) + TEMP*A(I,L)
  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*conjg( A' )*A + beta*C.
</span><span class="comment">*</span><span class="comment">
</span>          IF (UPPER) THEN
              DO 220 J = 1,N
                  DO 200 I = 1,J - 1
                      TEMP = ZERO
                      DO 190 L = 1,K
                          TEMP = TEMP + CONJG(A(L,I))*A(L,J)
  190                 CONTINUE
                      IF (BETA.EQ.ZERO) THEN
                          C(I,J) = ALPHA*TEMP
                      ELSE
                          C(I,J) = ALPHA*TEMP + BETA*C(I,J)
                      END IF
  200             CONTINUE
                  RTEMP = ZERO
                  DO 210 L = 1,K
                      RTEMP = RTEMP + CONJG(A(L,J))*A(L,J)
  210             CONTINUE
                  IF (BETA.EQ.ZERO) THEN
                      C(J,J) = ALPHA*RTEMP
                  ELSE
                      C(J,J) = ALPHA*RTEMP + BETA*REAL(C(J,J))
                  END IF
  220         CONTINUE
          ELSE
              DO 260 J = 1,N
                  RTEMP = ZERO
                  DO 230 L = 1,K
                      RTEMP = RTEMP + CONJG(A(L,J))*A(L,J)
  230             CONTINUE
                  IF (BETA.EQ.ZERO) THEN
                      C(J,J) = ALPHA*RTEMP
                  ELSE
                      C(J,J) = ALPHA*RTEMP + BETA*REAL(C(J,J))
                  END IF
                  DO 250 I = J + 1,N
                      TEMP = ZERO
                      DO 240 L = 1,K
                          TEMP = TEMP + CONJG(A(L,I))*A(L,J)
  240                 CONTINUE
                      IF (BETA.EQ.ZERO) THEN
                          C(I,J) = ALPHA*TEMP
                      ELSE
                          C(I,J) = ALPHA*TEMP + BETA*C(I,J)
                      END IF
  250             CONTINUE
  260         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="CHERK.325"></a><a href="cherk.f.html#CHERK.1">CHERK</a> .
</span><span class="comment">*</span><span class="comment">
</span>      END

</pre>

 </body>
</html>