d4/d2c/zgennd_8f_source.html

00001       LOGICAL FUNCTION ZGENND (M, N, A, LDA)
00002       IMPLICIT NONE
00003 *
00004 *  -- LAPACK test routine (version 3.1) --
00005 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00006 *     February 2008
00007 *
00008 *     .. Scalar Arguments ..
00009       INTEGER M, N, LDA
00010 *     ..
00011 *     .. Array Arguments ..
00012       COMPLEX*16 A( LDA, * )
00013 *     ..
00014 *
00015 *  Purpose
00016 *  =======
00017 *
00018 *     ZGENND tests that its argument has a real, non-negative diagonal.
00019 *
00020 *  Arguments
00021 *  =========
00022 *
00023 *  M       (input) INTEGER
00024 *          The number of rows in A.
00025 *
00026 *  N       (input) INTEGER
00027 *          The number of columns in A.
00028 *
00029 *  A       (input) COMPLEX*16 array, dimension (LDA, N)
00030 *          The matrix.
00031 *
00032 *  LDA     (input) INTEGER
00033 *          Leading dimension of A.
00034 *
00035 *  =====================================================================
00036 *
00037 *     .. Parameters ..
00038       REAL               ZERO
00039       PARAMETER          ( ZERO = 0.0E0 )
00040 *     ..
00041 *     .. Local Scalars ..
00042       LOGICAL OUT
00043       INTEGER I, K
00044       COMPLEX*16 AII
00045 *     ..
00046 *     .. Intrinsics ..
00047       INTRINSIC MIN, DBLE, DIMAG
00048 *     ..
00049 *     .. Executable Statements ..
00050       K = MIN( M, N )
00051       DO I = 1, K
00052          AII = A( I, I )
00053          IF( DBLE( AII ).LT.ZERO.OR.DIMAG( AII ).NE.ZERO ) THEN
00054             ZGENND = .FALSE.
00055             RETURN
00056          END IF
00057       END DO
00058       ZGENND = .TRUE.
00059       RETURN
00060       END