Program c09acfe ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: c09acf, c09fcf, c09fdf, nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Integer :: fr, i, i1, ifail, ilevel, & itype_coeffs, j, k, lda, ldb, ldd, & lenc, lmax, locc, m, n, nf, nwcfr, & nwcm, nwcn, nwct, nwl, sda, sdb, & sdd, want_coeffs, want_level Character (10) :: mode, wavnam, wtrans ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: a(:,:,:), b(:,:,:), c(:), d(:,:,:) Integer, Allocatable :: dwtlvfr(:), dwtlvm(:), dwtlvn(:) Integer :: icomm(260) ! .. Intrinsic Procedures .. Intrinsic :: sum ! .. Executable Statements .. Continue Write (nout,*) 'C09ACF Example Program Results' Write (nout,*) ! Skip heading in data file Read (nin,*) ! Read problem parameters Read (nin,*) m, n, fr Read (nin,*) wavnam, mode lda = m sda = n ldb = m sdb = n Allocate (a(lda,sda,fr),b(ldb,sdb,fr)) Write (nout,99999) wavnam, mode, m, n, fr ! Read data array and write it out Do j = 1, fr Do i = 1, m Read (nin,*) a(i,1:n,j) End Do If (j0 .Or. ilevel==nwl) Then If (itype_coeffs==0) Then ! For a multi level transform approx coeffs stored as nwcm x nwcn x nwcfr... i1 = locc Do k = 1, nwcfr Do j = 1, nwcn Do i = 1, nwcm d(i,j,k) = c(i1) i1 = i1 + 1 End Do End Do End Do Else ! but detail coefficients are stored as ncwfr x nwcm x nwcn Do k = 1, nwcfr Do j = 1, nwcn Do i = 1, nwcm i1 = locc - 1 + (j-1)*nwcfr*nwcm + (i-1)*nwcfr + k d(i,j,k) = c(i1) End Do End Do End Do End If ! Print out the selected set of coefficients Write (nout,99989) ilevel, itype_coeffs Do k = 1, nwcfr Write (nout,99990) k Do i = 1, nwcm Write (nout,99991) d(i,1:nwcn,k) End Do End Do End If End Do Deallocate (d) End Do ! Reconstruct original data ifail = 0 Call c09fdf(nwl,lenc,c,m,n,fr,b,ldb,sdb,icomm,ifail) Write (nout,99992) Do j = 1, fr Do i = 1, m Write (nout,99998) b(i,1:n,j) End Do Write (nout,*) End Do 99999 Format (1X,' MLDWT :: Wavelet : ',A/1X,' End mode : ',A/1X, & ' M : ',I4/1X,' N : ',I4/1X, & ' FR : ',I4/) 99998 Format (8(F8.4,1X):) 99997 Format (/1X,' Number of Levels : ',I10) 99996 Format (1X,' Number of coefficients in 1st dimension for each level :') 99995 Format (8(I8,1X):) 99994 Format (1X,' Number of coefficients in 2nd dimension for each level :') 99993 Format (1X,' Number of coefficients in 3rd dimension for each level :') 99992 Format (/1X,' Reconstruction B : ') 99991 Format (1X,8(F8.4,1X):) 99990 Format (1X,' Frame ',I2,' : ') 99989 Format (1X,' Level ',I2,', Coefficients ',I2,' : ') 99988 Format (1X,' Length of wavelet filter : ',I10) 99987 Format (1X,' Total number of wavelet coefficients : ',I10) 99986 Format (/1X,70('-')/1X,'Level : ',I10,'; output is ',I10,' by ',I10, & ' by ',I10/1X,70('-')) 99985 Format (/1X,A) End Program c09acfe