Program c09eafe ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: c09abf, c09eaf, c09ebf, nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Integer :: i, ifail, lda, ldb, ldca, ldcd, & ldch, ldcv, m, n, nf, nwcm, nwcn, & nwct, nwl Character (12) :: mode, wavnam, wtrans ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: a(:,:), b(:,:), ca(:,:), cd(:,:), & ch(:,:), cv(:,:) Integer :: icomm(180) ! .. Executable Statements .. Write (nout,*) 'C09EAF Example Program Results' ! Skip heading in data file Read (nin,*) ! Read problem parameters. Read (nin,*) m, n Read (nin,*) wavnam, mode Write (nout,99999) wavnam, mode lda = m ldb = m Allocate (a(lda,n),b(ldb,n)) ! Read data array Do i = 1, m Read (nin,*) a(i,1:n) End Do Write (nout,99998) 'Input Data A' Do i = 1, m Write (nout,99997) a(i,1:n) End Do ! Query wavelet filter dimensions wtrans = 'Single Level' ! ifail: behaviour on error exit ! =0 for hard exit, =1 for quiet-soft, =-1 for noisy-soft ifail = 0 Call c09abf(wavnam,wtrans,mode,m,n,nwl,nf,nwct,nwcn,icomm,ifail) nwcm = nwct/(4*nwcn) Allocate (ca(nwcm,nwcn),cd(nwcm,nwcn),cv(nwcm,nwcn),ch(nwcm,nwcn)) ldca = nwcm ldch = nwcm ldcv = nwcm ldcd = nwcm ifail = 0 Call c09eaf(m,n,a,lda,ca,ldca,ch,ldch,cv,ldcv,cd,ldcd,icomm,ifail) Write (nout,99998) 'Approximation coefficients CA' Do i = 1, nwcm Write (nout,99997) ca(i,1:nwcn) End Do Write (nout,99998) 'Diagonal coefficients CD' Do i = 1, nwcm Write (nout,99997) cd(i,1:nwcn) End Do Write (nout,99998) 'Horizontal coefficients CH' Do i = 1, nwcm Write (nout,99997) ch(i,1:nwcn) End Do Write (nout,99998) 'Vertical coefficients CV' Do i = 1, nwcm Write (nout,99997) cv(i,1:nwcn) End Do ifail = 0 Call c09ebf(m,n,ca,ldca,ch,ldch,cv,ldcv,cd,ldcd,b,ldb,icomm,ifail) Write (nout,99998) 'Reconstruction B' Do i = 1, m Write (nout,99997) b(i,1:n) End Do 99999 Format (/1X,'DWT ::'/1X,' Wavelet : ',A/1X,' End mode: ',A) 99998 Format (/1X,A,' : ') 99997 Format (1X,8(F8.4,1X):) End Program c09eafe