Annotation of rpl/lapack/blas/zsymm.f, revision 1.15

1.7       bertrand    1: *> \brief \b ZSYMM
                      2: *
                      3: *  =========== DOCUMENTATION ===========
                      4: *
1.12      bertrand    5: * Online html documentation available at
                      6: *            http://www.netlib.org/lapack/explore-html/
1.7       bertrand    7: *
                      8: *  Definition:
                      9: *  ===========
                     10: *
                     11: *       SUBROUTINE ZSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
1.12      bertrand   12: *
1.7       bertrand   13: *       .. Scalar Arguments ..
                     14: *       COMPLEX*16 ALPHA,BETA
                     15: *       INTEGER LDA,LDB,LDC,M,N
                     16: *       CHARACTER SIDE,UPLO
                     17: *       ..
                     18: *       .. Array Arguments ..
                     19: *       COMPLEX*16 A(LDA,*),B(LDB,*),C(LDC,*)
                     20: *       ..
1.12      bertrand   21: *
1.7       bertrand   22: *
                     23: *> \par Purpose:
                     24: *  =============
                     25: *>
                     26: *> \verbatim
                     27: *>
                     28: *> ZSYMM  performs one of the matrix-matrix operations
                     29: *>
                     30: *>    C := alpha*A*B + beta*C,
                     31: *>
                     32: *> or
                     33: *>
                     34: *>    C := alpha*B*A + beta*C,
                     35: *>
                     36: *> where  alpha and beta are scalars, A is a symmetric matrix and  B and
                     37: *> C are m by n matrices.
                     38: *> \endverbatim
                     39: *
                     40: *  Arguments:
                     41: *  ==========
                     42: *
                     43: *> \param[in] SIDE
                     44: *> \verbatim
                     45: *>          SIDE is CHARACTER*1
                     46: *>           On entry,  SIDE  specifies whether  the  symmetric matrix  A
                     47: *>           appears on the  left or right  in the  operation as follows:
                     48: *>
                     49: *>              SIDE = 'L' or 'l'   C := alpha*A*B + beta*C,
                     50: *>
                     51: *>              SIDE = 'R' or 'r'   C := alpha*B*A + beta*C,
                     52: *> \endverbatim
                     53: *>
                     54: *> \param[in] UPLO
                     55: *> \verbatim
                     56: *>          UPLO is CHARACTER*1
                     57: *>           On  entry,   UPLO  specifies  whether  the  upper  or  lower
                     58: *>           triangular  part  of  the  symmetric  matrix   A  is  to  be
                     59: *>           referenced as follows:
                     60: *>
                     61: *>              UPLO = 'U' or 'u'   Only the upper triangular part of the
                     62: *>                                  symmetric matrix is to be referenced.
                     63: *>
                     64: *>              UPLO = 'L' or 'l'   Only the lower triangular part of the
                     65: *>                                  symmetric matrix is to be referenced.
                     66: *> \endverbatim
                     67: *>
                     68: *> \param[in] M
                     69: *> \verbatim
                     70: *>          M is INTEGER
                     71: *>           On entry,  M  specifies the number of rows of the matrix  C.
                     72: *>           M  must be at least zero.
                     73: *> \endverbatim
                     74: *>
                     75: *> \param[in] N
                     76: *> \verbatim
                     77: *>          N is INTEGER
                     78: *>           On entry, N specifies the number of columns of the matrix C.
                     79: *>           N  must be at least zero.
                     80: *> \endverbatim
                     81: *>
                     82: *> \param[in] ALPHA
                     83: *> \verbatim
                     84: *>          ALPHA is COMPLEX*16
                     85: *>           On entry, ALPHA specifies the scalar alpha.
                     86: *> \endverbatim
                     87: *>
                     88: *> \param[in] A
                     89: *> \verbatim
