Program g03dcfe ! G03DCF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: g03daf, g03dcf, nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: df, sig, stat Integer :: i, ifail, ldgmn, ldox, ldp, ldx, & lgc, lwk, lwt, m, n, ng, nobs, nvar, & tdati Logical :: atiq Character (1) :: equal, priors, typ, weight Character (80) :: fmt ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: ati(:,:), det(:), gc(:), gmn(:,:), & ox(:,:), p(:,:), prior(:), wk(:), & wt(:), x(:,:) Integer, Allocatable :: iag(:), ing(:), isx(:), iwk(:), nig(:) ! .. Intrinsic Procedures .. Intrinsic :: count, max ! .. Executable Statements .. Write (nout,*) 'G03DCF Example Program Results' Write (nout,*) ! Skip headings in data file Read (nin,*) ! Read in the problem size Read (nin,*) n, m, ng, weight If (weight=='W' .Or. weight=='w') Then lwt = n Else lwt = 0 End If ldox = n Allocate (ox(ldox,m),ing(n),wt(lwt),isx(m)) ! Read in data If (lwt>0) Then Read (nin,*)(ox(i,1:m),ing(i),wt(i),i=1,n) Else Read (nin,*)(ox(i,1:m),ing(i),i=1,n) End If ! Read in variable inclusion flags Read (nin,*) isx(1:m) ! Calculate NVAR nvar = count(isx(1:m)==1) lwk = max(n*(nvar+1),2*nvar) ldgmn = ng lgc = (ng+1)*nvar*(nvar+1)/2 Allocate (nig(ng),gmn(ldgmn,nvar),det(ng),gc(lgc),wk(lwk),iwk(ng)) ! Compute covariance matrix ifail = 0 Call g03daf(weight,n,m,ox,ldox,isx,nvar,ing,ng,wt,nig,gmn,ldgmn,det,gc, & stat,df,sig,wk,iwk,ifail) ! Read in parameters controlling grouping Read (nin,*) typ, equal, priors, nobs, atiq If (atiq) Then tdati = ng Else tdati = 1 End If ldx = nobs ldp = nobs Allocate (x(ldx,m),prior(ng),p(ldp,ng),iag(nobs),ati(ldp,tdati)) ! Read in data to group Read (nin,*)(x(i,1:m),i=1,nobs) ! Read in priors If (priors=='I' .Or. priors=='i') Then Read (nin,*) prior(1:ng) End If ! Allocate observations to groups ifail = 0 Call g03dcf(typ,equal,priors,nvar,ng,nig,gmn,ldgmn,gc,det,nobs,m,isx,x, & ldx,prior,p,ldp,iag,atiq,ati,wk,ifail) ! Display results If (atiq) Then Write (fmt,99999) '(2(I6,5X,', ng, 'F6.3))' Write (nout,*) ' Obs Posterior Allocated', & ' Atypicality' Write (nout,*) ' probabilities to group index' Write (nout,*) Write (nout,fmt)(i,p(i,1:ng),iag(i),ati(i,1:ng),i=1,nobs) Else Write (fmt,99999) '(I6,5X,', ng, 'F6.3,I6))' Write (nout,*) ' Obs Posterior Allocated' Write (nout,*) ' probabilities to group ' Write (nout,*) Write (nout,fmt)(i,p(i,1:ng),iag(i),i=1,nobs) End If 99999 Format (A,I0,A) End Program g03dcfe