Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Debugging issue

Status
Not open for further replies.

svar

Programmer
Aug 12, 2001
349
GR
When running the zgees lapack program the actual matrix dimension N (=4)
apparently changes to 0 on a statement SDIM=0 that does not affect N
I looked for a NaN problem, but could not find something

Then I ran gdb and noticed that although the declared matrix dimension LDA=10, these arrays A(LDA,LDA), BWORK(LDA) have more bytes than the maximum allowed, which is absurd. I am not sure if this is relevant.
Any tips on how to proceed?








SUBROUTINE ZGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, W, VS,
$ LDVS, WORK, LWORK, RWORK, BWORK, INFO )
*
* -- LAPACK driver routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* December 2016
*
* .. Scalar Arguments ..
CHARACTER JOBVS, SORT
INTEGER INFO, LDA, LDVS, LWORK, N, SDIM
* ..
* .. Array Arguments ..
LOGICAL BWORK( * )
DOUBLE PRECISION RWORK( * )
COMPLEX*16 A( LDA, * ), VS( LDVS, * ), W( * ), WORK( * )
* ..
* .. Function Arguments ..
LOGICAL SELECT
EXTERNAL SELECT
* ..
*
* =====================================================================
*
* .. Parameters ..
DOUBLE PRECISION ZERO, ONE
PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
* ..
* .. Local Scalars ..
LOGICAL LQUERY, SCALEA, WANTST, WANTVS
INTEGER HSWORK, I, IBAL, ICOND, IERR, IEVAL, IHI, ILO,
$ ITAU, IWRK, MAXWRK, MINWRK
DOUBLE PRECISION ANRM, BIGNUM, CSCALE, EPS, S, SEP, SMLNUM
* ..
* .. Local Arrays ..
DOUBLE PRECISION DUM( 1 )
* ..
* .. External Subroutines ..
EXTERNAL DLABAD, XERBLA, ZCOPY, ZGEBAK, ZGEBAL, ZGEHRD,
$ ZHSEQR, ZLACPY, ZLASCL, ZTRSEN, ZUNGHR
* ..
* .. External Functions ..
LOGICAL LSAME
INTEGER ILAENV
DOUBLE PRECISION DLAMCH, ZLANGE
EXTERNAL LSAME, ILAENV, DLAMCH, ZLANGE
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX, SQRT
* ..
* .. Executable Statements ..
*
* Test the input arguments
*
if(jobvs.ne.jobvs)write(6,*)'jobvs=',jobvs
if (sort.ne.sort) write(6,*)'sort=',sort
c if(select.ne.select)write(6,*)'select=',select
if(n.ne.n) write(6,*)'n=',n
if(info.ne.info) write(6,*)'info=',info
if(Lwork.ne.lwork) write(6,*)'lwork=',lwork
if(ldvs.ne.ldvs) write(6,*)'ldvs=',ldvs
do 81 ilj=1,n
do 82 klj=1,n
if(a(klj,ilj).ne.a(klj,ilj))write(6,*)
z 'a(',klj,ilj,')=',a(klj,ilj)
82 continue
81 continue


