LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ lseres()

logical function lseres ( character*2  type,
character*1  uplo,
integer  m,
integer  n,
real, dimension( lda, * )  aa,
real, dimension( lda, * )  as,
integer  lda 
)

Definition at line 2999 of file sblat2.f.

3000*
3001* Tests if selected elements in two arrays are equal.
3002*
3003* TYPE is 'GE', 'SY' or 'SP'.
3004*
3005* Auxiliary routine for test program for Level 2 Blas.
3006*
3007* -- Written on 10-August-1987.
3008* Richard Hanson, Sandia National Labs.
3009* Jeremy Du Croz, NAG Central Office.
3010*
3011* .. Scalar Arguments ..
3012 INTEGER LDA, M, N
3013 CHARACTER*1 UPLO
3014 CHARACTER*2 TYPE
3015* .. Array Arguments ..
3016 REAL AA( LDA, * ), AS( LDA, * )
3017* .. Local Scalars ..
3018 INTEGER I, IBEG, IEND, J
3019 LOGICAL UPPER
3020* .. Executable Statements ..
3021 upper = uplo.EQ.'U'
3022 IF( type.EQ.'GE' )THEN
3023 DO 20 j = 1, n
3024 DO 10 i = m + 1, lda
3025 IF( aa( i, j ).NE.as( i, j ) )
3026 $ GO TO 70
3027 10 CONTINUE
3028 20 CONTINUE
3029 ELSE IF( type.EQ.'SY' )THEN
3030 DO 50 j = 1, n
3031 IF( upper )THEN
3032 ibeg = 1
3033 iend = j
3034 ELSE
3035 ibeg = j
3036 iend = n
3037 END IF
3038 DO 30 i = 1, ibeg - 1
3039 IF( aa( i, j ).NE.as( i, j ) )
3040 $ GO TO 70
3041 30 CONTINUE
3042 DO 40 i = iend + 1, lda
3043 IF( aa( i, j ).NE.as( i, j ) )
3044 $ GO TO 70
3045 40 CONTINUE
3046 50 CONTINUE
3047 END IF
3048*
3049 lseres = .true.
3050 GO TO 80
3051 70 CONTINUE
3052 lseres = .false.
3053 80 RETURN
3054*
3055* End of LSERES
3056*
logical function lseres(type, uplo, m, n, aa, as, lda)
Definition sblat2.f:3000
Here is the call graph for this function:
Here is the caller graph for this function: