PROGRAM g02bxfe ! G02BXF Example Program Text ! Mark 23 Release. NAG Copyright 2011. ! .. Use Statements .. USE nag_library, ONLY : g02bxf, nag_wp, x04caf ! .. Implicit None Statement .. IMPLICIT NONE ! .. Parameters .. INTEGER, PARAMETER :: nin = 5, nout = 6 ! .. Local Scalars .. INTEGER :: i, ifail, ldv, ldx, lwt, m, n LOGICAL :: zero_var CHARACTER (1) :: weight ! .. Local Arrays .. REAL (KIND=nag_wp), ALLOCATABLE :: r(:,:), std(:), v(:,:), wt(:), & x(:,:), xbar(:) ! .. Executable Statements .. WRITE (nout,*) 'G02BXF Example Program Results' WRITE (nout,*) ! Skip heading in data file READ (nin,*) ! Read in problem size READ (nin,*) weight, n, m IF (weight=='W' .OR. weight=='w') THEN lwt = n ELSE lwt = 0 END IF ldx = n ldv = m ALLOCATE (x(ldx,m),wt(lwt),xbar(m),std(m),v(ldv,m),r(ldv,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 ! Calculate summary statistics ifail = -1 CALL g02bxf(weight,n,m,x,ldx,wt,xbar,std,v,ldv,r,ifail) IF (ifail/=0) THEN IF (ifail==5) THEN zero_var = .TRUE. ELSE GO TO 20 END IF ELSE zero_var = .FALSE. END IF ! Display results WRITE (nout,*) ' Means' WRITE (nout,*) WRITE (nout,99999) (xbar(i),i=1,m) WRITE (nout,*) WRITE (nout,*) ' Standard deviations' WRITE (nout,*) WRITE (nout,99999) (std(i),i=1,m) WRITE (nout,*) FLUSH (nout) ifail = 0 CALL x04caf('Upper','Non-unit',m,m,r,ldv,' Correlation matrix', & ifail) IF (zero_var) THEN WRITE (nout,*) ' NOTE: some variances are zero' END IF 20 CONTINUE 99999 FORMAT (1X,10F13.4) END PROGRAM g02bxfe