1.13      bertrand   90: *>          A is COMPLEX*16 array, dimension ( LDA, ka ), where ka is
1.7       bertrand   91: *>           m  when  SIDE = 'L' or 'l'  and is n  otherwise.
                     92: *>           Before entry  with  SIDE = 'L' or 'l',  the  m by m  part of
                     93: *>           the array  A  must contain the  symmetric matrix,  such that
                     94: *>           when  UPLO = 'U' or 'u', the leading m by m upper triangular
                     95: *>           part of the array  A  must contain the upper triangular part
                     96: *>           of the  symmetric matrix and the  strictly  lower triangular
                     97: *>           part of  A  is not referenced,  and when  UPLO = 'L' or 'l',
                     98: *>           the leading  m by m  lower triangular part  of the  array  A
                     99: *>           must  contain  the  lower triangular part  of the  symmetric
                    100: *>           matrix and the  strictly upper triangular part of  A  is not
                    101: *>           referenced.
                    102: *>           Before entry  with  SIDE = 'R' or 'r',  the  n by n  part of
                    103: *>           the array  A  must contain the  symmetric matrix,  such that
                    104: *>           when  UPLO = 'U' or 'u', the leading n by n upper triangular
                    105: *>           part of the array  A  must contain the upper triangular part
                    106: *>           of the  symmetric matrix and the  strictly  lower triangular
                    107: *>           part of  A  is not referenced,  and when  UPLO = 'L' or 'l',
                    108: *>           the leading  n by n  lower triangular part  of the  array  A
                    109: *>           must  contain  the  lower triangular part  of the  symmetric
                    110: *>           matrix and the  strictly upper triangular part of  A  is not
                    111: *>           referenced.
                    112: *> \endverbatim
                    113: *>
                    114: *> \param[in] LDA
                    115: *> \verbatim
                    116: *>          LDA is INTEGER
                    117: *>           On entry, LDA specifies the first dimension of A as declared
                    118: *>           in the  calling (sub) program. When  SIDE = 'L' or 'l'  then
                    119: *>           LDA must be at least  max( 1, m ), otherwise  LDA must be at
                    120: *>           least max( 1, n ).
                    121: *> \endverbatim
                    122: *>
                    123: *> \param[in] B
                    124: *> \verbatim
1.13      bertrand  125: *>          B is COMPLEX*16 array, dimension ( LDB, N )
1.7       bertrand  126: *>           Before entry, the leading  m by n part of the array  B  must
                    127: *>           contain the matrix B.
                    128: *> \endverbatim
                    129: *>
                    130: *> \param[in] LDB
                    131: *> \verbatim
                    132: *>          LDB is INTEGER
                    133: *>           On entry, LDB specifies the first dimension of B as declared
                    134: *>           in  the  calling  (sub)  program.   LDB  must  be  at  least
                    135: *>           max( 1, m ).
                    136: *> \endverbatim
                    137: *>
                    138: *> \param[in] BETA
                    139: *> \verbatim
                    140: *>          BETA is COMPLEX*16
                    141: *>           On entry,  BETA  specifies the scalar  beta.  When  BETA  is
                    142: *>           supplied as zero then C need not be set on input.
                    143: *> \endverbatim
                    144: *>
                    145: *> \param[in,out] C
                    146: *> \verbatim
1.13      bertrand  147: *>          C is COMPLEX*16 array, dimension ( LDC, N )
1.7       bertrand  148: *>           Before entry, the leading  m by n  part of the array  C must
                    149: *>           contain the matrix  C,  except when  beta  is zero, in which
                    150: *>           case C need not be set on entry.
                    151: *>           On exit, the array  C  is overwritten by the  m by n updated
                    152: *>           matrix.
                    153: *> \endverbatim
                    154: *>
                    155: *> \param[in] LDC
                    156: *> \verbatim
                    157: *>          LDC is INTEGER
                    158: *>           On entry, LDC specifies the first dimension of C as declared
                    159: *>           in  the  calling  (sub)  program.   LDC  must  be  at  least
                    160: *>           max( 1, m ).
                    161: *> \endverbatim
                    162: *
                    163: *  Authors:
                    164: *  ========
                    165: *
1.12      bertrand  166: *> \author Univ. of Tennessee
                    167: *> \author Univ. of California Berkeley
                    168: *> \author Univ. of Colorado Denver
                    169: *> \author NAG Ltd.
