Program g08rafe ! G08RAF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: g08raf, nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: tol Integer :: i, idist, ifail, ip, j, ldprvr, ldx, & lparest, lvapvec, lwork, nmax, ns, & nsum ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: eta(:), parest(:), prvr(:,:), & vapvec(:), work(:), x(:,:), y(:), & zin(:) Integer, Allocatable :: irank(:), iwa(:), nv(:) ! .. Intrinsic Procedures .. Intrinsic :: maxval, sum ! .. Executable Statements .. Write (nout,*) 'G08RAF Example Program Results' Write (nout,*) ! Skip heading in data file Read (nin,*) ! Read number of samples, number of parameters to be fitted, ! error distribution parameter and tolerance criterion for ties. Read (nin,*) ns, ip, idist, tol Allocate (nv(ns)) ! Read the number of observations in each sample. Read (nin,*) nv(1:ns) ! Calculate NSUM, NMAX and various array lengths nsum = sum(nv(1:ns)) nmax = maxval(nv(1:ns)) ldx = nsum ldprvr = ip + 1 lvapvec = nmax*(nmax+1)/2 lparest = 4*ip + 1 lwork = nmax*(ip+1) Allocate (y(nsum),x(ldx,ip),prvr(ldprvr,ip),irank(nmax),zin(nmax), & eta(nmax),vapvec(lvapvec),parest(lparest),work(lwork),iwa(nmax)) ! Read in observations and design matrices for each sample. Read (nin,*)(y(i),x(i,1:ip),i=1,nsum) ! Display input information Write (nout,99999) 'Number of samples =', ns Write (nout,99999) 'Number of parameters fitted =', ip Write (nout,99999) 'Distribution =', idist Write (nout,99998) 'Tolerance for ties =', tol ifail = 0 Call g08raf(ns,nv,nsum,y,ip,x,ldx,idist,nmax,tol,prvr,ldprvr,irank,zin, & eta,vapvec,parest,work,lwork,iwa,ifail) ! Display results Write (nout,*) Write (nout,*) 'Score statistic' Write (nout,99997) parest(1:ip) Write (nout,*) Write (nout,*) 'Covariance matrix of score statistic' Do j = 1, ip Write (nout,99997) prvr(1:j,j) End Do Write (nout,*) Write (nout,*) 'Parameter estimates' Write (nout,99997) parest((ip+1):(2*ip)) Write (nout,*) Write (nout,*) 'Covariance matrix of parameter estimates' Do i = 1, ip Write (nout,99997) prvr(i+1,1:i) End Do Write (nout,*) Write (nout,99996) 'Chi-squared statistic =', parest(2*ip+1), ' with', & ip, ' d.f.' Write (nout,*) Write (nout,*) 'Standard errors of estimates and' Write (nout,*) 'approximate z-statistics' Write (nout,99995)(parest(2*ip+1+i),parest(3*ip+1+i),i=1,ip) 99999 Format (1X,A,I2) 99998 Format (1X,A,F8.5) 99997 Format (1X,2F9.3) 99996 Format (1X,A,F9.3,A,I2,A) 99995 Format (1X,F9.3,F14.3) End Program g08rafe