home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Geek Gadgets 1
/
ADE-1.bin
/
ade-dist
/
eispack-1.0-src.tgz
/
tar.out
/
contrib
/
eispack
/
cg.f
< prev
next >
Wrap
Text File
|
1996-09-28
|
2KB
|
64 lines
subroutine cg(nm,n,ar,ai,wr,wi,matz,zr,zi,fv1,fv2,fv3,ierr)
c
integer n,nm,is1,is2,ierr,matz
double precision ar(nm,n),ai(nm,n),wr(n),wi(n),zr(nm,n),zi(nm,n),
x fv1(n),fv2(n),fv3(n)
c
c this subroutine calls the recommended sequence of
c subroutines from the eigensystem subroutine package (eispack)
c to find the eigenvalues and eigenvectors (if desired)
c of a complex general matrix.
c
c on input
c
c nm must be set to the row dimension of the two-dimensional
c array parameters as declared in the calling program
c dimension statement.
c
c n is the order of the matrix a=(ar,ai).
c
c ar and ai contain the real and imaginary parts,
c respectively, of the complex general matrix.
c
c matz is an integer variable set equal to zero if
c only eigenvalues are desired. otherwise it is set to
c any non-zero integer for both eigenvalues and eigenvectors.
c
c on output
c
c wr and wi contain the real and imaginary parts,
c respectively, of the eigenvalues.
c
c zr and zi contain the real and imaginary parts,
c respectively, of the eigenvectors if matz is not zero.
c
c ierr is an integer output variable set equal to an error
c completion code described in the documentation for comqr
c and comqr2. the normal completion code is zero.
c
c fv1, fv2, and fv3 are temporary storage arrays.
c
c questions and comments should be directed to burton s. garbow,
c mathematics and computer science div, argonne national laboratory
c
c this version dated august 1983.
c
c ------------------------------------------------------------------
c
if (n .le. nm) go to 10
ierr = 10 * n
go to 50
c
10 call cbal(nm,n,ar,ai,is1,is2,fv1)
call corth(nm,n,is1,is2,ar,ai,fv2,fv3)
if (matz .ne. 0) go to 20
c .......... find eigenvalues only ..........
call comqr(nm,n,is1,is2,ar,ai,wr,wi,ierr)
go to 50
c .......... find both eigenvalues and eigenvectors ..........
20 call comqr2(nm,n,is1,is2,fv2,fv3,ar,ai,wr,wi,zr,zi,ierr)
if (ierr .ne. 0) go to 50
call cbabk2(nm,n,is1,is2,fv1,n,zr,zi)
50 return
end