Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement