NAG Library Manual, Mark 30.1
Interfaces:  FL   CL   CPP   AD 

NAG FL Interface Introduction
Example description
    Program f04zdfe

!     F04ZDF Example Program Text

!     Mark 30.1 Release. NAG Copyright 2024.

!     .. Use Statements ..
      Use nag_library, Only: f04zdf, f06uaf, nag_wp, zgetrf, zgetrs
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter               :: nin = 5, nout = 6
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: cond, nrma, nrminv
      Integer                          :: i, ifail, irevcm, lda, ldx, ldy, m,  &
                                          n, seed, t
!     .. Local Arrays ..
      Complex (Kind=nag_wp), Allocatable :: a(:,:), work(:), x(:,:), y(:,:)
      Real (Kind=nag_wp), Allocatable  :: rwork(:)
      Real (Kind=nag_wp)               :: workr(1)
      Integer, Allocatable             :: ipiv(:), iwork(:)
!     .. Executable Statements ..
      Write (nout,*) 'F04ZDF Example Program Results'
      Write (nout,*)
!     Skip heading in data file
      Read (nin,*)
      Read (nin,*) m, n, t

      lda = m
      ldx = n
      ldy = m
      Allocate (a(lda,n))
      Allocate (x(ldx,t))
      Allocate (y(ldy,t))
      Allocate (work(m*t))
      Allocate (rwork(2*n))
      Allocate (iwork(2*n+5*t+20))
      Allocate (ipiv(n))

!     Read A from data file
      Read (nin,*)(a(i,1:n),i=1,m)

!     Compute 1-norm of A
      nrma = f06uaf('1',m,n,a,lda,workr)
      Write (nout,99999) 'The norm of A is: ', nrma

!     Estimate the norm of A^(-1) without forming A^(-1)
      irevcm = 0
      ifail = 0

      seed = 652

!     Perform an LU factorization so that A=LU where L and U are lower
!     and upper triangular.

!     The NAG name equivalent of zgetrf is f07arf
      Call zgetrf(m,n,a,lda,ipiv,ifail)

loop: Do
        Call f04zdf(irevcm,m,n,x,ldx,y,ldy,nrminv,t,seed,work,rwork,iwork,     &
          ifail)
        If (irevcm/=0) Then
          If (irevcm==1) Then
!           Compute Y = inv(A)*X

!           The NAG name equivalent of zgetrf is f07asf
            Call zgetrs('N',n,t,a,lda,ipiv,x,ldx,ifail)
!           X was overwritten by ZGETRS, so set Y=X
            y(1:n,1:t) = x(1:n,1:t)
          Else
!           Compute X = herm(inv(A))*Y

!           The NAG name equivalent of zgetrf is f07asf
            Call zgetrs('C',n,t,a,lda,ipiv,y,ldy,ifail)
!           Y was overwritten by ZGETRS, so set X=Y
            x(1:n,1:t) = y(1:n,1:t)
          End If
        Else

          Write (nout,99999) 'The estimated norm of inverse(A) is: ', nrminv

!         Compute and print the estimated condition number
          cond = nrminv*nrma
          Write (nout,*)
          Write (nout,99999) 'Estimated condition number of A: ', cond
          Write (nout,*)
          Exit loop
        End If
      End Do loop
99999 Format (1X,A,F6.2)

    End Program f04zdfe