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

NAG FL Interface Introduction
Example description
    Program g02bxfe

!     G02BXF Example Program Text

!     Mark 30.0 Release. NAG Copyright 2024.

!     .. Use Statements ..
      Use nag_library, Only: g02bxf, nag_wp, x04caf
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter               :: nin = 5, nout = 6
!     .. Local Scalars ..
      Integer                          :: i, ifail, ldv, ldx, lwt, m, n
      Logical                          :: zero_var
      Character (1)                    :: weight
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: r(:,:), std(:), v(:,:), wt(:),       &
                                          x(:,:), xbar(:)
!     .. Executable Statements ..
      Write (nout,*) 'G02BXF Example Program Results'
      Write (nout,*)

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

!     Read in problem size
      Read (nin,*) weight, n, m
      If (weight=='W' .Or. weight=='w') Then
        lwt = n
      Else
        lwt = 0
      End If
      ldx = n
      ldv = m
      Allocate (x(ldx,m),wt(lwt),xbar(m),std(m),v(ldv,m),r(ldv,m))

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

!     Calculate summary statistics
      ifail = -1
      Call g02bxf(weight,n,m,x,ldx,wt,xbar,std,v,ldv,r,ifail)
      If (ifail/=0) Then
        If (ifail==5) Then
          zero_var = .True.
        Else
          Go To 100
        End If
      Else
        zero_var = .False.
      End If

!     Display results
      Write (nout,*) '     Means'
      Write (nout,*)
      Write (nout,99999)(xbar(i),i=1,m)
      Write (nout,*)
      Write (nout,*) '     Standard deviations'
      Write (nout,*)
      Write (nout,99999)(std(i),i=1,m)
      Write (nout,*)
      Flush (nout)
      ifail = 0
      Call x04caf('Upper','Non-unit',m,m,r,ldv,'     Correlation matrix',      &
        ifail)
      If (zero_var) Then
        Write (nout,*) ' NOTE: some variances are zero'
      End If

100   Continue

99999 Format (1X,10F13.4)
    End Program g02bxfe