INFO = 0
LQUERY = ( LWORK.EQ.-1 )
WANTVS = LSAME( JOBVS, 'V' )
WANTST = LSAME( SORT, 'S' )
IF( ( .NOT.WANTVS ) .AND. ( .NOT.LSAME( JOBVS, 'N' ) ) ) THEN
INFO = -1
ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN
INFO = -2
ELSE IF( N.LT.0 ) THEN
INFO = -4
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
INFO = -6
ELSE IF( LDVS.LT.1 .OR. ( WANTVS .AND. LDVS.LT.N ) ) THEN
INFO = -10
END IF
*
* Compute workspace
* (Note: Comments in the code beginning "Workspace:" describe the
* minimal amount of workspace needed at that point in the code,
* as well as the preferred amount for good performance.
* CWorkspace refers to complex workspace, and RWorkspace to real
* workspace. NB refers to the optimal block size for the
* immediately following subroutine, as returned by ILAENV.
* HSWORK refers to the workspace preferred by ZHSEQR, as
* calculated below. HSWORK is computed assuming ILO=1 and IHI=N,
* the worst case.)
*
IF( INFO.EQ.0 ) THEN
IF( N.EQ.0 ) THEN
MINWRK = 1
MAXWRK = 1
ELSE
MAXWRK = N + N*ILAENV( 1, 'ZGEHRD', ' ', N, 1, N, 0 )
MINWRK = 2*N
*
c write(6,*)'calling zhseqr with jobvs,n=',jobvs,n
CALL ZHSEQR( 'S', JOBVS, N, 1, N, A, LDA, W, VS, LDVS,
$ WORK, -1, IEVAL )
HSWORK = WORK( 1 )
*
IF( .NOT.WANTVS ) THEN
MAXWRK = MAX( MAXWRK, HSWORK )
ELSE
MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'ZUNGHR',
$ ' ', N, 1, N, -1 ) )
MAXWRK = MAX( MAXWRK, HSWORK )
END IF
END IF
WORK( 1 ) = MAXWRK
*
IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
INFO = -12
END IF
END IF
*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZGEES ', -INFO )
RETURN
ELSE IF( LQUERY ) THEN
RETURN
END IF
*
* Quick return if possible
*
IF( N.EQ.0 ) THEN
SDIM = 0
RETURN
END IF
*
* Get machine constants
*
EPS = DLAMCH( 'P' )
SMLNUM = DLAMCH( 'S' )
BIGNUM = ONE / SMLNUM
CALL DLABAD( SMLNUM, BIGNUM )
SMLNUM = SQRT( SMLNUM ) / EPS
BIGNUM = ONE / SMLNUM
*
* Scale A if max element outside range [SMLNUM,BIGNUM]
*
ANRM = ZLANGE( 'M', N, N, A, LDA, DUM )
c write(6,*)'after zlange n=',n
SCALEA = .FALSE.
IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
SCALEA = .TRUE.
CSCALE = SMLNUM
ELSE IF( ANRM.GT.BIGNUM ) THEN
SCALEA = .TRUE.
CSCALE = BIGNUM
END IF
IF( SCALEA )
$ CALL ZLASCL( 'G', 0, 0, ANRM, CSCALE, N, N, A, LDA, IERR )
c write(6,*)'after zlascl n=',n
*
* Permute the matrix to make it more nearly triangular
* (CWorkspace: none)
* (RWorkspace: need N)
*
IBAL = 1
CALL ZGEBAL( 'P', N, A, LDA, ILO, IHI, RWORK( IBAL ), IERR )
write(6,*)'after zgebal n=',n
*
* Reduce to upper Hessenberg form
* (CWorkspace: need 2*N, prefer N+N*NB)
* (RWorkspace: none)
*
ITAU = 1
IWRK = N + ITAU
CALL ZGEHRD( N, ILO, IHI, A, LDA, WORK( ITAU ), WORK( IWRK ),
$ LWORK-IWRK+1, IERR )
c write(6,*)'after zgehrd n=',n,'wantvs=',wantvs
*
IF( WANTVS ) THEN
*
* Copy Householder vectors to VS
*
CALL ZLACPY( 'L', N, N, A, LDA, VS, LDVS )
c write(6,*)'after zlacpy n=',n
*
* Generate unitary matrix in VS
* (CWorkspace: need 2*N-1, prefer N+(N-1)*NB)
* (RWorkspace: none)
*
CALL ZUNGHR( N, ILO, IHI, VS, LDVS, WORK( ITAU ), WORK( IWRK ),
$ LWORK-IWRK+1, IERR )
c write(6,*)'after zunghr n=',n
END IF
*
write(6,*)'here says (correctly) n=4 before sdim n=',n,sdim

SDIM = 0
*
* Perform QR iteration, accumulating Schur vectors in VS if desired
* (CWorkspace: need 1, prefer HSWORK (see comments) )
* (RWorkspace: none)
*
write(6,*)' Here it says n=0 before iwrk n=',n,sdim
IWRK = ITAU
write(6,*)'lling zhseqr with jobvs,n,ilo,ihi=',jobvs,N,
z ilo,ihi
CALL ZHSEQR( 'S', JOBVS, N, ILO, IHI, A, LDA, W,
$ VS, LDVS, WORK( IWRK ), LWORK-IWRK+1, IEVAL )
IF( IEVAL.GT.0 )
$ INFO = IEVAL
*
* Sort eigenvalues if desired
*
IF( WANTST .AND. INFO.EQ.0 ) THEN
IF( SCALEA )
$ CALL ZLASCL( 'G', 0, 0, CSCALE, ANRM, N, 1, W, N, IERR )
DO 10 I = 1, N
BWORK( I ) = SELECT( W( I ) )
10 CONTINUE
*
* Reorder eigenvalues and transform Schur vectors
* (CWorkspace: none)
* (RWorkspace: none)
*
CALL ZTRSEN( 'N', JOBVS, BWORK, N, A, LDA, VS, LDVS, W, SDIM,
$ S, SEP, WORK( IWRK ), LWORK-IWRK+1, ICOND )
END IF
*
IF( WANTVS ) THEN
*
* Undo balancing
* (CWorkspace: none)
* (RWorkspace: need N)
*
CALL ZGEBAK( 'P', 'R', N, ILO, IHI, RWORK( IBAL ), N, VS, LDVS,
$ IERR )
END IF
*
IF( SCALEA ) THEN
*
* Undo scaling for the Schur form of A
*
CALL ZLASCL( 'U', 0, 0, CSCALE, ANRM, N, N, A, LDA, IERR )
CALL ZCOPY( N, A, LDA+1, W, 1 )
END IF
*
WORK( 1 ) = MAXWRK
RETURN
*
* End of ZGEES
*
END
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top