NAG Library Manual, Mark 30
Interfaces:  FL   CL   CPP   AD 

NAG FL Interface Introduction
Example description
    Program g03bdfe

!     G03BDF Example Program Text

!     Mark 30.0 Release. NAG Copyright 2024.

!     .. Use Statements ..
      Use nag_library, Only: g03baf, g03bdf, nag_wp, x04caf
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter               :: nin = 5, nout = 6
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: acc, g, power
      Integer                          :: i, ifail, iter, ldfp, ldfs, ldphi,   &
                                          ldr, ldro, ldx, lwk, m, maxit, n
      Character (1)                    :: stand
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: fp(:,:), fs(:,:), phi(:,:), r(:,:),  &
                                          ro(:,:), wk(:), x(:,:)
!     .. Executable Statements ..
      Write (nout,*) 'G03BDF Example Program Results'
      Write (nout,*)
      Flush (nout)

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

!     Read in problem size
      Read (nin,*) n, m, g, stand, acc, maxit, power

      ldx = n
      ldro = m
      ldfp = n
      ldfs = n
      ldr = m
      ldphi = m
      lwk = 2*n + m*m + 5*(m-1)
      Allocate (fp(ldx,m),x(ldx,m),ro(ldro,m),wk(lwk),phi(ldphi,m),fs(ldfs,m), &
        r(ldr,m))

!     Read loadings matrix
      Read (nin,*)(fp(i,1:m),i=1,n)

!     Calculate orthogonal rotation
      ifail = 0
      Call g03baf(stand,g,n,m,fp,ldx,x,ro,ldro,acc,maxit,iter,wk,ifail)

!     Calculate ProMax rotation
      ifail = 0
      Call g03bdf(stand,n,m,x,ldx,ro,ldro,power,fp,ldfp,r,ldr,phi,ldphi,fs,    &
        ldfs,ifail)

!     Display results
      ifail = 0
      Call x04caf('General',' ',n,m,fp,ldfp,'Factor pattern',ifail)
      Write (nout,*)
      Flush (nout)
      ifail = 0
      Call x04caf('General',' ',m,m,r,ldr,'ProMax rotation',ifail)
      Write (nout,*)
      Flush (nout)
      ifail = 0
      Call x04caf('General',' ',m,m,phi,ldphi,'Inter-factor correlations',     &
        ifail)
      Write (nout,*)
      Flush (nout)
      ifail = 0
      Call x04caf('General',' ',n,m,fs,ldfs,'Factor structure',ifail)

    End Program g03bdfe