NAG Library Manual, Mark 28.5
```    Program g03ccfe

!     G03CCF Example Program Text

!     Mark 28.5 Release. NAG Copyright 2022.

!     .. Use Statements ..
Use nag_library, Only: g03caf, g03ccf, nag_wp, x04caf
!     .. Implicit None Statement ..
Implicit None
!     .. Parameters ..
Integer, Parameter               :: nin = 5, nout = 6
!     .. Local Scalars ..
Integer                          :: i, ifail, ldfl, ldfs, ldr, ldx,      &
liwk, lres, lwk, lwt, m, n, nfac,    &
nvar, tdr
Character (80)                   :: fmt
Character (1)                    :: matrix, method, rotate, weight
!     .. Local Arrays ..
Real (Kind=nag_wp), Allocatable  :: com(:), e(:), fl(:,:), fs(:,:),      &
psi(:), r(:,:), res(:), wk(:),       &
wt(:), x(:,:)
Real (Kind=nag_wp)               :: stat(4)
Integer                          :: iop(5)
Integer, Allocatable             :: isx(:), iwk(:)
!     .. Intrinsic Procedures ..
Intrinsic                        :: count, max
!     .. Executable Statements ..
Write (nout,*) 'G03CCF Example Program Results'
Write (nout,*)
Flush (nout)

!     Skip headings in data file

!     Read in the problem size
Read (nin,*) matrix, weight, n, m, nfac

If (matrix=='C' .Or. matrix=='c') Then
lwt = 0
ldx = m
Else
If (weight=='W' .Or. weight=='w') Then
lwt = n
Else
lwt = 0
End If
ldx = n
End If
Allocate (x(ldx,m),isx(m),wt(lwt))

If (lwt>0) Then
Else
End If

!     Read in variable inclusion flags

!     Calculate NVAR
nvar = count(isx(1:m)==1)

!     Do not apply a rotation
rotate = 'U'
tdr = 1
ldr = 1

lres = nvar*(nvar-1)/2
liwk = 4*nvar + 2
lwk = 5*nvar*nvar + 33*nvar - 4/2
If (matrix/='C' .And. matrix/='c') Then
lwk = max(lwk,n*nvar+7*nvar+nvar*(nvar-1)/2)
End If
lwk = max(lwk,nvar)
ldfs = nvar
ldfl = nvar
Allocate (e(nvar),com(nvar),psi(nvar),res(lres),fl(ldfl,nfac),wk(lwk),   &
iwk(liwk),fs(ldfs,nfac),r(ldr,tdr))

!     Fit factor analysis model
ifail = -1
Call g03caf(matrix,weight,n,m,x,ldx,nvar,isx,nfac,wt,e,stat,com,psi,res, &
fl,ldfl,iop,iwk,wk,lwk,ifail)
If (ifail/=0) Then
If (ifail<=4) Then
Go To 100
End If
End If

!     Display results
Write (nout,*)
Write (fmt,99999) '(', nfac + 2, '(1X,F8.3))'
Write (nout,fmt)(fl(i,1:nfac),com(i),psi(i),i=1,nvar)

!     Read in details of how to compute factor scores

!     Compute factor scores
ifail = 0
Call g03ccf(method,rotate,nvar,nfac,fl,ldfl,psi,e,r,ldr,fs,ldfs,wk,      &
ifail)

!     Display factor score coefficients
Write (nout,*)
Flush (nout)
ifail = 0
Call x04caf('General',' ',nvar,nfac,fs,ldfs,'Factor score coefficients', &
ifail)

100   Continue

99999 Format (A,I0,A)
End Program g03ccfe
```