!   G13DNF Example Program Text
!   Mark 23 Release. NAG Copyright 2011.

    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
!      .. Parameters ..
       INTEGER, PARAMETER                  :: nin = 5, nout = 6
    CONTAINS
       SUBROUTINE zprint(k,n,m,ldpar,parlag,x,pvalue,nout)

!         .. Use Statements ..
          USE nag_library, ONLY : x04cbf
!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. 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
          INTEGER                             :: i, i2, ifail, j, l, ll
!         .. Local Arrays ..
          CHARACTER (1)                       :: clabs(1), rlabs(1)
          CHARACTER (80)                      :: rec(7)
!         .. Intrinsic Functions ..
          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 = 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>c1) THEN
                      rec(1) (ll:ll) = '*'
                   END IF
                   IF (sum>c2) THEN
                      rec(2) (ll:ll) = '*'
                   END IF
                   IF (sum>c3) THEN
                      rec(3) (ll:ll) = '*'
                   END IF
                   IF (sum<c5) THEN
                      rec(5) (ll:ll) = '*'
                   END IF
                   IF (sum<c6) THEN
                      rec(6) (ll:ll) = '*'
                   END IF
                   IF (sum<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 nag_library, ONLY : g13dmf, g13dnf, nag_wp
       USE g13dnfe_mod, ONLY : nin, nout, zprint
!      .. 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