! G13DPF Example Program Text ! Mark 24 Release. NAG Copyright 2012. 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) ! .. 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 100 End If End If ! Display results Call zprint(k,m,kmax,maxlag,parlag,se,qq,x,pvalue,nout,ifail) 100 Continue End Program g13dpfe