PROGRAM f07btfe

!      F07BTF Example Program Text

!      Mark 23 Release. NAG Copyright 2011.

!      .. Use Statements ..
       USE nag_library, ONLY : f06kcf, nag_wp, x02ajf, x02amf, x02bhf, x04def, &
                               zdscal, zgbequ
!      .. 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, i0, i1, ifail, ilen, info, j, k,  &
                                          kl, ku, ldab, n
!      .. Local Arrays ..
       COMPLEX (KIND=nag_wp), ALLOCATABLE :: ab(:,:)
       REAL (KIND=nag_wp), ALLOCATABLE :: c(:), r(:)
!      .. Intrinsic Functions ..
       INTRINSIC                          max, min, real
!      .. Executable Statements ..
       WRITE (nout,*) 'F07BTF Example Program Results'
       WRITE (nout,*)
       FLUSH (nout)
!      Skip heading in data file
       READ (nin,*)
       READ (nin,*) n, kl, ku
       ldab = kl + ku + 1
       ALLOCATE (ab(ldab,n),c(n),r(n))

!      Read the band matrix A from data file

       k = ku + 1
       READ (nin,*) ((ab(k+i-j,j),j=max(i-kl,1),min(i+ku,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 x04def(n,n,kl,ku,ab,ldab,'Matrix A',ifail)

       WRITE (nout,*)

!      Compute row and column scaling factors

!      The NAG name equivalent of zgbequ is f07btf
       CALL zgbequ(n,n,kl,ku,ab,ldab,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 zdscal is f06jdf
                DO j = 1, n
                   i1 = 1 + max(1,j-ku) - (j-ku)
                   ilen = min(n,j+kl) - max(1,j-ku) + 1
                   CALL zdscal(ilen,c(j),ab(i1,j),1)
                END DO

             END IF
          ELSE IF (colcnd>=thresh) THEN

!            Just row scale A
             DO j = 1, n
                i0 = max(1,j-ku)
                i1 = 1 + i0 - (j-ku)
                ilen = min(n,j+kl) - i0 + 1
                CALL f06kcf(ilen,r(i0),1,ab(i1,j),1)
             END DO

          ELSE

!            Row and column scale A
             DO j = 1, n
                i0 = max(1,j-ku)
                i1 = 1 + i0 - (j-ku)
                ilen = min(n,j+kl) - i0 + 1
                CALL zdscal(ilen,c(j),ab(i1,j),1)
                CALL f06kcf(ilen,r(i0),1,ab(i1,j),1)
             END DO

          END IF

!         Print the scaled matrix
          ifail = 0
          CALL x04def(n,n,kl,ku,ab,ldab,'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 f07btfe