Program g03gafe ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: g03gaf, nag_wp, x04caf ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: loglik, tol Integer :: i, ifail, ldprob, lds, ldx, m, n, & ng, niter, nvar, popt, riter, sds, & sopt ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: f(:,:), g(:,:), prob(:,:), s(:,:,:), & w(:), x(:,:) Integer, Allocatable :: isx(:) ! .. Executable Statements .. Write (nout,*) 'G03GAF Example Program Results' Write (nout,*) ! Skip heading in data file Read (nin,*) ! Problem size Read (nin,*) n, m, nvar ! Number of groups Read (nin,*) ng ! Scaling option Read (nin,*) sopt ! Initial probabilities option Read (nin,*) popt ! Maximum number of iterations Read (nin,*) niter ! Leading dimensions ldx = n ldprob = n Select Case (sopt) Case (1) Allocate (s(nvar,nvar,ng)) lds = nvar sds = nvar Case (2) Allocate (s(nvar,nvar,1)) lds = nvar sds = nvar Case (3) Allocate (s(nvar,ng,1)) lds = nvar sds = ng Case (4) Allocate (s(nvar,1,1)) lds = nvar sds = 1 Case Default Allocate (s(1,1,1)) lds = 1 sds = 1 End Select Allocate (x(ldx,m),prob(ldprob,ng),g(nvar,ng),w(ng),isx(m),f(n,ng)) ! Data matrix X Read (nin,*)(x(i,1:m),i=1,n) ! Included variables If (nvar/=m) Then Read (nin,*) isx(1:m) End If ! Optionally read initial probabilties of group membership If (popt==2) Then Read (nin,*)(prob(i,1:ng),i=1,n) End If tol = 0.0E0_nag_wp riter = 5 ifail = 0 Call g03gaf(n,m,x,ldx,isx,nvar,ng,popt,prob,ldprob,niter,riter,w,g,sopt, & s,lds,sds,f,tol,loglik,ifail) ! Results Write (nout,*) ifail = 0 Call x04caf('g','n',1,ng,w,1,'Mixing proportions',ifail) Write (nout,*) ifail = 0 Call x04caf('g','n',nvar,ng,g,nvar,'Group means',ifail) Write (nout,*) Select Case (sopt) Case (1) Do i = 1, ng ifail = 0 Call x04caf('g','n',nvar,nvar,s(1,1,i),lds, & 'Variance-covariance matrix',ifail) End Do Case (2) ifail = 0 Call x04caf('g','n',nvar,nvar,s,lds, & 'Pooled Variance-covariance matrix',ifail) Case (3) ifail = 0 Call x04caf('g','n',nvar,ng,s,lds,'Groupwise Variance',ifail) Case (4) ifail = 0 Call x04caf('g','n',nvar,1,s,lds,'Pooled Variance',ifail) Case (5) ifail = 0 Call x04caf('g','n',1,1,s,lds,'Overall Variance',ifail) End Select Write (nout,*) ifail = 0 Call x04caf('g','n',n,ng,f,n,'Densities',ifail) Write (nout,*) ifail = 0 Call x04caf('g','n',n,ng,prob,n,'Membership probabilities',ifail) Write (nout,*) Write (nout,'(1X,A,1X,I16)') 'No. iterations:', niter Write (nout,'(1X,A,1X,F16.4)') 'Log-likelihood:', loglik Deallocate (x,prob,g,s,w,isx,f) End Program g03gafe