Program g03adfe

!     G03ADF Example Program Text

!     Mark 30.1 Release. NAG Copyright 2024.

!     .. Use Statements ..
      Use nag_library, Only: g03adf, nag_wp, x04caf
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter               :: nin = 5, nout = 6
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: tol
      Integer                          :: i, ifail, iwk, ldcvx, ldcvy, lde,    &
                                          ldz, lwt, m, mcv, n, ncv, nx, ny
      Character (1)                    :: weight
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: cvx(:,:), cvy(:,:), e(:,:), wk(:),   &
                                          wt(:), z(:,:)
      Integer, Allocatable             :: isz(:)
!     .. Intrinsic Procedures ..
      Intrinsic                        :: max
!     .. Executable Statements ..
      Write (nout,*) 'G03ADF Example Program Results'
      Write (nout,*)

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

!     Read in problem size
      Read (nin,*) n, m, nx, ny, weight

      If (weight=='W' .Or. weight=='w') Then
        lwt = n
      Else
        lwt = 0
      End If
      If (nx>=ny) Then
        iwk = n*nx + nx*ny + max(5*(nx-1)+nx*nx,n*ny) + 1
        lde = ny
        mcv = ny
      Else
        iwk = n*ny + nx*ny + max(5*(ny-1)+ny*ny,n*nx) + 1
        lde = nx
        mcv = nx
      End If
      ldz = n
      ldcvx = nx
      ldcvy = ny
      Allocate (z(ldz,m),isz(m),wt(lwt),e(lde,6),cvx(ldcvx,mcv),               &
        cvy(ldcvy,mcv),wk(iwk))

!     Read in data
      If (lwt>0) Then
        Read (nin,*)(z(i,1:m),wt(i),i=1,n)
      Else
        Read (nin,*)(z(i,1:m),i=1,n)
      End If

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

!     Use default tolerance
      tol = 0.0E0_nag_wp

!     Perform canonical correlation analysis
      ifail = 0
      Call g03adf(weight,n,m,z,ldz,isz,nx,ny,wt,e,lde,ncv,cvx,ldcvx,mcv,cvy,   &
        ldcvy,tol,wk,iwk,ifail)

!     Display results
      Write (nout,99999) 'Rank of X = ', nx, ' Rank of Y = ', ny
      Write (nout,*)
      Write (nout,*)                                                           &
        'Canonical    Eigenvalues Percentage     Chisq      DF     Sig'
      Write (nout,*) 'correlations              variation'
      Write (nout,99998)(e(i,1:6),i=1,ncv)
      Write (nout,*)
      Flush (nout)
      ifail = 0
      Call x04caf('General',' ',nx,ncv,cvx,ldcvx,                              &
        'Canonical Coefficients for X',ifail)
      Write (nout,*)
      Flush (nout)
      ifail = 0
      Call x04caf('General',' ',ny,ncv,cvy,ldcvy,                              &
        'Canonical Coefficients for Y',ifail)

99999 Format (1X,A,I0,A,I0)
99998 Format (1X,2F12.4,F11.4,F10.4,F8.1,F8.4)
    End Program g03adfe