PROGRAM g03ehfe

!      G03EHF Example Program Text

!      Mark 23 Release. NAG Copyright 2011.

!      .. Use Statements ..
       USE nag_library, ONLY : g03eaf, g03ecf, g03ehf, nag_wp
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Parameters ..
       INTEGER, PARAMETER              :: llen = 50, nin = 5, nout = 6
!      .. Local Scalars ..
       REAL (KIND=nag_wp)              :: dmin, dstep
       INTEGER                         :: ellen, i, ifail, ld, ldx, lenc,      &
                                          liwk, m, method, n, n1, nsym, olenc
       CHARACTER (1)                   :: dist, orient, scal, update
!      .. Local Arrays ..
       REAL (KIND=nag_wp), ALLOCATABLE :: cd(:), d(:), dord(:), s(:), x(:,:)
       INTEGER, ALLOCATABLE            :: ilc(:), iord(:), isx(:), iuc(:),     &
                                          iwk(:)
       CHARACTER (llen), ALLOCATABLE   :: c(:)
!      .. Executable Statements ..
       WRITE (nout,*) 'G03EHF Example Program Results'
       WRITE (nout,*)

!      Skip heading in data file
       READ (nin,*)

!      Read in the problem size
       READ (nin,*) n, m

!      Read in information on the type of distance matrix to use
       READ (nin,*) update, dist, scal

       ldx = n
       ld = n*(n-1)/2
       n1 = n - 1
       liwk = 2*n
       ALLOCATE (x(ldx,m),isx(m),s(m),d(ld),ilc(n1),iuc(n1),cd(n1),iord(n), &
          dord(n),iwk(liwk),c(1))

!      Read in the data used to construct distance matrix
       READ (nin,*) (x(i,1:m),i=1,n)

!      Read in variable inclusion flags
       READ (nin,*) isx(1:m)

!      Read in scaling
       IF (scal=='G' .OR. scal=='g') THEN
          READ (nin,*) s(1:m)
       END IF

!      Compute the distance matrix
       ifail = 0
       CALL g03eaf(update,dist,scal,n,m,x,ldx,isx,s,d,ifail)

!      Read in information on the clustering method to use
       READ (nin,*) method

!      Perform clustering
       ifail = 0
       CALL g03ecf(method,n,d,ilc,iuc,cd,iord,dord,iwk,ifail)

!      Produce some example dendrogram
       olenc = 0
D_LP:  DO
          READ (nin,*,IOSTAT=ifail) orient, dmin, dstep, nsym
          IF (ifail/=0) THEN
             GO TO 20
          END IF

!         Display the dendogram
          SELECT CASE (orient)
          CASE ('N')
             WRITE (nout,*) 'Dendrogram, Orientation North'
             lenc = nsym
             ellen = n
          CASE ('E')
             WRITE (nout,*) 'Dendrogram, Orientation East'
             lenc = n
             ellen = nsym
          CASE ('S')
             WRITE (nout,*) 'Dendrogram, Orientation South'
             lenc = nsym
             ellen = n
          CASE ('W')
             WRITE (nout,*) 'Dendrogram, Orientation West'
             lenc = n
             ellen = nsym
          END SELECT

!         Check that each element in the character array is sufficiently large
          IF (llen<ellen) THEN
             WRITE (nout,*) &
                'Each element of character array C needs to be at least ', &
                ellen
             WRITE (nout,*) 'elements long, current length is ', llen
             GO TO 20
          END IF

          IF (olenc<lenc) THEN
!            Reallocate matrix
             DEALLOCATE (c)
             ALLOCATE (c(lenc))
          END IF

!         Generate character array holding the dendogram
          ifail = 0
          CALL g03ehf(orient,n,dord,dmin,dstep,nsym,c,lenc,ifail)

          WRITE (nout,99999) c(1:lenc)
          WRITE (nout,*)
       END DO D_LP

20     CONTINUE

99999  FORMAT (1X,A)
    END PROGRAM g03ehfe