Program g02btfe ! G02BTF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: g02btf, nag_wp, x04ccf ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Real (Kind=nag_wp), Parameter :: one = 1.0_nag_wp Real (Kind=nag_wp), Parameter :: zero = 0.0_nag_wp Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: alpha, sw, wt Integer :: i, ifail, incx, lc, m, n, nprint Character (1) :: mean ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: c(:), v(:), x(:), xbar(:) ! .. Intrinsic Procedures .. Intrinsic :: mod ! .. Executable Statements .. Write (nout,*) 'G02BTF Example Program Results' Write (nout,*) ! Skip heading in data file Read (nin,*) ! Read in problem size Read (nin,*) mean, m, n, nprint lc = (m*m+m)/2 Allocate (x(m),xbar(m),c(lc),v(lc)) ! Elements of X are stored consecutively incx = 1 ! Loop over each observation individually, updating the sums of squares ! and cross-product matrix at each iteration sw = zero i = 0 data_lp: Do Read (nin,*,Iostat=ifail) wt, x(1:m) If (ifail/=0) Then ! Finished processing all the data Exit data_lp End If i = i + 1 ! Update the sums of squares and cross-products matrix ifail = 0 Call g02btf(mean,m,wt,x,incx,sw,xbar,c,ifail) ! Display the results, either at the end or every NPRINT iterations If (mod(i,nprint)==0 .Or. i==n) Then Write (nout,*) '---------------------------------------------' Write (nout,99999) 'Observation: ', i, ' Weight = ', wt Write (nout,*) '---------------------------------------------' Write (nout,*) Write (nout,*) 'Means' Write (nout,99998) xbar(1:m) Write (nout,*) Flush (nout) ifail = 0 Call x04ccf('Upper','Non-unit',m,c, & 'Sums of squares and cross-products',ifail) ! Convert the sums of squares and cross-products to a variance matrix If (sw>one) Then alpha = one/(sw-one) v(1:lc) = alpha*c(1:lc) Write (nout,*) Flush (nout) ifail = 0 Call x04ccf('Upper','Non-unit',m,v,'Variance matrix',ifail) End If Write (nout,*) End If End Do data_lp 99999 Format (1X,A,I4,A,F13.4) 99998 Format (1X,4F14.4) End Program g02btfe