Program g13ddfe ! G13DDF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: g13ddf, nag_wp, x04abf ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: iset = 1, nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: cgetol, rlogl Integer :: i, ifail, ip, iprint, iq, ishow, k, & kmax, ldcm, maxcal, n, nadv, niter, & npar Logical :: exact, mean ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: cm(:,:), g(:), par(:), qq(:,:), & v(:,:), w(:,:) Logical, Allocatable :: parhld(:) ! .. Executable Statements .. Write (nout,*) 'G13DDF Example Program Results' Write (nout,*) Flush (nout) ! Skip heading in data file Read (nin,*) ! Read in problem size Read (nin,*) k, ip, iq, n, mean ! Calculate NPAR npar = (ip+iq)*k*k If (mean) Then npar = npar + k End If ldcm = npar kmax = k Allocate (par(npar),qq(kmax,k),w(kmax,n),v(kmax,n),g(npar), & cm(ldcm,npar),parhld(npar)) ! Read in series Read (nin,*)(w(i,1:n),i=1,k) ! Read in control parameters Read (nin,*) iprint, cgetol, maxcal, ishow ! Read in exact likelihood flag Read (nin,*) exact ! Read in initial parameter estimates and free parameter flags Read (nin,*) par(1:npar) Read (nin,*) parhld(1:npar) ! Read in initial values for covariance matrix QQ Read (nin,*)(qq(i,1:i),i=1,k) ! Set the advisory channel to NOUT for monitoring information If (iprint>=0 .Or. ishow/=0) Then nadv = nout Call x04abf(iset,nadv) End If ! Fit a VARMA model ifail = 0 Call g13ddf(k,n,ip,iq,mean,par,npar,qq,kmax,w,parhld,exact,iprint, & cgetol,maxcal,ishow,niter,rlogl,v,g,cm,ldcm,ifail) End Program g13ddfe