Program f07kdfe ! F07KDF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: dpstrf, nag_wp, x04caf, x04ebf ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Real (Kind=nag_wp), Parameter :: zero = 0.0E0_nag_wp Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: tol Integer :: i, ifail, info, j, lda, n, rank Character (1) :: uplo ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: a(:,:), work(:) Integer, Allocatable :: piv(:) Character (1) :: clabs(1), rlabs(1) ! .. Executable Statements .. Write (nout,*) 'F07KDF Example Program Results' ! Skip heading in data file Read (nin,*) Read (nin,*) n, uplo lda = n Allocate (a(lda,n),piv(n),work(2*n)) ! Read A from data file If (uplo=='U') Then Read (nin,*)(a(i,i:n),i=1,n) Else If (uplo=='L') Then Read (nin,*)(a(i,1:i),i=1,n) End If tol = -1.0_nag_wp ! Factorize A info = 0 ! The NAG name equivalent of dpstrf is f07kdf Call dpstrf(uplo,n,a,lda,piv,rank,tol,work,info) ! Zero out columns rank+1 to n If (uplo=='U') Then Do j = rank + 1, n a(rank+1:j,j) = zero End Do Else If (uplo=='L') Then Do j = rank + 1, n a(j:n,j) = zero End Do End If ! Print rank Write (nout,*) Write (nout,'(1X,A15,I3)') 'Computed rank: ', rank ! Print factor Write (nout,*) Flush (nout) ifail = 0 Call x04caf(uplo,'Nonunit',n,n,a,lda,'Factor',ifail) ! Print pivot indices Write (nout,*) Write (nout,*) 'PIV' Flush (nout) ifail = 0 Call x04ebf('General','Non-unit',1,n,piv,1,'I11',' ','No',rlabs,'No', & clabs,80,1,ifail) End Program f07kdfe