! G13DNF Example Program Text ! Mark 24 Release. NAG Copyright 2012. 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 ! .. 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 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 = 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