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

NAG FL Interface Introduction
Example description
    Program g03effe

!     G03EFF Example Program Text

!     Mark 30.0 Release. NAG Copyright 2024.

!     .. Use Statements ..
      Use nag_library, Only: g03eff, nag_wp, x04caf
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter               :: nin = 5, nout = 6
!     .. Local Scalars ..
      Integer                          :: i, ifail, k, ldc, ldx, lwt, m,       &
                                          maxit, n, nvar
      Character (1)                    :: weight
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: cmeans(:,:), css(:), csw(:), wk(:),  &
                                          wt(:), x(:,:)
      Integer, Allocatable             :: inc(:), isx(:), iwk(:), nic(:)
!     .. Intrinsic Procedures ..
      Intrinsic                        :: count
!     .. Executable Statements ..
      Write (nout,*) 'G03EFF Example Program Results'
      Write (nout,*)

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

!     Read in the problem size and control parameters
      Read (nin,*) weight, n, m, k, maxit

      If (weight=='W' .Or. weight=='w') Then
        lwt = n
      Else
        lwt = 0
      End If
      ldx = n
      Allocate (x(ldx,m),wt(n),isx(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

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

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

      ldc = k
      Allocate (cmeans(ldc,nvar),inc(n),nic(k),css(k),csw(k),iwk(n+3*k),       &
        wk(n+2*k))

!     Read in the initial cluster centres
      Read (nin,*)(cmeans(i,1:nvar),i=1,k)

!     Perform k means clustering
      ifail = 0
      Call g03eff(weight,n,m,x,ldx,isx,nvar,k,cmeans,ldc,wt,inc,nic,css,csw,   &
        maxit,iwk,wk,ifail)

!     Display results
      Write (nout,*) ' The cluster each point belongs to'
      Write (nout,99999) inc(1:n)
      Write (nout,*)
      Write (nout,*) ' The number of points in each cluster'
      Write (nout,99999) nic(1:k)
      Write (nout,*)
      Write (nout,*) ' The within-cluster sum of weights of each cluster'
      Write (nout,99998) csw(1:k)
      Write (nout,*)
      Write (nout,*) ' The within-cluster sum of squares of each cluster'
      Write (nout,99997) css(1:k)
      Write (nout,*)
      Flush (nout)
      ifail = 0
      Call x04caf('General',' ',k,nvar,cmeans,ldc,'The final cluster centres', &
        ifail)

99999 Format (1X,10I6)
99998 Format (1X,5F9.2)
99997 Format (1X,5F13.4)
    End Program g03effe