PROGRAM g03dbfe ! G03DBF Example Program Text ! Mark 23 Release. NAG Copyright 2011. ! .. 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 Functions .. 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