! G02HMF Example Program Text ! Mark 24 Release. NAG Copyright 2012. Module g02hmfe_mod ! G02HMF Example Program Module: ! Parameters and User-defined Routines ! .. Use Statements .. Use nag_library, Only: nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: iset = 1, nin = 5, nout = 6 Contains Subroutine ucv(t,ruser,u,w) ! u function ! .. Scalar Arguments .. Real (Kind=nag_wp), Intent (In) :: t Real (Kind=nag_wp), Intent (Out) :: u, w ! .. Array Arguments .. Real (Kind=nag_wp), Intent (Inout) :: ruser(*) ! .. Local Scalars .. Real (Kind=nag_wp) :: cu, cw, t2 ! .. Executable Statements .. cu = ruser(1) u = 1.0_nag_wp If (t/=0.0_nag_wp) Then t2 = t*t If (t2>cu) Then u = cu/t2 End If End If ! w function cw = ruser(2) If (t>cw) Then w = cw/t Else w = 1.0_nag_wp End If End Subroutine ucv End Module g02hmfe_mod Program g02hmfe ! G02HMF Example Main Program ! .. Use Statements .. Use nag_library, Only: g02hmf, nag_wp, x04abf, x04ccf Use g02hmfe_mod, Only: iset, nin, nout, ucv ! .. Implicit None Statement .. Implicit None ! .. Local Scalars .. Real (Kind=nag_wp) :: bd, bl, tol Integer :: i, ifail, indm, la, lcov, ldx, & lruser, m, maxit, n, nadv, nit, & nitmon ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: a(:), cov(:), ruser(:), & theta(:), wk(:), wt(:), x(:,:) ! .. Executable Statements .. Write (nout,*) 'G02HMF Example Program Results' Write (nout,*) ! Skip heading in data file Read (nin,*) ! Read in the problem size Read (nin,*) n, m ldx = n lruser = 2 la = ((m+1)*m)/2 lcov = la Allocate (x(ldx,m),ruser(lruser),cov(lcov),a(la),wt(n),theta(m),wk(2*m)) ! Read in data Read (nin,*)(x(i,1:m),i=1,n) ! Read in the initial value of A Read (nin,*) a(1:la) ! Read in the initial value of THETA Read (nin,*) theta(1:m) ! Read in the values of the parameters of the ucv functions Read (nin,*) ruser(1:lruser) ! Read in the control parameters Read (nin,*) indm, nitmon, bl, bd, maxit, tol ! Set the advisory channel to NOUT for monitoring information If (nitmon/=0) Then nadv = nout Call x04abf(iset,nadv) End If ! Compute robust estimate of variance / covariance matrix ifail = 0 Call g02hmf(ucv,ruser,indm,n,m,x,ldx,cov,a,wt,theta,bl,bd,maxit,nitmon, & tol,nit,wk,ifail) ! Display results Write (nout,99999) 'G02HMF required ', nit, ' iterations to converge' Write (nout,*) Flush (nout) ifail = 0 Call x04ccf('Upper','Non-Unit',m,cov,'Robust covariance matrix',ifail) Write (nout,*) Write (nout,*) 'Robust estimates of THETA' Write (nout,99998) theta(1:m) 99999 Format (1X,A,I0,A) 99998 Format (1X,F10.3) End Program g02hmfe