Program g03dbfe ! G03DBF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: g03daf, g03dbf, nag_wp, x04caf ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: df, sig, stat Integer :: i, ifail, ldd, ldgmn, ldox, ldx, & lgc, lwk, lwt, m, n, ng, nobs, nvar Character (1) :: equal, mode, weight ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: d(:,:), det(:), gc(:), gmn(:,:), & ox(:,:), wk(:), wt(:), x(:,:) Integer, Allocatable :: ing(:), isx(:), iwk(:), nig(:) ! .. Intrinsic Procedures .. Intrinsic :: count, max ! .. Executable Statements .. Write (nout,*) 'G03DBF Example Program Results' Write (nout,*) Flush (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 original 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) ldgmn = ng lgc = (ng+1)*nvar*(nvar+1)/2 lwk = max(n*(nvar+1),2*nvar) 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 size data from which to compute distances Read (nin,*) mode, equal If (mode=='S' .Or. mode=='s') Then Read (nin,*) nobs ldd = nobs Else nobs = 0 ldd = ng End If ldx = nobs Allocate (x(ldx,m),d(ldd,ng)) ! Read in data from which to compute distances If (nobs>0) Then Read (nin,*)(x(i,1:m),i=1,nobs) End If ! Compute distances ifail = 0 Call g03dbf(equal,mode,nvar,ng,gmn,ldgmn,gc,nobs,m,isx,x,ldx,d,ldd,wk, & ifail) ! Display results ifail = 0 Call x04caf('General',' ',nobs,ng,d,ldd,'Distances',ifail) End Program g03dbfe