!   F02WGF Example Program Text
!   Mark 23 Release. NAG Copyright 2011.

    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
!      .. Parameters ..
       INTEGER, PARAMETER                  :: nin = 5, nout = 6
    CONTAINS
!      Matrix vector subroutines

!dec$ attributes offload : mic :: av
       SUBROUTINE av(iflag,m,n,x,ax,iuser,ruser)

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

!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. 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 Functions ..
          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
!dec$ attributes offload : mic :: av
       END SUBROUTINE av
    END MODULE f02wgfe_mod
    PROGRAM f02wgfe

!      F02WGF Example Main Program

!      .. Use Statements ..
       USE nag_library, ONLY : f02wgf, nag_wp
       USE f02wgfe_mod, ONLY : av, nin, nout
!      .. 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
