[COLOR=#a020f0]Program[/color] EigenVectors
[COLOR=#0000ff]! Finding Eigenvalues and Eigenvectors of a matrix A using LAPACK[/color]
[COLOR=#2e8b57][b]Implicit[/b][/color] [COLOR=#2e8b57][b]none[/b][/color]
[COLOR=#0000ff]! declarations[/color]
[COLOR=#2e8b57][b]integer[/b][/color] :: n, lda, ldvl, ldvr, lwork, lwmax, info
[COLOR=#2e8b57][b]parameter[/b][/color](n [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]2[/color], lwmax [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]1000[/color])
[COLOR=#2e8b57][b]parameter[/b][/color](lda [COLOR=#804040][b]=[/b][/color] n, ldvl [COLOR=#804040][b]=[/b][/color] n, ldvr[COLOR=#804040][b]=[/b][/color] n)
[COLOR=#2e8b57][b]double precision[/b][/color] :: A(lda,n), VL(ldvl,n), VR(ldvl,n), [highlight #ffff00][COLOR=#0000ff]&[/color][/highlight]
WR(n), WI(n), work(lwmax)
[COLOR=#0000ff]! matrix A[/color]
A([COLOR=#ff00ff]1[/color],:)[COLOR=#804040][b]=[/b][/color]([COLOR=#804040][b]/[/b][/color][COLOR=#ff00ff]3.00[/color], [COLOR=#804040][b]-[/b][/color][COLOR=#ff00ff]2.00[/color][COLOR=#804040][b]/[/b][/color])
A([COLOR=#ff00ff]2[/color],:)[COLOR=#804040][b]=[/b][/color]([COLOR=#804040][b]/[/b][/color][COLOR=#ff00ff]4.00[/color], [COLOR=#804040][b]-[/b][/color][COLOR=#ff00ff]1.00[/color][COLOR=#804040][b]/[/b][/color])
[COLOR=#0000ff]! workspace query: calculates the optimal size of the WORK array[/color]
lwork [COLOR=#804040][b]=[/b][/color] [COLOR=#804040][b]-[/b][/color][COLOR=#ff00ff]1[/color]
[COLOR=#a020f0]call[/color] DGEEV([COLOR=#ff00ff]'Vectors'[/color], [COLOR=#ff00ff]'Vectors'[/color], n, A, lda, WR, WI, VL, LDVL, [highlight #ffff00][COLOR=#0000ff]&[/color][/highlight]
VR, LDVR, work, lwork, info)
[COLOR=#0000ff]! compute workspace size[/color]
lwork [COLOR=#804040][b]=[/b][/color] [COLOR=#008080]min[/color](lwmax, [COLOR=#008080]int[/color](work([COLOR=#ff00ff]1[/color])))
[COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color]) [COLOR=#ff00ff]'lwork = '[/color], lwork
[COLOR=#0000ff]! solve[/color]
[COLOR=#a020f0]call[/color] DGEEV([COLOR=#ff00ff]'Vectors'[/color], [COLOR=#ff00ff]'Vectors'[/color], n, A, lda, WR, WI, VL, LDVL, [highlight #ffff00][COLOR=#0000ff]&[/color][/highlight]
VR, LDVR, work, lwork, info)
[COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color]) [COLOR=#ff00ff]'info = '[/color], info
[COLOR=#804040][b]if[/b][/color] (info [COLOR=#804040][b].eq.[/b][/color] [COLOR=#ff00ff]0[/color]) [COLOR=#804040][b]then[/b][/color]
[COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color]) [COLOR=#ff00ff]'Solution was succesfully computed:'[/color]
[COLOR=#0000ff]! print the solution[/color]
[COLOR=#a020f0]call[/color] print_eigenvalues([COLOR=#ff00ff]'Eigenvalues: '[/color], n, WR, WI )
[COLOR=#a020f0]call[/color] print_eigenvectors([COLOR=#ff00ff]'Left eigenvectors:'[/color], n, WI, VL, ldvl )
[COLOR=#a020f0]call[/color] print_eigenvectors([COLOR=#ff00ff]'Right eigenvectors:'[/color], n, WI, VR, ldvr )
[COLOR=#804040][b]else[/b][/color]
[COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color]) [COLOR=#ff00ff]'* Error computing solution!'[/color]
[COLOR=#804040][b]end if[/b][/color]
[COLOR=#a020f0]end program[/color] EigenVectors
[COLOR=#0000ff]!-------------------------- Subroutines --------------------------[/color]
[COLOR=#a020f0]subroutine[/color] print_eigenvalues (desc, n, WR, WI)
[COLOR=#2e8b57][b]character[/b][/color][COLOR=#804040][b]*[/b][/color]([COLOR=#804040][b]*[/b][/color]) :: desc
[COLOR=#2e8b57][b]integer[/b][/color] :: n
[COLOR=#2e8b57][b]double precision[/b][/color] :: WR([COLOR=#804040][b]*[/b][/color]), WI([COLOR=#804040][b]*[/b][/color])
[COLOR=#2e8b57][b]integer[/b][/color] :: j
[COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color])
[COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color]) desc
[COLOR=#804040][b]do[/b][/color] j[COLOR=#804040][b]=[/b][/color][COLOR=#ff00ff]1[/color], n
[COLOR=#804040][b]if[/b][/color] (WI(j) [COLOR=#804040][b]==[/b][/color] [COLOR=#ff00ff]0[/color]) [COLOR=#804040][b]then[/b][/color]
[COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#ff00ff]9998[/color],[COLOR=#804040][b]advance[/b][/color][COLOR=#804040][b]=[/b][/color][COLOR=#ff00ff]'no'[/color]) WR(j)
[COLOR=#804040][b]else[/b][/color]
[COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#ff00ff]9999[/color],[COLOR=#804040][b]advance[/b][/color][COLOR=#804040][b]=[/b][/color][COLOR=#ff00ff]'no'[/color]) WR(j), WI(j)
[COLOR=#804040][b]end if[/b][/color]
[COLOR=#804040][b]end do[/b][/color]
[COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color])
[COLOR=#ff00ff]9998[/color] [COLOR=#804040][b]format[/b][/color]([COLOR=#ff00ff]11[/color](:,[COLOR=#008080]1X[/color],[COLOR=#008080]F6.2[/color]) )
[COLOR=#ff00ff]9999[/color] [COLOR=#804040][b]format[/b][/color]([COLOR=#ff00ff]11[/color](:,[COLOR=#008080]1X[/color],[COLOR=#ff00ff]'('[/color],[COLOR=#008080]F6.2[/color],[COLOR=#ff00ff]','[/color],[COLOR=#008080]F6.2[/color],[COLOR=#ff00ff]')'[/color]))
[COLOR=#a020f0]end subroutine[/color] print_eigenvalues
[COLOR=#a020f0]subroutine[/color] print_eigenvectors (desc, n, WI, V, ldv)
[COLOR=#2e8b57][b]character[/b][/color][COLOR=#804040][b]*[/b][/color]([COLOR=#804040][b]*[/b][/color]) :: desc
[COLOR=#2e8b57][b]integer[/b][/color] :: n, ldv
[COLOR=#2e8b57][b]double precision[/b][/color] :: WI([COLOR=#804040][b]*[/b][/color]), V(ldv, [COLOR=#804040][b]*[/b][/color])
[COLOR=#2e8b57][b]integer[/b][/color] :: i, j
[COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color])
[COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color]) desc
[COLOR=#804040][b]do[/b][/color] i[COLOR=#804040][b]=[/b][/color][COLOR=#ff00ff]1[/color], n
j [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]1[/color]
[COLOR=#804040][b]do[/b][/color] [COLOR=#804040][b]while[/b][/color] (j [COLOR=#804040][b]<=[/b][/color] n)
[COLOR=#804040][b]if[/b][/color] (WI(j) [COLOR=#804040][b]==[/b][/color] [COLOR=#ff00ff]0[/color]) [COLOR=#804040][b]then[/b][/color]
[COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#ff00ff]9998[/color],[COLOR=#804040][b]advance[/b][/color][COLOR=#804040][b]=[/b][/color][COLOR=#ff00ff]'no'[/color]) V(i,j)
j [COLOR=#804040][b]=[/b][/color] j [COLOR=#804040][b]+[/b][/color] [COLOR=#ff00ff]1[/color]
[COLOR=#804040][b]else[/b][/color]
[COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#ff00ff]9999[/color],[COLOR=#804040][b]advance[/b][/color][COLOR=#804040][b]=[/b][/color][COLOR=#ff00ff]'no'[/color]) V(i,j), V(i,j[COLOR=#804040][b]+[/b][/color][COLOR=#ff00ff]1[/color])
[COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#ff00ff]9999[/color],[COLOR=#804040][b]advance[/b][/color][COLOR=#804040][b]=[/b][/color][COLOR=#ff00ff]'no'[/color]) V(i,j),[COLOR=#804040][b]-[/b][/color]V(i,j[COLOR=#804040][b]+[/b][/color][COLOR=#ff00ff]1[/color])
j [COLOR=#804040][b]=[/b][/color] j [COLOR=#804040][b]+[/b][/color] [COLOR=#ff00ff]2[/color]
[COLOR=#804040][b]end if[/b][/color]
[COLOR=#804040][b]end do[/b][/color]
[COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color])
[COLOR=#804040][b]end do[/b][/color]
[COLOR=#ff00ff]9998[/color] [COLOR=#804040][b]format[/b][/color]([COLOR=#ff00ff]11[/color](:,[COLOR=#008080]1X[/color],[COLOR=#008080]F6.2[/color]) )
[COLOR=#ff00ff]9999[/color] [COLOR=#804040][b]format[/b][/color]([COLOR=#ff00ff]11[/color](:,[COLOR=#008080]1X[/color],[COLOR=#ff00ff]'('[/color],[COLOR=#008080]F6.2[/color],[COLOR=#ff00ff]','[/color],[COLOR=#008080]F6.2[/color],[COLOR=#ff00ff]')'[/color]))
[COLOR=#a020f0]end subroutine[/color] print_eigenvectors