PROGRAM f07ftfe

!      F07FTF Example Program Text

!      Mark 23 Release. NAG Copyright 2011.

!      .. Use Statements ..
       USE nag_library, ONLY : f06kcf, nag_wp, x02ajf, x02amf, x02bhf, x04dbf, &
                               zdscal, zpoequ
!      .. 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, scond, small
       INTEGER                         :: i, ifail, info, j, lda, n
!      .. Local Arrays ..
       COMPLEX (KIND=nag_wp), ALLOCATABLE :: a(:,:)
       REAL (KIND=nag_wp), ALLOCATABLE :: s(:)
       CHARACTER (1)                   :: clabs(1), rlabs(1)
!      .. Intrinsic Functions ..
       INTRINSIC                          real
!      .. Executable Statements ..
       WRITE (nout,*) 'F07FTF Example Program Results'
       WRITE (nout,*)
       FLUSH (nout)
!      Skip heading in data file
       READ (nin,*)
       READ (nin,*) n
       lda = n
       ALLOCATE (a(lda,n),s(n))

!      Read the upper triangular part of the matrix A from data file

       READ (nin,*) (a(i,i: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 x04dbf('Upper','Non-unit',n,n,a,lda,'Bracketed','1P,E10.2', &
          'Matrix A','Integer',rlabs,'Integer',clabs,80,0,ifail)

       WRITE (nout,*)

!      Compute diagonal scaling factors

!      The NAG name equivalent of zpoequ is f07ftf
       CALL zpoequ(n,a,lda,s,scond,amax,info)

       IF (info>0) THEN
          WRITE (nout,99999) 'Diagonal element', info, ' of A is non positive'
       ELSE

!         Print SCOND, AMAX and the scale factors

          WRITE (nout,99998) 'SCOND =', scond, ', AMAX =', amax
          WRITE (nout,*)
          WRITE (nout,*) 'Diagonal scaling factors'
          WRITE (nout,99997) s(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 ((scond<thresh) .OR. (amax<small) .OR. (amax>big)) THEN

!            Scale A
!            The NAG name equivalent of zdscal is f06jdf
             DO j = 1, n
                CALL zdscal(j,s(j),a(1,j),1)
                CALL f06kcf(j,s,1,a(1,j),1)
             END DO

!            Print the scaled matrix

             ifail = 0
             CALL x04dbf('Upper','Non-unit',n,n,a,lda,'Bracketed','F8.4', &
                'Scaled matrix','Integer',rlabs,'Integer',clabs,80,0,ifail)

          END IF
       END IF

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