基于小波金字塔分解C 编写的灰度图像压缩实用程序源码

#include <stdio.h> #include <ctype.h> #include <math.h> /* Avoid linking in the FORTRAN library by defining a macro that substitutes for a FORTRAN builtin. EJC 9.5.91 */ #define d_sign(px,py) ( *(py) < 0.0 ? -fabs(*(px)) : fabs(*(px)) ) /*****************************************************************/ /************************ Original code **************************/ /****************** Trivial mods marked by EJ ********************/ /*****************************************************************/ /* dsvdc.f -- translated by f2c (version of 3 February 1990 3:36:42). You must link the resulting object file with the libraries: -lF77 -lI77 -lm -lc (in that order) */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static real c_b44 = -1.; /* Subroutine */ int dsvdc_(x, ldx, n, p, s, e, u, ldu, v, ldv, work, job, info) real *x; integer *ldx, *n, *p; real *s, *e, *u; integer *ldu; real *v; integer *ldv; real *work; integer *job, *info; { /* System generated locals */ integer x_dim1, x_offset, u_dim1, u_offset, v_dim1, v_offset, i_1, i_2, i_3; real d_1, d_2, d_3, d_4, d_5, d_6, d_7; /* Builtin functions */ /* This FORTRAN builtin is replaced by a macro. EJC 9.5.91 */ /* double d_sign(); */ double sqrt(); /* Local variables */ static integer kase; extern real ddot_(); static integer jobu, iter; extern /* Subroutine */ int drot_(); static real test; extern real dnrm2_(); static integer nctp1; static real b, c; static integer nrtp1; static real f, g; static integer i, j, k, l, m; static real t, scale; extern /* Subroutine */ int dscal_(); static real shift; extern /* Subroutine */ int dswap_(), drotg_(); static integer maxit; extern /* Subroutine */ int daxpy_(); static logical wantu, wantv; static real t1, ztest, el; static integer kk; static real cs; static integer ll, mm, ls; static real sl; static integer lu; static real sm, sn; static integer lm1, mm1, lp1, mp1, nct, ncu, lls, nrt; static real emm1, smm1; /* Parameter adjustments */ x_dim1 = *ldx; x_offset = x_dim1 + 1; x -= x_offset; --s; --e; u_dim1 = *ldu; u_offset = u_dim1 + 1; u -= u_offset; v_dim1 = *ldv; v_offset = v_dim1 + 1; v -= v_offset; --work; /* Function Body */ /* 00000040*/ /* 00000050*/ /* dsvdc is a subroutine to reduce a double precision nxp matrix x 00000060*/ /* by orthogonal transformations u and v to diagonal form. the 00000070*/ /* diagonal elements s(i) are the singular values of x. the 00000080*/ /* columns of u are the corresponding left singular vectors, 00000090*/ /* and the columns of v the right singular vectors. 00000100*/ /* 00000110*/ /* on entry 00000120*/ /* 00000130*/ /* x double precision(ldx,p), where ldx.ge.n. 00000140*/ /* x contains the matrix whose singular value 00000150*/ /* decomposition is to be computed. x is 00000160*/ /* destroyed by dsvdc. 00000170*/ /* 00000180*/ /* ldx integer. 00000190*/ /* ldx is the leading dimension of the array x. 00000200*/ /* 00000210*/ /* n integer. 00000220*/ /* n is the number of columns of the matrix x. 00000230*/ /* 00000240*/ /* p integer. 00000250*/ /* p is the number of rows of the matrix x. 00000260*/ /* 00000270*/ /* ldu integer. 00000280*/ /* ldu is the leading dimension of the array u. 00000290*/ /* (see below). 00000300*/ /* 00000310*/ /* ldv integer. 00000320*/ /* ldv is the leading dimension of the array v. 00000330*/ /* (see below). 00000340*/ /* 00000350*/ /* work double precision(n). 00000360*/ /* work is a scratch array. 00000370*/ /* 00000380*/ /* job integer. 00000390*/ /* job controls the computation of the singular 00000400*/ /* vectors. it has the decimal expansion ab 00000410*/ /* with the following meaning 00000420*/ /* 00000430*/ /* a.eq.0 do not compute the left singular 00000440*/ /* vectors. 00000450*/ /* a.eq.1 return the n left singular vectors 00000460*/ /* in u. 00000470*/ /* a.ge.2 return the first min(n,p) singular 00000480*/ /* vectors in u. 00000490*/ /* b.eq.0 do not compute the right singular 00000500*/ /* vectors. 00000510*/ /* b.eq.1 return the right singular vectors 00000520*/ /* in v. 00000530*/ /* 00000540*/ /* on return 00000550*/ /* 00000560*/ /* s double precision(mm), where mm=min(n+1,p). 00000570*/ /* the first min(n,p) entries of s contain the 00000580*/ /* singular values of x arranged in descending 00000590*/ /* order of magnitude. 00000600*/ /* 00000610*/ /* e double precision(p). 00000620*/ /* e ordinarily contains zeros. however see the 00000630*/ /* discussion of info for exceptions. 00000640*/ /* 00000650*/ /* u double precision(ldu,k), where ldu.ge.n. if 00000660*/ /* joba.eq.1 then k.eq.n, if joba.ge.2 00000670*/ /* then k.eq.min(n,p). 00000680*/ /* u contains the matrix of right singular vectors. 00000690*/ /* u is not referenced