Program g02hafe ! G02HAF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: g02haf, nag_wp, x04abf ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: iset = 1, nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: cpsi, cucv, dchi, h1, h2, h3, sigma, & tol Integer :: i, ifail, indc, indw, ipsi, isigma, & ldc, ldx, lwork, m, maxit, n, nadv, & nitmon ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: c(:,:), rs(:), theta(:), wgt(:), & work(:), x(:,:), y(:) ! .. Executable Statements .. Write (nout,*) 'G02HAF Example Program Results' Write (nout,*) ! Skip heading in data file Read (nin,*) ! Read in the problem size Read (nin,*) n, m ldx = n ldc = m lwork = 4*n + m*(n+m) Allocate (x(ldx,m),y(n),theta(m),c(ldc,m),work(lwork),rs(n),wgt(n)) ! Read in data Read (nin,*)(x(i,1:m),y(i),i=1,n) ! Read in control parameters Read (nin,*) indw, ipsi, isigma, nitmon, maxit, tol ! Read in appropriate weight function parameters If (indw/=0) Then Read (nin,*) cucv, indc End If If (ipsi>0) Then If (ipsi==1) Then Read (nin,*) cpsi Else If (ipsi==2) Then Read (nin,*) h1, h2, h3 End If If (isigma>0) Then Read (nin,*) dchi End If End If ! Set the advisory channel to NOUT for monitoring information If (nitmon/=0) Then nadv = nout Call x04abf(iset,nadv) End If ! Read in initial values Read (nin,*) sigma Read (nin,*) theta(1:m) ! Perform M-estimate regression ifail = -1 Call g02haf(indw,ipsi,isigma,indc,n,m,x,ldx,y,cpsi,h1,h2,h3,cucv,dchi, & theta,sigma,c,ldc,rs,wgt,tol,maxit,nitmon,work,ifail) If (ifail/=0) Then If (ifail<7) Then Go To 100 Else Write (nout,*) & ' Some of the following reslts may be unreliable' End If End If ! Display results Write (nout,99999) 'Sigma = ', sigma Write (nout,*) Write (nout,*) ' THETA Standard' Write (nout,*) ' errors' Write (nout,99998)(theta(i),c(i,i),i=1,m) Write (nout,*) Write (nout,*) ' Weights Residuals' Write (nout,99998)(wgt(i),rs(i),i=1,n) 100 Continue 99999 Format (1X,A,F10.4) 99998 Format (1X,F12.4,F13.4) End Program g02hafe