Program f07krfe ! F07KRF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: nag_wp, x04dbf, x04ebf, zpstrf ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Complex (Kind=nag_wp), Parameter :: zero = (0.0E0_nag_wp,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 .. Complex (Kind=nag_wp), Allocatable :: a(:,:) Real (Kind=nag_wp), Allocatable :: work(:) Integer, Allocatable :: piv(:) Character (1) :: clabs(1), rlabs(1) ! .. Executable Statements .. Write (nout,*) 'F07KRF 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 zpstrf is f07krf Call zpstrf(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 x04dbf(uplo,'Nonunit',n,n,a,lda,'Bracketed','F5.2','Factor', & 'Integer',rlabs,'Integer',clabs,80,0,ifail) ! Print pivot indices Write (nout,*) Write (nout,*) 'PIV' Flush (nout) ifail = 0 Call x04ebf('General','Non-unit',1,n,piv,1,'I14',' ','No',rlabs,'No', & clabs,80,1,ifail) End Program f07krfe