PROGRAM g13asfe ! G13ASF Example Program Text ! Mark 23 Release. NAG Copyright 2011. ! .. Use Statements .. USE nag_library, ONLY : g13aff, g13asf, nag_wp, x04abf ! .. Implicit None Statement .. IMPLICIT NONE ! .. Parameters .. INTEGER, PARAMETER :: iset = 1, nin = 5, nout = 6 ! .. Local Scalars .. REAL (KIND=nag_wp) :: c, chi, s, siglev INTEGER :: idf, ifail, ires, ishow, itc, kfc, & kpiv, ldcm, ldrcm, liw, lwork, m, n, & nadv, ndf, nit, npar, nppc, nst, nx, & pp, qp ! .. Local Arrays .. REAL (KIND=nag_wp), ALLOCATABLE :: cm(:,:), par(:), r(:), rcm(:,:), & sd(:), st(:), v(:), work(:), x(:) INTEGER :: isf(4), mr(7) INTEGER, ALLOCATABLE :: iw(:) ! .. Intrinsic Functions .. INTRINSIC max ! .. Executable Statements .. WRITE (nout,*) 'G13ASF Example Program Results' WRITE (nout,*) FLUSH (nout) ! Skip heading in data file READ (nin,*) ! Read in problem size READ (nin,*) nx, kfc, c ! Read in the orders READ (nin,*) mr(1:7) ! Calculate NPAR and various array sizes npar = mr(1) + mr(3) + mr(4) + mr(6) nppc = npar + kfc ldcm = nppc pp = mr(1) + mr(4)*mr(7) qp = mr(3) + mr(6)*mr(7) ires = 15*qp + 11*nx + 13*nppc + 8*pp + 12 + 2*(qp+nppc)**2 ALLOCATE (par(npar),x(nx),sd(nppc),cm(ldcm,nppc),st(nx),v(ires)) ! Read in data READ (nin,*) x(1:nx) ! Read in initial values READ (nin,*) par(1:npar) ! Read in control parameters READ (nin,*) kpiv, nit ! Set the advisory channel to NOUT for monitoring information IF (kpiv/=0) THEN nadv = nout CALL x04abf(iset,nadv) END IF ! Fit ARIMA model ifail = -1 CALL g13aff(mr,par,npar,c,kfc,x,nx,s,ndf,sd,nppc,cm,ldcm,st,nst,kpiv, & nit,itc,isf,v,ires,n,ifail) IF (ifail/=0) THEN IF (ifail/=9) THEN GO TO 20 END IF END IF ! Read in parameters for G13ASF READ (nin,*) m, ishow ldrcm = m liw = max(mr(1),mr(3),mr(4),mr(6)) lwork = npar*(n+npar+1) + liw*max(mr(7),1) + m ALLOCATE (r(m),rcm(ldrcm,m),iw(liw),work(lwork)) ! Set the advisory channel to NOUT for monitoring information ! if it has not been set previously IF (ishow/=0 .AND. kpiv==0) THEN nadv = nout CALL x04abf(iset,nadv) END IF ! Perform diagnostic checks ifail = 0 CALL g13asf(n,v,mr,m,par,npar,ishow,r,rcm,ldrcm,chi,idf,siglev,iw,liw, & work,lwork,ifail) 20 CONTINUE END PROGRAM g13asfe