NAG Library Manual, Mark 27.3
Interfaces:  FL   CL   CPP   AD 

NAG FL Interface Introduction
Example description
!   G13DPF Example Program Text
!   Mark 27.3 Release. NAG Copyright 2021.

    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