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

    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
!      .. Parameters ..
       INTEGER, PARAMETER                  :: nin = 5, nout = 6
    CONTAINS
!dec$ attributes offload : mic :: zprint
       SUBROUTINE zprint(k,m,ldpar,maxlag,parlag,se,qq,x,pvalue,nout,ifail)

!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. 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
          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 = parlag(1,j,l)
                st(j) = '.'
                IF (sum>1.96E0_nag_wp*se(1,j,l)) THEN
                   st(j) = '+'
                END IF
                IF (sum<-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 = parlag(i,j,l)
                   st(j) = '.'
                   IF (sum>1.96E0_nag_wp*se(i,j,l)) THEN
                      st(j) = '+'
                   END IF
                   IF (sum<-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)
!dec$ attributes offload : mic :: zprint
       END SUBROUTINE zprint
    END MODULE g13dpfe_mod
    PROGRAM g13dpfe

!      G13DPF Example Main Program

!      .. Use Statements ..
       USE nag_library, ONLY : g13dpf, nag_wp
       USE g13dpfe_mod, ONLY : nin, nout, zprint
!      .. 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 20
          END IF
       END IF

!      Display results
       CALL zprint(k,m,kmax,maxlag,parlag,se,qq,x,pvalue,nout,ifail)

20     CONTINUE

    END PROGRAM g13dpfe
