LAPACK 3.3.1
Linear Algebra PACKage

zsymm.f

Go to the documentation of this file.
00001       SUBROUTINE ZSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
00002 *     .. Scalar Arguments ..
00003       DOUBLE COMPLEX ALPHA,BETA
00004       INTEGER LDA,LDB,LDC,M,N
00005       CHARACTER SIDE,UPLO
00006 *     ..
00007 *     .. Array Arguments ..
00008       DOUBLE COMPLEX A(LDA,*),B(LDB,*),C(LDC,*)
00009 *     ..
00010 *
00011 *  Purpose
00012 *  =======
00013 *
00014 *  ZSYMM  performs one of the matrix-matrix operations
00015 *
00016 *     C := alpha*A*B + beta*C,
00017 *
00018 *  or
00019 *
00020 *     C := alpha*B*A + beta*C,
00021 *
00022 *  where  alpha and beta are scalars, A is a symmetric matrix and  B and
00023 *  C are m by n matrices.
00024 *
00025 *  Arguments
00026 *  ==========
00027 *
00028 *  SIDE   - CHARACTER*1.
00029 *           On entry,  SIDE  specifies whether  the  symmetric matrix  A
00030 *           appears on the  left or right  in the  operation as follows:
00031 *
00032 *              SIDE = 'L' or 'l'   C := alpha*A*B + beta*C,
00033 *
00034 *              SIDE = 'R' or 'r'   C := alpha*B*A + beta*C,
00035 *
00036 *           Unchanged on exit.
00037 *
00038 *  UPLO   - CHARACTER*1.
00039 *           On  entry,   UPLO  specifies  whether  the  upper  or  lower
00040 *           triangular  part  of  the  symmetric  matrix   A  is  to  be
00041 *           referenced as follows:
00042 *
00043 *              UPLO = 'U' or 'u'   Only the upper triangular part of the
00044 *                                  symmetric matrix is to be referenced.
00045 *
00046 *              UPLO = 'L' or 'l'   Only the lower triangular part of the
00047 *                                  symmetric matrix is to be referenced.
00048 *
00049 *           Unchanged on exit.
00050 *
00051 *  M      - INTEGER.
00052 *           On entry,  M  specifies the number of rows of the matrix  C.
00053 *           M  must be at least zero.
00054 *           Unchanged on exit.
00055 *
00056 *  N      - INTEGER.
00057 *           On entry, N specifies the number of columns of the matrix C.
00058 *           N  must be at least zero.
00059 *           Unchanged on exit.
00060 *
00061 *  ALPHA  - COMPLEX*16      .
00062 *           On entry, ALPHA specifies the scalar alpha.
00063 *           Unchanged on exit.
00064 *
00065 *  A      - COMPLEX*16       array of DIMENSION ( LDA, ka ), where ka is
00066 *           m  when  SIDE = 'L' or 'l'  and is n  otherwise.
00067 *           Before entry  with  SIDE = 'L' or 'l',  the  m by m  part of
00068 *           the array  A  must contain the  symmetric matrix,  such that
00069 *           when  UPLO = 'U' or 'u', the leading m by m upper triangular
00070 *           part of the array  A  must contain the upper triangular part
00071 *           of the  symmetric matrix and the  strictly  lower triangular
00072 *           part of  A  is not referenced,  and when  UPLO = 'L' or 'l',
00073 *           the leading  m by m  lower triangular part  of the  array  A
00074 *           must  contain  the  lower triangular part  of the  symmetric
00075 *           matrix and the  strictly upper triangular part of  A  is not
00076 *           referenced.
00077 *           Before entry  with  SIDE = 'R' or 'r',  the  n by n  part of
00078 *           the array  A  must contain the  symmetric matrix,  such that
00079 *           when  UPLO = 'U' or 'u', the leading n by n upper triangular
00080 *           part of the array  A  must contain the upper triangular part
00081 *           of the  symmetric matrix and the  strictly  lower triangular
00082 *           part of  A  is not referenced,  and when  UPLO = 'L' or 'l',
00083 *           the leading  n by n  lower triangular part  of the  array  A
00084 *           must  contain  the  lower triangular part  of the  symmetric
00085 *           matrix and the  strictly upper triangular part of  A  is not
00086 *           referenced.
00087 *           Unchanged on exit.
00088 *
00089 *  LDA    - INTEGER.
00090 *           On entry, LDA specifies the first dimension of A as declared
00091 *           in the  calling (sub) program. When  SIDE = 'L' or 'l'  then
00092 *           LDA must be at least  max( 1, m ), otherwise  LDA must be at
00093 *           least max( 1, n ).
00094 *           Unchanged on exit.
00095 *
00096 *  B      - COMPLEX*16       array of DIMENSION ( LDB, n ).
00097 *           Before entry, the leading  m by n part of the array  B  must
00098 *           contain the matrix B.
00099 *           Unchanged on exit.
00100 *
00101 *  LDB    - INTEGER.
00102 *           On entry, LDB specifies the first dimension of B as declared
00103 *           in  the  calling  (sub)  program.   LDB  must  be  at  least
00104 *           max( 1, m ).
00105 *           Unchanged on exit.
00106 *
00107 *  BETA   - COMPLEX*16      .
00108 *           On entry,  BETA  specifies the scalar  beta.  When  BETA  is
00109 *           supplied as zero then C need not be set on input.
00110 *           Unchanged on exit.
00111 *
00112 *  C      - COMPLEX*16       array of DIMENSION ( LDC, n ).
00113 *           Before entry, the leading  m by n  part of the array  C must
00114 *           contain the matrix  C,  except when  beta  is zero, in which
00115 *           case C need not be set on entry.
00116 *           On exit, the array  C  is overwritten by the  m by n updated
00117 *           matrix.
00118 *
00119 *  LDC    - INTEGER.
00120 *           On entry, LDC specifies the first dimension of C as declared
00121 *           in  the  calling  (sub)  program.   LDC  must  be  at  least
00122 *           max( 1, m ).
00123 *           Unchanged on exit.
00124 *
00125 *  Further Details
00126 *  ===============
00127 *
00128 *  Level 3 Blas routine.
00129 *
00130 *  -- Written on 8-February-1989.
00131 *     Jack Dongarra, Argonne National Laboratory.
00132 *     Iain Duff, AERE Harwell.
00133 *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
00134 *     Sven Hammarling, Numerical Algorithms Group Ltd.
00135 *
00136 *  =====================================================================
00137 *
00138 *     .. External Functions ..
00139       LOGICAL LSAME
00140       EXTERNAL LSAME
00141 *     ..
00142 *     .. External Subroutines ..
00143       EXTERNAL XERBLA
00144 *     ..
00145 *     .. Intrinsic Functions ..
00146       INTRINSIC MAX
00147 *     ..
00148 *     .. Local Scalars ..
00149       DOUBLE COMPLEX TEMP1,TEMP2
00150       INTEGER I,INFO,J,K,NROWA
00151       LOGICAL UPPER
00152 *     ..
00153 *     .. Parameters ..
00154       DOUBLE COMPLEX ONE
00155       PARAMETER (ONE= (1.0D+0,0.0D+0))
00156       DOUBLE COMPLEX ZERO
00157       PARAMETER (ZERO= (0.0D+0,0.0D+0))
00158 *     ..
00159 *
00160 *     Set NROWA as the number of rows of A.
00161 *
00162       IF (LSAME(SIDE,'L')) THEN
00163           NROWA = M
00164       ELSE
00165           NROWA = N
00166       END IF
00167       UPPER = LSAME(UPLO,'U')
00168 *
00169 *     Test the input parameters.
00170 *
00171       INFO = 0
00172       IF ((.NOT.LSAME(SIDE,'L')) .AND. (.NOT.LSAME(SIDE,'R'))) THEN
00173           INFO = 1
00174       ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
00175           INFO = 2
00176       ELSE IF (M.LT.0) THEN
00177           INFO = 3
00178       ELSE IF (N.LT.0) THEN
00179           INFO = 4
00180       ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
00181           INFO = 7
00182       ELSE IF (LDB.LT.MAX(1,M)) THEN
00183           INFO = 9
00184       ELSE IF (LDC.LT.MAX(1,M)) THEN
00185           INFO = 12
00186       END IF
00187       IF (INFO.NE.0) THEN
00188           CALL XERBLA('ZSYMM ',INFO)
00189           RETURN
00190       END IF
00191 *
00192 *     Quick return if possible.
00193 *
00194       IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
00195      +    ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
00196 *
00197 *     And when  alpha.eq.zero.
00198 *
00199       IF (ALPHA.EQ.ZERO) THEN
00200           IF (BETA.EQ.ZERO) THEN
00201               DO 20 J = 1,N
00202                   DO 10 I = 1,M
00203                       C(I,J) = ZERO
00204    10             CONTINUE
00205    20         CONTINUE
00206           ELSE
00207               DO 40 J = 1,N
00208                   DO 30 I = 1,M
00209                       C(I,J) = BETA*C(I,J)
00210    30             CONTINUE
00211    40         CONTINUE
00212           END IF
00213           RETURN
00214       END IF
00215 *
00216 *     Start the operations.
00217 *
00218       IF (LSAME(SIDE,'L')) THEN
00219 *
00220 *        Form  C := alpha*A*B + beta*C.
00221 *
00222           IF (UPPER) THEN
00223               DO 70 J = 1,N
00224                   DO 60 I = 1,M
00225                       TEMP1 = ALPHA*B(I,J)
00226                       TEMP2 = ZERO
00227                       DO 50 K = 1,I - 1
00228                           C(K,J) = C(K,J) + TEMP1*A(K,I)
00229                           TEMP2 = TEMP2 + B(K,J)*A(K,I)
00230    50                 CONTINUE
00231                       IF (BETA.EQ.ZERO) THEN
00232                           C(I,J) = TEMP1*A(I,I) + ALPHA*TEMP2
00233                       ELSE
00234                           C(I,J) = BETA*C(I,J) + TEMP1*A(I,I) +
00235      +                             ALPHA*TEMP2
00236                       END IF
00237    60             CONTINUE
00238    70         CONTINUE
00239           ELSE
00240               DO 100 J = 1,N
00241                   DO 90 I = M,1,-1
00242                       TEMP1 = ALPHA*B(I,J)
00243                       TEMP2 = ZERO
00244                       DO 80 K = I + 1,M
00245                           C(K,J) = C(K,J) + TEMP1*A(K,I)
00246                           TEMP2 = TEMP2 + B(K,J)*A(K,I)
00247    80                 CONTINUE
00248                       IF (BETA.EQ.ZERO) THEN
00249                           C(I,J) = TEMP1*A(I,I) + ALPHA*TEMP2
00250                       ELSE
00251                           C(I,J) = BETA*C(I,J) + TEMP1*A(I,I) +
00252      +                             ALPHA*TEMP2
00253                       END IF
00254    90             CONTINUE
00255   100         CONTINUE
00256           END IF
00257       ELSE
00258 *
00259 *        Form  C := alpha*B*A + beta*C.
00260 *
00261           DO 170 J = 1,N
00262               TEMP1 = ALPHA*A(J,J)
00263               IF (BETA.EQ.ZERO) THEN
00264                   DO 110 I = 1,M
00265                       C(I,J) = TEMP1*B(I,J)
00266   110             CONTINUE
00267               ELSE
00268                   DO 120 I = 1,M
00269                       C(I,J) = BETA*C(I,J) + TEMP1*B(I,J)
00270   120             CONTINUE
00271               END IF
00272               DO 140 K = 1,J - 1
00273                   IF (UPPER) THEN
00274                       TEMP1 = ALPHA*A(K,J)
00275                   ELSE
00276                       TEMP1 = ALPHA*A(J,K)
00277                   END IF
00278                   DO 130 I = 1,M
00279                       C(I,J) = C(I,J) + TEMP1*B(I,K)
00280   130             CONTINUE
00281   140         CONTINUE
00282               DO 160 K = J + 1,N
00283                   IF (UPPER) THEN
00284                       TEMP1 = ALPHA*A(J,K)
00285                   ELSE
00286                       TEMP1 = ALPHA*A(K,J)
00287                   END IF
00288                   DO 150 I = 1,M
00289                       C(I,J) = C(I,J) + TEMP1*B(I,K)
00290   150             CONTINUE
00291   160         CONTINUE
00292   170     CONTINUE
00293       END IF
00294 *
00295       RETURN
00296 *
00297 *     End of ZSYMM .
00298 *
00299       END
 All Files Functions