Mercurial > octave-antonio

comparison src/DLD-FUNCTIONS/__pchip_deriv__.cc @ 10154:40dfc0c99116

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
DLD-FUNCTIONS/*.cc: untabify
author John W. Eaton <jwe@octave.org>
date Wed, 20 Jan 2010 17:33:41 -0500
parents 02d4c764de61
children 141b3fb5cef7
comparison
equal deleted inserted replaced
10153:2c28f9d0360f 10154:40dfc0c99116
34 34
35 extern "C" 35 extern "C"
36 { 36 {
37 F77_RET_T 37 F77_RET_T
38 F77_FUNC (dpchim, DPCHIM) (const octave_idx_type& n, const double *x, const double *f, 38 F77_FUNC (dpchim, DPCHIM) (const octave_idx_type& n, const double *x, const double *f,
39 double *d, const octave_idx_type &incfd, 39 double *d, const octave_idx_type &incfd,
40 octave_idx_type *ierr); 40 octave_idx_type *ierr);
41 41
42 F77_RET_T 42 F77_RET_T
43 F77_FUNC (pchim, PCHIM) (const octave_idx_type& n, const float *x, const float *f, 43 F77_FUNC (pchim, PCHIM) (const octave_idx_type& n, const float *x, const float *f,
44 float *d, const octave_idx_type &incfd, 44 float *d, const octave_idx_type &incfd,
45 octave_idx_type *ierr); 45 octave_idx_type *ierr);
46 } 46 }
47 47
48 // Wrapper for SLATEC/PCHIP function DPCHIM to calculate the derivates 48 // Wrapper for SLATEC/PCHIP function DPCHIM to calculate the derivates
49 // for piecewise polynomials. 49 // for piecewise polynomials.
50 50
60 bool rows = (nargin == 3 && args (2).uint_value() == 2); 60 bool rows = (nargin == 3 && args (2).uint_value() == 2);
61 61
62 if (nargin >= 2) 62 if (nargin >= 2)
63 { 63 {
64 if (args(0).is_single_type () || args(1).is_single_type ()) 64 if (args(0).is_single_type () || args(1).is_single_type ())
65 { 65 {
66 FloatColumnVector xvec (args(0).float_vector_value ()); 66 FloatColumnVector xvec (args(0).float_vector_value ());
67 FloatMatrix ymat (args(1).float_matrix_value ()); 67 FloatMatrix ymat (args(1).float_matrix_value ());
68 68
69 octave_idx_type nx = xvec.length (); 69 octave_idx_type nx = xvec.length ();
70 octave_idx_type nyr = ymat.rows (); 70 octave_idx_type nyr = ymat.rows ();
71 octave_idx_type nyc = ymat.columns (); 71 octave_idx_type nyc = ymat.columns ();
72 72
73 if (nx != (rows ? nyc : nyr)) 73 if (nx != (rows ? nyc : nyr))
74 { 74 {
75 error ("__pchip_deriv__: dimension mismatch"); 75 error ("__pchip_deriv__: dimension mismatch");
76 return retval; 76 return retval;
77 } 77 }
78 78
79 const float *yvec = ymat.data (); 79 const float *yvec = ymat.data ();
80 FloatMatrix dmat (nyr, nyc); 80 FloatMatrix dmat (nyr, nyc);
81 float *dvec = dmat.fortran_vec (); 81 float *dvec = dmat.fortran_vec ();
82 82
83 octave_idx_type ierr; 83 octave_idx_type ierr;
84 const octave_idx_type incfd = rows ? nyr : 1; 84 const octave_idx_type incfd = rows ? nyr : 1;
85 const octave_idx_type inc = rows ? 1 : nyr; 85 const octave_idx_type inc = rows ? 1 : nyr;
86 86
87 for (octave_idx_type i = (rows ? nyr : nyc); i > 0; i--) 87 for (octave_idx_type i = (rows ? nyr : nyc); i > 0; i--)
88 { 88 {
89 F77_FUNC (pchim, PCHIM) (nx, xvec.data (), 89 F77_FUNC (pchim, PCHIM) (nx, xvec.data (),
90 yvec, dvec, incfd, &ierr); 90 yvec, dvec, incfd, &ierr);
91 91
92 yvec += inc; 92 yvec += inc;
93 dvec += inc; 93 dvec += inc;
94 94
95 if (ierr < 0) 95 if (ierr < 0)
96 { 96 {
97 error ("PCHIM error: %i\n", ierr); 97 error ("PCHIM error: %i\n", ierr);
98 return retval; 98 return retval;
99 } 99 }
100 } 100 }
101 101
102 retval = dmat; 102 retval = dmat;
103 } 103 }
104 else 104 else
105 { 105 {
106 ColumnVector xvec (args(0).vector_value ()); 106 ColumnVector xvec (args(0).vector_value ());
107 Matrix ymat (args(1).matrix_value ()); 107 Matrix ymat (args(1).matrix_value ());
108 108
109 octave_idx_type nx = xvec.length (); 109 octave_idx_type nx = xvec.length ();
110 octave_idx_type nyr = ymat.rows (); 110 octave_idx_type nyr = ymat.rows ();
111 octave_idx_type nyc = ymat.columns (); 111 octave_idx_type nyc = ymat.columns ();
112 112
113 if (nx != (rows ? nyc : nyr)) 113 if (nx != (rows ? nyc : nyr))
114 { 114 {
115 error ("__pchip_deriv__: dimension mismatch"); 115 error ("__pchip_deriv__: dimension mismatch");
116 return retval; 116 return retval;
117 } 117 }
118 118
119 const double *yvec = ymat.data (); 119 const double *yvec = ymat.data ();
120 Matrix dmat (nyr, nyc); 120 Matrix dmat (nyr, nyc);
121 double *dvec = dmat.fortran_vec (); 121 double *dvec = dmat.fortran_vec ();
122 122
123 octave_idx_type ierr; 123 octave_idx_type ierr;
124 const octave_idx_type incfd = rows ? nyr : 1; 124 const octave_idx_type incfd = rows ? nyr : 1;
125 const octave_idx_type inc = rows ? 1 : nyr; 125 const octave_idx_type inc = rows ? 1 : nyr;
126 126
127 for (octave_idx_type i = (rows ? nyr : nyc); i > 0; i--) 127 for (octave_idx_type i = (rows ? nyr : nyc); i > 0; i--)
128 { 128 {
129 F77_FUNC (dpchim, DPCHIM) (nx, xvec.data (), 129 F77_FUNC (dpchim, DPCHIM) (nx, xvec.data (),
130 yvec, dvec, incfd, &ierr); 130 yvec, dvec, incfd, &ierr);
131 131
132 yvec += inc; 132 yvec += inc;
133 dvec += inc; 133 dvec += inc;
134 134
135 if (ierr < 0) 135 if (ierr < 0)
136 { 136 {
137 error ("DPCHIM error: %i\n", ierr); 137 error ("DPCHIM error: %i\n", ierr);
138 return retval; 138 return retval;
139 } 139 }
140 } 140 }
141 141
142 retval = dmat; 142 retval = dmat;
143 } 143 }
144 } 144 }
145 145
146 return retval; 146 return retval;
147 } 147 }