! G13AEF Example Program Text ! Mark 23 Release. NAG Copyright 2011. MODULE g13aefe_mod ! G13AEF Example Program Module: ! Parameters and User-defined Routines ! .. Use Statements .. USE nag_library, ONLY : nag_wp ! .. Implicit None Statement .. IMPLICIT NONE ! .. Parameters .. INTEGER, PARAMETER :: nin = 5, nout = 6 CONTAINS SUBROUTINE piv(mr,par,npar,c,kfc,icount,s,g,h,ldh,igh,itc,zsp) ! .. Implicit None Statement .. IMPLICIT NONE ! .. Scalar Arguments .. REAL (KIND=nag_wp), INTENT (IN) :: c, s INTEGER, INTENT (IN) :: igh, itc, kfc, ldh, npar ! .. Array Arguments .. REAL (KIND=nag_wp), INTENT (IN) :: g(igh), h(ldh,igh), & par(npar), zsp(4) INTEGER, INTENT (IN) :: icount(6), mr(7) ! .. Executable Statements .. WRITE (nout,*) WRITE (nout,99999) 'Iteration', itc, ' residual sum of squares = ', & s RETURN 99999 FORMAT (1X,A,I3,A,E11.4) END SUBROUTINE piv END MODULE g13aefe_mod PROGRAM g13aefe ! G13AEF Example Main Program ! .. Use Statements .. USE nag_library, ONLY : g13aef, nag_wp, x04caf USE g13aefe_mod, ONLY : nin, nout, piv ! .. Implicit None Statement .. IMPLICIT NONE ! .. Local Scalars .. REAL (KIND=nag_wp) :: c, s INTEGER :: iex, ifail, igh, ist, itc, iwa, & kfc, kpiv, kzsp, ldh, ndf, nex, & ngh, nit, npar, nst, nx ! .. Local Arrays .. REAL (KIND=nag_wp), ALLOCATABLE :: al(:), ex(:), exr(:), g(:), & h(:,:), hc(:,:), par(:), sd(:), & st(:), wa(:), x(:) REAL (KIND=nag_wp) :: zsp(4) INTEGER :: icount(6), isf(4), mr(7) ! .. Intrinsic Functions .. INTRINSIC max ! .. Executable Statements .. WRITE (nout,*) 'G13AEF Example Program Results' WRITE (nout,*) ! Skip heading in data file READ (nin,*) ! Read in the problem size etc READ (nin,*) nx, kfc, c ! Read in the orders READ (nin,*) mr(1:7) ! Calculate NPAR and various array lengths npar = mr(1) + mr(3) + mr(4) + mr(6) iex = mr(3) + (mr(6)*mr(7)) + nx igh = mr(3) + (mr(6)*mr(7)) + npar + kfc ist = (mr(4)*mr(7)) + mr(2) + (mr(5)*mr(7)) + mr(3) + & max(mr(1),(mr(6)*mr(7))) iwa = ((nx+1+mr(1)+(mr(4)*mr(7))+mr(3)+(mr(6)*mr(7)))*8) + (9*npar) ldh = igh + 1 ALLOCATE (x(nx),par(npar),ex(iex),exr(iex),al(iex),g(igh),sd(igh), & h(ldh,igh),st(ist),wa(iwa),hc(ldh,igh)) ! 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, kzsp IF (kzsp==1) THEN READ (nin,*) zsp(1:4) END IF ! Fit ARIMA model ifail = -1 CALL g13aef(mr,par,npar,c,kfc,x,nx,icount,ex,exr,al,iex,s,g,igh,sd,h, & ldh,st,ist,nst,piv,kpiv,nit,itc,zsp,kzsp,isf,wa,iwa,hc,ifail) IF (ifail/=0) THEN IF (ifail<7) THEN GO TO 20 END IF END IF ! Display results nex = icount(4) ndf = icount(5) ngh = icount(6) IF (ifail==0) THEN WRITE (nout,99998) 'Convergence was achieved after', itc, ' cycles' ELSE WRITE (nout,99998) 'Iterative process ran for', itc, ' cycles' END IF WRITE (nout,*) WRITE (nout,*) 'Final values of the PAR parameters and the & &constant are as follows' WRITE (nout,99997) par(1:npar), c WRITE (nout,*) WRITE (nout,99996) 'Residual sum of squares is', s, ' with', ndf, & ' degrees of freedom' WRITE (nout,*) WRITE (nout,*) 'The final values of ZSP were' WRITE (nout,99995) zsp(1:4) WRITE (nout,*) WRITE (nout,99999) 'The number of parameters estimated was', ngh WRITE (nout,*) '( backward forecasts, PAR and C, in that order )' WRITE (nout,*) WRITE (nout,*) 'The corresponding G array holds' WRITE (nout,99994) g(1:ngh) IF ((ifail==0 .OR. ifail==9) .AND. itc>0) THEN WRITE (nout,*) WRITE (nout,*) 'The corresponding SD array holds' WRITE (nout,99994) sd(1:ngh) WRITE (nout,*) FLUSH (nout) ifail = 0 CALL x04caf('General',' ',ngh,ngh,h,ldh,'Corresponding H matrix', & ifail) WRITE (nout,*) 'Holds second derivatives in the upper & &half (including the main diagonal)' WRITE (nout,*) 'and correlation coefficients in the lower triangle' END IF WRITE (nout,*) WRITE (nout,99993) 'EX, EXR, and AL each hold', nex, & ' values made up of', icount(1), ' back forecast(s),' WRITE (nout,99992) icount(2), ' differenced values, and' WRITE (nout,99992) icount(3), & ' element(s) of reconstituted information' WRITE (nout,*) WRITE (nout,*) ' EX' WRITE (nout,99991) ex(1:nex) IF (ifail==0 .OR. ifail==9) THEN WRITE (nout,*) WRITE (nout,*) ' EXR' WRITE (nout,99991) exr(1:nex) END IF IF (ifail==0) THEN WRITE (nout,*) WRITE (nout,*) ' AL' WRITE (nout,99991) al(1:nex) END IF IF (ifail==0 .OR. ifail==9) THEN WRITE (nout,*) WRITE (nout,99998) 'The state set consists of', nst, ' values' WRITE (nout,99991) st(1:nst) END IF 20 CONTINUE 99999 FORMAT (1X,A,I5) 99998 FORMAT (1X,A,I3,A) 99997 FORMAT (1X,4F10.4) 99996 FORMAT (1X,A,F10.3,A,I4,A) 99995 FORMAT (1X,4E15.4) 99994 FORMAT (1X,10F9.4) 99993 FORMAT (1X,A,I5,A,I5,A) 99992 FORMAT (1X,I5,A) 99991 FORMAT (1X,5F11.4) END PROGRAM g13aefe