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

NAG FL Interface Introduction
Example description
!   G13DNF Example Program Text
!   Mark 30.1 Release. NAG Copyright 2024.

    Module g13dnfe_mod

!     G13DNF 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,n,m,ldpar,parlag,x,pvalue,nout)

!       .. Use Statements ..
        Use nag_library, Only: x04cbf
!       .. Scalar Arguments ..
        Integer, Intent (In)           :: k, ldpar, m, n, nout
!       .. Array Arguments ..
        Real (Kind=nag_wp), Intent (In) :: parlag(ldpar,ldpar,m), pvalue(m),   &
                                          x(m)
!       .. Local Scalars ..
        Real (Kind=nag_wp)             :: c1, c2, c3, c5, c6, c7, inv_sqrt_n,  &
                                          sum_nag
        Integer                        :: i, i2, ifail, j, l, ll
!       .. Local Arrays ..
        Character (1)                  :: clabs(1), rlabs(1)
        Character (79)                 :: rec(7)
!       .. Intrinsic Procedures ..
        Intrinsic                      :: real, sqrt
!       .. Executable Statements ..
!       Print the partial lag correlation matrices.

        inv_sqrt_n = 1.0E0_nag_wp/sqrt(real(n,kind=nag_wp))
        Write (nout,*)
        Write (nout,*) ' PARTIAL LAG CORRELATION MATRICES'
        Write (nout,*) ' --------------------------------'
        Do l = 1, m
          Write (nout,99999) ' Lag = ', l
          Flush (nout)
          ifail = 0
          Call x04cbf('G','N',k,k,parlag(1,1,l),ldpar,'F9.3',' ','N',rlabs,    &
            'N',clabs,80,5,ifail)
        End Do
        Write (nout,99998) ' Standard error = 1 / SQRT(N) =', inv_sqrt_n

!       Print indicator symbols to indicate significant elements.
        Write (nout,*)
        Write (nout,*) ' TABLES OF INDICATOR SYMBOLS'
        Write (nout,*) ' ---------------------------'
        Write (nout,99999) ' For Lags 1 to ', m

!       Set up annotation for the plots.
        Write (rec(1),99997) '              0.005  :'
        Write (rec(2),99997) '        +     0.01   :'
        Write (rec(3),99997) '              0.05   :'
        Write (rec(4)(1:23),99997) '   Sig. Level        :'
        Write (rec(4)(24:),99997) '- - - - - - - - - -  Lags'
        Write (rec(5),99997) '              0.05   :'
        Write (rec(6),99997) '        -     0.01   :'
        Write (rec(7),99997) '              0.005  :'

!       Set up the critical values
        c1 = 3.29E0_nag_wp*inv_sqrt_n
        c2 = 2.58E0_nag_wp*inv_sqrt_n
        c3 = 1.96E0_nag_wp*inv_sqrt_n
        c5 = -c3
        c6 = -c2
        c7 = -c1

        Do i = 1, k
          Do j = 1, k
            Write (nout,*)
            If (i==j) Then
              Write (nout,99996) ' Auto-correlation function for', ' series ', &
                i
            Else
              Write (nout,99995) ' Cross-correlation function for',            &
                ' series ', i, ' and series', j
            End If
            Do l = 1, m
              ll = 23 + 2*l
              sum_nag = parlag(i,j,l)

!             Clear the last plot with blanks
              Do i2 = 1, 7
                If (i2/=4) Then
                  rec(i2)(ll:ll) = ' '
                End If
              End Do

!             Check for significance
              If (sum_nag>c1) Then
                rec(1)(ll:ll) = '*'
              End If
              If (sum_nag>c2) Then
                rec(2)(ll:ll) = '*'
              End If
              If (sum_nag>c3) Then
                rec(3)(ll:ll) = '*'
              End If
              If (sum_nag<c5) Then
                rec(5)(ll:ll) = '*'
              End If
              If (sum_nag<c6) Then
                rec(6)(ll:ll) = '*'
              End If
              If (sum_nag<c7) Then
                rec(7)(ll:ll) = '*'
              End If
            End Do

!           Print
            Write (nout,99997)(rec(i2),i2=1,7)
          End Do
        End Do

!       Print the chi-square statistics and p-values.
        Write (nout,*)
        Write (nout,*)
        Write (nout,*) ' Lag     Chi-square statistic     P-value'
        Write (nout,*) ' ---     --------------------     -------'
        Write (nout,*)
        Write (nout,99994)(l,x(l),pvalue(l),l=1,m)

        Return

99999   Format (/,1X,A,I2)
99998   Format (/,1X,A,F6.3,A)
99997   Format (1X,A)
99996   Format (/,/,1X,A,A,I2,/)
99995   Format (/,/,1X,A,A,I2,A,I2,/)
99994   Format (1X,I4,10X,F8.3,11X,F8.4)
      End Subroutine zprint
    End Module g13dnfe_mod
    Program g13dnfe

!     G13DNF Example Main Program

!     .. Use Statements ..
      Use g13dnfe_mod, Only: nin, nout, zprint
      Use nag_library, Only: g13dmf, g13dnf, nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Local Scalars ..
      Integer                          :: i, ifail, k, kmax, lwork, m, maxlag, &
                                          n
      Character (1)                    :: matrix
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: parlag(:,:,:), pvalue(:), r(:,:,:),  &
                                          r0(:,:), w(:,:), wmean(:), work(:),  &
                                          x(:)
!     .. Executable Statements ..
      Write (nout,*) 'G13DNF Example Program Results'
      Write (nout,*)

!     Skip heading in data file
      Read (nin,*)

!     Read in the problem size
      Read (nin,*) k, n, m, matrix

      kmax = k
      lwork = (5*m+6)*k**2 + k
      Allocate (w(kmax,n),wmean(k),r0(kmax,k),r(kmax,kmax,m),                  &
        parlag(kmax,kmax,m),x(m),pvalue(m),work(lwork))

!     Read in series
      Read (nin,*)(w(i,1:n),i=1,k)

!     Calculate cross correlations
      ifail = 0
      Call g13dmf(matrix,k,n,m,w,kmax,wmean,r0,r,ifail)

!     Calculate sample partial lag correlation matrices
      ifail = 0
      Call g13dnf(k,n,m,kmax,r0,r,maxlag,parlag,x,pvalue,work,lwork,ifail)

!     Display results
      Call zprint(k,n,m,kmax,parlag,x,pvalue,nout)

    End Program g13dnfe