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

NAG FL Interface Introduction
Example description
    Program g02bwfe

!     G02BWF Example Program Text

!     Mark 30.2 Release. NAG Copyright 2024.

!     .. Use Statements ..
      Use nag_library, Only: g02buf, g02bwf, nag_wp, x04ccf
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter               :: nin = 5, nout = 6
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: sw
      Integer                          :: i, ifail, ldx, lr, lwt, m, n
      Logical                          :: zero_var
      Character (1)                    :: mean, weight
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: r(:), wmean(:), wt(:), x(:,:)
!     .. Executable Statements ..
      Write (nout,*) 'G02BWF Example Program Results'
      Write (nout,*)
      Flush (nout)

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

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

      If (weight=='W' .Or. weight=='w') Then
        lwt = n
      Else
        lwt = 0
      End If
      ldx = n
      lr = (m*m+m)/2
      Allocate (r(lr),wmean(m),wt(lwt),x(ldx,m))

!     Read in data
      Read (nin,*) wt(1:n)
      Read (nin,*)(x(i,1:m),i=1,n)

!     Calculate the sums of squares and cross-products matrix
      ifail = 0
      Call g02buf(mean,weight,n,m,x,ldx,wt,sw,wmean,r,ifail)

!     Calculate the correlation matrix
      ifail = -1
      Call g02bwf(m,r,ifail)
      If (ifail/=0) Then
        If (ifail==2) Then
          zero_var = .True.
        Else
          Go To 100
        End If
      Else
        zero_var = .False.
      End If

!     Display the results
      ifail = 0
      Call x04ccf('Upper','Non-unit',m,r,'Correlation matrix',ifail)
      If (zero_var) Then
        Write (nout,*) ' NOTE: some variances are zero'
      End If

100   Continue

    End Program g02bwfe