Mercurial > hg > octave-nkf

comparison src/DLD-FUNCTIONS/dasrt.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 2cd940306a06
children d0ce5e973937
comparison
equal deleted inserted replaced
10153:2c28f9d0360f 10154:40dfc0c99116
57 // Is this a recursive call? 57 // Is this a recursive call?
58 static int call_depth = 0; 58 static int call_depth = 0;
59 59
60 static ColumnVector 60 static ColumnVector
61 dasrt_user_f (const ColumnVector& x, const ColumnVector& xdot, 61 dasrt_user_f (const ColumnVector& x, const ColumnVector& xdot,
62 double t, octave_idx_type&) 62 double t, octave_idx_type&)
63 { 63 {
64 ColumnVector retval; 64 ColumnVector retval;
65 65
66 assert (x.capacity () == xdot.capacity ()); 66 assert (x.capacity () == xdot.capacity ());
67 67
74 if (dasrt_f) 74 if (dasrt_f)
75 { 75 {
76 octave_value_list tmp = dasrt_f->do_multi_index_op (1, args); 76 octave_value_list tmp = dasrt_f->do_multi_index_op (1, args);
77 77
78 if (error_state) 78 if (error_state)
79 { 79 {
80 gripe_user_supplied_eval ("dasrt"); 80 gripe_user_supplied_eval ("dasrt");
81 return retval; 81 return retval;
82 } 82 }
83 83
84 if (tmp.length () > 0 && tmp(0).is_defined ()) 84 if (tmp.length () > 0 && tmp(0).is_defined ())
85 { 85 {
86 if (! warned_fcn_imaginary && tmp(0).is_complex_type ()) 86 if (! warned_fcn_imaginary && tmp(0).is_complex_type ())
87 { 87 {
88 warning ("dasrt: ignoring imaginary part returned from user-supplied function"); 88 warning ("dasrt: ignoring imaginary part returned from user-supplied function");
89 warned_fcn_imaginary = true; 89 warned_fcn_imaginary = true;
90 } 90 }
91 91
92 retval = ColumnVector (tmp(0).vector_value ()); 92 retval = ColumnVector (tmp(0).vector_value ());
93 93
94 if (error_state || retval.length () == 0) 94 if (error_state || retval.length () == 0)
95 gripe_user_supplied_eval ("dasrt"); 95 gripe_user_supplied_eval ("dasrt");
96 } 96 }
97 else 97 else
98 gripe_user_supplied_eval ("dasrt"); 98 gripe_user_supplied_eval ("dasrt");
99 } 99 }
100 100
101 return retval; 101 return retval;
102 } 102 }
103 103
114 if (dasrt_cf) 114 if (dasrt_cf)
115 { 115 {
116 octave_value_list tmp = dasrt_cf->do_multi_index_op (1, args); 116 octave_value_list tmp = dasrt_cf->do_multi_index_op (1, args);
117 117
118 if (error_state) 118 if (error_state)
119 { 119 {
120 gripe_user_supplied_eval ("dasrt"); 120 gripe_user_supplied_eval ("dasrt");
121 return retval; 121 return retval;
122 } 122 }
123 123
124 if (tmp.length () > 0 && tmp(0).is_defined ()) 124 if (tmp.length () > 0 && tmp(0).is_defined ())
125 { 125 {
126 if (! warned_cf_imaginary && tmp(0).is_complex_type ()) 126 if (! warned_cf_imaginary && tmp(0).is_complex_type ())
127 { 127 {
128 warning ("dasrt: ignoring imaginary part returned from user-supplied constraint function"); 128 warning ("dasrt: ignoring imaginary part returned from user-supplied constraint function");
129 warned_cf_imaginary = true; 129 warned_cf_imaginary = true;
130 } 130 }
131 131
132 retval = ColumnVector (tmp(0).vector_value ()); 132 retval = ColumnVector (tmp(0).vector_value ());
133 133
134 if (error_state || retval.length () == 0) 134 if (error_state || retval.length () == 0)
135 gripe_user_supplied_eval ("dasrt"); 135 gripe_user_supplied_eval ("dasrt");
136 } 136 }
137 else 137 else
138 gripe_user_supplied_eval ("dasrt"); 138 gripe_user_supplied_eval ("dasrt");
139 } 139 }
140 140
141 return retval; 141 return retval;
142 } 142 }
143 143
144 static Matrix 144 static Matrix
145 dasrt_user_j (const ColumnVector& x, const ColumnVector& xdot, 145 dasrt_user_j (const ColumnVector& x, const ColumnVector& xdot,
146 double t, double cj) 146 double t, double cj)
147 { 147 {
148 Matrix retval; 148 Matrix retval;
149 149
150 assert (x.capacity () == xdot.capacity ()); 150 assert (x.capacity () == xdot.capacity ());
151 151
159 if (dasrt_j) 159 if (dasrt_j)
160 { 160 {
161 octave_value_list tmp = dasrt_j->do_multi_index_op (1, args); 161 octave_value_list tmp = dasrt_j->do_multi_index_op (1, args);
162 162
163 if (error_state) 163 if (error_state)
164 { 164 {
165 gripe_user_supplied_eval ("dasrt"); 165 gripe_user_supplied_eval ("dasrt");
166 return retval; 166 return retval;
167 } 167 }
168 168
169 int tlen = tmp.length (); 169 int tlen = tmp.length ();
170 if (tlen > 0 && tmp(0).is_defined ()) 170 if (tlen > 0 && tmp(0).is_defined ())
171 { 171 {
172 if (! warned_jac_imaginary && tmp(0).is_complex_type ()) 172 if (! warned_jac_imaginary && tmp(0).is_complex_type ())
173 { 173 {
174 warning ("dasrt: ignoring imaginary part returned from user-supplied jacobian function"); 174 warning ("dasrt: ignoring imaginary part returned from user-supplied jacobian function");
175 warned_jac_imaginary = true; 175 warned_jac_imaginary = true;
176 } 176 }
177 177
178 retval = tmp(0).matrix_value (); 178 retval = tmp(0).matrix_value ();
179 179
180 if (error_state || retval.length () == 0) 180 if (error_state || retval.length () == 0)
181 gripe_user_supplied_eval ("dasrt"); 181 gripe_user_supplied_eval ("dasrt");
182 } 182 }
183 else 183 else
184 gripe_user_supplied_eval ("dasrt"); 184 gripe_user_supplied_eval ("dasrt");
185 } 185 }
186 186
187 return retval; 187 return retval;
188 } 188 }
189 189
379 379
380 if (f_arg.is_cell ()) 380 if (f_arg.is_cell ())
381 { 381 {
382 Cell c = f_arg.cell_value (); 382 Cell c = f_arg.cell_value ();
383 if (c.length() == 1) 383 if (c.length() == 1)
384 f_arg = c(0); 384 f_arg = c(0);
385 else if (c.length() == 2) 385 else if (c.length() == 2)
386 { 386 {
387 if (c(0).is_function_handle () || c(0).is_inline_function ()) 387 if (c(0).is_function_handle () || c(0).is_inline_function ())
388 dasrt_f = c(0).function_value (); 388 dasrt_f = c(0).function_value ();
389 else 389 else
390 { 390 {
391 fcn_name = unique_symbol_name ("__dasrt_fcn__"); 391 fcn_name = unique_symbol_name ("__dasrt_fcn__");
392 fname = "function y = "; 392 fname = "function y = ";
393 fname.append (fcn_name); 393 fname.append (fcn_name);
394 fname.append (" (x, xdot, t) y = "); 394 fname.append (" (x, xdot, t) y = ");
395 dasrt_f = extract_function 395 dasrt_f = extract_function
396 (c(0), "dasrt", fcn_name, fname, "; endfunction"); 396 (c(0), "dasrt", fcn_name, fname, "; endfunction");
397 } 397 }
398 398
399 if (dasrt_f) 399 if (dasrt_f)
400 { 400 {
401 if (c(1).is_function_handle () || c(1).is_inline_function ()) 401 if (c(1).is_function_handle () || c(1).is_inline_function ())
402 dasrt_j = c(1).function_value (); 402 dasrt_j = c(1).function_value ();
403 else 403 else
404 { 404 {
405 jac_name = unique_symbol_name ("__dasrt_jac__"); 405 jac_name = unique_symbol_name ("__dasrt_jac__");
406 jname = "function jac = "; 406 jname = "function jac = ";
407 jname.append(jac_name); 407 jname.append(jac_name);
408 jname.append (" (x, xdot, t, cj) jac = "); 408 jname.append (" (x, xdot, t, cj) jac = ");
409 dasrt_j = extract_function 409 dasrt_j = extract_function
410 (c(1), "dasrt", jac_name, jname, "; endfunction"); 410 (c(1), "dasrt", jac_name, jname, "; endfunction");
411 411
412 if (!dasrt_j) 412 if (!dasrt_j)
413 { 413 {
414 if (fcn_name.length()) 414 if (fcn_name.length())
415 clear_function (fcn_name); 415 clear_function (fcn_name);
416 dasrt_f = 0; 416 dasrt_f = 0;
417 } 417 }
418 } 418 }
419 } 419 }
420 } 420 }
421 else 421 else
422 DASRT_ABORT1 ("incorrect number of elements in cell array"); 422 DASRT_ABORT1 ("incorrect number of elements in cell array");
423 } 423 }
424 424
425 if (!dasrt_f && ! f_arg.is_cell()) 425 if (!dasrt_f && ! f_arg.is_cell())
426 { 426 {
427 if (f_arg.is_function_handle () || f_arg.is_inline_function ()) 427 if (f_arg.is_function_handle () || f_arg.is_inline_function ())
428 dasrt_f = f_arg.function_value (); 428 dasrt_f = f_arg.function_value ();
429 else 429 else
430 { 430 {
431 switch (f_arg.rows ()) 431 switch (f_arg.rows ())
432 { 432 {
433 case 1: 433 case 1:
434 fcn_name = unique_symbol_name ("__dasrt_fcn__"); 434 fcn_name = unique_symbol_name ("__dasrt_fcn__");
435 fname = "function y = "; 435 fname = "function y = ";
436 fname.append (fcn_name); 436 fname.append (fcn_name);
437 fname.append (" (x, xdot, t) y = "); 437 fname.append (" (x, xdot, t) y = ");
438 dasrt_f = extract_function 438 dasrt_f = extract_function
439 (f_arg, "dasrt", fcn_name, fname, "; endfunction"); 439 (f_arg, "dasrt", fcn_name, fname, "; endfunction");
440 break; 440 break;
441 441
442 case 2: 442 case 2:
443 { 443 {
444 string_vector tmp = args(0).all_strings (); 444 string_vector tmp = args(0).all_strings ();
445 445
446 if (! error_state) 446 if (! error_state)
447 { 447 {
448 fcn_name = unique_symbol_name ("__dasrt_fcn__"); 448 fcn_name = unique_symbol_name ("__dasrt_fcn__");
449 fname = "function y = "; 449 fname = "function y = ";
450 fname.append (fcn_name); 450 fname.append (fcn_name);
451 fname.append (" (x, xdot, t) y = "); 451 fname.append (" (x, xdot, t) y = ");
452 dasrt_f = extract_function 452 dasrt_f = extract_function
453 (tmp(0), "dasrt", fcn_name, fname, "; endfunction"); 453 (tmp(0), "dasrt", fcn_name, fname, "; endfunction");
454 454
455 if (dasrt_f) 455 if (dasrt_f)
456 { 456 {
457 jac_name = unique_symbol_name ("__dasrt_jac__"); 457 jac_name = unique_symbol_name ("__dasrt_jac__");
458 jname = "function jac = "; 458 jname = "function jac = ";
459 jname.append(jac_name); 459 jname.append(jac_name);
460 jname.append (" (x, xdot, t, cj) jac = "); 460 jname.append (" (x, xdot, t, cj) jac = ");
461 dasrt_j = extract_function 461 dasrt_j = extract_function
462 (tmp(1), "dasrt", jac_name, jname, "; endfunction"); 462 (tmp(1), "dasrt", jac_name, jname, "; endfunction");
463 463
464 if (! dasrt_j) 464 if (! dasrt_j)
465 dasrt_f = 0; 465 dasrt_f = 0;
466 } 466 }
467 } 467 }
468 } 468 }
469 break; 469 break;
470 470
471 default: 471 default:
472 DASRT_ABORT1 472 DASRT_ABORT1
473 ("first arg should be a string or 2-element string array"); 473 ("first arg should be a string or 2-element string array");
474 } 474 }
475 } 475 }
476 } 476 }
477 477
478 if (error_state || (! dasrt_f)) 478 if (error_state || (! dasrt_f))
479 DASRT_ABORT; 479 DASRT_ABORT;
480 480
485 if (args(1).is_function_handle() || args(1).is_inline_function()) 485 if (args(1).is_function_handle() || args(1).is_inline_function())
486 { 486 {
487 dasrt_cf = args(1).function_value(); 487 dasrt_cf = args(1).function_value();
488 488
489 if (! dasrt_cf) 489 if (! dasrt_cf)
490 DASRT_ABORT1 ("expecting function name as argument 2"); 490 DASRT_ABORT1 ("expecting function name as argument 2");
491 491
492 argp++; 492 argp++;
493 493
494 func.set_constraint_function (dasrt_user_cf); 494 func.set_constraint_function (dasrt_user_cf);
495 } 495 }
496 else if (args(1).is_string ()) 496 else if (args(1).is_string ())
497 { 497 {
498 dasrt_cf = is_valid_function (args(1), "dasrt", true); 498 dasrt_cf = is_valid_function (args(1), "dasrt", true);
499 if (! dasrt_cf) 499 if (! dasrt_cf)
500 DASRT_ABORT1 ("expecting function name as argument 2"); 500 DASRT_ABORT1 ("expecting function name as argument 2");
501 501
502 argp++; 502 argp++;
503 503
504 func.set_constraint_function (dasrt_user_cf); 504 func.set_constraint_function (dasrt_user_cf);
505 } 505 }
517 517
518 ColumnVector out_times (args(argp++).vector_value ()); 518 ColumnVector out_times (args(argp++).vector_value ());
519 519
520 if (error_state) 520 if (error_state)
521 DASRT_ABORT2 521 DASRT_ABORT2
522 ("expecting output time vector as %s argument %d", argp); 522 ("expecting output time vector as %s argument %d", argp);
523 523
524 double tzero = out_times (0); 524 double tzero = out_times (0);
525 525
526 ColumnVector crit_times; 526 ColumnVector crit_times;
527 527
530 if (argp < nargin) 530 if (argp < nargin)
531 { 531 {
532 crit_times = ColumnVector (args(argp++).vector_value ()); 532 crit_times = ColumnVector (args(argp++).vector_value ());
533 533
534 if (error_state) 534 if (error_state)
535 DASRT_ABORT2 535 DASRT_ABORT2
536 ("expecting critical time vector as argument %d", argp); 536 ("expecting critical time vector as argument %d", argp);
537 537
538 crit_times_set = true; 538 crit_times_set = true;
539 } 539 }
540 540
541 if (dasrt_j) 541 if (dasrt_j)
563 563
564 retval(4) = msg; 564 retval(4) = msg;
565 retval(3) = static_cast<double> (dae.integration_state ()); 565 retval(3) = static_cast<double> (dae.integration_state ());
566 566
567 if (dae.integration_ok ()) 567 if (dae.integration_ok ())
568 { 568 {
569 retval(2) = output.times (); 569 retval(2) = output.times ();
570 retval(1) = output.deriv (); 570 retval(1) = output.deriv ();
571 retval(0) = output.state (); 571 retval(0) = output.state ();
572 } 572 }
573 else 573 else
574 { 574 {
575 retval(2) = Matrix (); 575 retval(2) = Matrix ();
576 retval(1) = Matrix (); 576 retval(1) = Matrix ();
577 retval(0) = Matrix (); 577 retval(0) = Matrix ();
578 578
579 if (nargout < 4) 579 if (nargout < 4)
580 error ("dasrt: %s", msg.c_str ()); 580 error ("dasrt: %s", msg.c_str ());
581 } 581 }
582 } 582 }
583 583
584 return retval; 584 return retval;
585 } 585 }
586 586