!   F02WGF Example Program Text
!   Mark 30.1 Release. NAG Copyright 2024.

    Module f02wgfe_mod

!     F02WGF Example Program Module:
!            Parameters and User-defined Routines

!     .. Use Statements ..
      Use nag_library, Only: nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Accessibility Statements ..
      Private
      Public                           :: av
!     .. Parameters ..
      Integer, Parameter, Public       :: nin = 5, nout = 6
    Contains
!     Matrix vector subroutines

      Subroutine av(iflag,m,n,x,ax,iuser,ruser)

!       Computes  w <- A*x or w <- Trans(A)*x.

!       .. Parameters ..
        Real (Kind=nag_wp), Parameter  :: one = 1.0_nag_wp
        Real (Kind=nag_wp), Parameter  :: zero = 0.0_nag_wp
!       .. Scalar Arguments ..
        Integer, Intent (Inout)        :: iflag
        Integer, Intent (In)           :: m, n
!       .. Array Arguments ..
        Real (Kind=nag_wp), Intent (Inout) :: ax(*), ruser(*)
        Real (Kind=nag_wp), Intent (In) :: x(*)
        Integer, Intent (Inout)        :: iuser(*)
!       .. Local Scalars ..
        Real (Kind=nag_wp)             :: h, k, s, t
        Integer                        :: i, j
!       .. Intrinsic Procedures ..
        Intrinsic                      :: min, real
!       .. Executable Statements ..
        h = one/real(m+1,kind=nag_wp)
        k = one/real(n+1,kind=nag_wp)
        If (iflag==1) Then
          ax(1:m) = zero
          t = zero

          Do j = 1, n
            t = t + k
            s = zero
            Do i = 1, min(j,m)
              s = s + h
              ax(i) = ax(i) + k*s*(t-one)*x(j)
            End Do
            Do i = j + 1, m
              s = s + h
              ax(i) = ax(i) + k*t*(s-one)*x(j)
            End Do
          End Do
        Else
          ax(1:n) = zero
          t = zero

          Do j = 1, n
            t = t + k
            s = zero
            Do i = 1, min(j,m)
              s = s + h
              ax(j) = ax(j) + k*s*(t-one)*x(i)
            End Do
            Do i = j + 1, m
              s = s + h
              ax(j) = ax(j) + k*t*(s-one)*x(i)
            End Do
          End Do
        End If

        Return
      End Subroutine av
    End Module f02wgfe_mod
    Program f02wgfe

!     F02WGF Example Main Program

!     .. Use Statements ..
      Use f02wgfe_mod, Only: av, nin, nout
      Use nag_library, Only: f02wgf, nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Local Scalars ..
      Integer                          :: i, ifail, k, ldu, ldv, m, n, nconv,  &
                                          ncv
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: resid(:), sigma(:), u(:,:), v(:,:)
      Real (Kind=nag_wp)               :: ruser(1)
      Integer                          :: iuser(1)
!     .. Executable Statements ..
      Write (nout,*) 'F02WGF Example Program Results'
      Write (nout,*)
!     Skip heading in data file
      Read (nin,*)
      Read (nin,*) m, n, k, ncv
      ldu = m
      ldv = n
      Allocate (resid(ncv),sigma(ncv),u(ldu,ncv),v(ldv,ncv))

!     ifail: behaviour on error exit
!             =0 for hard exit, =1 for quiet-soft, =-1 for noisy-soft
      ifail = 0
      Call f02wgf(m,n,k,ncv,av,nconv,sigma,u,ldu,v,ldv,resid,iuser,ruser,      &
        ifail)

!     Print computed residuals
      Write (nout,*) '  Singular Value    Residual'
      Write (nout,99999)(sigma(i),resid(i),i=1,nconv)

99999 Format (1X,F10.5,8X,G10.2)
    End Program f02wgfe