PROGRAM f07affe

!      F07AFF Example Program Text

!      Mark 23 Release. NAG Copyright 2011.

!      .. Use Statements ..
       USE nag_library, ONLY : dgeequ, dscal, f06fcf, nag_wp, x02ajf, x02amf,  &
                               x02bhf, x04caf
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Parameters ..
       REAL (KIND=nag_wp), PARAMETER   :: one = 1.0_nag_wp
       REAL (KIND=nag_wp), PARAMETER   :: thresh = 0.1_nag_wp
       INTEGER, PARAMETER              :: nin = 5, nout = 6
!      .. Local Scalars ..
       REAL (KIND=nag_wp)              :: amax, big, colcnd, rowcnd, small
       INTEGER                         :: i, ifail, info, j, lda, n
!      .. Local Arrays ..
       REAL (KIND=nag_wp), ALLOCATABLE :: a(:,:), c(:), r(:)
!      .. Intrinsic Functions ..
       INTRINSIC                          real
!      .. Executable Statements ..
       WRITE (nout,*) 'F07AFF Example Program Results'
       WRITE (nout,*)
       FLUSH (nout)
!      Skip heading in data file
       READ (nin,*)
       READ (nin,*) n
       lda = n
       ALLOCATE (a(lda,n),c(n),r(n))

!      Read the N by N matrix A from data file

       READ (nin,*) (a(i,1:n),i=1,n)

!      Print the matrix A

!      ifail: behaviour on error exit
!             =0 for hard exit, =1 for quiet-soft, =-1 for noisy-soft
       ifail = 0
       CALL x04caf('General',' ',n,n,a,lda,'Matrix A',ifail)
       WRITE (nout,*)

!      Compute row and column scaling factors

!      The NAG name equivalent of dgeequ is f07aff
       CALL dgeequ(n,n,a,lda,r,c,rowcnd,colcnd,amax,info)

       IF (info>0) THEN
          IF (info<=n) THEN
             WRITE (nout,99999) 'Row ', info, ' of A is exactly zero'
          ELSE
             WRITE (nout,99999) 'Column ', info - n, ' of A is exactly zero'
          END IF
       ELSE

!         Print ROWCND, COLCND, AMAX and the scale factors

          WRITE (nout,99998) 'ROWCND =', rowcnd, ', COLCND =', colcnd, &
             ', AMAX =', amax
          WRITE (nout,*)
          WRITE (nout,*) 'Row scale factors'
          WRITE (nout,99997) r(1:n)
          WRITE (nout,*)
          WRITE (nout,*) 'Column scale factors'
          WRITE (nout,99997) c(1:n)
          WRITE (nout,*)
          FLUSH (nout)

!         Compute values close to underflow and overflow

          small = x02amf()/(x02ajf()*real(x02bhf(),kind=nag_wp))
          big = one/small
          IF ((rowcnd>=thresh) .AND. (amax>=small) .AND. (amax<=big)) THEN
             IF (colcnd<thresh) THEN

!               Just column scale A
!               The NAG name equivalent of dscal is f06edf
                DO j = 1, n
                   CALL dscal(n,c(j),a(1,j),1)
                END DO

             END IF
          ELSE IF (colcnd>=thresh) THEN

!            Just row scale A
             DO j = 1, n
                CALL f06fcf(n,r,1,a(1,j),1)
             END DO

          ELSE

!            Row and column scale A
             DO j = 1, n
                CALL dscal(n,c(j),a(1,j),1)
                CALL f06fcf(n,r,1,a(1,j),1)
             END DO

          END IF

!         Print the scaled matrix
          ifail = 0
          CALL x04caf('General',' ',n,n,a,lda,'Scaled matrix',ifail)

       END IF

99999  FORMAT (1X,A,I4,A)
99998  FORMAT (1X,3(A,1P,E8.1))
99997  FORMAT ((1X,1P,7E11.1))
    END PROGRAM f07affe