!   G13DMF Example Program Text
!   Mark 30.1 Release. NAG Copyright 2024.

    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
!     .. Accessibility Statements ..
      Private
      Public                           :: cprint
!     .. Parameters ..
      Integer, Parameter, Public       :: nin = 5, nout = 6
    Contains
      Subroutine cprint(k,n,ldr,m,wmean,r0,r,nout)

!       .. Use Statements ..
        Use nag_library, Only: x04cbf
!       .. 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_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 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_nag = 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_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,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 g13dmfe_mod, Only: cprint, nin, nout
      Use nag_library, Only: g13dmf, nag_wp
!     .. 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