1.7       bertrand  170: *
                    171: *> \ingroup complex16_blas_level3
                    172: *
                    173: *> \par Further Details:
                    174: *  =====================
                    175: *>
                    176: *> \verbatim
                    177: *>
                    178: *>  Level 3 Blas routine.
                    179: *>
                    180: *>  -- Written on 8-February-1989.
                    181: *>     Jack Dongarra, Argonne National Laboratory.
                    182: *>     Iain Duff, AERE Harwell.
                    183: *>     Jeremy Du Croz, Numerical Algorithms Group Ltd.
                    184: *>     Sven Hammarling, Numerical Algorithms Group Ltd.
                    185: *> \endverbatim
                    186: *>
                    187: *  =====================================================================
1.1       bertrand  188:       SUBROUTINE ZSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
1.7       bertrand  189: *
1.15    ! bertrand  190: *  -- Reference BLAS level3 routine --
1.7       bertrand  191: *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
                    192: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
                    193: *
1.1       bertrand  194: *     .. Scalar Arguments ..
1.7       bertrand  195:       COMPLEX*16 ALPHA,BETA
1.1       bertrand  196:       INTEGER LDA,LDB,LDC,M,N
                    197:       CHARACTER SIDE,UPLO
                    198: *     ..
                    199: *     .. Array Arguments ..
1.7       bertrand  200:       COMPLEX*16 A(LDA,*),B(LDB,*),C(LDC,*)
1.1       bertrand  201: *     ..
                    202: *
                    203: *  =====================================================================
                    204: *
                    205: *     .. External Functions ..
                    206:       LOGICAL LSAME
                    207:       EXTERNAL LSAME
                    208: *     ..
                    209: *     .. External Subroutines ..
                    210:       EXTERNAL XERBLA
                    211: *     ..
                    212: *     .. Intrinsic Functions ..
                    213:       INTRINSIC MAX
                    214: *     ..
                    215: *     .. Local Scalars ..
1.7       bertrand  216:       COMPLEX*16 TEMP1,TEMP2
1.1       bertrand  217:       INTEGER I,INFO,J,K,NROWA
                    218:       LOGICAL UPPER
                    219: *     ..
                    220: *     .. Parameters ..
