Program g08rbfe ! G08RBF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: g08rbf, nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: gamma, tol Integer :: i, ifail, ip, j, ldprvr, ldx, liwa, & lparest, lvapvec, lwork, nmax, ns, & nsum ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: eta(:), parest(:), prvr(:,:), & vapvec(:), work(:), x(:,:), y(:), & zin(:) Integer, Allocatable :: icen(:), irank(:), iwa(:), nv(:) ! .. Intrinsic Procedures .. Intrinsic :: maxval, sum ! .. Executable Statements .. Write (nout,*) 'G08RBF Example Program Results' Write (nout,*) ! Skip heading in data file Read (nin,*) ! Read number of samples, number of parameters to be fitted, ! distribution power parameter and tolerance criterion for ties. Read (nin,*) ns, ip, gamma, 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) liwa = 4*nmax Allocate (y(nsum),x(ldx,ip),icen(nsum),prvr(ldprvr,ip),irank(nmax), & zin(nmax),eta(nmax),vapvec(lvapvec),parest(lparest),work(lwork), & iwa(liwa)) ! Read in observations, design matrix and censoring variable Read (nin,*)(y(i),x(i,1:ip),icen(i),i=1,nsum) ! Display input information Write (nout,99999) 'Number of samples =', ns Write (nout,99999) 'Number of parameters fitted =', ip Write (nout,99998) 'Distribution power parameter =', gamma Write (nout,99998) 'Tolerance for ties =', tol ifail = 0 Call g08rbf(ns,nv,nsum,y,ip,x,ldx,icen,gamma,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,F10.5) 99997 Format (1X,F9.3) 99996 Format (1X,A,F9.3,A,I2,A) 99995 Format (1X,F9.3,F14.3) End Program g08rbfe