Program g13dsfe ! G13DSF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: g13ddf, g13dsf, nag_wp, x04abf ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: iset = 1, nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: cgetol, chi, rlogl, siglev Integer :: dishow, i, idf, ifail, ip, iprint, & iq, ishow, k, k2, kmax, ldcm, ldrcm, & liw, lpar, lwork, m, maxcal, mk2, n, & nadv, niter, npar Logical :: exact, mean ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: cm(:,:), g(:), par(:), qq(:,:), & r(:,:,:), r0(:,:), rcm(:,:), v(:,:), & w(:,:), work(:) Integer, Allocatable :: iw(:) Logical, Allocatable :: parhld(:) ! .. Intrinsic Procedures .. Intrinsic :: max ! .. Executable Statements .. Write (nout,*) 'G13DSF Example Program Results' Write (nout,*) Flush (nout) ! Skip heading in data file Read (nin,*) ! Read in the problem size Read (nin,*) k, ip, iq, n, mean, m ! Calculate number of parameters for the VARMA k2 = k*k lpar = (ip+iq)*k2 npar = lpar If (mean) Then lpar = lpar + k End If kmax = k ldcm = lpar mk2 = m*k2 ldrcm = mk2 liw = k*max(ip,iq) lwork = k*(n+kmax+2) + mk2*(npar+mk2+1) + 3*k2 Allocate (par(lpar),parhld(lpar),qq(kmax,k),w(kmax,n),v(kmax,n),g(lpar), & cm(ldcm,lpar),r0(kmax,k),rcm(ldrcm,mk2),iw(liw),work(lwork), & r(kmax,kmax,mk2)) ! Read in series Read (nin,*)(w(i,1:n),i=1,k) ! Read in control parameters Read (nin,*) iprint, cgetol, maxcal, dishow ! Read in exact likelihood flag Read (nin,*) exact ! Read in initial parameter estimates and free parameter flags Read (nin,*) par(1:lpar) Read (nin,*) parhld(1:lpar) ! Read in initial values for covariance matrix Q Read (nin,*)(qq(i,1:i),i=1,k) ! Read in the ISHOW flag for G13DSF Read (nin,*) ishow ! Set the advisory channel to NOUT for monitoring information If (iprint>=0 .Or. dishow/=0 .Or. ishow/=0) Then nadv = nout Call x04abf(iset,nadv) End If ! Fit VARMA model ifail = -1 Call g13ddf(k,n,ip,iq,mean,par,lpar,qq,kmax,w,parhld,exact,iprint, & cgetol,maxcal,dishow,niter,rlogl,v,g,cm,ldcm,ifail) If (ifail/=0) Then If (ifail<4) Then Go To 100 End If End If ! Titles Write (nout,*) Write (nout,*) 'Output from G13DSF' Write (nout,*) Flush (nout) ! Calculate and display diagnostics ifail = 0 Call g13dsf(k,n,v,kmax,ip,iq,m,par,parhld,qq,ishow,r0,r,rcm,ldrcm,chi, & idf,siglev,iw,liw,work,lwork,ifail) 100 Continue End Program g13dsfe