1.7       bertrand  221:       COMPLEX*16 ONE
1.1       bertrand  222:       PARAMETER (ONE= (1.0D+0,0.0D+0))
1.7       bertrand  223:       COMPLEX*16 ZERO
1.1       bertrand  224:       PARAMETER (ZERO= (0.0D+0,0.0D+0))
                    225: *     ..
                    226: *
                    227: *     Set NROWA as the number of rows of A.
                    228: *
                    229:       IF (LSAME(SIDE,'L')) THEN
                    230:           NROWA = M
                    231:       ELSE
                    232:           NROWA = N
                    233:       END IF
                    234:       UPPER = LSAME(UPLO,'U')
                    235: *
                    236: *     Test the input parameters.
                    237: *
                    238:       INFO = 0
                    239:       IF ((.NOT.LSAME(SIDE,'L')) .AND. (.NOT.LSAME(SIDE,'R'))) THEN
                    240:           INFO = 1
                    241:       ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
                    242:           INFO = 2
                    243:       ELSE IF (M.LT.0) THEN
                    244:           INFO = 3
                    245:       ELSE IF (N.LT.0) THEN
                    246:           INFO = 4
                    247:       ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
                    248:           INFO = 7
                    249:       ELSE IF (LDB.LT.MAX(1,M)) THEN
                    250:           INFO = 9
                    251:       ELSE IF (LDC.LT.MAX(1,M)) THEN
                    252:           INFO = 12
                    253:       END IF
                    254:       IF (INFO.NE.0) THEN
                    255:           CALL XERBLA('ZSYMM ',INFO)
                    256:           RETURN
                    257:       END IF
                    258: *
                    259: *     Quick return if possible.
                    260: *
                    261:       IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
                    262:      +    ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
                    263: *
                    264: *     And when  alpha.eq.zero.
                    265: *
                    266:       IF (ALPHA.EQ.ZERO) THEN
                    267:           IF (BETA.EQ.ZERO) THEN
                    268:               DO 20 J = 1,N
                    269:                   DO 10 I = 1,M
                    270:                       C(I,J) = ZERO
                    271:    10             CONTINUE
                    272:    20         CONTINUE
                    273:           ELSE
                    274:               DO 40 J = 1,N
                    275:                   DO 30 I = 1,M
                    276:                       C(I,J) = BETA*C(I,J)
                    277:    30             CONTINUE
                    278:    40         CONTINUE
                    279:           END IF
                    280:           RETURN
                    281:       END IF
                    282: *
                    283: *     Start the operations.
                    284: *
                    285:       IF (LSAME(SIDE,'L')) THEN
                    286: *
                    287: *        Form  C := alpha*A*B + beta*C.
                    288: *
                    289:           IF (UPPER) THEN
                    290:               DO 70 J = 1,N
                    291:                   DO 60 I = 1,M
                    292:                       TEMP1 = ALPHA*B(I,J)
                    293:                       TEMP2 = ZERO
                    294:                       DO 50 K = 1,I - 1
                    295:                           C(K,J) = C(K,J) + TEMP1*A(K,I)
                    296:                           TEMP2 = TEMP2 + B(K,J)*A(K,I)
                    297:    50                 CONTINUE
                    298:                       IF (BETA.EQ.ZERO) THEN
                    299:                           C(I,J) = TEMP1*A(I,I) + ALPHA*TEMP2
                    300:                       ELSE
                    301:                           C(I,J) = BETA*C(I,J) + TEMP1*A(I,I) +
                    302:      +                             ALPHA*TEMP2
                    303:                       END IF
                    304:    60             CONTINUE
                    305:    70         CONTINUE
                    306:           ELSE
                    307:               DO 100 J = 1,N
                    308:                   DO 90 I = M,1,-1
                    309:                       TEMP1 = ALPHA*B(I,J)
                    310:                       TEMP2 = ZERO
                    311:                       DO 80 K = I + 1,M
                    312:                           C(K,J) = C(K,J) + TEMP1*A(K,I)
                    313:                           TEMP2 = TEMP2 + B(K,J)*A(K,I)
                    314:    80                 CONTINUE
                    315:                       IF (BETA.EQ.ZERO) THEN
                    316:                           C(I,J) = TEMP1*A(I,I) + ALPHA*TEMP2
                    317:                       ELSE
                    318:                           C(I,J) = BETA*C(I,J) + TEMP1*A(I,I) +
                    319:      +                             ALPHA*TEMP2
                    320:                       END IF
                    321:    90             CONTINUE
                    322:   100         CONTINUE
                    323:           END IF
                    324:       ELSE
                    325: *
                    326: *        Form  C := alpha*B*A + beta*C.
                    327: *
                    328:           DO 170 J = 1,N
                    329:               TEMP1 = ALPHA*A(J,J)
                    330:               IF (BETA.EQ.ZERO) THEN
                    331:                   DO 110 I = 1,M
                    332:                       C(I,J) = TEMP1*B(I,J)
                    333:   110             CONTINUE
                    334:               ELSE
                    335:                   DO 120 I = 1,M
                    336:                       C(I,J) = BETA*C(I,J) + TEMP1*B(I,J)
                    337:   120             CONTINUE
                    338:               END IF
                    339:               DO 140 K = 1,J - 1
                    340:                   IF (UPPER) THEN
                    341:                       TEMP1 = ALPHA*A(K,J)
                    342:                   ELSE
                    343:                       TEMP1 = ALPHA*A(J,K)
                    344:                   END IF
                    345:                   DO 130 I = 1,M
                    346:                       C(I,J) = C(I,J) + TEMP1*B(I,K)
                    347:   130             CONTINUE
                    348:   140         CONTINUE
                    349:               DO 160 K = J + 1,N
                    350:                   IF (UPPER) THEN
                    351:                       TEMP1 = ALPHA*A(J,K)
                    352:                   ELSE
                    353:                       TEMP1 = ALPHA*A(K,J)
                    354:                   END IF
                    355:                   DO 150 I = 1,M
                    356:                       C(I,J) = C(I,J) + TEMP1*B(I,K)
                    357:   150             CONTINUE
                    358:   160         CONTINUE
                    359:   170     CONTINUE
                    360:       END IF
                    361: *
                    362:       RETURN
                    363: *
1.15    ! bertrand  364: *     End of ZSYMM
1.1       bertrand  365: *
                    366:       END

CVSweb interface <joel.bertrand@systella.fr>