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

    MODULE g13dmfe_mod

!      G13DMF 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 cprint(k,n,ldr,m,wmean,r0,r,nout)

!         .. Use Statements ..
          USE nag_library, ONLY : x04cbf
!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. Scalar Arguments ..
          INTEGER, INTENT (IN)                :: k, ldr, m, n, nout
!         .. Array Arguments ..
          REAL (KIND=nag_wp), INTENT (IN)     :: r(ldr,ldr,m), r0(ldr,k),      &
                                                 wmean(k)
!         .. 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 correlation matrices and indicator symbols.

          inv_sqrt_n = 1.0E0_nag_wp/sqrt(real(n,kind=nag_wp))
          WRITE (nout,*)
          WRITE (nout,*) ' THE MEANS'
          WRITE (nout,*) ' ---------'
          WRITE (nout,99999) wmean(1:k)
          WRITE (nout,*)
          WRITE (nout,*) ' CROSS-CORRELATION MATRICES'
          WRITE (nout,*) ' --------------------------'
          WRITE (nout,99998) ' Lag = ', 0
          FLUSH (nout)
          ifail = 0
          CALL x04cbf('G','N',k,k,r0,ldr,'F9.3',' ','N',rlabs,'N',clabs,80,5, &
             ifail)
          DO l = 1, m
             WRITE (nout,99998) ' Lag = ', l
             FLUSH (nout)
             ifail = 0
             CALL x04cbf('G','N',k,k,r(1,1,l),ldr,'F9.3',' ','N',rlabs,'N', &
                clabs,80,5,ifail)
          END DO

!         Print indicator symbols to indicate significant elements.
          WRITE (nout,99997) ' Standard error = 1 / SQRT(N) =', inv_sqrt_n
          WRITE (nout,*)
          WRITE (nout,*) ' TABLES OF INDICATOR SYMBOLS'
          WRITE (nout,*) ' ---------------------------'
          WRITE (nout,99998) ' For Lags 1 to ', m

!         Set up annotation for the plots.
          WRITE (rec(1),99996) '              0.005  :'
          WRITE (rec(2),99996) '        +     0.01   :'
          WRITE (rec(3),99996) '              0.05   :'
          WRITE (rec(4)(1:23),99996) '   Sig. Level        :'
          WRITE (rec(4)(24:),99996) '- - - - - - - - - -  Lags'
          WRITE (rec(5),99996) '              0.05   :'
          WRITE (rec(6),99996) '        -     0.01   :'
          WRITE (rec(7),99996) '              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,99995) ' Auto-correlation function for', &
                      ' series ', i
                ELSE
                   WRITE (nout,99994) ' Cross-correlation function for', &
                      ' series ', i, ' and series', j
                END IF
                DO l = 1, m
                   ll = 23 + 2*l
                   sum = r(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,99996) (rec(i2),i2=1,7)
             END DO
          END DO
          RETURN

99999     FORMAT (/1X,2(2X,F9.3))
99998     FORMAT (/1X,A,I2)
99997     FORMAT (/1X,A,F6.3,A)
99996     FORMAT (1X,A)
99995     FORMAT (//1X,A,A,I2/)
99994     FORMAT (//1X,A,A,I2,A,I2/)
       END SUBROUTINE cprint
    END MODULE g13dmfe_mod
    PROGRAM g13dmfe

!      G13DMF Example Main Program

!      .. Use Statements ..
       USE nag_library, ONLY : g13dmf, nag_wp
       USE g13dmfe_mod, ONLY : cprint, nin, nout
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Local Scalars ..
       INTEGER                             :: i, ifail, k, kmax, m, n
       CHARACTER (1)                       :: matrix
!      .. Local Arrays ..
       REAL (KIND=nag_wp), ALLOCATABLE     :: r(:,:,:), r0(:,:), w(:,:),       &
                                              wmean(:)
!      .. Executable Statements ..
       WRITE (nout,*) 'G13DMF 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
       ALLOCATE (w(kmax,n),r0(kmax,k),wmean(k),r(kmax,kmax,m))

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

!      Calculate sample cross-correlation matrices
       ifail = 0
       CALL g13dmf(matrix,k,n,m,w,kmax,wmean,r0,r,ifail)

!      Display results
       CALL cprint(k,n,kmax,m,wmean,r0,r,nout)

    END PROGRAM g13dmfe