! G13DPF Example Program Text
! Mark 30.3 Release. nAG Copyright 2024.
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
! .. Accessibility Statements ..
Private
Public :: zprint
! .. Parameters ..
Integer, Parameter, Public :: 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_nag
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_nag = parlag(1,j,l)
st(j) = '.'
If (sum_nag>1.96E0_nag_wp*se(1,j,l)) Then
st(j) = '+'
End If
If (sum_nag<-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_nag = parlag(i,j,l)
st(j) = '.'
If (sum_nag>1.96E0_nag_wp*se(i,j,l)) Then
st(j) = '+'
End If
If (sum_nag<-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 g13dpfe_mod, Only: nin, nout, zprint
Use nag_library, Only: g13dpf, nag_wp
! .. 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