! G13DPF Example Program Text ! Mark 23 Release. NAG Copyright 2011. MODULE g13dpfe_mod ! G13DPF 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 zprint(k,m,ldpar,maxlag,parlag,se,qq,x,pvalue,nout,ifail) ! .. Implicit None Statement .. IMPLICIT NONE ! .. Scalar Arguments .. INTEGER, INTENT (IN) :: ifail, k, ldpar, m, maxlag, & nout ! .. Array Arguments .. REAL (KIND=nag_wp), INTENT (IN) :: parlag(ldpar,ldpar,m), & pvalue(m), qq(ldpar,ldpar,m), & se(ldpar,ldpar,m), x(m) ! .. Local Scalars .. REAL (KIND=nag_wp) :: sum INTEGER :: i, i2, j, l ! .. Local Arrays .. CHARACTER (6) :: st(6) ! .. Executable Statements .. ! Display titles IF (k>1) THEN WRITE (nout,99999) ELSE IF (k==1) THEN WRITE (nout,99998) END IF DO l = 1, maxlag DO j = 1, k sum = parlag(1,j,l) st(j) = '.' IF (sum>1.96E0_nag_wp*se(1,j,l)) THEN st(j) = '+' END IF IF (sum<-1.96E0_nag_wp*se(1,j,l)) THEN st(j) = '-' END IF END DO IF (k==1) THEN WRITE (nout,99997) l, (parlag(1,j,l),j=1,k), (st(i2),i2=1,k), & qq(1,1,l), x(l), pvalue(l) WRITE (nout,99996) (se(1,j,l),j=1,k) ELSE IF (k==2) THEN WRITE (nout,99995) l, (parlag(1,j,l),j=1,k), (st(i2),i2=1,k), & qq(1,1,l), x(l), pvalue(l) WRITE (nout,99994) (se(1,j,l),j=1,k) ELSE IF (k==3) THEN WRITE (nout,99993) l, (parlag(1,j,l),j=1,k), (st(i2),i2=1,k), & qq(1,1,l), x(l), pvalue(l) WRITE (nout,99992) (se(1,j,l),j=1,k) ELSE IF (k==4) THEN WRITE (nout,99991) l WRITE (nout,99986) (parlag(1,j,l),j=1,k), (st(i2),i2=1,k), & qq(1,1,l), x(l), pvalue(l) WRITE (nout,99990) (se(1,j,l),j=1,k) END IF DO i = 2, k DO j = 1, k sum = parlag(i,j,l) st(j) = '.' IF (sum>1.96E0_nag_wp*se(i,j,l)) THEN st(j) = '+' END IF IF (sum<-1.96E0_nag_wp*se(i,j,l)) THEN st(j) = '-' END IF END DO IF (k==2) THEN WRITE (nout,99989) (parlag(i,j,l),j=1,k), (st(i2),i2=1,k), & qq(i,i,l) WRITE (nout,99994) (se(i,j,l),j=1,k) ELSE IF (k==3) THEN WRITE (nout,99988) (parlag(i,j,l),j=1,k), (st(i2),i2=1,k), & qq(i,i,l) WRITE (nout,99992) (se(i,j,l),j=1,k) ELSE IF (k==4) THEN WRITE (nout,99987) (parlag(i,j,l),j=1,k), (st(i2),i2=1,k), & qq(i,i,l) WRITE (nout,99990) (se(i,j,l),j=1,k) END IF END DO END DO IF (ifail==2) THEN WRITE (nout,99985) 'Recursive equations broke down at ', & maxlag + 1 END IF RETURN 99999 FORMAT (' Partial Autoregression Matrices',4X,'Indicator',2X, & 'Residual',3X,'Chi-Square',2X,'Pvalue'/37X,'Symbols',3X, & 'Variances',3X,'Statistic'/' -------------------------------',4X, & '---------',2X,'---------',2X,'-----------',1X,'------') 99998 FORMAT (' Partial Autoregression Function',4X,'Indicator',2X, & 'Residual',3X,'Chi-Square',2X,'Pvalue'/37X,'Symbols',3X, & 'Variances',3X,'Statistic'/' -------------------------------',4X, & '---------',2X,'---------',2X,'-----------',1X,'------') 99997 FORMAT (/' Lag',I3,1X,':',F7.3,22X,A1,F14.3,3X,F10.3,F9.3) 99996 FORMAT (9X,'(',F6.3,')') 99995 FORMAT (/' Lag',I3,1X,':',2F8.3,14X,2A1,F13.3,3X,F10.3,F9.3) 99994 FORMAT (10X,'(',F6.3,')(',F6.3,')') 99993 FORMAT (/' Lag',I3,1X,':',3F8.3,6X,3A1,F12.3,3X,F10.3,F9.3) 99992 FORMAT (10X,'(',F6.3,')(',F6.3,')(',F6.3,')') 99991 FORMAT (/' Lag',I3) 99990 FORMAT (2X,'(',F6.3,')(',F6.3,')(',F6.3,')(',F6.3,')') 99989 FORMAT (9X,2F8.3,14X,2A1,F13.3) 99988 FORMAT (9X,3F8.3,6X,3A1,F12.3) 99987 FORMAT (1X,4F8.3,5X,4A1,F12.3) 99986 FORMAT (1X,4F8.3,5X,4A1,F12.3,3X,F10.3,F9.3) 99985 FORMAT (1X,A,I0) END SUBROUTINE zprint END MODULE g13dpfe_mod PROGRAM g13dpfe ! G13DPF Example Main Program ! .. Use Statements .. USE nag_library, ONLY : g13dpf, nag_wp USE g13dpfe_mod, ONLY : nin, nout, zprint ! .. Implicit None Statement .. IMPLICIT NONE ! .. Local Scalars .. INTEGER :: i, ifail, k, kmax, l, lwork, m, & maxlag, mk, n ! .. Local Arrays .. REAL (KIND=nag_wp), ALLOCATABLE :: loglhd(:), parlag(:,:,:), & pvalue(:), qq(:,:,:), se(:,:,:), & work(:), x(:), z(:,:) INTEGER, ALLOCATABLE :: iwork(:) ! .. Executable Statements .. WRITE (nout,*) 'G13DPF Example Program Results' WRITE (nout,*) ! Skip heading in data file READ (nin,*) ! Read in the problem size READ (nin,*) k, n, m kmax = k mk = m*k l = mk + 1 lwork = (k+1)*k + l*(4+k)*2*l**2 ALLOCATE (z(kmax,n),parlag(kmax,kmax,m),se(kmax,kmax,m),x(m),pvalue(m), & loglhd(m),work(lwork),qq(kmax,kmax,m),iwork(mk)) ! Read in series DO i = 1, k READ (nin,*) z(i,1:n) END DO ! Calculate sample partial autoregression matrices ifail = -1 CALL g13dpf(k,n,z,kmax,m,maxlag,parlag,se,qq,x,pvalue,loglhd,work, & lwork,iwork,ifail) IF (ifail/=0) THEN IF (ifail/=2) THEN GO TO 20 END IF END IF ! Display results CALL zprint(k,m,kmax,maxlag,parlag,se,qq,x,pvalue,nout,ifail) 20 CONTINUE END PROGRAM g13dpfe