diff --git a/+AMF/+utils/defineCustomColormap.m b/+AMF/+utils/defineCustomColormap.m new file mode 100644 index 0000000..a8beb26 --- /dev/null +++ b/+AMF/+utils/defineCustomColormap.m @@ -0,0 +1,28 @@ +function clist = define_custom_colormap(c_matrix,N) + +if length(c_matrix) == 3 + clist(1,:) = c_matrix{1}; %start color + clist(ceil(N/2),:) = c_matrix{2}; %middle color + clist(N,:) = c_matrix{3}; %end color + + dc1 = clist(ceil(N/2),:) - clist(1,:); + for i1 = 2:ceil(N/2)-1 + clist(i1,:) = clist(i1-1,:) + dc1/(N-1); + end + + dc2 = clist(N,:) - clist(ceil(N/2),:); + for i2 = ceil(N/2)+1:N-1 + clist(i2,:) = clist(i2-1,:) + dc2/(N-1); + end + + +elseif length(c_matrix) == 2 + clist(1,:) = c_matrix{1}; %start color + clist(N,:) = c_matrix{2}; %end color + + dc = clist(N,:)-clist(1,:); + + for i = 2:N-1 + clist(i,:) = clist(i-1,:) + dc/(N-1); + end +end \ No newline at end of file diff --git a/+AMF/+utils/getHist.m b/+AMF/+utils/getHist.m new file mode 100644 index 0000000..28a771e --- /dev/null +++ b/+AMF/+utils/getHist.m @@ -0,0 +1,14 @@ +function [N,C] = getHist(t,v,r,ny) + +a = repmat(t,size(v,1),1); +b = reshape(v.',numel(v),1); + +if numel(r) > 0 + [N, C] = hist3([a,b],{t,[r(1) : (r(2)-r(1))/(ny-1) : r(2)]}); +else + [N, C] = hist3([a,b],[numel(t) ny]); +end +N = log10(N); +N = N./max(max(N)); + +N(N==-inf) = 0; \ No newline at end of file diff --git a/+AMF/+utils/mexify.m b/+AMF/+utils/mexify.m new file mode 100644 index 0000000..facdf50 --- /dev/null +++ b/+AMF/+utils/mexify.m @@ -0,0 +1,6 @@ +function outputStr = mexify(inputStr) + +outputStr = inputStr; + +% parsers +outputStr = regexprep(outputStr, '([-+\w]+)\^([-+\w]+)', 'pow($1,$2)'); \ No newline at end of file diff --git a/+AMF/+utils/mexify2.m b/+AMF/+utils/mexify2.m new file mode 100644 index 0000000..c7988e6 --- /dev/null +++ b/+AMF/+utils/mexify2.m @@ -0,0 +1,8 @@ +function outputStr = mexify2(inputStr, compName) + +outputStr = inputStr; + +% parsers +outputStr = regexprep(outputStr, '([-+\w]+)\^([-+\w]+)', 'pow($1,$2)'); + +outputStr = regexprep(outputStr, 'if\((.*),(.*),(.*)\)', sprintf('0;\nif ($1)\n\t%s = $2;\nelse\n\t%s = $3;\nend', compName, compName)); \ No newline at end of file diff --git a/+AMF/+utils/parfor_progress.m b/+AMF/+utils/parfor_progress.m new file mode 100644 index 0000000..07ec991 --- /dev/null +++ b/+AMF/+utils/parfor_progress.m @@ -0,0 +1,82 @@ +function percent = parfor_progress(N) +%PARFOR_PROGRESS Progress monitor (progress bar) that works with parfor. +% PARFOR_PROGRESS works by creating a file called parfor_progress.txt in +% your working directory, and then keeping track of the parfor loop's +% progress within that file. This workaround is necessary because parfor +% workers cannot communicate with one another so there is no simple way +% to know which iterations have finished and which haven't. +% +% PARFOR_PROGRESS(N) initializes the progress monitor for a set of N +% upcoming calculations. +% +% PARFOR_PROGRESS updates the progress inside your parfor loop and +% displays an updated progress bar. +% +% PARFOR_PROGRESS(0) deletes parfor_progress.txt and finalizes progress +% bar. +% +% To suppress output from any of these functions, just ask for a return +% variable from the function calls, like PERCENT = PARFOR_PROGRESS which +% returns the percentage of completion. +% +% Example: +% +% N = 100; +% parfor_progress(N); +% parfor i=1:N +% pause(rand); % Replace with real code +% parfor_progress; +% end +% parfor_progress(0); +% +% See also PARFOR. + +% By Jeremy Scheff - jdscheff@gmail.com - http://www.jeremyscheff.com/ + +% error(nargchk(0, 1, nargin, 'struct')); + +if nargin < 1 + N = -1; +end + +percent = 0; +w = 50; % Width of progress bar + +if N > 0 + f = fopen('parfor_progress.txt', 'w'); + if f<0 + error('Do you have write permissions for %s?', pwd); + end + fprintf(f, '%d\n', N); % Save N at the top of progress.txt + fclose(f); + + if nargout == 0 + disp([' 0%[>', repmat(' ', 1, w), ']']); + end +elseif N == 0 + delete('parfor_progress.txt'); + percent = 100; + + if nargout == 0 + disp([repmat(char(8), 1, (w+9)), char(10), '100%[', repmat('=', 1, w+1), ']']); + end +else + + if ~exist('parfor_progress.txt', 'file') + error('parfor_progress.txt not found. Run PARFOR_PROGRESS(N) before PARFOR_PROGRESS to initialize parfor_progress.txt.'); + end + + f = fopen('parfor_progress.txt', 'a'); + fprintf(f, '1\n'); + fclose(f); + + f = fopen('parfor_progress.txt', 'r'); + progress = fscanf(f, '%d'); + fclose(f); + percent = (length(progress)-1)/progress(1)*100; + + if nargout == 0 + perc = sprintf('%3.0f%%', percent); % 4 characters wide, percentage + disp([repmat(char(8), 1, (w+9)), char(10), perc, '[', repmat('=', 1, round(percent*w/100)), '>', repmat(' ', 1, w - round(percent*w/100)), ']']); + end +end diff --git a/+AMF/+utils/parfor_progress2.m b/+AMF/+utils/parfor_progress2.m new file mode 100644 index 0000000..2335bb6 --- /dev/null +++ b/+AMF/+utils/parfor_progress2.m @@ -0,0 +1,82 @@ +function percent = parfor_progress2(N) +%PARFOR_PROGRESS Progress monitor (progress bar) that works with parfor. +% PARFOR_PROGRESS works by creating a file called parfor_progress.txt in +% your working directory, and then keeping track of the parfor loop's +% progress within that file. This workaround is necessary because parfor +% workers cannot communicate with one another so there is no simple way +% to know which iterations have finished and which haven't. +% +% PARFOR_PROGRESS(N) initializes the progress monitor for a set of N +% upcoming calculations. +% +% PARFOR_PROGRESS updates the progress inside your parfor loop and +% displays an updated progress bar. +% +% PARFOR_PROGRESS(0) deletes parfor_progress.txt and finalizes progress +% bar. +% +% To suppress output from any of these functions, just ask for a return +% variable from the function calls, like PERCENT = PARFOR_PROGRESS which +% returns the percentage of completion. +% +% Example: +% +% N = 100; +% parfor_progress(N); +% parfor i=1:N +% pause(rand); % Replace with real code +% parfor_progress; +% end +% parfor_progress(0); +% +% See also PARFOR. + +% By Jeremy Scheff - jdscheff@gmail.com - http://www.jeremyscheff.com/ + +% error(nargchk(0, 1, nargin, 'struct')); + +if nargin < 1 + N = -1; +end + +percent = 0; +w = 50; % Width of progress bar + +if N > 0 + f = fopen('parfor_progress.txt', 'w'); + if f<0 + error('Do you have write permissions for %s?', pwd); + end + fprintf(f, '%d\n', N); % Save N at the top of progress.txt + fclose(f); + + if nargout == 0 + disp([' 0%[>', repmat(' ', 1, w), ']']); + end +elseif N == 0 + delete('parfor_progress.txt'); + percent = 100; + + if nargout == 0 + disp([repmat(char(8), 1, (w+9)), char(10), '100%[', repmat('=', 1, w+1), ']']); + end +else + + if ~exist('parfor_progress.txt', 'file') + error('parfor_progress.txt not found. Run PARFOR_PROGRESS(N) before PARFOR_PROGRESS to initialize parfor_progress.txt.'); + end + +% f = fopen('parfor_progress.txt', 'a'); +% fprintf(f, '1\n'); +% fclose(f); + + f = fopen('parfor_progress.txt', 'r'); + progress = fscanf(f, '%d'); + fclose(f); + percent = (length(progress)-1)/progress(1)*100; + + if nargout == 0 + perc = sprintf('%3.0f%%', percent); % 4 characters wide, percentage + disp([perc, '[', repmat('=', 1, round(percent*w/100)), '>', repmat(' ', 1, w - round(percent*w/100)), ']']); + end +end diff --git a/+AMF/+utils/writeFile.m b/+AMF/+utils/writeFile.m new file mode 100644 index 0000000..90c1a3a --- /dev/null +++ b/+AMF/+utils/writeFile.m @@ -0,0 +1,5 @@ +function writeFile(fn, content) + +fid = fopen(fn, 'w'); +fprintf(fid, content); +fclose(fid); \ No newline at end of file diff --git a/+AMF/+visualisation/define_custom_colormap.m b/+AMF/+visualisation/define_custom_colormap.m new file mode 100644 index 0000000..a8beb26 --- /dev/null +++ b/+AMF/+visualisation/define_custom_colormap.m @@ -0,0 +1,28 @@ +function clist = define_custom_colormap(c_matrix,N) + +if length(c_matrix) == 3 + clist(1,:) = c_matrix{1}; %start color + clist(ceil(N/2),:) = c_matrix{2}; %middle color + clist(N,:) = c_matrix{3}; %end color + + dc1 = clist(ceil(N/2),:) - clist(1,:); + for i1 = 2:ceil(N/2)-1 + clist(i1,:) = clist(i1-1,:) + dc1/(N-1); + end + + dc2 = clist(N,:) - clist(ceil(N/2),:); + for i2 = ceil(N/2)+1:N-1 + clist(i2,:) = clist(i2-1,:) + dc2/(N-1); + end + + +elseif length(c_matrix) == 2 + clist(1,:) = c_matrix{1}; %start color + clist(N,:) = c_matrix{2}; %end color + + dc = clist(N,:)-clist(1,:); + + for i = 2:N-1 + clist(i,:) = clist(i-1,:) + dc/(N-1); + end +end \ No newline at end of file diff --git a/+AMF/+visualisation/define_figure_details.m b/+AMF/+visualisation/define_figure_details.m new file mode 100644 index 0000000..2e15ef5 --- /dev/null +++ b/+AMF/+visualisation/define_figure_details.m @@ -0,0 +1,59 @@ +function plotinfo = define_figure_details(varargin) + + if ~isempty(varargin) + plotinfo = varargin{1}; + else + plotinfo = struct(); + end + % figure size + dx = 10; + dy = 50; + ss = get(0,'ScreenSize'); + xmax = ss(3)-dx-10; + ymax = ss(4)-dy-80; + set(0,'DefaultFigurePosition',[dx dy xmax ymax]); + + + % font size + if ~isfield(plotinfo,'FS') + plotinfo.FS = 24; %40; + end + + % line width of axes + if ~isfield(plotinfo,'LW_axes') + plotinfo.LW_axes = 2; %3; + end + + % line width & marker size of (raw) data points + if ~isfield(plotinfo,'LW_data') + plotinfo.LW_data = 2; + end + if ~isfield(plotinfo,'MS_data') + plotinfo.MS_data = 14; + end + + % line width of spline data + if ~isfield(plotinfo,'LW_spline') + plotinfo.LW_spline = 3; + end + + % line width of model simulations / trajectories + if ~isfield(plotinfo,'LW_sim') + plotinfo.LW_sim = 4; + end + + + % text properties + set(0,'DefaultTextFontName','Myriad') + set(0,'DefaultTextFontSize',plotinfo.FS); + set(0,'DefaultTextInterpreter','tex'); + + % line and marker properties + set(0,'DefaultLineLineWidth',plotinfo.LW_data); + set(0,'DefaultLineMarkerSize',plotinfo.MS_data); + + % axes properties + set(0,'DefaultAxesFontName','Myriad') + set(0,'DefaultAxesFontSize',plotinfo.FS); + set(0,'DefaultAxesLineWidth',plotinfo.LW_axes); +end \ No newline at end of file diff --git a/+AMF/+visualisation/errorbar_tick.m b/+AMF/+visualisation/errorbar_tick.m new file mode 100644 index 0000000..9e40ebd --- /dev/null +++ b/+AMF/+visualisation/errorbar_tick.m @@ -0,0 +1,70 @@ +function errorbar_tick(h,w,xtype) +%ERRORBAR_TICK Adjust the width of errorbars +% ERRORBAR_TICK(H) adjust the width of error bars with handle H. +% Error bars width is given as a ratio of X axis length (1/80). +% ERRORBAR_TICK(H,W) adjust the width of error bars with handle H. +% The input W is given as a ratio of X axis length (1/W). The result +% is independent of the x-axis units. A ratio between 20 and 80 is usually fine. +% ERRORBAR_TICK(H,W,'UNITS') adjust the width of error bars with handle H. +% The input W is given in the units of the current x-axis. +% +% See also ERRORBAR +% + +% Author: Arnaud Laurent +% Creation : Jan 29th 2009 +% MATLAB version: R2007a +% +% Notes: This function was created from a post on the french forum : +% http://www.developpez.net/forums/f148/environnements-developpement/matlab/ +% Author : Jerome Briot (Dut) +% http://www.mathworks.com/matlabcentral/newsreader/author/94805 +% http://www.developpez.net/forums/u125006/dut/ +% It was further modified by Arnaud Laurent and Jerome Briot. + +% Check numbers of arguments +error(nargchk(1,3,nargin)) + +% Check for the use of V6 flag ( even if it is depreciated ;) ) +flagtype = get(h,'type'); + +% Check number of arguments and provide missing values +if nargin==1 + w = 80; +end + +if nargin<3 + xtype = 'ratio'; +end + +% Calculate width of error bars +if ~strcmpi(xtype,'units') + dx = diff(get(gca,'XLim')); % Retrieve x limits from current axis + w = dx/w; % Errorbar width +end + +% Plot error bars +if strcmpi(flagtype,'hggroup') % ERRORBAR(...) + + hh=get(h,'children'); % Retrieve info from errorbar plot + x = get(hh(2),'xdata'); % Get xdata from errorbar plot + + x(4:9:end) = x(1:9:end)-w/2; % Change xdata with respect to ratio + x(7:9:end) = x(1:9:end)-w/2; + x(5:9:end) = x(1:9:end)+w/2; + x(8:9:end) = x(1:9:end)+w/2; + + set(hh(2),'xdata',x(:)) % Change error bars on the figure + +else % ERRORBAR('V6',...) + + x = get(h(1),'xdata'); % Get xdata from errorbar plot + + x(4:9:end) = x(1:9:end)-w/2; % Change xdata with respect to the chosen ratio + x(7:9:end) = x(1:9:end)-w/2; + x(5:9:end) = x(1:9:end)+w/2; + x(8:9:end) = x(1:9:end)+w/2; + + set(h(1),'xdata',x(:)) % Change error bars on the figure + +end diff --git a/+AMF/+visualisation/plot_results.m b/+AMF/+visualisation/plot_results.m new file mode 100644 index 0000000..3f5f372 --- /dev/null +++ b/+AMF/+visualisation/plot_results.m @@ -0,0 +1,244 @@ +function plot_results(model,plotinfo) + addpath(genpath(fullfile(cd,'visualisation'))); + + load('r.mat') +% dir = [pwd '\' settings.folder_name '\' settings.phenotype '\']; +% load([dir sprintf('results_%s_Nit=%d_Nt=%d_seed=%d',settings.phenotype,model.options.numIter,model.options.numTimeSteps,settings.random_state)]); + + for it = 1:model.options.numIter + SSE(it,1) = sum(result.sse(:,it)); + end + [SSE_sorted,ind] = sort(SSE,'descend'); + clist = AMF.visualisation.define_custom_colormap(plotinfo.c_matrix,model.options.numIter); + + for i_mc = 1:numel(plotinfo.model_components) + x = plotinfo.model_components{i_mc}; + count = 0; + + + + + for i_x = 1:numel(result.(x)) + count = count + 1; + switch plotinfo.fig_style + case 'subplot' + % plotinfo.FS = 18; + % plotinfo.LW_axes = 2; + % plotinfo.LW_data = 3; + % plotinfo.MS_data = 16; + % plotinfo.LW_sim = 4; + + Nr = ceil(sqrt(numel(result.(x)))); + Nc = ceil(numel(result.(x))/Nr); + + if i_x == 1 + f{i_mc} = figure; %('name',[settings.phenotype ' - ' x]); + end + ax(i_x) = subplot(Nc,Nr,i_x);hold on + + case 'fig' + % plotinfo.FS = 40; + % plotinfo.LW_axes = 3; + % plotinfo.LW_data = 4; + % plotinfo.MS_data = 26; + % plotinfo.LW_sim = 6; + f{i_mc,i_x} = figure; %('name',[settings.phenotype ' - ' x]); + ax(i_x) = gca;hold on + + case 'splitfig' + if isfield(plotinfo,'Nr') + Nr = plotinfo.Nr; + else + Nr = 2; + end + if isfield(plotinfo,'Nc') + Nc = plotinfo.Nc; + else + Nc = 2; + end + i_fig = ceil( count / ( Nr * Nc )); + i_subpl = count - (i_fig-1) * ( Nr * Nc ); + + if i_subpl == 1 + f{i_fig} = figure; %('Name',[settings.phenotype ' - ' x ' [' num2str(i_fig) '/' num2str(ceil(numel(result.(x))/(Nr*Nc))) ']']); + end + ax(i_x) = subplot(Nr,Nc,i_subpl);hold on + end + AMF.visualisation.define_figure_details;%(plotinfo); + + T = result.(x)(i_x).time; + + switch plotinfo.plot_color + case 'normal' + for it = 1:model.options.numIter + X = result.(x)(i_x).val(:,it); + plot(T,X,'r-') + end + + case 'error' + for it = 1:model.options.numIter + X = result.(x)(i_x).val(:,it); + plot(T,X,'-','color',clist(it,:)); + end + + case 'density' + t_array = repmat(T,model.options.numIter,1); + + x_matrix = []; + for it = 1:model.options.numIter + x_matrix(it,:) = result.(x)(i_x).val(:,it); + end + x_array = x_matrix(:); + + [N,C] = hist3(ax(i_x),[t_array x_array],[model.options.numTimeSteps 100]); + N = N./max(max(N)); + N(isinf(N))=0; + + h=pcolor(C{1},C{2},N'); + shading(ax(i_x),'flat') + colormap(ax(i_x),clist); + + % annotate 67% confidence interval + if isfield(plotinfo,'ci') && plotinfo.ci + h_ci(1) = plot(T,mean(x_matrix)-std(x_matrix),'-.'); + h_ci(2) = plot(T,mean(x_matrix)+std(x_matrix),'-.'); + set(h_ci(:),'Color',clist(end,:)/2.5,'LineWidth',20) + end + case 'density2' + DT = 1; + NDX = 50; + Tspace = T(1):DT:T(end); + y_lim = get_ylim_without_outliers(result,model,x,i_x); + Xmin = y_lim(1); + Xmax = y_lim(2); + DX = ((ceil(Xmax)-floor(Xmin))/NDX); + Xspace = floor(Xmin) : DX : ceil(Xmax); + Z = zeros(length(Tspace),length(Xspace)-1); + + for it = 1:model.options.numIter + t_curr = T'; + x_curr = result.(x)(i_x).val(:,it); + + % -- interpolate data to discretized space + A{it}.t = interp1(t_curr,t_curr,Tspace); + A{it}.x = interp1(t_curr,x_curr,A{it}.t,'linear'); + A{it}.i = []; + + for t_i = 1:length(Tspace) + for x_i = 1:length(Xspace)-1 + dX = [Xspace(x_i) Xspace(x_i+1)]; + + left = find(A{it}.x(t_i)>=dX(1)); + right = find(A{it}.x(t_i) red + case 'black' + clist = define_custom_colormap({[0.9 0.9 0.9] [0 0 0]},max(Z(:))); %light grey -> black + case 'blue' + clist = define_custom_colormap({[0.8 0.8 1] [0 0 0.8]},max(Z(:))); %light blue -> dark blue + end + else + clist = define_custom_colormap(plotinfo.c_matrix,max(Z(:))); + end + + for it = 1:model.options.numIter + surf_x = repmat( A{it}.t( ~isnan(A{it}.t) ),2,1); + surf_y = repmat( A{it}.x( ~isnan(A{it}.t) ),2,1); + surf_z = zeros(size(surf_x)); + + surf_c = []; + for t_i = 1:length(surf_x) + if t_i <= length(A{it}.i) + surf_c(t_i) = Z(t_i,A{it}.i(t_i)); + else + surf_c(t_i) = 0; + end + end + + surface(surf_x,surf_y,surf_z,repmat(surf_c,2,1),... + 'FaceColor','none','EdgeColor','interp','LineWidth',1); + end + colormap(clist) + end + + + + if ~isempty(result.(x)(i_x).data) + plot(result.(x)(i_x).data.time,result.(x)(i_x).data.val,'kx',... + 'MarkerSize',20,'LineWidth',3); + he = errorbar(result.(x)(i_x).data.time,result.(x)(i_x).data.val,result.(x)(i_x).data.std,'k.',... + 'LineWidth',3); + AMF.visualisation.errorbar_tick(he,0.5,'units') + end + + xlabel(['time [' model.options.time_unit ']']) + + if ~isempty(result.(x)(i_x).unit) + ylabel([strrep(result.(x)(i_x).name,'_','-') ' [' result.(x)(i_x).unit ']']) + else + ylabel(strrep(result.(x)(i_x).name,'_','-')) + end + + set(ax(i_x),'xlim',[result.(x)(i_x).time(1)-0.25 result.(x)(i_x).time(end)+0.25]) + if isfield(plotinfo,'remove_outliers') && plotinfo.remove_outliers + set(ax(i_x),'ylim',get_ylim_without_outliers(result,model,x,i_x)) + end + end + + if plotinfo.save + save_dir = [pwd '\results\' plotinfo.plot_color '\']; + if ~exist(save_dir,'dir') + mkdir(save_dir) + end + for i_f = 1:length(f) + s.fig_handle = f{i_f}; + if length(f) == 1 + s.filename = [save_dir 'Nit=' num2str(model.options.numIter) '_Nt=' num2str(model.options.numTimeSteps) '_' x]; + else + s.filename = [save_dir 'Nit=' num2str(model.options.numIter) '_Nt=' num2str(model.options.numTimeSteps) '_' x num2str(i_f)]; + end + s.eps = 0; + s.png = 1; + save_figure_to_file(s) + close(i_f); + end + end + end +end + +function y_lim = get_ylim_without_outliers(result,model,x,i_x) + minlist = []; + maxlist = []; + for it = 1:model.options.numIter + minlist(end+1,1) = min(result.(x)(i_x).val(:,it)); + maxlist(end+1,1) = max(result.(x)(i_x).val(:,it)); + end + minlist_sorted = sort(minlist,'ascend'); + minQ1 = minlist_sorted(ceil(0.25*length(minlist))); + minQ3 = minlist_sorted(ceil(0.75*length(minlist))); + + maxlist_sorted = sort(maxlist,'ascend'); + maxQ1 = maxlist_sorted(ceil(0.25*length(maxlist))); + maxQ3 = maxlist_sorted(ceil(0.75*length(maxlist))); + + w=2; + i_min_outliers = (minlist > minQ3 + w*(minQ3 - minQ1) | minlist < minQ1 - w*(minQ3 - minQ1)); + i_max_outliers = (maxlist > maxQ3 + w*(maxQ3 - maxQ1) | maxlist < maxQ1 - w*(maxQ3 - maxQ1)); + + + y_lim(1) = min(minlist(~i_min_outliers)); + y_lim(2) = max(maxlist(~i_max_outliers)); +end \ No newline at end of file diff --git a/+AMF/+visualisation/save_figure_to_file.m b/+AMF/+visualisation/save_figure_to_file.m new file mode 100644 index 0000000..1d91c6d --- /dev/null +++ b/+AMF/+visualisation/save_figure_to_file.m @@ -0,0 +1,185 @@ +function save_figure_to_file(save_options) + + +%% Construct the filename +if numel(save_options.filename) < 5 || ~strcmpi(save_options.filename(end-3:end), '.eps') + save_options.filename = [save_options.filename '.eps']; % Add the missing extension +end + + +%% Find all the used fonts in the figure +font_handles = findall(save_options.fig_handle, '-property', 'FontName'); +fonts = get(font_handles, 'FontName'); +if ~iscell(fonts) + fonts = {fonts}; +end + + +%% Map supported font aliases onto the correct name +fontsl = lower(fonts); +for a = 1:numel(fonts) + f1 = fontsl{a}; + f1(f1==' ') = []; + switch f1 + case {'times', 'timesnewroman', 'times-roman'} + fontsl{a} = 'times-roman'; + case {'arial', 'helvetica'} + fontsl{a} = 'helvetica'; + case {'newcenturyschoolbook', 'newcenturyschlbk'} + fontsl{a} = 'newcenturyschlbk'; + otherwise + end +end +fontslu = unique(fontsl); +% Determine the font swap table +matlab_fonts = {'Helvetica', 'Times-Roman', 'Palatino', 'Bookman', 'Helvetica-Narrow', 'Symbol', ... + 'AvantGarde', 'NewCenturySchlbk', 'Courier', 'ZapfChancery', 'ZapfDingbats'}; +matlab_fontsl = lower(matlab_fonts); +require_swap = find(~ismember(fontslu, matlab_fontsl)); +unused_fonts = find(~ismember(matlab_fontsl, fontslu)); +font_swap = cell(3, min(numel(require_swap), numel(unused_fonts))); +fonts_new = fonts; +for a = 1:size(font_swap, 2) + font_swap{1,a} = find(strcmp(fontslu{require_swap(a)}, fontsl)); + font_swap{2,a} = matlab_fonts{unused_fonts(a)}; + font_swap{3,a} = fonts{font_swap{1,a}(1)}; + fonts_new(font_swap{1,a}) = {font_swap{2,a}}; +end + + +%% Swap the fonts +if ~isempty(font_swap) + fonts_size = get(font_handles, 'FontSize'); + if iscell(fonts_size) + fonts_size = cell2mat(fonts_size); + end + M = false(size(font_handles)); + % Loop because some changes may not stick first time, due to listeners + c = 0; + update = zeros(1000, 1); + for b = 1:10 % Limit number of loops to avoid infinite loop case + for a = 1:numel(M) + M(a) = ~isequal(get(font_handles(a), 'FontName'), fonts_new{a}) || ~isequal(get(font_handles(a), 'FontSize'), fonts_size(a)); + if M(a) + set(font_handles(a), 'FontName', fonts_new{a}, 'FontSize', fonts_size(a)); + c = c + 1; + update(c) = a; + end + end + if ~any(M) + break; + end + end + % Compute the order to revert fonts later, without the need of a loop + [update, M] = unique(update(1:c)); + [M, M] = sort(M); + update = reshape(update(M), 1, []); +end + + +%% Set paper size +old_pos_mode = get(save_options.fig_handle, 'PaperPositionMode'); +old_orientation = get(save_options.fig_handle, 'PaperOrientation'); +set(save_options.fig_handle, 'PaperPositionMode', 'auto', 'PaperOrientation', 'portrait'); + + +%% MATLAB bug fix - black and white text can come out inverted sometimes +% Find the white and black text +white_text_handles = findobj(save_options.fig_handle, 'Type', 'text'); +M = get(white_text_handles, 'Color'); +if iscell(M) + M = cell2mat(M); +end +M = sum(M, 2); +black_text_handles = white_text_handles(M == 0); +white_text_handles = white_text_handles(M == 3); + + +%% Set the font colors slightly off their correct values +set(black_text_handles, 'Color', [0 0 0] + eps); +set(white_text_handles, 'Color', [1 1 1] - eps); + + +%% MATLAB bug fix - white lines can come out funny sometimes +% Find the white lines +white_line_handles = findobj(save_options.fig_handle, 'Type', 'line'); +M = get(white_line_handles, 'Color'); +if iscell(M) + M = cell2mat(M); +end +white_line_handles = white_line_handles(sum(M, 2) == 3); + + +%% Set the line color slightly off white +set(white_line_handles, 'Color', [1 1 1] - 0.00001); + + +%% Print to eps and png files +if save_options.eps + print(save_options.fig_handle,'-depsc2',save_options.filename); +end +if save_options.png + print(save_options.fig_handle,'-dpng',[save_options.filename(1:end-4) '.png']); +end + + +%% Reset the font and line colors +set(black_text_handles, 'Color', [0 0 0]); +set(white_text_handles, 'Color', [1 1 1]); +set(white_line_handles, 'Color', [1 1 1]); + + +%% Reset paper size +set(save_options.fig_handle, 'PaperPositionMode', old_pos_mode, 'PaperOrientation', old_orientation); + + +%% Correct the fonts +if ~isempty(font_swap) + % Reset the font names in the figure + for a = update + set(font_handles(a), 'FontName', fonts{a}, 'FontSize', fonts_size(a)); + end + % Replace the font names in the eps file + font_swap = font_swap(2:3,:); + try + swap_fonts(save_options.filename, font_swap{:}); + catch + warning('swap_fonts() failed. This is usually because the figure contains a large number of patch objects. Consider exporting to a bitmap format in this case.'); + return + end +end + + +%% Fix the line styles +try + fix_lines(save_options.filename); +catch +% warning('fix_lines() failed. This is usually because the figure contains a large number of patch objects. Consider exporting to a bitmap format in this case.'); +end +return + + + +% ========================================================================================================================= +function swap_fonts(fname, varargin) +% Read in the file +fh = fopen(fname, 'r'); +if fh == -1 + error('File %s not found.', fname); +end +fstrm = fread(fh, '*char')'; +fclose(fh); + +% Replace the font names +for a = 1:2:numel(varargin) + fstrm = regexprep(fstrm, [varargin{a} '-?[a-zA-Z]*\>'], varargin{a+1}(~isspace(varargin{a+1}))); +end + +% Write out the updated file +fh = fopen(fname, 'w'); +if fh == -1 + error('Unable to open %s for writing.', fname2); +end +fwrite(fh, fstrm, 'char*1'); +fclose(fh); +return \ No newline at end of file diff --git a/+AMF/@DataComponent/DataComponent.m b/+AMF/@DataComponent/DataComponent.m new file mode 100644 index 0000000..55bc1af --- /dev/null +++ b/+AMF/@DataComponent/DataComponent.m @@ -0,0 +1,30 @@ +classdef DataComponent < handle + properties + name + obs + index + + timeField + valField + stdField + + unitConv + smooth + + src + curr + + time + val + std + + ppform + options + + fitIdx + end + methods + function this = DataComponent(varargin) + end + end +end \ No newline at end of file diff --git a/+AMF/@DataComponent/filter.m b/+AMF/@DataComponent/filter.m new file mode 100644 index 0000000..f6a29f4 --- /dev/null +++ b/+AMF/@DataComponent/filter.m @@ -0,0 +1,3 @@ +function fieldArr = filter(fieldArr, func) + +fieldArr = fieldArr(func(fieldArr)); \ No newline at end of file diff --git a/+AMF/@DataComponent/getStruct.m b/+AMF/@DataComponent/getStruct.m new file mode 100644 index 0000000..e454111 --- /dev/null +++ b/+AMF/@DataComponent/getStruct.m @@ -0,0 +1,11 @@ +function s = getStruct(compArr) + +for i = 1:length(compArr) + comp = compArr(i); + + props = properties(comp); + for j = 1:length(props) + propName = props{j}; + s(i).(propName) = comp.(propName); + end +end \ No newline at end of file diff --git a/+AMF/@DataComponent/isConstant.m b/+AMF/@DataComponent/isConstant.m new file mode 100644 index 0000000..dbd5c93 --- /dev/null +++ b/+AMF/@DataComponent/isConstant.m @@ -0,0 +1,8 @@ +function filter = isConstant(fieldArr) + +filter = zeros(1, length(fieldArr)); +for i = 1:length(fieldArr) + field = fieldArr(i); + filter(i) = length(field.src.time); +end +filter = filter < 2; \ No newline at end of file diff --git a/+AMF/@DataComponent/isObservable.m b/+AMF/@DataComponent/isObservable.m new file mode 100644 index 0000000..b393de5 --- /dev/null +++ b/+AMF/@DataComponent/isObservable.m @@ -0,0 +1,3 @@ +function filter = isObservable(fieldArr) + +filter = logical([fieldArr.obs]); \ No newline at end of file diff --git a/+AMF/@DataComponent/plot.m b/+AMF/@DataComponent/plot.m new file mode 100644 index 0000000..181e85b --- /dev/null +++ b/+AMF/@DataComponent/plot.m @@ -0,0 +1,7 @@ +function this = plot(this) + +if any(this.src.std) + errorbar(this.src.time, this.src.val, this.src.std, 'xr'); +else + plot(this.src.time, this.src.val, 'xr'); +end \ No newline at end of file diff --git a/+AMF/@DataField/DataField.m b/+AMF/@DataField/DataField.m new file mode 100644 index 0000000..533654e --- /dev/null +++ b/+AMF/@DataField/DataField.m @@ -0,0 +1,24 @@ +classdef DataField < AMF.DataComponent + properties + end + methods + function this = DataField(index, name, obs, timeField, valField, stdField, unitConv, smooth) + this.index = index; + this.name = name; + this.obs = obs; + this.timeField = timeField; + this.valField = valField; + this.stdField = stdField; + this.unitConv = unitConv; + this.smooth = smooth; + + this.src.val = []; + this.src.std = []; + this.src.time = []; + this.ppform = struct(); + + this.curr.val = []; + this.curr.std = []; + end + end +end \ No newline at end of file diff --git a/+AMF/@DataField/genSpline.m b/+AMF/@DataField/genSpline.m new file mode 100644 index 0000000..3f1e2f9 --- /dev/null +++ b/+AMF/@DataField/genSpline.m @@ -0,0 +1,22 @@ +function fieldArr = genSpline(fieldArr) + +for i = 1:length(fieldArr) + field = fieldArr(i); + + if isConstant(field) + continue + end + + t = field.src.time; + dd = field.curr.val; + ds = field.curr.std; + smooth = field.smooth; + + w = (1 ./ ds ).^2; + + if (sum(isinf(w))==0) + field.ppform = csaps(t,dd,smooth,[],w); + else + field.ppform = csaps(t,dd,smooth,[]); + end +end \ No newline at end of file diff --git a/+AMF/@DataField/interp.m b/+AMF/@DataField/interp.m new file mode 100644 index 0000000..ef4eecf --- /dev/null +++ b/+AMF/@DataField/interp.m @@ -0,0 +1,72 @@ +function [val, std] = interp(fieldArr, t, method) + +if nargin < 3, method = 'LINEAR'; end + +switch upper(method) + + case 'LINEAR' + interpFunc = @interpLinear; + + case 'SPLINE' + interpFunc = @interpSpline; + + otherwise + error('Unknown interpolation method.'); +end + +for field = fieldArr + field.time = t(:); + + if isConstant(field) + if isempty(field.src.time) + % static (no time point) + val = ones(size(field.time)) * field.curr.val; + + if any(field.curr.std) + std = ones(size(field.time)) * field.curr.std; + else + std = []; + end + else + % constant (vector of NaNs with one value at the measured time + % point) + timeIdx = find(t == field.src.time); + val = nan(size(field.time)); val(timeIdx) = field.curr.val; + + if any(field.curr.std) + std = nan(size(field.time)); std(timeIdx) = field.curr.std; + else + std = []; + end + end + + field.val = val; + field.std = std; + else + % dynamic + [val, std] = interpFunc(field, t); + field.val = val(:); + field.std = std(:); + end +end + +val = [fieldArr.val]; +std = [fieldArr.std]; + +% val = zeros(length(t), length(fieldArr)); +% std = zeros(length(t), length(fieldArr)); +% +% for i = 1:length(fieldArr) +% field = fieldArr(i); +% +% switch upper(field.type) +% case 'CONSTANT' +% val(:,i) = field.val * ones(length(t), 1); +% std(:,i) = field.std * ones(length(t), 1); +% otherwise +% [fieldVal, fieldStd] = interpFunc(field, t); +% +% val(:,i) = fieldVal; +% std(:,i) = fieldStd; +% end +% end \ No newline at end of file diff --git a/+AMF/@DataField/interpLinear.m b/+AMF/@DataField/interpLinear.m new file mode 100644 index 0000000..9eb280b --- /dev/null +++ b/+AMF/@DataField/interpLinear.m @@ -0,0 +1,9 @@ +function [val, std] = interpLinear(field, t) + +val = interp1(field.src.time, field.curr.val, t, 'linaer', 'extrap'); + +if any(field.curr.std) + std = sqrt(interp1(field.src.time, field.curr.std .^ 2, t, 'linear', 'extrap'))'; +else + std = []; +end \ No newline at end of file diff --git a/+AMF/@DataField/interpSpline.m b/+AMF/@DataField/interpSpline.m new file mode 100644 index 0000000..38df743 --- /dev/null +++ b/+AMF/@DataField/interpSpline.m @@ -0,0 +1,13 @@ +function [val, std] = interpSpline(field, t) + +if isempty(field.ppform) + genSpline(field); +end + +val = ppval(field.ppform, t)'; + +if any(field.curr.std) + std = sqrt(interp1(field.src.time, field.curr.std .^ 2, t, 'linear','extrap'))'; +else + std = []; +end \ No newline at end of file diff --git a/+AMF/@DataField/randomize.m b/+AMF/@DataField/randomize.m new file mode 100644 index 0000000..49e30ad --- /dev/null +++ b/+AMF/@DataField/randomize.m @@ -0,0 +1,9 @@ +function fieldArr = randomize(fieldArr) + +for field = fieldArr + if ~isempty(field.src.std) + field.curr.val = field.src.val + randn(size(field.src.val)) .* field.src.std; + + genSpline(field); + end +end \ No newline at end of file diff --git a/+AMF/@DataField/restore.m b/+AMF/@DataField/restore.m new file mode 100644 index 0000000..1cd6963 --- /dev/null +++ b/+AMF/@DataField/restore.m @@ -0,0 +1,8 @@ +function fieldArr = restore(fieldArr) + +for field = fieldArr + field.curr.val = field.src.val; + field.curr.std = field.src.std; + + genSpline(field); +end \ No newline at end of file diff --git a/+AMF/@DataFunction/DataFunction.m b/+AMF/@DataFunction/DataFunction.m new file mode 100644 index 0000000..efe4bbd --- /dev/null +++ b/+AMF/@DataFunction/DataFunction.m @@ -0,0 +1,16 @@ +classdef DataFunction < AMF.DataComponent + properties + valExpr + stdExpr + end + methods + function this = DataFunction(index, name, obs, timeField, valExpr, stdExpr) + this.index = index; + this.name = name; + this.obs = obs; + this.timeField = timeField; + this.valExpr = valExpr; + this.stdExpr = stdExpr; + end + end +end \ No newline at end of file diff --git a/+AMF/@DataSet/DataSet.m b/+AMF/@DataSet/DataSet.m new file mode 100644 index 0000000..bf82034 --- /dev/null +++ b/+AMF/@DataSet/DataSet.m @@ -0,0 +1,68 @@ +classdef DataSet < handle + properties + name + description + specification + + data + + groups + activeGroup + + fields + functions + ref + list + + funcs + compileDir + end + methods + function this = DataSet(dataFile) + this.name = dataFile; + this.specification = feval(dataFile); + this.description = this.specification.DESCRIPTION; + this.groups = this.specification.GROUPS; + + this.compileDir = 'temp/'; + this.funcs.func = str2func(['C_', this.name, '_FUNCTIONS']); + + % fields + this.fields = AMF.DataField.empty; + n = size(this.specification.FIELDS, 1); + for i = 1:n + fieldSpec = this.specification.FIELDS(i,:); + fieldName = fieldSpec{1}; + newField = AMF.DataField(i, fieldSpec{:}); + this.ref.(fieldName) = newField; + + this.fields(i) = newField; + end + + % functions + if isfield(this.specification, 'FUNCTIONS') + this.functions = AMF.DataFunction.empty; + m = size(this.specification.FUNCTIONS, 1); + for i = 1:m + fieldSpec = this.specification.FUNCTIONS(i,:); + fieldName = fieldSpec{1}; + newFunc = AMF.DataFunction(i + n, fieldSpec{:}); + this.ref.(fieldName) = newFunc; + + this.functions(i) = newFunc; + end + end + +% this.fields = struct2array(this.ref); + this.list = struct2cell(this.ref); + + this.data = load([this.specification.FILE, '.mat']); + + this.loadGroup(this.groups{1}); + + if ~isempty(this.functions) + compileFunctions(this); + end + end + end +end \ No newline at end of file diff --git a/+AMF/@DataSet/compileFunctions.m b/+AMF/@DataSet/compileFunctions.m new file mode 100644 index 0000000..710d26d --- /dev/null +++ b/+AMF/@DataSet/compileFunctions.m @@ -0,0 +1,38 @@ +function this = compileFunctions(this) + +if isempty(this.functions) + return +end + +import AMF.utils.writeFile + +% +% Data functions +% + +fn = char(this.funcs.func); + +header = ['function [dd, ds] = ', fn, '(dd,ds,d)\n\n']; + +DD = {}; +DS = {}; +n = length(this.fields); +for i = 1:length(this.fields) + comp = this.fields(i); + DD{i} = [comp.name, ' = dd(:, d.d.', comp.name, ');\n']; + DS{i} = [comp.name, ' = ds(:, d.d.', comp.name, ');\n']; +end + +DFD = {}; EDFD = {}; +DFS = {}; EDFS = {}; +for i = 1:length(this.functions) + comp = this.functions(i); + DFD{i} = [comp.name, ' = ', comp.valExpr, ';\n']; + DFS{i} = [comp.name, ' = ', comp.stdExpr, ';\n']; + EDFD{i} = ['dd(:, ', num2str(comp.index), ') = ', comp.name, ';\n']; + EDFS{i} = ['ds(:, ', num2str(comp.index), ') = ', comp.name, ';\n']; +end + +content = [DD{:}, '\n', DFD{:}, '\n', EDFD{:}, '\n', DS{:}, '\n', DFS{:}, '\n', EDFS{:}]; + +writeFile([this.compileDir, fn, '.m'], [header, content]); \ No newline at end of file diff --git a/+AMF/@DataSet/filter.m b/+AMF/@DataSet/filter.m new file mode 100644 index 0000000..7c5de22 --- /dev/null +++ b/+AMF/@DataSet/filter.m @@ -0,0 +1,4 @@ +function compList = filter(this, func) + +idx = cellfun(func, this.list); +compList = this.list(idx); \ No newline at end of file diff --git a/+AMF/@DataSet/get.m b/+AMF/@DataSet/get.m new file mode 100644 index 0000000..aeb9291 --- /dev/null +++ b/+AMF/@DataSet/get.m @@ -0,0 +1,7 @@ +function fields = get(this, varargin) + +for i = 1:length(varargin) + fieldName = varargin{i}; + + fields(i) = this.ref.(fieldName); +end \ No newline at end of file diff --git a/+AMF/@DataSet/getDataStruct.m b/+AMF/@DataSet/getDataStruct.m new file mode 100644 index 0000000..ded16f8 --- /dev/null +++ b/+AMF/@DataSet/getDataStruct.m @@ -0,0 +1,9 @@ +function d = getDataStruct(this) + +nf = length(this.fields); +for i = 1:nf + d.d.(this.fields(i).name) = this.fields(i).index; +end +for i = 1:length(this.functions) + d.d.(this.functions(i).name) = this.functions(i).index; +end \ No newline at end of file diff --git a/+AMF/@DataSet/getFitData.m b/+AMF/@DataSet/getFitData.m new file mode 100644 index 0000000..f6e9383 --- /dev/null +++ b/+AMF/@DataSet/getFitData.m @@ -0,0 +1,25 @@ +function [dd, ds] = getFitData(this) + +ft = getFitTime(this); +tt = nan(size(ft)); + +for i = 1:length(this.fields) + df = this.fields(i); + t = df.src.time; + idx = ismember(ft, t); + + if isempty(t) + d = ones(size(ft)) * df.curr.val(1); + s = ones(size(ft)) * df.curr.std(1); + else + d = tt; d(idx) = df.curr.val; + s = tt; s(idx) = df.curr.std; + end + + dd(:,i) = d; + ds(:,i) = s; +end + +if ~isempty(this.functions) + [dd, ds] = this.funcs.func(dd, ds, getDataStruct(this)); +end \ No newline at end of file diff --git a/+AMF/@DataSet/getFitTime.m b/+AMF/@DataSet/getFitTime.m new file mode 100644 index 0000000..3535610 --- /dev/null +++ b/+AMF/@DataSet/getFitTime.m @@ -0,0 +1,12 @@ +function t = getFitTime(this) + +t = []; + +for i = 1:length(this.fields) + df = this.fields(i); + if df.obs + t = [t df.src.time(:)']; + end +end + +t = sort(unique(t)); \ No newline at end of file diff --git a/+AMF/@DataSet/getInterpData.m b/+AMF/@DataSet/getInterpData.m new file mode 100644 index 0000000..b29cd62 --- /dev/null +++ b/+AMF/@DataSet/getInterpData.m @@ -0,0 +1,11 @@ +function [dd, ds] = getInterpData(this, t, method) + +if nargin < 3 + method = 'spline'; +end + +[dd, ds] = interp(this.fields, t, method); + +if ~isempty(this.functions) + [dd, ds] = this.funcs.func(dd, ds, getDataStruct(this)); +end \ No newline at end of file diff --git a/+AMF/@DataSet/interp.m b/+AMF/@DataSet/interp.m new file mode 100644 index 0000000..ad71638 --- /dev/null +++ b/+AMF/@DataSet/interp.m @@ -0,0 +1,7 @@ +function this = interp(this, t, method) + +if nargin < 3, method = 'LINEAR'; end + +interp(this.fields, t, method); + +parseFunctions(this); \ No newline at end of file diff --git a/+AMF/@DataSet/loadGroup.m b/+AMF/@DataSet/loadGroup.m new file mode 100644 index 0000000..0c9d70d --- /dev/null +++ b/+AMF/@DataSet/loadGroup.m @@ -0,0 +1,6 @@ +function this = loadGroup(this, groupName) + +this.activeGroup = groupName; + +parseFields(this); +parseFunctions(this); \ No newline at end of file diff --git a/+AMF/@DataSet/parseFields.m b/+AMF/@DataSet/parseFields.m new file mode 100644 index 0000000..47dba83 --- /dev/null +++ b/+AMF/@DataSet/parseFields.m @@ -0,0 +1,17 @@ +function this = parseFields(this) + +dataStruct = this.data.(this.activeGroup); + +for field = this.fields + if ~isempty(field.timeField) + field.src.time = dataStruct.(field.timeField); + end + + field.src.val = dataStruct.(field.valField) * field.unitConv; + + if ~isempty(field.stdField) + field.src.std = dataStruct.(field.stdField) * field.unitConv; + end + + restore(field); +end \ No newline at end of file diff --git a/+AMF/@DataSet/parseFunctions.m b/+AMF/@DataSet/parseFunctions.m new file mode 100644 index 0000000..0c7c19a --- /dev/null +++ b/+AMF/@DataSet/parseFunctions.m @@ -0,0 +1,10 @@ +function this = parseFunctions(this) + +dataStruct = this.data.(this.activeGroup); + +for field = this.functions + if ~isempty(field.timeField) + field.src.time = dataStruct.(field.timeField); + end + +end \ No newline at end of file diff --git a/+AMF/@DataSet/randomize.m b/+AMF/@DataSet/randomize.m new file mode 100644 index 0000000..f64a6fa --- /dev/null +++ b/+AMF/@DataSet/randomize.m @@ -0,0 +1,5 @@ +function this = randomize(this) + +randomize(this.fields); + +parseFunctions(this); \ No newline at end of file diff --git a/+AMF/@GridUI/GridUI.m b/+AMF/@GridUI/GridUI.m new file mode 100644 index 0000000..57c2ea7 --- /dev/null +++ b/+AMF/@GridUI/GridUI.m @@ -0,0 +1,15 @@ +classdef GridUI < handle + properties + id + color + + controls + handles + dim = [0 0] + scale = 25 + end + methods + function this = GridUI(varargin) + end + end +end \ No newline at end of file diff --git a/+AMF/@GridUI/draw.m b/+AMF/@GridUI/draw.m new file mode 100644 index 0000000..2f999b9 --- /dev/null +++ b/+AMF/@GridUI/draw.m @@ -0,0 +1,16 @@ +function this = draw(this, name, type, pos, size, value, cb) + +import AMF.* + +control.name = name; +control.type = type; +control.pos = pos; +control.size = size; +control.callback = cb; +control.value = value; +control.selected = ''; + +this.controls.(name) = control; + +this.dim(1) = max([control.pos(1) + control.size(1) + 2, this.dim(1)]); +this.dim(2) = max([control.pos(2) + control.size(2) + 2, this.dim(2)]); \ No newline at end of file diff --git a/+AMF/@GridUI/render.m b/+AMF/@GridUI/render.m new file mode 100644 index 0000000..375b080 --- /dev/null +++ b/+AMF/@GridUI/render.m @@ -0,0 +1,8 @@ +function this = render(this) + +this.id = figure; +this.color = get(this.id, 'color'); + +set(this.id, 'Position', [0, 0, fliplr(size(this))]); + +structfun(@this.renderControl, this.controls); \ No newline at end of file diff --git a/+AMF/@GridUI/renderAxes.m b/+AMF/@GridUI/renderAxes.m new file mode 100644 index 0000000..ccee716 --- /dev/null +++ b/+AMF/@GridUI/renderAxes.m @@ -0,0 +1,9 @@ +function handle = renderAxes(this, control) + +UISize = size(this); +pos(1) = (control.pos(2) + 2) / UISize(2) * this.scale; +pos(2) = (control.pos(1) + 2) / UISize(1) * this.scale; +dim(1) = (control.size(2) - 2) / UISize(2) * this.scale; +dim(2) = (control.size(1) - 2) / UISize(1) * this.scale; + +handle = axes('Parent', this.id, 'Position', [pos(1), pos(2), dim(1), dim(2)]); \ No newline at end of file diff --git a/+AMF/@GridUI/renderControl.m b/+AMF/@GridUI/renderControl.m new file mode 100644 index 0000000..d7e61d1 --- /dev/null +++ b/+AMF/@GridUI/renderControl.m @@ -0,0 +1,15 @@ +function handle = renderControl(this, control) + +switch control.type + case 'EDIT' + handle = renderEdit(this, control); + case 'AXES' + handle = renderAxes(this, control); + case 'LISTBOX' + handle = renderListBox(this, control); + + otherwise + handle = 0; +end + +this.handles.(control.name) = handle; \ No newline at end of file diff --git a/+AMF/@GridUI/renderEdit.m b/+AMF/@GridUI/renderEdit.m new file mode 100644 index 0000000..0f5a603 --- /dev/null +++ b/+AMF/@GridUI/renderEdit.m @@ -0,0 +1,35 @@ +function handle = renderEdit(this, control) + +UISize = size(this); + +xpos = control.pos(2) * this.scale; +ypos = UISize(1) - control.pos(1) * this.scale - this.scale * 2; +xsize = control.size(2) * this.scale; +ysize = control.size(1) * this.scale; + +pos = [xpos, ypos]; +dim = [xsize, ysize]; + +label = uicontrol('Parent', this.id, 'Style', 'text', 'Position', [pos(1), pos(2), .5 * dim(1), dim(2)], 'String', control.name, 'BackgroundColor', this.color); + +handle = uicontrol('Parent', this.id, 'Style', 'edit', 'Position', [pos(1) + .5 * dim(1), pos(2),.5 *dim(1),dim(2)],'String',control.value, 'BackgroundColor', [1,1,1]); +set(handle, 'Callback', {@callback, this, control.name}); + +function callback(handle, ~, this, name) + +string = get(handle, 'String'); +value = str2double(string); + +this.controls.(name).value = value; +callback = this.controls.(name).callback; + +if ~isempty(callback) + if isa(callback, 'cell') + cb = callback{1}; + args = callback(2:end); + else + cb = callback; + args = {}; + end + cb(this, args{:}); +end \ No newline at end of file diff --git a/+AMF/@GridUI/renderListBox.m b/+AMF/@GridUI/renderListBox.m new file mode 100644 index 0000000..9a68390 --- /dev/null +++ b/+AMF/@GridUI/renderListBox.m @@ -0,0 +1,35 @@ +function handle = renderEdit(this, control) + +UISize = size(this); + +xpos = control.pos(2) * this.scale; +ypos = UISize(1) - control.pos(1) * this.scale - this.scale * 2; +xsize = control.size(2) * this.scale; +ysize = control.size(1) * this.scale; + +pos = [xpos, ypos]; +dim = [xsize, ysize]; + +label = uicontrol('Parent', this.id, 'Style', 'text', 'Position', [pos(1), pos(2), dim(1), this.scale], 'String', control.name, 'BackgroundColor', this.color); + +handle = uicontrol('Parent', this.id, 'Style', 'listbox', 'Position', [pos(1), pos(2)-dim(2), dim(1), dim(2)],'String',control.value, 'Value', 1, 'BackgroundColor', [1,1,1]); +set(handle, 'Callback', {@callback, this, control.name}); + +function callback(handle, ~, this, name) + +string = get(handle, 'String'); +value = get(handle, 'Value'); + +this.controls.(name).value = string{value}; +callback = this.controls.(name).callback; + +if ~isempty(callback) + if isa(callback, 'cell') + cb = callback{1}; + args = callback(2:end); + else + cb = callback; + args = {}; + end + cb(this, args{:}); +end \ No newline at end of file diff --git a/+AMF/@GridUI/size.m b/+AMF/@GridUI/size.m new file mode 100644 index 0000000..7bf0a64 --- /dev/null +++ b/+AMF/@GridUI/size.m @@ -0,0 +1,3 @@ +function dim = size(this) + +dim = this.dim * this.scale; \ No newline at end of file diff --git a/+AMF/@Model/Model.m b/+AMF/@Model/Model.m new file mode 100644 index 0000000..1988a35 --- /dev/null +++ b/+AMF/@Model/Model.m @@ -0,0 +1,146 @@ +classdef Model < handle + properties + name + specification + dataset + + compilePrefix + compileDir + resultsDir + + functions + + template + list + ref + + predictors + constants + inputs + parameters + states + reactions + + fitParameters + observableStates + observableReactions + observableStatesData + observableReactionsData + observables + mStruct + iStruct + dStruct + + predictor + + time + fitTime + + options + result + + currTimeStep + end + methods + function this = Model(modelFile) + this.name = modelFile; + this.specification = feval(modelFile); + + this.compileDir = 'temp/'; + this.compilePrefix = ['C_', this.name]; + + if ~exist(this.compileDir, 'dir') + mkdir(this.compileDir); + end + addpath(this.compileDir); + + this.resultsDir = 'results/'; + + if ~exist(this.resultsDir, 'dir') + mkdir(this.resultsDir); + end + addpath(this.resultsDir); + + this.functions.ODE = str2func([this.compilePrefix, '_ODE']); + this.functions.ODEMex = str2func([this.compilePrefix, '_ODEMEX']); + this.functions.ODEC = str2func([this.compilePrefix, '_ODEC']); + this.functions.reactions = str2func([this.compilePrefix, '_REACTIONS']); + this.functions.inputs = str2func([this.compilePrefix, '_INPUTS']); + this.functions.reg = []; + this.functions.err = @AMF.errFun; + this.functions.errStep = @AMF.errFunStep; + + addComponents(this, 'PREDICTOR', this.specification, @AMF.ModelPredictor); + addComponents(this, 'CONSTANTS', this.specification, @AMF.ModelConstant); + addComponents(this, 'INPUTS', this.specification, @AMF.ModelInput); + addComponents(this, 'PARAMETERS', this.specification, @AMF.ModelParameter); + addComponents(this, 'STATES', this.specification, @AMF.ModelState); + addComponents(this, 'REACTIONS', this.specification, @AMF.ModelReaction); + + % component list + this.list = struct2cell(this.ref); + + % component groups + this.predictor = getAll(this, 'predictor'); + this.constants = getAll(this, 'constants'); + this.inputs = getAll(this, 'inputs'); + this.parameters = getAll(this, 'parameters'); + this.states = getAll(this, 'states'); + this.reactions = getAll(this, 'reactions'); + + % derived component groups + this.fitParameters = this.parameters(logical([this.parameters.fit])); + + % --- + + % default options + this.options.optimset = optimset('MaxIter',1e3,'Display','off','MaxFunEvals',1e5,'TolX',1e-8,'TolFun',1e-8); + this.options.odeTol = [1e-12 1e-12 100]; + this.options.useMex = 0; + % TODO: odeset + this.options.parScale = [2 -2]; + this.options.numIter = 1; + this.options.lab1 = .1; + this.options.seed = 1; + this.options.numTimeSteps = this.predictor.val(end) - this.predictor.val(1); + this.options.SSTime = 1000; + this.options.savePrefix = ''; + this.options.randPars = 1; + this.options.randData = 1; + + this.options.interpMethod = 'linear'; + + this.currTimeStep = 0; + + this.time = getTime(this); + + this.result.oxi = []; + this.result.ofi = []; + this.result.oxdi = []; + this.result.ofdi = []; + this.result.pidx = []; + this.result.lb = []; + this.result.p = []; + this.result.x = []; + this.result.u = []; + this.result.v = []; + this.result.sse = []; + this.result.dt = []; + this.result.dd = []; + this.result.ds = []; + this.result.idd = []; + this.result.ids = []; + this.result.xinit = []; + this.result.xcurr = []; + this.result.pcurr = [this.parameters.init]; + this.result.pinit = []; + this.result.pprev = []; + this.result.vcurr = []; + this.result.nfp = length(this.fitParameters); + this.result.time = []; + this.result.uidx = []; + this.result.upidx = []; + this.result.uvec = []; + end + end +end \ No newline at end of file diff --git a/+AMF/@Model/addComponents.m b/+AMF/@Model/addComponents.m new file mode 100644 index 0000000..de84cef --- /dev/null +++ b/+AMF/@Model/addComponents.m @@ -0,0 +1,13 @@ +function this = addComponents(this, groupName, spec, compType) + +this.template.(groupName) = func2str(compType); + +if ~isfield(spec, groupName) + return +end + +compSpec = spec.(groupName); +for i = 1:size(compSpec, 1) + name = compSpec{i, 1}; + this.ref.(name) = compType(i, compSpec{i, :}); +end \ No newline at end of file diff --git a/+AMF/@Model/compile.m b/+AMF/@Model/compile.m new file mode 100644 index 0000000..1274c81 --- /dev/null +++ b/+AMF/@Model/compile.m @@ -0,0 +1,83 @@ +function this = compile(this) + +prefix = 'C'; + +% +% ODE +% + +fn = [prefix, '_', this.name, '_ODE']; +fid = fopen([fn, '.m'], 'w'); + +fprintf(fid, ['function dxdt = ', fn, '(t,x,p,m)\n']); + +[states, n] = filterByType(this, 'State'); +for i = 1:n + comp = states(i); + fprintf(fid, ['dxdt(', num2str(states(i).index) ,')', ' = ' ,comp.compiledExpr, ';\n']); +end + +fprintf(fid, '\ndxdt = dxdt(:);'); +fclose(fid); + +% % +% % Inputs +% % +% +% fn = [prefix, '_', this.name, '_Inputs']; +% fid = fopen([fn, '.m'], 'w'); +% +% fprintf(fid, ['function u = ', fn, '(t,m)\n']); +% +% [inputs, n] = filterByType(this, 'Input'); +% for i = 1:n +% comp = inputs(i); +% fprintf(fid, [comp.compiledVar, ' = ' ,comp.compiledExpr, ';\n']); +% end +% +% fclose(fid); +% +% % +% % Reactions +% % +% +% fn = [prefix, '_', this.name, '_Reactions']; +% fid = fopen([fn, '.m'], 'w'); +% +% fprintf(fid, ['function v = ', fn, '(t,x,p,m)\n']); +% +% [reactions, n] = filterByType(this, 'Reaction'); +% for i = 1:n +% comp = reactions(i); +% fprintf(fid, [comp.compiledVar, ' = ' ,comp.compiledExpr, ';\n']); +% end +% +% fclose(fid); +% +% % EXPERIMENTAL +% +% % +% % Constraints +% % +% +% fn = [prefix, '_', this.name, '_Constraints']; +% fid = fopen([fn, '.m'], 'w'); +% +% fprintf(fid, ['function E = ', fn, '(model)\n']); +% +% n = size(this.spec.CONSTRAINTS, 1); +% for i = 1:n +% expr = this.spec.CONSTRAINTS{i,1}; +% weight = this.spec.CONSTRAINTS{i,2}; +% +% vars = symvar(expr); +% for j = 1:length(vars) +% var = char(vars(j)); +% expr = regexprep(expr, var, ['model.comps.', var]); +% end +% +% fprintf(fid, ['E(', num2str(i) ,') = ' ,expr, '* ', num2str(weight),';\n']); +% end +% +% fprintf(fid, 'E = E(:);\n'); +% fclose(fid); \ No newline at end of file diff --git a/+AMF/@Model/compileAll.m b/+AMF/@Model/compileAll.m new file mode 100644 index 0000000..de0e299 --- /dev/null +++ b/+AMF/@Model/compileAll.m @@ -0,0 +1,14 @@ +function compileAll(this) + +clear mex + +compileODE(this); +compileODEMex(this); +compileInputs(this); +compileReactions(this); + +if this.options.useMex + compileMex(this); +end + +addpath(this.compileDir); \ No newline at end of file diff --git a/+AMF/@Model/compileInputs.m b/+AMF/@Model/compileInputs.m new file mode 100644 index 0000000..db2f40f --- /dev/null +++ b/+AMF/@Model/compileInputs.m @@ -0,0 +1,24 @@ +function this = compileInputs(this) + +if isempty(this.inputs) + return +end + +import AMF.utils.writeFile + +% +% ODE +% + +fn = char(this.functions.inputs); + +header = ['function u = ', fn, '(t,uv,m)\n\n']; + +for i = 1:length(this.inputs) + comp = this.inputs(i); + IC{i} = ['u(', num2str(comp.index), ') = interp1(uv(m.u.', comp.name, '_t), ', 'uv(m.u.', comp.name, '), t, ''', comp.method, ''', ''extrap'');\n']; +end + +content = [IC{:}]; + +writeFile([this.compileDir, fn, '.m'], [header, content]); \ No newline at end of file diff --git a/+AMF/@Model/compileMex.m b/+AMF/@Model/compileMex.m new file mode 100644 index 0000000..12ba350 --- /dev/null +++ b/+AMF/@Model/compileMex.m @@ -0,0 +1,17 @@ +function compileMex(this) + +% ----------------------------------------------------- +% MEX +% + +if exist('convertToC') && exist('compileC') + clear mex + + inputFn = func2str(this.functions.ODEMex); + outputFn = func2str(this.functions.ODEC); + + convertToC(getInputStructMex(this), [inputFn, '.m']); + compileC([pwd, '\', this.compileDir , outputFn]); +else + fprintf('Add paths of odemex toolbox before compiling the model!\n'); +end \ No newline at end of file diff --git a/+AMF/@Model/compileODE.m b/+AMF/@Model/compileODE.m new file mode 100644 index 0000000..0d70dad --- /dev/null +++ b/+AMF/@Model/compileODE.m @@ -0,0 +1,53 @@ +function this = compileODE(this) + +import AMF.utils.writeFile + +% +% ODE +% + +fn = char(this.functions.ODE); + +header = ['function dxdt = ', fn, '(t,x,p,u,m)\n\n']; + +CC = {}; +for i = 1:length(this.constants) + comp = this.constants(i); + CC{i} = [comp.name, ' = m.c.', comp.name, ';\n']; +end + +IC = {}; +for i = 1:length(this.inputs) + comp = this.inputs(i); + IC{i} = [comp.name, ' = interp1(u(m.u.', comp.name, '_t), ', 'u(m.u.', comp.name, '), t, ''', comp.method, ''', ''extrap'');\n']; +end + +SC = {}; +for i = 1:length(this.states) + comp = this.states(i); + SC{i} = [comp.name, ' = x(m.s.', comp.name, ');\n']; +end + +PC = {}; +for i = 1:length(this.parameters) + comp = this.parameters(i); + PC{i} = [comp.name, ' = p(m.p.', comp.name, ');\n']; +end + +RC = {}; +for i = 1:length(this.reactions) + comp = this.reactions(i); + RC{i} = [comp.name, ' = ', comp.expr, ';\n']; +end + +OC = {}; +for i = 1:length(this.states) + comp = this.states(i); + OC{i} = ['dxdt(', num2str(comp.index), ') = ', comp.expr, ';\n']; +end + +footer = '\ndxdt = dxdt(:);'; + +content = [IC{:}, '\n', CC{:}, '\n', SC{:}, '\n', PC{:}, '\n', RC{:}, '\n', OC{:}]; + +writeFile([this.compileDir, fn, '.m'], [header, content, footer]); \ No newline at end of file diff --git a/+AMF/@Model/compileODEMex.m b/+AMF/@Model/compileODEMex.m new file mode 100644 index 0000000..33a7f30 --- /dev/null +++ b/+AMF/@Model/compileODEMex.m @@ -0,0 +1,56 @@ +function this = compileODE(this) + +import AMF.utils.writeFile +import AMF.utils.mexify2 + +% +% ODE +% + +fn = char(this.functions.ODEMex); + +header = ['function dxdt = ', fn, '(t,x,p,u,m)\n\n']; + +CC = {}; +for i = 1:length(this.constants) + comp = this.constants(i); + CC{i} = [comp.name, ' = m.c.', comp.name, ';\n']; +end + +IC = {}; +for i = 1:length(this.inputs) + comp = this.inputs(i); + IC{i} = [comp.name, ' = interpolate( &u(m.u.', comp.name, '_t), ', '&u(m.u.', comp.name, '), ', num2str(length(comp.initVal)),', t, 1);\n']; +end + +% interpolate( &u(myStruct.u.time1), &u(myStruct.u.linear1), 6, t, 1 ); + +SC = {}; +for i = 1:length(this.states) + comp = this.states(i); + SC{i} = [comp.name, ' = x(m.s.', comp.name, ');\n']; +end + +PC = {}; +for i = 1:length(this.parameters) + comp = this.parameters(i); + PC{i} = [comp.name, ' = p(m.p.', comp.name, ');\n']; +end + +RC = {}; +for i = 1:length(this.reactions) + comp = this.reactions(i); + RC{i} = [comp.name, ' = ', mexify2(comp.expr, comp.name), ';\n']; +end + +OC = {}; +for i = 1:length(this.states) + comp = this.states(i); + OC{i} = ['dxdt(', num2str(comp.index), ') = ', mexify2(comp.expr, comp.name), ';\n']; +end + +footer = '\ndxdt = dxdt(:);'; + +content = [IC{:}, '\n', CC{:}, '\n', SC{:}, '\n', PC{:}, '\n', RC{:}, '\n', OC{:}]; + +writeFile([this.compileDir, fn, '.m'], [header, content, footer]); \ No newline at end of file diff --git a/+AMF/@Model/compileReactions.m b/+AMF/@Model/compileReactions.m new file mode 100644 index 0000000..840f5a1 --- /dev/null +++ b/+AMF/@Model/compileReactions.m @@ -0,0 +1,51 @@ +function this = compileReactions(this) + +import AMF.utils.writeFile + +% +% ODE +% + +fn = char(this.functions.reactions); + +header = ['function v = ', fn, '(t,x,p,u,m)\n\n']; + +CC = {}; +for i = 1:length(this.constants) + comp = this.constants(i); + CC{i} = [comp.name, ' = m.c.', comp.name, ';\n']; +end + +IC = {}; +for i = 1:length(this.inputs) + comp = this.inputs(i); + IC{i} = [comp.name, ' = interp1(u(m.u.', comp.name, '_t), ', 'u(m.u.', comp.name, '), t, ''', comp.method, ''', ''extrap'');\n']; +end + +SC = {}; +for i = 1:length(this.states) + comp = this.states(i); + SC{i} = [comp.name, ' = x(m.s.', comp.name, ');\n']; +end + +PC = {}; +for i = 1:length(this.parameters) + comp = this.parameters(i); + PC{i} = [comp.name, ' = p(m.p.', comp.name, ');\n']; +end + +RC = {}; +for i = 1:length(this.reactions) + comp = this.reactions(i); + RC{i} = [comp.name, ' = ', AMF.utils.mexify2(comp.expr, comp.name), ';\n']; +end + +RRC = {}; +for i = 1:length(this.reactions); + comp = this.reactions(i); + RRC{i} = ['v(', num2str(comp.index), ') = ', comp.name, ';\n']; +end + +content = [IC{:}, '\n', CC{:}, '\n', SC{:}, '\n', PC{:}, '\n', RC{:}, '\n', RRC{:}]; + +writeFile([this.compileDir, fn, '.m'], [header, content]); \ No newline at end of file diff --git a/+AMF/@Model/computeAll.m b/+AMF/@Model/computeAll.m new file mode 100644 index 0000000..45ac316 --- /dev/null +++ b/+AMF/@Model/computeAll.m @@ -0,0 +1,38 @@ +function this = computeAll(this, t, x0, p, ts) + +if nargin < 5, ts = 0; end + +% compute +x = computeStates(this, t, x0, p); + +if ts > 0 + t = t(end); + x = x(end,:); +end + +u = this.computeInputs(t); +v = this.computeReactions(t, x, p); + +% update the component current values +for i = 1:length(this.states) + this.states(i).curr = x(:,i); +end +for i = 1:length(this.reactions) + this.reactions(i).curr = v(:,i); +end +for i = 1:length(this.inputs) + this.inputs(i).curr = u(:,i); +end + +% store the values in the trajectories +if ts > 0 + this.result.x(ts,:) = x; + this.result.v(ts,:) = v; + if ~isempty(this.inputs) + this.result.u(ts,:) = u; + end +else + this.result.x = x; + this.result.v = v; + this.result.u = u; +end \ No newline at end of file diff --git a/+AMF/@Model/computeInputs.m b/+AMF/@Model/computeInputs.m new file mode 100644 index 0000000..85396a8 --- /dev/null +++ b/+AMF/@Model/computeInputs.m @@ -0,0 +1,12 @@ +function u = computeInputs(this, time, uvec) + +if isempty(this.inputs) + u = []; + return +end + +m = this.mStruct; +for i = 1:length(time) + t = time(i); + u(i,:) = this.functions.inputs(t, uvec, m); +end \ No newline at end of file diff --git a/+AMF/@Model/computeReactions.m b/+AMF/@Model/computeReactions.m new file mode 100644 index 0000000..f02f6b5 --- /dev/null +++ b/+AMF/@Model/computeReactions.m @@ -0,0 +1,9 @@ +function v = computeReactions(this, t, x, p, uvec) + +n = length(t); +v = zeros(n, length(this.reactions)); + +m = this.mStruct; +for i = 1:n + v(i,:) = this.functions.reactions(t(i), x(i,:), p, uvec, m); +end \ No newline at end of file diff --git a/+AMF/@Model/computeStates.m b/+AMF/@Model/computeStates.m new file mode 100644 index 0000000..497eed9 --- /dev/null +++ b/+AMF/@Model/computeStates.m @@ -0,0 +1,9 @@ +function x = computeStates(this, t, x0, p, uvec) + +if ~this.options.useMex + mStruct = this.mStruct; + [~, x] = ode15s(this.functions.ODE, t, x0, this.options.odeTol, p, uvec, mStruct); +else + [~,x] = this.functions.ODEC(t, x0, p, uvec, this.options.odeTol); + x = x'; +end \ No newline at end of file diff --git a/+AMF/@Model/filter.m b/+AMF/@Model/filter.m new file mode 100644 index 0000000..7c5de22 --- /dev/null +++ b/+AMF/@Model/filter.m @@ -0,0 +1,4 @@ +function compList = filter(this, func) + +idx = cellfun(func, this.list); +compList = this.list(idx); \ No newline at end of file diff --git a/+AMF/@Model/get.m b/+AMF/@Model/get.m new file mode 100644 index 0000000..ab75e4c --- /dev/null +++ b/+AMF/@Model/get.m @@ -0,0 +1,7 @@ +function comps = get(this, varargin) + +for i = 1:length(varargin) + compName = varargin{i}; + + comps(i) = this.ref.(compName); +end \ No newline at end of file diff --git a/+AMF/@Model/getAll.m b/+AMF/@Model/getAll.m new file mode 100644 index 0000000..09f0073 --- /dev/null +++ b/+AMF/@Model/getAll.m @@ -0,0 +1,10 @@ +function [comps, n] = getAll(this, type) + +compClass = this.template.(upper(type)); + +idx = cellfun(@(comp) isa(comp, compClass), this.list); + +comps = this.list(idx); +comps = [comps{:}]; + +n = length(comps); \ No newline at end of file diff --git a/+AMF/@Model/getInputStruct.m b/+AMF/@Model/getInputStruct.m new file mode 100644 index 0000000..d3c135d --- /dev/null +++ b/+AMF/@Model/getInputStruct.m @@ -0,0 +1,7 @@ +function mStruct = getInputStruct(this) + +for state = this.states, mStruct.s.(state.name) = state.index; end +for param = this.parameters, mStruct.p.(param.name) = param.index; end +for constant = this.constants, mStruct.c.(constant.name) = constant.val; end +for reaction = this.reactions, mStruct.v.(reaction.name) = reaction.index; end +for input = this.inputs, mStruct.u.(input.name) = input.index; end diff --git a/+AMF/@Model/getInputStructMex.m b/+AMF/@Model/getInputStructMex.m new file mode 100644 index 0000000..30ef54f --- /dev/null +++ b/+AMF/@Model/getInputStructMex.m @@ -0,0 +1,14 @@ +function mStruct = getInputStructMex(this) + +for state = this.states, mStruct.s.(state.name) = state.index; end +for param = this.parameters, mStruct.p.(param.name) = param.index; end +for constant = this.constants, mStruct.c.(constant.name) = constant.val; end + +% TODO: fix allocation +n = 1; +for input = this.inputs + mStruct.u.(input.name) = n:n+length(input.initVal)-1; + n = n+length(input.initVal); + mStruct.u.([input.name, '_t']) = n:n+length(input.initTime)-1; + n = n+length(input.initTime); +end diff --git a/+AMF/@Model/getInputsMex.m b/+AMF/@Model/getInputsMex.m new file mode 100644 index 0000000..b1ca5ef --- /dev/null +++ b/+AMF/@Model/getInputsMex.m @@ -0,0 +1,6 @@ +function u = getInputsMex(this) + +u = []; +for input = this.inputs + u = [u, input.initVal(:)', input.initTime(:)']; +end \ No newline at end of file diff --git a/+AMF/@Model/getResiduals.m b/+AMF/@Model/getResiduals.m new file mode 100644 index 0000000..938dbb1 --- /dev/null +++ b/+AMF/@Model/getResiduals.m @@ -0,0 +1,52 @@ +function resid = getResiduals(this, ts) + +import AMF.regFun + +if nargin < 2, ts = 0; end + +% observables = filter(this, @isObservable); +observables = this.observables; + +% compute error from observables +resid = 0; +for i = 1:length(observables) + comp = observables{i}; + + if ts > 0 + err = comp.data.val(ts)-comp.curr(:); + + if any(comp.data.std) + err = err ./ comp.data.std(ts); + else + err = err ./ comp.data.val(ts); + end + else + idx = comp.data.fitIdx; + err = comp.data.src.val(:)-comp.curr(idx); + + if any(comp.data.std) + err = err ./ comp.data.src.std(:); + else + err = err ./ comp.data.src.val(:); + end + end + + resid = [resid; err]; +end + +% pad error to prevent lsqnonlin warnings +resid = [resid; zeros(length(this.fitParameters), 1)]; + +% standard ADAPT regularization +regADAPT = regFun(this); +resid = [resid; regADAPT(:)]; + +% additional regularization +if ~isempty(this.functions.reg) + reg = this.functions.reg(this); + resid = [resid; reg(:)]; +end + +% remove NaNs (caused by single time point data or zero divisions in model reactions or state derivatives) +resid(isnan(resid)) = 0; +resid(isinf(resid)) = 0; \ No newline at end of file diff --git a/+AMF/@Model/getResult.m b/+AMF/@Model/getResult.m new file mode 100644 index 0000000..3691623 --- /dev/null +++ b/+AMF/@Model/getResult.m @@ -0,0 +1,22 @@ +function result = getResult(this) + +result.predictor = getStruct(this.predictor); +result.parameters = getStruct(this.parameters); +result.states = getStruct(this.states); +result.reactions = getStruct(this.reactions); + +result.options = this.options; + +if ~isempty(this.constants) + result.constants = getStruct(this.constants); +else + result.constants = []; +end + +if ~isempty(this.inputs) + result.inputs = getStruct(this.inputs); +else + result.inputs = []; +end + +result.time = getTime(this); \ No newline at end of file diff --git a/+AMF/@Model/getTime.m b/+AMF/@Model/getTime.m new file mode 100644 index 0000000..d2df7d9 --- /dev/null +++ b/+AMF/@Model/getTime.m @@ -0,0 +1,18 @@ +function t = getTime(this, ts) + +if nargin < 2, ts = 0; end + +t = this.predictor.val(1):this.predictor.val(end)/this.options.numTimeSteps:this.predictor.val(end); + +if ts > 0 + SSTime = this.options.SSTime; + + if ts > 1 + t = [t(ts-1); (t(ts-1)+t(ts))/2; t(ts)]; + else + t0 = t(ts)-SSTime; + t = [t0; (t0+t(ts))/2; t(ts)]; + end +end + +t = t(:); \ No newline at end of file diff --git a/+AMF/@Model/initializeObservables.m b/+AMF/@Model/initializeObservables.m new file mode 100644 index 0000000..69c840a --- /dev/null +++ b/+AMF/@Model/initializeObservables.m @@ -0,0 +1,8 @@ +function this = initializeObservables(this) + +observables = filter(this, @isObservable); + +for i = 1:length(observables) + comp = observables{i}; + comp.init = comp.data.val(1); +end \ No newline at end of file diff --git a/+AMF/@Model/initiateExperiment.asv b/+AMF/@Model/initiateExperiment.asv new file mode 100644 index 0000000..e410d71 --- /dev/null +++ b/+AMF/@Model/initiateExperiment.asv @@ -0,0 +1,25 @@ +randfunction this = initiateExperiment(this, dataset) + +this.dataset = dataset; +interp(this.dataset, 0, 'spline'); + +observables = filter(this.dataset, @isObservable); + +this.fitTime = []; + +for i = 1:length(observables) + dataField = observables{i}; + this.fitTime = [this.fitTime, dataField.src.time]; +end + +this.fitTime = sort(unique(this.fitTime)); + +for i = 1:length(observables) + dataField = observables{i}; + fieldName = dataField.name; + + comp = this.ref.(fieldName); + comp.data = dataField; + + dataField.fitIdx = arrayfun(@(t) find(this.fitTime == t), dataField.src.time); +end \ No newline at end of file diff --git a/+AMF/@Model/initiateExperiment.m b/+AMF/@Model/initiateExperiment.m new file mode 100644 index 0000000..934ab02 --- /dev/null +++ b/+AMF/@Model/initiateExperiment.m @@ -0,0 +1,29 @@ +function this = initiateExperiment(this, dataset) + +this.dataset = dataset; + +observables = filter(this.dataset, @isObservable); + +for i = 1:length(observables) + df = observables{i}; + name = df.name; + + this.ref.(name).obs = 1; + this.ref.(name).dataIdx = df.index; +end + +% save observable indices (states, reactions corresponding data) +this.result.oxi = logical([this.states.obs]); +this.result.ofi = logical([this.reactions.obs]); +this.result.oxdi = [this.states.dataIdx]; +this.result.ofdi = [this.reactions.dataIdx]; + +% +dt = getFitTime(this.dataset); +[dd, ds] = getFitData(this.dataset); + +this.result.dt = dt(:); +this.result.dd = dd; +this.result.ds = ds; + +this.dStruct = getDataStruct(this.dataset); \ No newline at end of file diff --git a/+AMF/@Model/parseAll.m b/+AMF/@Model/parseAll.m new file mode 100644 index 0000000..44f31b2 --- /dev/null +++ b/+AMF/@Model/parseAll.m @@ -0,0 +1,10 @@ +function this = parseAll(this) + +parseConstants(this); +parseStates(this); +parseReactions(this); +parseParameters(this); +parseInputs(this); + +this.iStruct = getInputStruct(this); +this.mStruct = getInputStructMex(this); \ No newline at end of file diff --git a/+AMF/@Model/parseConstants.m b/+AMF/@Model/parseConstants.m new file mode 100644 index 0000000..d177b45 --- /dev/null +++ b/+AMF/@Model/parseConstants.m @@ -0,0 +1,23 @@ +function this = parseConstants(this) + +if isempty(this.constants) + return +end + +for comp = this.constants + + switch class(comp.expr) + + case 'char' + if isempty(this.dataset) + error('Can not obtain constant value from dataset.'); + end + + comp.val = this.dataset.ref.(comp.expr).src.val(1); + + case 'double' + comp.val = comp.expr; + + end + +end \ No newline at end of file diff --git a/+AMF/@Model/parseInputs.m b/+AMF/@Model/parseInputs.m new file mode 100644 index 0000000..36f7555 --- /dev/null +++ b/+AMF/@Model/parseInputs.m @@ -0,0 +1,46 @@ +function this = parseInputs(this) + +if isempty(this.inputs) + return +end + +uidx = []; +upidx = []; +uvec = []; + +for comp = this.inputs + + switch upper(comp.type) + case 'DATA' + if isempty(this.dataset) + error('Can not obtain input value from dataset.'); + end + + dataField = this.dataset.ref.(comp.args{1}); + comp.initVal = dataField.curr.val; + comp.initTime = dataField.src.time; + + uidx = [uidx zeros(1,length(comp.initVal)) zeros(1,length(comp.initTime))]; + uvec = [uvec comp.initVal(:)' comp.initTime(:)']; + + case 'FUNCTION' + t = comp.args{1}; +% params = get(this, comp.args{2:end}); + pnames = comp.args(2:end); + + pidx = cellfun(@(p) this.ref.(p).index, pnames); + upidx = [upidx pidx]; + + comp.initTime = t; +% comp.initVal = [params.curr]; + comp.initVal = this.result.pcurr(pidx); + + uidx = [uidx ones(1, length(pnames)) zeros(1,length(comp.initTime))]; + uvec = [uvec comp.initVal(:)' comp.initTime(:)']; + end + +end + +this.result.uidx = logical(uidx); +this.result.upidx = upidx; +this.result.uvec = uvec; \ No newline at end of file diff --git a/+AMF/@Model/parseParameters.m b/+AMF/@Model/parseParameters.m new file mode 100644 index 0000000..2ab51a5 --- /dev/null +++ b/+AMF/@Model/parseParameters.m @@ -0,0 +1,15 @@ +function this = parseParameters(this) + +for comp = this.parameters + + if isa(comp.expr, 'char') + sourcePar = this.ref.(comp.expr); + comp.init = sourcePar.init; + end +end + +this.result.pcurr = [this.parameters.init]; +this.result.pinit = [this.parameters.init]; +this.result.pidx = logical([this.parameters.fit]); +this.result.lb = [this.parameters.lb]; +this.result.ub = [this.parameters.ub]; \ No newline at end of file diff --git a/+AMF/@Model/parseReactions.m b/+AMF/@Model/parseReactions.m new file mode 100644 index 0000000..20c0606 --- /dev/null +++ b/+AMF/@Model/parseReactions.m @@ -0,0 +1,3 @@ +function this = parseReactions(this) + +% \ No newline at end of file diff --git a/+AMF/@Model/parseStates.m b/+AMF/@Model/parseStates.m new file mode 100644 index 0000000..dd46e13 --- /dev/null +++ b/+AMF/@Model/parseStates.m @@ -0,0 +1,15 @@ +function this = parseStates(this) + +[dd, ~] = getInterpData(this.dataset, 0, 'spline'); +d = getDataStruct(this.dataset); + +for comp = this.states + + if isa(comp.initExpr, 'char') + dataCompName = comp.initExpr; + comp.init = dd(d.d.(dataCompName)); + end +end + +this.result.xinit = [this.states.init]; +this.result.xcurr = [this.states.init]; \ No newline at end of file diff --git a/+AMF/@Model/plot.m b/+AMF/@Model/plot.m new file mode 100644 index 0000000..0e6f332 --- /dev/null +++ b/+AMF/@Model/plot.m @@ -0,0 +1,52 @@ +function this = plot(this, name) + +comp = this.ref.(name); + +plot(this.time, comp.val, 'r'); + +if ~isempty(comp.data) + data.time = comp.data.src.time; + data.val = comp.data.src.val; + data.std = comp.data.src.std; + + hold on + if any(data.std) + errorbar(data.time, data.val, data.std, 'kx', 'LineWidth', 2); + else + plot(data.time, data.val, 'kx', 'LineWidth', 2); + end + hold off +end + +xlabel([this.predictor.unitType, ' [', this.predictor.unit, ']']); +xlim([comp.time(1) comp.time(end)]); + +if comp.label + title(comp.label); +else + title(comp.name); +end + +if comp.unit + ylabel(sprintf('%s [%s]', comp.unitType, comp.unit)); +else + ylabel(comp.unitType); +end + +% function this = plot(this, compName) +% +% comp = this.ref.(compName); +% +% plot(this.getTime(), comp.val); +% +% title(comp.label); +% xlabel([this.predictor.unitType, '[', this.predictor.unit, ']']); +% ylabel([comp.unitType, '[', comp.unit, ']']); +% +% if isObservable(comp); +% hold on; +% plot(comp.data); +% hold off; +% end +% +% xlim([this.predictor.val(1) this.predictor.val(end)]); \ No newline at end of file diff --git a/+AMF/@Model/plotAll.m b/+AMF/@Model/plotAll.m new file mode 100644 index 0000000..e7af686 --- /dev/null +++ b/+AMF/@Model/plotAll.m @@ -0,0 +1,10 @@ +function this = plotAll(this, type) + +comps = this.(type); +n = length(comps); +ns = sqrt(n); + +for i = 1:n + subplot(ceil(ns),ceil(ns),i); hold on; + plot(this, comps(i).name); +end \ No newline at end of file diff --git a/+AMF/@Model/randomizeData.m b/+AMF/@Model/randomizeData.m new file mode 100644 index 0000000..60ffa1a --- /dev/null +++ b/+AMF/@Model/randomizeData.m @@ -0,0 +1,10 @@ +function this = randomizeData(this) + +randomize(this.dataset); + +t = getTime(this); + +[idd, ids] = getInterpData(this.dataset, t, 'spline'); + +this.result.idd = idd; +this.result.ids = ids; \ No newline at end of file diff --git a/+AMF/@Model/randomizeParameters.m b/+AMF/@Model/randomizeParameters.m new file mode 100644 index 0000000..c0c4011 --- /dev/null +++ b/+AMF/@Model/randomizeParameters.m @@ -0,0 +1,15 @@ +function pcurr = randomizeParameters(this) + +np = length(this.fitParameters); + +smax = this.options.parScale(1); +smin = this.options.parScale(2); +pcurr = 10.^((smax-smin)*rand(np,1)+smin); + +for i = 1:np + this.fitParameters(i).init = pcurr(i); + this.fitParameters(i).curr = pcurr(i); +end + +this.result.pcurr = [this.parameters.init]; +this.result.pinit = [this.parameters.init]; \ No newline at end of file diff --git a/+AMF/@Model/saveTrajectory.m b/+AMF/@Model/saveTrajectory.m new file mode 100644 index 0000000..281d32b --- /dev/null +++ b/+AMF/@Model/saveTrajectory.m @@ -0,0 +1,19 @@ +function this = saveTrajectory(this) + +x = this.result.x; +v = this.result.v; +u = this.result.u; +p = this.result.p; + +for i = 1:length(this.states) + this.states(i).val = x(:,i); +end +for i = 1:length(this.reactions) + this.reactions(i).val = v(:,i); +end +for i = 1:length(this.inputs) + this.inputs(i).val = u(:,i); +end +for i = 1:length(this.fitParameters) + this.fitParameters(i).val = p(:,i); +end \ No newline at end of file diff --git a/+AMF/@Model/setFitParameters.m b/+AMF/@Model/setFitParameters.m new file mode 100644 index 0000000..98d7be6 --- /dev/null +++ b/+AMF/@Model/setFitParameters.m @@ -0,0 +1,14 @@ +function this = setFitParameters(this, t, p, ts) + +if nargin < 4, ts = 0; end + +for i = 1:length(this.fitParameters) + this.fitParameters(i).curr = p(:,i); +end +parseInputs(this); + +if ts > 0 + this.result.p(ts,:) = p; +else + this.result.p = p; +end \ No newline at end of file diff --git a/+AMF/@Model/setPredictor.m b/+AMF/@Model/setPredictor.m new file mode 100644 index 0000000..cac7a99 --- /dev/null +++ b/+AMF/@Model/setPredictor.m @@ -0,0 +1,4 @@ +function this = setPredictor(this, name) + +this.predictor = this.ref.(name); +% parseAll(this); \ No newline at end of file diff --git a/+AMF/@Model/setTimeStep.m b/+AMF/@Model/setTimeStep.m new file mode 100644 index 0000000..7803457 --- /dev/null +++ b/+AMF/@Model/setTimeStep.m @@ -0,0 +1,3 @@ +function this = setTimeStep(this, ts) + +this.currTimeStep = ts; \ No newline at end of file diff --git a/+AMF/@ModelComponent/ModelComponent.m b/+AMF/@ModelComponent/ModelComponent.m new file mode 100644 index 0000000..1dda02d --- /dev/null +++ b/+AMF/@ModelComponent/ModelComponent.m @@ -0,0 +1,45 @@ +classdef ModelComponent < handle + properties + index + name + expr + + % data + data + dataIdx + obs = 0 + dt + dd + ds + idd + ids + + % computed + time + init + prev + curr + val + + % meta + unitType + unit + label + end + methods + function this = ModelComponent(index, name, metaData) + this.index = index; + this.name = name; + +% this.data.field = []; +% this.data.val = []; +% this.data.std = []; + + if ~isempty(metaData) + this.unitType = metaData{1}; + this.unit = metaData{2}; + this.label = metaData{3}; + end + end + end +end \ No newline at end of file diff --git a/+AMF/@ModelComponent/filter.m b/+AMF/@ModelComponent/filter.m new file mode 100644 index 0000000..ddf172e --- /dev/null +++ b/+AMF/@ModelComponent/filter.m @@ -0,0 +1,4 @@ +function comps = filter(compArray, func) + +idx = logical(func(compArray)); +comps = compArray(idx); \ No newline at end of file diff --git a/+AMF/@ModelComponent/getStruct.m b/+AMF/@ModelComponent/getStruct.m new file mode 100644 index 0000000..9c3bd9e --- /dev/null +++ b/+AMF/@ModelComponent/getStruct.m @@ -0,0 +1,15 @@ +function s = getStruct(compArr) + +for i = 1:length(compArr) + comp = compArr(i); + + props = properties(comp); + for j = 1:length(props) + propName = props{j}; + s(i).(propName) = comp.(propName); + end + + if isa(s(i).data, 'AMF.DataField') + s(i).data = getStruct(s(i).data); + end +end \ No newline at end of file diff --git a/+AMF/@ModelComponent/isObservable.m b/+AMF/@ModelComponent/isObservable.m new file mode 100644 index 0000000..ca0d5d7 --- /dev/null +++ b/+AMF/@ModelComponent/isObservable.m @@ -0,0 +1,3 @@ +function filter = isObservable(compArray) + +filter = logical([compArray.obs]); \ No newline at end of file diff --git a/+AMF/@ModelComponent/plot.m b/+AMF/@ModelComponent/plot.m new file mode 100644 index 0000000..67ac027 --- /dev/null +++ b/+AMF/@ModelComponent/plot.m @@ -0,0 +1,3 @@ +function this = plot(this) + +plot(this.time, this.curr, 'b'); \ No newline at end of file diff --git a/+AMF/@ModelConstant/ModelConstant.m b/+AMF/@ModelConstant/ModelConstant.m new file mode 100644 index 0000000..cf7bc6f --- /dev/null +++ b/+AMF/@ModelConstant/ModelConstant.m @@ -0,0 +1,11 @@ +classdef ModelConstant < AMF.ModelComponent + properties + end + methods + function this = ModelConstant(index, name, expr, meta) + this = this@AMF.ModelComponent(index, name, meta); + + this.expr = expr; + end + end +end \ No newline at end of file diff --git a/+AMF/@ModelInput/ModelInput.m b/+AMF/@ModelInput/ModelInput.m new file mode 100644 index 0000000..a2bb691 --- /dev/null +++ b/+AMF/@ModelInput/ModelInput.m @@ -0,0 +1,24 @@ +classdef ModelInput < AMF.ModelComponent + properties + type + func + predictor + parameters + method + + initVal + initTime + + args + pidx + end + methods + function this = ModelInput(index, name, type, args, method, meta) + this = this@AMF.ModelComponent(index, name, meta); + + this.type = type; + this.args = args; + this.method = method; + end + end +end \ No newline at end of file diff --git a/+AMF/@ModelParameter/ModelParameter.m b/+AMF/@ModelParameter/ModelParameter.m new file mode 100644 index 0000000..0a0d5eb --- /dev/null +++ b/+AMF/@ModelParameter/ModelParameter.m @@ -0,0 +1,27 @@ +classdef ModelParameter < AMF.ModelComponent + properties + fit + lb + ub + end + methods + function this = ModelParameter(index, name, fit, expr, bnd, meta) + this = this@AMF.ModelComponent(index, name, meta); + + this.expr = expr; + if isa(expr, 'double') + this.init = expr; + end + + this.fit = fit; + + if isempty(bnd) + this.lb = 0; + this.ub = inf; + else + this.lb = bnd(1); + this.ub = bnd(2); + end + end + end +end \ No newline at end of file diff --git a/+AMF/@ModelParameter/isFitParameter.m b/+AMF/@ModelParameter/isFitParameter.m new file mode 100644 index 0000000..4e4c4a2 --- /dev/null +++ b/+AMF/@ModelParameter/isFitParameter.m @@ -0,0 +1,3 @@ +function filter = isFitParameter(compArray) + +filter = logical([compArray.fit]); \ No newline at end of file diff --git a/+AMF/@ModelPredictor/ModelPredictor.m b/+AMF/@ModelPredictor/ModelPredictor.m new file mode 100644 index 0000000..d762c12 --- /dev/null +++ b/+AMF/@ModelPredictor/ModelPredictor.m @@ -0,0 +1,11 @@ +classdef ModelPredictor < AMF.ModelComponent + properties + end + methods + function this = ModelPredictor(index, name, val, meta) + this = this@AMF.ModelComponent(index, name, meta); + + this.val = val(:); + end + end +end \ No newline at end of file diff --git a/+AMF/@ModelReaction/@ModelResult/ModelResult.m b/+AMF/@ModelReaction/@ModelResult/ModelResult.m new file mode 100644 index 0000000..8072d33 --- /dev/null +++ b/+AMF/@ModelReaction/@ModelResult/ModelResult.m @@ -0,0 +1,63 @@ +classdef ModelResult < handle + properties + predictor + constants + inputs + parameters + states + reactions + + time + sse + + options + end + methods + function this = ModelResult(result) + if isfield(result, 'error'); + this.sse = [result.error]; + end + + this.time = result(1).time(:); + this.options = result(1).options; + + this.predictor = result(1).predictor; + this.constants = result(1).constants; + this.inputs = result(1).inputs; + this.parameters = result(1).parameters; + this.states = result(1).states; + this.reactions = result(1).reactions; + + for i = 1:length(result) + for j = 1:length(this.parameters) + this.parameters(j).val(:,i) = result(i).parameters(j).val; + if ~isempty(this.parameters(j).data) + this.parameters(j).data.val(:,i) = result(i).parameters(j).data.val; + this.parameters(j).data.std(:,i) = result(i).parameters(j).data.std; + end + end + for j = 1:length(this.states) + this.states(j).val(:,i) = result(i).states(j).val; + if ~isempty(this.states(j).data) + this.states(j).data.val(:,i) = result(i).states(j).data.val; + this.states(j).data.std(:,i) = result(i).states(j).data.std; + end + end + for j = 1:length(this.reactions) + this.reactions(j).val(:,i) = result(i).reactions(j).val; + if ~isempty(this.reactions(j).data) + this.reactions(j).data.val(:,i) = result(i).reactions(j).data.val; + this.reactions(j).data.std(:,i) = result(i).reactions(j).data.std; + end + end + for j = 1:length(this.inputs) + this.inputs(j).val(:,i) = result(i).inputs(j).val; + if ~isempty(this.inputs(j).data) + this.inputs(j).data.val(:,i) = result(i).inputs(j).data.val; + this.inputs(j).data.std(:,i) = result(i).inputs(j).data.std; + end + end + end + end + end +end \ No newline at end of file diff --git a/+AMF/@ModelReaction/@ModelResult/plotStates.m b/+AMF/@ModelReaction/@ModelResult/plotStates.m new file mode 100644 index 0000000..675e909 --- /dev/null +++ b/+AMF/@ModelReaction/@ModelResult/plotStates.m @@ -0,0 +1,16 @@ +function this = plotStates(this) + +n = length(this.states); +r = sqrt(n); + +figure; + +for i = 1:n + subplot(floor(r), ceil(r), i); + state = this.states(i); + + t = this.time; + x = state.val; + + plot(t, x, 'r'); +end \ No newline at end of file diff --git a/+AMF/@ModelReaction/@ModelResult/plot_hist.m b/+AMF/@ModelReaction/@ModelResult/plot_hist.m new file mode 100644 index 0000000..40f96f6 --- /dev/null +++ b/+AMF/@ModelReaction/@ModelResult/plot_hist.m @@ -0,0 +1,18 @@ +function this = plot_hist(this, t, r, xlab, ylab, colors) +if strcmp(colors, 'blue') + cs = {[1 1 1] [0 0 0.8] [0 0 0.2]}; +elseif strcmp(colors, 'red') + cs = {[1 1 1] [0.8 0 0] [0.2 0 0]}; +end +cm = AMF.utils.define_custom_colormap(cs, 100); + +ny = 100; +[N,C] = AMF.utils.getHist(t,r',[],ny); +pcolor(C{1},C{2},N'); +shading flat; + +xlabel(xlab) +ylabel(ylab) +colormap(cm) +axis([min(C{1})-1 max(C{1})+1 min(C{2}) max(C{2})]) +end diff --git a/+AMF/@ModelReaction/@ModelResult/plot_states.m b/+AMF/@ModelReaction/@ModelResult/plot_states.m new file mode 100644 index 0000000..6cee0e7 --- /dev/null +++ b/+AMF/@ModelReaction/@ModelResult/plot_states.m @@ -0,0 +1,13 @@ +function plot_states(this) + +h3 = figure('Name','States'); + +numstates = size(this.states,2); +numsupls = ceil(sqrt(numstates)); + +for it = 1:numstates + subplot(numsupls,numsupls,it) + + val = this.states(it).val; + plot_hist(this,this.time, val, 'xlab', 'ylab', 'red'); +end \ No newline at end of file diff --git a/+AMF/@ModelReaction/@ModelResult/plot_states_norm.m b/+AMF/@ModelReaction/@ModelResult/plot_states_norm.m new file mode 100644 index 0000000..8b786ad --- /dev/null +++ b/+AMF/@ModelReaction/@ModelResult/plot_states_norm.m @@ -0,0 +1,2 @@ +function this = plot_states_norm(this) + diff --git a/+AMF/@ModelReaction/@ModelResult/plot_traj.m b/+AMF/@ModelReaction/@ModelResult/plot_traj.m new file mode 100644 index 0000000..f0aee1f --- /dev/null +++ b/+AMF/@ModelReaction/@ModelResult/plot_traj.m @@ -0,0 +1,21 @@ +function this = plot_traj(this, t, r, vals, xlab, ylab, colors) + +t = this.time; +r = + +if strcmp(colors, 'blue') + cs = {[0.6 0.6 0.8] [0 0 0.8] [0 0 0.2]}; +elseif strcmp(colors, 'red') + cs = {[0.8 0.6 0.6] [0.8 0 0] [0.2 0 0]}; +end +length_colormap = 101; +cm = AMF.utils.define_custom_colormap(cs, length_colormap); + + +for it=1:size(r,2) + plot(t, r(:,it), 'Color', cm(1+100-(round(vals(it)*100)),:)); + hold on +end +xlabel(xlab) +ylabel(ylab) +end \ No newline at end of file diff --git a/+AMF/@ModelReaction/@ModelResult/test.m b/+AMF/@ModelReaction/@ModelResult/test.m new file mode 100644 index 0000000..ebe4b4b --- /dev/null +++ b/+AMF/@ModelReaction/@ModelResult/test.m @@ -0,0 +1,3 @@ +function this = test(this) + +disp('KAAAAAA'); \ No newline at end of file diff --git a/+AMF/@ModelReaction/ModelReaction.m b/+AMF/@ModelReaction/ModelReaction.m new file mode 100644 index 0000000..c4516e1 --- /dev/null +++ b/+AMF/@ModelReaction/ModelReaction.m @@ -0,0 +1,11 @@ +classdef ModelReaction < AMF.ModelComponent + properties + end + methods + function this = ModelReaction(index, name, expr, meta) + this = this@AMF.ModelComponent(index, name, meta); + + this.expr = expr; + end + end +end \ No newline at end of file diff --git a/+AMF/@ModelResult/ModelResult.m b/+AMF/@ModelResult/ModelResult.m new file mode 100644 index 0000000..126e64b --- /dev/null +++ b/+AMF/@ModelResult/ModelResult.m @@ -0,0 +1,106 @@ +classdef ModelResult < handle + properties + predictor + states + constants + reactions + inputs + parameters + + sse + result + time + mStruct + options + + ref = struct() + end + methods + function this = ModelResult(model, result) + this.result = result; + this.time = result(1).time; + this.sse = [result.sse]; + this.mStruct = getInputStructMex(model); + this.options = model.options; + + this.predictor = getStruct(model.predictor); + if ~isempty(model.states), this.states = getStruct(model.states); end + if ~isempty(model.constants), this.constants = getStruct(model.constants); end + if ~isempty(model.reactions), this.reactions = getStruct(model.reactions); end + if ~isempty(model.inputs), this.inputs = getStruct(model.inputs); end + if ~isempty(model.parameters), this.parameters = getStruct(model.parameters); end + + for i = 1:length(this.result) + for j = 1:length(this.states) + this.states(j).val(:,i) = this.result(i).x(:,j); + + if this.states(j).obs + oxi = double(this.result(1).oxi); + oxi(logical(oxi)) = this.result(1).oxdi; + oxdi = oxi(j); + if i == 1 + dt = this.result(i).dt; % fit time + dd = this.result(i).dd(:,oxdi); % data val + ds = this.result(i).ds(:,oxdi); % data std + + this.states(j).dt = dt(~isnan(dd)); + this.states(j).dd = dd(~isnan(dd)); + this.states(j).ds = ds(~isnan(dd)); + end + + if ~isempty(this.result(i).idd) + idd = this.result(i).idd(:,oxdi); + ids = this.result(i).ids(:,oxdi); + + this.states(j).idd(:,i) = idd; + this.states(j).ids(:,i) = ids; + end + end + + this.ref.(this.states(j).name) = this.states(j); + end + for j = 1:length(this.reactions) + this.reactions(j).val(:,i) = this.result(i).v(:,j); + + if this.reactions(j).obs + ofi = double(this.result(1).ofi); + ofi(logical(ofi)) = this.result(1).ofdi; + ofdi = ofi(j); + if i == 1 + dt = this.result(i).dt; % fit time + dd = this.result(i).dd(:,ofdi); % data val + ds = this.result(i).ds(:,ofdi); % data std + + this.reactions(j).dt = dt(~isnan(dd)); + this.reactions(j).dd = dd(~isnan(dd)); + this.reactions(j).ds = ds(~isnan(dd)); + end + + if ~isempty(this.result(i).idd) + idd = this.result(i).idd(:,ofdi); + ids = this.result(i).ids(:,ofdi); + + this.reactions(j).idd(:,i) = idd; + this.reactions(j).ids(:,i) = ids; + end + end + + this.ref.(this.reactions(j).name) = this.reactions(j); + end + for j = 1:length(this.inputs) + this.inputs(j).val(:,i) = this.result(i).u(:,j); + + this.ref.(this.inputs(j).name) = this.inputs(j); + end + for j = 1:length(this.parameters) + this.parameters(j).val(:,i) = this.result(i).p(:,j); + + this.ref.(this.parameters(j).name) = this.parameters(j); + end + for j = 1:length(this.constants) + this.ref.(this.constants(j).name) = this.constants(j); + end + end + end + end +end \ No newline at end of file diff --git a/+AMF/@ModelResult/getColorProfile.m b/+AMF/@ModelResult/getColorProfile.m new file mode 100644 index 0000000..e69de29 diff --git a/+AMF/@ModelResult/getValue.m b/+AMF/@ModelResult/getValue.m new file mode 100644 index 0000000..b08a99b --- /dev/null +++ b/+AMF/@ModelResult/getValue.m @@ -0,0 +1,8 @@ +function val = getValue(this, name, i) + +if nargin < 3, i = 0; end + +val = this.ref.(name).val; +if i > 0 + val = val(i,:); +end \ No newline at end of file diff --git a/AMF/+AMF/@ModelResult/plot.m b/+AMF/@ModelResult/plot.m similarity index 100% rename from AMF/+AMF/@ModelResult/plot.m rename to +AMF/@ModelResult/plot.m diff --git a/+AMF/@ModelResult/plotAll.m b/+AMF/@ModelResult/plotAll.m new file mode 100644 index 0000000..c2792a1 --- /dev/null +++ b/+AMF/@ModelResult/plotAll.m @@ -0,0 +1,55 @@ +function this = plotAll(this, type, mode) + +if nargin < 3, mode = 'TRAJ'; end + +import AMF.utils.defineCustomColormap + +comps = this.(type); +if strcmpi(type, 'PARAMETERS') + comps = comps(logical([this.parameters.fit])); +end + +n = length(comps); +ns = sqrt(n); + +numIter = this.options.numIter; + +figure('Name', upper(type)); + +for i = 1:n + subplot(ceil(ns),ceil(ns),i); hold on; + + comp = comps(i); + + switch upper(mode) + case 'TRAJ' + colorMap = defineCustomColormap({[0.8 0.6 0.6] [0.8 0 0] [0.2 0 0]}, numIter); + plotTraj(this, comp, colorMap); + + case 'HIST' + colorMap = defineCustomColormap({[1 1 1] [0.8 0 0] [0.2 0 0]}, numIter); + plotHist(this, comp, colorMap); + + case 'HIST_LOG' + + % TODO: plot logarithmic histograms + + otherwise + error('Unknown plot mode %s', mode); + end + + xlabel([this.predictor.unitType, ' [', this.predictor.unit, ']']); + xlim([this.time(1) this.time(end)]); + + if comp.label + title(comp.label); + else + title(comp.name); + end + + if comp.unit + ylabel(sprintf('%s [%s]', comp.unitType, comp.unit)); + else + ylabel(comp.unitType); + end +end \ No newline at end of file diff --git a/+AMF/@ModelResult/plotHist.m b/+AMF/@ModelResult/plotHist.m new file mode 100644 index 0000000..259f60e --- /dev/null +++ b/+AMF/@ModelResult/plotHist.m @@ -0,0 +1,14 @@ +function this = plotHist(this, comp, colorMap) + +ny = round(length(this.time) / 2); % proper bin count ?? + +[N,C] = AMF.utils.getHist(this.time,comp.val',[],ny); +pcolor(C{1},C{2},N'); +shading flat; + +colormap(colorMap); +axis([min(C{1})-1 max(C{1})+1 min(C{2}) max(C{2})]) + +if comp.obs + errorbar(comp.dt, comp.dd, comp.ds, 'k--', 'LineWidth', 2); +end \ No newline at end of file diff --git a/+AMF/@ModelResult/plotTraj.m b/+AMF/@ModelResult/plotTraj.m new file mode 100644 index 0000000..0900140 --- /dev/null +++ b/+AMF/@ModelResult/plotTraj.m @@ -0,0 +1,22 @@ +function plotTraj(this, comp, colorMap) + +import AMF.utils.defineCustomColormap + +[~, sseIdx] = sort(sum(this.sse), 'descend'); + +numIter = length(this.result); + +for it = 1:numIter + itIdx = sseIdx(it); + if numIter == 1 + plotColor = [1 0 0]; + else + plotColor = colorMap(it,:); + end + + plot(this.time, comp.val(:,itIdx), 'Color', plotColor); +end + +if comp.obs + errorbar(comp.dt, comp.dd, comp.ds, 'k--', 'LineWidth', 2); +end \ No newline at end of file diff --git a/+AMF/@ModelState/ModelState.m b/+AMF/@ModelState/ModelState.m new file mode 100644 index 0000000..6f2a049 --- /dev/null +++ b/+AMF/@ModelState/ModelState.m @@ -0,0 +1,19 @@ +classdef ModelState < AMF.ModelComponent + properties + derivedODE + compiledODE + initExpr + end + methods + function this = ModelState(index, name, init, expr, meta) + this = this@AMF.ModelComponent(index, name, meta); + + this.expr = expr; + this.initExpr = init; + + if isa(this.initExpr, 'double') + this.init = init; + end + end + end +end \ No newline at end of file diff --git a/+AMF/createDataset.m b/+AMF/createDataset.m new file mode 100644 index 0000000..8f8b73c --- /dev/null +++ b/+AMF/createDataset.m @@ -0,0 +1,54 @@ +function dataset = createDataset(dataFile) + +import AMF.* + +specification = feval(dataFile); + +if isfield(specification, 'DESCRIPTION') + description = specification.DESCRIPTION; +else + description = []; +end + +if isfield(specification, 'TYPE') + type = specification.TYPE; +else + type = []; +end + +if ~isfield(specification, 'GROUPS') + error('A dataset requires at least one group.'); +end + +groups = specification.GROUPS; + +if ~isfield(specification, 'FILE') + error('A dataset requires a MAT file containing the experimental data values.'); +end + +data = load([specification.FILE, '.mat']); + +if isfield(specification, 'FIELDS') + spec = specification.FIELDS; + + fields = AMF.DataField.empty; + for i = 1:size(spec, 1) + args = spec(i, :); + fields(i) = AMF.DataField(i, args{:}); + end +else + error('A dataset requires at least one defined data field.'); +end + +if isfield(specification, 'FUNCTIONS') + spec = specification.FUNCTIONS; + + functions = AMF.DataFunction.empty; + for i = 1:size(spec, 1) + args = spec(i,:); + functions(i) = AMF.DataFunction(i, args{:}); + end +end + +dataset.a = fields; +dataset.f = functions; \ No newline at end of file diff --git a/+AMF/fit.m b/+AMF/fit.m new file mode 100644 index 0000000..e14f1e9 --- /dev/null +++ b/+AMF/fit.m @@ -0,0 +1,69 @@ +function result = fit(model) + +import AMF.* + +model.time = getFitTime(model.dataset); +t = model.time; +model.result.time = t; + +model.result.pidx = logical([model.parameters.fit]); +model.result.pcurr = [model.parameters.init]; + +lb = [model.fitParameters.lb]; +ub = [model.fitParameters.ub]; + +p0 = [model.fitParameters.init]; +x0 = [model.states.init]; + +tic +[~, sse, ~] = lsqnonlin(@objectiveFunction,(p0),lb,ub,model.options.optimset, model,t,x0); +toc + +model.result.p = model.result.pcurr; +model.result.x = model.result.xcurr; +model.result.v = model.result.vcurr; +model.result.sse = sse; + +if ~isempty(model.inputs) + uvec = model.result.uvec; + uvec(model.result.uidx) = model.result.pcurr(model.result.upidx); + + model.result.u = computeInputs(model, t, uvec); +end + +result = ModelResult(model, model.result); + +function error = objectiveFunction(pest, model, t, x0) + +model.result.pcurr(model.result.pidx) = pest; +p = model.result.pcurr; + +uvec = model.result.uvec; +uvec(model.result.uidx) = model.result.pcurr(model.result.upidx); + +x = computeStates(model, t, x0, p, uvec); +v = computeReactions(model, t, x, p, uvec); + +model.result.xcurr = x; +model.result.vcurr = v; + +ox = x(:,model.result.oxi); +of = v(:,model.result.ofi); + +sim = [ox of]; + +odi = [model.result.oxdi model.result.ofdi]; + +dat = model.result.dd(:,odi); +sd = model.result.ds(:,odi); + +error = (sim(:) - dat(:)) ./ sd(:); + +error = [error;zeros(length(p), 1)]; + +if ~isempty(model.functions.reg) + error = [error; model.functions.reg(model, model.iStruct, model.dStruct)]; +end + +error = error(~isnan(error)); +error = error(~isinf(error)); \ No newline at end of file diff --git a/+AMF/fitTimeStep.m b/+AMF/fitTimeStep.m new file mode 100644 index 0000000..01d54e7 --- /dev/null +++ b/+AMF/fitTimeStep.m @@ -0,0 +1,64 @@ +function [pest, sse, resid] = fitTimeStep(model, ts) + +setTimeStep(model, ts); + +model.result.pprev = model.result.pcurr; + +x0 = model.result.xcurr; +p0 = model.result.pcurr(model.result.pidx); +lb = model.result.lb(model.result.pidx); +ub = model.result.ub(model.result.pidx); + +t = getTime(model, ts); + +[pest, sse, resid] = lsqnonlin(@objectiveFunction,(p0),lb,ub,model.options.optimset, model,x0,t,ts); + +model.result.p(ts,:) = model.result.pcurr; +model.result.x(ts,:) = model.result.xcurr; +model.result.v(ts,:) = model.result.vcurr; +model.result.sse(ts) = sse; + +if ~isempty(model.inputs) + uvec = model.result.uvec; + uvec(model.result.uidx) = model.result.pcurr(model.result.upidx); + + model.result.u(ts,:) = computeInputs(model, t(end), uvec); +end + +function error = objectiveFunction(pest, model, x0, t, ts) + +model.result.pcurr(model.result.pidx) = pest; +p = model.result.pcurr; + +uvec = model.result.uvec; +uvec(model.result.uidx) = model.result.pcurr(model.result.upidx); + +x = computeStates(model, t, x0, p, uvec); +v = computeReactions(model, t(end), x(end,:), p, uvec); + +model.result.xcurr = x(end,:); +model.result.vcurr = v; + +ox = model.result.xcurr(model.result.oxi); +of = model.result.vcurr(model.result.ofi); + +sim = [ox of]; + +odi = [model.result.oxdi model.result.ofdi]; + +dat = model.result.idd(ts,odi); +sd = model.result.ids(ts,odi); + +error = (sim(:) - dat(:)) ./ sd(:); + +error = [error;zeros(length(p), 1)]; + +reg = AMF.regFun(model, t); +error = [error;reg(:)]; + +if ~isempty(model.functions.reg) + error = [error; model.functions.reg(model, model.iStruct, model.dStruct)]; +end + +error(isnan(error)) = 0; +error(isinf(error)) = 0; \ No newline at end of file diff --git a/+AMF/manipulate.m b/+AMF/manipulate.m new file mode 100644 index 0000000..024df47 --- /dev/null +++ b/+AMF/manipulate.m @@ -0,0 +1,31 @@ +function ui = manipulate(model, compName) + + +import AMF.* + +ui = GridUI; + +params = getAll(model, 'parameters'); +for i = 1:length(params) + p = params(i); + ui.draw(p.name, 'EDIT', [i, 1], [1, 6], model.result.pcurr(p.index), {@update, model, compName}); +end + +ui.draw('ax1', 'AXES', [1, 8], [20, 25], 0, []); + +render(ui); +update(ui, model, compName); + +function update(ui, model, compName) + +import AMF.* + +params = getAll(model, 'parameters'); +for i = 1:length(params) + p = params(i); + model.result.pcurr(p.index) = ui.controls.(p.name).value; +end + +result = simulate(model); +cla; +plot(result, compName); \ No newline at end of file diff --git a/+AMF/proflik.m b/+AMF/proflik.m new file mode 100644 index 0000000..1943134 --- /dev/null +++ b/+AMF/proflik.m @@ -0,0 +1,56 @@ +function [val, chi2] = proflik(model, pName, frac, alpha) + +import AMF.* + +[~, sse] = fit(model); + +p = model.ref.(pName); +p.fit = 0; +parseParameters(model); + +popt = p.curr; + +val(1) = popt; +chi2(1) = sse; + +ref = chi2pdf(1-alpha, 1); + +rat = -inf; +ctr = 2; +while rat <= ref + p.curr = popt * (1+frac*(ctr-1)); disp(p.curr); + [~, sse] = fit(model); + val = [val p.curr]; + chi2 = [chi2 sse]; + + rat = 2 * log10(sse / chi2(1)); % ??? + ctr = ctr + 1; +end + +rat = -inf; +ctr = 2; +while rat <= ref + p.curr = popt * (1-frac*(ctr-1)); disp(p.curr); + [~, sse] = fit(model); + val = [val p.curr]; + chi2 = [chi2 sse]; + + rat = 2 * log(sse / chi2(1)); % ??? + ctr = ctr + 1; +end + +p.fit = 1; +parseParameters(model); + +[val, idx] = sort(val); +chi2 = chi2(idx); + +% display +figure; +plot(val, chi2, 'r'); +hold on; +[~, idx] = min(chi2); +plot(val(idx), chi2(idx), 'kx', 'MarkerSize', 10, 'LineWidth', 2); + +xlabel(p.name); +ylabel('chi2'); \ No newline at end of file diff --git a/+AMF/regFun.m b/+AMF/regFun.m new file mode 100644 index 0000000..e1d25f9 --- /dev/null +++ b/+AMF/regFun.m @@ -0,0 +1,14 @@ +function reg = regFun(model, t) + +lab1 = model.options.lab1; +pcurr = model.result.pcurr; +pprev = model.result.pprev; +pinit = model.result.pinit; + +dt = t(end) - t(1); + +if t(end) == 0 + reg = zeros(1, length(pcurr)); +else + reg = (pcurr - pprev) ./ pinit ./ dt * lab1; +end \ No newline at end of file diff --git a/+AMF/runADAPT.asv b/+AMF/runADAPT.asv new file mode 100644 index 0000000..9afbd23 --- /dev/null +++ b/+AMF/runADAPT.asv @@ -0,0 +1,54 @@ +function modelResult = runADAPT(model) + +import AMF.* + +model.time = getTime(model); + +seed = model.options.seed; +numIter = model.options.numIter; + +% if isempty(model.functions.reg) +% model.functions.reg = @regFun; +% end + +rng('default'); rng(seed); + +t = getTime(model); + +tic + +result = getResult(model); +result.error = 0; + +parfor it = 1:numIter + randomizeParameters(model); + randomizeData(model); + initializeObservables(model); + + parseAll(model); + + error = zeros(size(t)); + for ts = 1:length(t) + setTimeStep(model, ts); + [~, sse, ~] = fitTimeStep(model, ts); + + error(ts) = sse; + end + + saveTrajectory(model); + + itResult = getResult(model); + itResult.error = error(:); + + result(it) = itResult; + + fprintf('Computed trajectory %d [%d]\n', it, max(error)); +end + +resultStr = sprintf('%s_%s_%d_%d', model.options.savePrefix, model.name, model.options.numIter, model.options.numTimeSteps); +save([model.resultsDir, resultStr], 'result'); + +% modelResult = ModelResult(result); + + +toc \ No newline at end of file diff --git a/+AMF/runADAPT.m b/+AMF/runADAPT.m new file mode 100644 index 0000000..42224c8 --- /dev/null +++ b/+AMF/runADAPT.m @@ -0,0 +1,63 @@ +function result = runADAPT(model) + +import AMF.* + +model.time = getTime(model); +t = model.time; + +seed = model.options.seed; +numIter = model.options.numIter; + +rng('default'); rng(seed); + +% interpolate data (not randomized) + +[idd, ids] = getInterpData(model.dataset, t); +model.result.idd = idd; +model.result.ids = ids; + +% pre-allocate +model.result.p = zeros(length(t), length(model.parameters)); +model.result.x = zeros(length(t), length(model.states)); +model.result.u = zeros(length(t), length(model.inputs)); +model.result.v = zeros(length(t), length(model.reactions)); +model.result.sse = zeros(length(t), 1); +model.result.time = t; + +result = model.result; + +tic +parfor it = 1:numIter + model2 = model; % parfor fix + elt = 0; + + success = 0; + while ~success + try + if model.options.randPars, randomizeParameters(model2); end + if model.options.randData, randomizeData(model2); end + + parseAll(model2); + + tic + for ts = 1:length(t) + fitTimeStep(model2, ts); + end + elt = toc; + + success = 1; + catch err + % + end + end + + fprintf('Computed trajectory %d [%d] - %.2fs\n', it, max(model2.result.sse), elt); + + result(it) = model2.result; +end +toc + +result = AMF.ModelResult(model, result); + +resultStr = sprintf('%s_%s_%s__%d_%d', model.options.savePrefix, model.name, model.dataset.activeGroup, model.options.numIter, model.options.numTimeSteps); +save([model.resultsDir, resultStr], 'result'); \ No newline at end of file diff --git a/+AMF/simulate.m b/+AMF/simulate.m new file mode 100644 index 0000000..34d51a0 --- /dev/null +++ b/+AMF/simulate.m @@ -0,0 +1,25 @@ +function result = simulate(model) + +model.time = getTime(model); +t = model.time; + +x0 = model.result.xinit; +p = model.result.pcurr; + +if ~isempty(model.inputs) + uvec = model.result.uvec; + uvec(model.result.uidx) = model.result.pcurr(model.result.upidx); + + model.result.u = computeInputs(model, t, uvec); +else + uvec = []; +end + +model.result.p = p; +model.result.x = computeStates(model, t, x0, p, uvec); +model.result.xcurr = model.result.x; +model.result.v = computeReactions(model, t, model.result.x, p, uvec); +model.result.vcurr = model.result.v; +model.result.time = t; + +result = AMF.ModelResult(model, model.result); \ No newline at end of file diff --git a/AMF/+AMF/+utils/parfor_progress.m b/AMF/+AMF/+utils/parfor_progress.m new file mode 100644 index 0000000..07ec991 --- /dev/null +++ b/AMF/+AMF/+utils/parfor_progress.m @@ -0,0 +1,82 @@ +function percent = parfor_progress(N) +%PARFOR_PROGRESS Progress monitor (progress bar) that works with parfor. +% PARFOR_PROGRESS works by creating a file called parfor_progress.txt in +% your working directory, and then keeping track of the parfor loop's +% progress within that file. This workaround is necessary because parfor +% workers cannot communicate with one another so there is no simple way +% to know which iterations have finished and which haven't. +% +% PARFOR_PROGRESS(N) initializes the progress monitor for a set of N +% upcoming calculations. +% +% PARFOR_PROGRESS updates the progress inside your parfor loop and +% displays an updated progress bar. +% +% PARFOR_PROGRESS(0) deletes parfor_progress.txt and finalizes progress +% bar. +% +% To suppress output from any of these functions, just ask for a return +% variable from the function calls, like PERCENT = PARFOR_PROGRESS which +% returns the percentage of completion. +% +% Example: +% +% N = 100; +% parfor_progress(N); +% parfor i=1:N +% pause(rand); % Replace with real code +% parfor_progress; +% end +% parfor_progress(0); +% +% See also PARFOR. + +% By Jeremy Scheff - jdscheff@gmail.com - http://www.jeremyscheff.com/ + +% error(nargchk(0, 1, nargin, 'struct')); + +if nargin < 1 + N = -1; +end + +percent = 0; +w = 50; % Width of progress bar + +if N > 0 + f = fopen('parfor_progress.txt', 'w'); + if f<0 + error('Do you have write permissions for %s?', pwd); + end + fprintf(f, '%d\n', N); % Save N at the top of progress.txt + fclose(f); + + if nargout == 0 + disp([' 0%[>', repmat(' ', 1, w), ']']); + end +elseif N == 0 + delete('parfor_progress.txt'); + percent = 100; + + if nargout == 0 + disp([repmat(char(8), 1, (w+9)), char(10), '100%[', repmat('=', 1, w+1), ']']); + end +else + + if ~exist('parfor_progress.txt', 'file') + error('parfor_progress.txt not found. Run PARFOR_PROGRESS(N) before PARFOR_PROGRESS to initialize parfor_progress.txt.'); + end + + f = fopen('parfor_progress.txt', 'a'); + fprintf(f, '1\n'); + fclose(f); + + f = fopen('parfor_progress.txt', 'r'); + progress = fscanf(f, '%d'); + fclose(f); + percent = (length(progress)-1)/progress(1)*100; + + if nargout == 0 + perc = sprintf('%3.0f%%', percent); % 4 characters wide, percentage + disp([repmat(char(8), 1, (w+9)), char(10), perc, '[', repmat('=', 1, round(percent*w/100)), '>', repmat(' ', 1, w - round(percent*w/100)), ']']); + end +end diff --git a/AMF/+AMF/+utils/parfor_progress2.m b/AMF/+AMF/+utils/parfor_progress2.m new file mode 100644 index 0000000..2335bb6 --- /dev/null +++ b/AMF/+AMF/+utils/parfor_progress2.m @@ -0,0 +1,82 @@ +function percent = parfor_progress2(N) +%PARFOR_PROGRESS Progress monitor (progress bar) that works with parfor. +% PARFOR_PROGRESS works by creating a file called parfor_progress.txt in +% your working directory, and then keeping track of the parfor loop's +% progress within that file. This workaround is necessary because parfor +% workers cannot communicate with one another so there is no simple way +% to know which iterations have finished and which haven't. +% +% PARFOR_PROGRESS(N) initializes the progress monitor for a set of N +% upcoming calculations. +% +% PARFOR_PROGRESS updates the progress inside your parfor loop and +% displays an updated progress bar. +% +% PARFOR_PROGRESS(0) deletes parfor_progress.txt and finalizes progress +% bar. +% +% To suppress output from any of these functions, just ask for a return +% variable from the function calls, like PERCENT = PARFOR_PROGRESS which +% returns the percentage of completion. +% +% Example: +% +% N = 100; +% parfor_progress(N); +% parfor i=1:N +% pause(rand); % Replace with real code +% parfor_progress; +% end +% parfor_progress(0); +% +% See also PARFOR. + +% By Jeremy Scheff - jdscheff@gmail.com - http://www.jeremyscheff.com/ + +% error(nargchk(0, 1, nargin, 'struct')); + +if nargin < 1 + N = -1; +end + +percent = 0; +w = 50; % Width of progress bar + +if N > 0 + f = fopen('parfor_progress.txt', 'w'); + if f<0 + error('Do you have write permissions for %s?', pwd); + end + fprintf(f, '%d\n', N); % Save N at the top of progress.txt + fclose(f); + + if nargout == 0 + disp([' 0%[>', repmat(' ', 1, w), ']']); + end +elseif N == 0 + delete('parfor_progress.txt'); + percent = 100; + + if nargout == 0 + disp([repmat(char(8), 1, (w+9)), char(10), '100%[', repmat('=', 1, w+1), ']']); + end +else + + if ~exist('parfor_progress.txt', 'file') + error('parfor_progress.txt not found. Run PARFOR_PROGRESS(N) before PARFOR_PROGRESS to initialize parfor_progress.txt.'); + end + +% f = fopen('parfor_progress.txt', 'a'); +% fprintf(f, '1\n'); +% fclose(f); + + f = fopen('parfor_progress.txt', 'r'); + progress = fscanf(f, '%d'); + fclose(f); + percent = (length(progress)-1)/progress(1)*100; + + if nargout == 0 + perc = sprintf('%3.0f%%', percent); % 4 characters wide, percentage + disp([perc, '[', repmat('=', 1, round(percent*w/100)), '>', repmat(' ', 1, w - round(percent*w/100)), ']']); + end +end diff --git a/AMF/+AMF/@ModelResult/plotAll.m b/AMF/+AMF/@ModelResult/plotAll.m index c2792a1..cbd97f3 100644 --- a/AMF/+AMF/@ModelResult/plotAll.m +++ b/AMF/+AMF/@ModelResult/plotAll.m @@ -1,6 +1,14 @@ -function this = plotAll(this, type, mode) +function this = plotAll(this, type, varargin) -if nargin < 3, mode = 'TRAJ'; end +if nargin < 3, mode = 'TRAJ'; +else mode = varargin{1}; +end + +if length(varargin)>1 + split = varargin{2}; +else + split = 9; +end import AMF.utils.defineCustomColormap @@ -9,15 +17,20 @@ comps = comps(logical([this.parameters.fit])); end + n = length(comps); -ns = sqrt(n); +ns = sqrt(split); +% ns = sqrt(n); numIter = this.options.numIter; figure('Name', upper(type)); for i = 1:n - subplot(ceil(ns),ceil(ns),i); hold on; + figure(ceil(i/split)); + counter = ceil(i/split); + subplot(ceil(ns),ceil(ns),i-(counter-1)*split); hold on; +% subplot(ceil(ns),ceil(ns),i); hold on; comp = comps(i); @@ -31,9 +44,10 @@ plotHist(this, comp, colorMap); case 'HIST_LOG' - - % TODO: plot logarithmic histograms - + % TODO: plot logarithmic histograms + case 'MAD' % median absolute deviation + plotMad(this, comp, 'g'); + otherwise error('Unknown plot mode %s', mode); end diff --git a/AMF/+AMF/@ModelResult/plotMad.m b/AMF/+AMF/@ModelResult/plotMad.m new file mode 100644 index 0000000..0bc42ce --- /dev/null +++ b/AMF/+AMF/@ModelResult/plotMad.m @@ -0,0 +1,22 @@ +function [hp1, hp2] = plotMad(this, comp, color) +% plot median absolute deviation +time_steps = this.options.numTimeSteps; +meta = zeros(time_steps,4); +for dt = 1:time_steps + y = quantile(comp.val(dt,:),[0.05 0.16 0.25 0.5 0.75 0.84 0.95], 2); + meta(dt,1) = y(4); + meta(dt,2) = median(abs(comp.val(dt,:)- meta(dt,1))); + meta(dt,3) = meta(dt,1)+meta(dt,2); + meta(dt,4) = meta(dt,1)-meta(dt,2); +end +time = 1:time_steps; +time = time*this.time(end)/time_steps; +X = [time fliplr(time)]; +Yupp = meta(:,3)'; +Ylwr = meta(:,4)'; +Y = [Ylwr fliplr(Yupp)]; +hp1 = fill(X, Y, color); +hp2 = plot(time, meta(:,1), '-k', 'LineWidth', 2); + +end + diff --git a/AMF/+AMF/@ModelResult/plots.m b/AMF/+AMF/@ModelResult/plots.m new file mode 100644 index 0000000..8ded1a4 --- /dev/null +++ b/AMF/+AMF/@ModelResult/plots.m @@ -0,0 +1,71 @@ +function this = plots(this, names, mode) + +if nargin < 3, mode = 'TRAJ'; end + +import AMF.utils.defineCustomColormap + +if isa(names, 'char') + names = {names}; +end + +n = length(names); +ns = sqrt(n); + +numIter = this.options.numIter; + +for i = 1:length(names) + subplot(ceil(ns),ceil(ns),i); hold on; + name = names{i}; + + comp = this.ref.(name); + + switch upper(mode) + case 'TRAJ' + colorMap = defineCustomColormap({[0.8 0.6 0.6] [0.8 0 0] [0.2 0 0]}, numIter); + plotTraj(this, comp, colorMap); + + case 'HIST' + colorMap = defineCustomColormap({[1 1 1] [0.8 0 0] [0.2 0 0]}, numIter); + plotHist(this, comp, colorMap); + + case 'HIST_LOG' + + % TODO: plot logarithmic histograms + case 'MAD' % median absolute deviation + time_steps = this.options.numTimeSteps; + meta = zeros(time_steps,4); + for dt = 1:time_steps + y = quantile(comp.val(dt,:),[0.05 0.16 0.25 0.5 0.75 0.84 0.95], 2); + meta(dt,1) = y(4); + meta(dt,2) = median(abs(comp.val(dt,:)- meta(dt,1))); + meta(dt,3) = meta(dt,1)+meta(dt,2); + meta(dt,4) = meta(dt,1)-meta(dt,2); + end + time = 1:time_steps; + time = time*this.time(end)/time_steps; + X = [time fliplr(time)]; + Yupp = meta(:,3)'; + Ylwr = meta(:,4)'; + Y = [Ylwr fliplr(Yupp)]; + hp = fill(X, Y, 'g'); + plot(time, meta(:,1), '-k', 'LineWidth', 2); + + otherwise + error('Unknown plot mode %s', mode); + end + + xlabel([this.predictor.unitType, ' [', this.predictor.unit, ']']); + xlim([this.time(1) this.time(end)]); + + if comp.label + title(comp.label); + else + title(comp.name); + end + + if comp.unit + ylabel(sprintf('%s [%s]', comp.unitType, comp.unit)); + else + ylabel(comp.unitType); + end +end \ No newline at end of file diff --git a/AMF/+AMF/runADAPT.m b/AMF/+AMF/runADAPT.m index 42224c8..7ca3d88 100644 --- a/AMF/+AMF/runADAPT.m +++ b/AMF/+AMF/runADAPT.m @@ -27,6 +27,7 @@ result = model.result; tic +utils.parfor_progress(numIter); parfor it = 1:numIter model2 = model; % parfor fix elt = 0; @@ -47,14 +48,17 @@ success = 1; catch err - % + disp(err.message); + utils.parfor_progress2; end end + utils.parfor_progress; - fprintf('Computed trajectory %d [%d] - %.2fs\n', it, max(model2.result.sse), elt); +% fprintf('Computed trajectory %d [%d] - %.2fs\n', it, max(model2.result.sse), elt); result(it) = model2.result; end +parfor_progress(0); toc result = AMF.ModelResult(model, result); diff --git a/AMF/models/dietModel/Hall/BW.emf b/AMF/models/dietModel/Hall/BW.emf new file mode 100644 index 0000000..5e27a8c Binary files /dev/null and b/AMF/models/dietModel/Hall/BW.emf differ diff --git a/AMF/models/dietModel/Hall/Hall.emf b/AMF/models/dietModel/Hall/Hall.emf new file mode 100644 index 0000000..88d01e0 Binary files /dev/null and b/AMF/models/dietModel/Hall/Hall.emf differ diff --git a/AMF/models/dietModel/Hall/Hall.m b/AMF/models/dietModel/Hall/Hall.m new file mode 100644 index 0000000..5d5f77d --- /dev/null +++ b/AMF/models/dietModel/Hall/Hall.m @@ -0,0 +1,9 @@ +function EE = Hall(t, dEI ) +%Energy Expenditure in mice according to Hall +LM = 25; +FM = -0.0649.*t.^2 + 2.0961.*t + 2.5263; + +EE = 2.1 + 0.331.*LM + 0.202.*FM + 0.4.*dEI; + +end + diff --git a/AMF/models/dietModel/Hall/Hall1.emf b/AMF/models/dietModel/Hall/Hall1.emf new file mode 100644 index 0000000..00418df Binary files /dev/null and b/AMF/models/dietModel/Hall/Hall1.emf differ diff --git a/AMF/models/dietModel/Hall/bw_fit.m b/AMF/models/dietModel/Hall/bw_fit.m new file mode 100644 index 0000000..7a0d333 --- /dev/null +++ b/AMF/models/dietModel/Hall/bw_fit.m @@ -0,0 +1,21 @@ +% Fit body weight data + +time = diets.t3/(24*7); % weeks HFD +TG = diets.perTG_m*853/1e6; % g TG + +% fit to polynomial +p = polyfit(time, TG, 2); % -0.0649*x^2 + 2.0961*x + 2.5263 + +% plot polynomial and data +x1 = linspace(0, 12, 100); +y1 = polyval(p,x1); + +figure(1);hold on; +plot(time, TG, 'ok', x1, y1, '-k', 'LineWidth', 2); +xlabel('Time on HFD (weeks)'); +ylabel('Body TG (g)'); +saveas(1, 'BW.emf'); + +% slope at t= 3 = 1.7067 g TG/week +% slope at t=10 = 0.7981 g TG/week + diff --git a/AMF/models/dietModel/Hall/hall_plot.m b/AMF/models/dietModel/Hall/hall_plot.m new file mode 100644 index 0000000..e8502a1 --- /dev/null +++ b/AMF/models/dietModel/Hall/hall_plot.m @@ -0,0 +1,11 @@ +% Hall +t = linspace(0,16,100); +t1 = [3 10]; +x1 = [11.3+1.35 12.9+1.35]; +ee3 = Hall(t, 3); +ee2 = Hall(t, 2); +ee4 = Hall(t, 4); +ee909 = Hall(t, 0.909); +plot(t,ee2, '--k', t, ee3, '-k', t, ee4, '--k',t, ee909, '--b', t1, x1, 'or', 'LineWidth', 2); +xlabel('Time on HFD (weeks)') +ylabel('Energy Expenditure (kcal/day)') \ No newline at end of file diff --git a/AMF/models/dietModel/Model_Diets_YP.m b/AMF/models/dietModel/Model_Diets_YP.m new file mode 100644 index 0000000..8954a88 --- /dev/null +++ b/AMF/models/dietModel/Model_Diets_YP.m @@ -0,0 +1,108 @@ +function MODEL = Model_Diets_YP() + +MODEL.DESCRIPTION = 'Model to explore glucose lipid interactions in the diet selection experiment.'; + +MODEL.PREDICTOR = { + 't' [0 24*7*12] {'time' 'hours' 'Time'} +}; + +MODEL.CONSTANTS = { +}; + +MODEL.PARAMETERS = { +% name fit init_value bnd meta-data + 'k1' 1 1 [] {} + 'k2' 1 1 [] {} + 'k3' 1 1 [] {} + 'k4' 1 1 [] {} + 'k5' 1 1 [] {} + 'k6' 1 1 [] {} + 'k7' 1 1 [] {} + 'k8' 1 1 [] {} + 'k9' 1 1 [] {} + 'k10' 1 1 [] {} + 'k11' 1 1 [] {} + 'k12' 1 1 [] {} + 'k13' 1 1 [] {} + 'k14' 1 1 [] {} + 'k15' 1 1 [] {} + 'k16' 1 1 [] {} + 'k17' 1 1 [] {} + 'k18' 1 1 [] {} + 'k19' 1 1 [] {} + 'k20' 1 1 [] {} + 'k21' 1 1 [] {} + 'k22' 1 1 [] {} + 'k23' 1 1 [] {} + 'k24' 1 1 [] {} + 'k25' 1 1 [] {} + 'k26' 1 1 [] {} + 'k27' 1 1 [] {} + 'k28' 1 1 [] {} + 'k29' 1 1 [] {} + 'k30' 1 1 [] {} + 'k31' 1 1 [] {} + 'k32' 1 1 [] {} +}; + +MODEL.STATES = { + 'hep_AcoA' 1 '3*v4 - v5 - v6' {} + 'hep_TG' 2 'v2 + v5/26 + v14/3 - v7 - v12 + v17' {} + 'hep_C' 1 'v6/13 + v15 + v16 - v8 - v11 - v13 + v32' {} + 'hep_BA' 0 'v8 - v9' {} + 'pl_FFA' 1 '3*v19 - v14' {} + 'pl_VLDL_TG' 1 'v12 - v20 - v31' {} + 'pl_VLDL_C' 1 'v13 - v15 - v21 - v22 + v18' {} + 'pl_HDL_C' 1 'v30 - v16 - v18' {} + 'per_AcoA' 1 '3*v26 - v27 - v28' {} + 'per_TG' 1 'v20 + v23 + v27/26 - v19 - v29' {} + 'per_C' 1 'v21 + v28/13 - v30' {} + 'pl_HDL_TG' 1 'v31 - v17' {} +}; + +MODEL.REACTIONS = { + % name reaction meta + 'v1' 'k1' {} + 'v2' 'k2' {} + 'v3' 'k3' {} + 'v4' 'k4' {} + 'v5' 'k5 * hep_AcoA' {} + 'v6' 'k6 * hep_AcoA' {} + 'v7' 'k7 * hep_TG' {} + 'v8' 'k8 * hep_C' {} + 'v9' 'k9 * hep_BA' {} + 'v10' 'k10 * hep_BA' {} + 'v11' 'k11 * hep_C' {} + 'v12' 'k12 * hep_TG' {} + 'v13' 'k13 * hep_C' {} + 'v14' 'k14 * pl_FFA' {} + 'v15' 'k15 * pl_VLDL_C' {} + 'v16' 'k16 * pl_HDL_C' {} + 'v17' 'k17 * pl_HDL_TG' {} + 'v18' 'k18 * (pl_HDL_C / (pl_HDL_TG + pl_HDL_C) - pl_VLDL_C / (pl_VLDL_C + pl_VLDL_TG))' {} % HDL_C -> VLDL_C + 'v19' 'k19 * per_TG' {} + 'v20' 'k20 * pl_VLDL_TG' {} + 'v21' 'k21 * pl_VLDL_C' {} + 'v22' 'k22 * pl_VLDL_C' {} + 'v23' 'k23' {} + 'v24' 'k24' {} + 'v25' 'k25' {} + 'v26' 'k26' {} + 'v27' 'k27 * per_AcoA' {} + 'v28' 'k28 * per_AcoA' {} + 'v29' 'k29 * per_TG' {} + 'v30' 'k30 * per_C' {} + 'v31' 'k31 * (pl_VLDL_TG / (pl_VLDL_TG + pl_VLDL_C) - pl_HDL_TG / (pl_HDL_TG + pl_HDL_C))' {} % VLDL_TG -> HDL_TG + 'v32' 'k32' {} % cholesterol from diet to liver + + % helper functions + 'pl_TC' 'pl_VLDL_C + pl_HDL_C' {} + 'fat_intk' 'v1 + v2 + v23 + v24' {} + 'gluc_intk' 'v3 + v4 + v25 + v26' {} + 'fat_ox' 'v1 + v24 + v7 + v29' {} + 'gluc_ox' 'v3 + v25' {} +% 'chol_exc' 'v42 - v41 + v11' {} + + +}; + diff --git a/AMF/models/dietModel/dietData.m b/AMF/models/dietModel/dietData.m new file mode 100644 index 0000000..96efbfa --- /dev/null +++ b/AMF/models/dietModel/dietData.m @@ -0,0 +1,30 @@ +function DATASET = dietData() + +DATASET.DESCRIPTION = 'Diet data.'; + +DATASET.FILE = 'dietData'; + +DATASET.GROUPS = { + 'diets' +% 'diets_R' +% 'diets_NAMR' +}; + +DATASET.FIELDS = { + %name %obs %t %mean % stand dev % unit conv + 'hep_TG' 1 't1' 'hep_TG_m' 'hep_TG_std' 1 [] + 'hep_C' 1 't1' 'hep_C_m' 'hep_C_std' 1 [] + 'pl_VLDL_TG' 1 't2' 'pl_VLDL_TG_m' 'pl_VLDL_TG_std' 1 [] + 'pl_HDL_C' 1 't2' 'pl_HDL_C_m' 'pl_HDL_C_std' 1 [] + 'pl_FFA' 1 't2' 'pl_FFA_m' 'pl_FFA_std' 1 [] + 'per_TG' 1 't3' 'perTG_m' 'perTG_std' 1 [] + 'pl_TC' 1 't2' 'pl_TC_m' 'pl_TC_std' 1 [] + 'fat_intk' 1 't2' 'FatInt_m' 'FatInt_std' 1 [] + 'gluc_intk' 1 't2' 'GlucInt_m' 'GlucInt_std' 1 [] + 'fat_ox' 1 't4' 'fat_ox_m' 'fat_ox_std' 1 [] + 'gluc_ox' 1 't4' 'gluc_ox_m' 'gluc_ox_std' 1 [] +% 'chol_intk' 0 't2' 'chol_intk_m' 'chol_intk_std' 1 [] +}; + +DATASET.FUNCTIONS = { +}; \ No newline at end of file diff --git a/AMF/models/dietModel/dietData.mat b/AMF/models/dietModel/dietData.mat new file mode 100644 index 0000000..2420587 Binary files /dev/null and b/AMF/models/dietModel/dietData.mat differ diff --git a/AMF/models/dietModel/loadData.m b/AMF/models/dietModel/loadData.m new file mode 100644 index 0000000..7d2dddb --- /dev/null +++ b/AMF/models/dietModel/loadData.m @@ -0,0 +1,153 @@ +data.diets.t1 = [0 12]*7*24; +data.diets.t2 = [0 4 8 12]*7*24; +data.diets.t3 = [0 1 3 5 7 9 12]*7*24; +data.diets.t4 = [3 10]*7*24; + + +% liver weights (g) +liver_weights = [ 2.85 + 3.40 + 3.39 + 1.88 + 1.74 + 1.43 + 3.02 + 3.96 + 4.28 + 3.54 ]; + +% nmol/mg tissue (mumol/g tissue) +data.diets.hep_TG_r = [ 109.3 + 124.6 + 115.9 + 62.5 + 44.0 + 47.9 + 106.0 + 111.9 + 112.1 + 83.8 ]; +data.diets.hep_TG_m = nanmean(data.diets.hep_TG_r .* liver_weights); +data.diets.hep_TG_std = nanstd(data.diets.hep_TG_r .* liver_weights); +% Wielinga et al. 9.1 (0.8) mumol TG/liver +data.diets.hep_TG_m = [9.1 data.diets.hep_TG_m]; % mumol / liver +data.diets.hep_TG_std = [0.8 data.diets.hep_TG_std]; % mumol / liver +% data.diets.hep_TG_m = [8.1 91.79]; + +% nmol/mg tissue (mumol/g tissue) +data.diets.hep_C_r = [ 16.6 + 12.3 + 14.7 + 8.8 + 9.5 + 10.2 + 13.5 + 15.7 + 13.3 + 13.2 ]; +data.diets.hep_C_m = nanmean(data.diets.hep_C_r .* liver_weights); +data.diets.hep_C_std = nanstd(data.diets.hep_C_r .* liver_weights); +% Wielinga et al. 6.8 (0.4) mumol C/liver +data.diets.hep_C_m = [6.8 data.diets.hep_C_m]; % mumol / liver +data.diets.hep_C_std = [0.4 data.diets.hep_C_std]; % mumol / liver +% data.diets.hep_C_m = [6.1 12.79]; +% data.diets.hep_C_std = [0.35 2.61]; + +% mM (mumol, assuming plasma volume = 1ml) +data.diets.pl_FFA_r = [ 1.87 0.71 0.53 1.40 + 1.27 0.87 0.55 1.51 + 1.52 0.65 0.61 1.64 + 0.99 0.66 0.65 1.04 + 0.77 0.61 0.46 1.19 + 1.60 0.61 0.38 1.07 + 1.34 0.52 0.80 1.13 + 1.41 0.92 0.59 1.17 + 1.51 0.68 0.46 1.53 + 1.43 0.61 0.56 1.48 ]; +data.diets.pl_FFA_m = [ 1.37 0.68 0.56 1.32]; % mumol / plasma +data.diets.pl_FFA_std = [0.31 0.12 0.12 0.22]; % mumol / plasma + +% mM +data.diets.pl_VLDL_TG_r = [ 2.27 1.58 1.45 2.00 + 2.7 1.25 1.47 2.39 + 2.78 1.08 1.31 2.42 + 2.07 1.30 1.10 0.77 + 1.88 1.06 1.17 0.79 + 5.72 1.64 1.13 0.82 + 4.23 1.57 1.34 2.16 + 1.89 1.20 2.30 7.97 + 2.57 1.44 2.48 7.50 + 1.89 1.39 2.02 5.57] ; + +data.diets.pl_VLDL_TG_m = [2.80 1.35 1.58 3.24]; % mumol / plasma +data.diets.pl_VLDL_TG_std = [1.25 0.21 0.50 2.75]; % mumol / plasma + +% mM +data.diets.pl_TC_r = [ 3.17 5.01 4.94 5.79 + 3.22 4.39 4.92 7.07 + 3.67 4.32 4.94 6.86 + 2.45 4.22 4.26 5.25 + 2.20 3.92 3.96 5.13 + 5.25 4.95 3.37 4.52 + 4.56 4.74 4.64 7.09 + 2.82 5.31 6.21 15.45 + 3.07 5.31 6.06 14.58 + 2.55 4.89 5.44 15.22] ; +data.diets.pl_TC_m = [ 3.30 4.70 4.87 8.69]; % mumol / plasma +data.diets.pl_TC_std = [0.96 0.47 0.88 4.50]; % mumol / plasma + +% mM +data.diets.pl_HDL_C_r = [ 1.69 3.03 3.21 2.64 + 1.29 3.03 3.44 2.47 + 1.06 3.35 3.25 2.51 + 0.61 3.09 3.64 3.56 + 0.82 2.69 2.83 2.73 + 1.79 1.82 NaN 2.86 + 1.10 1.91 3.91 2.97 + 1.31 2.56 2.63 1.41 + 1.15 3.03 2.86 1.81 + 1.20 NaN 3.49 1.80]; +data.diets.pl_HDL_C_m = [1.20 2.72 3.25 2.48]; % mumol / plasma +data.diets.pl_HDL_C_std = [0.36 0.54 0.42 0.64]; % mumol / plasma + + +% TG = (fat mass (g)) / 853 (g/mol) = TG (mol) ; + +data.diets.fat_mass = [ 2.4 7.6 11.3 14.4 14.4 18.1 19.0 + 3.6 8.1 10.2 13.8 15.7 18.4 18.6 + 2.3 6.3 10.1 13.7 15.8 19.4 20.8 + 0.8 2.9 5.0 8.4 10.0 13.4 13.8 + 0.9 2.8 3.9 7.2 8.4 10.7 11.7 + 1.1 1.8 1.6 3.4 4.5 6.7 9.6 + 1.3 3.2 4.7 9.3 11.9 15.3 19.9 + 3.2 8.2 11.8 14.7 16.7 21.1 23.3 + 2.1 6.9 10.8 14.7 17.5 21.3 22.4 + 1.7 6.2 11.6 15.4 18.3 22.4 23.4]; + +data.diets.perTG_m = nanmean(data.diets.fat_mass*(1e6/853)); +data.diets.perTG_std = nanstd(data.diets.fat_mass*(1e6/853)); + +% energy intake in TG equivalents +% TG = 9.2 kcal/g +% fat intake +data.diets.FatInt_m = [3.1 3.1 3.1 3.1]*0.60*(5.2/9.2)*1*(1e6/853)/24; +data.diets.FatInt_std = [0.3 0.3 0.3 0.3]*0.60*(5.2/9.2)*1*(1e6/853)/24; + +% gluc = 4.2 kcal/g --> gluc / TG = 0.46; 4/9 = 0.44; +% glucose intake +data.diets.GlucInt_m = [3.1 3.1 3.1 3.1]*0.20*(5.2/4.2)*1*(1e6/180)/24; +data.diets.GlucInt_std = [0.3 0.3 0.3 0.3]*0.20*(5.2/4.2)*1*(1e6/180)/24; + +% chol intake %% is there a TG equivalent of cholesterol? +data.diets.chol_intk_m = [3.1 3.1 3.1 3.1]*0.01; +data.diets.chol_intk_std = [0.3 0.3 0.3 0.3]*0.01; + +% fat oxidation (kcal/h) +data.diets.fat_ox_m = [6.98 8.79]*(1e6/853)/9.2/24; +data.diets.fat_ox_std = [0.81 0.78]*(1e6/853)/9.2/24; + +% glucose oxidation (kcal/h) +data.diets.gluc_ox_m = [1.32 1.10]*(1e6/180)/4.2/24; +data.diets.gluc_ox_std = [0.19 0.09]*(1e6/180)/4.2/24; + +save('dietData.mat', '-struct', 'data'); \ No newline at end of file diff --git a/AMF/models/dietModel/results/_Model_Diets_YP_diets__10_50.mat b/AMF/models/dietModel/results/_Model_Diets_YP_diets__10_50.mat new file mode 100644 index 0000000..6503f86 Binary files /dev/null and b/AMF/models/dietModel/results/_Model_Diets_YP_diets__10_50.mat differ diff --git a/AMF/models/dietModel/runDiet.m b/AMF/models/dietModel/runDiet.m new file mode 100644 index 0000000..50245b0 --- /dev/null +++ b/AMF/models/dietModel/runDiet.m @@ -0,0 +1,37 @@ +%% initialize + +import AMF.* + +model = Model('Model_Diets_YP'); +data = DataSet('dietData'); + +loadGroup(data, 'diets'); +initiateExperiment(model, data); + +%% config + +model.options.useMex = 1; +model.options.savePrefix = ''; +model.options.odeTol = [1e-12 1e-12 100]; +model.options.numIter = 10; +model.options.numTimeSteps = 50; +model.options.parScale = [2 -2]; +model.options.seed = 1; +model.options.SSTime = 1000; +model.options.lab1 = .1; + +parseAll(model); +compileAll(model); + +%% run + +result = runADAPT(model); + + +%% plot + +% plotAll(result, 'parameters', 'traj'); +plotAll(result, 'states', 'mad'); +plotAll(result, 'reactions', 'mad'); + +% random change \ No newline at end of file diff --git a/AMF/models/dietModel/temp/C_Model_Diets_YP_ODE.m b/AMF/models/dietModel/temp/C_Model_Diets_YP_ODE.m new file mode 100644 index 0000000..1cabf2f --- /dev/null +++ b/AMF/models/dietModel/temp/C_Model_Diets_YP_ODE.m @@ -0,0 +1,102 @@ +function dxdt = C_Model_Diets_YP_ODE(t,x,p,u,m) + + + +hep_AcoA = x(m.s.hep_AcoA); +hep_TG = x(m.s.hep_TG); +hep_C = x(m.s.hep_C); +hep_BA = x(m.s.hep_BA); +pl_FFA = x(m.s.pl_FFA); +pl_VLDL_TG = x(m.s.pl_VLDL_TG); +pl_VLDL_C = x(m.s.pl_VLDL_C); +pl_HDL_C = x(m.s.pl_HDL_C); +per_AcoA = x(m.s.per_AcoA); +per_TG = x(m.s.per_TG); +per_C = x(m.s.per_C); +pl_HDL_TG = x(m.s.pl_HDL_TG); + +k1 = p(m.p.k1); +k2 = p(m.p.k2); +k3 = p(m.p.k3); +k4 = p(m.p.k4); +k5 = p(m.p.k5); +k6 = p(m.p.k6); +k7 = p(m.p.k7); +k8 = p(m.p.k8); +k9 = p(m.p.k9); +k10 = p(m.p.k10); +k11 = p(m.p.k11); +k12 = p(m.p.k12); +k13 = p(m.p.k13); +k14 = p(m.p.k14); +k15 = p(m.p.k15); +k16 = p(m.p.k16); +k17 = p(m.p.k17); +k18 = p(m.p.k18); +k19 = p(m.p.k19); +k20 = p(m.p.k20); +k21 = p(m.p.k21); +k22 = p(m.p.k22); +k23 = p(m.p.k23); +k24 = p(m.p.k24); +k25 = p(m.p.k25); +k26 = p(m.p.k26); +k27 = p(m.p.k27); +k28 = p(m.p.k28); +k29 = p(m.p.k29); +k30 = p(m.p.k30); +k31 = p(m.p.k31); +k32 = p(m.p.k32); + +v1 = k1; +v2 = k2; +v3 = k3; +v4 = k4; +v5 = k5 * hep_AcoA; +v6 = k6 * hep_AcoA; +v7 = k7 * hep_TG; +v8 = k8 * hep_C; +v9 = k9 * hep_BA; +v10 = k10 * hep_BA; +v11 = k11 * hep_C; +v12 = k12 * hep_TG; +v13 = k13 * hep_C; +v14 = k14 * pl_FFA; +v15 = k15 * pl_VLDL_C; +v16 = k16 * pl_HDL_C; +v17 = k17 * pl_HDL_TG; +v18 = k18 * (pl_HDL_C / (pl_HDL_TG + pl_HDL_C) - pl_VLDL_C / (pl_VLDL_C + pl_VLDL_TG)); +v19 = k19 * per_TG; +v20 = k20 * pl_VLDL_TG; +v21 = k21 * pl_VLDL_C; +v22 = k22 * pl_VLDL_C; +v23 = k23; +v24 = k24; +v25 = k25; +v26 = k26; +v27 = k27 * per_AcoA; +v28 = k28 * per_AcoA; +v29 = k29 * per_TG; +v30 = k30 * per_C; +v31 = k31 * (pl_VLDL_TG / (pl_VLDL_TG + pl_VLDL_C) - pl_HDL_TG / (pl_HDL_TG + pl_HDL_C)); +v32 = k32; +pl_TC = pl_VLDL_C + pl_HDL_C; +fat_intk = v1 + v2 + v23 + v24; +gluc_intk = v3 + v4 + v25 + v26; +fat_ox = v1 + v24 + v7 + v29; +gluc_ox = v3 + v25; + +dxdt(1) = 3*v4 - v5 - v6; +dxdt(2) = v2 + v5/26 + v14/3 - v7 - v12 + v17; +dxdt(3) = v6/13 + v15 + v16 - v8 - v11 - v13 + v32; +dxdt(4) = v8 - v9; +dxdt(5) = 3*v19 - v14; +dxdt(6) = v12 - v20 - v31; +dxdt(7) = v13 - v15 - v21 - v22 + v18; +dxdt(8) = v30 - v16 - v18; +dxdt(9) = 3*v26 - v27 - v28; +dxdt(10) = v20 + v23 + v27/26 - v19 - v29; +dxdt(11) = v21 + v28/13 - v30; +dxdt(12) = v31 - v17; + +dxdt = dxdt(:); \ No newline at end of file diff --git a/AMF/models/dietModel/temp/C_Model_Diets_YP_ODEC.mexw64 b/AMF/models/dietModel/temp/C_Model_Diets_YP_ODEC.mexw64 new file mode 100644 index 0000000..a613c8c Binary files /dev/null and b/AMF/models/dietModel/temp/C_Model_Diets_YP_ODEC.mexw64 differ diff --git a/AMF/models/dietModel/temp/C_Model_Diets_YP_ODEMEX.m b/AMF/models/dietModel/temp/C_Model_Diets_YP_ODEMEX.m new file mode 100644 index 0000000..31b93e2 --- /dev/null +++ b/AMF/models/dietModel/temp/C_Model_Diets_YP_ODEMEX.m @@ -0,0 +1,102 @@ +function dxdt = C_Model_Diets_YP_ODEMEX(t,x,p,u,m) + + + +hep_AcoA = x(m.s.hep_AcoA); +hep_TG = x(m.s.hep_TG); +hep_C = x(m.s.hep_C); +hep_BA = x(m.s.hep_BA); +pl_FFA = x(m.s.pl_FFA); +pl_VLDL_TG = x(m.s.pl_VLDL_TG); +pl_VLDL_C = x(m.s.pl_VLDL_C); +pl_HDL_C = x(m.s.pl_HDL_C); +per_AcoA = x(m.s.per_AcoA); +per_TG = x(m.s.per_TG); +per_C = x(m.s.per_C); +pl_HDL_TG = x(m.s.pl_HDL_TG); + +k1 = p(m.p.k1); +k2 = p(m.p.k2); +k3 = p(m.p.k3); +k4 = p(m.p.k4); +k5 = p(m.p.k5); +k6 = p(m.p.k6); +k7 = p(m.p.k7); +k8 = p(m.p.k8); +k9 = p(m.p.k9); +k10 = p(m.p.k10); +k11 = p(m.p.k11); +k12 = p(m.p.k12); +k13 = p(m.p.k13); +k14 = p(m.p.k14); +k15 = p(m.p.k15); +k16 = p(m.p.k16); +k17 = p(m.p.k17); +k18 = p(m.p.k18); +k19 = p(m.p.k19); +k20 = p(m.p.k20); +k21 = p(m.p.k21); +k22 = p(m.p.k22); +k23 = p(m.p.k23); +k24 = p(m.p.k24); +k25 = p(m.p.k25); +k26 = p(m.p.k26); +k27 = p(m.p.k27); +k28 = p(m.p.k28); +k29 = p(m.p.k29); +k30 = p(m.p.k30); +k31 = p(m.p.k31); +k32 = p(m.p.k32); + +v1 = k1; +v2 = k2; +v3 = k3; +v4 = k4; +v5 = k5 * hep_AcoA; +v6 = k6 * hep_AcoA; +v7 = k7 * hep_TG; +v8 = k8 * hep_C; +v9 = k9 * hep_BA; +v10 = k10 * hep_BA; +v11 = k11 * hep_C; +v12 = k12 * hep_TG; +v13 = k13 * hep_C; +v14 = k14 * pl_FFA; +v15 = k15 * pl_VLDL_C; +v16 = k16 * pl_HDL_C; +v17 = k17 * pl_HDL_TG; +v18 = k18 * (pl_HDL_C / (pl_HDL_TG + pl_HDL_C) - pl_VLDL_C / (pl_VLDL_C + pl_VLDL_TG)); +v19 = k19 * per_TG; +v20 = k20 * pl_VLDL_TG; +v21 = k21 * pl_VLDL_C; +v22 = k22 * pl_VLDL_C; +v23 = k23; +v24 = k24; +v25 = k25; +v26 = k26; +v27 = k27 * per_AcoA; +v28 = k28 * per_AcoA; +v29 = k29 * per_TG; +v30 = k30 * per_C; +v31 = k31 * (pl_VLDL_TG / (pl_VLDL_TG + pl_VLDL_C) - pl_HDL_TG / (pl_HDL_TG + pl_HDL_C)); +v32 = k32; +pl_TC = pl_VLDL_C + pl_HDL_C; +fat_intk = v1 + v2 + v23 + v24; +gluc_intk = v3 + v4 + v25 + v26; +fat_ox = v1 + v24 + v7 + v29; +gluc_ox = v3 + v25; + +dxdt(1) = 3*v4 - v5 - v6; +dxdt(2) = v2 + v5/26 + v14/3 - v7 - v12 + v17; +dxdt(3) = v6/13 + v15 + v16 - v8 - v11 - v13 + v32; +dxdt(4) = v8 - v9; +dxdt(5) = 3*v19 - v14; +dxdt(6) = v12 - v20 - v31; +dxdt(7) = v13 - v15 - v21 - v22 + v18; +dxdt(8) = v30 - v16 - v18; +dxdt(9) = 3*v26 - v27 - v28; +dxdt(10) = v20 + v23 + v27/26 - v19 - v29; +dxdt(11) = v21 + v28/13 - v30; +dxdt(12) = v31 - v17; + +dxdt = dxdt(:); \ No newline at end of file diff --git a/AMF/models/dietModel/temp/C_Model_Diets_YP_REACTIONS.m b/AMF/models/dietModel/temp/C_Model_Diets_YP_REACTIONS.m new file mode 100644 index 0000000..37bdc9b --- /dev/null +++ b/AMF/models/dietModel/temp/C_Model_Diets_YP_REACTIONS.m @@ -0,0 +1,125 @@ +function v = C_Model_Diets_YP_REACTIONS(t,x,p,u,m) + + + +hep_AcoA = x(m.s.hep_AcoA); +hep_TG = x(m.s.hep_TG); +hep_C = x(m.s.hep_C); +hep_BA = x(m.s.hep_BA); +pl_FFA = x(m.s.pl_FFA); +pl_VLDL_TG = x(m.s.pl_VLDL_TG); +pl_VLDL_C = x(m.s.pl_VLDL_C); +pl_HDL_C = x(m.s.pl_HDL_C); +per_AcoA = x(m.s.per_AcoA); +per_TG = x(m.s.per_TG); +per_C = x(m.s.per_C); +pl_HDL_TG = x(m.s.pl_HDL_TG); + +k1 = p(m.p.k1); +k2 = p(m.p.k2); +k3 = p(m.p.k3); +k4 = p(m.p.k4); +k5 = p(m.p.k5); +k6 = p(m.p.k6); +k7 = p(m.p.k7); +k8 = p(m.p.k8); +k9 = p(m.p.k9); +k10 = p(m.p.k10); +k11 = p(m.p.k11); +k12 = p(m.p.k12); +k13 = p(m.p.k13); +k14 = p(m.p.k14); +k15 = p(m.p.k15); +k16 = p(m.p.k16); +k17 = p(m.p.k17); +k18 = p(m.p.k18); +k19 = p(m.p.k19); +k20 = p(m.p.k20); +k21 = p(m.p.k21); +k22 = p(m.p.k22); +k23 = p(m.p.k23); +k24 = p(m.p.k24); +k25 = p(m.p.k25); +k26 = p(m.p.k26); +k27 = p(m.p.k27); +k28 = p(m.p.k28); +k29 = p(m.p.k29); +k30 = p(m.p.k30); +k31 = p(m.p.k31); +k32 = p(m.p.k32); + +v1 = k1; +v2 = k2; +v3 = k3; +v4 = k4; +v5 = k5 * hep_AcoA; +v6 = k6 * hep_AcoA; +v7 = k7 * hep_TG; +v8 = k8 * hep_C; +v9 = k9 * hep_BA; +v10 = k10 * hep_BA; +v11 = k11 * hep_C; +v12 = k12 * hep_TG; +v13 = k13 * hep_C; +v14 = k14 * pl_FFA; +v15 = k15 * pl_VLDL_C; +v16 = k16 * pl_HDL_C; +v17 = k17 * pl_HDL_TG; +v18 = k18 * (pl_HDL_C / (pl_HDL_TG + pl_HDL_C) - pl_VLDL_C / (pl_VLDL_C + pl_VLDL_TG)); +v19 = k19 * per_TG; +v20 = k20 * pl_VLDL_TG; +v21 = k21 * pl_VLDL_C; +v22 = k22 * pl_VLDL_C; +v23 = k23; +v24 = k24; +v25 = k25; +v26 = k26; +v27 = k27 * per_AcoA; +v28 = k28 * per_AcoA; +v29 = k29 * per_TG; +v30 = k30 * per_C; +v31 = k31 * (pl_VLDL_TG / (pl_VLDL_TG + pl_VLDL_C) - pl_HDL_TG / (pl_HDL_TG + pl_HDL_C)); +v32 = k32; +pl_TC = pl_VLDL_C + pl_HDL_C; +fat_intk = v1 + v2 + v23 + v24; +gluc_intk = v3 + v4 + v25 + v26; +fat_ox = v1 + v24 + v7 + v29; +gluc_ox = v3 + v25; + +v(1) = v1; +v(2) = v2; +v(3) = v3; +v(4) = v4; +v(5) = v5; +v(6) = v6; +v(7) = v7; +v(8) = v8; +v(9) = v9; +v(10) = v10; +v(11) = v11; +v(12) = v12; +v(13) = v13; +v(14) = v14; +v(15) = v15; +v(16) = v16; +v(17) = v17; +v(18) = v18; +v(19) = v19; +v(20) = v20; +v(21) = v21; +v(22) = v22; +v(23) = v23; +v(24) = v24; +v(25) = v25; +v(26) = v26; +v(27) = v27; +v(28) = v28; +v(29) = v29; +v(30) = v30; +v(31) = v31; +v(32) = v32; +v(33) = pl_TC; +v(34) = fat_intk; +v(35) = gluc_intk; +v(36) = fat_ox; +v(37) = gluc_ox; diff --git a/AMF/models/minGlucModel2/runMinGluc2.m b/AMF/models/minGlucModel2/runMinGluc2.m index 999e3ca..9c9898f 100644 --- a/AMF/models/minGlucModel2/runMinGluc2.m +++ b/AMF/models/minGlucModel2/runMinGluc2.m @@ -11,10 +11,11 @@ %% config -model.options.optimset.Display = 'off'; -model.options.useMex = 1; model.options.numIter = 500; model.options.numTimeSteps = 100; + +model.options.optimset.Display = 'off'; +model.options.useMex = 1; model.options.SSTime = 30; model.options.lab1 = .1; model.options.randPars = 0; @@ -25,10 +26,11 @@ %% run -% model.functions.reg = @minGlucReg; - result = runADAPT(model); + +%check whether AUC satisfies carbohydrate dose + %% plot close all diff --git a/README.MD b/README.MD new file mode 100644 index 0000000..1ed55a8 --- /dev/null +++ b/README.MD @@ -0,0 +1,22 @@ +** Read the manual (manual.pdf) for a complete overview of how to install and use the AMF package. + +Install the ADAPT Modeling Framework (AMF) by running + +setup + +in the AMF root directory. This will add all subdirectories to the MATLAB path and will attempt to start a parralel pool. +To run the examples, please make sure the ODEMEX toolbox is configured properly (Instructions.pdf located in the odemex folder). + +The following example run files are included: + +runToy + +-> runs ADAPT on the toy model (Natal van Riel et al) to compute parameter trajectories + +runMinGluc + +-> fits the minimal glucose model (Dalla man et al) to post-bariatric surgery insulin data + +runMinCPep + +-> fits the minimal c-peptide model (Dalla man et al) to post-bariatric surgery glucose data \ No newline at end of file diff --git a/README.TXT b/README.TXT new file mode 100644 index 0000000..1ed55a8 --- /dev/null +++ b/README.TXT @@ -0,0 +1,22 @@ +** Read the manual (manual.pdf) for a complete overview of how to install and use the AMF package. + +Install the ADAPT Modeling Framework (AMF) by running + +setup + +in the AMF root directory. This will add all subdirectories to the MATLAB path and will attempt to start a parralel pool. +To run the examples, please make sure the ODEMEX toolbox is configured properly (Instructions.pdf located in the odemex folder). + +The following example run files are included: + +runToy + +-> runs ADAPT on the toy model (Natal van Riel et al) to compute parameter trajectories + +runMinGluc + +-> fits the minimal glucose model (Dalla man et al) to post-bariatric surgery insulin data + +runMinCPep + +-> fits the minimal c-peptide model (Dalla man et al) to post-bariatric surgery glucose data \ No newline at end of file diff --git a/README.md b/README.md index 707bd3d..1ed55a8 100644 --- a/README.md +++ b/README.md @@ -1,4 +1,22 @@ -ADAPT -===== +** Read the manual (manual.pdf) for a complete overview of how to install and use the AMF package. -ADAPT toolbox for Matlab - Analysis of Dynamic Adaptations in Parameter Trajectories +Install the ADAPT Modeling Framework (AMF) by running + +setup + +in the AMF root directory. This will add all subdirectories to the MATLAB path and will attempt to start a parralel pool. +To run the examples, please make sure the ODEMEX toolbox is configured properly (Instructions.pdf located in the odemex folder). + +The following example run files are included: + +runToy + +-> runs ADAPT on the toy model (Natal van Riel et al) to compute parameter trajectories + +runMinGluc + +-> fits the minimal glucose model (Dalla man et al) to post-bariatric surgery insulin data + +runMinCPep + +-> fits the minimal c-peptide model (Dalla man et al) to post-bariatric surgery glucose data \ No newline at end of file diff --git a/manual.docx b/manual.docx new file mode 100644 index 0000000..ff32786 Binary files /dev/null and b/manual.docx differ diff --git a/manual.pdf b/manual.pdf new file mode 100644 index 0000000..212a0ab Binary files /dev/null and b/manual.pdf differ diff --git a/models/bariatricData.m b/models/bariatricData.m new file mode 100644 index 0000000..79b0209 --- /dev/null +++ b/models/bariatricData.m @@ -0,0 +1,251 @@ +% +% time [min] +% + +% data.t = [0 15 30 45 60 90 120 180 240]; + +data.t2d_pre.t = [0 15 30 45 60 90 120 180 240]; +data.t2d_1wk.t = [0 15 30 45 60 90 120 180 240]; +data.t2d_3mo.t = [0 15 30 45 60 90 120 180 240]; +data.t2d_1y.t = [0 15 30 45 60 90 120 180 240]; +data.ngt_pre.t = [0 15 30 45 60 90 120 180 240]; +data.ngt_1wk.t = [0 15 30 45 60 90 120 180 240]; +data.ngt_3mo.t = [0 15 30 45 60 90 120 180 240]; +data.ngt_1y.t = [0 15 30 45 60 90 120 180 240]; + +% +% body weight +% + +data.t2d_pre.m_mean = 128.8; +data.t2d_pre.m_std = 13.9; +data.t2d_1wk.m_mean = 127; +data.t2d_1wk.m_std = 13.1; +data.t2d_3mo.m_mean = 112.1; +data.t2d_3mo.m_std = 15.0; +data.t2d_1y.m_mean = 100.8; +data.t2d_1y.m_std = 19.5; +data.ngt_pre.m_mean = 126.6; +data.ngt_pre.m_std = 15.4; +data.ngt_1wk.m_mean = 123.5; +data.ngt_1wk.m_std = 14.7; +data.ngt_3mo.m_mean = 105.5; +data.ngt_3mo.m_std = 13.0; +data.ngt_1y.m_mean = 94.7; +data.ngt_1y.m_std = 16.0; + +% +% glucose +% + +% t2d fasting [mmol/L] +data.t2d_pre.glucose_ss_mean = 8.8; +data.t2d_pre.glucose_ss_std = 2.3; + +data.t2d_1wk.glucose_ss_mean = 7.0; +data.t2d_1wk.glucose_ss_std = 1.2; + +data.t2d_3mo.glucose_ss_mean = 6.8; +data.t2d_3mo.glucose_ss_std = 1.6; + +data.t2d_1y.glucose_ss_mean = 6.2; +data.t2d_1y.glucose_ss_std = 1.6; + +% ngt fasting [mmol/L] +data.ngt_pre.glucose_ss_mean = 5.5; +data.ngt_pre.glucose_ss_std = 0.6; + +data.ngt_1wk.glucose_ss_mean = 5.0; +data.ngt_1wk.glucose_ss_std = 0.6; + +data.ngt_3mo.glucose_ss_mean = 4.9; +data.ngt_3mo.glucose_ss_std = 0.4; + +data.ngt_1y.glucose_ss_mean = 4.9; +data.ngt_1y.glucose_ss_std = 0.3; + +% t2d post-prandial [mM] +data.t2d_pre.glucose_mean = [8.77244 8.85589 9.99010 11.35133 12.11621 12.22632 11.39915 9.31906 7.86372]; +data.t2d_pre.glucose_max = [9.44681 9.59575 10.80851 12.14894 12.82979 13.08511 12.31915 10.27660 8.74468]; +data.t2d_pre.glucose_std = data.t2d_pre.glucose_max - data.t2d_pre.glucose_mean; +data.t2d_pre.glucose_diff = [0 diff(data.t2d_pre.glucose_mean)]./[1 diff(data.t2d_pre.t)]; + +data.t2d_1wk.glucose_mean = [6.81301 7.52126 9.08133 10.64139 11.09391 9.44337 8.13344 6.70645 6.10303]; +data.t2d_1wk.glucose_max = [7.31915 8.08511 9.63830 11.27660 11.74468 10.19149 8.89362 7.36170 6.61702]; +data.t2d_1wk.glucose_std = data.t2d_1wk.glucose_max - data.t2d_1wk.glucose_mean; +data.t2d_1wk.glucose_diff = [0 diff(data.t2d_1wk.glucose_mean)]./[1 diff(data.t2d_1wk.t)]; + +data.t2d_3mo.glucose_mean = [6.81301 7.46447 9.81966 11.18089 10.32723 7.96670 6.82716 5.99661 5.64872]; +data.t2d_3mo.glucose_max = [7.31915 8.08511 10.74468 12.04255 11.10638 8.74468 7.55319 6.57447 6.21277]; +data.t2d_3mo.glucose_std = data.t2d_3mo.glucose_max - data.t2d_3mo.glucose_mean; +data.t2d_3mo.glucose_diff = [0 diff(data.t2d_3mo.glucose_mean)]./[1 diff(data.t2d_3mo.t)]; + +data.t2d_1y.glucose_mean = [6.15993 7.46441 9.99005 11.09575 9.81607 7.31356 6.23081 5.34337 5.08072]; +data.t2d_1y.glucose_max = [6.72340 8.08511 10.76596 12.06383 10.61702 8.06383 6.87234 5.87234 5.53191]; +data.t2d_1y.glucose_std = data.t2d_1y.glucose_max - data.t2d_1y.glucose_mean; +data.t2d_1y.glucose_diff = [0 diff(data.t2d_1y.glucose_mean)]./[1 diff(data.t2d_1y.t)]; + +% ngt post-prandial [mM] +data.ngt_pre.glucose_mean = [5.48956 5.82918 6.53877 6.90695 6.44993 5.87725 5.58912 5.24061 4.86354]; +data.ngt_pre.glucose_max = [5.68950 6.20091 6.92542 7.37291 6.92542 6.15830 5.83866 5.49772 5.17808]; +data.ngt_pre.glucose_std = data.ngt_pre.glucose_max - data.ngt_pre.glucose_mean; +data.ngt_pre.glucose_diff = [0 diff(data.ngt_pre.glucose_mean)]./[1 diff(data.ngt_pre.t)]; + +data.ngt_1wk.glucose_mean = [4.92040 5.77227 6.88029 7.64674 7.61655 6.04798 5.19070 4.95606 4.83503]; +data.ngt_1wk.glucose_max = [5.43379 6.43531 7.33029 8.03349 7.99087 6.45662 5.34855 5.34855 5.11416]; +data.ngt_1wk.glucose_std = data.ngt_1wk.glucose_max - data.ngt_1wk.glucose_mean; +data.ngt_1wk.glucose_diff = [0 diff(data.ngt_1wk.glucose_mean)]./[1 diff(data.ngt_1wk.t)]; + +data.ngt_3mo.glucose_mean = [4.94885 6.25601 8.07541 8.35817 6.93362 4.39752 4.22316 4.64295 4.66440]; +data.ngt_3mo.glucose_max = [5.47641 6.56317 8.67276 8.90715 7.58600 4.79452 4.56012 4.87976 5.05023]; +data.ngt_3mo.glucose_std = data.ngt_3mo.glucose_max - data.ngt_3mo.glucose_mean; +data.ngt_3mo.glucose_diff = [0 diff(data.ngt_3mo.glucose_mean)]./[1 diff(data.ngt_3mo.t)]; + +data.ngt_1y.glucose_mean = [4.94885 6.25601 8.21763 8.61427 6.39292 4.11297 4.22332 4.55784 4.66440]; +data.ngt_1y.glucose_max = [5.54033 6.60578 8.67276 8.90715 6.94673 4.45358 4.53881 4.92237 4.92237]; +data.ngt_1y.glucose_std = data.ngt_1y.glucose_max - data.ngt_1y.glucose_mean; +data.ngt_1y.glucose_diff = [0 diff(data.ngt_1y.glucose_mean)]./[1 diff(data.ngt_1y.t)]; + +% +% insulin +% + +% t2d fasting [nmol/L] +data.t2d_pre.insulin_ss_mean = 125/1000; +data.t2d_pre.insulin_ss_std = 77/1000; + +data.t2d_1wk.insulin_ss_mean = 73/1000; +data.t2d_1wk.insulin_ss_std = 32/1000; + +data.t2d_3mo.insulin_ss_mean = 58/1000; +data.t2d_3mo.insulin_ss_std = 35/1000; + +data.t2d_1y.insulin_ss_mean = 47/1000; +data.t2d_1y.insulin_ss_std = 27/1000; + +% ngt fasting [nmol/L] +data.ngt_pre.insulin_ss_mean = 82/1000; +data.ngt_pre.insulin_ss_std = 28/1000; + +data.ngt_1wk.insulin_ss_mean = 49/1000; +data.ngt_1wk.insulin_ss_std = 14/1000; + +data.ngt_3mo.insulin_ss_mean = 43/1000; +data.ngt_3mo.insulin_ss_std = 14/1000; + +data.ngt_1y.insulin_ss_mean = 36/1000; +data.ngt_1y.insulin_ss_std = 16/1000; + +% t2d post-prandial [nM] +data.t2d_pre.insulin_mean = [0.13170 0.15222 0.29688 0.38983 0.39742 0.35831 0.27523 0.17372 0.11100]; +data.t2d_pre.insulin_max = [0.16265 0.19105 0.37952 0.49828 0.50861 0.41824 0.32272 0.20912 0.14200]; +data.t2d_pre.insulin_std = data.t2d_pre.insulin_max - data.t2d_pre.insulin_mean; +data.t2d_pre.insulin_rel = data.t2d_pre.insulin_mean - data.t2d_pre.insulin_mean(1); + +data.t2d_1wk.insulin_mean = [0.05411 0.14963 0.29947 0.53983 0.53191 0.26261 0.14850 0.08320 0.07738]; +data.t2d_1wk.insulin_max = [0.08778 0.18847 0.38210 0.68158 0.69707 0.31239 0.17040 0.10843 0.10069]; +data.t2d_1wk.insulin_std = data.t2d_1wk.insulin_max - data.t2d_1wk.insulin_mean; +data.t2d_1wk.insulin_rel = data.t2d_1wk.insulin_mean - data.t2d_1wk.insulin_mean(1); + +data.t2d_3mo.insulin_mean = [0.05153 0.17291 0.45206 0.72604 0.58363 0.23158 0.10712 0.05734 0.05152]; +data.t2d_3mo.insulin_max = [0.08778 0.19105 0.53184 0.86231 0.69707 0.28399 0.14716 0.08262 0.07229]; +data.t2d_3mo.insulin_std = data.t2d_3mo.insulin_max - data.t2d_3mo.insulin_mean; +data.t2d_3mo.insulin_rel = data.t2d_3mo.insulin_mean - data.t2d_3mo.insulin_mean(1); + +data.t2d_1y.insulin_mean = [0.04894 0.14446 0.37447 0.58897 0.42328 0.15141 0.07351 0.04182 0.03342]; +data.t2d_1y.insulin_max = [0.08778 0.18847 0.44148 0.68675 0.53959 0.18847 0.09811 0.06454 0.05680]; +data.t2d_1y.insulin_std = data.t2d_1y.insulin_max - data.t2d_1y.insulin_mean; +data.t2d_1y.insulin_rel = data.t2d_1y.insulin_mean - data.t2d_1y.insulin_mean(1); + +% ngt post-prandial [nM] +data.ngt_pre.insulin_mean = [0.04339 0.14100 0.41646 0.51149 0.41065 0.25279 0.14389 0.07045 0.04854] +data.ngt_pre.insulin_max = [0.09840 0.22032 0.49717 0.58856 0.47105 0.36513 0.18173 0.09899 0.07492]; +data.ngt_pre.insulin_std = data.ngt_pre.insulin_max - data.ngt_pre.insulin_mean; +data.ngt_pre.insulin_rel = data.ngt_pre.insulin_mean - data.ngt_pre.insulin_mean(1); + +data.ngt_1wk.insulin_mean = [0.05886 0.14358 0.42161 0.68674 0.64776 0.26827 0.07688 0.05756 0.04082]; +data.ngt_1wk.insulin_max = [0.09840 0.20623 0.49952 0.83270 0.76448 0.36278 0.09958 0.07551 0.05614]; +data.ngt_1wk.insulin_std = data.ngt_1wk.insulin_max - data.ngt_1wk.insulin_mean; +data.ngt_1wk.insulin_rel = data.ngt_1wk.insulin_mean - data.ngt_1wk.insulin_mean(1); + +data.ngt_3mo.insulin_mean = [0.05887 0.27760 0.93965 1.32333 1.01117 0.20897 0.07433 0.04210 0.03309]; +data.ngt_3mo.insulin_max = [0.10075 0.31656 1.14271 1.62612 1.29264 0.36043 0.09723 0.06143 0.04440]; +data.ngt_3mo.insulin_std = data.ngt_3mo.insulin_max - data.ngt_3mo.insulin_mean; +data.ngt_3mo.insulin_rel = data.ngt_3mo.insulin_mean - data.ngt_3mo.insulin_mean(1); + +data.ngt_1y.insulin_mean = [0.05371 0.25183 0.60202 0.89293 0.45703 0.06981 0.03308 0.02664 0.01761]; +data.ngt_1y.insulin_max = [0.09840 0.23910 0.67792 1.02049 0.53912 0.09048 0.06201 0.04030 0.03267]; +data.ngt_1y.insulin_std = data.ngt_1y.insulin_max - data.ngt_1y.insulin_mean; +data.ngt_1y.insulin_rel = data.ngt_1y.insulin_mean - data.ngt_1y.insulin_mean(1); + +% +% c-peptide +% + +% t2d fasting [nmol/L] +data.t2d_pre.cpeptide_ss_mean = 1483/1000; +data.t2d_pre.cpeptide_ss_std = 543/1000; + +data.t2d_1wk.cpeptide_ss_mean = 1175/1000; +data.t2d_1wk.cpeptide_ss_std = 595/1000; + +data.t2d_3mo.cpeptide_ss_mean = 1049/1000; +data.t2d_3mo.cpeptide_ss_std = 501/1000; + +data.t2d_1y.cpeptide_ss_mean = 796/1000; +data.t2d_1y.cpeptide_ss_std = 345/1000; + +% ngt fasting [nmol/L] +data.ngt_pre.cpeptide_ss_mean = 1098/1000; +data.ngt_pre.cpeptide_ss_std = 227/1000; + +data.ngt_1wk.cpeptide_ss_mean = 834/1000; +data.ngt_1wk.cpeptide_ss_std = 187/1000; + +data.ngt_3mo.cpeptide_ss_mean = 816/1000; +data.ngt_3mo.cpeptide_ss_std = 191/1000; + +data.ngt_1y.cpeptide_ss_mean = 602/1000; +data.ngt_1y.cpeptide_ss_std = 198/1000; + +% t2d post-prandial [nM] +data.t2d_pre.cpeptide_mean = [1.56164 1.59817 1.94521 2.23744 2.48402 2.72146 2.70320 2.27397 1.78995]; +data.t2d_pre.cpeptide_max = [1.73183 1.77682 2.21394 2.54165 2.75994 2.90467 2.93090 2.53652 2.02361]; +data.t2d_pre.cpeptide_std = data.t2d_pre.cpeptide_max - data.t2d_pre.cpeptide_mean; +data.t2d_pre.cpeptide_rel = data.t2d_pre.cpeptide_mean - data.t2d_pre.cpeptide_mean(1); + +data.t2d_1wk.cpeptide_mean = [1.12329 1.45205 2.01826 2.94977 3.36073 2.92237 2.42922 1.86301 1.58904]; +data.t2d_1wk.cpeptide_max = [1.38532 1.58535 2.38721 3.24378 3.88151 3.34236 2.75766 2.09883 1.76829]; +data.t2d_1wk.cpeptide_std = data.t2d_1wk.cpeptide_max - data.t2d_1wk.cpeptide_mean; +data.t2d_1wk.cpeptide_rel = data.t2d_1wk.cpeptide_mean - data.t2d_1wk.cpeptide_mean(1); + +data.t2d_3mo.cpeptide_mean = [1.04110 1.38813 2.37443 3.06849 3.44292 2.54795 2.08219 1.44292 1.26027]; +data.t2d_3mo.cpeptide_max = [1.36712 1.59445 2.69723 3.48086 3.89064 2.83172 2.34732 1.67026 1.44002]; +data.t2d_3mo.cpeptide_std = data.t2d_3mo.cpeptide_max - data.t2d_3mo.cpeptide_mean; +data.t2d_3mo.cpeptide_rel = data.t2d_3mo.cpeptide_mean - data.t2d_3mo.cpeptide_mean(1); + +data.t2d_1y.cpeptide_mean = [0.77626 1.29680 2.18265 2.85845 2.73973 1.98174 1.63470 1.11416 0.88584]; +data.t2d_1y.cpeptide_max = [1.00234 1.54885 2.35072 3.22554 3.02438 2.20255 1.85494 1.25992 0.97496]; +data.t2d_1y.cpeptide_std = data.t2d_1y.cpeptide_max - data.t2d_1y.cpeptide_mean; +data.t2d_1y.cpeptide_rel = data.t2d_1y.cpeptide_mean - data.t2d_1y.cpeptide_mean(1); + +% ngt post-prandial [nM] +data.ngt_pre.cpeptide_mean = [1.13338 1.44380 2.21150 2.68655 2.65853 2.22752 1.86966 1.43750 1.08765]; +data.ngt_pre.cpeptide_max = [1.18826 1.55354 2.37618 2.82374 2.83232 2.42874 2.09832 1.61126 1.17911]; +data.ngt_pre.cpeptide_std = data.ngt_pre.cpeptide_max - data.ngt_pre.cpeptide_mean; +data.ngt_pre.cpeptide_rel = data.ngt_pre.cpeptide_mean - data.ngt_pre.cpeptide_mean(1); + +data.ngt_1wk.cpeptide_mean = [0.84069 1.34317 2.39446 3.39996 3.52744 2.72141 1.80563 1.28200 1.03279]; +data.ngt_1wk.cpeptide_max = [0.94132 1.55353 2.69629 3.89386 4.00305 3.19703 2.08917 1.35517 1.09681]; +data.ngt_1wk.cpeptide_std = data.ngt_1wk.cpeptide_max - data.ngt_1wk.cpeptide_mean; +data.ngt_1wk.cpeptide_rel = data.ngt_1wk.cpeptide_mean - data.ngt_1wk.cpeptide_mean(1); + +data.ngt_3mo.cpeptide_mean = [0.84986 1.87369 3.55603 5.00970 4.76219 2.71229 1.60441 1.04421 0.88643]; +data.ngt_3mo.cpeptide_max = [0.94131 1.99256 3.93105 5.68653 5.39328 2.46532 1.88796 1.18141 0.95961]; +data.ngt_3mo.cpeptide_std = data.ngt_3mo.cpeptide_max - data.ngt_3mo.cpeptide_mean; +data.ngt_3mo.cpeptide_rel = data.ngt_3mo.cpeptide_mean - data.ngt_3mo.cpeptide_mean(1); + +data.ngt_1y.cpeptide_mean = [0.59376 1.44378 2.81516 4.03105 3.30792 1.52325 1.09224 0.69665 0.55716]; +data.ngt_1y.cpeptide_max = [0.80413 1.55354 3.08958 4.37860 3.72866 1.69704 1.22029 0.77898 0.61205]; +data.ngt_1y.cpeptide_std = data.ngt_1y.cpeptide_max - data.ngt_1y.cpeptide_mean; +data.ngt_1y.cpeptide_rel = data.ngt_1y.cpeptide_mean - data.ngt_1y.cpeptide_mean(1); \ No newline at end of file diff --git a/models/bariatricData.mat b/models/bariatricData.mat new file mode 100644 index 0000000..5773e82 Binary files /dev/null and b/models/bariatricData.mat differ diff --git a/models/bariatricData_basal.m b/models/bariatricData_basal.m new file mode 100644 index 0000000..0204d4d --- /dev/null +++ b/models/bariatricData_basal.m @@ -0,0 +1,251 @@ +% +% time [min] +% + +% data.t = [0 15 30 45 60 90 120 180 240]; + +data.t2d_pre.t = [-45 -30 -15 0 15 30 45 60 90 120 180 240]; +data.t2d_1wk.t = [-45 -30 -15 0 15 30 45 60 90 120 180 240]; +data.t2d_3mo.t = [-45 -30 -15 0 15 30 45 60 90 120 180 240]; +data.t2d_1y.t = [-45 -30 -15 0 15 30 45 60 90 120 180 240]; +data.ngt_pre.t = [-45 -30 -15 0 15 30 45 60 90 120 180 240]; +data.ngt_1wk.t = [-45 -30 -15 0 15 30 45 60 90 120 180 240]; +data.ngt_3mo.t = [-45 -30 -15 0 15 30 45 60 90 120 180 240]; +data.ngt_1y.t = [-45 -30 -15 0 15 30 45 60 90 120 180 240]; + +% +% body weight +% + +data.t2d_pre.m_mean = 128.8; +data.t2d_pre.m_std = 13.9; +data.t2d_1wk.m_mean = 127; +data.t2d_1wk.m_std = 13.1; +data.t2d_3mo.m_mean = 112.1; +data.t2d_3mo.m_std = 15.0; +data.t2d_1y.m_mean = 100.8; +data.t2d_1y.m_std = 19.5; +data.ngt_pre.m_mean = 126.6; +data.ngt_pre.m_std = 15.4; +data.ngt_1wk.m_mean = 123.5; +data.ngt_1wk.m_std = 14.7; +data.ngt_3mo.m_mean = 105.5; +data.ngt_3mo.m_std = 13.0; +data.ngt_1y.m_mean = 94.7; +data.ngt_1y.m_std = 16.0; + +% +% glucose +% + +% t2d fasting [mmol/L] +data.t2d_pre.glucose_ss_mean = 8.8; +data.t2d_pre.glucose_ss_std = 2.3; + +data.t2d_1wk.glucose_ss_mean = 7.0; +data.t2d_1wk.glucose_ss_std = 1.2; + +data.t2d_3mo.glucose_ss_mean = 6.8; +data.t2d_3mo.glucose_ss_std = 1.6; + +data.t2d_1y.glucose_ss_mean = 6.2; +data.t2d_1y.glucose_ss_std = 1.6; + +% ngt fasting [mmol/L] +data.ngt_pre.glucose_ss_mean = 5.5; +data.ngt_pre.glucose_ss_std = 0.6; + +data.ngt_1wk.glucose_ss_mean = 5.0; +data.ngt_1wk.glucose_ss_std = 0.6; + +data.ngt_3mo.glucose_ss_mean = 4.9; +data.ngt_3mo.glucose_ss_std = 0.4; + +data.ngt_1y.glucose_ss_mean = 4.9; +data.ngt_1y.glucose_ss_std = 0.3; + +% t2d post-prandial [mM] +data.t2d_pre.glucose_mean = [8.77244 8.77244 8.77244 8.77244 8.85589 9.99010 11.35133 12.11621 12.22632 11.39915 9.31906 7.86372]; +data.t2d_pre.glucose_max = [9.44681 9.44681 9.44681 9.44681 9.59575 10.80851 12.14894 12.82979 13.08511 12.31915 10.27660 8.74468]; +data.t2d_pre.glucose_std = data.t2d_pre.glucose_max - data.t2d_pre.glucose_mean; +data.t2d_pre.glucose_diff = [0 diff(data.t2d_pre.glucose_mean)]./[1 diff(data.t2d_pre.t)]; + +data.t2d_1wk.glucose_mean = [6.81301 6.81301 6.81301 6.81301 7.52126 9.08133 10.64139 11.09391 9.44337 8.13344 6.70645 6.10303]; +data.t2d_1wk.glucose_max = [7.31915 7.31915 7.31915 7.31915 8.08511 9.63830 11.27660 11.74468 10.19149 8.89362 7.36170 6.61702]; +data.t2d_1wk.glucose_std = data.t2d_1wk.glucose_max - data.t2d_1wk.glucose_mean; +data.t2d_1wk.glucose_diff = [0 diff(data.t2d_1wk.glucose_mean)]./[1 diff(data.t2d_1wk.t)]; + +data.t2d_3mo.glucose_mean = [6.81301 6.81301 6.81301 6.81301 7.46447 9.81966 11.18089 10.32723 7.96670 6.82716 5.99661 5.64872]; +data.t2d_3mo.glucose_max = [7.31915 7.31915 7.31915 7.31915 8.08511 10.74468 12.04255 11.10638 8.74468 7.55319 6.57447 6.21277]; +data.t2d_3mo.glucose_std = data.t2d_3mo.glucose_max - data.t2d_3mo.glucose_mean; +data.t2d_3mo.glucose_diff = [0 diff(data.t2d_3mo.glucose_mean)]./[1 diff(data.t2d_3mo.t)]; + +data.t2d_1y.glucose_mean = [6.15993 6.15993 6.15993 6.15993 7.46441 9.99005 11.09575 9.81607 7.31356 6.23081 5.34337 5.08072]; +data.t2d_1y.glucose_max = [6.72340 6.72340 6.72340 6.72340 8.08511 10.76596 12.06383 10.61702 8.06383 6.87234 5.87234 5.53191]; +data.t2d_1y.glucose_std = data.t2d_1y.glucose_max - data.t2d_1y.glucose_mean; +data.t2d_1y.glucose_diff = [0 diff(data.t2d_1y.glucose_mean)]./[1 diff(data.t2d_1y.t)]; + +% ngt post-prandial [mM] +data.ngt_pre.glucose_mean = [5.48956 5.48956 5.48956 5.48956 5.82918 6.53877 6.90695 6.44993 5.87725 5.58912 5.24061 4.86354]; +data.ngt_pre.glucose_max = [5.68950 5.68950 5.68950 5.68950 6.20091 6.92542 7.37291 6.92542 6.15830 5.83866 5.49772 5.17808]; +data.ngt_pre.glucose_std = data.ngt_pre.glucose_max - data.ngt_pre.glucose_mean; +data.ngt_pre.glucose_diff = [0 diff(data.ngt_pre.glucose_mean)]./[1 diff(data.ngt_pre.t)]; + +data.ngt_1wk.glucose_mean = [4.92040 4.92040 4.92040 4.92040 5.77227 6.88029 7.64674 7.61655 6.04798 5.19070 4.95606 4.83503]; +data.ngt_1wk.glucose_max = [5.43379 5.43379 5.43379 5.43379 6.43531 7.33029 8.03349 7.99087 6.45662 5.34855 5.34855 5.11416]; +data.ngt_1wk.glucose_std = data.ngt_1wk.glucose_max - data.ngt_1wk.glucose_mean; +data.ngt_1wk.glucose_diff = [0 diff(data.ngt_1wk.glucose_mean)]./[1 diff(data.ngt_1wk.t)]; + +data.ngt_3mo.glucose_mean = [4.94885 4.94885 4.94885 4.94885 6.25601 8.07541 8.35817 6.93362 4.39752 4.22316 4.64295 4.66440]; +data.ngt_3mo.glucose_max = [5.47641 5.47641 5.47641 5.47641 6.56317 8.67276 8.90715 7.58600 4.79452 4.56012 4.87976 5.05023]; +data.ngt_3mo.glucose_std = data.ngt_3mo.glucose_max - data.ngt_3mo.glucose_mean; +data.ngt_3mo.glucose_diff = [0 diff(data.ngt_3mo.glucose_mean)]./[1 diff(data.ngt_3mo.t)]; + +data.ngt_1y.glucose_mean = [4.94885 4.94885 4.94885 4.94885 6.25601 8.21763 8.61427 6.39292 4.11297 4.22332 4.55784 4.66440]; +data.ngt_1y.glucose_max = [5.54033 5.54033 5.54033 5.54033 6.60578 8.67276 8.90715 6.94673 4.45358 4.53881 4.92237 4.92237]; +data.ngt_1y.glucose_std = data.ngt_1y.glucose_max - data.ngt_1y.glucose_mean; +data.ngt_1y.glucose_diff = [0 diff(data.ngt_1y.glucose_mean)]./[1 diff(data.ngt_1y.t)]; + +% +% insulin +% + +% t2d fasting [nmol/L] +data.t2d_pre.insulin_ss_mean = 125/1000; +data.t2d_pre.insulin_ss_std = 77/1000; + +data.t2d_1wk.insulin_ss_mean = 73/1000; +data.t2d_1wk.insulin_ss_std = 32/1000; + +data.t2d_3mo.insulin_ss_mean = 58/1000; +data.t2d_3mo.insulin_ss_std = 35/1000; + +data.t2d_1y.insulin_ss_mean = 47/1000; +data.t2d_1y.insulin_ss_std = 27/1000; + +% ngt fasting [nmol/L] +data.ngt_pre.insulin_ss_mean = 82/1000; +data.ngt_pre.insulin_ss_std = 28/1000; + +data.ngt_1wk.insulin_ss_mean = 49/1000; +data.ngt_1wk.insulin_ss_std = 14/1000; + +data.ngt_3mo.insulin_ss_mean = 43/1000; +data.ngt_3mo.insulin_ss_std = 14/1000; + +data.ngt_1y.insulin_ss_mean = 36/1000; +data.ngt_1y.insulin_ss_std = 16/1000; + +% t2d post-prandial [nM] +data.t2d_pre.insulin_mean = [0.13170 0.13170 0.13170 0.13170 0.15222 0.29688 0.38983 0.39742 0.35831 0.27523 0.17372 0.11100]; +data.t2d_pre.insulin_max = [0.16265 0.16265 0.16265 0.16265 0.19105 0.37952 0.49828 0.50861 0.41824 0.32272 0.20912 0.14200]; +data.t2d_pre.insulin_std = data.t2d_pre.insulin_max - data.t2d_pre.insulin_mean; +data.t2d_pre.insulin_rel = data.t2d_pre.insulin_mean - data.t2d_pre.insulin_mean(1); + +data.t2d_1wk.insulin_mean = [0.05411 0.05411 0.05411 0.05411 0.14963 0.29947 0.53983 0.53191 0.26261 0.14850 0.08320 0.07738]; +data.t2d_1wk.insulin_max = [0.08778 0.08778 0.08778 0.08778 0.18847 0.38210 0.68158 0.69707 0.31239 0.17040 0.10843 0.10069]; +data.t2d_1wk.insulin_std = data.t2d_1wk.insulin_max - data.t2d_1wk.insulin_mean; +data.t2d_1wk.insulin_rel = data.t2d_1wk.insulin_mean - data.t2d_1wk.insulin_mean(1); + +data.t2d_3mo.insulin_mean = [0.05153 0.05153 0.05153 0.05153 0.17291 0.45206 0.72604 0.58363 0.23158 0.10712 0.05734 0.05152]; +data.t2d_3mo.insulin_max = [0.08778 0.08778 0.08778 0.08778 0.19105 0.53184 0.86231 0.69707 0.28399 0.14716 0.08262 0.07229]; +data.t2d_3mo.insulin_std = data.t2d_3mo.insulin_max - data.t2d_3mo.insulin_mean; +data.t2d_3mo.insulin_rel = data.t2d_3mo.insulin_mean - data.t2d_3mo.insulin_mean(1); + +data.t2d_1y.insulin_mean = [0.04894 0.04894 0.04894 0.04894 0.14446 0.37447 0.58897 0.42328 0.15141 0.07351 0.04182 0.03342]; +data.t2d_1y.insulin_max = [0.08778 0.08778 0.08778 0.08778 0.18847 0.44148 0.68675 0.53959 0.18847 0.09811 0.06454 0.05680]; +data.t2d_1y.insulin_std = data.t2d_1y.insulin_max - data.t2d_1y.insulin_mean; +data.t2d_1y.insulin_rel = data.t2d_1y.insulin_mean - data.t2d_1y.insulin_mean(1); + +% ngt post-prandial [nM] +data.ngt_pre.insulin_mean = [0.04339 0.04339 0.04339 0.04339 0.14100 0.41646 0.51149 0.41065 0.25279 0.14389 0.07045 0.04854] +data.ngt_pre.insulin_max = [0.09840 0.09840 0.09840 0.09840 0.22032 0.49717 0.58856 0.47105 0.36513 0.18173 0.09899 0.07492]; +data.ngt_pre.insulin_std = data.ngt_pre.insulin_max - data.ngt_pre.insulin_mean; +data.ngt_pre.insulin_rel = data.ngt_pre.insulin_mean - data.ngt_pre.insulin_mean(1); + +data.ngt_1wk.insulin_mean = [0.05886 0.05886 0.05886 0.05886 0.14358 0.42161 0.68674 0.64776 0.26827 0.07688 0.05756 0.04082]; +data.ngt_1wk.insulin_max = [0.09840 0.09840 0.09840 0.09840 0.20623 0.49952 0.83270 0.76448 0.36278 0.09958 0.07551 0.05614]; +data.ngt_1wk.insulin_std = data.ngt_1wk.insulin_max - data.ngt_1wk.insulin_mean; +data.ngt_1wk.insulin_rel = data.ngt_1wk.insulin_mean - data.ngt_1wk.insulin_mean(1); + +data.ngt_3mo.insulin_mean = [0.05887 0.05887 0.05887 0.05887 0.27760 0.93965 1.32333 1.01117 0.20897 0.07433 0.04210 0.03309]; +data.ngt_3mo.insulin_max = [0.10075 0.10075 0.10075 0.10075 0.31656 1.14271 1.62612 1.29264 0.36043 0.09723 0.06143 0.04440]; +data.ngt_3mo.insulin_std = data.ngt_3mo.insulin_max - data.ngt_3mo.insulin_mean; +data.ngt_3mo.insulin_rel = data.ngt_3mo.insulin_mean - data.ngt_3mo.insulin_mean(1); + +data.ngt_1y.insulin_mean = [0.05371 0.05371 0.05371 0.05371 0.25183 0.60202 0.89293 0.45703 0.06981 0.03308 0.02664 0.01761]; +data.ngt_1y.insulin_max = [0.09840 0.09840 0.09840 0.09840 0.23910 0.67792 1.02049 0.53912 0.09048 0.06201 0.04030 0.03267]; +data.ngt_1y.insulin_std = data.ngt_1y.insulin_max - data.ngt_1y.insulin_mean; +data.ngt_1y.insulin_rel = data.ngt_1y.insulin_mean - data.ngt_1y.insulin_mean(1); + +% +% c-peptide +% + +% t2d fasting [nmol/L] +data.t2d_pre.cpeptide_ss_mean = 1483/1000; +data.t2d_pre.cpeptide_ss_std = 543/1000; + +data.t2d_1wk.cpeptide_ss_mean = 1175/1000; +data.t2d_1wk.cpeptide_ss_std = 595/1000; + +data.t2d_3mo.cpeptide_ss_mean = 1049/1000; +data.t2d_3mo.cpeptide_ss_std = 501/1000; + +data.t2d_1y.cpeptide_ss_mean = 796/1000; +data.t2d_1y.cpeptide_ss_std = 345/1000; + +% ngt fasting [nmol/L] +data.ngt_pre.cpeptide_ss_mean = 1098/1000; +data.ngt_pre.cpeptide_ss_std = 227/1000; + +data.ngt_1wk.cpeptide_ss_mean = 834/1000; +data.ngt_1wk.cpeptide_ss_std = 187/1000; + +data.ngt_3mo.cpeptide_ss_mean = 816/1000; +data.ngt_3mo.cpeptide_ss_std = 191/1000; + +data.ngt_1y.cpeptide_ss_mean = 602/1000; +data.ngt_1y.cpeptide_ss_std = 198/1000; + +% t2d post-prandial [nM] +data.t2d_pre.cpeptide_mean = [1.56164 1.56164 1.56164 1.56164 1.59817 1.94521 2.23744 2.48402 2.72146 2.70320 2.27397 1.78995]; +data.t2d_pre.cpeptide_max = [1.73183 1.73183 1.73183 1.73183 1.77682 2.21394 2.54165 2.75994 2.90467 2.93090 2.53652 2.02361]; +data.t2d_pre.cpeptide_std = data.t2d_pre.cpeptide_max - data.t2d_pre.cpeptide_mean; +data.t2d_pre.cpeptide_rel = data.t2d_pre.cpeptide_mean - data.t2d_pre.cpeptide_mean(1); + +data.t2d_1wk.cpeptide_mean = [1.12329 1.12329 1.12329 1.12329 1.45205 2.01826 2.94977 3.36073 2.92237 2.42922 1.86301 1.58904]; +data.t2d_1wk.cpeptide_max = [1.38532 1.38532 1.38532 1.38532 1.58535 2.38721 3.24378 3.88151 3.34236 2.75766 2.09883 1.76829]; +data.t2d_1wk.cpeptide_std = data.t2d_1wk.cpeptide_max - data.t2d_1wk.cpeptide_mean; +data.t2d_1wk.cpeptide_rel = data.t2d_1wk.cpeptide_mean - data.t2d_1wk.cpeptide_mean(1); + +data.t2d_3mo.cpeptide_mean = [1.04110 1.04110 1.04110 1.04110 1.38813 2.37443 3.06849 3.44292 2.54795 2.08219 1.44292 1.26027]; +data.t2d_3mo.cpeptide_max = [1.36712 1.36712 1.36712 1.36712 1.59445 2.69723 3.48086 3.89064 2.83172 2.34732 1.67026 1.44002]; +data.t2d_3mo.cpeptide_std = data.t2d_3mo.cpeptide_max - data.t2d_3mo.cpeptide_mean; +data.t2d_3mo.cpeptide_rel = data.t2d_3mo.cpeptide_mean - data.t2d_3mo.cpeptide_mean(1); + +data.t2d_1y.cpeptide_mean = [0.77626 0.77626 0.77626 0.77626 1.29680 2.18265 2.85845 2.73973 1.98174 1.63470 1.11416 0.88584]; +data.t2d_1y.cpeptide_max = [1.00234 1.00234 1.00234 1.00234 1.54885 2.35072 3.22554 3.02438 2.20255 1.85494 1.25992 0.97496]; +data.t2d_1y.cpeptide_std = data.t2d_1y.cpeptide_max - data.t2d_1y.cpeptide_mean; +data.t2d_1y.cpeptide_rel = data.t2d_1y.cpeptide_mean - data.t2d_1y.cpeptide_mean(1); + +% ngt post-prandial [nM] +data.ngt_pre.cpeptide_mean = [1.13338 1.13338 1.13338 1.13338 1.44380 2.21150 2.68655 2.65853 2.22752 1.86966 1.43750 1.08765]; +data.ngt_pre.cpeptide_max = [1.18826 1.18826 1.18826 1.18826 1.55354 2.37618 2.82374 2.83232 2.42874 2.09832 1.61126 1.17911]; +data.ngt_pre.cpeptide_std = data.ngt_pre.cpeptide_max - data.ngt_pre.cpeptide_mean; +data.ngt_pre.cpeptide_rel = data.ngt_pre.cpeptide_mean - data.ngt_pre.cpeptide_mean(1); + +data.ngt_1wk.cpeptide_mean = [0.84069 0.84069 0.84069 0.84069 1.34317 2.39446 3.39996 3.52744 2.72141 1.80563 1.28200 1.03279]; +data.ngt_1wk.cpeptide_max = [0.94132 0.94132 0.94132 0.94132 1.55353 2.69629 3.89386 4.00305 3.19703 2.08917 1.35517 1.09681]; +data.ngt_1wk.cpeptide_std = data.ngt_1wk.cpeptide_max - data.ngt_1wk.cpeptide_mean; +data.ngt_1wk.cpeptide_rel = data.ngt_1wk.cpeptide_mean - data.ngt_1wk.cpeptide_mean(1); + +data.ngt_3mo.cpeptide_mean = [0.84986 0.84986 0.84986 0.84986 1.87369 3.55603 5.00970 4.76219 2.71229 1.60441 1.04421 0.88643]; +data.ngt_3mo.cpeptide_max = [0.94131 0.94131 0.94131 0.94131 1.99256 3.93105 5.68653 5.39328 2.46532 1.88796 1.18141 0.95961]; +data.ngt_3mo.cpeptide_std = data.ngt_3mo.cpeptide_max - data.ngt_3mo.cpeptide_mean; +data.ngt_3mo.cpeptide_rel = data.ngt_3mo.cpeptide_mean - data.ngt_3mo.cpeptide_mean(1); + +data.ngt_1y.cpeptide_mean = [0.59376 0.59376 0.59376 0.59376 1.44378 2.81516 4.03105 3.30792 1.52325 1.09224 0.69665 0.55716]; +data.ngt_1y.cpeptide_max = [0.80413 0.80413 0.80413 0.80413 1.55354 3.08958 4.37860 3.72866 1.69704 1.22029 0.77898 0.61205]; +data.ngt_1y.cpeptide_std = data.ngt_1y.cpeptide_max - data.ngt_1y.cpeptide_mean; +data.ngt_1y.cpeptide_rel = data.ngt_1y.cpeptide_mean - data.ngt_1y.cpeptide_mean(1); \ No newline at end of file diff --git a/models/minCPepModel/minCPepData.m b/models/minCPepModel/minCPepData.m new file mode 100644 index 0000000..c8e571a --- /dev/null +++ b/models/minCPepModel/minCPepData.m @@ -0,0 +1,26 @@ +function DATASET = minCPepData() + +DATASET.DESCRIPTION = 'Bariatric surgery data'; + +DATASET.FILE = 'bariatricData'; +DATASET.TYPE = 'Collection'; + +DATASET.GROUPS = { + 't2d_pre' + 't2d_1wk' + 't2d_3mo' + 't2d_1y' + 'ngt_pre' + 'ngt_1wk' + 'ngt_3mo' + 'ngt_1y' +}; + +DATASET.FIELDS = { + 'G' 0 't' 'glucose_mean' 'glucose_std' 1e9 [] + 'dGdt' 0 't' 'glucose_diff' 'glucose_std' 1e9 [] + 'CP' 1 't' 'cpeptide_mean' 'cpeptide_std' 1e3 [] + 'I' 0 't' 'insulin_mean' 'insulin_std' 1e3 [] + + 'BW' 0 [] 'm_mean' 'm_std' 1 [] +}; \ No newline at end of file diff --git a/models/minCPepModel/minCPepModel.m b/models/minCPepModel/minCPepModel.m new file mode 100644 index 0000000..fc0ee36 --- /dev/null +++ b/models/minCPepModel/minCPepModel.m @@ -0,0 +1,82 @@ +function MODEL = minCPepModel() + +MODEL.DESCRIPTION = 'Minimal CPeptide model by Dalla Man et. al'; + +MODEL.PREDICTOR = { + 't' [0 240] {'time' 'min' 'time'} +}; + +MODEL.CONSTANTS = { + 'BW' 'BW' {} + 'Gb' 'G' {} + 'CPb' 'CP' {} + 'Ib' 'I' {} +}; + +MODEL.INPUTS = { + 'G' 'Data' {'G'} 'Linear' {} + 'dGdt' 'Data' {'dGdt'} 'Linear' {} + + 'HE' 'Function' {[-45 0 15 30 45 60 90 120 180 240],'heb','he0','he1','he2','he3','he4','he5','he6','he7','he8',} 'Linear' {} +}; + +MODEL.PARAMETERS = { + % van Cauter + 'k01' 0 .067 [] {} + 'k12' 0 .051 [] {} + 'k21' 0 .065 [] {} + 'dV' 0 .0422 [] {} + + % Campioni + 'PHId' 1 200 [] {'' '-' 'kG'} + 'PHIs' 1 20 [] {'' '1/min' 'beta'} + 'T' 0 1 [] {} + + % Insulin + 'Vi' 0 10 [] {} + + % Hepatic extraction + 'heb' 0 .6 [0 1] {} % + 'he0' 0 .6 [0 1] {} % + 'he1' 1 .6 [0 1] {} % + 'he2' 1 .6 [0 1] {} % + 'he3' 1 .6 [0 1] {} % + 'he4' 1 .6 [0 1] {} % HE pars + 'he5' 1 .6 [0 1] {} % + 'he6' 1 .6 [0 1] {} % + 'he7' 1 .6 [0 1] {} % + 'he8' 1 .6 [0 1] {} % + +% 'HE' 0 .6 [0 1] {} +}; + +MODEL.STATES = { + 'CP1' 0 '-(k01 + k21) * CP1 + k12 * CP2 + SR' {} + 'CP2' 0 '-k12 * CP2 + k21 * CP1' {} + 'Y' 0 '-1/T * (Y - PHIs * 10^-9 * pG)' {} + 'I' 'I' '-(CL/Vi) * I + IDR / Vi' {} +}; + +MODEL.REACTIONS = { + 'V1' 'dV * BW' {} + + 'pdGdt' 'if((G < Gb) || (dGdt < 0), 0, dGdt)' {} + 'pG' 'if((G < Gb), 0, G-Gb)' {} + + 'SRs' 'Y' {} + 'SRd' 'PHId * 10^-9 * pdGdt' {} + 'SRb' 'CPb * k01' {} + + 'SR' 'SRs + SRd' {} + + 'ISR' '(SR + SRb) * V1' {} + 'ISR2' 'ISR / BW' {} + + 'CP' 'CP1 + CPb' {'conc.' 'pM' 'CPeptide'} + + 'PHIb' 'SRb / Gb' {} + + % Insulin + 'IDR' 'ISR * (1 - HE)' {} + 'CL' 'SRb * V1 * (1 - heb) / Ib' {} +}; \ No newline at end of file diff --git a/models/minCPepModel/minCPepModel2.m b/models/minCPepModel/minCPepModel2.m new file mode 100644 index 0000000..e8f21d5 --- /dev/null +++ b/models/minCPepModel/minCPepModel2.m @@ -0,0 +1,69 @@ +function MODEL = minCPepModel() + +MODEL.DESCRIPTION = 'Minimal CPeptide model by Dalla Man et. al'; + +MODEL.PREDICTOR = { + 't' [0 240] {'time' 'min' 'time'} +}; + +MODEL.CONSTANTS = { + 'BW' 'BW' {} + 'Gb' 'G' {} + 'CPb' 'CP' {} + 'Ib' 'I' {} +}; + +MODEL.INPUTS = { + 'G' 'Data' {'G'} 'Linear' {} + 'dGdt' 'Data' {'dGdt'} 'Linear' {} + 'CPI' 'Data' {'CP'} 'Linear' {} +}; + +MODEL.PARAMETERS = { + % van Cauter + 'k01' 0 .067 [] {} + 'k12' 0 .051 [] {} + 'k21' 0 .065 [] {} + 'dV' 0 .0422 [] {} + + % Campioni + 'PHId' 0 1160 [] {'' '-' 'kG'} + 'PHIs' 0 41 [] {'' '1/min' 'beta'} + 'T' 0 10 [] {} + + % Insulin + 'CL' 0 1.7 [] {} + 'Vi' 0 10 [] {} + + 'HE' 1 .6 [0 1] {} +}; + +MODEL.STATES = { + 'CP1' 0 '-(k01 + k21) * CP1 + k12 * CP2 + SR' {} + 'CP2' 0 '-k12 * CP2 + k21 * CP1' {} + 'Y' 0 '-1/T * (Y - PHIs * 10^-9 * pG)' {} + 'I' 'I' '-(CL/Vi) * I + IDR / Vi' {} +}; + +MODEL.REACTIONS = { + 'V1' 'dV * BW' {} + + 'pdGdt' 'if((G < Gb) || (dGdt < 0), 0, dGdt)' {} + 'pG' 'if((G < Gb), 0, G-Gb)' {} + + 'SRs' 'Y' {} + 'SRd' 'PHId * 10^-9 * pdGdt' {} + 'SRb' 'CPb * k01' {} + + 'SR' 'SRs + SRd' {} + + 'ISR' '(SR + SRb) * V1' {} + 'ISR2' 'ISR / BW' {} + + 'CP' 'CP1 + CPb' {'conc.' 'pM' 'CPeptide'} + + 'PHIb' 'SRb / Gb' {} + + % Insulin + 'IDR' 'ISR * (1 - HE)' {} +}; \ No newline at end of file diff --git a/models/minCPepModel/minCPepReg.m b/models/minCPepModel/minCPepReg.m new file mode 100644 index 0000000..4b235e2 --- /dev/null +++ b/models/minCPepModel/minCPepReg.m @@ -0,0 +1,10 @@ +function E = minCPepReg(model, m, d) + +r = model.result; + +ISRi = trapz(r.time, r.vcurr(:, m.v.ISR)); +IDRi = trapz(r.time, r.vcurr(:, m.v.IDR)); + +HE = 1 - IDRi / ISRi; + +E = (HE - .4) * 100; \ No newline at end of file diff --git a/models/minCPepModel/runMinCPep.asv b/models/minCPepModel/runMinCPep.asv new file mode 100644 index 0000000..b713949 --- /dev/null +++ b/models/minCPepModel/runMinCPep.asv @@ -0,0 +1,45 @@ +%% initialize + +import AMF.* + +model = Model('minCPepModel'); +data = DataSet('minCPepData'); + +loadGroup(data, 'ngt_1wk'); +initiateExperiment(model, data); + +%% config + +model.options.optimset.Display = 'iter'; +model.options.useMex = 1; + +parseAll(model); +compileAll(model); + +%% run + +model.functions.reg = @minCPepReg; + +result = fit(model); +% result = simulate(model); + +%% plot +close all; + +plot(result, {'CP','ISR2','I','HE','G','IDR'}); +% manipulate(model, 'CP'); + +fprintf('\n'); +fprintf('T: %.2f\n', getValue(result, 'T', 1)) +fprintf('PHIb: %.2f\n', getValue(result, 'PHIb', 1) * 1e9) +fprintf('PHId: %.2f\n', getValue(result, 'PHId', 1)) +fprintf('PHIs: %.2f\n', getValue(result, 'PHIs', 1)) + +ISR = getValue(result, 'ISR'); +IDR = getValue(result, 'IDR'); + +ISRi = trapz(result.time, ISR); +IDRi = trapz(result.time, IDR); + +fprintf('HE: %.2f\n', 1-IDRi/ISRi); +fprintf('\n'); \ No newline at end of file diff --git a/models/minCPepModel/runMinCPep.m b/models/minCPepModel/runMinCPep.m new file mode 100644 index 0000000..e4097b9 --- /dev/null +++ b/models/minCPepModel/runMinCPep.m @@ -0,0 +1,45 @@ +%% initialize + +import AMF.* + +model = Model('minCPepModel'); +data = DataSet('minCPepData'); + +loadGroup(data, 'ngt_pre'); +initiateExperiment(model, data); + +%% config + +model.options.optimset.Display = 'iter'; +model.options.useMex = 1; + +parseAll(model); +compileAll(model); + +%% run + +% model.functions.reg = @minCPepReg; + +result = fit(model); +% result = simulate(model); + +%% plot +close all; + +plot(result, {'CP','ISR2','I','HE','G','IDR'}); +% manipulate(model, 'CP'); + +fprintf('\n'); +fprintf('T: %.2f\n', getValue(result, 'T', 1)) +fprintf('PHIb: %.2f\n', getValue(result, 'PHIb', 1) * 1e9) +fprintf('PHId: %.2f\n', getValue(result, 'PHId', 1)) +fprintf('PHIs: %.2f\n', getValue(result, 'PHIs', 1)) + +ISR = getValue(result, 'ISR'); +IDR = getValue(result, 'IDR'); + +ISRi = trapz(result.time, ISR); +IDRi = trapz(result.time, IDR); + +fprintf('HE: %.2f\n', 1-IDRi/ISRi); +fprintf('\n'); \ No newline at end of file diff --git a/models/minCPepModel/runMinCPep2.m b/models/minCPepModel/runMinCPep2.m new file mode 100644 index 0000000..488490c --- /dev/null +++ b/models/minCPepModel/runMinCPep2.m @@ -0,0 +1,38 @@ +%% initialize + +import AMF.* + +model = Model('minCPepModel2'); +data = DataSet('minCPepData'); + +loadGroup(data, 't2d_3mo'); +initiateExperiment(model, data); + +%% config + +model.options.optimset.Display = 'off'; +model.options.useMex = 1; +model.options.numIter = 1; +model.options.numTimeSteps = 20; +model.options.SStime = 30; +model.options.seed = 2; +model.options.randPars = 0; +model.options.randData = 0; + +parseAll(model); +compileAll(model); + +%% run + +% model.functions.reg = @minCPepReg; + +result = runADAPT(model); + +%% plot +close all; + +plot(result, {'CP','CP1','I','HE','G','dGdt','pdGdt','SRd','SRs'}); + +% pdGdt haywire - standard deviations too big (will be better if calculated +% using propagation of uncertainty. Will be fixed in combined minModel (no +% inputs just states). \ No newline at end of file diff --git a/models/minGlucModel/minGlucData.m b/models/minGlucModel/minGlucData.m new file mode 100644 index 0000000..70a57dd --- /dev/null +++ b/models/minGlucModel/minGlucData.m @@ -0,0 +1,25 @@ +function DATASET = minGlucData() + +import AMF.functions.* + +DATASET.DESCRIPTION = 'Bariatric surgery data'; + +DATASET.FILE = 'bariatricData'; +DATASET.TYPE = 'Collection'; + +DATASET.GROUPS = { + 't2d_pre' + 't2d_1wk' + 't2d_3mo' + 't2d_1y' + 'ngt_pre' + 'ngt_1wk' + 'ngt_3mo' + 'ngt_1y' +}; + +DATASET.FIELDS = { + 'G' 1 't' 'glucose_mean' 'glucose_std' 1e9 [] + 'I' 0 't' 'insulin_mean' 'insulin_std' 1e3 [] + 'BW' 0 [] 'm_mean' 'm_std' 1 [] +}; \ No newline at end of file diff --git a/models/minGlucModel/minGlucModel.m b/models/minGlucModel/minGlucModel.m new file mode 100644 index 0000000..ece8e90 --- /dev/null +++ b/models/minGlucModel/minGlucModel.m @@ -0,0 +1,54 @@ +function MODEL = minGlucModel() + +MODEL.DESCRIPTION = 'Minimal Glucose model by Dalla Man et. al'; + +MODEL.PREDICTOR = { + 't' [0 240] {'time' 'min' 'time'} +}; + +MODEL.CONSTANTS = { + 'Gtot' 40 {'mass' 'g' 'Gluc intake'} + 'Vg' 1.7 {'' 'dl/kg' 'dV gluc'} + 'BW' 'BW' {'mass' 'kg' 'Avg. BW'} + 'Gb' 'G' {} + 'Ib' 'I' {} +}; + +MODEL.INPUTS = { + 'I' 'Data' {'I'} 'Linear' {'conc.' 'uU/ml' 'Insulin'} + 'Ra' 'Function' {[-45 0 15 30 45 60 90 120 180 240], 'rab', 'ra0', 'ra1', 'ra2', 'ra3', 'ra4', 'ra5', 'ra6', 'ra7', 'ra8',} 'Linear' {'' 'mg/kg/min' 'Rate of appearance'} +}; + +MODEL.PARAMETERS = { + 'p1' 0 .014 [] {'rate' '1/min' 'p1'} % Fractional glucose effectiveness (GE) + 'p2' 0 .03 [] {'rate' '1/min' 'p2'} % Rate constant of remove insulin compartment + 'p3' 1 1e-6 [] {'rate' 'ml/uU' 'p3'} % Scale factor for amplitude of insulin action + + 'rab' 0 0 [] {} + 'ra0' 0 0 [] {} % + 'ra1' 1 1 [] {} % + 'ra2' 1 1 [] {} % + 'ra3' 1 1 [] {} % + 'ra4' 1 1 [] {} % Rate of appearence parameters + 'ra5' 1 1 [] {} % + 'ra6' 1 1 [] {} % + 'ra7' 1 1 [] {} % + 'ra8' 1 1 [] {} % +}; + +MODEL.STATES = { + 'G' 'G' 'dGdt' {'conc.' 'mg/dl' 'Glucose'} + 'X' 0 'dXdt' {'' '-' 'Insulin action'} + 'Gin' 0 'Ra_g' {'mass' 'g' 'App. gluc'} +}; + +MODEL.REACTIONS = { + 'Ir' 'if((I-Ib) > 0, I-Ib,0)' {} + + 'dGdt' '-(p1 + X) * G + p1 * Gb + Ra/Vg * 1e9/18.0182' {} + 'dXdt' '-p2 * X + p3/6.94 * Ir' {} + + % --- + 'Ra_g' 'Ra * BW / 1000' {'' 'g/min' 'Ra'} + 'SI' 'p3/p2' {'' '1/min/(uU/ml)' 'Frac. SI idx'} +}; \ No newline at end of file diff --git a/models/minGlucModel/minGlucReg.m b/models/minGlucModel/minGlucReg.m new file mode 100644 index 0000000..38310a7 --- /dev/null +++ b/models/minGlucModel/minGlucReg.m @@ -0,0 +1,7 @@ +function E = minGlucReg(model, m, d) + +r = model.result; + +AUC = trapz(r.time, r.vcurr(:, m.v.Ra_g)); + +E = AUC - m.c.Gtot; \ No newline at end of file diff --git a/models/minGlucModel/runMinGluc.m b/models/minGlucModel/runMinGluc.m new file mode 100644 index 0000000..17b148d --- /dev/null +++ b/models/minGlucModel/runMinGluc.m @@ -0,0 +1,33 @@ +%% initialize + +import AMF.* + +model = Model('minGlucModel'); +data = DataSet('minGlucData'); + +loadGroup(data, 'ngt_pre'); +initiateExperiment(model, data); + + +%% config + +model.options.optimset.Display = 'iter'; +model.options.useMex = 1; + +parseAll(model); +compileAll(model); + +%% run + +model.functions.reg = @minGlucReg; + +result = fit(model); +result = simulate(model); + +%% plot + +% manipulate(model, 'G'); +figure;plot(result, {'G', 'X', 'dGdt', 'Ra_g', 'Gin'}); + +getValue(result, 'p3') +getValue(result, 'SI', 1) \ No newline at end of file diff --git a/models/minGlucModel2/minGlucData2.m b/models/minGlucModel2/minGlucData2.m new file mode 100644 index 0000000..60b82fd --- /dev/null +++ b/models/minGlucModel2/minGlucData2.m @@ -0,0 +1,25 @@ +function DATASET = minGlucData2() + +import AMF.functions.* + +DATASET.DESCRIPTION = 'Bariatric surgery data'; + +DATASET.FILE = 'bariatricData'; +DATASET.TYPE = 'Collection'; + +DATASET.GROUPS = { + 't2d_pre' + 't2d_1wk' + 't2d_3mo' + 't2d_1y' + 'ngt_pre' + 'ngt_1wk' + 'ngt_3mo' + 'ngt_1y' +}; + +DATASET.FIELDS = { + 'G' 1 't' 'glucose_mean' 'glucose_std' 18.0182 [] + 'I' 0 't' 'insulin_mean' 'insulin_std' 1000/6.94 [] + 'BW' 0 [] 'm_mean' 'm_std' 1 [] +}; \ No newline at end of file diff --git a/models/minGlucModel2/minGlucModel2.m b/models/minGlucModel2/minGlucModel2.m new file mode 100644 index 0000000..555f5f0 --- /dev/null +++ b/models/minGlucModel2/minGlucModel2.m @@ -0,0 +1,44 @@ +function MODEL = minGlucModel2() + +MODEL.DESCRIPTION = 'Minimal Glucose model by Dalla Man et. al'; + +MODEL.PREDICTOR = { + 't' [0 240] {'time' 'min' 'time'} +}; + +MODEL.CONSTANTS = { + 'Gtot' 40 {'mass' 'g' 'Gluc intake'} + 'Vg' 1.7 {'' 'dl/kg' 'dV gluc'} + 'BW' 'BW' {'mass' 'kg' 'Avg. BW'} + 'Gb' 'G' {} + 'Ib' 'I' {} +}; + +MODEL.INPUTS = { + 'I' 'Data' {'I'} 'Linear' {'conc.' 'uU/ml' 'Insulin'} +}; + +MODEL.PARAMETERS = { + 'p1' 0 .014 [] {'rate' '1/min' 'p1'} % Fractional glucose effectiveness (GE) + 'p2' 0 .03 [] {'rate' '1/min' 'p2'} % Rate constant of remove insulin compartment + 'p3' 0 1.0539e-05 [] {'rate' 'ml/uU' 'p3'} % Scale factor for amplitude of insulin action + + 'Ra' 1 0 [] {} +}; + +MODEL.STATES = { + 'G' 'G' 'dGdt' {'conc.' 'mg/dl' 'Glucose'} + 'X' 0 'dXdt' {'' '-' 'Insulin action'} + 'Gin' 0 'Ra_g' {'mass' 'g' 'App. gluc'} +}; + +MODEL.REACTIONS = { + 'Ir' 'if((I-Ib) > 0, I-Ib,0)' {} + + 'dGdt' '-(p1 + X) * G + p1 * Gb + Ra/Vg' {} + 'dXdt' '-p2 * X + p3 * Ir' {} + + % --- + 'Ra_g' 'Ra * BW / 1000' {'' 'g/min' 'Ra'} + 'SI' 'p3/p2' {'' '1/min/(uU/ml)' 'Frac. SI idx'} +}; \ No newline at end of file diff --git a/models/minGlucModel2/runMinGluc2.m b/models/minGlucModel2/runMinGluc2.m new file mode 100644 index 0000000..9c9898f --- /dev/null +++ b/models/minGlucModel2/runMinGluc2.m @@ -0,0 +1,37 @@ +%% initialize + +import AMF.* + +model = Model('minGlucModel2'); +data = DataSet('minGlucData2'); + +loadGroup(data, 'ngt_pre'); +initiateExperiment(model, data); + + +%% config + +model.options.numIter = 500; +model.options.numTimeSteps = 100; + +model.options.optimset.Display = 'off'; +model.options.useMex = 1; +model.options.SSTime = 30; +model.options.lab1 = .1; +model.options.randPars = 0; +model.options.randData = 1; + +parseAll(model); +compileAll(model); + +%% run + +result = runADAPT(model); + + +%check whether AUC satisfies carbohydrate dose + +%% plot +close all + +figure;plot(result, {'G', 'dGdt', 'Ra_g', 'Gin'}, 'hist'); \ No newline at end of file diff --git a/models/minModel/minData.m b/models/minModel/minData.m new file mode 100644 index 0000000..7c67162 --- /dev/null +++ b/models/minModel/minData.m @@ -0,0 +1,26 @@ +function DATASET = minData() + +DATASET.DESCRIPTION = 'Bariatric surgery data'; + +DATASET.FILE = 'bariatricData'; +DATASET.TYPE = 'Collection'; + +DATASET.GROUPS = { + 't2d_pre' + 't2d_1wk' + 't2d_3mo' + 't2d_1y' + 'ngt_pre' + 'ngt_1wk' + 'ngt_3mo' + 'ngt_1y' +}; + +DATASET.FIELDS = { + 'G' 1 't' 'glucose_mean' 'glucose_std' 1e9 [] + 'CP' 1 't' 'cpeptide_mean' 'cpeptide_std' 1e3 [] + 'I' 1 't' 'insulin_mean' 'insulin_std' 1e3 [] +% 'dGdt' 0 't' 'glucose_diff' 'glucose_std' 1e9 [] + + 'BW' 0 [] 'm_mean' 'm_std' 1 [] +}; \ No newline at end of file diff --git a/models/minModel/minModel.m b/models/minModel/minModel.m new file mode 100644 index 0000000..646e1c9 --- /dev/null +++ b/models/minModel/minModel.m @@ -0,0 +1,120 @@ +function MODEL = minModel() + +MODEL.DESCRIPTION = 'Combined minimal model by Dalla Man et. al'; + +MODEL.PREDICTOR = { + 't' [0 240] {'time' 'min' 'time'} +}; + +MODEL.CONSTANTS = { + 'BW' 'BW' {} + 'Gb' 'G' {} + 'CPb' 'CP' {} + 'Ib' 'I' {} + + 'Gtot' 40 {'mass' 'g' 'Gluc intake'} + 'HEi' .4 {} + + 'Vg' 1.7 {'' 'dl/kg' 'dV gluc'} +}; + +MODEL.INPUTS = { +% 'G' 'Data' {'G'} 'Linear' {} +% 'dGdt' 'Data' {'dGdt'} 'Linear' {} + + 'HE' 'Function' {[-45 0 15 30 45 60 90 120 180 240],'heb','he0','he1','he2','he3','he4','he5','he6','he7','he8',} 'Linear' {} + 'Ra' 'Function' {[-45 0 15 30 45 60 90 120 180 240],'rab','ra0','ra1','ra2','ra3','ra4','ra5','ra6','ra7','ra8',} 'Linear' {'' 'mg/kg/min' 'Ra'} +}; + +MODEL.PARAMETERS = { + % van Cauter + 'k01' 0 .067 [] {} + 'k12' 0 .051 [] {} + 'k21' 0 .065 [] {} + 'dV' 0 .0422 [] {} + + % Campioni + 'PHId' 1 200 [] {'' '10^-9' 'PHId(=kG)'} + 'PHIs' 1 20 [] {'' '10^-9/min' 'PHIs(=beta)'} + 'T' 0 3 [] {} + + % Insulin + 'Vi' 0 10 [] {} + + % Hepatic extraction + 'heb' 0 .6 [0 1] {} % + 'he0' 0 .6 [0 1] {} % + 'he1' 1 .6 [0 1] {} % + 'he2' 1 .6 [0 1] {} % + 'he3' 1 .6 [0 1] {} % + 'he4' 1 .6 [0 1] {} % HE pars + 'he5' 1 .6 [0 1] {} % + 'he6' 1 .6 [0 1] {} % + 'he7' 1 .6 [0 1] {} % + 'he8' 1 .6 [0 1] {} % + + % Glucose + 'p1' 0 .014 [] {'rate' '1/min' 'p1'} % Fractional glucose effectiveness (GE) + 'p2' 0 .03 [] {'rate' '1/min' 'p2'} % Rate constant of remove insulin compartment + 'p3' 1 1e-6 [] {'rate' 'ml/uU' 'p3'} % Scale factor for amplitude of insulin action + + 'rab' 0 0 [] {} + 'ra0' 0 0 [] {} % + 'ra1' 1 1 [] {} % + 'ra2' 1 1 [] {} % + 'ra3' 1 1 [] {} % + 'ra4' 1 1 [] {} % Rate of appearence parameters + 'ra5' 1 1 [] {} % + 'ra6' 1 1 [] {} % + 'ra7' 1 1 [] {} % + 'ra8' 1 1 [] {} % +}; + +MODEL.STATES = { + % C-peptide + 'CP1' 0 '-(k01 + k21) * CP1 + k12 * CP2 + SR' {} + 'CP2' 0 '-k12 * CP2 + k21 * CP1' {} + 'Y' 0 '-1/T * (Y - PHIs * 10^-9 * pG)' {} + + % Insulin + 'I' 'I' '-(CL/Vi) * I + IDR / Vi' {} + + % Glucose + 'G' 'G' 'dGdt' {'conc.' 'mg/dl' 'Glucose'} + 'X' 0 'dXdt' {'' '-' 'Insulin action'} + 'Gin' 0 'Ra_g' {'mass' 'g' 'App. gluc'} +}; + +MODEL.REACTIONS = { + % Glucose + 'Ir' 'if((I-Ib) > 0, I-Ib,0)' {} + + 'dGdt' '-(p1 + X) * G + p1 * Gb + Ra/Vg * 1e9/18.0182' {} + 'dXdt' '-p2 * X + p3/6.94 * Ir' {} + + 'Ra_g' 'Ra * BW / 1000' {'' 'g/min' 'Ra'} + 'SI' 'p3/p2' {'' '1/min/(uU/ml)' 'Frac. SI idx'} + + % C-peptide + 'V1' 'dV * BW' {} + + 'pdGdt' 'if((G < Gb) || (dGdt < 0), 0, dGdt)' {} + 'pG' 'if((G < Gb), 0, G-Gb)' {} + + 'SRs' 'Y' {} + 'SRd' 'PHId * 10^-9 * pdGdt' {} + 'SRb' 'CPb * k01' {} + + 'SR' 'SRs + SRd' {} + + 'ISR' '(SR + SRb) * V1' {} + 'ISR2' 'ISR / BW' {} + + 'CP' 'CP1 + CPb' {'conc.' 'pM' 'CPeptide'} + + 'PHIb' 'SRb / Gb' {} + + % Insulin + 'IDR' 'ISR * (1 - HE)' {} + 'CL' 'SRb * V1 * (1 - heb) / Ib' {} +}; \ No newline at end of file diff --git a/models/minModel/minModel2.m b/models/minModel/minModel2.m new file mode 100644 index 0000000..5a08182 --- /dev/null +++ b/models/minModel/minModel2.m @@ -0,0 +1,96 @@ +function MODEL = minModel() + +MODEL.DESCRIPTION = 'Combined minimal model by Dalla Man et. al'; + +MODEL.PREDICTOR = { + 't' [0 240] {'time' 'min' 'time'} +}; + +MODEL.CONSTANTS = { + 'BW' 'BW' {} + 'Gb' 'G' {} + 'CPb' 'CP' {} + 'Ib' 'I' {} + + % Constraints + 'Gtot' 40 {'mass' 'g' 'Gluc intake'} + 'HEi' .4 {} +}; + +MODEL.PARAMETERS = { + % van Cauter + 'k01' 0 .067 [] {} + 'k12' 0 .051 [] {} + 'k21' 0 .065 [] {} + 'dV' 0 .0422 [] {} + + % Insulin + 'Vi' 0 10 [] {} + + % Hepatic extraction + 'heb' 0 .6 [0 1] {} % + + % Glucose + 'p1' 0 .014 [] {'rate' '1/min' 'p1'} % Fractional glucose effectiveness (GE) + 'p2' 0 .03 [] {'rate' '1/min' 'p2'} % Rate constant of remove insulin compartment + + 'Vg' 0 1.7 [] {'' 'dl/kg' 'dV gluc'} + + % Fitpars + 'T' 0 3 [] {} + 'PHId' 0 565.44 [] {'' '10^-9' 'PHId(=kG)'} + 'PHIs' 0 38.57 [] {'' '10^-9/min' 'PHIs(=beta)'} + 'p3' 0 1.0888e-05 [] {'rate' 'ml/uU' 'p3'} % Scale factor for amplitude of insulin action + + 'Ra' 1 0 [] {} + 'HE' 1 .6 [0 1] {} +}; + +MODEL.STATES = { + % C-peptide + 'CP1' 0 '-(k01 + k21) * CP1 + k12 * CP2 + SR' {} + 'CP2' 0 '-k12 * CP2 + k21 * CP1' {} + 'Y' 0 '-1/T * (Y - PHIs * 10^-9 * pG)' {} + + % Insulin + 'I' 'I' '-(CL/Vi) * I + IDR / Vi' {} + + % Glucose + 'G' 'G' 'dGdt' {'conc.' 'mg/dl' 'Glucose'} + 'X' 0 'dXdt' {'' '-' 'Insulin action'} + 'Gin' 0 'Ra_g' {'mass' 'g' 'App. gluc'} +}; + +MODEL.REACTIONS = { + % Glucose + 'Ir' 'if((I-Ib) > 0, I-Ib,0)' {} + + 'dGdt' '-(p1 + X) * G + p1 * Gb + Ra/Vg * 1e9/18.0182' {} + 'dXdt' '-p2 * X + p3/6.94 * Ir' {} + + 'Ra_g' 'Ra * BW / 1000' {'' 'g/min' 'Ra'} + 'SI' 'p3/p2' {'' '1/min/(uU/ml)' 'Frac. SI idx'} + + % C-peptide + 'V1' 'dV * BW' {} + + 'pdGdt' 'if((G < Gb) || (dGdt < 0), 0, dGdt)' {} + 'pG' 'if((G < Gb), 0, G-Gb)' {} + + 'SRs' 'Y' {} + 'SRd' 'PHId * 10^-9 * pdGdt' {} + 'SRb' 'CPb * k01' {} + + 'SR' 'SRs + SRd' {} + + 'ISR' '(SR + SRb) * V1' {} + 'ISR2' 'ISR / BW' {} + + 'CP' 'CP1 + CPb' {'conc.' 'pM' 'CPeptide'} + + 'PHIb' 'SRb / Gb' {} + + % Insulin + 'IDR' 'ISR * (1 - HE)' {} + 'CL' 'SRb * V1 * (1 - heb) / Ib' {} +}; \ No newline at end of file diff --git a/models/minModel/minReg.m b/models/minModel/minReg.m new file mode 100644 index 0000000..0a65aaf --- /dev/null +++ b/models/minModel/minReg.m @@ -0,0 +1,14 @@ +function E = minReg(model, m, d) + +r = model.result; + +% C-pep HE +ISRi = trapz(r.time, r.vcurr(:, m.v.ISR)); +IDRi = trapz(r.time, r.vcurr(:, m.v.IDR)); + +HE = 1 - IDRi / ISRi; + +% Gluc RA +AUC_Ra = trapz(r.time, r.vcurr(:, m.v.Ra_g)); + +E = [(HE - m.c.HEi) * 1; AUC_Ra - m.c.Gtot]; \ No newline at end of file diff --git a/models/minModel/runMin.m b/models/minModel/runMin.m new file mode 100644 index 0000000..7e860dc --- /dev/null +++ b/models/minModel/runMin.m @@ -0,0 +1,46 @@ +%% initialize + +import AMF.* + +model = Model('minModel'); +data = DataSet('minData'); + +loadGroup(data, 't2d_1y'); +initiateExperiment(model, data); + +%% config + +model.options.optimset.Display = 'iter'; +model.options.useMex = 1; + +parseAll(model); +compileAll(model); + +%% run + +model.functions.reg = @minReg; + +result = fit(model); +% result = simulate(model); + +%% plot +close all; + +plot(result, {'CP','I','G','dGdt','HE','Ra','ISR2','Gin'}); +% manipulate(model, 'CP'); + +fprintf('\n'); +fprintf('T: %.2f\n', getValue(result, 'T', 1)) +fprintf('PHIb: %.2f\n', getValue(result, 'PHIb', 1) * 1e9) +fprintf('PHId: %.2f\n', getValue(result, 'PHId', 1)) +fprintf('PHIs: %.2f\n', getValue(result, 'PHIs', 1)) +fprintf('p3: %.4e\n', getValue(result, 'p3', 1)) + +ISR = getValue(result, 'ISR'); +IDR = getValue(result, 'IDR'); + +ISRi = trapz(result.time, ISR); +IDRi = trapz(result.time, IDR); + +fprintf('HE: %.2f\n', 1-IDRi/ISRi); +fprintf('\n'); \ No newline at end of file diff --git a/models/minModel/runMin2.m b/models/minModel/runMin2.m new file mode 100644 index 0000000..f694804 --- /dev/null +++ b/models/minModel/runMin2.m @@ -0,0 +1,34 @@ +%% initialize + +import AMF.* + +model = Model('minModel2'); +data = DataSet('minData'); + +loadGroup(data, 't2d_1y'); +initiateExperiment(model, data); + +%% config + +model.options.optimset.Display = 'off'; +model.options.useMex = 1; +model.options.numIter = 10; +model.options.numTimeSteps = 100; +model.options.SSTime = 45; +model.options.lab1 = .1; +model.options.randPars = 0; +model.options.randData = 1; + +parseAll(model); +compileAll(model); + +%% run + +% model.functions.reg = @minReg; + +result = runADAPT(model); + +%% plot +close all; + +plot(result, {'CP','I','G','Ir','dGdt','HE','Ra_g','ISR2','Gin'}); \ No newline at end of file diff --git a/models/tiemannModel/dat.m b/models/tiemannModel/dat.m new file mode 100644 index 0000000..dab73a6 --- /dev/null +++ b/models/tiemannModel/dat.m @@ -0,0 +1,95 @@ +load('data_Oosterveer.mat') + +C16_0 = [11.5556 17.1852 34.3704 59.2593]; +C18_1 = [14.9466 34.1637 128.114 200.712]; +C16_0_i = interp1(data.t2,C16_0,data.t1,'linear','extrap') ; +C18_1_i = interp1(data.t2,C18_1,data.t1,'linear','extrap') ; +w16 = C16_0_i ./ (C16_0_i + C18_1_i); +w18 = C18_1_i ./ (C16_0_i + C18_1_i); + +% -- +hep_DNL = data.DNL_16_0 .* repmat(w16,size(data.DNL_16_0,1),1) + data.DNL_18_1 .* repmat(w18,size(data.DNL_18_1,1),1); +d.hep_DNL = nanmean(hep_DNL); +d.hep_DNL_std = nanstd(hep_DNL); + +hep_CE_abs = data.hep_CE.*data.hep_mass; +d.hep_CE_abs = nanmean(hep_CE_abs); +d.hep_CE_abs_std = nanstd(hep_CE_abs); + +hep_FC_abs = data.hep_FC.*data.hep_mass; +d.hep_FC_abs = nanmean(hep_FC_abs); +d.hep_FC_abs_std = nanstd(hep_FC_abs); + +hep_TG_abs = data.hep_TG.*data.hep_mass; +d.hep_TG_abs = nanmean(hep_TG_abs); +d.hep_TG_abs_std = nanstd(hep_TG_abs); + +hep_CE_rel = data.hep_CE; +d.hep_CE_rel = nanmean(hep_CE_rel); +d.hep_CE_rel_std = nanstd(hep_CE_rel); + +hep_FC_rel = data.hep_FC; +d.hep_FC_rel = nanmean(hep_FC_rel); +d.hep_FC_rel_std = nanstd(hep_FC_rel); + +hep_TG_rel = data.hep_TG; +d.hep_TG_rel = nanmean(hep_TG_rel); +d.hep_TG_rel_std = nanstd(hep_TG_rel); + +hep_mass = data.hep_mass; +d.hep_mass = nanmean(hep_mass); +d.hep_mass_std = nanstd(hep_mass); + +plasma_FFA = data.FFA; +d.plasma_FFA = nanmean(plasma_FFA); +d.plasma_FFA_std = nanstd(plasma_FFA); + +plasma_TG = data.plasma_TG; +d.plasma_TG = nanmean(plasma_TG); +d.plasma_TG_std = nanstd(plasma_TG); + +VLDL_clearance = data.VLDL_clearance ./ mean(data.VLDL_clearance(:,1)); +d.VLDL_clearance = nanmean(VLDL_clearance); +d.VLDL_clearance_std = nanstd(VLDL_clearance); + +VLDL_diameter = data.VLDL_diameter; +d.VLDL_diameter = nanmean(VLDL_diameter); +d.VLDL_diameter_std = nanstd(VLDL_diameter); + +VLDL_TG_C_ratio = data.VLDL_TG ./ data.VLDL_CE; +d.VLDL_TG_C_ratio = nanmean(VLDL_TG_C_ratio); +d.VLDL_TG_C_ratio_std = nanstd(VLDL_TG_C_ratio); + +VLDL_production = data.VLDL_production; +d.VLDL_production = nanmean(VLDL_production); +d.VLDL_production_std = nanstd(VLDL_production); + +% -- + +d.plasma_TG_FPLC = data.plasma_TG_FPLC; +d.plasma_TG_FPLC_std = sqrt(interp1(data.t2,nanstd(data.plasma_TG).^2,data.t1,'linear')); +d.plasma_TG_FPLC_std(end) = d.plasma_TG_FPLC_std(end-1); + +d.plasma_TC_FPLC = data.plasma_C_FPLC; +d.plasma_TC_FPLC_std = sqrt(interp1([0 336],[137.6 302.7].^2,data.t1,'linear')); % estimated from Grefhorst 2012 et al. Atherosclerosis +d.plasma_TC_FPLC_std(end) = d.plasma_TC_FPLC_std(end-1); + +d.plasma_C_HDL_FPLC = data.plasma_C_HDL_FPLC; +d.plasma_C_HDL_FPLC_std = (d.plasma_C_HDL_FPLC./d.plasma_TC_FPLC) .* d.plasma_TC_FPLC_std; + +d.plasma_C_HDL_FPLC_2 = d.plasma_C_HDL_FPLC ./ d.plasma_TC_FPLC; +d.plasma_C_HDL_FPLC_2_std = d.plasma_C_HDL_FPLC_std; + +d.hep_SRB1 = data.hep_SRB1'; +d.hep_SRB1_std = data.hep_SRB1_std'; + +d.t1 = data.t1; +d.t2 = data.t2; + +% Xie +bodymass = 25e-3; + +mwFC = 386.7; % molecular weight of FC [g / mol], Teerlink et al. + +d.hep_HDL_CE_upt = ( bodymass * 1e6 * 44.8 * 1e-3) / (24 * mwFC); % umol/h +d.hep_HDL_CE_upt_std = ( bodymass * 1e6 * 6.79 * 1e-3) / (24 * mwFC); % umol/h \ No newline at end of file diff --git a/models/tiemannModel/data_Oosterveer.mat b/models/tiemannModel/data_Oosterveer.mat new file mode 100644 index 0000000..edd769a Binary files /dev/null and b/models/tiemannModel/data_Oosterveer.mat differ diff --git a/models/tiemannModel/runTiemann.m b/models/tiemannModel/runTiemann.m new file mode 100644 index 0000000..3952276 --- /dev/null +++ b/models/tiemannModel/runTiemann.m @@ -0,0 +1,38 @@ +%% initialize + +import AMF.* + +model = Model('tiemannModel'); +data = DataSet('tiemannData'); + +loadGroup(data, 'oosterveer'); +initiateExperiment(model, data); + +%% config + +model.options.useMex = 1; +model.options.savePrefix = ''; +model.options.odeTol = [1e-12 1e-12 100]; +model.options.numIter = 1; +model.options.numTimeSteps = 3; +model.options.parScale = [2 -2]; +model.options.seed = 3; +model.options.SSTime = 1000; +model.options.lab1 = .1; +model.options.optimset.Display = 'iter'; + +parseAll(model); +compileAll(model); + +%% run + +model.functions.reg = @tiemannReg; + +result = runADAPT(model); + + +%% plot + +plotAll(result, 'parameters', 'traj'); +plotAll(result, 'states', 'traj'); +plotAll(result, 'reactions', 'traj'); \ No newline at end of file diff --git a/models/tiemannModel/tiemannData.m b/models/tiemannModel/tiemannData.m new file mode 100644 index 0000000..a9925fa --- /dev/null +++ b/models/tiemannModel/tiemannData.m @@ -0,0 +1,32 @@ +function DATASET = tiemannData() + +DATASET.DESCRIPTION = 'Tiemann model data (Oosterveer & Xie)'; + +DATASET.FILE = 'tiemannData'; +DATASET.TYPE = 'Collection'; + +DATASET.GROUPS = { + 'oosterveer' +}; + +DATASET.FIELDS = { + 'dhep_TG_abs' 1 't1' 'hep_TG_abs' 'hep_TG_abs_std' 1 [] + 'dhep_CE_abs' 1 't1' 'hep_CE_abs' 'hep_CE_abs_std' 1 [] + 'dhep_FC_abs' 1 't1' 'hep_FC_abs' 'hep_FC_abs_std' 1 [] + 'dplasma_C' 1 't1' 'plasma_TC_FPLC' 'plasma_TC_FPLC_std' 1 [] + 'dplasma_TG' 1 't1' 'plasma_TG_FPLC' 'plasma_TG_FPLC_std' 1 [] + 'dVLDL_TG_C_ratio' 1 't2' 'VLDL_TG_C_ratio' 'VLDL_TG_C_ratio_std' 1 [] + 'dVLDL_diameter' 1 't2' 'VLDL_diameter' 'VLDL_diameter_std' 1 [] + 'dVLDL_production' 1 't2' 'VLDL_production' 'VLDL_production_std' 1 [] + 'dVLDL_clearance' 1 't2' 'VLDL_clearance' 'VLDL_clearance_std' 1 [] + 'dDNL' 1 't1' 'hep_DNL' 'hep_DNL_std' 1 [] + 'dFFA' 1 't1' 'plasma_FFA' 'plasma_FFA_std' 1 [] + + 'dhep_HDL_CE_upt' 1 't3' 'hep_HDL_CE_upt' 'hep_HDL_CE_upt_std' 1 [] + 'dplasma_C_HDL_FPLC' 0 't1' 'plasma_C_HDL_FPLC_2' 'plasma_C_HDL_FPLC_2_std' 1 [] +}; + +DATASET.FUNCTIONS = { + 'dplasma_C_HDL' 1 't1' 'dplasma_C .* dplasma_C_HDL_FPLC' 'dplasma_C_HDL_FPLC' + 'dplasma_C_0' 0 't1' 'dplasma_C - dplasma_C_HDL' 'dplasma_C' +}; \ No newline at end of file diff --git a/models/tiemannModel/tiemannData.mat b/models/tiemannModel/tiemannData.mat new file mode 100644 index 0000000..43b109f Binary files /dev/null and b/models/tiemannModel/tiemannData.mat differ diff --git a/models/tiemannModel/tiemannModel.m b/models/tiemannModel/tiemannModel.m new file mode 100644 index 0000000..da1dbfd --- /dev/null +++ b/models/tiemannModel/tiemannModel.m @@ -0,0 +1,144 @@ +function MODEL = tiemannModel() + +MODEL.PREDICTOR = { + 't' [0 504] {} +}; + +MODEL.PARAMETERS = { + 'Vm_FC_prod' 1 0 [] {} + 'Vm_FC_met' 1 0 [] {} + 'Vm_CE_for' 1 0 [] {} + 'Vm_CE_def' 1 0 [] {} + 'Vm_CE_ER_for' 1 0 [] {} + 'Vm_CE_ER_def' 1 0 [] {} + 'Vm_TG_prod' 1 0 [] {} + 'Vm_TG_met' 1 0 [] {} + 'Vm_TG_for' 1 0 [] {} + 'Vm_TG_ER_prod' 1 0 [] {} + 'Vm_TG_ER_for' 1 0 [] {} + 'Vm_FFA_upt' 1 0 [] {} + 'Vm_FFA_prod' 1 0 [] {} + 'Vm_VLDL_TG' 1 0 [] {} + 'Vm_VLDL_CE' 1 0 [] {} + 'Vm_TG_CE_upt' 1 0 [] {} + 'Vm_TG_CE_upt_ph' 1 0 [] {} + 'Vm_TG_hyd' 1 0 [] {} + 'Vm_TG_hyd_ph' 1 0 [] {} + 'Vm_HDL_CE_for' 1 0 [] {} + 'Vm_HDL_CE_upt' 1 0 [] {} + 'Vm_ApoB_prod' 1 0 [] {} + + % copied + 'Vm_TG_CE_upt_0' 0 'Vm_TG_CE_upt' [] {} + 'Vm_TG_CE_upt_ph_0' 0 'Vm_TG_CE_upt_ph' [] {} +}; + +MODEL.CONSTANTS = { + 'mwTG' 859.2 {} % molecular weight of TG [g / mol], Teerlink et al. + 'mvTG' 859.2 * 1.102 {} % molecular volume of TG [ml / mol], Teerlink et al. + 'mwCE' 647.9 {} % molecular weight of CE [g / mol], Teerlink et al. + 'mvCE' 647.9 * 1.058 {} % molecular volume of CE [ml / mol], Teerlink et al. + 'mwFC' 386.7 {} % molecular weight of FC [g / mol], Teerlink et al. + 'mvFC' 386.7 * 1.021 {} % molecular volume of FC [ml / mol], Teerlink et al. + 'mwPL' 786.0 {} % molecular weight of PL [g / mol], Teerlink et al. + 'mvPL' 786.0 * 0.984 {} % molecular volume of PL [ml / mol], Teerlink et al. + 'mwApoB' 546340 {} % molecular weight of apoB [g / mol], Hubner et al. + 'navg' 6.02214179 {} % number of Avogadro [10^23] + 'uH' 1.660538782 {} % atomic mass of a hydrogen atom [10^-24] + 'plasma_volume' 0.001 {} % 4.125% of bodyweight [L] + 'rs' 2 {} % radius of lipoprotein surface [nm], Hubner et al. 2009 + 'npi' pi {} % pi +}; + +MODEL.STATES = { + 'hep_FC' 'dhep_FC_abs' 'J_FC_production - J_FC_metabolism - J_CE_formation + J_CE_deformation - J_CE_ER_formation + J_CE_ER_deformation' {} + 'hep_CE' 'dhep_CE_abs' 'J_CE_formation - J_CE_deformation + J_CE_upt_2 + J_CE_HDL_upt_2' {} + 'hep_CE_ER' 0 'J_CE_ER_formation - J_CE_ER_deformation - J_VLDL_CE_1' {} + 'hep_TG' 'dhep_TG_abs' '- J_TG_metabolism + J_TG_formation - J_TG_ER_formation + (J_FFA_upt_2/3.0) + J_TG_upt_2 + J_TG_hyd_2' {} + 'hep_TG_ER' 0 '- J_TG_formation + J_TG_ER_formation - J_VLDL_TG_1' {} + 'hep_TG_DNL' 0 'J_TG_production - J_TG_metabolism_DNL + J_TG_formation_DNL - J_TG_ER_formation_DNL' {} + 'hep_TG_ER_DNL' 0 'J_TG_ER_production - J_TG_formation_DNL + J_TG_ER_formation_DNL - J_VLDL_TG_DNL_1' {} + 'plasma_TG' 'dplasma_TG' 'J_VLDL_TG_2 + J_VLDL_TG_DNL_2 - J_TG_upt_1 - J_TG_upt_ph - J_TG_hyd_1 - J_TG_hyd_ph' {} + 'plasma_C' 'dplasma_C_0' 'J_VLDL_CE_2 - J_CE_upt_1 - J_CE_upt_ph' {} + 'plasma_C_HDL' 'dplasma_C_HDL' 'J_CE_HDL_for - J_CE_HDL_upt_1' {} + 'plasma_FFA' 'dFFA' 'J_FFA_prod - J_FFA_upt_1' {} +}; + +MODEL.REACTIONS = { + % cholesterol + 'J_FC_production' 'Vm_FC_prod' {} %production of free cholesterol + 'J_FC_metabolism' 'Vm_FC_met * hep_FC' {} %metabolism of free cholesterol + 'J_CE_formation' 'Vm_CE_for * hep_FC' {} %formation of cholesterol ester from free cholesterol (cytosol) + 'J_CE_deformation' 'Vm_CE_def * hep_CE' {} %deformation of cholesterol ester to free cholesterol (cytosol) + 'J_CE_ER_formation' 'Vm_CE_ER_for * hep_FC' {} %formation of cholesterol ester from free cholesterol (ER) + 'J_CE_ER_deformation' 'Vm_CE_ER_def * hep_CE_ER' {} %deformation of cholesterol ester to free cholesterol (ER) + + % triglyceride + 'J_TG_production' 'Vm_TG_prod' {} %production of triglyceride (cytosol) + 'J_TG_metabolism' 'Vm_TG_met * hep_TG' {} %metabolism of triglyceride (cytosol) + 'J_TG_metabolism_DNL' 'Vm_TG_met * hep_TG_DNL' {} %metabolism of triglyceride (cytosol) + 'J_TG_formation' 'Vm_TG_for * hep_TG_ER' {} %transport of triglyceride from ER to cytosol + 'J_TG_formation_DNL' 'Vm_TG_for * hep_TG_ER_DNL' {} %transport of triglyceride from ER to cytosol + 'J_TG_ER_production' 'Vm_TG_ER_prod' {} %production of triglyceride (ER) + 'J_TG_ER_formation' 'Vm_TG_ER_for * hep_TG' {} %transport of triglyceride from cytosol to ER + 'J_TG_ER_formation_DNL' 'Vm_TG_ER_for * hep_TG_DNL' {} %transport of triglyceride from cytosol to ER + 'J_FFA_upt_1' 'Vm_FFA_upt * plasma_FFA' {} %uptake of free fatty acids by the liver (cytosol) + 'J_FFA_upt_2' 'Vm_FFA_upt * plasma_FFA * plasma_volume' {} %uptake of free fatty acids by the liver (cytosol) + 'J_FFA_prod' 'Vm_FFA_prod' {} % + + % lipoprotein production + 'J_VLDL_TG_1' 'Vm_VLDL_TG * hep_TG_ER' {} %amount of triglycerides transported to VLDL + 'J_VLDL_TG_DNL_1' 'Vm_VLDL_TG * hep_TG_ER_DNL' {} %amount of triglycerides transported to VLDL + 'J_VLDL_CE_1' 'Vm_VLDL_CE * hep_CE_ER' {} %amount of cholesterol ester transported to VLDL + 'J_VLDL_TG_2' 'Vm_VLDL_TG * hep_TG_ER / plasma_volume' {} %amount of triglycerides transported to VLDL + 'J_VLDL_TG_DNL_2' 'Vm_VLDL_TG * hep_TG_ER_DNL / plasma_volume' {} %amount of triglycerides transported to VLDL + 'J_VLDL_CE_2' 'Vm_VLDL_CE * hep_CE_ER / plasma_volume' {} %amount of cholesterol ester transported to VLDL + + % lipoprotein uptake + 'J_TG_upt_1' 'Vm_TG_CE_upt * plasma_TG' {} %whole particle uptake by liver (TG) + 'J_CE_upt_1' 'Vm_TG_CE_upt * plasma_C' {} %whole particle uptake by liver (CE) + 'J_TG_upt_ph' 'Vm_TG_CE_upt_ph * plasma_TG' {} %whole particle uptake by peripheral tissue (TG) + 'J_CE_upt_ph' 'Vm_TG_CE_upt_ph * plasma_C' {} %whole particle uptake by peripheral tissue (CE) + 'J_CE_HDL_for' 'Vm_HDL_CE_for' {} %CE uptake from peripheral tissues by HDL + 'J_CE_HDL_upt_1' 'Vm_HDL_CE_upt * plasma_C_HDL' {} %CE uptake by liver from HDL + 'J_TG_hyd_1' 'Vm_TG_hyd * plasma_TG' {} %hydrolysis of TG at liver + 'J_TG_hyd_ph' 'Vm_TG_hyd_ph * plasma_TG' {} %hydrolysis of TG at peripheral tissue + 'J_TG_upt_2' 'Vm_TG_CE_upt * plasma_TG * plasma_volume' {} %whole particle uptake by liver (TG) + 'J_CE_upt_2' 'Vm_TG_CE_upt * plasma_C * plasma_volume' {} %whole particle uptake by liver (CE) + 'J_CE_HDL_upt_2' 'Vm_HDL_CE_upt * plasma_C_HDL * plasma_volume' {} %CE uptake by liver from HDL + 'J_TG_hyd_2' 'Vm_TG_hyd * plasma_TG * plasma_volume' {} %hydrolysis of TG at liver + + % helpers + 'J_VLDL_TG' 'Vm_VLDL_TG * (hep_TG_ER + hep_TG_ER_DNL)' {} + 'J_VLDL_CE' 'Vm_VLDL_CE * hep_CE_ER' {} + 'J_ApoB_prod' 'Vm_ApoB_prod' {} + 'ApoB_count' 'J_ApoB_prod * navg * 10^23 * 10^-6' {} + 'TG_count' 'J_VLDL_TG * navg * 10^23 * 10^-6 / ApoB_count' {} + 'CE_count' 'J_VLDL_CE * navg * 10^23 * 10^-6 / ApoB_count' {} + 'DNL' '(hep_TG_DNL + hep_TG_ER_DNL) / (hep_TG + hep_TG_ER + hep_TG_DNL + hep_TG_ER_DNL)' {} + + 'lipo_vc' '( (TG_count * mvTG) + (CE_count * mvCE) ) * (pow(10,21) / (navg * 10^23))' {} + 'lipo_rc' 'pow((3 * lipo_vc) / (4 * npi), 1/3)' {} + 'VLDL_diameter' '(lipo_vc + lipo_rc) * 2' {} + 'VLDL_clearance' '(Vm_TG_CE_upt + Vm_TG_CE_upt_ph) / (Vm_TG_CE_upt_0 + Vm_TG_CE_upt_ph_0)' {} + + 'J_CE_HDL_upt' 'Vm_HDL_CE_upt * plasma_C_HDL' {} + + % observables + 'dhep_TG_abs' 'hep_TG + hep_TG_ER + hep_TG_DNL + hep_TG_ER_DNL' {} + 'dhep_CE_abs' 'hep_CE + hep_CE_ER' {} + 'dhep_FC_abs' 'hep_FC' {} + 'dplasma_C' 'plasma_C + plasma_C_HDL' {} + 'dplasma_TG' 'plasma_TG' {} + 'dVLDL_TG_C_ratio' 'TG_count / CE_count' {} + + 'dVLDL_diameter' 'VLDL_diameter' {} + 'dVLDL_production' 'J_VLDL_TG' {} + 'dVLDL_clearance' 'VLDL_clearance' {} + + 'dDNL' 'DNL' {} + 'dFFA' 'plasma_FFA' {} + + 'dplasma_C_HDL' 'plasma_C_HDL' {} + 'dhep_HDL_CE_upt' 'J_CE_HDL_upt * plasma_volume' {} +}; \ No newline at end of file diff --git a/models/tiemannModel/tiemannReg.m b/models/tiemannModel/tiemannReg.m new file mode 100644 index 0000000..39aa256 --- /dev/null +++ b/models/tiemannModel/tiemannReg.m @@ -0,0 +1,5 @@ +function reg = tiemannReg(model, m, d) + +r = model.result; + +reg = (r.pcurr(m.p.Vm_TG_prod) + r.pcurr(m.p.Vm_TG_ER_prod) - r.pprev(m.p.Vm_TG_prod) - r.pprev(m.p.Vm_TG_ER_prod)) / (r.pinit(m.p.Vm_TG_prod) + r.pinit(m.p.Vm_TG_ER_prod)); \ No newline at end of file diff --git a/models/toyModel/runToy.m b/models/toyModel/runToy.m new file mode 100644 index 0000000..ccff834 --- /dev/null +++ b/models/toyModel/runToy.m @@ -0,0 +1,45 @@ +%% initialize + +import AMF.* + +model = Model('toyModel'); +data = DataSet('toyData'); + +loadGroup(data, 'toy'); +initiateExperiment(model, data); + +%% config + +model.options.useMex = 1; +model.options.savePrefix = ''; +model.options.odeTol = [1e-12 1e-12 100]; +model.options.numIter = 20; +model.options.numTimeSteps = 100; +model.options.parScale = [2 -2]; +model.options.seed = 1; +model.options.SSTime = 1000; +model.options.lab1 = .1; +model.options.optimset.Display = 'off'; + +parseAll(model); +compileAll(model); + +%% run + +result = runADAPT(model); +% result = simulate(model); + +%% plot +close all + +plot(result, {'s3','ds3dt','k1'}); + +% plotAll(result, 'states', 'traj'); +% plotAll(result, 'parameters', 'traj'); + +% v1 = getValue(result, 'v1'); +% v2 = getValue(result, 'v2'); +% s3 = getValue(result, 's3'); +% t = result.time; +% +% figure;plot(diff(s3)./repmat(diff(t(:)),1,size(s3,2)), 'r');hold on;plot(v1-v2, 'b'); \ No newline at end of file diff --git a/models/toyModel/toyData.m b/models/toyModel/toyData.m new file mode 100644 index 0000000..8eb1956 --- /dev/null +++ b/models/toyModel/toyData.m @@ -0,0 +1,16 @@ +function DATASET = toyData() + +DATASET.DESCRIPTION = 'Toy test data.'; + +DATASET.FILE = 'toyData'; + +DATASET.GROUPS = { + 'toy' +}; + +DATASET.FIELDS = { + 's1' 1 't' 's1_mean' 's1_std' 1 [] + 's2' 1 't' 's2_mean' 's2_std' 1 [] + 's3' 1 't' 's3_mean' 's3_std' 1 [] + 's4' 1 't' 's4_mean' 's4_std' 1 [] +}; \ No newline at end of file diff --git a/models/toyModel/toyData.mat b/models/toyModel/toyData.mat new file mode 100644 index 0000000..9e082e5 Binary files /dev/null and b/models/toyModel/toyData.mat differ diff --git a/models/toyModel/toyModel.m b/models/toyModel/toyModel.m new file mode 100644 index 0000000..82a305f --- /dev/null +++ b/models/toyModel/toyModel.m @@ -0,0 +1,37 @@ +function MODEL = toyModel() + +MODEL.DESCRIPTION = 'Toy model created by N.A.W van Riel.'; + +MODEL.PREDICTOR = { + 't' [0 10] {'time' 'days' 'Time'} +}; + +MODEL.CONSTANTS = { + 'u1' 1 {} + 'u2' 1 {} +}; + +MODEL.PARAMETERS = { + 'k1' 1 1 [] {} + 'k2' 0 1 [] {} + 'k3' 0 .1 [] {} + 'k4' 0 .5 [] {} + 'k5' 0 1 [] {} +}; + +MODEL.STATES = { + 's1' 's1' 'v1 - v3 - v4' {} + 's2' 's2' '-v1 + v2' {} + 's3' 's3' 'ds3dt' {} + 's4' 's4' 'v4 - v5' {} +}; + +MODEL.REACTIONS = { + 'v1' 'k1 * u1 * s2' {} + 'v2' 'k2 * u2 * s3' {} + 'v3' 'k3 * s1' {} + 'v4' 'k4 * s1' {} + 'v5' 'k5 * s4' {} + + 'ds3dt' 'v1 - v2' {} +}; \ No newline at end of file diff --git a/models/toyModel/toyReg.m b/models/toyModel/toyReg.m new file mode 100644 index 0000000..8d94bac --- /dev/null +++ b/models/toyModel/toyReg.m @@ -0,0 +1,14 @@ +function reg = toyReg(model) + +t = getTime(model); +p = model.fitParameters; + +lab1 = model.options.lab1; + +dt = t(end) - t(1); + +if t(end) == 0 + reg = 0; +else + reg = ([p.curr] - [p.prev]) ./ [p.init] ./ dt * lab1; +end \ No newline at end of file diff --git a/odemex/COPYING b/odemex/COPYING new file mode 100644 index 0000000..94a9ed0 --- /dev/null +++ b/odemex/COPYING @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + Copyright (C) + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +. diff --git a/odemex/Examples/SBMLexample.m b/odemex/Examples/SBMLexample.m new file mode 100644 index 0000000..5f11ae3 --- /dev/null +++ b/odemex/Examples/SBMLexample.m @@ -0,0 +1,61 @@ + +if exist( 'Parser' ) ~= 7 + error ( 'Run this one level up from the parser dir' ); +end + +inDir = 'SBML_Files'; +inFn = 'HIF_4.xml'; +outFn = 'HIF_4.m'; +outDir = 'tmp'; +mkdir( outDir ); + +[ mStruct, p, x0, u0 ] = SBMLtoM( inDir, inFn, outDir, outFn ); + +odeInput = [ outDir '/' outFn ]; +addPath( [ outDir '/' ] ); + +a = dir( [ outDir ] ); +c = 1; +for b = 1 : length( a ) + if a(b).isdir == 0 + if strcmp( a(b).name, outFn ) == 0 + dependencies{ c } = [ outDir '/' a(b).name ]; + end + end +end + +options = cParserSet( 'blockSize', 5000 ); +convertToC_IDA( mStruct, odeInput, dependencies, options ); +convertToC( mStruct, odeInput, dependencies, options ); + +compileC( 'HIF_CV', 0 ); +compileC( 'HIF_IDA', 1 ); + + +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/Examples/example.m b/odemex/Examples/example.m new file mode 100644 index 0000000..d504b47 --- /dev/null +++ b/odemex/Examples/example.m @@ -0,0 +1,58 @@ + clear all; + + mStruct.s.x1 = 1; + mStruct.s.x2 = 2; + mStruct.p.k1 = 1; + mStruct.p.k2 = 2; + mStruct.p.k3 = 3; + mStruct.u.u1 = 1; + + mStruct.c.c1 = 1; + + %% Custom options + odeInput = 'MATLAB_models/mymodel2.m'; + dependencies = { 'MATLAB_models/addtwo.m' }; + + options = cParserSet( 'blockSize', 5000 ); + convertToC( mStruct, odeInput, dependencies, options ); + compileC( 'mymodel2C' ); + + options = odeset( 'RelTol', 1e-6, 'AbsTol', 1e-8 ); + + addpath( 'MATLAB_models' ); + [t y_MATLAB] = ode15s( @mymodel2, [0:.001:10], [3,5], options, ... + [2, 3, 4], [1], mStruct ); + + + [ t y_odeC ] = mymodel2C( [0:.001:10], [3,5], [2, 3, 4], ... + [1], [ 1e-6 1e-8 10 ] ); + + + plot( t, ( y_MATLAB - y_odeC.' ) ./ y_MATLAB ); +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/Examples/fitExample.m b/odemex/Examples/fitExample.m new file mode 100644 index 0000000..2bb050c --- /dev/null +++ b/odemex/Examples/fitExample.m @@ -0,0 +1,132 @@ +clear all; + +%% Set up the mstruct for a 25 state goodwin oscillator +mStruct.p.a1 = 1; +mStruct.p.a2 = 2; +mStruct.p.alf = 3; + +N = 25; +for k = 1 : N + eval( sprintf( 'mStruct.p.k%d = %d;', k, k+3 ) ); +end + +for k = 1 : N + eval( sprintf ( 'mStruct.s.x%d = %d;', k, k ) ); +end + +mStruct.o.sigma1 = 1; + +%% Compile with and without analytical Jacobian +odeInput = 'MATLAB_models/goodwinN.m'; +dependencies = { }; + +options = cParserSet( 'blockSize', 5000, 'aJac', 0, 'fJac', 1, 'maxStepSize', 0.1, 'debug', 1 ); +convertToC( mStruct, odeInput, dependencies, options ); +compileC( 'goodwin' ); + +options = cParserSet( 'blockSize', 5000, 'aJac', 1, 'fJac', 1, 'maxStepSize', 0.1, 'debug', 1 ); +convertToC( mStruct, odeInput, dependencies, options ); +compileC( 'goodwin_jac' ); + +% Simulate the true model +tols = [ 1e-4 1e-4 10 ]; +t = [ 0 : 1 : 40 ]; +trueSig = 2; +parTrue = rand( 1, N+3 ); +parTrue(1:3) = [ 0.6625 0.5233 0.2599 ]; +lb = zeros( length( parTrue ) + 1, 1 ); +x0 = zeros( 25, 1 ); +data = goodwin( t, x0, parTrue, [], tols ); +data = data(1,:) + trueSig * randn( 1, length(t) ); + +%% Set up the observer functions (3 observers) +obs{1} = '100*(x1([0:1:40])-data({1:41}))/(sigma1)'; +obs{2} = 'sqrt(41*log(sigma1))'; + +% Create and compile the observerfunctions with Jacobian (last flag) +[ timePts, parIndices, obsIndices, icIndices ] = observerFunctions( 'goodwinObs', obs, mStruct, 1 ); + +% Do a Monte Carlo sampling of random parameter vectors +N_samples = 100; +for a = 1 : N_samples + par(a,:) = [parTrue trueSig*100] .* (1+3*randn( 1, length(parTrue) + 1 )); +end + +%% Set up the simulation functions +simJac = @(pars)goodwin_jac( t, x0, pars(parIndices), [], [ 1e-5 1e-5 30 ], 1 ); +simNonJac = @(pars)goodwin( t, x0, pars(parIndices), [], [ 1e-8 1e-8 30 ] ); + +%% Set up the observation functions +obsJac = @(sims,pars,J)goodwinObs( sims, pars, data, [], J ); +obsNonJac = @(sims,pars)goodwinObs( sims, pars, data, [] ); + +%% Link the two +lsqFunJac = @(pars)useObserver( obsJac, simJac, pars ); +lsqFunNonJac = @(pars)useObserver( obsNonJac, simNonJac, pars ); + +%% Do N_samples fits with Jacobian based on Sensitivity Equations +disp( 'With Jacobian' ); +tic; +options = optimset('Jacobian','on','TolFun',1e-6,'TolX',1e-6,'Display', 'off' ); +for a = 1 : N_samples + disp( sprintf( '%d/%d', a, N_samples ) ); + try + [X,RESNORM,RESIDUAL,EXITFLAG,OUTPUT,LAMBDA,JACOBIAN1] = lsqnonlin(lsqFunJac,par(a,:),lb,[],options); + with(a) = RESNORM; + catch + with(a) = inf; + end +end +withTime = toc; + +%% Do N_samples fits with Jacobian based on Finite Differences +disp( 'Without Jacobian' ); +tic; +options = optimset('Jacobian','off','TolFun',1e-6,'TolX',1e-6,'Display', 'off' ); +for a = 1 : N_samples + disp( sprintf( '%d/%d', a, N_samples ) ); + try + [X,RESNORM,RESIDUAL,EXITFLAG,OUTPUT,LAMBDA,JACOBIAN2] = lsqnonlin(lsqFunNonJac,par(a,:),lb,[],options); + without(a) = RESNORM; + catch + without(a) = inf; + end +end +withoutTime = toc; + +%% Plot some stuff +plot( sort( with ), 'k' ); hold on; +plot( sort( without ), 'r' ); +ylabel( 'Final sum of squared error' ); +xlabel( 'Sorted index' ); +legend( 'Sensitivity equations', 'Finite differences' ); +title( sprintf( 'T_{SE} = %f s, T_{FD} = %f s', withTime, withoutTime ) ); + + +% +% Joep Vanlier, 2012 +% +% Licensing: +% Copyright (C) 2009-2012 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/Examples/goodwin.m b/odemex/Examples/goodwin.m new file mode 100644 index 0000000..a382e33 --- /dev/null +++ b/odemex/Examples/goodwin.m @@ -0,0 +1,64 @@ +%% Model 1 +mStruct.p.a1 = 1; +mStruct.p.a2 = 2; +mStruct.p.alf = 3; + +N = 25; +for k = 1 : N + eval( sprintf( 'mStruct.p.k%d = %d;', k, k+3 ) ); +end + +for k = 1 : N + eval( sprintf ( 'mStruct.s.x%d = %d;', k, k ) ); +end + + +%% Compile with analytical Jacobian +odeInput = 'MATLAB_models/goodwinN.m'; + +options = cParserSet( 'blockSize', 5000, 'fJac', 0 ); +convertToC( mStruct, odeInput, {}, options ); +compileC( 'goodwin5' ); + +options = cParserSet( 'blockSize', 5000, 'fJac', 1 ); +convertToC( mStruct, odeInput, {}, options ); +compileC( 'goodwin5_jac' ); + +%par = [0.6625 0.5233 0.2599 0.9620 0.5402 0.0303 0.6963 0.9620 0.5402 0.0303 0.6963]; +rand( 'state', 5805 ); +par = rand( N+3, 1 ); +par(1:3) = [ 0.6625 0.5233 0.2599 ]; +tols = [ 1e-10, 1e-12, 10 ]; +x0 = zeros( N, 1 ); +t = [ 0 : 0.1 : 2000 ]; + + +%% simulation +disp( 'Without Jacobian' ); +tic; +for q = 1 : 100 + [t,g1] = goodwin5( t, x0, par, [], tols ); +end +toc; + +disp( 'With Jacobian' ); +tic; +for q = 1 : 100 + [t,g2] = goodwin5_jac( t, x0, par, [], tols ); +end +toc; + +subplot(3,1,1); +plot( t, g1 ); +title( 'Without jacobian' ); + +subplot(3,1,2); +plot( t, g2 ); +title( 'With jacobian' ); + +subplot(3,1,3); +plot( t, g2 - g1 ); +title( 'Difference' ); + +clear goodwin5 +clear goodwin5_jac \ No newline at end of file diff --git a/odemex/Examples/ifExample.m b/odemex/Examples/ifExample.m new file mode 100644 index 0000000..1bf66a1 --- /dev/null +++ b/odemex/Examples/ifExample.m @@ -0,0 +1,53 @@ + clear all + + mStruct.s.x1 = 1; + mStruct.s.x2 = 2; + mStruct.p.k1 = 1; + + %% Custom options + odeInput = 'MATLAB_models/mymodel4.m'; + dependencies = {}; + + options = cParserSet( 'blockSize', 5000 ); + convertToC( mStruct, odeInput, dependencies, options ); + compileC( 'mymodel4C' ); + + options = odeset( 'RelTol', 1e-6, 'AbsTol', 1e-8 ); + + % Time points for the simulation + dt = .01; + tend = 15; + tPoints = [0:dt:tend]; + x0 = [3,5]; + + [ tz y_odeC ] = mymodel4C( tPoints, x0, [1], [], [ 1e-6 1e-8 10 ] ); + + plot( tz, y_odeC.' ); + +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/Examples/interpolationExample.m b/odemex/Examples/interpolationExample.m new file mode 100644 index 0000000..fa1a21a --- /dev/null +++ b/odemex/Examples/interpolationExample.m @@ -0,0 +1,88 @@ + clear all + + mStruct.s.x1 = 1; + mStruct.s.x2 = 2; + mStruct.p.k1 = 1; + mStruct.u.u1 = 1; + + % Note that you need to allocate elements for both time as well as the + % actual data. + nelem = 6; + mStruct.u.time1 = 2:2+6-1; + mStruct.u.linear1 = 2+6:2+2*6-1; + + mStruct.u.time2 = 14:14+6-1; + mStruct.u.linear2 = 14+6:14+2*6-1; + + %% Custom options + odeInput = 'MATLAB_models/mymodel3.m'; + dependencies = {}; + + options = cParserSet( 'blockSize', 5000 ); + convertToC( mStruct, odeInput, dependencies, options ); + compileC( 'mymodel3C' ); + + options = odeset( 'RelTol', 1e-6, 'AbsTol', 1e-8 ); + + %[t y_MATLAB] = ode15s( @mymodel2, [0:.001:10], [3,5], options, ... + % [2, 3, 4], [1], mStruct ); + + % Time points for the driving inputs + t = 0:2:10; + + % Values at the time points for the driving inputs + u1 = [4,5,6,7,6,9]; + u2 = [1,2,3,4,8,9]; + + % Time points for the simulation + dt = .01; + tend = 15; + tPoints = [0:dt:tend]; + x0 = [3,5]; + + % Inputs + inputs = [1, t, u1, t, u2 ]; + + [ tz y_odeC ] = mymodel3C( tPoints, x0, [1], inputs, [ 1e-6 1e-8 10 ] ); + + % Manually integrate + u1S = interp1( t, u1, tPoints, 'linear' ); + u2S = interp1( t, u2, tPoints, 'linear' ); + for z = 1 : length( tPoints ) + u1I(z) = dt * trapz( u1S(1:z) ) + x0(1); + u2I(z) = dt * trapz( u2S(1:z) ) + x0(2); + end + + plot( tz, y_odeC.' ); + hold on; + plot( tPoints, u1I, 'b.-' ); + plot( tPoints, u2I, 'g.-' ); + + legend( 'Integrator State 1', 'Integrator State 2', 'Manual State 1', 'Manual State 2' ); +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/Examples/obsTest.m b/odemex/Examples/obsTest.m new file mode 100644 index 0000000..59acaed --- /dev/null +++ b/odemex/Examples/obsTest.m @@ -0,0 +1,93 @@ +clear all; +mStruct.s.x1 = 1; +mStruct.s.x2 = 2; +mStruct.p.k1 = 1; +mStruct.p.k2 = 2; +mStruct.p.k3 = 3; +mStruct.u.u1 = 1; +mStruct.c.c1 = 1; + +mStruct.o.sigma1 = 1; +mStruct.o.sigma2 = 2; +mStruct.i.x2_0 = mStruct.s.x2; + +%% Compile with analytical Jacobian +odeInput = 'MATLAB_models/mymodel2.m'; +dependencies = { 'MATLAB_models/addtwo.m' }; + +options = cParserSet( 'blockSize', 5000, 'aJac', 1 ); +convertToC( mStruct, odeInput, dependencies, options ); +compileC( 'mymodel2D' ); + +%% Set up the observer functions (3 observers) +obs{1} = 'k1*u1*x1([0:.1:1]) * (1+sigma1)'; +obs{2} = 'k2*(x1([0,1,2,3,4]) + x2([0,1,2,3,4]) - data({1,2,3,4,5})) / (1+sigma2)'; +obs{3} = 'k3*x2([0:.1:5])./x1([0:.1:5])/k2'; + +% All the parameters (3 model parameters, one initial condition and two +% observer parameters) +params = [ 2 3 4 5 1 1 ]; +data = [4,3,7,4,5]; +input = 1; +tols = [ 1e-6 1e-8 10 ]; + +% Create and compile the observerfunctions with Jacobian +[ timePts, parIndices, obsIndices, icIndices ] = observerFunctions( 'test', obs, mStruct, 1 ); + +% Make a quick wrapper which calls the model and observation function +disp( 'Finite Differencing' ); +tic +for a = 1 : 1000 + func = @(pars)test( mymodel2D( timePts, [3 pars(icIndices(mStruct.i.x2_0))], pars(parIndices), input, tols ), pars, data, input ); + jac = nJac( func, params, 1e-8 ); +end +toc + +% Use the observation function on the model simulation and actually +% propagate sensitivities +disp( 'Sensitivity Equations' ); +tic +for a = 1 : 1000 + [ t y_odeC, S1 ] = mymodel2D( timePts, [3 params(icIndices(mStruct.i.x2_0))], params(parIndices), input, tols, 1 ); + [ observ, sens ] = test( y_odeC, params, data, input, S1 ); +end +toc + +close all; +subplot(3,1,1); +plot( sens ) +title( 'Sensitivity Equations' ); +subplot(3,1,2); +plot( jac ); +title( 'Finite Differences' ); +subplot(3,1,3); +plot( sens-jac ); +title( 'Difference' ); + +% +% Joep Vanlier, 2012 +% +% Licensing: +% Copyright (C) 2009-2012 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/Examples/sens1.m b/odemex/Examples/sens1.m new file mode 100644 index 0000000..3b22b27 --- /dev/null +++ b/odemex/Examples/sens1.m @@ -0,0 +1,90 @@ + clear all; + + mStruct.s.x1 = 1; + mStruct.s.x2 = 2; + mStruct.p.k1 = 1; + mStruct.p.k2 = 2; + mStruct.p.k3 = 3; + mStruct.u.u1 = 1; + mStruct.c.c1 = 1; + + %% Custom options + odeInput = 'MATLAB_models/mymodel2.m'; + dependencies = { 'MATLAB_models/addtwo.m' }; + + options = cParserSet( 'blockSize', 5000 ); + convertToC( mStruct, odeInput, dependencies, options ); + compileC( 'mymodel2C' ); + + time = [0:.1:10]; + initCond = [3,5]; + params = [2,3,4]; + tols = [ 1e-6 1e-8 10 ]; + input = 1; + + % Stack the parameters and initial condition in a parameter vector + pars = [ params, initCond ]; + + % Compute the sensitivities using the forward sensitivity calculations + tols = [ 1e-8 1e-9 10 ]; + tic + [ t y_odeC, S ] = mymodel2C( time, initCond, params, input, tols, 1 ); + toc + + % Make a routine that computes the model and concatenates the outputs + % (since lsqnonlin only uses vector residuals) + tols = [ 1e-8 1e-9 10 ]; + resids = @( pars ) ( reshape( mymodel2C( time, pars(4 : 5), ... + pars( 1 : 3 ), input, tols ).', ... + length( time ) * 2, 1 ) ); + + % Set the options of the optimiser in such a way that it does not + % perform any fitting. We are simply exploiting it to calculate a + % numerical Jacobian w.r.t. the parameters and initial conditions + tic + options = optimset( 'MaxIter', 0, 'MaxFunEvals', 0 ); + [x,resnorm,residual,exitflag,output,lambda,jacobian] = ... + lsqnonlin( resids, pars, [], [], options ); + toc + + % Reshape the Jacobian + jacobian = reshape( full( jacobian ), length( time ), 10 ); + + % Compare the two! + figure; + subplot( 1, 3, 1 ); + plot( jacobian ); + title( 'Numerical Jacobian' ); + subplot( 1, 3, 2 ); + plot( S.' ); + title( 'Forward sensitivity result' ); + subplot( 1, 3, 3 ); + plot( jacobian - S.' ); + title( 'Difference' ); +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/Examples/sens2.m b/odemex/Examples/sens2.m new file mode 100644 index 0000000..89f22ce --- /dev/null +++ b/odemex/Examples/sens2.m @@ -0,0 +1,76 @@ + + clear all; + mStruct.s.x1 = 1; + mStruct.s.x2 = 2; + mStruct.p.k1 = 1; + mStruct.p.k2 = 2; + mStruct.p.k3 = 3; + mStruct.u.u1 = 1; + mStruct.c.c1 = 1; + + %% Custom options + odeInput = 'MATLAB_models/mymodel2.m'; + dependencies = { 'MATLAB_models/addtwo.m' }; + + options = cParserSet( 'blockSize', 5000 ); + convertToC( mStruct, odeInput, dependencies, options ); + compileC( 'mymodel2C' ); + + options = odeset( 'RelTol', 1e-6, 'AbsTol', 1e-8 ); + + time1 = [0:.1:5]; + time2 = [5:.1:10]; + initCond = [3,5]; + params = [2,3,4]; + tols = [ 1e-6 1e-8 10 ]; + input = 1; + + % Compute sensitivity in one step + [ t y_odeC, S ] = mymodel2C( [time1 time2(2:end)], ... + initCond, params, input, tols, 1 ); + + % Compute sensitivity in two steps + [ t y_odeC, S1 ] = mymodel2C( [time1], initCond, params, ... + input, tols, 1 ); + % Propagate the initial conditions for y and the + % sensitivities from the previous simulation + [ t y_odeC, S2 ] = mymodel2C( [time2], y_odeC(:, end), params, ... + input, tols, 1, S1(:,end) ); + + figure; + subplot( 1, 3, 1 ); + plot( S.' ); + title( 'Sensitivities Single Step' ); + subplot( 1, 3, 2 ); + plot( [S1(:,1:end-1) S2].' ); + title( 'Sensitivities Two Step' ); + subplot( 1, 3, 3 ); + plot( S.'-[S1(:,1:end-1) S2].' ); + title( 'Difference' ); +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/Examples/sens3.m b/odemex/Examples/sens3.m new file mode 100644 index 0000000..1aa889c --- /dev/null +++ b/odemex/Examples/sens3.m @@ -0,0 +1,131 @@ + + clear all; + mStruct.s.x1 = 1; + mStruct.s.x2 = 2; + mStruct.p.k1 = 1; + mStruct.p.k2 = 2; + mStruct.p.k3 = 3; + mStruct.u.u1 = 1; + mStruct.c.c1 = 1; + + %% Compile without analytical Jacobian + odeInput = 'MATLAB_models/mymodel2.m'; + dependencies = { 'MATLAB_models/addtwo.m' }; + + options = cParserSet( 'blockSize', 5000, 'aJac', 0 ); + convertToC( mStruct, odeInput, dependencies, options ); + compileC( 'mymodel2C' ); + + %% Compile with analytical Jacobian + odeInput = 'MATLAB_models/mymodel2.m'; + dependencies = { 'MATLAB_models/addtwo.m' }; + + options = cParserSet( 'blockSize', 5000, 'aJac', 1 ); + convertToC( mStruct, odeInput, dependencies, options ); + compileC( 'mymodel2D' ); + + options = odeset( 'RelTol', 1e-6, 'AbsTol', 1e-8 ); + + time1 = [0:.1:5]; + time2 = [5:.1:10]; + initCond = [3,5]; + params = [2,3,4]; + tols = [ 1e-6 1e-8 10 ]; + input = 1; + + %% Without analytical Jacobian + % Compute sensitivity in one step + tic; + [ t y_odeC, S ] = mymodel2C( [time1 time2(2:end)], ... + initCond, params, input, tols, 1 ); + t1 = toc; + + % Compute sensitivity in two steps + [ t y_odeC, S1 ] = mymodel2C( [time1], initCond, params, ... + input, tols, 1 ); + + % Propagate the initial conditions for y and the + % sensitivities from the previous simulation + [ t y_odeC, S2 ] = mymodel2C( [time2], y_odeC(:, end), params, ... + input, tols, 1, S1(:,end) ); + + %% With analytical Jacobian + tic; + [ t y_odeC, S_2 ] = mymodel2D( [time1 time2(2:end)], ... + initCond, params, input, tols, 1 ); + t2 = toc; + + % Compute sensitivity in two steps + [ t y_odeC, S1_2 ] = mymodel2D( [time1], initCond, params, ... + input, tols, 1 ); + + % Propagate the initial conditions for y and the + % sensitivities from the previous simulation + [ t y_odeC, S2_2 ] = mymodel2D( [time2], y_odeC(:, end), params, ... + input, tols, 1, S1_2(:,end) ); + + + figure; + subplot( 2, 3, 1 ); + plot( S.' ); + title( 'Sensitivities Single Step' ); + subplot( 2, 3, 2 ); + plot( [S1(:,1:end-1) S2].' ); + title( 'Sensitivities Two Step' ); + subplot( 2, 3, 3 ); + plot( S.'-[S1(:,1:end-1) S2].' ); + title( 'Difference' ); + + subplot( 2, 3, 4 ); + plot( S_2.' ); + title( 'AnalyticalSensitivities Single Step' ); + subplot( 2, 3, 5 ); + plot( [S1_2(:,1:end-1) S2_2].' ); + title( 'AnalyticalSensitivities Two Step' ); + subplot( 2, 3, 6 ); + plot( S_2.'-[S1_2(:,1:end-1) S2_2].' ); + title( 'Difference' ); + + + figure; + title( 'Without analytical Jacobian' ); + subplot(1,3,1); + plot( S.' ); + + subplot(1,3,2); + plot( S_2.' ); + title( 'With analytical Jacobian' ); + + subplot(1,3,3); + plot( S_2.' - S.' ); + title( 'Difference' ); + + disp( sprintf( 'Time taken without analytical derivatives %d', t1 ) ) + disp( sprintf( 'Time taken with analytical derivatives %d', t2 ) ) +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/Instructions.pdf b/odemex/Instructions.pdf new file mode 100644 index 0000000..846b730 Binary files /dev/null and b/odemex/Instructions.pdf differ diff --git a/odemex/MATLAB_models/addTwo.m b/odemex/MATLAB_models/addTwo.m new file mode 100644 index 0000000..f837e85 --- /dev/null +++ b/odemex/MATLAB_models/addTwo.m @@ -0,0 +1,30 @@ +function y = addTwo( in1, in2 ) + + y = in1 + in2; +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/MATLAB_models/goodwin5.m b/odemex/MATLAB_models/goodwin5.m new file mode 100644 index 0000000..3a951ac --- /dev/null +++ b/odemex/MATLAB_models/goodwin5.m @@ -0,0 +1,26 @@ +function dx = goodwin5(t,x,p,u,modelStruct) + +% Parameters: +oa1 = p(1); +oa2 = p(2); +alf = p(3); + +k1 = p(4); +k2 = p(5); +k3 = p(6); +k4 = p(7); + +rho = 10; + +x1 = x( modelStruct.s.x1 ); +x2 = x( modelStruct.s.x2 ); +x3 = x( modelStruct.s.x3 ); +x4 = x( modelStruct.s.x4 ); +x5 = x( modelStruct.s.x5 ); + +dx( modelStruct.s.x1 ) = ( oa1 / ( 1 + oa2 * intPow(x5,rho) ) ) - alf * x1; +dx( modelStruct.s.x2 ) = k1 * x1 - alf * x2; +dx( modelStruct.s.x3 ) = k2 * x2 - alf * x3; +dx( modelStruct.s.x4 ) = k3 * x3 - alf * x4; +dx( modelStruct.s.x5 ) = k4 * x4 - alf * x5; + diff --git a/odemex/MATLAB_models/goodwinN.m b/odemex/MATLAB_models/goodwinN.m new file mode 100644 index 0000000..85bcfd6 --- /dev/null +++ b/odemex/MATLAB_models/goodwinN.m @@ -0,0 +1,15 @@ +function dx = goodwinN(t,x,p,u,modelStruct) + +% Parameters: +a1 = p(1); +a2 = p(2); +alf = p(3); + +rho = 2; +order = 24; + +dx( modelStruct.s.x1 ) = ( a1 / ( 1 + a2 * intPow(x(24),rho) ) ) - alf * x( modelStruct.s.x1 ); + +for k1 = 1 : order + dx( modelStruct.s.x1 + k1 ) = p( modelStruct.p.k1 + k1 ) * x( modelStruct.s.x1 + k1 - 1 ) - alf * x( modelStruct.s.x1 + k1 ); +end \ No newline at end of file diff --git a/odemex/MATLAB_models/mymodel1.m b/odemex/MATLAB_models/mymodel1.m new file mode 100644 index 0000000..3b6dccc --- /dev/null +++ b/odemex/MATLAB_models/mymodel1.m @@ -0,0 +1,33 @@ +function dx = mymodel1(t, x, p, u, myStruct) + +dx(1) = u(1) - p(1) * x(1) + p(2) * x(2); +dx(2) = p(1) * x(1) - (( p(3) /4) + p(2)) * x(2); + +dx = dx(:); +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/MATLAB_models/mymodel2.m b/odemex/MATLAB_models/mymodel2.m new file mode 100644 index 0000000..983677a --- /dev/null +++ b/odemex/MATLAB_models/mymodel2.m @@ -0,0 +1,44 @@ +function dx = mymodel2(t, x, p, u, myStruct) + + p1 = p( myStruct.p.k1 ); + p2 = p( myStruct.p.k2 ); + p3 = p( myStruct.p.k3 ); + x1 = x( myStruct.s.x1 ); + x2 = x( myStruct.s.x2 ); + u1 = u( myStruct.u.u1 ); + c1 = myStruct.c.c1; + + temp1 = u1 - p1 * x1; + temp2 = p2 * x2; + + dx( myStruct.s.x1 ) = temp1 + temp2; + dx( myStruct.s.x2 ) = p1 * x1 - addTwo((p3/c1), p2) * x2; + + dx = dx(:); +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/MATLAB_models/mymodel3.m b/odemex/MATLAB_models/mymodel3.m new file mode 100644 index 0000000..3bb5aa4 --- /dev/null +++ b/odemex/MATLAB_models/mymodel3.m @@ -0,0 +1,37 @@ +function dx = mymodel3(t, x, p, u, myStruct) + + p1 = p( myStruct.p.k1 ); + testThingy = u(myStruct.u.u1 ); + + dx( myStruct.s.x1 ) = interpolate( &u(myStruct.u.time1), &u(myStruct.u.linear1), 6, t, 1 ); + dx( myStruct.s.x2 ) = interpolate( &u(myStruct.u.time2), &u(myStruct.u.linear2), 6, t, 1 ); + + dx = dx(:); + +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/MATLAB_models/mymodel4.m b/odemex/MATLAB_models/mymodel4.m new file mode 100644 index 0000000..057eb94 --- /dev/null +++ b/odemex/MATLAB_models/mymodel4.m @@ -0,0 +1,43 @@ +function dx = mymodel4(t, x, p, u, myStruct) + + dx( myStruct.s.x1 ) = 0; + dx( myStruct.s.x2 ) = 0; + + if ( ( t > 5 ) && ( t < 10 ) || ( t < 2 ) ) + dx( myStruct.s.x2 ) = 1; + else if ( t > 7 ) + dx( myStruct.s.x1 ) = 1; + dx( myStruct.s.x2 ) = 2; + else + dx( myStruct.s.x2 ) = 0; + end + end + + dx = dx(:); +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/Parser/CVode/chooseCompiler.m b/odemex/Parser/CVode/chooseCompiler.m new file mode 100644 index 0000000..8eb00ad --- /dev/null +++ b/odemex/Parser/CVode/chooseCompiler.m @@ -0,0 +1,164 @@ +%% Mandatory Settings + +% compiler = 1; % lccwin32 +compiler = 2; % msvc +% compiler = 3; % GCC under windows +% compiler = 4; % GCC under linux + +% Don't forget to call mex -setup when you switch compiler (not needed for +% GCC) + +lapack = 'libmwlapack.lib'; +blas = 'libmwblas.lib'; + +%% Common Settings + +lccLocation = [ matlabroot '/sys/lcc' ]; + +[junk,parserDir] = strtok( fliplr( fileparts( mfilename( 'fullpath' ) ) ), '/\' ); +parserDir = fliplr( parserDir ); +cvodeDir = [ parserDir '/CVode' ]; + +%% LCC-Win32 +if ( compiler == 1 ) + + % O2 means optimise for performance, not space! + flags = '-O2 '; + + + % Don't set these unless you're having trouble \/ + compilerLocation = [ matlabroot '\sys\lcc' ]; + algebraDir = [ matlabroot '\extern\lib\win32\lcc' ]; + lapack = [ algebraDir '\' lapack ]; + blas = [ algebraDir '\' blas ]; + libraryName = 'CVODE.lib'; + idaName = 'IDA.lib'; + extraflags = ' '; +end + +%% Microsoft Visual C++ 2008 +if ( compiler == 2 ) + + % If you use MSVC, adjust these to the appropriate location \/ + %vsroot = 'D:\Program Files\Microsoft Visual Studio 9.0'; + %netroot = 'C:\WINDOWS\Microsoft.NET'; + %vsroot = 'C:\Program Files (x86)\Microsoft Visual Studio 10.0'; + %netroot = 'C:\Windows\Microsoft.NET'; + vsroot = ''; + netroot = ''; + + % \/ Base your choice of optimisations here + %* P2: G6 is fastest (official builds are G6) + %* P3: G6 SSE is fastest + %* P4: G7 SSE2 is fastest + %* Celeron: Depends on whether your Celeron is P2-based, P3-based, or P4-based. + %* Athlon XP: G7 may be faster than G7 SSE even though SSE is supported + % + % O2 means optimise for performance, not space! + % + % -ffast-math very fast math, b + flags = '-O2 '; % /fp:strict'; + + + % Don't set these unless you're having trouble \/ + compilerLocation = [ vsroot '\VC' ]; + if strcmp(computer, 'PCWIN') + algebraDir = [ matlabroot '\extern\lib\win32\microsoft' ]; + else + if strcmp(computer, 'PCWIN64') + algebraDir = [ matlabroot '\extern\lib\win64\microsoft' ]; + else + disp( 'WARNING: Could not identify computer. Cannot link against lapack/BLAS' ); + end + end + lapack = [ algebraDir '\' lapack ]; + blas = [ algebraDir '\' blas ]; + libraryName = 'CVODE.lib'; + idaName = 'IDA.lib'; + extraflags = ' '; +end + +%% GCC --> Win +if ( compiler == 3 ) + + % To use the GCC compiler, obtain GNUMEX from + % http://gnumex.sourceforge.net/ + % and install it in the subdiretory parser/gnumex + % Follow the instructions, and set up cygwin. + % Copy the cygwin1.dll in the directory where you want to solve + % things under windows. Cygwin is used to run linux stuff on windows + % machines so you can test. + % Use gnumex to create a .bat file (in the gnumex dir!) with appropriate mex options + % and reference it by changing this line: + gnumex = [ parserDir '\gnumex\mexopts.bat' ]; + flags = '-ffast-math'; % /fp:strict'; + cygwinLib = 'C:\cygwin\bin\'; + + + % Don't set these unless you're having trouble \/ + %vsroot = 'D:\Program Files\Microsoft Visual Studio 9.0'; + %compilerLocation = [ vsroot '\VC' ]; + algebraDir = [ matlabroot '\extern\lib\win32\microsoft' ]; + lapack = [ algebraDir '\' lapack ]; + blas = [ algebraDir '\' blas ]; + extraflags = [ '-f ''' gnumex '''' ]; + libraryName = 'CVODE.a'; + idaName = 'IDA.a'; + copyfile( [ cygwinLib, 'cygwin1.dll' ], parserDir ); + +end + +%% GCC --> For deployment on Linux stations! +if ( compiler == 4 ) + + % To use the GCC compiler, obtain GNUMEX from + % http://gnumex.sourceforge.net/ + % and install it in the subdiretory parser/gnumex + % Follow the instructions, and set up cygwin. + % Copy the cygwin1.dll in the directory where you want to solve + % things under windows. Cygwin is used to run linux stuff on windows + % machines so you can test. + % Use gnumex to create a .bat file (in the gnumex dir!) with appropriate mex options + % and reference it by changing this line: + gnumex = [ parserDir '/gnumex/mexopts.bat' ]; + flags = '-ffast-math'; % /fp:strict'; + + + % Don't set these unless you're having trouble \/ + %vsroot = 'D:\Program Files\Microsoft Visual Studio 9.0'; + %compilerLocation = [ vsroot '\VC' ]; + algebraDir = [ matlabroot '/extern/lib/linux/microsoft' ]; + extraflags = ''; + libraryName = 'CVODE.a'; + idaName = 'IDA.a'; + +end + + +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/Parser/CVode/cv_src/include/cvodes.h b/odemex/Parser/CVode/cv_src/include/cvodes.h new file mode 100644 index 0000000..f368530 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/cvodes.h @@ -0,0 +1,1968 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.22 $ + * $Date: 2008/04/16 21:53:06 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the interface file for the main CVODES integrator. + * ----------------------------------------------------------------- + * + * CVODES is used to solve numerically the ordinary initial value + * problem: + * + * y' = f(t,y), + * y(t0) = y0, + * + * where t0, y0 in R^N, and f: R x R^N -> R^N are given. + * + * Optionally, CVODES can perform forward or adjoint sensitivity + * analysis to find sensitivities of the solution y with respect + * to parameters in the right hand side f and/or in the initial + * conditions y0. + * + * ----------------------------------------------------------------- + * + * 1: CONSTANTS + * input constants + * return flags + * + * 2: FUNCTION TYPES + * CVRhsFn CVQuadRhsFn CVSensRhsFn CVSensRhs1Fn CVQuadSensRhsFn + * CVRootFn + * CVEwtFn + * CVErrHandlerFn + * CVRhsFnB CVRhsFnBS + * CVQuadRhsFnB CVQuadRhsFnBS + * + * 3: INITIALIZATION AND DEALLOCATION FUNCTIONS FOR FORWARD PROBLEMS + * CVodeCreate + * CVodeInit CVodeReInit + * CVodeQuadInit CVodeQuadReInit + * CVodeSensInit CVodeSensReInit + * CVodeRootInit + * CVodeFree CVodeQuadFree CVodeSensFree + * + * 4: OPTIONAL INPUT FUNCTIONS FOR FORWARD PROBLEMS + * + * 5: MAIN SOLVER FUNCTION FOR FORWARD PROBLEMS + * CVode + * + * 6: EXTRACTION AND DENSE OUTPUT FUNCTIONS FOR FORWARD PROBLEMS + * CVodeGetDky + * CVodeGetQuad + * CVodeGetQuadDky + * CVodeGetSens CVodeGetSens1 + * CVodeGetSensDky CVodeGetSensDky1 + * CVodeGetQuadSens CVodeGetQuadSens1 + * CVodeGetQuadSensDky CVodeGetQuadSensDky1 + * + * 7: OPTIONAL OUTPUT FUNCTIONS FOR FORWARD PROBLEMS + * + * 8: INITIALIZATION AND DEALLOCATION FUNCTIONS FOR BACKWARD PROBLEMS + * CVodeAdjInit CVodeAdjReInit + * CVodeAdjFree + * CVodeInitB CVodeInitBS CVodeReInitB + * CVodeQuadInitB CVodeQuadInitBS CVodeQuadReInitB + * + * 9 MAIN SOLVER FUNCTIONS FOR FORWARD PROBLEMS + * CVodeF + * CVodeB + * + * 10: OPTIONAL INPUT FUNCTIONS FOR BACKWARD PROBLEMS + * + * 11: EXTRACTION AND DENSE OUTPUT FUNCTIONS FOR BACKWARD PROBLEMS + * CVodeGetB + * CVodeGetQuadB + * + * 12: OPTIONAL OUTPUT FUNCTIONS FOR BACKWARD PROBLEMS + * + * ----------------------------------------------------------------- + */ + +#ifndef _CVODES_H +#define _CVODES_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +#include + +/* + * ================================================================= + * + * CVODES CONSTANTS + * + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Enumerations for inputs to: + * CVodeCreate (lmm, iter), + * CVodeSensInit, CvodeSensinit1, CVodeSensReInit (ism), + * CVodeAdjInit (interp), + * CVode (itask) + * ----------------------------------------------------------------- + * Symbolic constants for the lmm and iter parameters to CVodeCreate + * the input parameter itask to CVode, and the input parameter interp + * to CVodeAdjInit, are given below. + * + * lmm: The user of the CVODES package specifies whether to use + * the CV_ADAMS or CV_BDF (backward differentiation formula) + * linear multistep method. The BDF method is recommended + * for stiff problems, and the CV_ADAMS method is recommended + * for nonstiff problems. + * + * iter: At each internal time step, a nonlinear equation must + * be solved. The user can specify either CV_FUNCTIONAL + * iteration, which does not require linear algebra, or a + * CV_NEWTON iteration, which requires the solution of linear + * systems. In the CV_NEWTON case, the user also specifies a + * CVODE linear solver. CV_NEWTON is recommended in case of + * stiff problems. + * + * ism: This parameter specifies the sensitivity corrector type + * to be used. In the CV_SIMULTANEOUS case, the nonlinear + * systems for states and all sensitivities are solved + * simultaneously. In the CV_STAGGERED case, the nonlinear + * system for states is solved first and then, the + * nonlinear systems for all sensitivities are solved + * at the same time. Finally, in the CV_STAGGERED1 approach + * all nonlinear systems are solved in a sequence. + * + * itask: The itask input parameter to CVode indicates the job + * of the solver for the next user step. The CV_NORMAL + * itask is to have the solver take internal steps until + * it has reached or just passed the user specified tout + * parameter. The solver then interpolates in order to + * return an approximate value of y(tout). The CV_ONE_STEP + * option tells the solver to just take one internal step + * and return the solution at the point reached by that step. + * + * interp: Specifies the interpolation type used to evaluate the + * forward solution during the backward integration phase. + * CV_HERMITE specifies cubic Hermite interpolation. + * CV_POYNOMIAL specifies the polynomial interpolation + * ----------------------------------------------------------------- + */ + +/* lmm */ +#define CV_ADAMS 1 +#define CV_BDF 2 + +/* iter */ +#define CV_FUNCTIONAL 1 +#define CV_NEWTON 2 + +/* itask */ +#define CV_NORMAL 1 +#define CV_ONE_STEP 2 + +/* ism */ +#define CV_SIMULTANEOUS 1 +#define CV_STAGGERED 2 +#define CV_STAGGERED1 3 + +/* DQtype */ +#define CV_CENTERED 1 +#define CV_FORWARD 2 + +/* interp */ +#define CV_HERMITE 1 +#define CV_POLYNOMIAL 2 + +/* + * ---------------------------------------- + * CVODES return flags + * ---------------------------------------- + */ + +#define CV_SUCCESS 0 +#define CV_TSTOP_RETURN 1 +#define CV_ROOT_RETURN 2 + +#define CV_WARNING 99 + +#define CV_TOO_MUCH_WORK -1 +#define CV_TOO_MUCH_ACC -2 +#define CV_ERR_FAILURE -3 +#define CV_CONV_FAILURE -4 + +#define CV_LINIT_FAIL -5 +#define CV_LSETUP_FAIL -6 +#define CV_LSOLVE_FAIL -7 +#define CV_RHSFUNC_FAIL -8 +#define CV_FIRST_RHSFUNC_ERR -9 +#define CV_REPTD_RHSFUNC_ERR -10 +#define CV_UNREC_RHSFUNC_ERR -11 +#define CV_RTFUNC_FAIL -12 + +#define CV_MEM_FAIL -20 +#define CV_MEM_NULL -21 +#define CV_ILL_INPUT -22 +#define CV_NO_MALLOC -23 +#define CV_BAD_K -24 +#define CV_BAD_T -25 +#define CV_BAD_DKY -26 +#define CV_TOO_CLOSE -27 + +#define CV_NO_QUAD -30 +#define CV_QRHSFUNC_FAIL -31 +#define CV_FIRST_QRHSFUNC_ERR -32 +#define CV_REPTD_QRHSFUNC_ERR -33 +#define CV_UNREC_QRHSFUNC_ERR -34 + +#define CV_NO_SENS -40 +#define CV_SRHSFUNC_FAIL -41 +#define CV_FIRST_SRHSFUNC_ERR -42 +#define CV_REPTD_SRHSFUNC_ERR -43 +#define CV_UNREC_SRHSFUNC_ERR -44 + +#define CV_BAD_IS -45 + +#define CV_NO_QUADSENS -50 +#define CV_QSRHSFUNC_FAIL -51 +#define CV_FIRST_QSRHSFUNC_ERR -52 +#define CV_REPTD_QSRHSFUNC_ERR -53 +#define CV_UNREC_QSRHSFUNC_ERR -54 + +/* + * ---------------------------------------- + * CVODEA return flags + * ---------------------------------------- + */ + +#define CV_NO_ADJ -101 +#define CV_NO_FWD -102 +#define CV_NO_BCK -103 +#define CV_BAD_TB0 -104 +#define CV_REIFWD_FAIL -105 +#define CV_FWD_FAIL -106 +#define CV_GETY_BADT -107 + +/* + * ================================================================= + * + * FUNCTION TYPES + * + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Type : CVRhsFn + * ----------------------------------------------------------------- + * The f function which defines the right hand side of the ODE + * system y' = f(t,y) must have type CVRhsFn. + * f takes as input the independent variable value t, and the + * dependent variable vector y. It stores the result of f(t,y) + * in the vector ydot. The y and ydot arguments are of type + * N_Vector. + * (Allocation of memory for ydot is handled within CVODES) + * The user_data parameter is the same as the user_data + * parameter set by the user through the CVodeSetUserData routine. + * This user-supplied pointer is passed to the user's f function + * every time it is called. + * + * A CVRhsFn should return 0 if successful, a negative value if + * an unrecoverable error occured, and a positive value if a + * recoverable error (e.g. invalid y values) occured. + * If an unrecoverable occured, the integration is halted. + * If a recoverable error occured, then (in most cases) CVODES + * will try to correct and retry. + * ----------------------------------------------------------------- + */ + +typedef int (*CVRhsFn)(realtype t, N_Vector y, + N_Vector ydot, void *user_data); + +/* + * ----------------------------------------------------------------- + * Type : CVRootFn + * ----------------------------------------------------------------- + * A function g, which defines a set of functions g_i(t,y) whose + * roots are sought during the integration, must have type CVRootFn. + * The function g takes as input the independent variable value + * t, and the dependent variable vector y. It stores the nrtfn + * values g_i(t,y) in the realtype array gout. + * (Allocation of memory for gout is handled within CVODE.) + * The user_data parameter is the same as that passed by the user + * to the CVodeSetUserData routine. This user-supplied pointer is + * passed to the user's g function every time it is called. + * + * A CVRootFn should return 0 if successful or a non-zero value + * if an error occured (in which case the integration will be halted). + * ----------------------------------------------------------------- + */ + +typedef int (*CVRootFn)(realtype t, N_Vector y, realtype *gout, void *user_data); + +/* + * ----------------------------------------------------------------- + * Type : CVEwtFn + * ----------------------------------------------------------------- + * A function e, which sets the error weight vector ewt, must have + * type CVEwtFn. + * The function e takes as input the current dependent variable y. + * It must set the vector of error weights used in the WRMS norm: + * + * ||y||_WRMS = sqrt [ 1/N * sum ( ewt_i * y_i)^2 ] + * + * Typically, the vector ewt has components: + * + * ewt_i = 1 / (reltol * |y_i| + abstol_i) + * + * The user_data parameter is the same as that passed by the user + * to the CVodeSetUserData routine. This user-supplied pointer is + * passed to the user's e function every time it is called. + * A CVEwtFn e must return 0 if the error weight vector has been + * successfuly set and a non-zero value otherwise. + * ----------------------------------------------------------------- + */ + +typedef int (*CVEwtFn)(N_Vector y, N_Vector ewt, void *user_data); + + +/* + * ----------------------------------------------------------------- + * Type : CVErrHandlerFn + * ----------------------------------------------------------------- + * A function eh, which handles error messages, must have type + * CVErrHandlerFn. + * The function eh takes as input the error code, the name of the + * module reporting the error, the error message, and a pointer to + * user data, the same as that passed to CVodeSetUserData. + * + * All error codes are negative, except CV_WARNING which indicates + * a warning (the solver continues). + * + * A CVErrHandlerFn has no return value. + * ----------------------------------------------------------------- + */ + +typedef void (*CVErrHandlerFn)(int error_code, + const char *module, const char *function, + char *msg, void *user_data); + +/* + * ----------------------------------------------------------------- + * Type : CVQuadRhsFn + * ----------------------------------------------------------------- + * The fQ function which defines the right hand side of the + * quadrature equations yQ' = fQ(t,y) must have type CVQuadRhsFn. + * fQ takes as input the value of the independent variable t, + * the vector of states y and must store the result of fQ in + * yQdot. (Allocation of memory for yQdot is handled by CVODES). + * The user_data parameter is the same as the user_data parameter + * set by the user through the CVodeSetUserData routine and is + * passed to the fQ function every time it is called. + * + * If the quadrature RHS also depends on the sensitivity variables, + * i.e., yQ' = fQs(t,y,yS), then fQ must be of type CVodeQuadRhsFnS. + * + * A CVQuadRhsFn or CVodeQuadRhsFnS should return 0 if successful, + * a negative value if an unrecoverable error occured, and a positive + * value if a recoverable error (e.g. invalid y values) occured. + * If an unrecoverable occured, the integration is halted. + * If a recoverable error occured, then (in most cases) CVODES + * will try to correct and retry. + * ----------------------------------------------------------------- + */ + +typedef int (*CVQuadRhsFn)(realtype t, N_Vector y, + N_Vector yQdot, + void *user_data); + +/* + * ----------------------------------------------------------------- + * Type : CVSensRhsFn + * ----------------------------------------------------------------- + * The fS function which defines the right hand side of the + * sensitivity ODE systems s' = f_y * s + f_p must have type + * CVSensRhsFn. + * fS takes as input the number of sensitivities Ns, the + * independent variable value t, the states y and the + * corresponding value of f(t,y) in ydot, and the dependent + * sensitivity vectors yS. It stores the result of fS in ySdot. + * (Allocation of memory for ySdot is handled within CVODES) + * The user_data parameter is the same as the user_data parameter + * set by the user through the CVodeSetUserData routine and is + * passed to the fS function every time it is called. + * + * A CVSensRhsFn should return 0 if successful, a negative value if + * an unrecoverable error occured, and a positive value if a + * recoverable error (e.g. invalid y or yS values) occured. + * If an unrecoverable occured, the integration is halted. + * If a recoverable error occured, then (in most cases) CVODES + * will try to correct and retry. + * ----------------------------------------------------------------- + */ + +typedef int (*CVSensRhsFn)(int Ns, realtype t, + N_Vector y, N_Vector ydot, + N_Vector *yS, N_Vector *ySdot, + void *user_data, + N_Vector tmp1, N_Vector tmp2); + +/* + * ----------------------------------------------------------------- + * Type : CVSensRhs1Fn + * ----------------------------------------------------------------- + * The fS1 function which defines the right hand side of the i-th + * sensitivity ODE system s_i' = f_y * s_i + f_p must have type + * CVSensRhs1Fn. + * fS1 takes as input the number of sensitivities Ns, the current + * sensitivity iS, the independent variable value t, the states y + * and the corresponding value of f(t,y) in ydot, and the + * dependent sensitivity vector yS. It stores the result of fS in + * ySdot. + * (Allocation of memory for ySdot is handled within CVODES) + * The user_data parameter is the same as the user_data parameter + * set by the user through the CVodeSetUserData routine and is + * passed to the fS1 function every time it is called. + * + * A CVSensRhs1Fn should return 0 if successful, a negative value if + * an unrecoverable error occured, and a positive value if a + * recoverable error (e.g. invalid y or yS values) occured. + * If an unrecoverable occured, the integration is halted. + * If a recoverable error occured, then (in most cases) CVODES + * will try to correct and retry. + * ----------------------------------------------------------------- + */ + +typedef int (*CVSensRhs1Fn)(int Ns, realtype t, + N_Vector y, N_Vector ydot, + int iS, N_Vector yS, N_Vector ySdot, + void *user_data, + N_Vector tmp1, N_Vector tmp2); + +/* + * ----------------------------------------------------------------- + * Type : CVQuadSensRhsFn + * ----------------------------------------------------------------- + * The fQS function which defines the right hand side of the + * sensitivity ODE systems for quadratures, yQS' = fQ_y * yS + fQ_p + * must have type CVQuadSensRhsFn. + * + * fQS takes as input the number of sensitivities Ns (the same as + * that passed to CVodeQuadSensInit), the independent variable + * value t, the states y and the dependent sensitivity vectors yS, + * as well as the current value of the quadrature RHS yQdot. + * It stores the result of fQS in yQSdot. + * (Allocation of memory for yQSdot is handled within CVODES) + * + * A CVQuadSensRhsFn should return 0 if successful, a negative + * value if an unrecoverable error occured, and a positive value + * if a recoverable error (e.g. invalid y or yS values) occured. + * If an unrecoverable occured, the integration is halted. + * If a recoverable error occured, then (in most cases) CVODES + * will try to correct and retry. + * ----------------------------------------------------------------- + */ + +typedef int (*CVQuadSensRhsFn)(int Ns, realtype t, + N_Vector y, N_Vector *yS, + N_Vector yQdot, N_Vector *yQSdot, + void *user_data, + N_Vector tmp, N_Vector tmpQ); + +/* + * ----------------------------------------------------------------- + * CVRhsFnB and CVRhsFnBS + * The fB function which defines the right hand side of the + * ODE systems to be integrated backwards must have type CVRhsFnB. + * If the backward problem depends on forward sensitivities, its + * RHS function must have type CVRhsFnBS. + * ----------------------------------------------------------------- + * CVQuadRhsFnB and CVQuadRhsFnBS + * The fQB function which defines the quadratures to be integrated + * backwards must have type CVQuadRhsFnB. + * If the backward problem depends on forward sensitivities, its + * quadrature RHS function must have type CVQuadRhsFnBS. + * ----------------------------------------------------------------- + */ + +typedef int (*CVRhsFnB)(realtype t, N_Vector y, + N_Vector yB, N_Vector yBdot, + void *user_dataB); + +typedef int (*CVRhsFnBS)(realtype t, N_Vector y, N_Vector *yS, + N_Vector yB, N_Vector yBdot, + void *user_dataB); + + +typedef int (*CVQuadRhsFnB)(realtype t, N_Vector y, + N_Vector yB, N_Vector qBdot, + void *user_dataB); + +typedef int (*CVQuadRhsFnBS)(realtype t, N_Vector y, N_Vector *yS, + N_Vector yB, N_Vector qBdot, + void *user_dataB); + + +/* + * ================================================================= + * + * INITIALIZATION AND DEALLOCATION FUNCTIONS FOR FORWARD PROBLEMS + * + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Function : CVodeCreate + * ----------------------------------------------------------------- + * CVodeCreate creates an internal memory block for a problem to + * be solved by CVODES. + * + * lmm is the type of linear multistep method to be used. + * The legal values are CV_ADAMS and CV_BDF (see previous + * description). + * + * iter is the type of iteration used to solve the nonlinear + * system that arises during each internal time step. + * The legal values are CV_FUNCTIONAL and CV_NEWTON. + * + * If successful, CVodeCreate returns a pointer to initialized + * problem memory. This pointer should be passed to CVodeInit. + * If an initialization error occurs, CVodeCreate prints an error + * message to standard err and returns NULL. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void *CVodeCreate(int lmm, int iter); + +/* + * ----------------------------------------------------------------- + * Functions : CVodeInit and CVodeReInit + * ----------------------------------------------------------------- + * CVodeInit allocates and initializes memory for a problem to + * to be solved by CVODE. + * + * CVodeReInit re-initializes CVode for the solution of a problem, + * where a prior call to CVodeInit has been made with the same + * problem size N. CVodeReInit performs the same input checking + * and initializations that CVodeInit does. + * But it does no memory allocation, assuming that the existing + * internal memory is sufficient for the new problem. + * + * The use of CVodeReInit requires that the maximum method order, + * maxord, is no larger for the new problem than for the problem + * specified in the last call to CVodeInit. This condition is + * automatically fulfilled if the multistep method parameter lmm + * is unchanged (or changed from CV_ADAMS to CV_BDF) and the default + * value for maxord is specified. + * + * cvode_mem is pointer to CVODE memory returned by CVodeCreate. + * + * f is the name of the C function defining the right-hand + * side function in y' = f(t,y). + * + * t0 is the initial value of t. + * + * y0 is the initial condition vector y(t0). + * + * Return flag: + * CV_SUCCESS if successful + * CV_MEM_NULL if the cvode memory was NULL + * CV_MEM_FAIL if a memory allocation failed + * CV_NO_MALLOC if cvode_mem has not been allocated + * (i.e., CVodeInit has not been called). + * CV_ILL_INPUT if an argument has an illegal value. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeInit(void *cvode_mem, CVRhsFn f, realtype t0, N_Vector y0); +SUNDIALS_EXPORT int CVodeReInit(void *cvode_mem, realtype t0, N_Vector y0); + +/* + * ----------------------------------------------------------------- + * Functions : CVodeSStolerances + * CVodeSVtolerances + * CVodeWFtolerances + * ----------------------------------------------------------------- + * + * These functions specify the integration tolerances. One of them + * MUST be called before the first call to CVode. + * + * CVodeSStolerances specifies scalar relative and absolute tolerances. + * CVodeSVtolerances specifies scalar relative tolerance and a vector + * absolute tolerance (a potentially different absolute tolerance + * for each vector component). + * CVodeWFtolerances specifies a user-provides function (of type CVEwtFn) + * which will be called to set the error weight vector. + * + * The tolerances reltol and abstol define a vector of error weights, + * ewt, with components + * ewt[i] = 1/(reltol*abs(y[i]) + abstol) (in the SS case), or + * ewt[i] = 1/(reltol*abs(y[i]) + abstol[i]) (in the SV case). + * This vector is used in all error and convergence tests, which + * use a weighted RMS norm on all error-like vectors v: + * WRMSnorm(v) = sqrt( (1/N) sum(i=1..N) (v[i]*ewt[i])^2 ), + * where N is the problem dimension. + * + * The return value of these functions is equal to CV_SUCCESS = 0 if + * there were no errors; otherwise it is a negative int equal to: + * CV_MEM_NULL indicating cvode_mem was NULL (i.e., + * CVodeCreate has not been called). + * CV_NO_MALLOC indicating that cvode_mem has not been + * allocated (i.e., CVodeInit has not been + * called). + * CV_ILL_INPUT indicating an input argument was illegal + * (e.g. a negative tolerance) + * In case of an error return, an error message is also printed. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeSStolerances(void *cvode_mem, realtype reltol, realtype abstol); +SUNDIALS_EXPORT int CVodeSVtolerances(void *cvode_mem, realtype reltol, N_Vector abstol); +SUNDIALS_EXPORT int CVodeWFtolerances(void *cvode_mem, CVEwtFn efun); + +/* + * ----------------------------------------------------------------- + * Function : CVodeQuadInit and CVodeQuadReInit + * ----------------------------------------------------------------- + * CVodeQuadInit allocates and initializes memory related to + * quadrature integration. + * + * CVodeQuadReInit re-initializes CVODES's quadrature related + * memory for a problem, assuming it has already been allocated + * in prior calls to CVodeInit and CVodeQuadInit. + * The number of quadratures Nq is assumed to be unchanged + * since the previous call to CVodeQuadInit. + * + * cvode_mem is a pointer to CVODES memory returned by CVodeCreate + * + * fQ is the user-provided integrand routine. + * + * yQ0 is an N_Vector with initial values for quadratures + * (typically yQ0 has all zero components). + * + * Return values: + * CV_SUCCESS if successful + * CV_MEM_NULL if the cvode memory was NULL + * CV_MEM_FAIL if a memory allocation failed + * CV_NO_QUAD if quadratures were not initialized + * (i.e. CVodeQuadInit has not been called) + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeQuadInit(void *cvode_mem, CVQuadRhsFn fQ, N_Vector yQ0); +SUNDIALS_EXPORT int CVodeQuadReInit(void *cvode_mem, N_Vector yQ0); + +/* + * ----------------------------------------------------------------- + * Functions : CVodeQuadSStolerances + * CVodeQuadSVtolerances + * ----------------------------------------------------------------- + * + * These functions specify the integration tolerances for quadrature + * variables. One of them MUST be called before the first call to + * CVode IF error control on the quadrature variables is enabled + * (see CVodeSetQuadErrCon). + * + * CVodeSStolerances specifies scalar relative and absolute tolerances. + * CVodeSVtolerances specifies scalar relative tolerance and a vector + * absolute tolerance (a potentially different absolute tolerance + * for each vector component). + * + * Return values: + * CV_SUCCESS if successful + * CV_MEM_NULL if the cvode memory was NULL + * CV_NO_QUAD if quadratures were not initialized + * CV_ILL_INPUT if an input argument was illegal + * (e.g. a negative tolerance) + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeQuadSStolerances(void *cvode_mem, realtype reltolQ, realtype abstolQ); +SUNDIALS_EXPORT int CVodeQuadSVtolerances(void *cvode_mem, realtype reltolQ, N_Vector abstolQ); + +/* + * ----------------------------------------------------------------- + * Function : CVodeSensInit, CVSensInit1, and CVodeSensReInit + * ----------------------------------------------------------------- + * CVodeSensInit and CVSensInit1 allocate and initialize memory + * related to sensitivity computations. They only differ in the + * type of the sensitivity RHS function: CVodeSensInit specifies + * fS of type CVSensRhsFn (i.e. a function that evaluates all + * sensitivity RHS simultaneously), while CVodeSensInit1 specifies + * fS of type CVSensRhs1Fn (i.e. a function that evaluates one + * sensitivity RHS at a time). Recall that ism=CV_STAGGERED1 is + * compatible ONLY with a CVSensRhs1Fn. As such, this value for + * ism cannot be passed to CVodeSensInit. + * + * CVodeSensReInit re-initializes CVODES's sensitivity related + * memory for a problem, assuming it has already been allocated + * in prior calls to CVodeInit and CVodeSensInit. + * The number of sensitivities Ns is assumed to be unchanged + * since the previous call to CVodeSensInit. + * If any error occurs during initialization, it is reported to + * the file whose file pointer is errfp. + * CVodeSensReInit potentially does some minimal memory allocation + * (for the sensitivity absolute tolerance and for arrays of + * counters used by the CV_STAGGERED1 method). + + * cvode_mem is pointer to CVODES memory returned by CVodeCreate + * + * Ns is the number of sensitivities to be computed. + * + * ism is the type of corrector used in sensitivity + * analysis. The legal values are: CV_SIMULTANEOUS, + * CV_STAGGERED, and CV_STAGGERED1. + * + * fS is the sensitivity righ-hand side function + * (pass NULL to use the internal DQ approximation) + * + * yS0 is the array of initial condition vectors for + * sensitivity variables. + * + * Return values: + * CV_SUCCESS + * CV_MEM_NULL + * CV_ILL_INPUT + * CV_MEM_FAIL + * CV_NO_SENS + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeSensInit(void *cvode_mem, int Ns, int ism, + CVSensRhsFn fS, N_Vector *yS0); +SUNDIALS_EXPORT int CVodeSensInit1(void *cvode_mem, int Ns, int ism, + CVSensRhs1Fn fS1, N_Vector *yS0); +SUNDIALS_EXPORT int CVodeSensReInit(void *cvode_mem, int ism, N_Vector *yS0); + +/* + * ----------------------------------------------------------------- + * Functions : CVodeSensSStolerances + * CVodeSensSVtolerances + * CVodeSensEEtolerances + * ----------------------------------------------------------------- + * + * These functions specify the integration tolerances for sensitivity + * variables. One of them MUST be called before the first call to CVode. + * + * CVodeSensSStolerances specifies scalar relative and absolute tolerances. + * CVodeSensSVtolerances specifies scalar relative tolerance and a vector + * absolute tolerance for each sensitivity vector (a potentially different + * absolute tolerance for each vector component). + * CVodeSensEEtolerances specifies that tolerances for sensitivity variables + * should be estimated from those provided for the state variables. + * + * The return value is equal to CV_SUCCESS = 0 if there were no + * errors; otherwise it is a negative int equal to: + * CV_MEM_NULL indicating cvode_mem was NULL, or + * CV_NO_SENS indicating there was not a prior call to + * CVodeSensInit. + * CV_ILL_INPUT indicating an input argument was illegal + * (e.g. negative tolerances) + * In case of an error return, an error message is also printed. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeSensSStolerances(void *cvode_mem, realtype reltolS, realtype *abstolS); +SUNDIALS_EXPORT int CVodeSensSVtolerances(void *cvode_mem, realtype reltolS, N_Vector *abstolS); +SUNDIALS_EXPORT int CVodeSensEEtolerances(void *cvode_mem); + +/* + * ----------------------------------------------------------------- + * Function : CVodeQuadSensInit and CVodeQuadSensReInit + * ----------------------------------------------------------------- + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeQuadSensInit(void *cvode_mem, CVQuadSensRhsFn fQS, N_Vector *yQS0); +SUNDIALS_EXPORT int CVodeQuadSensReInit(void *cvode_mem, N_Vector *yQS0); + +/* + * ----------------------------------------------------------------- + * Functions : CVodeQuadSensSStolerances + * CVodeQuadSensSVtolerances + * CVodeQuadSensEEtolerances + * ----------------------------------------------------------------- + * + * These functions specify the integration tolerances for quadrature + * sensitivity variables. One of them MUST be called before the first + * call to CVode IF these variables are included in the error test. + * + * CVodeQuadSensSStolerances specifies scalar relative and absolute tolerances. + * CVodeQuadSensSVtolerances specifies scalar relative tolerance and a vector + * absolute tolerance for each quadrature sensitivity vector (a potentially + * different absolute tolerance for each vector component). + * CVodeQuadSensEEtolerances specifies that tolerances for sensitivity variables + * should be estimated from those provided for the quadrature variables. + * In this case, tolerances for the quadrature variables must be + * specified through a call to one of CVodeQuad**tolerances. + * + * The return value is equal to CV_SUCCESS = 0 if there were no + * errors; otherwise it is a negative int equal to: + * CV_MEM_NULL if cvode_mem was NULL, or + * CV_NO_QuadSENS if there was not a prior call to + * CVodeQuadSensInit. + * CV_ILL_INPUT if an input argument was illegal + * (e.g. negative tolerances) + * In case of an error return, an error message is also printed. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeQuadSensSStolerances(void *cvode_mem, realtype reltolQS, realtype *abstolQS); +SUNDIALS_EXPORT int CVodeQuadSensSVtolerances(void *cvode_mem, realtype reltolQS, N_Vector *abstolQS); +SUNDIALS_EXPORT int CVodeQuadSensEEtolerances(void *cvode_mem); + +/* + * ----------------------------------------------------------------- + * Function : CVodeRootInit + * ----------------------------------------------------------------- + * CVodeRootInit initializes a rootfinding problem to be solved + * during the integration of the ODE system. It must be called + * after CVodeCreate, and before CVode. The arguments are: + * + * cvode_mem = pointer to CVODE memory returned by CVodeCreate. + * + * nrtfn = number of functions g_i, an int >= 0. + * + * g = name of user-supplied function, of type CVRootFn, + * defining the functions g_i whose roots are sought. + * + * If a new problem is to be solved with a call to CVodeReInit, + * where the new problem has no root functions but the prior one + * did, then call CVodeRootInit with nrtfn = 0. + * + * The return value of CVodeRootInit is CV_SUCCESS = 0 if there were + * no errors; otherwise it is a negative int equal to: + * CV_MEM_NULL indicating cvode_mem was NULL, or + * CV_MEM_FAIL indicating a memory allocation failed. + * (including an attempt to increase maxord). + * CV_ILL_INPUT indicating nrtfn > 0 but g = NULL. + * In case of an error return, an error message is also printed. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeRootInit(void *cvode_mem, int nrtfn, CVRootFn g); + +/* + * ----------------------------------------------------------------- + * Function : CVodeFree + * ----------------------------------------------------------------- + * CVodeFree frees the problem memory cvode_mem allocated by + * CVodeInit. Its only argument is the pointer cvode_mem + * returned by CVodeCreate. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void CVodeFree(void **cvode_mem); + +/* + * ----------------------------------------------------------------- + * Function : CVodeQuadFree + * ----------------------------------------------------------------- + * CVodeQuadFree frees the problem memory in cvode_mem allocated + * for quadrature integration. Its only argument is the pointer + * cvode_mem returned by CVodeCreate. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void CVodeQuadFree(void *cvode_mem); + +/* + * ----------------------------------------------------------------- + * Function : CVodeSensFree + * ----------------------------------------------------------------- + * CVodeSensFree frees the problem memory in cvode_mem allocated + * for sensitivity analysis. Its only argument is the pointer + * cvode_mem returned by CVodeCreate. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void CVodeSensFree(void *cvode_mem); + +/* + * ----------------------------------------------------------------- + * Function : CVodeQuadSensFree + * ----------------------------------------------------------------- + * CVodeQuadSensFree frees the problem memory in cvode_mem allocated + * for quadrature sensitivity analysis. Its only argument is the + * pointer cvode_mem returned by CVodeCreate. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void CVodeQuadSensFree(void *cvode_mem); + +/* + * ================================================================= + * + * OPTIONAL INPUT FUNCTIONS FOR FORWARD PROBLEMS + * + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Integrator optional input specification functions + * ----------------------------------------------------------------- + * The following functions can be called to set optional inputs + * to values other than the defaults given below: + * + * Function | Optional input / [ default value ] + * ----------------------------------------------------------------- + * | + * CVodeSetErrHandlerFn | user-provided ErrHandler function. + * | [internal] + * | + * CVodeSetErrFile | the file pointer for an error file + * | where all CVODE warning and error + * | messages will be written if the default + * | internal error handling function is used. + * | This parameter can be stdout (standard + * | output), stderr (standard error), or a + * | file pointer (corresponding to a user + * | error file opened for writing) returned + * | by fopen. + * | If not called, then all messages will + * | be written to the standard error stream. + * | [stderr] + * | + * CVodeSetUserData | a pointer to user data that will be + * | passed to the user's f function every + * | time f is called. + * | [NULL] + * | + * CVodeSetMaxOrd | maximum lmm order to be used by the + * | solver. + * | [12 for Adams , 5 for BDF] + * | + * CVodeSetMaxNumSteps | maximum number of internal steps to be + * | taken by the solver in its attempt to + * | reach tout. + * | [500] + * | + * CVodeSetMaxHnilWarns | maximum number of warning messages + * | issued by the solver that t+h==t on the + * | next internal step. A value of -1 means + * | no such messages are issued. + * | [10] + * | + * CVodeSetStabLimDet | flag to turn on/off stability limit + * | detection (TRUE = on, FALSE = off). + * | When BDF is used and order is 3 or + * | greater, CVsldet is called to detect + * | stability limit. If limit is detected, + * | the order is reduced. + * | [FALSE] + * | + * CVodeSetInitStep | initial step size. + * | [estimated by CVODES] + * | + * CVodeSetMinStep | minimum absolute value of step size + * | allowed. + * | [0.0] + * | + * CVodeSetMaxStep | maximum absolute value of step size + * | allowed. + * | [infinity] + * | + * CVodeSetStopTime | the independent variable value past + * | which the solution is not to proceed. + * | [infinity] + * | + * CVodeSetMaxErrTestFails | Maximum number of error test failures + * | in attempting one step. + * | [7] + * | + * CVodeSetMaxNonlinIters | Maximum number of nonlinear solver + * | iterations at one solution. + * | [3] + * | + * CVodeSetMaxConvFails | Maximum number of allowable conv. + * | failures in attempting one step. + * | [10] + * | + * CVodeSetNonlinConvCoef | Coeficient in the nonlinear conv. + * | test. + * | [0.1] + * | + * ----------------------------------------------------------------- + * | + * CVodeSetIterType | Changes the current nonlinear iteration + * | type. + * | [set by CVodecreate] + * | + * ----------------------------------------------------------------- + * | + * CVodeSetRootDirection | Specifies the direction of zero + * | crossings to be monitored + * | [both directions] + * | + * CVodeSetNoInactiveRootWarn | disable warning about possible + * | g==0 at beginning of integration + * | + * ----------------------------------------------------------------- + * Return flag: + * CV_SUCCESS if successful + * CV_MEM_NULL if the cvode memory is NULL + * CV_ILL_INPUT if an argument has an illegal value + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeSetErrHandlerFn(void *cvode_mem, CVErrHandlerFn ehfun, void *eh_data); +SUNDIALS_EXPORT int CVodeSetErrFile(void *cvode_mem, FILE *errfp); +SUNDIALS_EXPORT int CVodeSetUserData(void *cvode_mem, void *user_data); +SUNDIALS_EXPORT int CVodeSetMaxOrd(void *cvode_mem, int maxord); +SUNDIALS_EXPORT int CVodeSetMaxNumSteps(void *cvode_mem, long int mxsteps); +SUNDIALS_EXPORT int CVodeSetMaxHnilWarns(void *cvode_mem, int mxhnil); +SUNDIALS_EXPORT int CVodeSetStabLimDet(void *cvode_mem, booleantype stldet); +SUNDIALS_EXPORT int CVodeSetInitStep(void *cvode_mem, realtype hin); +SUNDIALS_EXPORT int CVodeSetMinStep(void *cvode_mem, realtype hmin); +SUNDIALS_EXPORT int CVodeSetMaxStep(void *cvode_mem, realtype hmax); +SUNDIALS_EXPORT int CVodeSetStopTime(void *cvode_mem, realtype tstop); +SUNDIALS_EXPORT int CVodeSetMaxErrTestFails(void *cvode_mem, int maxnef); +SUNDIALS_EXPORT int CVodeSetMaxNonlinIters(void *cvode_mem, int maxcor); +SUNDIALS_EXPORT int CVodeSetMaxConvFails(void *cvode_mem, int maxncf); +SUNDIALS_EXPORT int CVodeSetNonlinConvCoef(void *cvode_mem, realtype nlscoef); + +SUNDIALS_EXPORT int CVodeSetIterType(void *cvode_mem, int iter); + +SUNDIALS_EXPORT int CVodeSetRootDirection(void *cvode_mem, int *rootdir); +SUNDIALS_EXPORT int CVodeSetNoInactiveRootWarn(void *cvode_mem); + + +/* + * ----------------------------------------------------------------- + * Quadrature optional input specification functions + * ----------------------------------------------------------------- + * The following functions can be called to set optional inputs + * to values other than the defaults given below: + * + * Function | Optional input / [ default value ] + * -------------------------------------------------------------- + * | + * CVodeSetQuadErrCon | are quadrature variables considered in + * | the error control? + * | If yes, tolerances for quadrature are + * | required (see CVodeQuad**tolerances) + * | [errconQ = FALSE] + * | + * ----------------------------------------------------------------- + * If successful, these functions return CV_SUCCESS. If an argument + * has an illegal value, they return one of the error flags + * defined for the CVodeSet* routines. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeSetQuadErrCon(void *cvode_mem, booleantype errconQ); + +/* + * ----------------------------------------------------------------- + * Forward sensitivity optional input specification functions + * ----------------------------------------------------------------- + * The following functions can be called to set optional inputs + * to other values than the defaults given below: + * + * Function | Optional input / [ default value ] + * ----------------------------------------------------------------- + * | + * CVodeSetSensDQMethod | controls the selection of finite + * | difference schemes used in evaluating + * | the sensitivity right hand sides: + * | (centered vs. forward and + * | simultaneous vs. separate) + * | [DQtype=CV_CENTERED] + * | [DQrhomax=0.0] + * | + * CVodeSetSensParams | parameter information: + * | p: pointer to problem parameters + * | plist: list of parameters with respect + * | to which sensitivities are to be + * | computed. + * | pbar: order of magnitude info. + * | Typically, if p[plist[i]] is nonzero, + * | pbar[i]=p[plist[i]]. + * | [p=NULL] + * | [plist=NULL] + * | [pbar=NULL] + * | + * CVodeSetSensErrCon | are sensitivity variables considered in + * | the error control? + * | [FALSE] + * | + * CVodeSetSensMaxNonlinIters | Maximum number of nonlinear solver + * | iterations at one solution. + * | [3] + * | + * ----------------------------------------------------------------- + * The return values are the same as for CVodeSet* + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeSetSensDQMethod(void *cvode_mem, int DQtype, realtype DQrhomax); +SUNDIALS_EXPORT int CVodeSetSensErrCon(void *cvode_mem, booleantype errconS); +SUNDIALS_EXPORT int CVodeSetSensMaxNonlinIters(void *cvode_mem, int maxcorS); +SUNDIALS_EXPORT int CVodeSetSensParams(void *cvode_mem, realtype *p, realtype *pbar, int *plist); + +/* + * ----------------------------------------------------------------- + * Quadrature sensitivity optional input specification functions + * ----------------------------------------------------------------- + * The following functions can be called to set optional inputs + * to values other than the defaults given below: + * + * Function | Optional input / [ default value ] + * -------------------------------------------------------------- + * | + * CVodeSetQuadSensErrCon | are quadrature sensitivity variables + * | considered in the error control? + * | If yes, tolerances for quadrature + * | sensitivity variables are required. + * | [errconQS = FALSE] + * | + * ----------------------------------------------------------------- + * If successful, these functions return CV_SUCCESS. If an argument + * has an illegal value, they return one of the error flags + * defined for the CVodeSet* routines. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeSetQuadSensErrCon(void *cvode_mem, booleantype errconQS); + +/* + * ----------------------------------------------------------------- + * Function : CVodeSensToggleOff + * ----------------------------------------------------------------- + * CVodeSensToggleOff deactivates sensitivity calculations. + * It does NOT deallocate sensitivity-related memory so that + * sensitivity computations can be later toggled ON (through + * CVodeSensReInit). + * + * The return value is equal to CV_SUCCESS = 0 if there were no + * errors or CV_MEM_NULL if cvode_mem was NULL + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeSensToggleOff(void *cvode_mem); + + +/* + * ================================================================= + * + * MAIN SOLVER FUNCTION FOR FORWARD PROBLEMS + * + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Function : CVode + * ----------------------------------------------------------------- + * CVode integrates the ODE over an interval in t. + * If itask is CV_NORMAL, then the solver integrates from its + * current internal t value to a point at or beyond tout, then + * interpolates to t = tout and returns y(tout) in the user- + * allocated vector yout. If itask is CV_ONE_STEP, then the solver + * takes one internal time step and returns in yout the value of + * y at the new internal time. In this case, tout is used only + * during the first call to CVode to determine the direction of + * integration and the rough scale of the problem. If tstop is + * enabled (through a call to CVodeSetStopTime), then CVode returns + * the solution at tstop. Once the integrator returns at a tstop + * time, any future testing for tstop is disabled (and can be + * reenabled only though a new call to CVodeSetStopTime). + * The time reached by the solver is placed in (*tret). The + * user is responsible for allocating the memory for this value. + * + * cvode_mem is the pointer to CVODES memory returned by + * CVodeCreate. + * + * tout is the next time at which a computed solution is desired. + * + * yout is the computed solution vector. In CV_NORMAL mode with no + * errors and no roots found, yout=y(tout). + * + * tret is a pointer to a real location. CVode sets (*tret) to + * the time reached by the solver and returns yout=y(*tret). + * + * itask is CV_NORMAL or CV_ONE_STEP. These two modes are described above. + * + * Here is a brief description of each return value: + * + * CV_SUCCESS: CVode succeeded and no roots were found. + * + * CV_ROOT_RETURN: CVode succeeded, and found one or more roots. + * If nrtfn > 1, call CVodeGetRootInfo to see + * which g_i were found to have a root at (*tret). + * + * CV_TSTOP_RETURN: CVode succeded and returned at tstop. + * + * CV_MEM_NULL: The cvode_mem argument was NULL. + * + * CV_NO_MALLOC: cvode_mem was not allocated. + * + * CV_ILL_INPUT: One of the inputs to CVode is illegal. This + * includes the situation when a component of the + * error weight vectors becomes < 0 during + * internal time-stepping. The ILL_INPUT flag + * will also be returned if the linear solver + * routine CV--- (called by the user after + * calling CVodeCreate) failed to set one of the + * linear solver-related fields in cvode_mem or + * if the linear solver's init routine failed. In + * any case, the user should see the printed + * error message for more details. + * + * CV_TOO_MUCH_WORK: The solver took mxstep internal steps but + * could not reach tout. The default value for + * mxstep is MXSTEP_DEFAULT = 500. + * + * CV_TOO_MUCH_ACC: The solver could not satisfy the accuracy + * demanded by the user for some internal step. + * + * CV_ERR_FAILURE: Error test failures occurred too many times + * (= MXNEF = 7) during one internal time step or + * occurred with |h| = hmin. + * + * CV_CONV_FAILURE: Convergence test failures occurred too many + * times (= MXNCF = 10) during one internal time + * step or occurred with |h| = hmin. + * + * CV_LINIT_FAIL: The linear solver's initialization function + * failed. + * + * CV_LSETUP_FAIL: The linear solver's setup routine failed in an + * unrecoverable manner. + * + * CV_LSOLVE_FAIL: The linear solver's solve routine failed in an + * unrecoverable manner. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVode(void *cvode_mem, realtype tout, N_Vector yout, + realtype *tret, int itask); + + +/* + * ================================================================= + * + * EXTRACTION AND DENSE OUTPUT FUNCTIONS FOR FORWARD PROBLEMS + * + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Function : CVodeGetDky + * ----------------------------------------------------------------- + * CVodeGetDky computes the kth derivative of the y function at + * time t, where tn-hu <= t <= tn, tn denotes the current + * internal time reached, and hu is the last internal step size + * successfully used by the solver. The user may request + * k=0, 1, ..., qu, where qu is the current order. The + * derivative vector is returned in dky. This vector must be + * allocated by the caller. It is only legal to call this + * function after a successful return from CVode. + * + * cvode_mem is the pointer to CVODES memory returned by + * CVodeCreate. + * + * t is the time at which the kth derivative of y is evaluated. + * The legal range for t is [tn-hu,tn] as described above. + * + * k is the order of the derivative of y to be computed. The + * legal range for k is [0,qu] as described above. + * + * dky is the output derivative vector [(D_k)y](t). + * + * The return values for CVodeGetDky are defined below. + * Here is a brief description of each return value: + * + * CV_SUCCESS: CVodeGetDky succeeded. + * + * CV_BAD_K : k is not in the range 0, 1, ..., qu. + * + * CV_BAD_T : t is not in the interval [tn-hu,tn]. + * + * CV_BAD_DKY : The dky argument was NULL. + * + * CV_MEM_NULL : The cvode_mem argument was NULL. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetDky(void *cvode_mem, realtype t, int k, N_Vector dky); + + +/* + * ----------------------------------------------------------------- + * Quadrature integration solution extraction routines + * ----------------------------------------------------------------- + * The following functions can be called to obtain the quadrature + * variables after a successful integration step. + * If quadratures were not computed, they return CV_NO_QUAD. + * + * CVodeGetQuad returns the quadrature variables at the same time + * as that at which CVode returned the solution. + * + * CVodeGetQuadDky returns the quadrature variables (or their + * derivatives up to the current method order) at any time within + * the last integration step (dense output). See CVodeGetQuad for + * more information. + * + * The output vectors yQout and dky must be allocated by the user. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetQuad(void *cvode_mem, realtype *tret, N_Vector yQout); + +SUNDIALS_EXPORT int CVodeGetQuadDky(void *cvode_mem, realtype t, int k, N_Vector dky); + +/* + * ----------------------------------------------------------------- + * Forward sensitivity solution extraction routines + * ----------------------------------------------------------------- + * The following functions can be called to obtain the sensitivity + * variables after a successful integration step. + * + * CVodeGetSens and CVodeGetSens1 return all the sensitivity vectors + * or only one of them, respectively, at the same time as that at + * which CVode returned the solution. + * The array of output vectors or output vector ySout must be + * allocated by the user. + * + * CVodeGetSensDky1 computes the kth derivative of the is-th + * sensitivity (is=1, 2, ..., Ns) of the y function at time t, + * where tn-hu <= t <= tn, tn denotes the current internal time + * reached, and hu is the last internal step size successfully + * used by the solver. The user may request k=0, 1, ..., qu, + * where qu is the current order. + * The is-th sensitivity derivative vector is returned in dky. + * This vector must be allocated by the caller. It is only legal + * to call this function after a successful return from CVode + * with sensitivty computations enabled. + * Arguments have the same meaning as in CVodeDky. + * + * CVodeGetSensDky computes the k-th derivative of all + * sensitivities of the y function at time t. It repeatedly calls + * CVodeGetSensDky. The argument dkyA must be a pointer to + * N_Vector and must be allocated by the user to hold at least Ns + * vectors. + * + * Return values are similar to those of CVodeDky. Additionally, + * CVodeSensDky can return CV_NO_SENS if sensitivities were + * not computed and CV_BAD_IS if is < 0 or is >= Ns. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetSens(void *cvode_mem, realtype *tret, N_Vector *ySout); +SUNDIALS_EXPORT int CVodeGetSens1(void *cvode_mem, realtype *tret, int is, N_Vector ySout); + +SUNDIALS_EXPORT int CVodeGetSensDky(void *cvode_mem, realtype t, int k, N_Vector *dkyA); +SUNDIALS_EXPORT int CVodeGetSensDky1(void *cvode_mem, realtype t, int k, int is, N_Vector dky); + +/* + * ----------------------------------------------------------------- + * Quadrature sensitivity solution extraction routines + * ----------------------------------------------------------------- + * The following functions can be called to obtain the quadrature + * sensitivity variables after a successful integration step. + * + * CVodeGetQuadSens and CVodeGetQuadSens1 return all the quadrature + * sensitivity vectors or only one of them, respectively, at the + * same time as that at which CVode returned the solution. + * The array of output vectors or output vector yQSout must be + * allocated by the user. + * + * CVodeGetQuadSensDky1 computes the kth derivative of the is-th + * quadrature sensitivity (is=1, 2, ..., Ns) at time t, where + * tn-hu <= t <= tn, tn denotes the current internal time + * reached, and hu is the last internal step size successfully + * used by the solver. The user may request k=0, 1, ..., qu, + * where qu is the current order. + * The is-th sensitivity derivative vector is returned in dkyQS. + * This vector must be allocated by the caller. It is only legal + * to call this function after a successful return from CVode + * with quadrature sensitivty computations enabled. + * Arguments have the same meaning as in CVodeDky. + * + * CVodeGetQuadSensDky computes the k-th derivative of all + * quadrature sensitivities at time t. It repeatedly calls + * CVodeGetSensDky. The argument dkyQS_all must be a pointer to + * N_Vector and must be allocated by the user to hold at least Ns + * vectors. + * + * Return values are similar to those of CVodeDky. Additionally, + * CVodeQuadSensDky can return CV_NO_QUADSENS if quadrature + * sensitivities were not computed and CV_BAD_IS if is < 0 or is >= Ns. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetQuadSens(void *cvode_mem, realtype *tret, N_Vector *yQSout); +SUNDIALS_EXPORT int CVodeGetQuadSens1(void *cvode_mem, realtype *tret, int is, N_Vector yQSout); + +SUNDIALS_EXPORT int CVodeGetQuadSensDky(void *cvode_mem, realtype t, int k, N_Vector *dkyQS_all); +SUNDIALS_EXPORT int CVodeGetQuadSensDky1(void *cvode_mem, realtype t, int k, int is, N_Vector dkyQS); + +/* + * ================================================================= + * + * OPTIONAL OUTPUT FUNCTIONS FOR FORWARD PROBLEMS + * + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Integrator optional output extraction functions + * ----------------------------------------------------------------- + * The following functions can be called to get optional outputs + * and statistics related to the main integrator. + * ----------------------------------------------------------------- + * CVodeGetWorkSpace returns the CVODES real and integer workspaces + * CVodeGetNumSteps returns the cumulative number of internal + * steps taken by the solver + * CVodeGetNumRhsEvals returns the number of calls to the user's + * f function + * CVodeGetNumLinSolvSetups returns the number of calls made to + * the linear solver's setup routine + * CVodeGetNumErrTestFails returns the number of local error test + * failures that have occured + * CVodeGetLastOrder returns the order used during the last + * internal step + * CVodeGetCurrentOrder returns the order to be used on the next + * internal step + * CVodeGetNumStabLimOrderReds returns the number of order + * reductions due to stability limit detection + * CVodeGetActualInitStep returns the actual initial step size + * used by CVODES + * CVodeGetLastStep returns the step size for the last internal + * step + * CVodeGetCurrentStep returns the step size to be attempted on + * the next internal step + * CVodeGetCurrentTime returns the current internal time reached + * by the solver + * CVodeGetTolScaleFactor returns a suggested factor by which the + * user's tolerances should be scaled when too + * much accuracy has been requested for some + * internal step + * CVodeGetErrWeights returns the current error weight vector. + * The user must allocate space for eweight. + * CVodeGetEstLocalErrors returns the vector of estimated local + * errors. The user must allocate space for ele. + * CVodeGetNumGEvals returns the number of calls to the user's + * g function (for rootfinding) + * CVodeGetRootInfo returns the indices for which g_i was found to + * have a root. The user must allocate space for + * rootsfound. For i = 0 ... nrtfn-1, + * rootsfound[i] = 1 if g_i has a root, and = 0 if not. + * + * CVodeGet* return values: + * CV_SUCCESS if succesful + * CV_MEM_NULL if the cvode memory was NULL + * CV_NO_SLDET if stability limit was not turned on + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetWorkSpace(void *cvode_mem, long int *lenrw, long int *leniw); +SUNDIALS_EXPORT int CVodeGetNumSteps(void *cvode_mem, long int *nsteps); +SUNDIALS_EXPORT int CVodeGetNumRhsEvals(void *cvode_mem, long int *nfevals); +SUNDIALS_EXPORT int CVodeGetNumLinSolvSetups(void *cvode_mem, long int *nlinsetups); +SUNDIALS_EXPORT int CVodeGetNumErrTestFails(void *cvode_mem, long int *netfails); +SUNDIALS_EXPORT int CVodeGetLastOrder(void *cvode_mem, int *qlast); +SUNDIALS_EXPORT int CVodeGetCurrentOrder(void *cvode_mem, int *qcur); +SUNDIALS_EXPORT int CVodeGetNumStabLimOrderReds(void *cvode_mem, long int *nslred); +SUNDIALS_EXPORT int CVodeGetActualInitStep(void *cvode_mem, realtype *hinused); +SUNDIALS_EXPORT int CVodeGetLastStep(void *cvode_mem, realtype *hlast); +SUNDIALS_EXPORT int CVodeGetCurrentStep(void *cvode_mem, realtype *hcur); +SUNDIALS_EXPORT int CVodeGetCurrentTime(void *cvode_mem, realtype *tcur); +SUNDIALS_EXPORT int CVodeGetTolScaleFactor(void *cvode_mem, realtype *tolsfac); +SUNDIALS_EXPORT int CVodeGetErrWeights(void *cvode_mem, N_Vector eweight); +SUNDIALS_EXPORT int CVodeGetEstLocalErrors(void *cvode_mem, N_Vector ele); +SUNDIALS_EXPORT int CVodeGetNumGEvals(void *cvode_mem, long int *ngevals); +SUNDIALS_EXPORT int CVodeGetRootInfo(void *cvode_mem, int *rootsfound); + +/* + * ----------------------------------------------------------------- + * As a convenience, the following functions provides the + * optional outputs in one group. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetIntegratorStats(void *cvode_mem, long int *nsteps, + long int *nfevals, long int *nlinsetups, + long int *netfails, int *qlast, + int *qcur, realtype *hinused, realtype *hlast, + realtype *hcur, realtype *tcur); + +/* + * ----------------------------------------------------------------- + * Nonlinear solver optional output extraction functions + * ----------------------------------------------------------------- + * The following functions can be called to get optional outputs + * and statistics related to the nonlinear solver. + * ----------------------------------------------------------------- + * CVodeGetNumNonlinSolvIters returns the number of nonlinear + * solver iterations performed. + * CVodeGetNumNonlinSolvConvFails returns the number of nonlinear + * convergence failures. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetNumNonlinSolvIters(void *cvode_mem, long int *nniters); +SUNDIALS_EXPORT int CVodeGetNumNonlinSolvConvFails(void *cvode_mem, long int *nncfails); + +/* + * ----------------------------------------------------------------- + * As a convenience, the following function provides the + * nonlinear solver optional outputs in a group. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetNonlinSolvStats(void *cvode_mem, long int *nniters, + long int *nncfails); + + +/* + * ----------------------------------------------------------------- + * The following function returns the name of the constant + * associated with a CVODES return flag + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT char *CVodeGetReturnFlagName(int flag); + +/* + * ----------------------------------------------------------------- + * Quadrature integration optional output extraction routines + * ----------------------------------------------------------------- + * The following functions can be called to get optional outputs + * and statistics related to the integration of quadratures. + * ----------------------------------------------------------------- + * CVodeGetQuadNumRhsEvals returns the number of calls to the + * user function fQ defining the right hand + * side of the quadrature variables. + * CVodeGetQuadNumErrTestFails returns the number of local error + * test failures for quadrature variables. + * CVodeGetQuadErrWeights returns the vector of error weights for + * the quadrature variables. The user must + * allocate space for ewtQ. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetQuadNumRhsEvals(void *cvode_mem, long int *nfQevals); +SUNDIALS_EXPORT int CVodeGetQuadNumErrTestFails(void *cvode_mem, long int *nQetfails); +SUNDIALS_EXPORT int CVodeGetQuadErrWeights(void *cvode_mem, N_Vector eQweight); + +/* + * ----------------------------------------------------------------- + * As a convenience, the following function provides the above + * optional outputs in a group. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetQuadStats(void *cvode_mem, long int *nfQevals, + long int *nQetfails); + +/* + * ----------------------------------------------------------------- + * Forward sensitivity optional output extraction routines + * ----------------------------------------------------------------- + * The following functions can be called to get optional outputs + * and statistics related to the integration of sensitivities. + * ----------------------------------------------------------------- + * CVodeGetSensNumRhsEvals returns the number of calls to the + * sensitivity right hand side routine. + * CVodeGetNumRhsEvalsSens returns the number of calls to the + * user f routine due to finite difference evaluations of the + * sensitivity equations. + * CVodeGetSensNumErrTestFails returns the number of local error + * test failures for sensitivity variables. + * CVodeGetSensNumLinSolvSetups returns the number of calls made + * to the linear solver's setup routine due to sensitivity computations. + * CVodeGetSensErrWeights returns the sensitivity error weight + * vectors. The user need not allocate space for ewtS. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetSensNumRhsEvals(void *cvode_mem, long int *nfSevals); +SUNDIALS_EXPORT int CVodeGetNumRhsEvalsSens(void *cvode_mem, long int *nfevalsS); +SUNDIALS_EXPORT int CVodeGetSensNumErrTestFails(void *cvode_mem, long int *nSetfails); +SUNDIALS_EXPORT int CVodeGetSensNumLinSolvSetups(void *cvode_mem, long int *nlinsetupsS); +SUNDIALS_EXPORT int CVodeGetSensErrWeights(void *cvode_mem, N_Vector *eSweight); + +/* + * ----------------------------------------------------------------- + * As a convenience, the following function provides the + * optional outputs in a group. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetSensStats(void *cvode_mem, long int *nfSevals, long int *nfevalsS, + long int *nSetfails, long int *nlinsetupsS); + +/* + * ----------------------------------------------------------------- + * Sensitivity nonlinear solver optional output extraction + * ----------------------------------------------------------------- + * The following functions can be called to get optional outputs + * and statistics related to the sensitivity nonlinear solver. + * ----------------------------------------------------------------- + * CVodeGetSensNumNonlinSolvIters returns the total number of + * nonlinear iterations for sensitivity variables. + * CVodeGetSensNumNonlinSolvConvFails returns the total number + * of nonlinear convergence failures for sensitivity variables + * CVodeGetStgrSensNumNonlinSolvIters returns a vector of Ns + * nonlinear iteration counters for sensitivity variables in + * the CV_STAGGERED1 method. + * CVodeGetStgrSensNumNonlinSolvConvFails returns a vector of Ns + * nonlinear solver convergence failure counters for sensitivity + * variables in the CV_STAGGERED1 method. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetSensNumNonlinSolvIters(void *cvode_mem, long int *nSniters); +SUNDIALS_EXPORT int CVodeGetSensNumNonlinSolvConvFails(void *cvode_mem, long int *nSncfails); +SUNDIALS_EXPORT int CVodeGetStgrSensNumNonlinSolvIters(void *cvode_mem, long int *nSTGR1niters); +SUNDIALS_EXPORT int CVodeGetStgrSensNumNonlinSolvConvFails(void *cvode_mem, + long int *nSTGR1ncfails); + +/* + * ----------------------------------------------------------------- + * As a convenience, the following function provides the + * optional outputs in groups. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetSensNonlinSolvStats(void *cvode_mem, long int *nSniters, + long int *nSncfails); + + +/* + * ----------------------------------------------------------------- + * Quadrature sensitivity optional output extraction routines + * ----------------------------------------------------------------- + * The following functions can be called to get optional outputs and + * statistics related to the integration of quadrature sensitivitiess. + * ----------------------------------------------------------------- + * CVodeGetQuadSensNumRhsEvals returns the number of calls to the + * user function fQS defining the right hand side of the + * quadrature sensitivity equations. + * CVodeGetQuadSensNumErrTestFails returns the number of local error + * test failures for quadrature sensitivity variables. + * CVodeGetQuadSensErrWeights returns the vector of error weights + * for the quadrature sensitivity variables. The user must + * allocate space for ewtQS. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetQuadSensNumRhsEvals(void *cvode_mem, long int *nfQSevals); +SUNDIALS_EXPORT int CVodeGetQuadSensNumErrTestFails(void *cvode_mem, long int *nQSetfails); +SUNDIALS_EXPORT int CVodeGetQuadSensErrWeights(void *cvode_mem, N_Vector *eQSweight); + +/* + * ----------------------------------------------------------------- + * As a convenience, the following function provides the above + * optional outputs in a group. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetQuadSensStats(void *cvode_mem, + long int *nfQSevals, + long int *nQSetfails); + + +/* + * ================================================================= + * + * INITIALIZATION AND DEALLOCATION FUNCTIONS FOR BACKWARD PROBLEMS + * + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * CVodeAdjInit + * ----------------------------------------------------------------- + * CVodeAdjInit specifies some parameters for ASA, initializes ASA + * and allocates space for the adjoint memory structure. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeAdjInit(void *cvode_mem, long int steps, int interp); + +/* + * ----------------------------------------------------------------- + * CVodeAdjReInit + * ----------------------------------------------------------------- + * CVodeAdjReInit reinitializes the CVODES memory structure for ASA, + * assuming that the number of steps between check points and the + * type of interpolation remained unchanged. The list of check points + * (and associated memory) is deleted. The list of backward problems + * is kept (however, new backward problems can be added to this list + * by calling CVodeCreateB). The CVODES memory for the forward and + * backward problems can be reinitialized separately by calling + * CVodeReInit and CVodeReInitB, respectively. + * NOTE: if a entirely new list of backward problems is desired, + * then simply free the adjoint memory (by calling CVodeAdjFree) + * and reinitialize ASA with CVodeAdjInit. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeAdjReInit(void *cvode_mem); + +/* + * ----------------------------------------------------------------- + * CVodeAdjFree + * ----------------------------------------------------------------- + * CVodeAdjFree frees the memory allocated by CVodeAdjInit. + * It is typically called by CVodeFree. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void CVodeAdjFree(void *cvode_mem); + + +/* + * ----------------------------------------------------------------- + * Interfaces to CVODES functions for setting-up backward problems. + * ----------------------------------------------------------------- + * CVodeCreateB, + * + * CVodeInitB, CVodeInitBS, CVodeReInitB + * + * CVodeQuadInitB, CVodeQuadInitBS, CVodeQuadReInitB + * + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeCreateB(void *cvode_mem, int lmmB, int iterB, int *which); + +SUNDIALS_EXPORT int CVodeInitB(void *cvode_mem, int which, + CVRhsFnB fB, + realtype tB0, N_Vector yB0); +SUNDIALS_EXPORT int CVodeInitBS(void *cvode_mem, int which, + CVRhsFnBS fBs, + realtype tB0, N_Vector yB0); +SUNDIALS_EXPORT int CVodeReInitB(void *cvode_mem, int which, + realtype tB0, N_Vector yB0); + +SUNDIALS_EXPORT int CVodeSStolerancesB(void *cvode_mem, int which, + realtype reltolB, realtype abstolB); +SUNDIALS_EXPORT int CVodeSVtolerancesB(void *cvode_mem, int which, + realtype reltolB, N_Vector abstolB); + +SUNDIALS_EXPORT int CVodeQuadInitB(void *cvode_mem, int which, + CVQuadRhsFnB fQB, N_Vector yQB0); +SUNDIALS_EXPORT int CVodeQuadInitBS(void *cvode_mem, int which, + CVQuadRhsFnBS fQBs, N_Vector yQB0); +SUNDIALS_EXPORT int CVodeQuadReInitB(void *cvode_mem, int which, N_Vector yQB0); + +SUNDIALS_EXPORT int CVodeQuadSStolerancesB(void *cvode_mem, int which, + realtype reltolQB, realtype abstolQB); +SUNDIALS_EXPORT int CVodeQuadSVtolerancesB(void *cvode_mem, int which, + realtype reltolQB, N_Vector abstolQB); + +/* + * ================================================================= + * + * MAIN SOLVER FUNCTIONS FOR FORWARD PROBLEMS + * + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * CVodeF + * ----------------------------------------------------------------- + * CVodeF integrates towards tout and returns solution into yout. + * In the same time, it stores check point data every 'steps'. + * + * CVodeF can be called repeatedly by the user. + * + * ncheckPtr points to the number of check points stored so far. + * + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeF(void *cvode_mem, realtype tout, N_Vector yout, + realtype *tret, int itask, int *ncheckPtr); + + +/* + * ----------------------------------------------------------------- + * CVodeB + * ----------------------------------------------------------------- + * CVodeB performs the integration of all backward problems specified + * through calls to CVodeCreateB through a sequence of forward-backward + * runs in between consecutive check points. CVodeB can be called + * either in CV_NORMAL or CV_ONE_STEP mode. After a successful return + * from CVodeB, the solution and quadrature variables at the current + * return time for any given backward problem can be obtained by + * calling CVodeGetB and CVodeGetQuadB, respectively. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeB(void *cvode_mem, realtype tBout, int itaskB); + +/* + * ================================================================= + * + * OPTIONAL INPUT FUNCTIONS FOR BACKWARD PROBLEMS + * + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * CVodeSetAdjNoSensi + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeSetAdjNoSensi(void *cvode_mem); + +/* + * ----------------------------------------------------------------- + * Optional input functions for backward problems + * ----------------------------------------------------------------- + * These functions are just wrappers around the corresponding + * functions in cvodes.h, with some particularizations for the + * backward integration. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeSetIterTypeB(void *cvode_mem, int which, int iterB); +SUNDIALS_EXPORT int CVodeSetUserDataB(void *cvode_mem, int which, void *user_dataB); +SUNDIALS_EXPORT int CVodeSetMaxOrdB(void *cvode_mem, int which, int maxordB); +SUNDIALS_EXPORT int CVodeSetMaxNumStepsB(void *cvode_mem, int which, long int mxstepsB); +SUNDIALS_EXPORT int CVodeSetStabLimDetB(void *cvode_mem, int which, booleantype stldetB); +SUNDIALS_EXPORT int CVodeSetInitStepB(void *cvode_mem, int which, realtype hinB); +SUNDIALS_EXPORT int CVodeSetMinStepB(void *cvode_mem, int which, realtype hminB); +SUNDIALS_EXPORT int CVodeSetMaxStepB(void *cvode_mem, int which, realtype hmaxB); + +SUNDIALS_EXPORT int CVodeSetQuadErrConB(void *cvode_mem, int which, booleantype errconQB); + +/* + * ================================================================= + * + * EXTRACTION AND DENSE OUTPUT FUNCTIONS FOR BACKWARD PROBLEMS + * + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * CVodeGetB and CVodeGetQuadB + * ----------------------------------------------------------------- + * Extraction functions for the solution and quadratures for a given + * backward problem. They return their corresponding output vector + * at the current time reached by the integration of the backward + * problem. To obtain the solution or quadratures associated with + * a given backward problem at some other time within the last + * integration step (dense output), first obtain a pointer to the + * proper CVODES memory by calling CVodeGetAdjCVodeBmem and then use it + * to call CVodeGetDky and CVodeGetQuadDky. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetB(void *cvode_mem, int which, + realtype *tBret, N_Vector yB); +SUNDIALS_EXPORT int CVodeGetQuadB(void *cvode_mem, int which, + realtype *tBret, N_Vector qB); + + +/* + * ================================================================= + * + * OPTIONAL OUTPUT FUNCTIONS FOR BACKWARD PROBLEMS + * + * ================================================================= + */ + + +/* + * ----------------------------------------------------------------- + * CVodeGetAdjCVodeBmem + * ----------------------------------------------------------------- + * CVodeGetAdjCVodeBmem returns a (void *) pointer to the CVODES + * memory allocated for the backward problem. This pointer can + * then be used to call any of the CVodeGet* CVODES routines to + * extract optional output for the backward integration phase. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void *CVodeGetAdjCVodeBmem(void *cvode_mem, int which); + + +/* + * ----------------------------------------------------------------- + * CVodeGetAdjY + * Returns the interpolated forward solution at time t. This + * function is a wrapper around the interpType-dependent internal + * function. + * The calling function must allocate space for y. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetAdjY(void *cvode_mem, realtype t, N_Vector y); + +/* + * ----------------------------------------------------------------- + * CVodeGetAdjCheckPointsInfo + * Loads an array of nckpnts structures of type CVadjCheckPointRec. + * The user must allocate space for ckpnt (ncheck+1). + * ----------------------------------------------------------------- + */ + +typedef struct { + void *my_addr; + void *next_addr; + realtype t0; + realtype t1; + long int nstep; + int order; + realtype step; +} CVadjCheckPointRec; + +SUNDIALS_EXPORT int CVodeGetAdjCheckPointsInfo(void *cvode_mem, CVadjCheckPointRec *ckpnt); + +/* + * ----------------------------------------------------------------- + * CVodeGetAdjDataPointHermite + * Returns the 2 vectors stored for cubic Hermite interpolation + * at the data point 'which'. The user must allocate space for + * y and yd. Returns CV_MEM_NULL if cvode_mem is NULL. + * Returns CV_ILL_INPUT if interpType != CV_HERMITE. + * CVodeGetAdjDataPointPolynomial + * Returns the vector stored for polynomial interpolation + * at the data point 'which'. The user must allocate space for + * y. Returns CV_MEM_NULL if cvode_mem is NULL. + * Returns CV_ILL_INPUT if interpType != CV_POLYNOMIAL. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetAdjDataPointHermite(void *cvode_mem, long int which, + realtype *t, N_Vector y, N_Vector yd); + +SUNDIALS_EXPORT int CVodeGetAdjDataPointPolynomial(void *cvode_mem, long int which, + realtype *t, int *order, N_Vector y); + +/* + * ----------------------------------------------------------------- + * CVodeGetAdjCurrentCheckPoint + * Returns the address of the 'active' check point. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetAdjCurrentCheckPoint(void *cvode_mem, void **addr); + + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/cvodes/cvodes.h b/odemex/Parser/CVode/cv_src/include/cvodes/cvodes.h new file mode 100644 index 0000000..f368530 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/cvodes/cvodes.h @@ -0,0 +1,1968 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.22 $ + * $Date: 2008/04/16 21:53:06 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the interface file for the main CVODES integrator. + * ----------------------------------------------------------------- + * + * CVODES is used to solve numerically the ordinary initial value + * problem: + * + * y' = f(t,y), + * y(t0) = y0, + * + * where t0, y0 in R^N, and f: R x R^N -> R^N are given. + * + * Optionally, CVODES can perform forward or adjoint sensitivity + * analysis to find sensitivities of the solution y with respect + * to parameters in the right hand side f and/or in the initial + * conditions y0. + * + * ----------------------------------------------------------------- + * + * 1: CONSTANTS + * input constants + * return flags + * + * 2: FUNCTION TYPES + * CVRhsFn CVQuadRhsFn CVSensRhsFn CVSensRhs1Fn CVQuadSensRhsFn + * CVRootFn + * CVEwtFn + * CVErrHandlerFn + * CVRhsFnB CVRhsFnBS + * CVQuadRhsFnB CVQuadRhsFnBS + * + * 3: INITIALIZATION AND DEALLOCATION FUNCTIONS FOR FORWARD PROBLEMS + * CVodeCreate + * CVodeInit CVodeReInit + * CVodeQuadInit CVodeQuadReInit + * CVodeSensInit CVodeSensReInit + * CVodeRootInit + * CVodeFree CVodeQuadFree CVodeSensFree + * + * 4: OPTIONAL INPUT FUNCTIONS FOR FORWARD PROBLEMS + * + * 5: MAIN SOLVER FUNCTION FOR FORWARD PROBLEMS + * CVode + * + * 6: EXTRACTION AND DENSE OUTPUT FUNCTIONS FOR FORWARD PROBLEMS + * CVodeGetDky + * CVodeGetQuad + * CVodeGetQuadDky + * CVodeGetSens CVodeGetSens1 + * CVodeGetSensDky CVodeGetSensDky1 + * CVodeGetQuadSens CVodeGetQuadSens1 + * CVodeGetQuadSensDky CVodeGetQuadSensDky1 + * + * 7: OPTIONAL OUTPUT FUNCTIONS FOR FORWARD PROBLEMS + * + * 8: INITIALIZATION AND DEALLOCATION FUNCTIONS FOR BACKWARD PROBLEMS + * CVodeAdjInit CVodeAdjReInit + * CVodeAdjFree + * CVodeInitB CVodeInitBS CVodeReInitB + * CVodeQuadInitB CVodeQuadInitBS CVodeQuadReInitB + * + * 9 MAIN SOLVER FUNCTIONS FOR FORWARD PROBLEMS + * CVodeF + * CVodeB + * + * 10: OPTIONAL INPUT FUNCTIONS FOR BACKWARD PROBLEMS + * + * 11: EXTRACTION AND DENSE OUTPUT FUNCTIONS FOR BACKWARD PROBLEMS + * CVodeGetB + * CVodeGetQuadB + * + * 12: OPTIONAL OUTPUT FUNCTIONS FOR BACKWARD PROBLEMS + * + * ----------------------------------------------------------------- + */ + +#ifndef _CVODES_H +#define _CVODES_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +#include + +/* + * ================================================================= + * + * CVODES CONSTANTS + * + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Enumerations for inputs to: + * CVodeCreate (lmm, iter), + * CVodeSensInit, CvodeSensinit1, CVodeSensReInit (ism), + * CVodeAdjInit (interp), + * CVode (itask) + * ----------------------------------------------------------------- + * Symbolic constants for the lmm and iter parameters to CVodeCreate + * the input parameter itask to CVode, and the input parameter interp + * to CVodeAdjInit, are given below. + * + * lmm: The user of the CVODES package specifies whether to use + * the CV_ADAMS or CV_BDF (backward differentiation formula) + * linear multistep method. The BDF method is recommended + * for stiff problems, and the CV_ADAMS method is recommended + * for nonstiff problems. + * + * iter: At each internal time step, a nonlinear equation must + * be solved. The user can specify either CV_FUNCTIONAL + * iteration, which does not require linear algebra, or a + * CV_NEWTON iteration, which requires the solution of linear + * systems. In the CV_NEWTON case, the user also specifies a + * CVODE linear solver. CV_NEWTON is recommended in case of + * stiff problems. + * + * ism: This parameter specifies the sensitivity corrector type + * to be used. In the CV_SIMULTANEOUS case, the nonlinear + * systems for states and all sensitivities are solved + * simultaneously. In the CV_STAGGERED case, the nonlinear + * system for states is solved first and then, the + * nonlinear systems for all sensitivities are solved + * at the same time. Finally, in the CV_STAGGERED1 approach + * all nonlinear systems are solved in a sequence. + * + * itask: The itask input parameter to CVode indicates the job + * of the solver for the next user step. The CV_NORMAL + * itask is to have the solver take internal steps until + * it has reached or just passed the user specified tout + * parameter. The solver then interpolates in order to + * return an approximate value of y(tout). The CV_ONE_STEP + * option tells the solver to just take one internal step + * and return the solution at the point reached by that step. + * + * interp: Specifies the interpolation type used to evaluate the + * forward solution during the backward integration phase. + * CV_HERMITE specifies cubic Hermite interpolation. + * CV_POYNOMIAL specifies the polynomial interpolation + * ----------------------------------------------------------------- + */ + +/* lmm */ +#define CV_ADAMS 1 +#define CV_BDF 2 + +/* iter */ +#define CV_FUNCTIONAL 1 +#define CV_NEWTON 2 + +/* itask */ +#define CV_NORMAL 1 +#define CV_ONE_STEP 2 + +/* ism */ +#define CV_SIMULTANEOUS 1 +#define CV_STAGGERED 2 +#define CV_STAGGERED1 3 + +/* DQtype */ +#define CV_CENTERED 1 +#define CV_FORWARD 2 + +/* interp */ +#define CV_HERMITE 1 +#define CV_POLYNOMIAL 2 + +/* + * ---------------------------------------- + * CVODES return flags + * ---------------------------------------- + */ + +#define CV_SUCCESS 0 +#define CV_TSTOP_RETURN 1 +#define CV_ROOT_RETURN 2 + +#define CV_WARNING 99 + +#define CV_TOO_MUCH_WORK -1 +#define CV_TOO_MUCH_ACC -2 +#define CV_ERR_FAILURE -3 +#define CV_CONV_FAILURE -4 + +#define CV_LINIT_FAIL -5 +#define CV_LSETUP_FAIL -6 +#define CV_LSOLVE_FAIL -7 +#define CV_RHSFUNC_FAIL -8 +#define CV_FIRST_RHSFUNC_ERR -9 +#define CV_REPTD_RHSFUNC_ERR -10 +#define CV_UNREC_RHSFUNC_ERR -11 +#define CV_RTFUNC_FAIL -12 + +#define CV_MEM_FAIL -20 +#define CV_MEM_NULL -21 +#define CV_ILL_INPUT -22 +#define CV_NO_MALLOC -23 +#define CV_BAD_K -24 +#define CV_BAD_T -25 +#define CV_BAD_DKY -26 +#define CV_TOO_CLOSE -27 + +#define CV_NO_QUAD -30 +#define CV_QRHSFUNC_FAIL -31 +#define CV_FIRST_QRHSFUNC_ERR -32 +#define CV_REPTD_QRHSFUNC_ERR -33 +#define CV_UNREC_QRHSFUNC_ERR -34 + +#define CV_NO_SENS -40 +#define CV_SRHSFUNC_FAIL -41 +#define CV_FIRST_SRHSFUNC_ERR -42 +#define CV_REPTD_SRHSFUNC_ERR -43 +#define CV_UNREC_SRHSFUNC_ERR -44 + +#define CV_BAD_IS -45 + +#define CV_NO_QUADSENS -50 +#define CV_QSRHSFUNC_FAIL -51 +#define CV_FIRST_QSRHSFUNC_ERR -52 +#define CV_REPTD_QSRHSFUNC_ERR -53 +#define CV_UNREC_QSRHSFUNC_ERR -54 + +/* + * ---------------------------------------- + * CVODEA return flags + * ---------------------------------------- + */ + +#define CV_NO_ADJ -101 +#define CV_NO_FWD -102 +#define CV_NO_BCK -103 +#define CV_BAD_TB0 -104 +#define CV_REIFWD_FAIL -105 +#define CV_FWD_FAIL -106 +#define CV_GETY_BADT -107 + +/* + * ================================================================= + * + * FUNCTION TYPES + * + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Type : CVRhsFn + * ----------------------------------------------------------------- + * The f function which defines the right hand side of the ODE + * system y' = f(t,y) must have type CVRhsFn. + * f takes as input the independent variable value t, and the + * dependent variable vector y. It stores the result of f(t,y) + * in the vector ydot. The y and ydot arguments are of type + * N_Vector. + * (Allocation of memory for ydot is handled within CVODES) + * The user_data parameter is the same as the user_data + * parameter set by the user through the CVodeSetUserData routine. + * This user-supplied pointer is passed to the user's f function + * every time it is called. + * + * A CVRhsFn should return 0 if successful, a negative value if + * an unrecoverable error occured, and a positive value if a + * recoverable error (e.g. invalid y values) occured. + * If an unrecoverable occured, the integration is halted. + * If a recoverable error occured, then (in most cases) CVODES + * will try to correct and retry. + * ----------------------------------------------------------------- + */ + +typedef int (*CVRhsFn)(realtype t, N_Vector y, + N_Vector ydot, void *user_data); + +/* + * ----------------------------------------------------------------- + * Type : CVRootFn + * ----------------------------------------------------------------- + * A function g, which defines a set of functions g_i(t,y) whose + * roots are sought during the integration, must have type CVRootFn. + * The function g takes as input the independent variable value + * t, and the dependent variable vector y. It stores the nrtfn + * values g_i(t,y) in the realtype array gout. + * (Allocation of memory for gout is handled within CVODE.) + * The user_data parameter is the same as that passed by the user + * to the CVodeSetUserData routine. This user-supplied pointer is + * passed to the user's g function every time it is called. + * + * A CVRootFn should return 0 if successful or a non-zero value + * if an error occured (in which case the integration will be halted). + * ----------------------------------------------------------------- + */ + +typedef int (*CVRootFn)(realtype t, N_Vector y, realtype *gout, void *user_data); + +/* + * ----------------------------------------------------------------- + * Type : CVEwtFn + * ----------------------------------------------------------------- + * A function e, which sets the error weight vector ewt, must have + * type CVEwtFn. + * The function e takes as input the current dependent variable y. + * It must set the vector of error weights used in the WRMS norm: + * + * ||y||_WRMS = sqrt [ 1/N * sum ( ewt_i * y_i)^2 ] + * + * Typically, the vector ewt has components: + * + * ewt_i = 1 / (reltol * |y_i| + abstol_i) + * + * The user_data parameter is the same as that passed by the user + * to the CVodeSetUserData routine. This user-supplied pointer is + * passed to the user's e function every time it is called. + * A CVEwtFn e must return 0 if the error weight vector has been + * successfuly set and a non-zero value otherwise. + * ----------------------------------------------------------------- + */ + +typedef int (*CVEwtFn)(N_Vector y, N_Vector ewt, void *user_data); + + +/* + * ----------------------------------------------------------------- + * Type : CVErrHandlerFn + * ----------------------------------------------------------------- + * A function eh, which handles error messages, must have type + * CVErrHandlerFn. + * The function eh takes as input the error code, the name of the + * module reporting the error, the error message, and a pointer to + * user data, the same as that passed to CVodeSetUserData. + * + * All error codes are negative, except CV_WARNING which indicates + * a warning (the solver continues). + * + * A CVErrHandlerFn has no return value. + * ----------------------------------------------------------------- + */ + +typedef void (*CVErrHandlerFn)(int error_code, + const char *module, const char *function, + char *msg, void *user_data); + +/* + * ----------------------------------------------------------------- + * Type : CVQuadRhsFn + * ----------------------------------------------------------------- + * The fQ function which defines the right hand side of the + * quadrature equations yQ' = fQ(t,y) must have type CVQuadRhsFn. + * fQ takes as input the value of the independent variable t, + * the vector of states y and must store the result of fQ in + * yQdot. (Allocation of memory for yQdot is handled by CVODES). + * The user_data parameter is the same as the user_data parameter + * set by the user through the CVodeSetUserData routine and is + * passed to the fQ function every time it is called. + * + * If the quadrature RHS also depends on the sensitivity variables, + * i.e., yQ' = fQs(t,y,yS), then fQ must be of type CVodeQuadRhsFnS. + * + * A CVQuadRhsFn or CVodeQuadRhsFnS should return 0 if successful, + * a negative value if an unrecoverable error occured, and a positive + * value if a recoverable error (e.g. invalid y values) occured. + * If an unrecoverable occured, the integration is halted. + * If a recoverable error occured, then (in most cases) CVODES + * will try to correct and retry. + * ----------------------------------------------------------------- + */ + +typedef int (*CVQuadRhsFn)(realtype t, N_Vector y, + N_Vector yQdot, + void *user_data); + +/* + * ----------------------------------------------------------------- + * Type : CVSensRhsFn + * ----------------------------------------------------------------- + * The fS function which defines the right hand side of the + * sensitivity ODE systems s' = f_y * s + f_p must have type + * CVSensRhsFn. + * fS takes as input the number of sensitivities Ns, the + * independent variable value t, the states y and the + * corresponding value of f(t,y) in ydot, and the dependent + * sensitivity vectors yS. It stores the result of fS in ySdot. + * (Allocation of memory for ySdot is handled within CVODES) + * The user_data parameter is the same as the user_data parameter + * set by the user through the CVodeSetUserData routine and is + * passed to the fS function every time it is called. + * + * A CVSensRhsFn should return 0 if successful, a negative value if + * an unrecoverable error occured, and a positive value if a + * recoverable error (e.g. invalid y or yS values) occured. + * If an unrecoverable occured, the integration is halted. + * If a recoverable error occured, then (in most cases) CVODES + * will try to correct and retry. + * ----------------------------------------------------------------- + */ + +typedef int (*CVSensRhsFn)(int Ns, realtype t, + N_Vector y, N_Vector ydot, + N_Vector *yS, N_Vector *ySdot, + void *user_data, + N_Vector tmp1, N_Vector tmp2); + +/* + * ----------------------------------------------------------------- + * Type : CVSensRhs1Fn + * ----------------------------------------------------------------- + * The fS1 function which defines the right hand side of the i-th + * sensitivity ODE system s_i' = f_y * s_i + f_p must have type + * CVSensRhs1Fn. + * fS1 takes as input the number of sensitivities Ns, the current + * sensitivity iS, the independent variable value t, the states y + * and the corresponding value of f(t,y) in ydot, and the + * dependent sensitivity vector yS. It stores the result of fS in + * ySdot. + * (Allocation of memory for ySdot is handled within CVODES) + * The user_data parameter is the same as the user_data parameter + * set by the user through the CVodeSetUserData routine and is + * passed to the fS1 function every time it is called. + * + * A CVSensRhs1Fn should return 0 if successful, a negative value if + * an unrecoverable error occured, and a positive value if a + * recoverable error (e.g. invalid y or yS values) occured. + * If an unrecoverable occured, the integration is halted. + * If a recoverable error occured, then (in most cases) CVODES + * will try to correct and retry. + * ----------------------------------------------------------------- + */ + +typedef int (*CVSensRhs1Fn)(int Ns, realtype t, + N_Vector y, N_Vector ydot, + int iS, N_Vector yS, N_Vector ySdot, + void *user_data, + N_Vector tmp1, N_Vector tmp2); + +/* + * ----------------------------------------------------------------- + * Type : CVQuadSensRhsFn + * ----------------------------------------------------------------- + * The fQS function which defines the right hand side of the + * sensitivity ODE systems for quadratures, yQS' = fQ_y * yS + fQ_p + * must have type CVQuadSensRhsFn. + * + * fQS takes as input the number of sensitivities Ns (the same as + * that passed to CVodeQuadSensInit), the independent variable + * value t, the states y and the dependent sensitivity vectors yS, + * as well as the current value of the quadrature RHS yQdot. + * It stores the result of fQS in yQSdot. + * (Allocation of memory for yQSdot is handled within CVODES) + * + * A CVQuadSensRhsFn should return 0 if successful, a negative + * value if an unrecoverable error occured, and a positive value + * if a recoverable error (e.g. invalid y or yS values) occured. + * If an unrecoverable occured, the integration is halted. + * If a recoverable error occured, then (in most cases) CVODES + * will try to correct and retry. + * ----------------------------------------------------------------- + */ + +typedef int (*CVQuadSensRhsFn)(int Ns, realtype t, + N_Vector y, N_Vector *yS, + N_Vector yQdot, N_Vector *yQSdot, + void *user_data, + N_Vector tmp, N_Vector tmpQ); + +/* + * ----------------------------------------------------------------- + * CVRhsFnB and CVRhsFnBS + * The fB function which defines the right hand side of the + * ODE systems to be integrated backwards must have type CVRhsFnB. + * If the backward problem depends on forward sensitivities, its + * RHS function must have type CVRhsFnBS. + * ----------------------------------------------------------------- + * CVQuadRhsFnB and CVQuadRhsFnBS + * The fQB function which defines the quadratures to be integrated + * backwards must have type CVQuadRhsFnB. + * If the backward problem depends on forward sensitivities, its + * quadrature RHS function must have type CVQuadRhsFnBS. + * ----------------------------------------------------------------- + */ + +typedef int (*CVRhsFnB)(realtype t, N_Vector y, + N_Vector yB, N_Vector yBdot, + void *user_dataB); + +typedef int (*CVRhsFnBS)(realtype t, N_Vector y, N_Vector *yS, + N_Vector yB, N_Vector yBdot, + void *user_dataB); + + +typedef int (*CVQuadRhsFnB)(realtype t, N_Vector y, + N_Vector yB, N_Vector qBdot, + void *user_dataB); + +typedef int (*CVQuadRhsFnBS)(realtype t, N_Vector y, N_Vector *yS, + N_Vector yB, N_Vector qBdot, + void *user_dataB); + + +/* + * ================================================================= + * + * INITIALIZATION AND DEALLOCATION FUNCTIONS FOR FORWARD PROBLEMS + * + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Function : CVodeCreate + * ----------------------------------------------------------------- + * CVodeCreate creates an internal memory block for a problem to + * be solved by CVODES. + * + * lmm is the type of linear multistep method to be used. + * The legal values are CV_ADAMS and CV_BDF (see previous + * description). + * + * iter is the type of iteration used to solve the nonlinear + * system that arises during each internal time step. + * The legal values are CV_FUNCTIONAL and CV_NEWTON. + * + * If successful, CVodeCreate returns a pointer to initialized + * problem memory. This pointer should be passed to CVodeInit. + * If an initialization error occurs, CVodeCreate prints an error + * message to standard err and returns NULL. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void *CVodeCreate(int lmm, int iter); + +/* + * ----------------------------------------------------------------- + * Functions : CVodeInit and CVodeReInit + * ----------------------------------------------------------------- + * CVodeInit allocates and initializes memory for a problem to + * to be solved by CVODE. + * + * CVodeReInit re-initializes CVode for the solution of a problem, + * where a prior call to CVodeInit has been made with the same + * problem size N. CVodeReInit performs the same input checking + * and initializations that CVodeInit does. + * But it does no memory allocation, assuming that the existing + * internal memory is sufficient for the new problem. + * + * The use of CVodeReInit requires that the maximum method order, + * maxord, is no larger for the new problem than for the problem + * specified in the last call to CVodeInit. This condition is + * automatically fulfilled if the multistep method parameter lmm + * is unchanged (or changed from CV_ADAMS to CV_BDF) and the default + * value for maxord is specified. + * + * cvode_mem is pointer to CVODE memory returned by CVodeCreate. + * + * f is the name of the C function defining the right-hand + * side function in y' = f(t,y). + * + * t0 is the initial value of t. + * + * y0 is the initial condition vector y(t0). + * + * Return flag: + * CV_SUCCESS if successful + * CV_MEM_NULL if the cvode memory was NULL + * CV_MEM_FAIL if a memory allocation failed + * CV_NO_MALLOC if cvode_mem has not been allocated + * (i.e., CVodeInit has not been called). + * CV_ILL_INPUT if an argument has an illegal value. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeInit(void *cvode_mem, CVRhsFn f, realtype t0, N_Vector y0); +SUNDIALS_EXPORT int CVodeReInit(void *cvode_mem, realtype t0, N_Vector y0); + +/* + * ----------------------------------------------------------------- + * Functions : CVodeSStolerances + * CVodeSVtolerances + * CVodeWFtolerances + * ----------------------------------------------------------------- + * + * These functions specify the integration tolerances. One of them + * MUST be called before the first call to CVode. + * + * CVodeSStolerances specifies scalar relative and absolute tolerances. + * CVodeSVtolerances specifies scalar relative tolerance and a vector + * absolute tolerance (a potentially different absolute tolerance + * for each vector component). + * CVodeWFtolerances specifies a user-provides function (of type CVEwtFn) + * which will be called to set the error weight vector. + * + * The tolerances reltol and abstol define a vector of error weights, + * ewt, with components + * ewt[i] = 1/(reltol*abs(y[i]) + abstol) (in the SS case), or + * ewt[i] = 1/(reltol*abs(y[i]) + abstol[i]) (in the SV case). + * This vector is used in all error and convergence tests, which + * use a weighted RMS norm on all error-like vectors v: + * WRMSnorm(v) = sqrt( (1/N) sum(i=1..N) (v[i]*ewt[i])^2 ), + * where N is the problem dimension. + * + * The return value of these functions is equal to CV_SUCCESS = 0 if + * there were no errors; otherwise it is a negative int equal to: + * CV_MEM_NULL indicating cvode_mem was NULL (i.e., + * CVodeCreate has not been called). + * CV_NO_MALLOC indicating that cvode_mem has not been + * allocated (i.e., CVodeInit has not been + * called). + * CV_ILL_INPUT indicating an input argument was illegal + * (e.g. a negative tolerance) + * In case of an error return, an error message is also printed. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeSStolerances(void *cvode_mem, realtype reltol, realtype abstol); +SUNDIALS_EXPORT int CVodeSVtolerances(void *cvode_mem, realtype reltol, N_Vector abstol); +SUNDIALS_EXPORT int CVodeWFtolerances(void *cvode_mem, CVEwtFn efun); + +/* + * ----------------------------------------------------------------- + * Function : CVodeQuadInit and CVodeQuadReInit + * ----------------------------------------------------------------- + * CVodeQuadInit allocates and initializes memory related to + * quadrature integration. + * + * CVodeQuadReInit re-initializes CVODES's quadrature related + * memory for a problem, assuming it has already been allocated + * in prior calls to CVodeInit and CVodeQuadInit. + * The number of quadratures Nq is assumed to be unchanged + * since the previous call to CVodeQuadInit. + * + * cvode_mem is a pointer to CVODES memory returned by CVodeCreate + * + * fQ is the user-provided integrand routine. + * + * yQ0 is an N_Vector with initial values for quadratures + * (typically yQ0 has all zero components). + * + * Return values: + * CV_SUCCESS if successful + * CV_MEM_NULL if the cvode memory was NULL + * CV_MEM_FAIL if a memory allocation failed + * CV_NO_QUAD if quadratures were not initialized + * (i.e. CVodeQuadInit has not been called) + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeQuadInit(void *cvode_mem, CVQuadRhsFn fQ, N_Vector yQ0); +SUNDIALS_EXPORT int CVodeQuadReInit(void *cvode_mem, N_Vector yQ0); + +/* + * ----------------------------------------------------------------- + * Functions : CVodeQuadSStolerances + * CVodeQuadSVtolerances + * ----------------------------------------------------------------- + * + * These functions specify the integration tolerances for quadrature + * variables. One of them MUST be called before the first call to + * CVode IF error control on the quadrature variables is enabled + * (see CVodeSetQuadErrCon). + * + * CVodeSStolerances specifies scalar relative and absolute tolerances. + * CVodeSVtolerances specifies scalar relative tolerance and a vector + * absolute tolerance (a potentially different absolute tolerance + * for each vector component). + * + * Return values: + * CV_SUCCESS if successful + * CV_MEM_NULL if the cvode memory was NULL + * CV_NO_QUAD if quadratures were not initialized + * CV_ILL_INPUT if an input argument was illegal + * (e.g. a negative tolerance) + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeQuadSStolerances(void *cvode_mem, realtype reltolQ, realtype abstolQ); +SUNDIALS_EXPORT int CVodeQuadSVtolerances(void *cvode_mem, realtype reltolQ, N_Vector abstolQ); + +/* + * ----------------------------------------------------------------- + * Function : CVodeSensInit, CVSensInit1, and CVodeSensReInit + * ----------------------------------------------------------------- + * CVodeSensInit and CVSensInit1 allocate and initialize memory + * related to sensitivity computations. They only differ in the + * type of the sensitivity RHS function: CVodeSensInit specifies + * fS of type CVSensRhsFn (i.e. a function that evaluates all + * sensitivity RHS simultaneously), while CVodeSensInit1 specifies + * fS of type CVSensRhs1Fn (i.e. a function that evaluates one + * sensitivity RHS at a time). Recall that ism=CV_STAGGERED1 is + * compatible ONLY with a CVSensRhs1Fn. As such, this value for + * ism cannot be passed to CVodeSensInit. + * + * CVodeSensReInit re-initializes CVODES's sensitivity related + * memory for a problem, assuming it has already been allocated + * in prior calls to CVodeInit and CVodeSensInit. + * The number of sensitivities Ns is assumed to be unchanged + * since the previous call to CVodeSensInit. + * If any error occurs during initialization, it is reported to + * the file whose file pointer is errfp. + * CVodeSensReInit potentially does some minimal memory allocation + * (for the sensitivity absolute tolerance and for arrays of + * counters used by the CV_STAGGERED1 method). + + * cvode_mem is pointer to CVODES memory returned by CVodeCreate + * + * Ns is the number of sensitivities to be computed. + * + * ism is the type of corrector used in sensitivity + * analysis. The legal values are: CV_SIMULTANEOUS, + * CV_STAGGERED, and CV_STAGGERED1. + * + * fS is the sensitivity righ-hand side function + * (pass NULL to use the internal DQ approximation) + * + * yS0 is the array of initial condition vectors for + * sensitivity variables. + * + * Return values: + * CV_SUCCESS + * CV_MEM_NULL + * CV_ILL_INPUT + * CV_MEM_FAIL + * CV_NO_SENS + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeSensInit(void *cvode_mem, int Ns, int ism, + CVSensRhsFn fS, N_Vector *yS0); +SUNDIALS_EXPORT int CVodeSensInit1(void *cvode_mem, int Ns, int ism, + CVSensRhs1Fn fS1, N_Vector *yS0); +SUNDIALS_EXPORT int CVodeSensReInit(void *cvode_mem, int ism, N_Vector *yS0); + +/* + * ----------------------------------------------------------------- + * Functions : CVodeSensSStolerances + * CVodeSensSVtolerances + * CVodeSensEEtolerances + * ----------------------------------------------------------------- + * + * These functions specify the integration tolerances for sensitivity + * variables. One of them MUST be called before the first call to CVode. + * + * CVodeSensSStolerances specifies scalar relative and absolute tolerances. + * CVodeSensSVtolerances specifies scalar relative tolerance and a vector + * absolute tolerance for each sensitivity vector (a potentially different + * absolute tolerance for each vector component). + * CVodeSensEEtolerances specifies that tolerances for sensitivity variables + * should be estimated from those provided for the state variables. + * + * The return value is equal to CV_SUCCESS = 0 if there were no + * errors; otherwise it is a negative int equal to: + * CV_MEM_NULL indicating cvode_mem was NULL, or + * CV_NO_SENS indicating there was not a prior call to + * CVodeSensInit. + * CV_ILL_INPUT indicating an input argument was illegal + * (e.g. negative tolerances) + * In case of an error return, an error message is also printed. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeSensSStolerances(void *cvode_mem, realtype reltolS, realtype *abstolS); +SUNDIALS_EXPORT int CVodeSensSVtolerances(void *cvode_mem, realtype reltolS, N_Vector *abstolS); +SUNDIALS_EXPORT int CVodeSensEEtolerances(void *cvode_mem); + +/* + * ----------------------------------------------------------------- + * Function : CVodeQuadSensInit and CVodeQuadSensReInit + * ----------------------------------------------------------------- + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeQuadSensInit(void *cvode_mem, CVQuadSensRhsFn fQS, N_Vector *yQS0); +SUNDIALS_EXPORT int CVodeQuadSensReInit(void *cvode_mem, N_Vector *yQS0); + +/* + * ----------------------------------------------------------------- + * Functions : CVodeQuadSensSStolerances + * CVodeQuadSensSVtolerances + * CVodeQuadSensEEtolerances + * ----------------------------------------------------------------- + * + * These functions specify the integration tolerances for quadrature + * sensitivity variables. One of them MUST be called before the first + * call to CVode IF these variables are included in the error test. + * + * CVodeQuadSensSStolerances specifies scalar relative and absolute tolerances. + * CVodeQuadSensSVtolerances specifies scalar relative tolerance and a vector + * absolute tolerance for each quadrature sensitivity vector (a potentially + * different absolute tolerance for each vector component). + * CVodeQuadSensEEtolerances specifies that tolerances for sensitivity variables + * should be estimated from those provided for the quadrature variables. + * In this case, tolerances for the quadrature variables must be + * specified through a call to one of CVodeQuad**tolerances. + * + * The return value is equal to CV_SUCCESS = 0 if there were no + * errors; otherwise it is a negative int equal to: + * CV_MEM_NULL if cvode_mem was NULL, or + * CV_NO_QuadSENS if there was not a prior call to + * CVodeQuadSensInit. + * CV_ILL_INPUT if an input argument was illegal + * (e.g. negative tolerances) + * In case of an error return, an error message is also printed. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeQuadSensSStolerances(void *cvode_mem, realtype reltolQS, realtype *abstolQS); +SUNDIALS_EXPORT int CVodeQuadSensSVtolerances(void *cvode_mem, realtype reltolQS, N_Vector *abstolQS); +SUNDIALS_EXPORT int CVodeQuadSensEEtolerances(void *cvode_mem); + +/* + * ----------------------------------------------------------------- + * Function : CVodeRootInit + * ----------------------------------------------------------------- + * CVodeRootInit initializes a rootfinding problem to be solved + * during the integration of the ODE system. It must be called + * after CVodeCreate, and before CVode. The arguments are: + * + * cvode_mem = pointer to CVODE memory returned by CVodeCreate. + * + * nrtfn = number of functions g_i, an int >= 0. + * + * g = name of user-supplied function, of type CVRootFn, + * defining the functions g_i whose roots are sought. + * + * If a new problem is to be solved with a call to CVodeReInit, + * where the new problem has no root functions but the prior one + * did, then call CVodeRootInit with nrtfn = 0. + * + * The return value of CVodeRootInit is CV_SUCCESS = 0 if there were + * no errors; otherwise it is a negative int equal to: + * CV_MEM_NULL indicating cvode_mem was NULL, or + * CV_MEM_FAIL indicating a memory allocation failed. + * (including an attempt to increase maxord). + * CV_ILL_INPUT indicating nrtfn > 0 but g = NULL. + * In case of an error return, an error message is also printed. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeRootInit(void *cvode_mem, int nrtfn, CVRootFn g); + +/* + * ----------------------------------------------------------------- + * Function : CVodeFree + * ----------------------------------------------------------------- + * CVodeFree frees the problem memory cvode_mem allocated by + * CVodeInit. Its only argument is the pointer cvode_mem + * returned by CVodeCreate. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void CVodeFree(void **cvode_mem); + +/* + * ----------------------------------------------------------------- + * Function : CVodeQuadFree + * ----------------------------------------------------------------- + * CVodeQuadFree frees the problem memory in cvode_mem allocated + * for quadrature integration. Its only argument is the pointer + * cvode_mem returned by CVodeCreate. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void CVodeQuadFree(void *cvode_mem); + +/* + * ----------------------------------------------------------------- + * Function : CVodeSensFree + * ----------------------------------------------------------------- + * CVodeSensFree frees the problem memory in cvode_mem allocated + * for sensitivity analysis. Its only argument is the pointer + * cvode_mem returned by CVodeCreate. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void CVodeSensFree(void *cvode_mem); + +/* + * ----------------------------------------------------------------- + * Function : CVodeQuadSensFree + * ----------------------------------------------------------------- + * CVodeQuadSensFree frees the problem memory in cvode_mem allocated + * for quadrature sensitivity analysis. Its only argument is the + * pointer cvode_mem returned by CVodeCreate. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void CVodeQuadSensFree(void *cvode_mem); + +/* + * ================================================================= + * + * OPTIONAL INPUT FUNCTIONS FOR FORWARD PROBLEMS + * + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Integrator optional input specification functions + * ----------------------------------------------------------------- + * The following functions can be called to set optional inputs + * to values other than the defaults given below: + * + * Function | Optional input / [ default value ] + * ----------------------------------------------------------------- + * | + * CVodeSetErrHandlerFn | user-provided ErrHandler function. + * | [internal] + * | + * CVodeSetErrFile | the file pointer for an error file + * | where all CVODE warning and error + * | messages will be written if the default + * | internal error handling function is used. + * | This parameter can be stdout (standard + * | output), stderr (standard error), or a + * | file pointer (corresponding to a user + * | error file opened for writing) returned + * | by fopen. + * | If not called, then all messages will + * | be written to the standard error stream. + * | [stderr] + * | + * CVodeSetUserData | a pointer to user data that will be + * | passed to the user's f function every + * | time f is called. + * | [NULL] + * | + * CVodeSetMaxOrd | maximum lmm order to be used by the + * | solver. + * | [12 for Adams , 5 for BDF] + * | + * CVodeSetMaxNumSteps | maximum number of internal steps to be + * | taken by the solver in its attempt to + * | reach tout. + * | [500] + * | + * CVodeSetMaxHnilWarns | maximum number of warning messages + * | issued by the solver that t+h==t on the + * | next internal step. A value of -1 means + * | no such messages are issued. + * | [10] + * | + * CVodeSetStabLimDet | flag to turn on/off stability limit + * | detection (TRUE = on, FALSE = off). + * | When BDF is used and order is 3 or + * | greater, CVsldet is called to detect + * | stability limit. If limit is detected, + * | the order is reduced. + * | [FALSE] + * | + * CVodeSetInitStep | initial step size. + * | [estimated by CVODES] + * | + * CVodeSetMinStep | minimum absolute value of step size + * | allowed. + * | [0.0] + * | + * CVodeSetMaxStep | maximum absolute value of step size + * | allowed. + * | [infinity] + * | + * CVodeSetStopTime | the independent variable value past + * | which the solution is not to proceed. + * | [infinity] + * | + * CVodeSetMaxErrTestFails | Maximum number of error test failures + * | in attempting one step. + * | [7] + * | + * CVodeSetMaxNonlinIters | Maximum number of nonlinear solver + * | iterations at one solution. + * | [3] + * | + * CVodeSetMaxConvFails | Maximum number of allowable conv. + * | failures in attempting one step. + * | [10] + * | + * CVodeSetNonlinConvCoef | Coeficient in the nonlinear conv. + * | test. + * | [0.1] + * | + * ----------------------------------------------------------------- + * | + * CVodeSetIterType | Changes the current nonlinear iteration + * | type. + * | [set by CVodecreate] + * | + * ----------------------------------------------------------------- + * | + * CVodeSetRootDirection | Specifies the direction of zero + * | crossings to be monitored + * | [both directions] + * | + * CVodeSetNoInactiveRootWarn | disable warning about possible + * | g==0 at beginning of integration + * | + * ----------------------------------------------------------------- + * Return flag: + * CV_SUCCESS if successful + * CV_MEM_NULL if the cvode memory is NULL + * CV_ILL_INPUT if an argument has an illegal value + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeSetErrHandlerFn(void *cvode_mem, CVErrHandlerFn ehfun, void *eh_data); +SUNDIALS_EXPORT int CVodeSetErrFile(void *cvode_mem, FILE *errfp); +SUNDIALS_EXPORT int CVodeSetUserData(void *cvode_mem, void *user_data); +SUNDIALS_EXPORT int CVodeSetMaxOrd(void *cvode_mem, int maxord); +SUNDIALS_EXPORT int CVodeSetMaxNumSteps(void *cvode_mem, long int mxsteps); +SUNDIALS_EXPORT int CVodeSetMaxHnilWarns(void *cvode_mem, int mxhnil); +SUNDIALS_EXPORT int CVodeSetStabLimDet(void *cvode_mem, booleantype stldet); +SUNDIALS_EXPORT int CVodeSetInitStep(void *cvode_mem, realtype hin); +SUNDIALS_EXPORT int CVodeSetMinStep(void *cvode_mem, realtype hmin); +SUNDIALS_EXPORT int CVodeSetMaxStep(void *cvode_mem, realtype hmax); +SUNDIALS_EXPORT int CVodeSetStopTime(void *cvode_mem, realtype tstop); +SUNDIALS_EXPORT int CVodeSetMaxErrTestFails(void *cvode_mem, int maxnef); +SUNDIALS_EXPORT int CVodeSetMaxNonlinIters(void *cvode_mem, int maxcor); +SUNDIALS_EXPORT int CVodeSetMaxConvFails(void *cvode_mem, int maxncf); +SUNDIALS_EXPORT int CVodeSetNonlinConvCoef(void *cvode_mem, realtype nlscoef); + +SUNDIALS_EXPORT int CVodeSetIterType(void *cvode_mem, int iter); + +SUNDIALS_EXPORT int CVodeSetRootDirection(void *cvode_mem, int *rootdir); +SUNDIALS_EXPORT int CVodeSetNoInactiveRootWarn(void *cvode_mem); + + +/* + * ----------------------------------------------------------------- + * Quadrature optional input specification functions + * ----------------------------------------------------------------- + * The following functions can be called to set optional inputs + * to values other than the defaults given below: + * + * Function | Optional input / [ default value ] + * -------------------------------------------------------------- + * | + * CVodeSetQuadErrCon | are quadrature variables considered in + * | the error control? + * | If yes, tolerances for quadrature are + * | required (see CVodeQuad**tolerances) + * | [errconQ = FALSE] + * | + * ----------------------------------------------------------------- + * If successful, these functions return CV_SUCCESS. If an argument + * has an illegal value, they return one of the error flags + * defined for the CVodeSet* routines. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeSetQuadErrCon(void *cvode_mem, booleantype errconQ); + +/* + * ----------------------------------------------------------------- + * Forward sensitivity optional input specification functions + * ----------------------------------------------------------------- + * The following functions can be called to set optional inputs + * to other values than the defaults given below: + * + * Function | Optional input / [ default value ] + * ----------------------------------------------------------------- + * | + * CVodeSetSensDQMethod | controls the selection of finite + * | difference schemes used in evaluating + * | the sensitivity right hand sides: + * | (centered vs. forward and + * | simultaneous vs. separate) + * | [DQtype=CV_CENTERED] + * | [DQrhomax=0.0] + * | + * CVodeSetSensParams | parameter information: + * | p: pointer to problem parameters + * | plist: list of parameters with respect + * | to which sensitivities are to be + * | computed. + * | pbar: order of magnitude info. + * | Typically, if p[plist[i]] is nonzero, + * | pbar[i]=p[plist[i]]. + * | [p=NULL] + * | [plist=NULL] + * | [pbar=NULL] + * | + * CVodeSetSensErrCon | are sensitivity variables considered in + * | the error control? + * | [FALSE] + * | + * CVodeSetSensMaxNonlinIters | Maximum number of nonlinear solver + * | iterations at one solution. + * | [3] + * | + * ----------------------------------------------------------------- + * The return values are the same as for CVodeSet* + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeSetSensDQMethod(void *cvode_mem, int DQtype, realtype DQrhomax); +SUNDIALS_EXPORT int CVodeSetSensErrCon(void *cvode_mem, booleantype errconS); +SUNDIALS_EXPORT int CVodeSetSensMaxNonlinIters(void *cvode_mem, int maxcorS); +SUNDIALS_EXPORT int CVodeSetSensParams(void *cvode_mem, realtype *p, realtype *pbar, int *plist); + +/* + * ----------------------------------------------------------------- + * Quadrature sensitivity optional input specification functions + * ----------------------------------------------------------------- + * The following functions can be called to set optional inputs + * to values other than the defaults given below: + * + * Function | Optional input / [ default value ] + * -------------------------------------------------------------- + * | + * CVodeSetQuadSensErrCon | are quadrature sensitivity variables + * | considered in the error control? + * | If yes, tolerances for quadrature + * | sensitivity variables are required. + * | [errconQS = FALSE] + * | + * ----------------------------------------------------------------- + * If successful, these functions return CV_SUCCESS. If an argument + * has an illegal value, they return one of the error flags + * defined for the CVodeSet* routines. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeSetQuadSensErrCon(void *cvode_mem, booleantype errconQS); + +/* + * ----------------------------------------------------------------- + * Function : CVodeSensToggleOff + * ----------------------------------------------------------------- + * CVodeSensToggleOff deactivates sensitivity calculations. + * It does NOT deallocate sensitivity-related memory so that + * sensitivity computations can be later toggled ON (through + * CVodeSensReInit). + * + * The return value is equal to CV_SUCCESS = 0 if there were no + * errors or CV_MEM_NULL if cvode_mem was NULL + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeSensToggleOff(void *cvode_mem); + + +/* + * ================================================================= + * + * MAIN SOLVER FUNCTION FOR FORWARD PROBLEMS + * + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Function : CVode + * ----------------------------------------------------------------- + * CVode integrates the ODE over an interval in t. + * If itask is CV_NORMAL, then the solver integrates from its + * current internal t value to a point at or beyond tout, then + * interpolates to t = tout and returns y(tout) in the user- + * allocated vector yout. If itask is CV_ONE_STEP, then the solver + * takes one internal time step and returns in yout the value of + * y at the new internal time. In this case, tout is used only + * during the first call to CVode to determine the direction of + * integration and the rough scale of the problem. If tstop is + * enabled (through a call to CVodeSetStopTime), then CVode returns + * the solution at tstop. Once the integrator returns at a tstop + * time, any future testing for tstop is disabled (and can be + * reenabled only though a new call to CVodeSetStopTime). + * The time reached by the solver is placed in (*tret). The + * user is responsible for allocating the memory for this value. + * + * cvode_mem is the pointer to CVODES memory returned by + * CVodeCreate. + * + * tout is the next time at which a computed solution is desired. + * + * yout is the computed solution vector. In CV_NORMAL mode with no + * errors and no roots found, yout=y(tout). + * + * tret is a pointer to a real location. CVode sets (*tret) to + * the time reached by the solver and returns yout=y(*tret). + * + * itask is CV_NORMAL or CV_ONE_STEP. These two modes are described above. + * + * Here is a brief description of each return value: + * + * CV_SUCCESS: CVode succeeded and no roots were found. + * + * CV_ROOT_RETURN: CVode succeeded, and found one or more roots. + * If nrtfn > 1, call CVodeGetRootInfo to see + * which g_i were found to have a root at (*tret). + * + * CV_TSTOP_RETURN: CVode succeded and returned at tstop. + * + * CV_MEM_NULL: The cvode_mem argument was NULL. + * + * CV_NO_MALLOC: cvode_mem was not allocated. + * + * CV_ILL_INPUT: One of the inputs to CVode is illegal. This + * includes the situation when a component of the + * error weight vectors becomes < 0 during + * internal time-stepping. The ILL_INPUT flag + * will also be returned if the linear solver + * routine CV--- (called by the user after + * calling CVodeCreate) failed to set one of the + * linear solver-related fields in cvode_mem or + * if the linear solver's init routine failed. In + * any case, the user should see the printed + * error message for more details. + * + * CV_TOO_MUCH_WORK: The solver took mxstep internal steps but + * could not reach tout. The default value for + * mxstep is MXSTEP_DEFAULT = 500. + * + * CV_TOO_MUCH_ACC: The solver could not satisfy the accuracy + * demanded by the user for some internal step. + * + * CV_ERR_FAILURE: Error test failures occurred too many times + * (= MXNEF = 7) during one internal time step or + * occurred with |h| = hmin. + * + * CV_CONV_FAILURE: Convergence test failures occurred too many + * times (= MXNCF = 10) during one internal time + * step or occurred with |h| = hmin. + * + * CV_LINIT_FAIL: The linear solver's initialization function + * failed. + * + * CV_LSETUP_FAIL: The linear solver's setup routine failed in an + * unrecoverable manner. + * + * CV_LSOLVE_FAIL: The linear solver's solve routine failed in an + * unrecoverable manner. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVode(void *cvode_mem, realtype tout, N_Vector yout, + realtype *tret, int itask); + + +/* + * ================================================================= + * + * EXTRACTION AND DENSE OUTPUT FUNCTIONS FOR FORWARD PROBLEMS + * + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Function : CVodeGetDky + * ----------------------------------------------------------------- + * CVodeGetDky computes the kth derivative of the y function at + * time t, where tn-hu <= t <= tn, tn denotes the current + * internal time reached, and hu is the last internal step size + * successfully used by the solver. The user may request + * k=0, 1, ..., qu, where qu is the current order. The + * derivative vector is returned in dky. This vector must be + * allocated by the caller. It is only legal to call this + * function after a successful return from CVode. + * + * cvode_mem is the pointer to CVODES memory returned by + * CVodeCreate. + * + * t is the time at which the kth derivative of y is evaluated. + * The legal range for t is [tn-hu,tn] as described above. + * + * k is the order of the derivative of y to be computed. The + * legal range for k is [0,qu] as described above. + * + * dky is the output derivative vector [(D_k)y](t). + * + * The return values for CVodeGetDky are defined below. + * Here is a brief description of each return value: + * + * CV_SUCCESS: CVodeGetDky succeeded. + * + * CV_BAD_K : k is not in the range 0, 1, ..., qu. + * + * CV_BAD_T : t is not in the interval [tn-hu,tn]. + * + * CV_BAD_DKY : The dky argument was NULL. + * + * CV_MEM_NULL : The cvode_mem argument was NULL. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetDky(void *cvode_mem, realtype t, int k, N_Vector dky); + + +/* + * ----------------------------------------------------------------- + * Quadrature integration solution extraction routines + * ----------------------------------------------------------------- + * The following functions can be called to obtain the quadrature + * variables after a successful integration step. + * If quadratures were not computed, they return CV_NO_QUAD. + * + * CVodeGetQuad returns the quadrature variables at the same time + * as that at which CVode returned the solution. + * + * CVodeGetQuadDky returns the quadrature variables (or their + * derivatives up to the current method order) at any time within + * the last integration step (dense output). See CVodeGetQuad for + * more information. + * + * The output vectors yQout and dky must be allocated by the user. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetQuad(void *cvode_mem, realtype *tret, N_Vector yQout); + +SUNDIALS_EXPORT int CVodeGetQuadDky(void *cvode_mem, realtype t, int k, N_Vector dky); + +/* + * ----------------------------------------------------------------- + * Forward sensitivity solution extraction routines + * ----------------------------------------------------------------- + * The following functions can be called to obtain the sensitivity + * variables after a successful integration step. + * + * CVodeGetSens and CVodeGetSens1 return all the sensitivity vectors + * or only one of them, respectively, at the same time as that at + * which CVode returned the solution. + * The array of output vectors or output vector ySout must be + * allocated by the user. + * + * CVodeGetSensDky1 computes the kth derivative of the is-th + * sensitivity (is=1, 2, ..., Ns) of the y function at time t, + * where tn-hu <= t <= tn, tn denotes the current internal time + * reached, and hu is the last internal step size successfully + * used by the solver. The user may request k=0, 1, ..., qu, + * where qu is the current order. + * The is-th sensitivity derivative vector is returned in dky. + * This vector must be allocated by the caller. It is only legal + * to call this function after a successful return from CVode + * with sensitivty computations enabled. + * Arguments have the same meaning as in CVodeDky. + * + * CVodeGetSensDky computes the k-th derivative of all + * sensitivities of the y function at time t. It repeatedly calls + * CVodeGetSensDky. The argument dkyA must be a pointer to + * N_Vector and must be allocated by the user to hold at least Ns + * vectors. + * + * Return values are similar to those of CVodeDky. Additionally, + * CVodeSensDky can return CV_NO_SENS if sensitivities were + * not computed and CV_BAD_IS if is < 0 or is >= Ns. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetSens(void *cvode_mem, realtype *tret, N_Vector *ySout); +SUNDIALS_EXPORT int CVodeGetSens1(void *cvode_mem, realtype *tret, int is, N_Vector ySout); + +SUNDIALS_EXPORT int CVodeGetSensDky(void *cvode_mem, realtype t, int k, N_Vector *dkyA); +SUNDIALS_EXPORT int CVodeGetSensDky1(void *cvode_mem, realtype t, int k, int is, N_Vector dky); + +/* + * ----------------------------------------------------------------- + * Quadrature sensitivity solution extraction routines + * ----------------------------------------------------------------- + * The following functions can be called to obtain the quadrature + * sensitivity variables after a successful integration step. + * + * CVodeGetQuadSens and CVodeGetQuadSens1 return all the quadrature + * sensitivity vectors or only one of them, respectively, at the + * same time as that at which CVode returned the solution. + * The array of output vectors or output vector yQSout must be + * allocated by the user. + * + * CVodeGetQuadSensDky1 computes the kth derivative of the is-th + * quadrature sensitivity (is=1, 2, ..., Ns) at time t, where + * tn-hu <= t <= tn, tn denotes the current internal time + * reached, and hu is the last internal step size successfully + * used by the solver. The user may request k=0, 1, ..., qu, + * where qu is the current order. + * The is-th sensitivity derivative vector is returned in dkyQS. + * This vector must be allocated by the caller. It is only legal + * to call this function after a successful return from CVode + * with quadrature sensitivty computations enabled. + * Arguments have the same meaning as in CVodeDky. + * + * CVodeGetQuadSensDky computes the k-th derivative of all + * quadrature sensitivities at time t. It repeatedly calls + * CVodeGetSensDky. The argument dkyQS_all must be a pointer to + * N_Vector and must be allocated by the user to hold at least Ns + * vectors. + * + * Return values are similar to those of CVodeDky. Additionally, + * CVodeQuadSensDky can return CV_NO_QUADSENS if quadrature + * sensitivities were not computed and CV_BAD_IS if is < 0 or is >= Ns. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetQuadSens(void *cvode_mem, realtype *tret, N_Vector *yQSout); +SUNDIALS_EXPORT int CVodeGetQuadSens1(void *cvode_mem, realtype *tret, int is, N_Vector yQSout); + +SUNDIALS_EXPORT int CVodeGetQuadSensDky(void *cvode_mem, realtype t, int k, N_Vector *dkyQS_all); +SUNDIALS_EXPORT int CVodeGetQuadSensDky1(void *cvode_mem, realtype t, int k, int is, N_Vector dkyQS); + +/* + * ================================================================= + * + * OPTIONAL OUTPUT FUNCTIONS FOR FORWARD PROBLEMS + * + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Integrator optional output extraction functions + * ----------------------------------------------------------------- + * The following functions can be called to get optional outputs + * and statistics related to the main integrator. + * ----------------------------------------------------------------- + * CVodeGetWorkSpace returns the CVODES real and integer workspaces + * CVodeGetNumSteps returns the cumulative number of internal + * steps taken by the solver + * CVodeGetNumRhsEvals returns the number of calls to the user's + * f function + * CVodeGetNumLinSolvSetups returns the number of calls made to + * the linear solver's setup routine + * CVodeGetNumErrTestFails returns the number of local error test + * failures that have occured + * CVodeGetLastOrder returns the order used during the last + * internal step + * CVodeGetCurrentOrder returns the order to be used on the next + * internal step + * CVodeGetNumStabLimOrderReds returns the number of order + * reductions due to stability limit detection + * CVodeGetActualInitStep returns the actual initial step size + * used by CVODES + * CVodeGetLastStep returns the step size for the last internal + * step + * CVodeGetCurrentStep returns the step size to be attempted on + * the next internal step + * CVodeGetCurrentTime returns the current internal time reached + * by the solver + * CVodeGetTolScaleFactor returns a suggested factor by which the + * user's tolerances should be scaled when too + * much accuracy has been requested for some + * internal step + * CVodeGetErrWeights returns the current error weight vector. + * The user must allocate space for eweight. + * CVodeGetEstLocalErrors returns the vector of estimated local + * errors. The user must allocate space for ele. + * CVodeGetNumGEvals returns the number of calls to the user's + * g function (for rootfinding) + * CVodeGetRootInfo returns the indices for which g_i was found to + * have a root. The user must allocate space for + * rootsfound. For i = 0 ... nrtfn-1, + * rootsfound[i] = 1 if g_i has a root, and = 0 if not. + * + * CVodeGet* return values: + * CV_SUCCESS if succesful + * CV_MEM_NULL if the cvode memory was NULL + * CV_NO_SLDET if stability limit was not turned on + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetWorkSpace(void *cvode_mem, long int *lenrw, long int *leniw); +SUNDIALS_EXPORT int CVodeGetNumSteps(void *cvode_mem, long int *nsteps); +SUNDIALS_EXPORT int CVodeGetNumRhsEvals(void *cvode_mem, long int *nfevals); +SUNDIALS_EXPORT int CVodeGetNumLinSolvSetups(void *cvode_mem, long int *nlinsetups); +SUNDIALS_EXPORT int CVodeGetNumErrTestFails(void *cvode_mem, long int *netfails); +SUNDIALS_EXPORT int CVodeGetLastOrder(void *cvode_mem, int *qlast); +SUNDIALS_EXPORT int CVodeGetCurrentOrder(void *cvode_mem, int *qcur); +SUNDIALS_EXPORT int CVodeGetNumStabLimOrderReds(void *cvode_mem, long int *nslred); +SUNDIALS_EXPORT int CVodeGetActualInitStep(void *cvode_mem, realtype *hinused); +SUNDIALS_EXPORT int CVodeGetLastStep(void *cvode_mem, realtype *hlast); +SUNDIALS_EXPORT int CVodeGetCurrentStep(void *cvode_mem, realtype *hcur); +SUNDIALS_EXPORT int CVodeGetCurrentTime(void *cvode_mem, realtype *tcur); +SUNDIALS_EXPORT int CVodeGetTolScaleFactor(void *cvode_mem, realtype *tolsfac); +SUNDIALS_EXPORT int CVodeGetErrWeights(void *cvode_mem, N_Vector eweight); +SUNDIALS_EXPORT int CVodeGetEstLocalErrors(void *cvode_mem, N_Vector ele); +SUNDIALS_EXPORT int CVodeGetNumGEvals(void *cvode_mem, long int *ngevals); +SUNDIALS_EXPORT int CVodeGetRootInfo(void *cvode_mem, int *rootsfound); + +/* + * ----------------------------------------------------------------- + * As a convenience, the following functions provides the + * optional outputs in one group. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetIntegratorStats(void *cvode_mem, long int *nsteps, + long int *nfevals, long int *nlinsetups, + long int *netfails, int *qlast, + int *qcur, realtype *hinused, realtype *hlast, + realtype *hcur, realtype *tcur); + +/* + * ----------------------------------------------------------------- + * Nonlinear solver optional output extraction functions + * ----------------------------------------------------------------- + * The following functions can be called to get optional outputs + * and statistics related to the nonlinear solver. + * ----------------------------------------------------------------- + * CVodeGetNumNonlinSolvIters returns the number of nonlinear + * solver iterations performed. + * CVodeGetNumNonlinSolvConvFails returns the number of nonlinear + * convergence failures. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetNumNonlinSolvIters(void *cvode_mem, long int *nniters); +SUNDIALS_EXPORT int CVodeGetNumNonlinSolvConvFails(void *cvode_mem, long int *nncfails); + +/* + * ----------------------------------------------------------------- + * As a convenience, the following function provides the + * nonlinear solver optional outputs in a group. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetNonlinSolvStats(void *cvode_mem, long int *nniters, + long int *nncfails); + + +/* + * ----------------------------------------------------------------- + * The following function returns the name of the constant + * associated with a CVODES return flag + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT char *CVodeGetReturnFlagName(int flag); + +/* + * ----------------------------------------------------------------- + * Quadrature integration optional output extraction routines + * ----------------------------------------------------------------- + * The following functions can be called to get optional outputs + * and statistics related to the integration of quadratures. + * ----------------------------------------------------------------- + * CVodeGetQuadNumRhsEvals returns the number of calls to the + * user function fQ defining the right hand + * side of the quadrature variables. + * CVodeGetQuadNumErrTestFails returns the number of local error + * test failures for quadrature variables. + * CVodeGetQuadErrWeights returns the vector of error weights for + * the quadrature variables. The user must + * allocate space for ewtQ. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetQuadNumRhsEvals(void *cvode_mem, long int *nfQevals); +SUNDIALS_EXPORT int CVodeGetQuadNumErrTestFails(void *cvode_mem, long int *nQetfails); +SUNDIALS_EXPORT int CVodeGetQuadErrWeights(void *cvode_mem, N_Vector eQweight); + +/* + * ----------------------------------------------------------------- + * As a convenience, the following function provides the above + * optional outputs in a group. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetQuadStats(void *cvode_mem, long int *nfQevals, + long int *nQetfails); + +/* + * ----------------------------------------------------------------- + * Forward sensitivity optional output extraction routines + * ----------------------------------------------------------------- + * The following functions can be called to get optional outputs + * and statistics related to the integration of sensitivities. + * ----------------------------------------------------------------- + * CVodeGetSensNumRhsEvals returns the number of calls to the + * sensitivity right hand side routine. + * CVodeGetNumRhsEvalsSens returns the number of calls to the + * user f routine due to finite difference evaluations of the + * sensitivity equations. + * CVodeGetSensNumErrTestFails returns the number of local error + * test failures for sensitivity variables. + * CVodeGetSensNumLinSolvSetups returns the number of calls made + * to the linear solver's setup routine due to sensitivity computations. + * CVodeGetSensErrWeights returns the sensitivity error weight + * vectors. The user need not allocate space for ewtS. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetSensNumRhsEvals(void *cvode_mem, long int *nfSevals); +SUNDIALS_EXPORT int CVodeGetNumRhsEvalsSens(void *cvode_mem, long int *nfevalsS); +SUNDIALS_EXPORT int CVodeGetSensNumErrTestFails(void *cvode_mem, long int *nSetfails); +SUNDIALS_EXPORT int CVodeGetSensNumLinSolvSetups(void *cvode_mem, long int *nlinsetupsS); +SUNDIALS_EXPORT int CVodeGetSensErrWeights(void *cvode_mem, N_Vector *eSweight); + +/* + * ----------------------------------------------------------------- + * As a convenience, the following function provides the + * optional outputs in a group. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetSensStats(void *cvode_mem, long int *nfSevals, long int *nfevalsS, + long int *nSetfails, long int *nlinsetupsS); + +/* + * ----------------------------------------------------------------- + * Sensitivity nonlinear solver optional output extraction + * ----------------------------------------------------------------- + * The following functions can be called to get optional outputs + * and statistics related to the sensitivity nonlinear solver. + * ----------------------------------------------------------------- + * CVodeGetSensNumNonlinSolvIters returns the total number of + * nonlinear iterations for sensitivity variables. + * CVodeGetSensNumNonlinSolvConvFails returns the total number + * of nonlinear convergence failures for sensitivity variables + * CVodeGetStgrSensNumNonlinSolvIters returns a vector of Ns + * nonlinear iteration counters for sensitivity variables in + * the CV_STAGGERED1 method. + * CVodeGetStgrSensNumNonlinSolvConvFails returns a vector of Ns + * nonlinear solver convergence failure counters for sensitivity + * variables in the CV_STAGGERED1 method. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetSensNumNonlinSolvIters(void *cvode_mem, long int *nSniters); +SUNDIALS_EXPORT int CVodeGetSensNumNonlinSolvConvFails(void *cvode_mem, long int *nSncfails); +SUNDIALS_EXPORT int CVodeGetStgrSensNumNonlinSolvIters(void *cvode_mem, long int *nSTGR1niters); +SUNDIALS_EXPORT int CVodeGetStgrSensNumNonlinSolvConvFails(void *cvode_mem, + long int *nSTGR1ncfails); + +/* + * ----------------------------------------------------------------- + * As a convenience, the following function provides the + * optional outputs in groups. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetSensNonlinSolvStats(void *cvode_mem, long int *nSniters, + long int *nSncfails); + + +/* + * ----------------------------------------------------------------- + * Quadrature sensitivity optional output extraction routines + * ----------------------------------------------------------------- + * The following functions can be called to get optional outputs and + * statistics related to the integration of quadrature sensitivitiess. + * ----------------------------------------------------------------- + * CVodeGetQuadSensNumRhsEvals returns the number of calls to the + * user function fQS defining the right hand side of the + * quadrature sensitivity equations. + * CVodeGetQuadSensNumErrTestFails returns the number of local error + * test failures for quadrature sensitivity variables. + * CVodeGetQuadSensErrWeights returns the vector of error weights + * for the quadrature sensitivity variables. The user must + * allocate space for ewtQS. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetQuadSensNumRhsEvals(void *cvode_mem, long int *nfQSevals); +SUNDIALS_EXPORT int CVodeGetQuadSensNumErrTestFails(void *cvode_mem, long int *nQSetfails); +SUNDIALS_EXPORT int CVodeGetQuadSensErrWeights(void *cvode_mem, N_Vector *eQSweight); + +/* + * ----------------------------------------------------------------- + * As a convenience, the following function provides the above + * optional outputs in a group. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetQuadSensStats(void *cvode_mem, + long int *nfQSevals, + long int *nQSetfails); + + +/* + * ================================================================= + * + * INITIALIZATION AND DEALLOCATION FUNCTIONS FOR BACKWARD PROBLEMS + * + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * CVodeAdjInit + * ----------------------------------------------------------------- + * CVodeAdjInit specifies some parameters for ASA, initializes ASA + * and allocates space for the adjoint memory structure. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeAdjInit(void *cvode_mem, long int steps, int interp); + +/* + * ----------------------------------------------------------------- + * CVodeAdjReInit + * ----------------------------------------------------------------- + * CVodeAdjReInit reinitializes the CVODES memory structure for ASA, + * assuming that the number of steps between check points and the + * type of interpolation remained unchanged. The list of check points + * (and associated memory) is deleted. The list of backward problems + * is kept (however, new backward problems can be added to this list + * by calling CVodeCreateB). The CVODES memory for the forward and + * backward problems can be reinitialized separately by calling + * CVodeReInit and CVodeReInitB, respectively. + * NOTE: if a entirely new list of backward problems is desired, + * then simply free the adjoint memory (by calling CVodeAdjFree) + * and reinitialize ASA with CVodeAdjInit. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeAdjReInit(void *cvode_mem); + +/* + * ----------------------------------------------------------------- + * CVodeAdjFree + * ----------------------------------------------------------------- + * CVodeAdjFree frees the memory allocated by CVodeAdjInit. + * It is typically called by CVodeFree. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void CVodeAdjFree(void *cvode_mem); + + +/* + * ----------------------------------------------------------------- + * Interfaces to CVODES functions for setting-up backward problems. + * ----------------------------------------------------------------- + * CVodeCreateB, + * + * CVodeInitB, CVodeInitBS, CVodeReInitB + * + * CVodeQuadInitB, CVodeQuadInitBS, CVodeQuadReInitB + * + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeCreateB(void *cvode_mem, int lmmB, int iterB, int *which); + +SUNDIALS_EXPORT int CVodeInitB(void *cvode_mem, int which, + CVRhsFnB fB, + realtype tB0, N_Vector yB0); +SUNDIALS_EXPORT int CVodeInitBS(void *cvode_mem, int which, + CVRhsFnBS fBs, + realtype tB0, N_Vector yB0); +SUNDIALS_EXPORT int CVodeReInitB(void *cvode_mem, int which, + realtype tB0, N_Vector yB0); + +SUNDIALS_EXPORT int CVodeSStolerancesB(void *cvode_mem, int which, + realtype reltolB, realtype abstolB); +SUNDIALS_EXPORT int CVodeSVtolerancesB(void *cvode_mem, int which, + realtype reltolB, N_Vector abstolB); + +SUNDIALS_EXPORT int CVodeQuadInitB(void *cvode_mem, int which, + CVQuadRhsFnB fQB, N_Vector yQB0); +SUNDIALS_EXPORT int CVodeQuadInitBS(void *cvode_mem, int which, + CVQuadRhsFnBS fQBs, N_Vector yQB0); +SUNDIALS_EXPORT int CVodeQuadReInitB(void *cvode_mem, int which, N_Vector yQB0); + +SUNDIALS_EXPORT int CVodeQuadSStolerancesB(void *cvode_mem, int which, + realtype reltolQB, realtype abstolQB); +SUNDIALS_EXPORT int CVodeQuadSVtolerancesB(void *cvode_mem, int which, + realtype reltolQB, N_Vector abstolQB); + +/* + * ================================================================= + * + * MAIN SOLVER FUNCTIONS FOR FORWARD PROBLEMS + * + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * CVodeF + * ----------------------------------------------------------------- + * CVodeF integrates towards tout and returns solution into yout. + * In the same time, it stores check point data every 'steps'. + * + * CVodeF can be called repeatedly by the user. + * + * ncheckPtr points to the number of check points stored so far. + * + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeF(void *cvode_mem, realtype tout, N_Vector yout, + realtype *tret, int itask, int *ncheckPtr); + + +/* + * ----------------------------------------------------------------- + * CVodeB + * ----------------------------------------------------------------- + * CVodeB performs the integration of all backward problems specified + * through calls to CVodeCreateB through a sequence of forward-backward + * runs in between consecutive check points. CVodeB can be called + * either in CV_NORMAL or CV_ONE_STEP mode. After a successful return + * from CVodeB, the solution and quadrature variables at the current + * return time for any given backward problem can be obtained by + * calling CVodeGetB and CVodeGetQuadB, respectively. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeB(void *cvode_mem, realtype tBout, int itaskB); + +/* + * ================================================================= + * + * OPTIONAL INPUT FUNCTIONS FOR BACKWARD PROBLEMS + * + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * CVodeSetAdjNoSensi + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeSetAdjNoSensi(void *cvode_mem); + +/* + * ----------------------------------------------------------------- + * Optional input functions for backward problems + * ----------------------------------------------------------------- + * These functions are just wrappers around the corresponding + * functions in cvodes.h, with some particularizations for the + * backward integration. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeSetIterTypeB(void *cvode_mem, int which, int iterB); +SUNDIALS_EXPORT int CVodeSetUserDataB(void *cvode_mem, int which, void *user_dataB); +SUNDIALS_EXPORT int CVodeSetMaxOrdB(void *cvode_mem, int which, int maxordB); +SUNDIALS_EXPORT int CVodeSetMaxNumStepsB(void *cvode_mem, int which, long int mxstepsB); +SUNDIALS_EXPORT int CVodeSetStabLimDetB(void *cvode_mem, int which, booleantype stldetB); +SUNDIALS_EXPORT int CVodeSetInitStepB(void *cvode_mem, int which, realtype hinB); +SUNDIALS_EXPORT int CVodeSetMinStepB(void *cvode_mem, int which, realtype hminB); +SUNDIALS_EXPORT int CVodeSetMaxStepB(void *cvode_mem, int which, realtype hmaxB); + +SUNDIALS_EXPORT int CVodeSetQuadErrConB(void *cvode_mem, int which, booleantype errconQB); + +/* + * ================================================================= + * + * EXTRACTION AND DENSE OUTPUT FUNCTIONS FOR BACKWARD PROBLEMS + * + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * CVodeGetB and CVodeGetQuadB + * ----------------------------------------------------------------- + * Extraction functions for the solution and quadratures for a given + * backward problem. They return their corresponding output vector + * at the current time reached by the integration of the backward + * problem. To obtain the solution or quadratures associated with + * a given backward problem at some other time within the last + * integration step (dense output), first obtain a pointer to the + * proper CVODES memory by calling CVodeGetAdjCVodeBmem and then use it + * to call CVodeGetDky and CVodeGetQuadDky. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetB(void *cvode_mem, int which, + realtype *tBret, N_Vector yB); +SUNDIALS_EXPORT int CVodeGetQuadB(void *cvode_mem, int which, + realtype *tBret, N_Vector qB); + + +/* + * ================================================================= + * + * OPTIONAL OUTPUT FUNCTIONS FOR BACKWARD PROBLEMS + * + * ================================================================= + */ + + +/* + * ----------------------------------------------------------------- + * CVodeGetAdjCVodeBmem + * ----------------------------------------------------------------- + * CVodeGetAdjCVodeBmem returns a (void *) pointer to the CVODES + * memory allocated for the backward problem. This pointer can + * then be used to call any of the CVodeGet* CVODES routines to + * extract optional output for the backward integration phase. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void *CVodeGetAdjCVodeBmem(void *cvode_mem, int which); + + +/* + * ----------------------------------------------------------------- + * CVodeGetAdjY + * Returns the interpolated forward solution at time t. This + * function is a wrapper around the interpType-dependent internal + * function. + * The calling function must allocate space for y. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetAdjY(void *cvode_mem, realtype t, N_Vector y); + +/* + * ----------------------------------------------------------------- + * CVodeGetAdjCheckPointsInfo + * Loads an array of nckpnts structures of type CVadjCheckPointRec. + * The user must allocate space for ckpnt (ncheck+1). + * ----------------------------------------------------------------- + */ + +typedef struct { + void *my_addr; + void *next_addr; + realtype t0; + realtype t1; + long int nstep; + int order; + realtype step; +} CVadjCheckPointRec; + +SUNDIALS_EXPORT int CVodeGetAdjCheckPointsInfo(void *cvode_mem, CVadjCheckPointRec *ckpnt); + +/* + * ----------------------------------------------------------------- + * CVodeGetAdjDataPointHermite + * Returns the 2 vectors stored for cubic Hermite interpolation + * at the data point 'which'. The user must allocate space for + * y and yd. Returns CV_MEM_NULL if cvode_mem is NULL. + * Returns CV_ILL_INPUT if interpType != CV_HERMITE. + * CVodeGetAdjDataPointPolynomial + * Returns the vector stored for polynomial interpolation + * at the data point 'which'. The user must allocate space for + * y. Returns CV_MEM_NULL if cvode_mem is NULL. + * Returns CV_ILL_INPUT if interpType != CV_POLYNOMIAL. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetAdjDataPointHermite(void *cvode_mem, long int which, + realtype *t, N_Vector y, N_Vector yd); + +SUNDIALS_EXPORT int CVodeGetAdjDataPointPolynomial(void *cvode_mem, long int which, + realtype *t, int *order, N_Vector y); + +/* + * ----------------------------------------------------------------- + * CVodeGetAdjCurrentCheckPoint + * Returns the address of the 'active' check point. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVodeGetAdjCurrentCheckPoint(void *cvode_mem, void **addr); + + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_band.h b/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_band.h new file mode 100644 index 0000000..fc3ce44 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_band.h @@ -0,0 +1,72 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.7 $ + * $Date: 2008/04/18 19:42:36 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the band linear solver CSVBAND. + * ----------------------------------------------------------------- + */ + +#ifndef _CVSBAND_H +#define _CVSBAND_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ----------------------------------------------------------------- + * Function : CVBand + * ----------------------------------------------------------------- + * A call to the CVBand function links the main CVODE integrator + * with the CVSBAND linear solver. + * + * cvode_mem is the pointer to the integrator memory returned by + * CVodeCreate. + * + * N is the size of the ODE system. + * + * mupper is the upper bandwidth of the band Jacobian + * approximation. + * + * mlower is the lower bandwidth of the band Jacobian + * approximation. + * + * The return value of CVBand is one of: + * CVDLS_SUCCESS if successful + * CVDLS_MEM_NULL if the cvode memory was NULL + * CVDLS_MEM_FAIL if there was a memory allocation failure + * CVDLS_ILL_INPUT if a required vector operation is missing or + * if a bandwidth has an illegal value. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVBand(void *cvode_mem, int N, int mupper, int mlower); + +/* + * ----------------------------------------------------------------- + * Function: CVBandB + * ----------------------------------------------------------------- + * CVBandB links the main CVODE integrator with the CVSBAND + * linear solver for the backward integration. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVBandB(void *cvode_mem, int which, + int nB, int mupperB, int mlowerB); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_bandpre.h b/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_bandpre.h new file mode 100644 index 0000000..966fdc3 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_bandpre.h @@ -0,0 +1,179 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.7 $ + * $Date: 2007/11/26 16:19:58 $ + * ----------------------------------------------------------------- + * Programmer: Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the CVSBANDPRE module, which + * provides a banded difference quotient Jacobian-based + * preconditioner and solver routines for use with CVSPGMR, + * CVSPBCG, or CVSPTFQMR. + * + * Part I contains type definitions and function prototypes for using + * CVSBANDPRE on forward problems (IVP integration and/or FSA) + * + * Part II contains type definitions and function prototypes for using + * CVSBANDPRE on adjopint (backward) problems + * ----------------------------------------------------------------- + */ + +#ifndef _CVSBANDPRE_H +#define _CVSBANDPRE_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ================================================================= + * PART I - forward problems + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * + * SUMMARY + * + * These routines provide a band matrix preconditioner based on + * difference quotients of the ODE right-hand side function f. + * The user supplies parameters + * mu = upper half-bandwidth (number of super-diagonals) + * ml = lower half-bandwidth (number of sub-diagonals) + * The routines generate a band matrix of bandwidth ml + mu + 1 + * and use this to form a preconditioner for use with the Krylov + * linear solver in CVSP*. Although this matrix is intended to + * approximate the Jacobian df/dy, it may be a very crude + * approximation. The true Jacobian need not be banded, or its + * true bandwith may be larger than ml + mu + 1, as long as the + * banded approximation generated here is sufficiently accurate + * to speed convergence as a preconditioner. + * + * Usage: + * The following is a summary of the usage of this module. + * Details of the calls to CVodeCreate, CVodeMalloc, CVSp*, + * and CVode are available in the User Guide. + * To use these routines, the sequence of calls in the user + * main program should be as follows: + * + * #include + * #include + * ... + * Set y0 + * ... + * cvode_mem = CVodeCreate(...); + * ier = CVodeMalloc(...); + * ... + * flag = CVSptfqmr(cvode_mem, pretype, maxl); + * -or- + * flag = CVSpgmr(cvode_mem, pretype, maxl); + * -or- + * flag = CVSpbcg(cvode_mem, pretype, maxl); + * ... + * flag = CVBandPrecInit(cvode_mem, N, mu, ml); + * ... + * flag = CVode(...); + * ... + * Free y0 + * ... + * CVodeFree(&cvode_mem); + * + * Notes: + * (1) Include this file for the CVBandPrecData type definition. + * (2) In the CVBandPrecInit call, the arguments N is the + * problem dimension. + * (3) In the CVBPSp* call, the user is free to specify + * the input pretype and the optional input maxl. + * ----------------------------------------------------------------- + */ + + +/* + * ----------------------------------------------------------------- + * Function : CVBandPrecInit + * ----------------------------------------------------------------- + * CVBandPrecInit allocates and initializes the BANDPRE preconditioner + * module. This functino must be called AFTER one of the SPILS linear + * solver modules has been attached to the CVODE integrator. + * + * The parameters of CVBandPrecInit are as follows: + * + * cvode_mem is the pointer to CVODE memory returned by CVodeCreate. + * + * N is the problem size. + * + * mu is the upper half bandwidth. + * + * ml is the lower half bandwidth. + * + * The return value of CVBandPrecInit is one of: + * CVSPILS_SUCCESS if no errors occurred + * CVSPILS_MEM_NULL if the integrator memory is NULL + * CVSPILS_LMEM_NULL if the linear solver memory is NULL + * CVSPILS_ILL_INPUT if an input has an illegal value + * CVSPILS_MEM_FAIL if a memory allocation request failed + * + * NOTE: The band preconditioner assumes a serial implementation + * of the NVECTOR package. Therefore, CVBandPrecInit will + * first test for a compatible N_Vector internal + * representation by checking for required functions. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVBandPrecInit(void *cvode_mem, int N, int mu, int ml); + +/* + * ----------------------------------------------------------------- + * Optional output functions : CVBandPrecGet* + * ----------------------------------------------------------------- + * CVBandPrecGetWorkSpace returns the real and integer work space used + * by CVBANDPRE. + * CVBandPrecGetNumRhsEvals returns the number of calls made from + * CVBANDPRE to the user's right-hand side + * routine f. + * + * The return value of CVBandPrecGet* is one of: + * CVSPILS_SUCCESS if no errors occurred + * CVSPILS_MEM_NULL if the integrator memory is NULL + * CVSPILS_LMEM_NULL if the linear solver memory is NULL + * CVSPILS_PMEM_NULL if the preconditioner memory is NULL + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVBandPrecGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS); +SUNDIALS_EXPORT int CVBandPrecGetNumRhsEvals(void *cvode_mem, long int *nfevalsBP); + +/* + * ================================================================= + * PART II - backward problems + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Functions: CVBandPrecInitB, CVBPSp*B + * ----------------------------------------------------------------- + * Interface functions for the CVBANDPRE preconditioner to be used + * on the backward phase. + * + * CVBandPrecInitB interfaces to the CVBANDPRE preconditioner + * for the backward integration. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVBandPrecInitB(void *cvode_mem, int which, + int nB, int muB, int mlB); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_bbdpre.h b/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_bbdpre.h new file mode 100644 index 0000000..5792794 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_bbdpre.h @@ -0,0 +1,331 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.10 $ + * $Date: 2007/11/26 16:19:58 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the CVBBDPRE module, for a + * band-block-diagonal preconditioner, i.e. a block-diagonal + * matrix with banded blocks, for use with CVSPGMR/CVSPBCG/CVSPTFQMR, + * and the parallel implementation of the NVECTOR module. + * + * + * Part I contains type definitions and function prototypes for using + * CVBBDPRE on forward problems (IVP integration and/or FSA) + * + * Part II contains type definitions and function prototypes for using + * CVBBDPRE on adjopint (backward) problems + * ----------------------------------------------------------------- + */ + +#ifndef _CVSBBDPRE_H +#define _CVSBBDPRE_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ================================================================= + * PART I - forward problems + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * + * SUMMARY + * + * These routines provide a preconditioner matrix that is + * block-diagonal with banded blocks. The blocking corresponds + * to the distribution of the dependent variable vector y among + * the processors. Each preconditioner block is generated from + * the Jacobian of the local part (on the current processor) of a + * given function g(t,y) approximating f(t,y). The blocks are + * generated by a difference quotient scheme on each processor + * independently. This scheme utilizes an assumed banded + * structure with given half-bandwidths, mudq and mldq. + * However, the banded Jacobian block kept by the scheme has + * half-bandwiths mukeep and mlkeep, which may be smaller. + * + * The user's calling program should have the following form: + * + * #include + * #include + * ... + * void *cvode_mem; + * ... + * Set y0 + * ... + * cvode_mem = CVodeCreate(...); + * ier = CVodeMalloc(...); + * ... + * flag = CVSpgmr(cvode_mem, pretype, maxl); + * -or- + * flag = CVSpbcg(cvode_mem, pretype, maxl); + * -or- + * flag = CVSptfqmr(cvode_mem, pretype, maxl); + * ... + * flag = CVBBDPrecInit(cvode_mem, Nlocal, mudq ,mldq, + * mukeep, mlkeep, dqrely, gloc, cfn); + * ... + * ier = CVode(...); + * ... + * CVodeFree(&cvode_mem); + * + * Free y0 + * + * The user-supplied routines required are: + * + * f = function defining the ODE right-hand side f(t,y). + * + * gloc = function defining the approximation g(t,y). + * + * cfn = function to perform communication need for gloc. + * + * Notes: + * + * 1) This header file is included by the user for the definition + * of the CVBBDData type and for needed function prototypes. + * + * 2) The CVBBDPrecInit call includes half-bandwiths mudq and mldq + * to be used in the difference quotient calculation of the + * approximate Jacobian. They need not be the true + * half-bandwidths of the Jacobian of the local block of g, + * when smaller values may provide a greater efficiency. + * Also, the half-bandwidths mukeep and mlkeep of the retained + * banded approximate Jacobian block may be even smaller, + * to reduce storage and computation costs further. + * For all four half-bandwidths, the values need not be the + * same on every processor. + * + * 3) The actual name of the user's f function is passed to + * CVodeInit, and the names of the user's gloc and cfn + * functions are passed to CVBBDPrecInit. + * + * 4) The pointer to the user-defined data block user_data, which is + * set through CVodeSetUserData is also available to the user in + * gloc and cfn. + * + * 5) Optional outputs specific to this module are available by + * way of routines listed below. These include work space sizes + * and the cumulative number of gloc calls. The costs + * associated with this module also include nsetups banded LU + * factorizations, nlinsetups cfn calls, and npsolves banded + * backsolve calls, where nlinsetups and npsolves are + * integrator/CVSPGMR/CVSPBCG/CVSPTFQMR optional outputs. + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * Type : CVLocalFn + * ----------------------------------------------------------------- + * The user must supply a function g(t,y) which approximates the + * right-hand side function f for the system y'=f(t,y), and which + * is computed locally (without interprocess communication). + * (The case where g is mathematically identical to f is allowed.) + * The implementation of this function must have type CVLocalFn. + * + * This function takes as input the local vector size Nlocal, the + * independent variable value t, the local real dependent + * variable vector y, and a pointer to the user-defined data + * block user_data. It is to compute the local part of g(t,y) and + * store this in the vector g. + * (Allocation of memory for y and g is handled within the + * preconditioner module.) + * The user_data parameter is the same as that specified by the user + * through the CVodeSetFdata routine. + * + * A CVLocalFn should return 0 if successful, a positive value if + * a recoverable error occurred, and a negative value if an + * unrecoverable error occurred. + * ----------------------------------------------------------------- + */ + +typedef int (*CVLocalFn)(int Nlocal, realtype t, + N_Vector y, N_Vector g, void *user_data); + +/* + * ----------------------------------------------------------------- + * Type : CVCommFn + * ----------------------------------------------------------------- + * The user may supply a function of type CVCommFn which performs + * all interprocess communication necessary to evaluate the + * approximate right-hand side function described above. + * + * This function takes as input the local vector size Nlocal, + * the independent variable value t, the dependent variable + * vector y, and a pointer to the user-defined data block user_data. + * The user_data parameter is the same as that specified by the user + * through the CVodeSetUserData routine. The CVCommFn cfn is + * expected to save communicated data in space defined within the + * structure user_data. Note: A CVCommFn cfn does not have a return value. + * + * Each call to the CVCommFn cfn is preceded by a call to the + * CVRhsFn f with the same (t,y) arguments. Thus cfn can omit any + * communications done by f if relevant to the evaluation of g. + * If all necessary communication was done by f, the user can + * pass NULL for cfn in CVBBDPrecInit (see below). + * + * A CVCommFn should return 0 if successful, a positive value if + * a recoverable error occurred, and a negative value if an + * unrecoverable error occurred. + * ----------------------------------------------------------------- + */ + +typedef int (*CVCommFn)(int Nlocal, realtype t, + N_Vector y, + void *user_data); + +/* + * ----------------------------------------------------------------- + * Function : CVBBDPrecInit + * ----------------------------------------------------------------- + * CVBBDPrecInit allocates and initializes the BBD preconditioner. + * + * The parameters of CVBBDPrecInit are as follows: + * + * cvode_mem is the pointer to the integrator memory. + * + * Nlocal is the length of the local block of the vectors y etc. + * on the current processor. + * + * mudq, mldq are the upper and lower half-bandwidths to be used + * in the difference quotient computation of the local + * Jacobian block. + * + * mukeep, mlkeep are the upper and lower half-bandwidths of the + * retained banded approximation to the local Jacobian + * block. + * + * dqrely is an optional input. It is the relative increment + * in components of y used in the difference quotient + * approximations. To specify the default, pass 0. + * The default is dqrely = sqrt(unit roundoff). + * + * gloc is the name of the user-supplied function g(t,y) that + * approximates f and whose local Jacobian blocks are + * to form the preconditioner. + * + * cfn is the name of the user-defined function that performs + * necessary interprocess communication for the + * execution of gloc. + * + * The return value of CVBBDPrecInit is one of: + * CVSPILS_SUCCESS if no errors occurred + * CVSPILS_MEM_NULL if the integrator memory is NULL + * CVSPILS_LMEM_NULL if the linear solver memory is NULL + * CVSPILS_ILL_INPUT if an input has an illegal value + * CVSPILS_MEM_FAIL if a memory allocation request failed + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVBBDPrecInit(void *cvode_mem, int Nlocal, + int mudq, int mldq, + int mukeep, int mlkeep, + realtype dqrely, + CVLocalFn gloc, CVCommFn cfn); + +/* + * ----------------------------------------------------------------- + * Function : CVBBDPrecReInit + * ----------------------------------------------------------------- + * CVBBDPrecReInit re-initializes the BBDPRE module when solving a + * sequence of problems of the same size with CVSPGMR/CVBBDPRE, + * CVSPBCG/CVBBDPRE, or CVSPTFQMR/CVBBDPRE provided there is no change + * in Nlocal, mukeep, or mlkeep. After solving one problem, and after + * calling CVodeReInit to re-initialize the integrator for a subsequent + * problem, call CVBBDPrecReInit. + * + * All arguments have the same names and meanings as those + * of CVBBDPrecInit. + * + * The return value of CVBBDPrecReInit is one of: + * CVSPILS_SUCCESS if no errors occurred + * CVSPILS_MEM_NULL if the integrator memory is NULL + * CVSPILS_LMEM_NULL if the linear solver memory is NULL + * CVSPILS_PMEM_NULL if the preconditioner memory is NULL + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVBBDPrecReInit(void *cvode_mem, int mudq, int mldq, + realtype dqrely); + +/* + * ----------------------------------------------------------------- + * CVBBDPRE optional output extraction routines + * ----------------------------------------------------------------- + * CVBBDPrecGetWorkSpace returns the BBDPRE real and integer work space + * sizes. + * CVBBDPrecGetNumGfnEvals returns the number of calls to gfn. + * + * The return value of CVBBDPrecGet* is one of: + * CVSPILS_SUCCESS if no errors occurred + * CVSPILS_MEM_NULL if the integrator memory is NULL + * CVSPILS_LMEM_NULL if the linear solver memory is NULL + * CVSPILS_PMEM_NULL if the preconditioner memory is NULL + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVBBDPrecGetWorkSpace(void *cvode_mem, + long int *lenrwBBDP, long int *leniwBBDP); +SUNDIALS_EXPORT int CVBBDPrecGetNumGfnEvals(void *cvode_mem, long int *ngevalsBBDP); + +/* + * ================================================================= + * PART II - backward problems + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Types: CVLocalFnB and CVCommFnB + * ----------------------------------------------------------------- + * Local approximation function and inter-process communication + * function for the BBD preconditioner on the backward phase. + * ----------------------------------------------------------------- + */ + +typedef int (*CVLocalFnB)(int NlocalB, realtype t, + N_Vector y, + N_Vector yB, N_Vector gB, + void *user_dataB); + +typedef int (*CVCommFnB)(int NlocalB, realtype t, + N_Vector y, + N_Vector yB, + void *user_dataB); + +/* + * ----------------------------------------------------------------- + * Functions: CVBBDPrecInitB, CVBBDSp*B, CVBBDPrecReInit + * ----------------------------------------------------------------- + * Interface functions for the CVBBDPRE preconditioner to be used on + * the backward phase. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVBBDPrecInitB(void *cvode_mem, int which, int NlocalB, + int mudqB, int mldqB, + int mukeepB, int mlkeepB, + realtype dqrelyB, + CVLocalFnB glocB, CVCommFnB cfnB); + +SUNDIALS_EXPORT int CVBBDPrecReInitB(void *cvode_mem, int which, + int mudqB, int mldqB, + realtype dqrelyB); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_dense.h b/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_dense.h new file mode 100644 index 0000000..59fe7f7 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_dense.h @@ -0,0 +1,64 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.7 $ + * $Date: 2008/04/18 19:42:36 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the dense linear solver CVSDENSE. + * ----------------------------------------------------------------- + */ + +#ifndef _CVSDENSE_H +#define _CVSDENSE_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ----------------------------------------------------------------- + * Function: CVDense + * ----------------------------------------------------------------- + * A call to the CVDense function links the main integrator with + * the CVSDENSE linear solver. + * + * cvode_mem is the pointer to the integrator memory returned by + * CVodeCreate. + * + * N is the size of the ODE system. + * + * The return value of CVDense is one of: + * CVDLS_SUCCESS if successful + * CVDLS_MEM_NULL if the cvode memory was NULL + * CVDLS_MEM_FAIL if there was a memory allocation failure + * CVDLS_ILL_INPUT if a required vector operation is missing + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVDense(void *cvode_mem, int N); + +/* + * ----------------------------------------------------------------- + * Function: CVDenseB + * ----------------------------------------------------------------- + * CVDenseB links the main CVODE integrator with the CVSDENSE + * linear solver for the backward integration. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVDenseB(void *cvode_mem, int which, int nB); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_diag.h b/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_diag.h new file mode 100644 index 0000000..00bf2a0 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_diag.h @@ -0,0 +1,140 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.5 $ + * $Date: 2007/03/22 18:05:50 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the diagonal linear solver CVSDIAG. + * + * + * Part I contains type definitions and function prototypes for using + * CVDIAG on forward problems (IVP integration and/or FSA) + * + * Part II contains type definitions and function prototypes for using + * CVDIAG on adjoint (backward) problems + * ----------------------------------------------------------------- + */ + +#ifndef _CVSDIAG_H +#define _CVSDIAG_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ----------------------------------------------------------------- + * CVDIAG return values + * ----------------------------------------------------------------- + */ + +#define CVDIAG_SUCCESS 0 +#define CVDIAG_MEM_NULL -1 +#define CVDIAG_LMEM_NULL -2 +#define CVDIAG_ILL_INPUT -3 +#define CVDIAG_MEM_FAIL -4 + +/* Additional last_flag values */ + +#define CVDIAG_INV_FAIL -5 +#define CVDIAG_RHSFUNC_UNRECVR -6 +#define CVDIAG_RHSFUNC_RECVR -7 + +/* Return values for adjoint module */ + +#define CVDIAG_NO_ADJ -101 + +/* + * ----------------------------------------------------------------- + * PART I - forward problems + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * Function : CVDiag + * ----------------------------------------------------------------- + * A call to the CVDiag function links the main integrator with + * the CVDIAG linear solver. + * + * cvode_mem is the pointer to the integrator memory returned by + * CVodeCreate. + * + * The return value of CVDiag is one of: + * CVDIAG_SUCCESS if successful + * CVDIAG_MEM_NULL if the cvode memory was NULL + * CVDIAG_MEM_FAIL if there was a memory allocation failure + * CVDIAG_ILL_INPUT if a required vector operation is missing + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVDiag(void *cvode_mem); + +/* + * ----------------------------------------------------------------- + * Optional outputs from the CVDIAG linear solver + * ----------------------------------------------------------------- + * + * CVDiagGetWorkSpace returns the real and integer workspace used + * by CVDIAG. + * CVDiagGetNumRhsEvals returns the number of calls to the user + * f routine due to finite difference Jacobian + * evaluation. + * Note: The number of diagonal approximate + * Jacobians formed is equal to the number of + * CVDiagSetup calls. This number is available + * through CVodeGetNumLinSolvSetups. + * CVDiagGetLastFlag returns the last error flag set by any of + * the CVDIAG interface functions. + * + * The return value of CVDiagGet* is one of: + * CVDIAG_SUCCESS if successful + * CVDIAG_MEM_NULL if the cvode memory was NULL + * CVDIAG_LMEM_NULL if the cvdiag memory was NULL + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVDiagGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS); +SUNDIALS_EXPORT int CVDiagGetNumRhsEvals(void *cvode_mem, long int *nfevalsLS); +SUNDIALS_EXPORT int CVDiagGetLastFlag(void *cvode_mem, int *flag); + +/* + * ----------------------------------------------------------------- + * The following function returns the name of the constant + * associated with a CVDIAG return flag + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT char *CVDiagGetReturnFlagName(int flag); + +/* + * ----------------------------------------------------------------- + * PART II - backward problems + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * Function: CVDiagB + * ----------------------------------------------------------------- + * CVDiagB links the main CVODE integrator with the CVDIAG + * linear solver for the backward integration. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVDiagB(void *cvode_mem, int which); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_direct.h b/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_direct.h new file mode 100644 index 0000000..3c0366a --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_direct.h @@ -0,0 +1,366 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.7 $ + * $Date: 2008/04/18 19:42:37 $ + * ----------------------------------------------------------------- + * Programmer: Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2006, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * Common header file for the direct linear solvers in CVODES. + * + * Part I contains type definitions and function prototypes for + * using a CVDLS linear solver on forward problems (IVP + * integration and/or FSA) + * + * Part II contains type definitions and function prototypes for + * using a CVDLS linear solver on adjoint (backward) problems + * ----------------------------------------------------------------- + */ + +#ifndef _CVSDLS_H +#define _CVSDLS_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ================================================================= + * C V S D I R E C T C O N S T A N T S + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * CVSDIRECT return values + * ----------------------------------------------------------------- + */ + +#define CVDLS_SUCCESS 0 +#define CVDLS_MEM_NULL -1 +#define CVDLS_LMEM_NULL -2 +#define CVDLS_ILL_INPUT -3 +#define CVDLS_MEM_FAIL -4 + +/* Additional last_flag values */ + +#define CVDLS_JACFUNC_UNRECVR -5 +#define CVDLS_JACFUNC_RECVR -6 + +/* Return values for the adjoint module */ + +#define CVDLS_NO_ADJ -101 +#define CVDLS_LMEMB_NULL -102 + +/* + * ================================================================= + * PART I: F O R W A R D P R O B L E M S + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * FUNCTION TYPES + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * Type: CVDlsDenseJacFn + * ----------------------------------------------------------------- + * + * A dense Jacobian approximation function Jac must be of type + * CVDlsDenseJacFn. Its parameters are: + * + * N is the problem size. + * + * Jac is the dense matrix (of type DlsMat) that will be loaded + * by a CVDlsDenseJacFn with an approximation to the Jacobian + * matrix J = (df_i/dy_j) at the point (t,y). + * + * t is the current value of the independent variable. + * + * y is the current value of the dependent variable vector, + * namely the predicted value of y(t). + * + * fy is the vector f(t,y). + * + * user_data is a pointer to user data - the same as the user_data + * parameter passed to CVodeSetFdata. + * + * tmp1, tmp2, and tmp3 are pointers to memory allocated for + * vectors of length N which can be used by a CVDlsDenseJacFn + * as temporary storage or work space. + * + * A CVDlsDenseJacFn should return 0 if successful, a positive + * value if a recoverable error occurred, and a negative value if + * an unrecoverable error occurred. + * + * ----------------------------------------------------------------- + * + * NOTE: The following are two efficient ways to load a dense Jac: + * (1) (with macros - no explicit data structure references) + * for (j=0; j < Neq; j++) { + * col_j = DENSE_COL(Jac,j); + * for (i=0; i < Neq; i++) { + * generate J_ij = the (i,j)th Jacobian element + * col_j[i] = J_ij; + * } + * } + * (2) (without macros - explicit data structure references) + * for (j=0; j < Neq; j++) { + * col_j = (Jac->data)[j]; + * for (i=0; i < Neq; i++) { + * generate J_ij = the (i,j)th Jacobian element + * col_j[i] = J_ij; + * } + * } + * A third way, using the DENSE_ELEM(A,i,j) macro, is much less + * efficient in general. It is only appropriate for use in small + * problems in which efficiency of access is NOT a major concern. + * + * NOTE: If the user's Jacobian routine needs other quantities, + * they are accessible as follows: hcur (the current stepsize) + * and ewt (the error weight vector) are accessible through + * CVodeGetCurrentStep and CVodeGetErrWeights, respectively + * (see cvode.h). The unit roundoff is available as + * UNIT_ROUNDOFF defined in sundials_types.h. + * + * ----------------------------------------------------------------- + */ + + +typedef int (*CVDlsDenseJacFn)(int N, realtype t, + N_Vector y, N_Vector fy, + DlsMat Jac, void *user_data, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); + +/* + * ----------------------------------------------------------------- + * Type: CVDlsBandJacFn + * ----------------------------------------------------------------- + * + * A band Jacobian approximation function Jac must have the + * prototype given below. Its parameters are: + * + * N is the length of all vector arguments. + * + * mupper is the upper half-bandwidth of the approximate banded + * Jacobian. This parameter is the same as the mupper parameter + * passed by the user to the linear solver initialization function. + * + * mlower is the lower half-bandwidth of the approximate banded + * Jacobian. This parameter is the same as the mlower parameter + * passed by the user to the linear solver initialization function. + * + * t is the current value of the independent variable. + * + * y is the current value of the dependent variable vector, + * namely the predicted value of y(t). + * + * fy is the vector f(t,y). + * + * Jac is the band matrix (of type DlsMat) that will be loaded + * by a CVDlsBandJacFn with an approximation to the Jacobian matrix + * Jac = (df_i/dy_j) at the point (t,y). + * Three efficient ways to load J are: + * + * (1) (with macros - no explicit data structure references) + * for (j=0; j < n; j++) { + * col_j = BAND_COL(Jac,j); + * for (i=j-mupper; i <= j+mlower; i++) { + * generate J_ij = the (i,j)th Jacobian element + * BAND_COL_ELEM(col_j,i,j) = J_ij; + * } + * } + * + * (2) (with BAND_COL macro, but without BAND_COL_ELEM macro) + * for (j=0; j < n; j++) { + * col_j = BAND_COL(Jac,j); + * for (k=-mupper; k <= mlower; k++) { + * generate J_ij = the (i,j)th Jacobian element, i=j+k + * col_j[k] = J_ij; + * } + * } + * + * (3) (without macros - explicit data structure references) + * offset = Jac->smu; + * for (j=0; j < n; j++) { + * col_j = ((Jac->data)[j])+offset; + * for (k=-mupper; k <= mlower; k++) { + * generate J_ij = the (i,j)th Jacobian element, i=j+k + * col_j[k] = J_ij; + * } + * } + * Caution: Jac->smu is generally NOT the same as mupper. + * + * The BAND_ELEM(A,i,j) macro is appropriate for use in small + * problems in which efficiency of access is NOT a major concern. + * + * user_data is a pointer to user data - the same as the user_data + * parameter passed to CVodeSetFdata. + * + * NOTE: If the user's Jacobian routine needs other quantities, + * they are accessible as follows: hcur (the current stepsize) + * and ewt (the error weight vector) are accessible through + * CVodeGetCurrentStep and CVodeGetErrWeights, respectively + * (see cvode.h). The unit roundoff is available as + * UNIT_ROUNDOFF defined in sundials_types.h + * + * tmp1, tmp2, and tmp3 are pointers to memory allocated for + * vectors of length N which can be used by a CVDlsBandJacFn + * as temporary storage or work space. + * + * A CVDlsBandJacFn should return 0 if successful, a positive value + * if a recoverable error occurred, and a negative value if an + * unrecoverable error occurred. + * ----------------------------------------------------------------- + */ + +typedef int (*CVDlsBandJacFn)(int N, int mupper, int mlower, + realtype t, N_Vector y, N_Vector fy, + DlsMat Jac, void *user_data, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); + +/* + * ----------------------------------------------------------------- + * EXPORTED FUNCTIONS + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * Optional inputs to the CVDLS linear solver + * ----------------------------------------------------------------- + * + * CVDlsSetDenseJacFn specifies the dense Jacobian approximation + * routine to be used for a direct dense linear solver. + * + * CVDlsSetBandJacFn specifies the band Jacobian approximation + * routine to be used for a direct band linear solver. + * + * By default, a difference quotient approximation, supplied with + * the solver is used. + * + * The return value is one of: + * CVDLS_SUCCESS if successful + * CVDLS_MEM_NULL if the CVODE memory was NULL + * CVDLS_LMEM_NULL if the linear solver memory was NULL + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVDlsSetDenseJacFn(void *cvode_mem, CVDlsDenseJacFn jac); +SUNDIALS_EXPORT int CVDlsSetBandJacFn(void *cvode_mem, CVDlsBandJacFn jac); + +/* + * ----------------------------------------------------------------- + * Optional outputs from the CVSDIRECT linear solver + * ----------------------------------------------------------------- + * + * CVDlsGetWorkSpace returns the real and integer workspace used + * by the direct linear solver. + * CVDlsGetNumJacEvals returns the number of calls made to the + * Jacobian evaluation routine jac. + * CVDlsGetNumRhsEvals returns the number of calls to the user + * f routine due to finite difference Jacobian + * evaluation. + * CVDlsGetLastFlag returns the last error flag set by any of + * the CVSDIRECT interface functions. + * + * The return value of CVDlsGet* is one of: + * CVDLS_SUCCESS if successful + * CVDLS_MEM_NULL if the CVODES memory was NULL + * CVDLS_LMEM_NULL if the linear solver memory was NULL + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVDlsGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS); +SUNDIALS_EXPORT int CVDlsGetNumJacEvals(void *cvode_mem, long int *njevals); +SUNDIALS_EXPORT int CVDlsGetNumRhsEvals(void *cvode_mem, long int *nfevalsLS); +SUNDIALS_EXPORT int CVDlsGetLastFlag(void *cvode_mem, int *flag); + +/* + * ----------------------------------------------------------------- + * The following function returns the name of the constant + * associated with a CVSDIRECT return flag + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT char *CVDlsGetReturnFlagName(int flag); + +/* + * ================================================================= + * PART II: B A C K W A R D P R O B L E M S + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * FUNCTION TYPES + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * Type: CVDlsDenseJacFnB + * ----------------------------------------------------------------- + * A dense Jacobian approximation function jacB for the adjoint + * (backward) problem must have the prototype given below. + * ----------------------------------------------------------------- + */ + +typedef int (*CVDlsDenseJacFnB)(int nB, realtype t, + N_Vector y, + N_Vector yB, N_Vector fyB, + DlsMat JB, void *user_dataB, + N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); + +/* + * ----------------------------------------------------------------- + * Type : CVDlsBandJacFnB + * ----------------------------------------------------------------- + * A band Jacobian approximation function jacB for the adjoint + * (backward) problem must have the prototype given below. + * ----------------------------------------------------------------- + */ + +typedef int (*CVDlsBandJacFnB)(int nB, int mupperB, int mlowerB, + realtype t, + N_Vector y, + N_Vector yB, N_Vector fyB, + DlsMat JB, void *user_dataB, + N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); + +/* + * ----------------------------------------------------------------- + * EXPORTED FUNCTIONS + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * Functions: CVDlsSetJacFnB + * ----------------------------------------------------------------- + * CVDlsSetDenseJacFnB and CVDlsSetBandJacFnB specify the dense and + * band, respectively, Jacobian functions to be used by a + * CVSDIRECT linear solver for the bacward integration phase. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVDlsSetDenseJacFnB(void *cvode_mem, int which, + CVDlsDenseJacFnB jacB); +SUNDIALS_EXPORT int CVDlsSetBandJacFnB(void *cvode_mem, int which, + CVDlsBandJacFnB jacB); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_lapack.h b/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_lapack.h new file mode 100644 index 0000000..20eedf8 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_lapack.h @@ -0,0 +1,103 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.6 $ + * $Date: 2008/04/18 19:42:37 $ + * ----------------------------------------------------------------- + * Programmer: Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2006, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * Header file for the CVODES dense linear solver CVSLAPACK. + * ----------------------------------------------------------------- + */ + +#ifndef _CVSLAPACK_H +#define _CVSLAPACK_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ----------------------------------------------------------------- + * Function: CVLapackDense + * ----------------------------------------------------------------- + * A call to the CVLapackDense function links the main integrator + * with the CVSLAPACK linear solver using dense Jacobians. + * + * cvode_mem is the pointer to the integrator memory returned by + * CVodeCreate. + * + * N is the size of the ODE system. + * + * The return value of CVLapackDense is one of: + * CVDLS_SUCCESS if successful + * CVDLS_MEM_NULL if the CVODES memory was NULL + * CVDLS_MEM_FAIL if there was a memory allocation failure + * CVDLS_ILL_INPUT if a required vector operation is missing + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVLapackDense(void *cvode_mem, int N); + +/* + * ----------------------------------------------------------------- + * Function: CVLapackBand + * ----------------------------------------------------------------- + * A call to the CVLapackBand function links the main integrator + * with the CVSLAPACK linear solver using banded Jacobians. + * + * cvode_mem is the pointer to the integrator memory returned by + * CVodeCreate. + * + * N is the size of the ODE system. + * + * mupper is the upper bandwidth of the band Jacobian approximation. + * + * mlower is the lower bandwidth of the band Jacobian approximation. + * + * The return value of CVLapackBand is one of: + * CVDLS_SUCCESS if successful + * CVDLS_MEM_NULL if the CVODES memory was NULL + * CVDLS_MEM_FAIL if there was a memory allocation failure + * CVDLS_ILL_INPUT if a required vector operation is missing or + * if a bandwidth has an illegal value. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVLapackBand(void *cvode_mem, int N, int mupper, int mlower); + +/* + * ----------------------------------------------------------------- + * Function: CVLapackDenseB + * ----------------------------------------------------------------- + * CVLapackDenseB links the main CVODE integrator with the dense + * CVSLAPACK linear solver for the backward integration. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVLapackDenseB(void *cvode_mem, int which, int nB); + +/* + * ----------------------------------------------------------------- + * Function: CVLapackBandB + * ----------------------------------------------------------------- + * CVLapackBandB links the main CVODE integrator with the band + * CVSLAPACK linear solver for the backward integration. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVLapackBandB(void *cvode_mem, int which, + int nB, int mupperB, int mlowerB); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_spbcgs.h b/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_spbcgs.h new file mode 100644 index 0000000..acc56c9 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_spbcgs.h @@ -0,0 +1,87 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.4 $ + * $Date: 2007/03/22 18:05:50 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the CVODES scaled preconditioned + * Bi-CGSTAB linear solver, CVSPBCG. + * + * Part I contains function prototypes for using CVSPBCG on forward + * problems (IVP integration and/or FSA) + * + * Part II contains function prototypes for using CVSPBCG on adjoint + * (backward) problems + * ----------------------------------------------------------------- + */ + +#ifndef _CVSSPBCG_H +#define _CVSSPBCG_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ----------------------------------------------------------------- + * PART I - forward problems + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * Function : CVSpbcg + * ----------------------------------------------------------------- + * A call to the CVSpbcg function links the main CVODE integrator + * with the CVSPBCG linear solver. + * + * cvode_mem is the pointer to the integrator memory returned by + * CVodeCreate. + * + * pretype is the type of user preconditioning to be done. + * This must be one of the four enumeration constants + * PREC_NONE, PREC_LEFT, PREC_RIGHT, or PREC_BOTH defined + * in iterative.h. These correspond to no preconditioning, + * left preconditioning only, right preconditioning + * only, and both left and right preconditioning, + * respectively. + * + * maxl is the maximum Krylov dimension. This is an + * optional input to the CVSPBCG solver. Pass 0 to + * use the default value CVSPILS_MAXL=5. + * + * The return value of CVSpbcg is one of: + * CVSPILS_SUCCESS if successful + * CVSPILS_MEM_NULL if the cvode memory was NULL + * CVSPILS_MEM_FAIL if there was a memory allocation failure + * CVSPILS_ILL_INPUT if a required vector operation is missing + * The above constants are defined in cvodes_spils.h + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVSpbcg(void *cvode_mem, int pretype, int maxl); + +/* + * ----------------------------------------------------------------- + * PART II - backward problems + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVSpbcgB(void *cvode_mem, int which, + int pretypeB, int maxlB); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_spgmr.h b/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_spgmr.h new file mode 100644 index 0000000..73f2420 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_spgmr.h @@ -0,0 +1,88 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.4 $ + * $Date: 2007/03/22 18:05:50 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the CVODES scaled preconditioned + * GMRES linear solver, CVSPGMR. + * + * Part I contains function prototypes for using CVSPGMR on forward + * problems (IVP integration and/or FSA) + * + * Part II contains function prototypes for using CVSPGMR on adjoint + * (backward) problems + * ----------------------------------------------------------------- + */ + +#ifndef _CVSSPGMR_H +#define _CVSSPGMR_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ----------------------------------------------------------------- + * PART I - forward problems + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * Function : CVSpgmr + * ----------------------------------------------------------------- + * A call to the CVSpgmr function links the main CVODE integrator + * with the CVSPGMR linear solver. + * + * cvode_mem is the pointer to the integrator memory returned by + * CVodeCreate. + * + * pretype is the type of user preconditioning to be done. + * This must be one of the four enumeration constants + * NONE, LEFT, RIGHT, or BOTH defined in iterative.h. + * These correspond to no preconditioning, + * left preconditioning only, right preconditioning + * only, and both left and right preconditioning, + * respectively. + * + * maxl is the maximum Krylov dimension. This is an + * optional input to the CVSPGMR solver. Pass 0 to + * use the default value CVSPILS_MAXL=5. + * + * The return value of CVSpgmr is one of: + * CVSPILS_SUCCESS if successful + * CVSPILS_MEM_NULL if the cvode memory was NULL + * CVSPILS_MEM_FAIL if there was a memory allocation failure + * CVSPILS_ILL_INPUT if a required vector operation is missing + * The above constants are defined in cvodes_spils.h + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVSpgmr(void *cvode_mem, int pretype, int maxl); + +/* + * ----------------------------------------------------------------- + * PART II - backward problems + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVSpgmrB(void *cvode_mem, int which, + int pretypeB, int maxlB); + + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_spils.h b/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_spils.h new file mode 100644 index 0000000..928a1ef --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_spils.h @@ -0,0 +1,450 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.11 $ + * $Date: 2008/09/03 20:24:48 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the common header file for the Scaled, Preconditioned + * Iterative Linear Solvers in CVODES. + * + * Part I contains type definitions and functions for using the + * iterative linear solvers on forward problems + * (IVP integration and/or FSA) + * + * Part II contains type definitions and functions for using the + * iterative linear solvers on adjoint (backward) problems + * ----------------------------------------------------------------- + */ + +#ifndef _CVSSPILS_H +#define _CVSSPILS_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ----------------------------------------------------------------- + * CVSPILS return values + * ----------------------------------------------------------------- + */ + +#define CVSPILS_SUCCESS 0 +#define CVSPILS_MEM_NULL -1 +#define CVSPILS_LMEM_NULL -2 +#define CVSPILS_ILL_INPUT -3 +#define CVSPILS_MEM_FAIL -4 +#define CVSPILS_PMEM_NULL -5 + +/* Return values for the adjoint module */ + +#define CVSPILS_NO_ADJ -101 +#define CVSPILS_LMEMB_NULL -102 + +/* + * ----------------------------------------------------------------- + * CVSPILS solver constants + * ----------------------------------------------------------------- + * CVSPILS_MAXL : default value for the maximum Krylov + * dimension + * + * CVSPILS_MSBPRE : maximum number of steps between + * preconditioner evaluations + * + * CVSPILS_DGMAX : maximum change in gamma between + * preconditioner evaluations + * + * CVSPILS_EPLIN : default value for factor by which the + * tolerance on the nonlinear iteration is + * multiplied to get a tolerance on the linear + * iteration + * ----------------------------------------------------------------- + */ + +#define CVSPILS_MAXL 5 +#define CVSPILS_MSBPRE 50 +#define CVSPILS_DGMAX RCONST(0.2) +#define CVSPILS_EPLIN RCONST(0.05) + +/* + * ----------------------------------------------------------------- + * PART I - forward problems + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * Type : CVSpilsPrecSetupFn + * ----------------------------------------------------------------- + * The user-supplied preconditioner setup function PrecSetup and + * the user-supplied preconditioner solve function PrecSolve + * together must define left and right preconditoner matrices + * P1 and P2 (either of which may be trivial), such that the + * product P1*P2 is an approximation to the Newton matrix + * M = I - gamma*J. Here J is the system Jacobian J = df/dy, + * and gamma is a scalar proportional to the integration step + * size h. The solution of systems P z = r, with P = P1 or P2, + * is to be carried out by the PrecSolve function, and PrecSetup + * is to do any necessary setup operations. + * + * The user-supplied preconditioner setup function PrecSetup + * is to evaluate and preprocess any Jacobian-related data + * needed by the preconditioner solve function PrecSolve. + * This might include forming a crude approximate Jacobian, + * and performing an LU factorization on the resulting + * approximation to M. This function will not be called in + * advance of every call to PrecSolve, but instead will be called + * only as often as necessary to achieve convergence within the + * Newton iteration. If the PrecSolve function needs no + * preparation, the PrecSetup function can be NULL. + * + * For greater efficiency, the PrecSetup function may save + * Jacobian-related data and reuse it, rather than generating it + * from scratch. In this case, it should use the input flag jok + * to decide whether to recompute the data, and set the output + * flag *jcurPtr accordingly. + * + * Each call to the PrecSetup function is preceded by a call to + * the RhsFn f with the same (t,y) arguments. Thus the PrecSetup + * function can use any auxiliary data that is computed and + * saved by the f function and made accessible to PrecSetup. + * + * A function PrecSetup must have the prototype given below. + * Its parameters are as follows: + * + * t is the current value of the independent variable. + * + * y is the current value of the dependent variable vector, + * namely the predicted value of y(t). + * + * fy is the vector f(t,y). + * + * jok is an input flag indicating whether Jacobian-related + * data needs to be recomputed, as follows: + * jok == FALSE means recompute Jacobian-related data + * from scratch. + * jok == TRUE means that Jacobian data, if saved from + * the previous PrecSetup call, can be reused + * (with the current value of gamma). + * A Precset call with jok == TRUE can only occur after + * a call with jok == FALSE. + * + * jcurPtr is a pointer to an output integer flag which is + * to be set by PrecSetup as follows: + * Set *jcurPtr = TRUE if Jacobian data was recomputed. + * Set *jcurPtr = FALSE if Jacobian data was not recomputed, + * but saved data was reused. + * + * gamma is the scalar appearing in the Newton matrix. + * + * user_data is a pointer to user data - the same as the user_data + * parameter passed to the CVodeSetUserData function. + * + * tmp1, tmp2, and tmp3 are pointers to memory allocated + * for N_Vectors which can be used by + * CVSpilsPrecSetupFn as temporary storage or + * work space. + * + * NOTE: If the user's preconditioner needs other quantities, + * they are accessible as follows: hcur (the current stepsize) + * and ewt (the error weight vector) are accessible through + * CVodeGetCurrentStep and CVodeGetErrWeights, respectively). + * The unit roundoff is available as UNIT_ROUNDOFF defined in + * sundials_types.h. + * + * Returned value: + * The value to be returned by the PrecSetup function is a flag + * indicating whether it was successful. This value should be + * 0 if successful, + * > 0 for a recoverable error (step will be retried), + * < 0 for an unrecoverable error (integration is halted). + * ----------------------------------------------------------------- + */ + +typedef int (*CVSpilsPrecSetupFn)(realtype t, N_Vector y, N_Vector fy, + booleantype jok, booleantype *jcurPtr, + realtype gamma, void *user_data, + N_Vector tmp1, N_Vector tmp2, + N_Vector tmp3); + +/* + * ----------------------------------------------------------------- + * Type : CVSpilsPrecSolveFn + * ----------------------------------------------------------------- + * The user-supplied preconditioner solve function PrecSolve + * is to solve a linear system P z = r in which the matrix P is + * one of the preconditioner matrices P1 or P2, depending on the + * type of preconditioning chosen. + * + * A function PrecSolve must have the prototype given below. + * Its parameters are as follows: + * + * t is the current value of the independent variable. + * + * y is the current value of the dependent variable vector. + * + * fy is the vector f(t,y). + * + * r is the right-hand side vector of the linear system. + * + * z is the output vector computed by PrecSolve. + * + * gamma is the scalar appearing in the Newton matrix. + * + * delta is an input tolerance for use by PSolve if it uses + * an iterative method in its solution. In that case, + * the residual vector Res = r - P z of the system + * should be made less than delta in weighted L2 norm, + * i.e., sqrt [ Sum (Res[i]*ewt[i])^2 ] < delta. + * Note: the error weight vector ewt can be obtained + * through a call to the routine CVodeGetErrWeights. + * + * lr is an input flag indicating whether PrecSolve is to use + * the left preconditioner P1 or right preconditioner + * P2: lr = 1 means use P1, and lr = 2 means use P2. + * + * user_data is a pointer to user data - the same as the user_data + * parameter passed to the CVodeSetUserData function. + * + * tmp is a pointer to memory allocated for an N_Vector + * which can be used by PSolve for work space. + * + * Returned value: + * The value to be returned by the PrecSolve function is a flag + * indicating whether it was successful. This value should be + * 0 if successful, + * positive for a recoverable error (step will be retried), + * negative for an unrecoverable error (integration is halted). + * ----------------------------------------------------------------- + */ + +typedef int (*CVSpilsPrecSolveFn)(realtype t, N_Vector y, N_Vector fy, + N_Vector r, N_Vector z, + realtype gamma, realtype delta, + int lr, void *user_data, N_Vector tmp); + +/* + * ----------------------------------------------------------------- + * Type : CVSpilsJacTimesVecFn + * ----------------------------------------------------------------- + * The user-supplied function jtimes is to generate the product + * J*v for given v, where J is the Jacobian df/dy, or an + * approximation to it, and v is a given vector. It should return + * 0 if successful a positive value for a recoverable error or + * a negative value for an unrecoverable failure. + * + * A function jtimes must have the prototype given below. Its + * parameters are as follows: + * + * v is the N_Vector to be multiplied by J. + * + * Jv is the output N_Vector containing J*v. + * + * t is the current value of the independent variable. + * + * y is the current value of the dependent variable + * vector. + * + * fy is the vector f(t,y). + * + * user_data is a pointer to user data, the same as the user_data + * parameter passed to the CVodeSetUserData function. + * + * tmp is a pointer to memory allocated for an N_Vector + * which can be used by Jtimes for work space. + * ----------------------------------------------------------------- + */ + +typedef int (*CVSpilsJacTimesVecFn)(N_Vector v, N_Vector Jv, realtype t, + N_Vector y, N_Vector fy, + void *user_data, N_Vector tmp); + + +/* + * ----------------------------------------------------------------- + * Optional inputs to the CVSPILS linear solver + * ----------------------------------------------------------------- + * + * CVSpilsSetPrecType resets the type of preconditioner, pretype, + * from the value previously set. + * This must be one of PREC_NONE, PREC_LEFT, + * PREC_RIGHT, or PREC_BOTH. + * + * CVSpilsSetGSType specifies the type of Gram-Schmidt + * orthogonalization to be used. This must be one of + * the two enumeration constants MODIFIED_GS or + * CLASSICAL_GS defined in iterative.h. These correspond + * to using modified Gram-Schmidt and classical + * Gram-Schmidt, respectively. + * Default value is MODIFIED_GS. + * + * CVSpilsSetMaxl resets the maximum Krylov subspace size, maxl, + * from the value previously set. + * An input value <= 0, gives the default value. + * + * CVSpilsSetEpsLin specifies the factor by which the tolerance on + * the nonlinear iteration is multiplied to get a + * tolerance on the linear iteration. + * Default value is 0.05. + * + * CVSpilsSetPreconditioner specifies the PrecSetup and PrecSolve functions. + * Default is NULL for both arguments (no preconditioning). + * + * CVSpilsSetJacTimesVecFn specifies the jtimes function. Default is to use + * an internal finite difference approximation routine. + * + * The return value of CVSpilsSet* is one of: + * CVSPILS_SUCCESS if successful + * CVSPILS_MEM_NULL if the cvode memory was NULL + * CVSPILS_LMEM_NULL if the linear solver memory was NULL + * CVSPILS_ILL_INPUT if an input has an illegal value + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVSpilsSetPrecType(void *cvode_mem, int pretype); +SUNDIALS_EXPORT int CVSpilsSetGSType(void *cvode_mem, int gstype); +SUNDIALS_EXPORT int CVSpilsSetMaxl(void *cvode_mem, int maxl); +SUNDIALS_EXPORT int CVSpilsSetEpsLin(void *cvode_mem, realtype eplifac); +SUNDIALS_EXPORT int CVSpilsSetPreconditioner(void *cvode_mem, + CVSpilsPrecSetupFn pset, + CVSpilsPrecSolveFn psolve); +SUNDIALS_EXPORT int CVSpilsSetJacTimesVecFn(void *cvode_mem, + CVSpilsJacTimesVecFn jtv); + +/* + * ----------------------------------------------------------------- + * Optional outputs from the CVSPILS linear solver + * ----------------------------------------------------------------- + * CVSpilsGetWorkSpace returns the real and integer workspace used + * by the SPILS module. + * + * CVSpilsGetNumPrecEvals returns the number of preconditioner + * evaluations, i.e. the number of calls made + * to PrecSetup with jok==FALSE. + * + * CVSpilsGetNumPrecSolves returns the number of calls made to + * PrecSolve. + * + * CVSpilsGetNumLinIters returns the number of linear iterations. + * + * CVSpilsGetNumConvFails returns the number of linear + * convergence failures. + * + * CVSpilsGetNumJtimesEvals returns the number of calls to jtimes. + * + * CVSpilsGetNumRhsEvals returns the number of calls to the user + * f routine due to finite difference Jacobian + * times vector evaluation. + * + * CVSpilsGetLastFlag returns the last error flag set by any of + * the CVSPILS interface functions. + * + * The return value of CVSpilsGet* is one of: + * CVSPILS_SUCCESS if successful + * CVSPILS_MEM_NULL if the cvode memory was NULL + * CVSPILS_LMEM_NULL if the linear solver memory was NULL + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVSpilsGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS); +SUNDIALS_EXPORT int CVSpilsGetNumPrecEvals(void *cvode_mem, long int *npevals); +SUNDIALS_EXPORT int CVSpilsGetNumPrecSolves(void *cvode_mem, long int *npsolves); +SUNDIALS_EXPORT int CVSpilsGetNumLinIters(void *cvode_mem, long int *nliters); +SUNDIALS_EXPORT int CVSpilsGetNumConvFails(void *cvode_mem, long int *nlcfails); +SUNDIALS_EXPORT int CVSpilsGetNumJtimesEvals(void *cvode_mem, long int *njvevals); +SUNDIALS_EXPORT int CVSpilsGetNumRhsEvals(void *cvode_mem, long int *nfevalsLS); +SUNDIALS_EXPORT int CVSpilsGetLastFlag(void *cvode_mem, int *flag); + +/* + * ----------------------------------------------------------------- + * The following function returns the name of the constant + * associated with a CVSPILS return flag + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT char *CVSpilsGetReturnFlagName(int flag); + + +/* + * ----------------------------------------------------------------- + * PART II - backward problems + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * Type : CVSpilsPrecSetupFnB + * ----------------------------------------------------------------- + * A function PrecSetupB for the adjoint (backward) problem must have + * the prototype given below. + * ----------------------------------------------------------------- + */ + +typedef int (*CVSpilsPrecSetupFnB)(realtype t, N_Vector y, + N_Vector yB, N_Vector fyB, + booleantype jokB, + booleantype *jcurPtrB, realtype gammaB, + void *user_dataB, + N_Vector tmp1B, N_Vector tmp2B, + N_Vector tmp3B); + + +/* + * ----------------------------------------------------------------- + * Type : CVSpilsPrecSolveFnB + * ----------------------------------------------------------------- + * A function PrecSolveB for the adjoint (backward) problem must + * have the prototype given below. + * ----------------------------------------------------------------- + */ + +typedef int (*CVSpilsPrecSolveFnB)(realtype t, N_Vector y, + N_Vector yB, N_Vector fyB, + N_Vector rB, N_Vector zB, + realtype gammaB, realtype deltaB, + int lrB, void *user_dataB, N_Vector tmpB); + +/* + * ----------------------------------------------------------------- + * Type : CVSpilsJacTimesVecFnB + * ----------------------------------------------------------------- + * A function jtimesB for the adjoint (backward) problem must have + * the prototype given below. + * ----------------------------------------------------------------- + */ + +typedef int (*CVSpilsJacTimesVecFnB)(N_Vector vB, N_Vector JvB, realtype t, + N_Vector y, N_Vector yB, N_Vector fyB, + void *jac_dataB, N_Vector tmpB); + +/* + * ----------------------------------------------------------------- + * Functions + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVSpilsSetPrecTypeB(void *cvode_mem, int which, int pretypeB); +SUNDIALS_EXPORT int CVSpilsSetGSTypeB(void *cvode_mem, int which, int gstypeB); +SUNDIALS_EXPORT int CVSpilsSetEpslinB(void *cvode_mem, int which, realtype eplifacB); +SUNDIALS_EXPORT int CVSpilsSetMaxlB(void *cvode_mem, int which, int maxlB); +SUNDIALS_EXPORT int CVSpilsSetPreconditionerB(void *cvode_mem, int which, + CVSpilsPrecSetupFnB psetB, + CVSpilsPrecSolveFnB psolveB); +SUNDIALS_EXPORT int CVSpilsSetJacTimesVecFnB(void *cvode_mem, int which, + CVSpilsJacTimesVecFnB jtvB); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_sptfqmr.h b/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_sptfqmr.h new file mode 100644 index 0000000..2b91a3a --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/cvodes/cvodes_sptfqmr.h @@ -0,0 +1,88 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.4 $ + * $Date: 2007/03/22 18:05:50 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the CVODES scaled preconditioned TFQMR + * linear solver, CVSPTFQMR. + * + * Part I contains function prototypes for using CVSPTFQMR on forward + * problems (IVP integration and/or FSA) + * + * Part II contains function prototypes for using CVSPTFQMR on adjoint + * (backward) problems + * ----------------------------------------------------------------- + */ + +#ifndef _CVSSPTFQMR_H +#define _CVSSPTFQMR_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ----------------------------------------------------------------- + * PART I - forward problems + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * Function : CVSptfqmr + * ----------------------------------------------------------------- + * A call to the CVSptfqmr function links the main CVODE integrator + * with the CVSPTFQMR linear solver. + * + * cvode_mem is the pointer to the integrator memory returned by + * CVodeCreate. + * + * pretype is the type of user preconditioning to be done. + * This must be one of the four enumeration constants + * PREC_NONE, PREC_LEFT, PREC_RIGHT, or PREC_BOTH defined + * in iterative.h. These correspond to no preconditioning, + * left preconditioning only, right preconditioning + * only, and both left and right preconditioning, + * respectively. + * + * maxl is the maximum Krylov dimension. This is an + * optional input to the CVSPTFQMR solver. Pass 0 to + * use the default value CVSPILS_MAXL=5. + * + * The return value of CVSptfqmr is one of: + * CVSPILS_SUCCESS if successful + * CVSPILS_MEM_NULL if the cvode memory was NULL + * CVSPILS_MEM_FAIL if there was a memory allocation failure + * CVSPILS_ILL_INPUT if a required vector operation is missing + * The above constants are defined in cvodes_spils.h + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVSptfqmr(void *cvode_mem, int pretype, int maxl); + + +/* + * ----------------------------------------------------------------- + * PART II - backward problems + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVSptfqmrB(void *cvode_mem, int which, + int pretypeB, int maxlB); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/cvodes_band.h b/odemex/Parser/CVode/cv_src/include/cvodes_band.h new file mode 100644 index 0000000..fc3ce44 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/cvodes_band.h @@ -0,0 +1,72 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.7 $ + * $Date: 2008/04/18 19:42:36 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the band linear solver CSVBAND. + * ----------------------------------------------------------------- + */ + +#ifndef _CVSBAND_H +#define _CVSBAND_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ----------------------------------------------------------------- + * Function : CVBand + * ----------------------------------------------------------------- + * A call to the CVBand function links the main CVODE integrator + * with the CVSBAND linear solver. + * + * cvode_mem is the pointer to the integrator memory returned by + * CVodeCreate. + * + * N is the size of the ODE system. + * + * mupper is the upper bandwidth of the band Jacobian + * approximation. + * + * mlower is the lower bandwidth of the band Jacobian + * approximation. + * + * The return value of CVBand is one of: + * CVDLS_SUCCESS if successful + * CVDLS_MEM_NULL if the cvode memory was NULL + * CVDLS_MEM_FAIL if there was a memory allocation failure + * CVDLS_ILL_INPUT if a required vector operation is missing or + * if a bandwidth has an illegal value. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVBand(void *cvode_mem, int N, int mupper, int mlower); + +/* + * ----------------------------------------------------------------- + * Function: CVBandB + * ----------------------------------------------------------------- + * CVBandB links the main CVODE integrator with the CVSBAND + * linear solver for the backward integration. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVBandB(void *cvode_mem, int which, + int nB, int mupperB, int mlowerB); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/cvodes_bandpre.h b/odemex/Parser/CVode/cv_src/include/cvodes_bandpre.h new file mode 100644 index 0000000..966fdc3 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/cvodes_bandpre.h @@ -0,0 +1,179 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.7 $ + * $Date: 2007/11/26 16:19:58 $ + * ----------------------------------------------------------------- + * Programmer: Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the CVSBANDPRE module, which + * provides a banded difference quotient Jacobian-based + * preconditioner and solver routines for use with CVSPGMR, + * CVSPBCG, or CVSPTFQMR. + * + * Part I contains type definitions and function prototypes for using + * CVSBANDPRE on forward problems (IVP integration and/or FSA) + * + * Part II contains type definitions and function prototypes for using + * CVSBANDPRE on adjopint (backward) problems + * ----------------------------------------------------------------- + */ + +#ifndef _CVSBANDPRE_H +#define _CVSBANDPRE_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ================================================================= + * PART I - forward problems + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * + * SUMMARY + * + * These routines provide a band matrix preconditioner based on + * difference quotients of the ODE right-hand side function f. + * The user supplies parameters + * mu = upper half-bandwidth (number of super-diagonals) + * ml = lower half-bandwidth (number of sub-diagonals) + * The routines generate a band matrix of bandwidth ml + mu + 1 + * and use this to form a preconditioner for use with the Krylov + * linear solver in CVSP*. Although this matrix is intended to + * approximate the Jacobian df/dy, it may be a very crude + * approximation. The true Jacobian need not be banded, or its + * true bandwith may be larger than ml + mu + 1, as long as the + * banded approximation generated here is sufficiently accurate + * to speed convergence as a preconditioner. + * + * Usage: + * The following is a summary of the usage of this module. + * Details of the calls to CVodeCreate, CVodeMalloc, CVSp*, + * and CVode are available in the User Guide. + * To use these routines, the sequence of calls in the user + * main program should be as follows: + * + * #include + * #include + * ... + * Set y0 + * ... + * cvode_mem = CVodeCreate(...); + * ier = CVodeMalloc(...); + * ... + * flag = CVSptfqmr(cvode_mem, pretype, maxl); + * -or- + * flag = CVSpgmr(cvode_mem, pretype, maxl); + * -or- + * flag = CVSpbcg(cvode_mem, pretype, maxl); + * ... + * flag = CVBandPrecInit(cvode_mem, N, mu, ml); + * ... + * flag = CVode(...); + * ... + * Free y0 + * ... + * CVodeFree(&cvode_mem); + * + * Notes: + * (1) Include this file for the CVBandPrecData type definition. + * (2) In the CVBandPrecInit call, the arguments N is the + * problem dimension. + * (3) In the CVBPSp* call, the user is free to specify + * the input pretype and the optional input maxl. + * ----------------------------------------------------------------- + */ + + +/* + * ----------------------------------------------------------------- + * Function : CVBandPrecInit + * ----------------------------------------------------------------- + * CVBandPrecInit allocates and initializes the BANDPRE preconditioner + * module. This functino must be called AFTER one of the SPILS linear + * solver modules has been attached to the CVODE integrator. + * + * The parameters of CVBandPrecInit are as follows: + * + * cvode_mem is the pointer to CVODE memory returned by CVodeCreate. + * + * N is the problem size. + * + * mu is the upper half bandwidth. + * + * ml is the lower half bandwidth. + * + * The return value of CVBandPrecInit is one of: + * CVSPILS_SUCCESS if no errors occurred + * CVSPILS_MEM_NULL if the integrator memory is NULL + * CVSPILS_LMEM_NULL if the linear solver memory is NULL + * CVSPILS_ILL_INPUT if an input has an illegal value + * CVSPILS_MEM_FAIL if a memory allocation request failed + * + * NOTE: The band preconditioner assumes a serial implementation + * of the NVECTOR package. Therefore, CVBandPrecInit will + * first test for a compatible N_Vector internal + * representation by checking for required functions. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVBandPrecInit(void *cvode_mem, int N, int mu, int ml); + +/* + * ----------------------------------------------------------------- + * Optional output functions : CVBandPrecGet* + * ----------------------------------------------------------------- + * CVBandPrecGetWorkSpace returns the real and integer work space used + * by CVBANDPRE. + * CVBandPrecGetNumRhsEvals returns the number of calls made from + * CVBANDPRE to the user's right-hand side + * routine f. + * + * The return value of CVBandPrecGet* is one of: + * CVSPILS_SUCCESS if no errors occurred + * CVSPILS_MEM_NULL if the integrator memory is NULL + * CVSPILS_LMEM_NULL if the linear solver memory is NULL + * CVSPILS_PMEM_NULL if the preconditioner memory is NULL + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVBandPrecGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS); +SUNDIALS_EXPORT int CVBandPrecGetNumRhsEvals(void *cvode_mem, long int *nfevalsBP); + +/* + * ================================================================= + * PART II - backward problems + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Functions: CVBandPrecInitB, CVBPSp*B + * ----------------------------------------------------------------- + * Interface functions for the CVBANDPRE preconditioner to be used + * on the backward phase. + * + * CVBandPrecInitB interfaces to the CVBANDPRE preconditioner + * for the backward integration. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVBandPrecInitB(void *cvode_mem, int which, + int nB, int muB, int mlB); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/cvodes_bbdpre.h b/odemex/Parser/CVode/cv_src/include/cvodes_bbdpre.h new file mode 100644 index 0000000..5792794 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/cvodes_bbdpre.h @@ -0,0 +1,331 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.10 $ + * $Date: 2007/11/26 16:19:58 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the CVBBDPRE module, for a + * band-block-diagonal preconditioner, i.e. a block-diagonal + * matrix with banded blocks, for use with CVSPGMR/CVSPBCG/CVSPTFQMR, + * and the parallel implementation of the NVECTOR module. + * + * + * Part I contains type definitions and function prototypes for using + * CVBBDPRE on forward problems (IVP integration and/or FSA) + * + * Part II contains type definitions and function prototypes for using + * CVBBDPRE on adjopint (backward) problems + * ----------------------------------------------------------------- + */ + +#ifndef _CVSBBDPRE_H +#define _CVSBBDPRE_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ================================================================= + * PART I - forward problems + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * + * SUMMARY + * + * These routines provide a preconditioner matrix that is + * block-diagonal with banded blocks. The blocking corresponds + * to the distribution of the dependent variable vector y among + * the processors. Each preconditioner block is generated from + * the Jacobian of the local part (on the current processor) of a + * given function g(t,y) approximating f(t,y). The blocks are + * generated by a difference quotient scheme on each processor + * independently. This scheme utilizes an assumed banded + * structure with given half-bandwidths, mudq and mldq. + * However, the banded Jacobian block kept by the scheme has + * half-bandwiths mukeep and mlkeep, which may be smaller. + * + * The user's calling program should have the following form: + * + * #include + * #include + * ... + * void *cvode_mem; + * ... + * Set y0 + * ... + * cvode_mem = CVodeCreate(...); + * ier = CVodeMalloc(...); + * ... + * flag = CVSpgmr(cvode_mem, pretype, maxl); + * -or- + * flag = CVSpbcg(cvode_mem, pretype, maxl); + * -or- + * flag = CVSptfqmr(cvode_mem, pretype, maxl); + * ... + * flag = CVBBDPrecInit(cvode_mem, Nlocal, mudq ,mldq, + * mukeep, mlkeep, dqrely, gloc, cfn); + * ... + * ier = CVode(...); + * ... + * CVodeFree(&cvode_mem); + * + * Free y0 + * + * The user-supplied routines required are: + * + * f = function defining the ODE right-hand side f(t,y). + * + * gloc = function defining the approximation g(t,y). + * + * cfn = function to perform communication need for gloc. + * + * Notes: + * + * 1) This header file is included by the user for the definition + * of the CVBBDData type and for needed function prototypes. + * + * 2) The CVBBDPrecInit call includes half-bandwiths mudq and mldq + * to be used in the difference quotient calculation of the + * approximate Jacobian. They need not be the true + * half-bandwidths of the Jacobian of the local block of g, + * when smaller values may provide a greater efficiency. + * Also, the half-bandwidths mukeep and mlkeep of the retained + * banded approximate Jacobian block may be even smaller, + * to reduce storage and computation costs further. + * For all four half-bandwidths, the values need not be the + * same on every processor. + * + * 3) The actual name of the user's f function is passed to + * CVodeInit, and the names of the user's gloc and cfn + * functions are passed to CVBBDPrecInit. + * + * 4) The pointer to the user-defined data block user_data, which is + * set through CVodeSetUserData is also available to the user in + * gloc and cfn. + * + * 5) Optional outputs specific to this module are available by + * way of routines listed below. These include work space sizes + * and the cumulative number of gloc calls. The costs + * associated with this module also include nsetups banded LU + * factorizations, nlinsetups cfn calls, and npsolves banded + * backsolve calls, where nlinsetups and npsolves are + * integrator/CVSPGMR/CVSPBCG/CVSPTFQMR optional outputs. + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * Type : CVLocalFn + * ----------------------------------------------------------------- + * The user must supply a function g(t,y) which approximates the + * right-hand side function f for the system y'=f(t,y), and which + * is computed locally (without interprocess communication). + * (The case where g is mathematically identical to f is allowed.) + * The implementation of this function must have type CVLocalFn. + * + * This function takes as input the local vector size Nlocal, the + * independent variable value t, the local real dependent + * variable vector y, and a pointer to the user-defined data + * block user_data. It is to compute the local part of g(t,y) and + * store this in the vector g. + * (Allocation of memory for y and g is handled within the + * preconditioner module.) + * The user_data parameter is the same as that specified by the user + * through the CVodeSetFdata routine. + * + * A CVLocalFn should return 0 if successful, a positive value if + * a recoverable error occurred, and a negative value if an + * unrecoverable error occurred. + * ----------------------------------------------------------------- + */ + +typedef int (*CVLocalFn)(int Nlocal, realtype t, + N_Vector y, N_Vector g, void *user_data); + +/* + * ----------------------------------------------------------------- + * Type : CVCommFn + * ----------------------------------------------------------------- + * The user may supply a function of type CVCommFn which performs + * all interprocess communication necessary to evaluate the + * approximate right-hand side function described above. + * + * This function takes as input the local vector size Nlocal, + * the independent variable value t, the dependent variable + * vector y, and a pointer to the user-defined data block user_data. + * The user_data parameter is the same as that specified by the user + * through the CVodeSetUserData routine. The CVCommFn cfn is + * expected to save communicated data in space defined within the + * structure user_data. Note: A CVCommFn cfn does not have a return value. + * + * Each call to the CVCommFn cfn is preceded by a call to the + * CVRhsFn f with the same (t,y) arguments. Thus cfn can omit any + * communications done by f if relevant to the evaluation of g. + * If all necessary communication was done by f, the user can + * pass NULL for cfn in CVBBDPrecInit (see below). + * + * A CVCommFn should return 0 if successful, a positive value if + * a recoverable error occurred, and a negative value if an + * unrecoverable error occurred. + * ----------------------------------------------------------------- + */ + +typedef int (*CVCommFn)(int Nlocal, realtype t, + N_Vector y, + void *user_data); + +/* + * ----------------------------------------------------------------- + * Function : CVBBDPrecInit + * ----------------------------------------------------------------- + * CVBBDPrecInit allocates and initializes the BBD preconditioner. + * + * The parameters of CVBBDPrecInit are as follows: + * + * cvode_mem is the pointer to the integrator memory. + * + * Nlocal is the length of the local block of the vectors y etc. + * on the current processor. + * + * mudq, mldq are the upper and lower half-bandwidths to be used + * in the difference quotient computation of the local + * Jacobian block. + * + * mukeep, mlkeep are the upper and lower half-bandwidths of the + * retained banded approximation to the local Jacobian + * block. + * + * dqrely is an optional input. It is the relative increment + * in components of y used in the difference quotient + * approximations. To specify the default, pass 0. + * The default is dqrely = sqrt(unit roundoff). + * + * gloc is the name of the user-supplied function g(t,y) that + * approximates f and whose local Jacobian blocks are + * to form the preconditioner. + * + * cfn is the name of the user-defined function that performs + * necessary interprocess communication for the + * execution of gloc. + * + * The return value of CVBBDPrecInit is one of: + * CVSPILS_SUCCESS if no errors occurred + * CVSPILS_MEM_NULL if the integrator memory is NULL + * CVSPILS_LMEM_NULL if the linear solver memory is NULL + * CVSPILS_ILL_INPUT if an input has an illegal value + * CVSPILS_MEM_FAIL if a memory allocation request failed + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVBBDPrecInit(void *cvode_mem, int Nlocal, + int mudq, int mldq, + int mukeep, int mlkeep, + realtype dqrely, + CVLocalFn gloc, CVCommFn cfn); + +/* + * ----------------------------------------------------------------- + * Function : CVBBDPrecReInit + * ----------------------------------------------------------------- + * CVBBDPrecReInit re-initializes the BBDPRE module when solving a + * sequence of problems of the same size with CVSPGMR/CVBBDPRE, + * CVSPBCG/CVBBDPRE, or CVSPTFQMR/CVBBDPRE provided there is no change + * in Nlocal, mukeep, or mlkeep. After solving one problem, and after + * calling CVodeReInit to re-initialize the integrator for a subsequent + * problem, call CVBBDPrecReInit. + * + * All arguments have the same names and meanings as those + * of CVBBDPrecInit. + * + * The return value of CVBBDPrecReInit is one of: + * CVSPILS_SUCCESS if no errors occurred + * CVSPILS_MEM_NULL if the integrator memory is NULL + * CVSPILS_LMEM_NULL if the linear solver memory is NULL + * CVSPILS_PMEM_NULL if the preconditioner memory is NULL + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVBBDPrecReInit(void *cvode_mem, int mudq, int mldq, + realtype dqrely); + +/* + * ----------------------------------------------------------------- + * CVBBDPRE optional output extraction routines + * ----------------------------------------------------------------- + * CVBBDPrecGetWorkSpace returns the BBDPRE real and integer work space + * sizes. + * CVBBDPrecGetNumGfnEvals returns the number of calls to gfn. + * + * The return value of CVBBDPrecGet* is one of: + * CVSPILS_SUCCESS if no errors occurred + * CVSPILS_MEM_NULL if the integrator memory is NULL + * CVSPILS_LMEM_NULL if the linear solver memory is NULL + * CVSPILS_PMEM_NULL if the preconditioner memory is NULL + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVBBDPrecGetWorkSpace(void *cvode_mem, + long int *lenrwBBDP, long int *leniwBBDP); +SUNDIALS_EXPORT int CVBBDPrecGetNumGfnEvals(void *cvode_mem, long int *ngevalsBBDP); + +/* + * ================================================================= + * PART II - backward problems + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Types: CVLocalFnB and CVCommFnB + * ----------------------------------------------------------------- + * Local approximation function and inter-process communication + * function for the BBD preconditioner on the backward phase. + * ----------------------------------------------------------------- + */ + +typedef int (*CVLocalFnB)(int NlocalB, realtype t, + N_Vector y, + N_Vector yB, N_Vector gB, + void *user_dataB); + +typedef int (*CVCommFnB)(int NlocalB, realtype t, + N_Vector y, + N_Vector yB, + void *user_dataB); + +/* + * ----------------------------------------------------------------- + * Functions: CVBBDPrecInitB, CVBBDSp*B, CVBBDPrecReInit + * ----------------------------------------------------------------- + * Interface functions for the CVBBDPRE preconditioner to be used on + * the backward phase. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVBBDPrecInitB(void *cvode_mem, int which, int NlocalB, + int mudqB, int mldqB, + int mukeepB, int mlkeepB, + realtype dqrelyB, + CVLocalFnB glocB, CVCommFnB cfnB); + +SUNDIALS_EXPORT int CVBBDPrecReInitB(void *cvode_mem, int which, + int mudqB, int mldqB, + realtype dqrelyB); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/cvodes_dense.h b/odemex/Parser/CVode/cv_src/include/cvodes_dense.h new file mode 100644 index 0000000..59fe7f7 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/cvodes_dense.h @@ -0,0 +1,64 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.7 $ + * $Date: 2008/04/18 19:42:36 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the dense linear solver CVSDENSE. + * ----------------------------------------------------------------- + */ + +#ifndef _CVSDENSE_H +#define _CVSDENSE_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ----------------------------------------------------------------- + * Function: CVDense + * ----------------------------------------------------------------- + * A call to the CVDense function links the main integrator with + * the CVSDENSE linear solver. + * + * cvode_mem is the pointer to the integrator memory returned by + * CVodeCreate. + * + * N is the size of the ODE system. + * + * The return value of CVDense is one of: + * CVDLS_SUCCESS if successful + * CVDLS_MEM_NULL if the cvode memory was NULL + * CVDLS_MEM_FAIL if there was a memory allocation failure + * CVDLS_ILL_INPUT if a required vector operation is missing + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVDense(void *cvode_mem, int N); + +/* + * ----------------------------------------------------------------- + * Function: CVDenseB + * ----------------------------------------------------------------- + * CVDenseB links the main CVODE integrator with the CVSDENSE + * linear solver for the backward integration. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVDenseB(void *cvode_mem, int which, int nB); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/cvodes_diag.h b/odemex/Parser/CVode/cv_src/include/cvodes_diag.h new file mode 100644 index 0000000..00bf2a0 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/cvodes_diag.h @@ -0,0 +1,140 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.5 $ + * $Date: 2007/03/22 18:05:50 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the diagonal linear solver CVSDIAG. + * + * + * Part I contains type definitions and function prototypes for using + * CVDIAG on forward problems (IVP integration and/or FSA) + * + * Part II contains type definitions and function prototypes for using + * CVDIAG on adjoint (backward) problems + * ----------------------------------------------------------------- + */ + +#ifndef _CVSDIAG_H +#define _CVSDIAG_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ----------------------------------------------------------------- + * CVDIAG return values + * ----------------------------------------------------------------- + */ + +#define CVDIAG_SUCCESS 0 +#define CVDIAG_MEM_NULL -1 +#define CVDIAG_LMEM_NULL -2 +#define CVDIAG_ILL_INPUT -3 +#define CVDIAG_MEM_FAIL -4 + +/* Additional last_flag values */ + +#define CVDIAG_INV_FAIL -5 +#define CVDIAG_RHSFUNC_UNRECVR -6 +#define CVDIAG_RHSFUNC_RECVR -7 + +/* Return values for adjoint module */ + +#define CVDIAG_NO_ADJ -101 + +/* + * ----------------------------------------------------------------- + * PART I - forward problems + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * Function : CVDiag + * ----------------------------------------------------------------- + * A call to the CVDiag function links the main integrator with + * the CVDIAG linear solver. + * + * cvode_mem is the pointer to the integrator memory returned by + * CVodeCreate. + * + * The return value of CVDiag is one of: + * CVDIAG_SUCCESS if successful + * CVDIAG_MEM_NULL if the cvode memory was NULL + * CVDIAG_MEM_FAIL if there was a memory allocation failure + * CVDIAG_ILL_INPUT if a required vector operation is missing + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVDiag(void *cvode_mem); + +/* + * ----------------------------------------------------------------- + * Optional outputs from the CVDIAG linear solver + * ----------------------------------------------------------------- + * + * CVDiagGetWorkSpace returns the real and integer workspace used + * by CVDIAG. + * CVDiagGetNumRhsEvals returns the number of calls to the user + * f routine due to finite difference Jacobian + * evaluation. + * Note: The number of diagonal approximate + * Jacobians formed is equal to the number of + * CVDiagSetup calls. This number is available + * through CVodeGetNumLinSolvSetups. + * CVDiagGetLastFlag returns the last error flag set by any of + * the CVDIAG interface functions. + * + * The return value of CVDiagGet* is one of: + * CVDIAG_SUCCESS if successful + * CVDIAG_MEM_NULL if the cvode memory was NULL + * CVDIAG_LMEM_NULL if the cvdiag memory was NULL + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVDiagGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS); +SUNDIALS_EXPORT int CVDiagGetNumRhsEvals(void *cvode_mem, long int *nfevalsLS); +SUNDIALS_EXPORT int CVDiagGetLastFlag(void *cvode_mem, int *flag); + +/* + * ----------------------------------------------------------------- + * The following function returns the name of the constant + * associated with a CVDIAG return flag + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT char *CVDiagGetReturnFlagName(int flag); + +/* + * ----------------------------------------------------------------- + * PART II - backward problems + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * Function: CVDiagB + * ----------------------------------------------------------------- + * CVDiagB links the main CVODE integrator with the CVDIAG + * linear solver for the backward integration. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVDiagB(void *cvode_mem, int which); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/cvodes_direct.h b/odemex/Parser/CVode/cv_src/include/cvodes_direct.h new file mode 100644 index 0000000..3c0366a --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/cvodes_direct.h @@ -0,0 +1,366 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.7 $ + * $Date: 2008/04/18 19:42:37 $ + * ----------------------------------------------------------------- + * Programmer: Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2006, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * Common header file for the direct linear solvers in CVODES. + * + * Part I contains type definitions and function prototypes for + * using a CVDLS linear solver on forward problems (IVP + * integration and/or FSA) + * + * Part II contains type definitions and function prototypes for + * using a CVDLS linear solver on adjoint (backward) problems + * ----------------------------------------------------------------- + */ + +#ifndef _CVSDLS_H +#define _CVSDLS_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ================================================================= + * C V S D I R E C T C O N S T A N T S + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * CVSDIRECT return values + * ----------------------------------------------------------------- + */ + +#define CVDLS_SUCCESS 0 +#define CVDLS_MEM_NULL -1 +#define CVDLS_LMEM_NULL -2 +#define CVDLS_ILL_INPUT -3 +#define CVDLS_MEM_FAIL -4 + +/* Additional last_flag values */ + +#define CVDLS_JACFUNC_UNRECVR -5 +#define CVDLS_JACFUNC_RECVR -6 + +/* Return values for the adjoint module */ + +#define CVDLS_NO_ADJ -101 +#define CVDLS_LMEMB_NULL -102 + +/* + * ================================================================= + * PART I: F O R W A R D P R O B L E M S + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * FUNCTION TYPES + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * Type: CVDlsDenseJacFn + * ----------------------------------------------------------------- + * + * A dense Jacobian approximation function Jac must be of type + * CVDlsDenseJacFn. Its parameters are: + * + * N is the problem size. + * + * Jac is the dense matrix (of type DlsMat) that will be loaded + * by a CVDlsDenseJacFn with an approximation to the Jacobian + * matrix J = (df_i/dy_j) at the point (t,y). + * + * t is the current value of the independent variable. + * + * y is the current value of the dependent variable vector, + * namely the predicted value of y(t). + * + * fy is the vector f(t,y). + * + * user_data is a pointer to user data - the same as the user_data + * parameter passed to CVodeSetFdata. + * + * tmp1, tmp2, and tmp3 are pointers to memory allocated for + * vectors of length N which can be used by a CVDlsDenseJacFn + * as temporary storage or work space. + * + * A CVDlsDenseJacFn should return 0 if successful, a positive + * value if a recoverable error occurred, and a negative value if + * an unrecoverable error occurred. + * + * ----------------------------------------------------------------- + * + * NOTE: The following are two efficient ways to load a dense Jac: + * (1) (with macros - no explicit data structure references) + * for (j=0; j < Neq; j++) { + * col_j = DENSE_COL(Jac,j); + * for (i=0; i < Neq; i++) { + * generate J_ij = the (i,j)th Jacobian element + * col_j[i] = J_ij; + * } + * } + * (2) (without macros - explicit data structure references) + * for (j=0; j < Neq; j++) { + * col_j = (Jac->data)[j]; + * for (i=0; i < Neq; i++) { + * generate J_ij = the (i,j)th Jacobian element + * col_j[i] = J_ij; + * } + * } + * A third way, using the DENSE_ELEM(A,i,j) macro, is much less + * efficient in general. It is only appropriate for use in small + * problems in which efficiency of access is NOT a major concern. + * + * NOTE: If the user's Jacobian routine needs other quantities, + * they are accessible as follows: hcur (the current stepsize) + * and ewt (the error weight vector) are accessible through + * CVodeGetCurrentStep and CVodeGetErrWeights, respectively + * (see cvode.h). The unit roundoff is available as + * UNIT_ROUNDOFF defined in sundials_types.h. + * + * ----------------------------------------------------------------- + */ + + +typedef int (*CVDlsDenseJacFn)(int N, realtype t, + N_Vector y, N_Vector fy, + DlsMat Jac, void *user_data, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); + +/* + * ----------------------------------------------------------------- + * Type: CVDlsBandJacFn + * ----------------------------------------------------------------- + * + * A band Jacobian approximation function Jac must have the + * prototype given below. Its parameters are: + * + * N is the length of all vector arguments. + * + * mupper is the upper half-bandwidth of the approximate banded + * Jacobian. This parameter is the same as the mupper parameter + * passed by the user to the linear solver initialization function. + * + * mlower is the lower half-bandwidth of the approximate banded + * Jacobian. This parameter is the same as the mlower parameter + * passed by the user to the linear solver initialization function. + * + * t is the current value of the independent variable. + * + * y is the current value of the dependent variable vector, + * namely the predicted value of y(t). + * + * fy is the vector f(t,y). + * + * Jac is the band matrix (of type DlsMat) that will be loaded + * by a CVDlsBandJacFn with an approximation to the Jacobian matrix + * Jac = (df_i/dy_j) at the point (t,y). + * Three efficient ways to load J are: + * + * (1) (with macros - no explicit data structure references) + * for (j=0; j < n; j++) { + * col_j = BAND_COL(Jac,j); + * for (i=j-mupper; i <= j+mlower; i++) { + * generate J_ij = the (i,j)th Jacobian element + * BAND_COL_ELEM(col_j,i,j) = J_ij; + * } + * } + * + * (2) (with BAND_COL macro, but without BAND_COL_ELEM macro) + * for (j=0; j < n; j++) { + * col_j = BAND_COL(Jac,j); + * for (k=-mupper; k <= mlower; k++) { + * generate J_ij = the (i,j)th Jacobian element, i=j+k + * col_j[k] = J_ij; + * } + * } + * + * (3) (without macros - explicit data structure references) + * offset = Jac->smu; + * for (j=0; j < n; j++) { + * col_j = ((Jac->data)[j])+offset; + * for (k=-mupper; k <= mlower; k++) { + * generate J_ij = the (i,j)th Jacobian element, i=j+k + * col_j[k] = J_ij; + * } + * } + * Caution: Jac->smu is generally NOT the same as mupper. + * + * The BAND_ELEM(A,i,j) macro is appropriate for use in small + * problems in which efficiency of access is NOT a major concern. + * + * user_data is a pointer to user data - the same as the user_data + * parameter passed to CVodeSetFdata. + * + * NOTE: If the user's Jacobian routine needs other quantities, + * they are accessible as follows: hcur (the current stepsize) + * and ewt (the error weight vector) are accessible through + * CVodeGetCurrentStep and CVodeGetErrWeights, respectively + * (see cvode.h). The unit roundoff is available as + * UNIT_ROUNDOFF defined in sundials_types.h + * + * tmp1, tmp2, and tmp3 are pointers to memory allocated for + * vectors of length N which can be used by a CVDlsBandJacFn + * as temporary storage or work space. + * + * A CVDlsBandJacFn should return 0 if successful, a positive value + * if a recoverable error occurred, and a negative value if an + * unrecoverable error occurred. + * ----------------------------------------------------------------- + */ + +typedef int (*CVDlsBandJacFn)(int N, int mupper, int mlower, + realtype t, N_Vector y, N_Vector fy, + DlsMat Jac, void *user_data, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); + +/* + * ----------------------------------------------------------------- + * EXPORTED FUNCTIONS + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * Optional inputs to the CVDLS linear solver + * ----------------------------------------------------------------- + * + * CVDlsSetDenseJacFn specifies the dense Jacobian approximation + * routine to be used for a direct dense linear solver. + * + * CVDlsSetBandJacFn specifies the band Jacobian approximation + * routine to be used for a direct band linear solver. + * + * By default, a difference quotient approximation, supplied with + * the solver is used. + * + * The return value is one of: + * CVDLS_SUCCESS if successful + * CVDLS_MEM_NULL if the CVODE memory was NULL + * CVDLS_LMEM_NULL if the linear solver memory was NULL + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVDlsSetDenseJacFn(void *cvode_mem, CVDlsDenseJacFn jac); +SUNDIALS_EXPORT int CVDlsSetBandJacFn(void *cvode_mem, CVDlsBandJacFn jac); + +/* + * ----------------------------------------------------------------- + * Optional outputs from the CVSDIRECT linear solver + * ----------------------------------------------------------------- + * + * CVDlsGetWorkSpace returns the real and integer workspace used + * by the direct linear solver. + * CVDlsGetNumJacEvals returns the number of calls made to the + * Jacobian evaluation routine jac. + * CVDlsGetNumRhsEvals returns the number of calls to the user + * f routine due to finite difference Jacobian + * evaluation. + * CVDlsGetLastFlag returns the last error flag set by any of + * the CVSDIRECT interface functions. + * + * The return value of CVDlsGet* is one of: + * CVDLS_SUCCESS if successful + * CVDLS_MEM_NULL if the CVODES memory was NULL + * CVDLS_LMEM_NULL if the linear solver memory was NULL + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVDlsGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS); +SUNDIALS_EXPORT int CVDlsGetNumJacEvals(void *cvode_mem, long int *njevals); +SUNDIALS_EXPORT int CVDlsGetNumRhsEvals(void *cvode_mem, long int *nfevalsLS); +SUNDIALS_EXPORT int CVDlsGetLastFlag(void *cvode_mem, int *flag); + +/* + * ----------------------------------------------------------------- + * The following function returns the name of the constant + * associated with a CVSDIRECT return flag + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT char *CVDlsGetReturnFlagName(int flag); + +/* + * ================================================================= + * PART II: B A C K W A R D P R O B L E M S + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * FUNCTION TYPES + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * Type: CVDlsDenseJacFnB + * ----------------------------------------------------------------- + * A dense Jacobian approximation function jacB for the adjoint + * (backward) problem must have the prototype given below. + * ----------------------------------------------------------------- + */ + +typedef int (*CVDlsDenseJacFnB)(int nB, realtype t, + N_Vector y, + N_Vector yB, N_Vector fyB, + DlsMat JB, void *user_dataB, + N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); + +/* + * ----------------------------------------------------------------- + * Type : CVDlsBandJacFnB + * ----------------------------------------------------------------- + * A band Jacobian approximation function jacB for the adjoint + * (backward) problem must have the prototype given below. + * ----------------------------------------------------------------- + */ + +typedef int (*CVDlsBandJacFnB)(int nB, int mupperB, int mlowerB, + realtype t, + N_Vector y, + N_Vector yB, N_Vector fyB, + DlsMat JB, void *user_dataB, + N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); + +/* + * ----------------------------------------------------------------- + * EXPORTED FUNCTIONS + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * Functions: CVDlsSetJacFnB + * ----------------------------------------------------------------- + * CVDlsSetDenseJacFnB and CVDlsSetBandJacFnB specify the dense and + * band, respectively, Jacobian functions to be used by a + * CVSDIRECT linear solver for the bacward integration phase. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVDlsSetDenseJacFnB(void *cvode_mem, int which, + CVDlsDenseJacFnB jacB); +SUNDIALS_EXPORT int CVDlsSetBandJacFnB(void *cvode_mem, int which, + CVDlsBandJacFnB jacB); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/cvodes_lapack.h b/odemex/Parser/CVode/cv_src/include/cvodes_lapack.h new file mode 100644 index 0000000..20eedf8 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/cvodes_lapack.h @@ -0,0 +1,103 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.6 $ + * $Date: 2008/04/18 19:42:37 $ + * ----------------------------------------------------------------- + * Programmer: Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2006, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * Header file for the CVODES dense linear solver CVSLAPACK. + * ----------------------------------------------------------------- + */ + +#ifndef _CVSLAPACK_H +#define _CVSLAPACK_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ----------------------------------------------------------------- + * Function: CVLapackDense + * ----------------------------------------------------------------- + * A call to the CVLapackDense function links the main integrator + * with the CVSLAPACK linear solver using dense Jacobians. + * + * cvode_mem is the pointer to the integrator memory returned by + * CVodeCreate. + * + * N is the size of the ODE system. + * + * The return value of CVLapackDense is one of: + * CVDLS_SUCCESS if successful + * CVDLS_MEM_NULL if the CVODES memory was NULL + * CVDLS_MEM_FAIL if there was a memory allocation failure + * CVDLS_ILL_INPUT if a required vector operation is missing + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVLapackDense(void *cvode_mem, int N); + +/* + * ----------------------------------------------------------------- + * Function: CVLapackBand + * ----------------------------------------------------------------- + * A call to the CVLapackBand function links the main integrator + * with the CVSLAPACK linear solver using banded Jacobians. + * + * cvode_mem is the pointer to the integrator memory returned by + * CVodeCreate. + * + * N is the size of the ODE system. + * + * mupper is the upper bandwidth of the band Jacobian approximation. + * + * mlower is the lower bandwidth of the band Jacobian approximation. + * + * The return value of CVLapackBand is one of: + * CVDLS_SUCCESS if successful + * CVDLS_MEM_NULL if the CVODES memory was NULL + * CVDLS_MEM_FAIL if there was a memory allocation failure + * CVDLS_ILL_INPUT if a required vector operation is missing or + * if a bandwidth has an illegal value. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVLapackBand(void *cvode_mem, int N, int mupper, int mlower); + +/* + * ----------------------------------------------------------------- + * Function: CVLapackDenseB + * ----------------------------------------------------------------- + * CVLapackDenseB links the main CVODE integrator with the dense + * CVSLAPACK linear solver for the backward integration. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVLapackDenseB(void *cvode_mem, int which, int nB); + +/* + * ----------------------------------------------------------------- + * Function: CVLapackBandB + * ----------------------------------------------------------------- + * CVLapackBandB links the main CVODE integrator with the band + * CVSLAPACK linear solver for the backward integration. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVLapackBandB(void *cvode_mem, int which, + int nB, int mupperB, int mlowerB); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/cvodes_spbcgs.h b/odemex/Parser/CVode/cv_src/include/cvodes_spbcgs.h new file mode 100644 index 0000000..acc56c9 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/cvodes_spbcgs.h @@ -0,0 +1,87 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.4 $ + * $Date: 2007/03/22 18:05:50 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the CVODES scaled preconditioned + * Bi-CGSTAB linear solver, CVSPBCG. + * + * Part I contains function prototypes for using CVSPBCG on forward + * problems (IVP integration and/or FSA) + * + * Part II contains function prototypes for using CVSPBCG on adjoint + * (backward) problems + * ----------------------------------------------------------------- + */ + +#ifndef _CVSSPBCG_H +#define _CVSSPBCG_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ----------------------------------------------------------------- + * PART I - forward problems + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * Function : CVSpbcg + * ----------------------------------------------------------------- + * A call to the CVSpbcg function links the main CVODE integrator + * with the CVSPBCG linear solver. + * + * cvode_mem is the pointer to the integrator memory returned by + * CVodeCreate. + * + * pretype is the type of user preconditioning to be done. + * This must be one of the four enumeration constants + * PREC_NONE, PREC_LEFT, PREC_RIGHT, or PREC_BOTH defined + * in iterative.h. These correspond to no preconditioning, + * left preconditioning only, right preconditioning + * only, and both left and right preconditioning, + * respectively. + * + * maxl is the maximum Krylov dimension. This is an + * optional input to the CVSPBCG solver. Pass 0 to + * use the default value CVSPILS_MAXL=5. + * + * The return value of CVSpbcg is one of: + * CVSPILS_SUCCESS if successful + * CVSPILS_MEM_NULL if the cvode memory was NULL + * CVSPILS_MEM_FAIL if there was a memory allocation failure + * CVSPILS_ILL_INPUT if a required vector operation is missing + * The above constants are defined in cvodes_spils.h + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVSpbcg(void *cvode_mem, int pretype, int maxl); + +/* + * ----------------------------------------------------------------- + * PART II - backward problems + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVSpbcgB(void *cvode_mem, int which, + int pretypeB, int maxlB); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/cvodes_spgmr.h b/odemex/Parser/CVode/cv_src/include/cvodes_spgmr.h new file mode 100644 index 0000000..73f2420 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/cvodes_spgmr.h @@ -0,0 +1,88 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.4 $ + * $Date: 2007/03/22 18:05:50 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the CVODES scaled preconditioned + * GMRES linear solver, CVSPGMR. + * + * Part I contains function prototypes for using CVSPGMR on forward + * problems (IVP integration and/or FSA) + * + * Part II contains function prototypes for using CVSPGMR on adjoint + * (backward) problems + * ----------------------------------------------------------------- + */ + +#ifndef _CVSSPGMR_H +#define _CVSSPGMR_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ----------------------------------------------------------------- + * PART I - forward problems + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * Function : CVSpgmr + * ----------------------------------------------------------------- + * A call to the CVSpgmr function links the main CVODE integrator + * with the CVSPGMR linear solver. + * + * cvode_mem is the pointer to the integrator memory returned by + * CVodeCreate. + * + * pretype is the type of user preconditioning to be done. + * This must be one of the four enumeration constants + * NONE, LEFT, RIGHT, or BOTH defined in iterative.h. + * These correspond to no preconditioning, + * left preconditioning only, right preconditioning + * only, and both left and right preconditioning, + * respectively. + * + * maxl is the maximum Krylov dimension. This is an + * optional input to the CVSPGMR solver. Pass 0 to + * use the default value CVSPILS_MAXL=5. + * + * The return value of CVSpgmr is one of: + * CVSPILS_SUCCESS if successful + * CVSPILS_MEM_NULL if the cvode memory was NULL + * CVSPILS_MEM_FAIL if there was a memory allocation failure + * CVSPILS_ILL_INPUT if a required vector operation is missing + * The above constants are defined in cvodes_spils.h + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVSpgmr(void *cvode_mem, int pretype, int maxl); + +/* + * ----------------------------------------------------------------- + * PART II - backward problems + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVSpgmrB(void *cvode_mem, int which, + int pretypeB, int maxlB); + + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/cvodes_spils.h b/odemex/Parser/CVode/cv_src/include/cvodes_spils.h new file mode 100644 index 0000000..928a1ef --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/cvodes_spils.h @@ -0,0 +1,450 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.11 $ + * $Date: 2008/09/03 20:24:48 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the common header file for the Scaled, Preconditioned + * Iterative Linear Solvers in CVODES. + * + * Part I contains type definitions and functions for using the + * iterative linear solvers on forward problems + * (IVP integration and/or FSA) + * + * Part II contains type definitions and functions for using the + * iterative linear solvers on adjoint (backward) problems + * ----------------------------------------------------------------- + */ + +#ifndef _CVSSPILS_H +#define _CVSSPILS_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ----------------------------------------------------------------- + * CVSPILS return values + * ----------------------------------------------------------------- + */ + +#define CVSPILS_SUCCESS 0 +#define CVSPILS_MEM_NULL -1 +#define CVSPILS_LMEM_NULL -2 +#define CVSPILS_ILL_INPUT -3 +#define CVSPILS_MEM_FAIL -4 +#define CVSPILS_PMEM_NULL -5 + +/* Return values for the adjoint module */ + +#define CVSPILS_NO_ADJ -101 +#define CVSPILS_LMEMB_NULL -102 + +/* + * ----------------------------------------------------------------- + * CVSPILS solver constants + * ----------------------------------------------------------------- + * CVSPILS_MAXL : default value for the maximum Krylov + * dimension + * + * CVSPILS_MSBPRE : maximum number of steps between + * preconditioner evaluations + * + * CVSPILS_DGMAX : maximum change in gamma between + * preconditioner evaluations + * + * CVSPILS_EPLIN : default value for factor by which the + * tolerance on the nonlinear iteration is + * multiplied to get a tolerance on the linear + * iteration + * ----------------------------------------------------------------- + */ + +#define CVSPILS_MAXL 5 +#define CVSPILS_MSBPRE 50 +#define CVSPILS_DGMAX RCONST(0.2) +#define CVSPILS_EPLIN RCONST(0.05) + +/* + * ----------------------------------------------------------------- + * PART I - forward problems + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * Type : CVSpilsPrecSetupFn + * ----------------------------------------------------------------- + * The user-supplied preconditioner setup function PrecSetup and + * the user-supplied preconditioner solve function PrecSolve + * together must define left and right preconditoner matrices + * P1 and P2 (either of which may be trivial), such that the + * product P1*P2 is an approximation to the Newton matrix + * M = I - gamma*J. Here J is the system Jacobian J = df/dy, + * and gamma is a scalar proportional to the integration step + * size h. The solution of systems P z = r, with P = P1 or P2, + * is to be carried out by the PrecSolve function, and PrecSetup + * is to do any necessary setup operations. + * + * The user-supplied preconditioner setup function PrecSetup + * is to evaluate and preprocess any Jacobian-related data + * needed by the preconditioner solve function PrecSolve. + * This might include forming a crude approximate Jacobian, + * and performing an LU factorization on the resulting + * approximation to M. This function will not be called in + * advance of every call to PrecSolve, but instead will be called + * only as often as necessary to achieve convergence within the + * Newton iteration. If the PrecSolve function needs no + * preparation, the PrecSetup function can be NULL. + * + * For greater efficiency, the PrecSetup function may save + * Jacobian-related data and reuse it, rather than generating it + * from scratch. In this case, it should use the input flag jok + * to decide whether to recompute the data, and set the output + * flag *jcurPtr accordingly. + * + * Each call to the PrecSetup function is preceded by a call to + * the RhsFn f with the same (t,y) arguments. Thus the PrecSetup + * function can use any auxiliary data that is computed and + * saved by the f function and made accessible to PrecSetup. + * + * A function PrecSetup must have the prototype given below. + * Its parameters are as follows: + * + * t is the current value of the independent variable. + * + * y is the current value of the dependent variable vector, + * namely the predicted value of y(t). + * + * fy is the vector f(t,y). + * + * jok is an input flag indicating whether Jacobian-related + * data needs to be recomputed, as follows: + * jok == FALSE means recompute Jacobian-related data + * from scratch. + * jok == TRUE means that Jacobian data, if saved from + * the previous PrecSetup call, can be reused + * (with the current value of gamma). + * A Precset call with jok == TRUE can only occur after + * a call with jok == FALSE. + * + * jcurPtr is a pointer to an output integer flag which is + * to be set by PrecSetup as follows: + * Set *jcurPtr = TRUE if Jacobian data was recomputed. + * Set *jcurPtr = FALSE if Jacobian data was not recomputed, + * but saved data was reused. + * + * gamma is the scalar appearing in the Newton matrix. + * + * user_data is a pointer to user data - the same as the user_data + * parameter passed to the CVodeSetUserData function. + * + * tmp1, tmp2, and tmp3 are pointers to memory allocated + * for N_Vectors which can be used by + * CVSpilsPrecSetupFn as temporary storage or + * work space. + * + * NOTE: If the user's preconditioner needs other quantities, + * they are accessible as follows: hcur (the current stepsize) + * and ewt (the error weight vector) are accessible through + * CVodeGetCurrentStep and CVodeGetErrWeights, respectively). + * The unit roundoff is available as UNIT_ROUNDOFF defined in + * sundials_types.h. + * + * Returned value: + * The value to be returned by the PrecSetup function is a flag + * indicating whether it was successful. This value should be + * 0 if successful, + * > 0 for a recoverable error (step will be retried), + * < 0 for an unrecoverable error (integration is halted). + * ----------------------------------------------------------------- + */ + +typedef int (*CVSpilsPrecSetupFn)(realtype t, N_Vector y, N_Vector fy, + booleantype jok, booleantype *jcurPtr, + realtype gamma, void *user_data, + N_Vector tmp1, N_Vector tmp2, + N_Vector tmp3); + +/* + * ----------------------------------------------------------------- + * Type : CVSpilsPrecSolveFn + * ----------------------------------------------------------------- + * The user-supplied preconditioner solve function PrecSolve + * is to solve a linear system P z = r in which the matrix P is + * one of the preconditioner matrices P1 or P2, depending on the + * type of preconditioning chosen. + * + * A function PrecSolve must have the prototype given below. + * Its parameters are as follows: + * + * t is the current value of the independent variable. + * + * y is the current value of the dependent variable vector. + * + * fy is the vector f(t,y). + * + * r is the right-hand side vector of the linear system. + * + * z is the output vector computed by PrecSolve. + * + * gamma is the scalar appearing in the Newton matrix. + * + * delta is an input tolerance for use by PSolve if it uses + * an iterative method in its solution. In that case, + * the residual vector Res = r - P z of the system + * should be made less than delta in weighted L2 norm, + * i.e., sqrt [ Sum (Res[i]*ewt[i])^2 ] < delta. + * Note: the error weight vector ewt can be obtained + * through a call to the routine CVodeGetErrWeights. + * + * lr is an input flag indicating whether PrecSolve is to use + * the left preconditioner P1 or right preconditioner + * P2: lr = 1 means use P1, and lr = 2 means use P2. + * + * user_data is a pointer to user data - the same as the user_data + * parameter passed to the CVodeSetUserData function. + * + * tmp is a pointer to memory allocated for an N_Vector + * which can be used by PSolve for work space. + * + * Returned value: + * The value to be returned by the PrecSolve function is a flag + * indicating whether it was successful. This value should be + * 0 if successful, + * positive for a recoverable error (step will be retried), + * negative for an unrecoverable error (integration is halted). + * ----------------------------------------------------------------- + */ + +typedef int (*CVSpilsPrecSolveFn)(realtype t, N_Vector y, N_Vector fy, + N_Vector r, N_Vector z, + realtype gamma, realtype delta, + int lr, void *user_data, N_Vector tmp); + +/* + * ----------------------------------------------------------------- + * Type : CVSpilsJacTimesVecFn + * ----------------------------------------------------------------- + * The user-supplied function jtimes is to generate the product + * J*v for given v, where J is the Jacobian df/dy, or an + * approximation to it, and v is a given vector. It should return + * 0 if successful a positive value for a recoverable error or + * a negative value for an unrecoverable failure. + * + * A function jtimes must have the prototype given below. Its + * parameters are as follows: + * + * v is the N_Vector to be multiplied by J. + * + * Jv is the output N_Vector containing J*v. + * + * t is the current value of the independent variable. + * + * y is the current value of the dependent variable + * vector. + * + * fy is the vector f(t,y). + * + * user_data is a pointer to user data, the same as the user_data + * parameter passed to the CVodeSetUserData function. + * + * tmp is a pointer to memory allocated for an N_Vector + * which can be used by Jtimes for work space. + * ----------------------------------------------------------------- + */ + +typedef int (*CVSpilsJacTimesVecFn)(N_Vector v, N_Vector Jv, realtype t, + N_Vector y, N_Vector fy, + void *user_data, N_Vector tmp); + + +/* + * ----------------------------------------------------------------- + * Optional inputs to the CVSPILS linear solver + * ----------------------------------------------------------------- + * + * CVSpilsSetPrecType resets the type of preconditioner, pretype, + * from the value previously set. + * This must be one of PREC_NONE, PREC_LEFT, + * PREC_RIGHT, or PREC_BOTH. + * + * CVSpilsSetGSType specifies the type of Gram-Schmidt + * orthogonalization to be used. This must be one of + * the two enumeration constants MODIFIED_GS or + * CLASSICAL_GS defined in iterative.h. These correspond + * to using modified Gram-Schmidt and classical + * Gram-Schmidt, respectively. + * Default value is MODIFIED_GS. + * + * CVSpilsSetMaxl resets the maximum Krylov subspace size, maxl, + * from the value previously set. + * An input value <= 0, gives the default value. + * + * CVSpilsSetEpsLin specifies the factor by which the tolerance on + * the nonlinear iteration is multiplied to get a + * tolerance on the linear iteration. + * Default value is 0.05. + * + * CVSpilsSetPreconditioner specifies the PrecSetup and PrecSolve functions. + * Default is NULL for both arguments (no preconditioning). + * + * CVSpilsSetJacTimesVecFn specifies the jtimes function. Default is to use + * an internal finite difference approximation routine. + * + * The return value of CVSpilsSet* is one of: + * CVSPILS_SUCCESS if successful + * CVSPILS_MEM_NULL if the cvode memory was NULL + * CVSPILS_LMEM_NULL if the linear solver memory was NULL + * CVSPILS_ILL_INPUT if an input has an illegal value + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVSpilsSetPrecType(void *cvode_mem, int pretype); +SUNDIALS_EXPORT int CVSpilsSetGSType(void *cvode_mem, int gstype); +SUNDIALS_EXPORT int CVSpilsSetMaxl(void *cvode_mem, int maxl); +SUNDIALS_EXPORT int CVSpilsSetEpsLin(void *cvode_mem, realtype eplifac); +SUNDIALS_EXPORT int CVSpilsSetPreconditioner(void *cvode_mem, + CVSpilsPrecSetupFn pset, + CVSpilsPrecSolveFn psolve); +SUNDIALS_EXPORT int CVSpilsSetJacTimesVecFn(void *cvode_mem, + CVSpilsJacTimesVecFn jtv); + +/* + * ----------------------------------------------------------------- + * Optional outputs from the CVSPILS linear solver + * ----------------------------------------------------------------- + * CVSpilsGetWorkSpace returns the real and integer workspace used + * by the SPILS module. + * + * CVSpilsGetNumPrecEvals returns the number of preconditioner + * evaluations, i.e. the number of calls made + * to PrecSetup with jok==FALSE. + * + * CVSpilsGetNumPrecSolves returns the number of calls made to + * PrecSolve. + * + * CVSpilsGetNumLinIters returns the number of linear iterations. + * + * CVSpilsGetNumConvFails returns the number of linear + * convergence failures. + * + * CVSpilsGetNumJtimesEvals returns the number of calls to jtimes. + * + * CVSpilsGetNumRhsEvals returns the number of calls to the user + * f routine due to finite difference Jacobian + * times vector evaluation. + * + * CVSpilsGetLastFlag returns the last error flag set by any of + * the CVSPILS interface functions. + * + * The return value of CVSpilsGet* is one of: + * CVSPILS_SUCCESS if successful + * CVSPILS_MEM_NULL if the cvode memory was NULL + * CVSPILS_LMEM_NULL if the linear solver memory was NULL + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVSpilsGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS); +SUNDIALS_EXPORT int CVSpilsGetNumPrecEvals(void *cvode_mem, long int *npevals); +SUNDIALS_EXPORT int CVSpilsGetNumPrecSolves(void *cvode_mem, long int *npsolves); +SUNDIALS_EXPORT int CVSpilsGetNumLinIters(void *cvode_mem, long int *nliters); +SUNDIALS_EXPORT int CVSpilsGetNumConvFails(void *cvode_mem, long int *nlcfails); +SUNDIALS_EXPORT int CVSpilsGetNumJtimesEvals(void *cvode_mem, long int *njvevals); +SUNDIALS_EXPORT int CVSpilsGetNumRhsEvals(void *cvode_mem, long int *nfevalsLS); +SUNDIALS_EXPORT int CVSpilsGetLastFlag(void *cvode_mem, int *flag); + +/* + * ----------------------------------------------------------------- + * The following function returns the name of the constant + * associated with a CVSPILS return flag + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT char *CVSpilsGetReturnFlagName(int flag); + + +/* + * ----------------------------------------------------------------- + * PART II - backward problems + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * Type : CVSpilsPrecSetupFnB + * ----------------------------------------------------------------- + * A function PrecSetupB for the adjoint (backward) problem must have + * the prototype given below. + * ----------------------------------------------------------------- + */ + +typedef int (*CVSpilsPrecSetupFnB)(realtype t, N_Vector y, + N_Vector yB, N_Vector fyB, + booleantype jokB, + booleantype *jcurPtrB, realtype gammaB, + void *user_dataB, + N_Vector tmp1B, N_Vector tmp2B, + N_Vector tmp3B); + + +/* + * ----------------------------------------------------------------- + * Type : CVSpilsPrecSolveFnB + * ----------------------------------------------------------------- + * A function PrecSolveB for the adjoint (backward) problem must + * have the prototype given below. + * ----------------------------------------------------------------- + */ + +typedef int (*CVSpilsPrecSolveFnB)(realtype t, N_Vector y, + N_Vector yB, N_Vector fyB, + N_Vector rB, N_Vector zB, + realtype gammaB, realtype deltaB, + int lrB, void *user_dataB, N_Vector tmpB); + +/* + * ----------------------------------------------------------------- + * Type : CVSpilsJacTimesVecFnB + * ----------------------------------------------------------------- + * A function jtimesB for the adjoint (backward) problem must have + * the prototype given below. + * ----------------------------------------------------------------- + */ + +typedef int (*CVSpilsJacTimesVecFnB)(N_Vector vB, N_Vector JvB, realtype t, + N_Vector y, N_Vector yB, N_Vector fyB, + void *jac_dataB, N_Vector tmpB); + +/* + * ----------------------------------------------------------------- + * Functions + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVSpilsSetPrecTypeB(void *cvode_mem, int which, int pretypeB); +SUNDIALS_EXPORT int CVSpilsSetGSTypeB(void *cvode_mem, int which, int gstypeB); +SUNDIALS_EXPORT int CVSpilsSetEpslinB(void *cvode_mem, int which, realtype eplifacB); +SUNDIALS_EXPORT int CVSpilsSetMaxlB(void *cvode_mem, int which, int maxlB); +SUNDIALS_EXPORT int CVSpilsSetPreconditionerB(void *cvode_mem, int which, + CVSpilsPrecSetupFnB psetB, + CVSpilsPrecSolveFnB psolveB); +SUNDIALS_EXPORT int CVSpilsSetJacTimesVecFnB(void *cvode_mem, int which, + CVSpilsJacTimesVecFnB jtvB); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/cvodes_sptfqmr.h b/odemex/Parser/CVode/cv_src/include/cvodes_sptfqmr.h new file mode 100644 index 0000000..2b91a3a --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/cvodes_sptfqmr.h @@ -0,0 +1,88 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.4 $ + * $Date: 2007/03/22 18:05:50 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the CVODES scaled preconditioned TFQMR + * linear solver, CVSPTFQMR. + * + * Part I contains function prototypes for using CVSPTFQMR on forward + * problems (IVP integration and/or FSA) + * + * Part II contains function prototypes for using CVSPTFQMR on adjoint + * (backward) problems + * ----------------------------------------------------------------- + */ + +#ifndef _CVSSPTFQMR_H +#define _CVSSPTFQMR_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ----------------------------------------------------------------- + * PART I - forward problems + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * Function : CVSptfqmr + * ----------------------------------------------------------------- + * A call to the CVSptfqmr function links the main CVODE integrator + * with the CVSPTFQMR linear solver. + * + * cvode_mem is the pointer to the integrator memory returned by + * CVodeCreate. + * + * pretype is the type of user preconditioning to be done. + * This must be one of the four enumeration constants + * PREC_NONE, PREC_LEFT, PREC_RIGHT, or PREC_BOTH defined + * in iterative.h. These correspond to no preconditioning, + * left preconditioning only, right preconditioning + * only, and both left and right preconditioning, + * respectively. + * + * maxl is the maximum Krylov dimension. This is an + * optional input to the CVSPTFQMR solver. Pass 0 to + * use the default value CVSPILS_MAXL=5. + * + * The return value of CVSptfqmr is one of: + * CVSPILS_SUCCESS if successful + * CVSPILS_MEM_NULL if the cvode memory was NULL + * CVSPILS_MEM_FAIL if there was a memory allocation failure + * CVSPILS_ILL_INPUT if a required vector operation is missing + * The above constants are defined in cvodes_spils.h + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVSptfqmr(void *cvode_mem, int pretype, int maxl); + + +/* + * ----------------------------------------------------------------- + * PART II - backward problems + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int CVSptfqmrB(void *cvode_mem, int which, + int pretypeB, int maxlB); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/nvector/nvector_parallel.h b/odemex/Parser/CVode/cv_src/include/nvector/nvector_parallel.h new file mode 100644 index 0000000..f8a006c --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/nvector/nvector_parallel.h @@ -0,0 +1,314 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2006/11/29 00:05:07 $ + * ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, Radu Serban, + * and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the main header file for the MPI-enabled implementation + * of the NVECTOR module. + * + * Part I contains declarations specific to the parallel + * implementation of the supplied NVECTOR module. + * + * Part II defines accessor macros that allow the user to efficiently + * use the type N_Vector without making explicit references to the + * underlying data structure. + * + * Part III contains the prototype for the constructor + * N_VNew_Parallel as well as implementation-specific prototypes + * for various useful vector operations. + * + * Notes: + * + * - The definition of the generic N_Vector structure can be + * found in the header file sundials_nvector.h. + * + * - The definition of the type realtype can be found in the + * header file sundials_types.h, and it may be changed (at the + * configuration stage) according to the user's needs. + * The sundials_types.h file also contains the definition + * for the type booleantype. + * + * - N_Vector arguments to arithmetic vector operations need not + * be distinct. For example, the following call: + * + * N_VLinearSum_Parallel(a,x,b,y,y); + * + * (which stores the result of the operation a*x+b*y in y) + * is legal. + * ----------------------------------------------------------------- + */ + +#ifndef _NVECTOR_PARALLEL_H +#define _NVECTOR_PARALLEL_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +#include + + +/* + * ----------------------------------------------------------------- + * PART I: PARALLEL implementation of N_Vector + * ----------------------------------------------------------------- + */ + +/* define MPI data types */ + +#if defined(SUNDIALS_SINGLE_PRECISION) + +#define PVEC_REAL_MPI_TYPE MPI_FLOAT + +#elif defined(SUNDIALS_DOUBLE_PRECISION) + +#define PVEC_REAL_MPI_TYPE MPI_DOUBLE + +#elif defined(SUNDIALS_EXTENDED_PRECISION) + +#define PVEC_REAL_MPI_TYPE MPI_LONG_DOUBLE + +#endif + +#define PVEC_INTEGER_MPI_TYPE MPI_LONG + +/* parallel implementation of the N_Vector 'content' structure + contains the global and local lengths of the vector, a pointer + to an array of 'realtype components', the MPI communicator, + and a flag indicating ownership of the data */ + +struct _N_VectorContent_Parallel { + long int local_length; /* local vector length */ + long int global_length; /* global vector length */ + booleantype own_data; /* ownership of data */ + realtype *data; /* local data array */ + MPI_Comm comm; /* pointer to MPI communicator */ +}; + +typedef struct _N_VectorContent_Parallel *N_VectorContent_Parallel; + +/* + * ----------------------------------------------------------------- + * PART II: macros NV_CONTENT_P, NV_DATA_P, NV_OWN_DATA_P, + * NV_LOCLENGTH_P, NV_GLOBLENGTH_P,NV_COMM_P, and NV_Ith_P + * ----------------------------------------------------------------- + * In the descriptions below, the following user declarations + * are assumed: + * + * N_Vector v; + * long int v_len, s_len, i; + * + * (1) NV_CONTENT_P + * + * This routines gives access to the contents of the parallel + * vector N_Vector. + * + * The assignment v_cont = NV_CONTENT_P(v) sets v_cont to be + * a pointer to the parallel N_Vector content structure. + * + * (2) NV_DATA_P, NV_OWN_DATA_P, NV_LOCLENGTH_P, NV_GLOBLENGTH_P, + * and NV_COMM_P + * + * These routines give access to the individual parts of + * the content structure of a parallel N_Vector. + * + * The assignment v_data = NV_DATA_P(v) sets v_data to be + * a pointer to the first component of the local data for + * the vector v. The assignment NV_DATA_P(v) = data_v sets + * the component array of v to be data_V by storing the + * pointer data_v. + * + * The assignment v_llen = NV_LOCLENGTH_P(v) sets v_llen to + * be the length of the local part of the vector v. The call + * NV_LOCLENGTH_P(v) = llen_v sets the local length + * of v to be llen_v. + * + * The assignment v_glen = NV_GLOBLENGTH_P(v) sets v_glen to + * be the global length of the vector v. The call + * NV_GLOBLENGTH_P(v) = glen_v sets the global length of v to + * be glen_v. + * + * The assignment v_comm = NV_COMM_P(v) sets v_comm to be the + * MPI communicator of the vector v. The assignment + * NV_COMM_C(v) = comm_v sets the MPI communicator of v to be + * comm_v. + * + * (3) NV_Ith_P + * + * In the following description, the components of the + * local part of an N_Vector are numbered 0..n-1, where n + * is the local length of (the local part of) v. + * + * The assignment r = NV_Ith_P(v,i) sets r to be the value + * of the ith component of the local part of the vector v. + * The assignment NV_Ith_P(v,i) = r sets the value of the + * ith local component of v to be r. + * + * Note: When looping over the components of an N_Vector v, it is + * more efficient to first obtain the component array via + * v_data = NV_DATA_P(v) and then access v_data[i] within the + * loop than it is to use NV_Ith_P(v,i) within the loop. + * ----------------------------------------------------------------- + */ + +#define NV_CONTENT_P(v) ( (N_VectorContent_Parallel)(v->content) ) + +#define NV_LOCLENGTH_P(v) ( NV_CONTENT_P(v)->local_length ) + +#define NV_GLOBLENGTH_P(v) ( NV_CONTENT_P(v)->global_length ) + +#define NV_OWN_DATA_P(v) ( NV_CONTENT_P(v)->own_data ) + +#define NV_DATA_P(v) ( NV_CONTENT_P(v)->data ) + +#define NV_COMM_P(v) ( NV_CONTENT_P(v)->comm ) + +#define NV_Ith_P(v,i) ( NV_DATA_P(v)[i] ) + +/* + * ----------------------------------------------------------------- + * PART III: functions exported by nvector_parallel + * + * CONSTRUCTORS: + * N_VNew_Parallel + * N_VNewEmpty_Parallel + * N_VMake_Parallel + * N_VCloneVectorArray_Parallel + * N_VCloneVectorArrayEmpty_Parallel + * DESTRUCTORS: + * N_VDestroy_Parallel + * N_VDestroyVectorArray_Parallel + * OTHER: + * N_VPrint_Parallel + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * Function : N_VNew_Parallel + * ----------------------------------------------------------------- + * This function creates and allocates memory for a parallel vector. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector N_VNew_Parallel(MPI_Comm comm, + long int local_length, + long int global_length); + +/* + * ----------------------------------------------------------------- + * Function : N_VNewEmpty_Parallel + * ----------------------------------------------------------------- + * This function creates a new parallel N_Vector with an empty + * (NULL) data array. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector N_VNewEmpty_Parallel(MPI_Comm comm, + long int local_length, + long int global_length); + +/* + * ----------------------------------------------------------------- + * Function : N_VMake_Parallel + * ----------------------------------------------------------------- + * This function creates and allocates memory for a parallel vector + * with a user-supplied data array. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector N_VMake_Parallel(MPI_Comm comm, + long int local_length, + long int global_length, + realtype *v_data); + +/* + * ----------------------------------------------------------------- + * Function : N_VCloneVectorArray_Parallel + * ----------------------------------------------------------------- + * This function creates an array of 'count' PARALLEL vectors by + * cloning a given vector w. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector *N_VCloneVectorArray_Parallel(int count, N_Vector w); + +/* + * ----------------------------------------------------------------- + * Function : N_VCloneVectorArrayEmpty_Parallel + * ----------------------------------------------------------------- + * This function creates an array of 'count' PARALLEL vectors each + * with an empty (NULL) data array by cloning w. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector *N_VCloneVectorArrayEmpty_Parallel(int count, N_Vector w); + +/* + * ----------------------------------------------------------------- + * Function : N_VDestroyVectorArray_Parallel + * ----------------------------------------------------------------- + * This function frees an array of N_Vector created with + * N_VCloneVectorArray_Parallel or N_VCloneVectorArrayEmpty_Parallel. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void N_VDestroyVectorArray_Parallel(N_Vector *vs, int count); + +/* + * ----------------------------------------------------------------- + * Function : N_VPrint_Parallel + * ----------------------------------------------------------------- + * This function prints the content of a parallel vector to stdout. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void N_VPrint_Parallel(N_Vector v); + +/* + * ----------------------------------------------------------------- + * parallel implementations of the vector operations + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector N_VCloneEmpty_Parallel(N_Vector w); +SUNDIALS_EXPORT N_Vector N_VClone_Parallel(N_Vector w); +SUNDIALS_EXPORT void N_VDestroy_Parallel(N_Vector v); +SUNDIALS_EXPORT void N_VSpace_Parallel(N_Vector v, long int *lrw, long int *liw); +SUNDIALS_EXPORT realtype *N_VGetArrayPointer_Parallel(N_Vector v); +SUNDIALS_EXPORT void N_VSetArrayPointer_Parallel(realtype *v_data, N_Vector v); +SUNDIALS_EXPORT void N_VLinearSum_Parallel(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VConst_Parallel(realtype c, N_Vector z); +SUNDIALS_EXPORT void N_VProd_Parallel(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VDiv_Parallel(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VScale_Parallel(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAbs_Parallel(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VInv_Parallel(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAddConst_Parallel(N_Vector x, realtype b, N_Vector z); +SUNDIALS_EXPORT realtype N_VDotProd_Parallel(N_Vector x, N_Vector y); +SUNDIALS_EXPORT realtype N_VMaxNorm_Parallel(N_Vector x); +SUNDIALS_EXPORT realtype N_VWrmsNorm_Parallel(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VWrmsNormMask_Parallel(N_Vector x, N_Vector w, N_Vector id); +SUNDIALS_EXPORT realtype N_VMin_Parallel(N_Vector x); +SUNDIALS_EXPORT realtype N_VWL2Norm_Parallel(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VL1Norm_Parallel(N_Vector x); +SUNDIALS_EXPORT void N_VCompare_Parallel(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VInvTest_Parallel(N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VConstrMask_Parallel(N_Vector c, N_Vector x, N_Vector m); +SUNDIALS_EXPORT realtype N_VMinQuotient_Parallel(N_Vector num, N_Vector denom); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/nvector/nvector_serial.h b/odemex/Parser/CVode/cv_src/include/nvector/nvector_serial.h new file mode 100644 index 0000000..4301a68 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/nvector/nvector_serial.h @@ -0,0 +1,265 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2006/11/29 00:05:07 $ + * ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, Radu Serban, + * and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the serial implementation of the + * NVECTOR module. + * + * Part I contains declarations specific to the serial + * implementation of the supplied NVECTOR module. + * + * Part II defines accessor macros that allow the user to + * efficiently use the type N_Vector without making explicit + * references to the underlying data structure. + * + * Part III contains the prototype for the constructor N_VNew_Serial + * as well as implementation-specific prototypes for various useful + * vector operations. + * + * Notes: + * + * - The definition of the generic N_Vector structure can be found + * in the header file sundials_nvector.h. + * + * - The definition of the type 'realtype' can be found in the + * header file sundials_types.h, and it may be changed (at the + * configuration stage) according to the user's needs. + * The sundials_types.h file also contains the definition + * for the type 'booleantype'. + * + * - N_Vector arguments to arithmetic vector operations need not + * be distinct. For example, the following call: + * + * N_VLinearSum_Serial(a,x,b,y,y); + * + * (which stores the result of the operation a*x+b*y in y) + * is legal. + * ----------------------------------------------------------------- + */ + +#ifndef _NVECTOR_SERIAL_H +#define _NVECTOR_SERIAL_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ----------------------------------------------------------------- + * PART I: SERIAL implementation of N_Vector + * ----------------------------------------------------------------- + */ + +/* serial implementation of the N_Vector 'content' structure + contains the length of the vector, a pointer to an array + of 'realtype' components, and a flag indicating ownership of + the data */ + +struct _N_VectorContent_Serial { + long int length; + booleantype own_data; + realtype *data; +}; + +typedef struct _N_VectorContent_Serial *N_VectorContent_Serial; + +/* + * ----------------------------------------------------------------- + * PART II: macros NV_CONTENT_S, NV_DATA_S, NV_OWN_DATA_S, + * NV_LENGTH_S, and NV_Ith_S + * ----------------------------------------------------------------- + * In the descriptions below, the following user declarations + * are assumed: + * + * N_Vector v; + * long int i; + * + * (1) NV_CONTENT_S + * + * This routines gives access to the contents of the serial + * vector N_Vector. + * + * The assignment v_cont = NV_CONTENT_S(v) sets v_cont to be + * a pointer to the serial N_Vector content structure. + * + * (2) NV_DATA_S NV_OWN_DATA_S and NV_LENGTH_S + * + * These routines give access to the individual parts of + * the content structure of a serial N_Vector. + * + * The assignment v_data = NV_DATA_S(v) sets v_data to be + * a pointer to the first component of v. The assignment + * NV_DATA_S(v) = data_V sets the component array of v to + * be data_v by storing the pointer data_v. + * + * The assignment v_len = NV_LENGTH_S(v) sets v_len to be + * the length of v. The call NV_LENGTH_S(v) = len_v sets + * the length of v to be len_v. + * + * (3) NV_Ith_S + * + * In the following description, the components of an + * N_Vector are numbered 0..n-1, where n is the length of v. + * + * The assignment r = NV_Ith_S(v,i) sets r to be the value of + * the ith component of v. The assignment NV_Ith_S(v,i) = r + * sets the value of the ith component of v to be r. + * + * Note: When looping over the components of an N_Vector v, it is + * more efficient to first obtain the component array via + * v_data = NV_DATA_S(v) and then access v_data[i] within the + * loop than it is to use NV_Ith_S(v,i) within the loop. + * ----------------------------------------------------------------- + */ + +#define NV_CONTENT_S(v) ( (N_VectorContent_Serial)(v->content) ) + +#define NV_LENGTH_S(v) ( NV_CONTENT_S(v)->length ) + +#define NV_OWN_DATA_S(v) ( NV_CONTENT_S(v)->own_data ) + +#define NV_DATA_S(v) ( NV_CONTENT_S(v)->data ) + +#define NV_Ith_S(v,i) ( NV_DATA_S(v)[i] ) + +/* + * ----------------------------------------------------------------- + * PART III: functions exported by nvector_serial + * + * CONSTRUCTORS: + * N_VNew_Serial + * N_VNewEmpty_Serial + * N_VMake_Serial + * N_VCloneVectorArray_Serial + * N_VCloneVectorArrayEmpty_Serial + * DESTRUCTORS: + * N_VDestroy_Serial + * N_VDestroyVectorArray_Serial + * OTHER: + * N_VPrint_Serial + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * Function : N_VNew_Serial + * ----------------------------------------------------------------- + * This function creates and allocates memory for a serial vector. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector N_VNew_Serial(long int vec_length); + +/* + * ----------------------------------------------------------------- + * Function : N_VNewEmpty_Serial + * ----------------------------------------------------------------- + * This function creates a new serial N_Vector with an empty (NULL) + * data array. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector N_VNewEmpty_Serial(long int vec_length); + +/* + * ----------------------------------------------------------------- + * Function : N_VMake_Serial + * ----------------------------------------------------------------- + * This function creates and allocates memory for a serial vector + * with a user-supplied data array. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector N_VMake_Serial(long int vec_length, realtype *v_data); + +/* + * ----------------------------------------------------------------- + * Function : N_VCloneVectorArray_Serial + * ----------------------------------------------------------------- + * This function creates an array of 'count' SERIAL vectors by + * cloning a given vector w. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector *N_VCloneVectorArray_Serial(int count, N_Vector w); + +/* + * ----------------------------------------------------------------- + * Function : N_VCloneVectorArrayEmpty_Serial + * ----------------------------------------------------------------- + * This function creates an array of 'count' SERIAL vectors each + * with an empty (NULL) data array by cloning w. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector *N_VCloneVectorArrayEmpty_Serial(int count, N_Vector w); + +/* + * ----------------------------------------------------------------- + * Function : N_VDestroyVectorArray_Serial + * ----------------------------------------------------------------- + * This function frees an array of SERIAL vectors created with + * N_VCloneVectorArray_Serial or N_VCloneVectorArrayEmpty_Serial. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void N_VDestroyVectorArray_Serial(N_Vector *vs, int count); + +/* + * ----------------------------------------------------------------- + * Function : N_VPrint_Serial + * ----------------------------------------------------------------- + * This function prints the content of a serial vector to stdout. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void N_VPrint_Serial(N_Vector v); + +/* + * ----------------------------------------------------------------- + * serial implementations of various useful vector operations + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector N_VCloneEmpty_Serial(N_Vector w); +SUNDIALS_EXPORT N_Vector N_VClone_Serial(N_Vector w); +SUNDIALS_EXPORT void N_VDestroy_Serial(N_Vector v); +SUNDIALS_EXPORT void N_VSpace_Serial(N_Vector v, long int *lrw, long int *liw); +SUNDIALS_EXPORT realtype *N_VGetArrayPointer_Serial(N_Vector v); +SUNDIALS_EXPORT void N_VSetArrayPointer_Serial(realtype *v_data, N_Vector v); +SUNDIALS_EXPORT void N_VLinearSum_Serial(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VConst_Serial(realtype c, N_Vector z); +SUNDIALS_EXPORT void N_VProd_Serial(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VDiv_Serial(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VScale_Serial(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAbs_Serial(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VInv_Serial(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAddConst_Serial(N_Vector x, realtype b, N_Vector z); +SUNDIALS_EXPORT realtype N_VDotProd_Serial(N_Vector x, N_Vector y); +SUNDIALS_EXPORT realtype N_VMaxNorm_Serial(N_Vector x); +SUNDIALS_EXPORT realtype N_VWrmsNorm_Serial(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VWrmsNormMask_Serial(N_Vector x, N_Vector w, N_Vector id); +SUNDIALS_EXPORT realtype N_VMin_Serial(N_Vector x); +SUNDIALS_EXPORT realtype N_VWL2Norm_Serial(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VL1Norm_Serial(N_Vector x); +SUNDIALS_EXPORT void N_VCompare_Serial(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VInvTest_Serial(N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VConstrMask_Serial(N_Vector c, N_Vector x, N_Vector m); +SUNDIALS_EXPORT realtype N_VMinQuotient_Serial(N_Vector num, N_Vector denom); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/nvector_serial.h b/odemex/Parser/CVode/cv_src/include/nvector_serial.h new file mode 100644 index 0000000..4301a68 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/nvector_serial.h @@ -0,0 +1,265 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2006/11/29 00:05:07 $ + * ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, Radu Serban, + * and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the serial implementation of the + * NVECTOR module. + * + * Part I contains declarations specific to the serial + * implementation of the supplied NVECTOR module. + * + * Part II defines accessor macros that allow the user to + * efficiently use the type N_Vector without making explicit + * references to the underlying data structure. + * + * Part III contains the prototype for the constructor N_VNew_Serial + * as well as implementation-specific prototypes for various useful + * vector operations. + * + * Notes: + * + * - The definition of the generic N_Vector structure can be found + * in the header file sundials_nvector.h. + * + * - The definition of the type 'realtype' can be found in the + * header file sundials_types.h, and it may be changed (at the + * configuration stage) according to the user's needs. + * The sundials_types.h file also contains the definition + * for the type 'booleantype'. + * + * - N_Vector arguments to arithmetic vector operations need not + * be distinct. For example, the following call: + * + * N_VLinearSum_Serial(a,x,b,y,y); + * + * (which stores the result of the operation a*x+b*y in y) + * is legal. + * ----------------------------------------------------------------- + */ + +#ifndef _NVECTOR_SERIAL_H +#define _NVECTOR_SERIAL_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ----------------------------------------------------------------- + * PART I: SERIAL implementation of N_Vector + * ----------------------------------------------------------------- + */ + +/* serial implementation of the N_Vector 'content' structure + contains the length of the vector, a pointer to an array + of 'realtype' components, and a flag indicating ownership of + the data */ + +struct _N_VectorContent_Serial { + long int length; + booleantype own_data; + realtype *data; +}; + +typedef struct _N_VectorContent_Serial *N_VectorContent_Serial; + +/* + * ----------------------------------------------------------------- + * PART II: macros NV_CONTENT_S, NV_DATA_S, NV_OWN_DATA_S, + * NV_LENGTH_S, and NV_Ith_S + * ----------------------------------------------------------------- + * In the descriptions below, the following user declarations + * are assumed: + * + * N_Vector v; + * long int i; + * + * (1) NV_CONTENT_S + * + * This routines gives access to the contents of the serial + * vector N_Vector. + * + * The assignment v_cont = NV_CONTENT_S(v) sets v_cont to be + * a pointer to the serial N_Vector content structure. + * + * (2) NV_DATA_S NV_OWN_DATA_S and NV_LENGTH_S + * + * These routines give access to the individual parts of + * the content structure of a serial N_Vector. + * + * The assignment v_data = NV_DATA_S(v) sets v_data to be + * a pointer to the first component of v. The assignment + * NV_DATA_S(v) = data_V sets the component array of v to + * be data_v by storing the pointer data_v. + * + * The assignment v_len = NV_LENGTH_S(v) sets v_len to be + * the length of v. The call NV_LENGTH_S(v) = len_v sets + * the length of v to be len_v. + * + * (3) NV_Ith_S + * + * In the following description, the components of an + * N_Vector are numbered 0..n-1, where n is the length of v. + * + * The assignment r = NV_Ith_S(v,i) sets r to be the value of + * the ith component of v. The assignment NV_Ith_S(v,i) = r + * sets the value of the ith component of v to be r. + * + * Note: When looping over the components of an N_Vector v, it is + * more efficient to first obtain the component array via + * v_data = NV_DATA_S(v) and then access v_data[i] within the + * loop than it is to use NV_Ith_S(v,i) within the loop. + * ----------------------------------------------------------------- + */ + +#define NV_CONTENT_S(v) ( (N_VectorContent_Serial)(v->content) ) + +#define NV_LENGTH_S(v) ( NV_CONTENT_S(v)->length ) + +#define NV_OWN_DATA_S(v) ( NV_CONTENT_S(v)->own_data ) + +#define NV_DATA_S(v) ( NV_CONTENT_S(v)->data ) + +#define NV_Ith_S(v,i) ( NV_DATA_S(v)[i] ) + +/* + * ----------------------------------------------------------------- + * PART III: functions exported by nvector_serial + * + * CONSTRUCTORS: + * N_VNew_Serial + * N_VNewEmpty_Serial + * N_VMake_Serial + * N_VCloneVectorArray_Serial + * N_VCloneVectorArrayEmpty_Serial + * DESTRUCTORS: + * N_VDestroy_Serial + * N_VDestroyVectorArray_Serial + * OTHER: + * N_VPrint_Serial + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * Function : N_VNew_Serial + * ----------------------------------------------------------------- + * This function creates and allocates memory for a serial vector. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector N_VNew_Serial(long int vec_length); + +/* + * ----------------------------------------------------------------- + * Function : N_VNewEmpty_Serial + * ----------------------------------------------------------------- + * This function creates a new serial N_Vector with an empty (NULL) + * data array. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector N_VNewEmpty_Serial(long int vec_length); + +/* + * ----------------------------------------------------------------- + * Function : N_VMake_Serial + * ----------------------------------------------------------------- + * This function creates and allocates memory for a serial vector + * with a user-supplied data array. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector N_VMake_Serial(long int vec_length, realtype *v_data); + +/* + * ----------------------------------------------------------------- + * Function : N_VCloneVectorArray_Serial + * ----------------------------------------------------------------- + * This function creates an array of 'count' SERIAL vectors by + * cloning a given vector w. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector *N_VCloneVectorArray_Serial(int count, N_Vector w); + +/* + * ----------------------------------------------------------------- + * Function : N_VCloneVectorArrayEmpty_Serial + * ----------------------------------------------------------------- + * This function creates an array of 'count' SERIAL vectors each + * with an empty (NULL) data array by cloning w. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector *N_VCloneVectorArrayEmpty_Serial(int count, N_Vector w); + +/* + * ----------------------------------------------------------------- + * Function : N_VDestroyVectorArray_Serial + * ----------------------------------------------------------------- + * This function frees an array of SERIAL vectors created with + * N_VCloneVectorArray_Serial or N_VCloneVectorArrayEmpty_Serial. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void N_VDestroyVectorArray_Serial(N_Vector *vs, int count); + +/* + * ----------------------------------------------------------------- + * Function : N_VPrint_Serial + * ----------------------------------------------------------------- + * This function prints the content of a serial vector to stdout. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void N_VPrint_Serial(N_Vector v); + +/* + * ----------------------------------------------------------------- + * serial implementations of various useful vector operations + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector N_VCloneEmpty_Serial(N_Vector w); +SUNDIALS_EXPORT N_Vector N_VClone_Serial(N_Vector w); +SUNDIALS_EXPORT void N_VDestroy_Serial(N_Vector v); +SUNDIALS_EXPORT void N_VSpace_Serial(N_Vector v, long int *lrw, long int *liw); +SUNDIALS_EXPORT realtype *N_VGetArrayPointer_Serial(N_Vector v); +SUNDIALS_EXPORT void N_VSetArrayPointer_Serial(realtype *v_data, N_Vector v); +SUNDIALS_EXPORT void N_VLinearSum_Serial(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VConst_Serial(realtype c, N_Vector z); +SUNDIALS_EXPORT void N_VProd_Serial(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VDiv_Serial(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VScale_Serial(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAbs_Serial(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VInv_Serial(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAddConst_Serial(N_Vector x, realtype b, N_Vector z); +SUNDIALS_EXPORT realtype N_VDotProd_Serial(N_Vector x, N_Vector y); +SUNDIALS_EXPORT realtype N_VMaxNorm_Serial(N_Vector x); +SUNDIALS_EXPORT realtype N_VWrmsNorm_Serial(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VWrmsNormMask_Serial(N_Vector x, N_Vector w, N_Vector id); +SUNDIALS_EXPORT realtype N_VMin_Serial(N_Vector x); +SUNDIALS_EXPORT realtype N_VWL2Norm_Serial(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VL1Norm_Serial(N_Vector x); +SUNDIALS_EXPORT void N_VCompare_Serial(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VInvTest_Serial(N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VConstrMask_Serial(N_Vector c, N_Vector x, N_Vector m); +SUNDIALS_EXPORT realtype N_VMinQuotient_Serial(N_Vector num, N_Vector denom); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/sundials/sundials_band.h b/odemex/Parser/CVode/cv_src/include/sundials/sundials_band.h new file mode 100644 index 0000000..95ee54c --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/sundials/sundials_band.h @@ -0,0 +1,153 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.5 $ + * $Date: 2009/02/17 02:39:26 $ + * ----------------------------------------------------------------- + * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for a generic BAND linear solver + * package, based on the DlsMat type defined in sundials_direct.h. + * + * There are two sets of band solver routines listed in + * this file: one set uses type DlsMat defined below and the + * other set uses the type realtype ** for band matrix arguments. + * Routines that work with the type DlsMat begin with "Band". + * Routines that work with realtype ** begin with "band" + * ----------------------------------------------------------------- + */ + +#ifndef _SUNDIALS_BAND_H +#define _SUNDIALS_BAND_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ----------------------------------------------------------------- + * Function : BandGBTRF + * ----------------------------------------------------------------- + * Usage : ier = BandGBTRF(A, p); + * if (ier != 0) ... A is singular + * ----------------------------------------------------------------- + * BandGBTRF performs the LU factorization of the N by N band + * matrix A. This is done using standard Gaussian elimination + * with partial pivoting. + * + * A successful LU factorization leaves the "matrix" A and the + * pivot array p with the following information: + * + * (1) p[k] contains the row number of the pivot element chosen + * at the beginning of elimination step k, k=0, 1, ..., N-1. + * + * (2) If the unique LU factorization of A is given by PA = LU, + * where P is a permutation matrix, L is a lower triangular + * matrix with all 1's on the diagonal, and U is an upper + * triangular matrix, then the upper triangular part of A + * (including its diagonal) contains U and the strictly lower + * triangular part of A contains the multipliers, I-L. + * + * BandGBTRF returns 0 if successful. Otherwise it encountered + * a zero diagonal element during the factorization. In this case + * it returns the column index (numbered from one) at which + * it encountered the zero. + * + * Important Note: A must be allocated to accommodate the increase + * in upper bandwidth that occurs during factorization. If + * mathematically, A is a band matrix with upper bandwidth mu and + * lower bandwidth ml, then the upper triangular factor U can + * have upper bandwidth as big as smu = MIN(n-1,mu+ml). The lower + * triangular factor L has lower bandwidth ml. Allocate A with + * call A = BandAllocMat(N,mu,ml,smu), where mu, ml, and smu are + * as defined above. The user does not have to zero the "extra" + * storage allocated for the purpose of factorization. This will + * handled by the BandGBTRF routine. + * + * BandGBTRF is only a wrapper around bandGBTRF. All work is done + * in bandGBTRF works directly on the data in the DlsMat A (i.e., + * the field cols). + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int BandGBTRF(DlsMat A, int *p); +SUNDIALS_EXPORT int bandGBTRF(realtype **a, int n, int mu, int ml, int smu, int *p); + +/* + * ----------------------------------------------------------------- + * Function : BandGBTRS + * ----------------------------------------------------------------- + * Usage : BandGBTRS(A, p, b); + * ----------------------------------------------------------------- + * BandGBTRS solves the N-dimensional system A x = b using + * the LU factorization in A and the pivot information in p + * computed in BandGBTRF. The solution x is returned in b. This + * routine cannot fail if the corresponding call to BandGBTRF + * did not fail. + * + * BandGBTRS is only a wrapper around bandGBTRS which does all the + * work directly on the data in the DlsMat A (i.e., the field cols). + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void BandGBTRS(DlsMat A, int *p, realtype *b); +SUNDIALS_EXPORT void bandGBTRS(realtype **a, int n, int smu, int ml, int *p, realtype *b); + +/* + * ----------------------------------------------------------------- + * Function : BandCopy + * ----------------------------------------------------------------- + * Usage : BandCopy(A, B, copymu, copyml); + * ----------------------------------------------------------------- + * BandCopy copies the submatrix with upper and lower bandwidths + * copymu, copyml of the N by N band matrix A into the N by N + * band matrix B. + * + * BandCopy is a wrapper around bandCopy which accesses the data + * in the DlsMat A and B (i.e. the fields cols) + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void BandCopy(DlsMat A, DlsMat B, int copymu, int copyml); +SUNDIALS_EXPORT void bandCopy(realtype **a, realtype **b, int n, int a_smu, int b_smu, + int copymu, int copyml); + +/* + * ----------------------------------------------------------------- + * Function: BandScale + * ----------------------------------------------------------------- + * Usage : BandScale(c, A); + * ----------------------------------------------------------------- + * A(i,j) <- c*A(i,j), j-(A->mu) <= i <= j+(A->ml). + * + * BandScale is a wrapper around bandScale which performs the actual + * scaling by accessing the data in the DlsMat A (i.e. the field + * cols). + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void BandScale(realtype c, DlsMat A); +SUNDIALS_EXPORT void bandScale(realtype c, realtype **a, int n, int mu, int ml, int smu); + +/* + * ----------------------------------------------------------------- + * Function: bandAddIdentity + * ----------------------------------------------------------------- + * bandAddIdentity adds the identity matrix to the n-by-n matrix + * stored in the realtype** arrays. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void bandAddIdentity(realtype **a, int n, int smu); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/sundials/sundials_config.h b/odemex/Parser/CVode/cv_src/include/sundials/sundials_config.h new file mode 100644 index 0000000..3ba4096 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/sundials/sundials_config.h @@ -0,0 +1,80 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.4 $ + * $Date: 2007/12/19 20:34:00 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + *------------------------------------------------------------------ + * SUNDIALS configuration header file + *------------------------------------------------------------------ + */ + +#include "winDefine.h" + +/* Define SUNDIALS version number */ +#define SUNDIALS_PACKAGE_VERSION "2.4.0" + +/* FCMIX: Define Fortran name-mangling macro for C identifiers. + * Depending on the inferred scheme, one of the following six + * macros will be defined: + * #define SUNDIALS_F77_FUNC(name,NAME) name + * #define SUNDIALS_F77_FUNC(name,NAME) name ## _ + * #define SUNDIALS_F77_FUNC(name,NAME) name ## __ + * #define SUNDIALS_F77_FUNC(name,NAME) NAME + * #define SUNDIALS_F77_FUNC(name,NAME) NAME ## _ + * #define SUNDIALS_F77_FUNC(name,NAME) NAME ## __ + */ + + +/* FCMIX: Define Fortran name-mangling macro for C identifiers + * which contain underscores. + */ + + +/* Define precision of SUNDIALS data type 'realtype' + * Depending on the precision level, one of the following + * three macros will be defined: + * #define SUNDIALS_SINGLE_PRECISION 1 + * #define SUNDIALS_DOUBLE_PRECISION 1 + * #define SUNDIALS_EXTENDED_PRECISION 1 + */ +#define SUNDIALS_DOUBLE_PRECISION 1 + +/* Use generic math functions + * If it was decided that generic math functions can be used, then + * #define SUNDIALS_USE_GENERIC_MATH 1 + * otherwise + * #define SUNDIALS_USE_GENERIC_MATH 0 + */ + + +/* Blas/Lapack available + * If working libraries for Blas/lapack support were found, then + * #define SUNDIALS_BLAS_LAPACK 1 + * otherwise + * #define SUNDIALS_BLAS_LAPACK 0 + */ +#define SUNDIALS_BLAS_LAPACK 1 + +/* FNVECTOR: Allow user to specify different MPI communicator + * If it was found that the MPI implementation supports MPI_Comm_f2c, then + * #define SUNDIALS_MPI_COMM_F2C 1 + * otherwise + * #define SUNDIALS_MPI_COMM_F2C 0 + */ + + +/* Mark SUNDIALS API functions for export/import + * When building shared SUNDIALS libraries under Windows, use + * #define SUNDIALS_EXPORT __declspec(dllexport) + * When linking to shared SUNDIALS libraries under Windows, use + * #define SUNDIALS_EXPORT __declspec(dllimport) + * In all other cases (other platforms or static libraries under + * Windows), the SUNDIALS_EXPORT macro is empty + */ +#define SUNDIALS_EXPORT diff --git a/odemex/Parser/CVode/cv_src/include/sundials/sundials_config.in b/odemex/Parser/CVode/cv_src/include/sundials/sundials_config.in new file mode 100644 index 0000000..f43aeae --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/sundials/sundials_config.in @@ -0,0 +1,78 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.4 $ + * $Date: 2007/12/19 20:34:00 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + *------------------------------------------------------------------ + * SUNDIALS configuration header file + *------------------------------------------------------------------ + */ + +/* Define SUNDIALS version number */ +#define SUNDIALS_PACKAGE_VERSION "@PACKAGE_VERSION@" + +/* FCMIX: Define Fortran name-mangling macro for C identifiers. + * Depending on the inferred scheme, one of the following six + * macros will be defined: + * #define SUNDIALS_F77_FUNC(name,NAME) name + * #define SUNDIALS_F77_FUNC(name,NAME) name ## _ + * #define SUNDIALS_F77_FUNC(name,NAME) name ## __ + * #define SUNDIALS_F77_FUNC(name,NAME) NAME + * #define SUNDIALS_F77_FUNC(name,NAME) NAME ## _ + * #define SUNDIALS_F77_FUNC(name,NAME) NAME ## __ + */ +@F77_MANGLE_MACRO1@ + +/* FCMIX: Define Fortran name-mangling macro for C identifiers + * which contain underscores. + */ +@F77_MANGLE_MACRO2@ + +/* Define precision of SUNDIALS data type 'realtype' + * Depending on the precision level, one of the following + * three macros will be defined: + * #define SUNDIALS_SINGLE_PRECISION 1 + * #define SUNDIALS_DOUBLE_PRECISION 1 + * #define SUNDIALS_EXTENDED_PRECISION 1 + */ +@PRECISION_LEVEL@ + +/* Use generic math functions + * If it was decided that generic math functions can be used, then + * #define SUNDIALS_USE_GENERIC_MATH 1 + * otherwise + * #define SUNDIALS_USE_GENERIC_MATH 0 + */ +@GENERIC_MATH_LIB@ + +/* Blas/Lapack available + * If working libraries for Blas/lapack support were found, then + * #define SUNDIALS_BLAS_LAPACK 1 + * otherwise + * #define SUNDIALS_BLAS_LAPACK 0 + */ +@BLAS_LAPACK_MACRO@ + +/* FNVECTOR: Allow user to specify different MPI communicator + * If it was found that the MPI implementation supports MPI_Comm_f2c, then + * #define SUNDIALS_MPI_COMM_F2C 1 + * otherwise + * #define SUNDIALS_MPI_COMM_F2C 0 + */ +@F77_MPI_COMM_F2C@ + +/* Mark SUNDIALS API functions for export/import + * When building shared SUNDIALS libraries under Windows, use + * #define SUNDIALS_EXPORT __declspec(dllexport) + * When linking to shared SUNDIALS libraries under Windows, use + * #define SUNDIALS_EXPORT __declspec(dllimport) + * In all other cases (other platforms or static libraries under + * Windows), the SUNDIALS_EXPORT macro is empty + */ +@SUNDIALS_EXPORT@ diff --git a/odemex/Parser/CVode/cv_src/include/sundials/sundials_dense.h b/odemex/Parser/CVode/cv_src/include/sundials/sundials_dense.h new file mode 100644 index 0000000..a3b1431 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/sundials/sundials_dense.h @@ -0,0 +1,187 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.7 $ + * $Date: 2009/02/17 02:39:26 $ + * ----------------------------------------------------------------- + * Programmer: Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2006, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for a generic package of DENSE matrix + * operations, based on the DlsMat type defined in sundials_direct.h. + * + * There are two sets of dense solver routines listed in + * this file: one set uses type DlsMat defined below and the + * other set uses the type realtype ** for dense matrix arguments. + * Routines that work with the type DlsMat begin with "Dense". + * Routines that work with realtype** begin with "dense". + * ----------------------------------------------------------------- + */ + +#ifndef _SUNDIALS_DENSE_H +#define _SUNDIALS_DENSE_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ----------------------------------------------------------------- + * Functions: DenseGETRF and DenseGETRS + * ----------------------------------------------------------------- + * DenseGETRF performs the LU factorization of the M by N dense + * matrix A. This is done using standard Gaussian elimination + * with partial (row) pivoting. Note that this applies only + * to matrices with M >= N and full column rank. + * + * A successful LU factorization leaves the matrix A and the + * pivot array p with the following information: + * + * (1) p[k] contains the row number of the pivot element chosen + * at the beginning of elimination step k, k=0, 1, ..., N-1. + * + * (2) If the unique LU factorization of A is given by PA = LU, + * where P is a permutation matrix, L is a lower trapezoidal + * matrix with all 1's on the diagonal, and U is an upper + * triangular matrix, then the upper triangular part of A + * (including its diagonal) contains U and the strictly lower + * trapezoidal part of A contains the multipliers, I-L. + * + * For square matrices (M=N), L is unit lower triangular. + * + * DenseGETRF returns 0 if successful. Otherwise it encountered + * a zero diagonal element during the factorization. In this case + * it returns the column index (numbered from one) at which + * it encountered the zero. + * + * DenseGETRS solves the N-dimensional system A x = b using + * the LU factorization in A and the pivot information in p + * computed in DenseGETRF. The solution x is returned in b. This + * routine cannot fail if the corresponding call to DenseGETRF + * did not fail. + * DenseGETRS does NOT check for a square matrix! + * + * ----------------------------------------------------------------- + * DenseGETRF and DenseGETRS are simply wrappers around denseGETRF + * and denseGETRS, respectively, which perform all the work by + * directly accessing the data in the DlsMat A (i.e. the field cols) + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int DenseGETRF(DlsMat A, int *p); +SUNDIALS_EXPORT void DenseGETRS(DlsMat A, int *p, realtype *b); + +SUNDIALS_EXPORT int denseGETRF(realtype **a, int m, int n, int *p); +SUNDIALS_EXPORT void denseGETRS(realtype **a, int n, int *p, realtype *b); + +/* + * ----------------------------------------------------------------- + * Functions : DensePOTRF and DensePOTRS + * ----------------------------------------------------------------- + * DensePOTRF computes the Cholesky factorization of a real symmetric + * positive definite matrix A. + * ----------------------------------------------------------------- + * DensePOTRS solves a system of linear equations A*X = B with a + * symmetric positive definite matrix A using the Cholesky factorization + * A = L*L**T computed by DensePOTRF. + * + * ----------------------------------------------------------------- + * DensePOTRF and DensePOTRS are simply wrappers around densePOTRF + * and densePOTRS, respectively, which perform all the work by + * directly accessing the data in the DlsMat A (i.e. the field cols) + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int DensePOTRF(DlsMat A); +SUNDIALS_EXPORT void DensePOTRS(DlsMat A, realtype *b); + +SUNDIALS_EXPORT int densePOTRF(realtype **a, int m); +SUNDIALS_EXPORT void densePOTRS(realtype **a, int m, realtype *b); + +/* + * ----------------------------------------------------------------- + * Functions : DenseGEQRF and DenseORMQR + * ----------------------------------------------------------------- + * DenseGEQRF computes a QR factorization of a real M-by-N matrix A: + * A = Q * R (with M>= N). + * + * DenseGEQRF requires a temporary work vector wrk of length M. + * ----------------------------------------------------------------- + * DenseORMQR computes the product w = Q * v where Q is a real + * orthogonal matrix defined as the product of k elementary reflectors + * + * Q = H(1) H(2) . . . H(k) + * + * as returned by DenseGEQRF. Q is an M-by-N matrix, v is a vector + * of length N and w is a vector of length M (with M>=N). + * + * DenseORMQR requires a temporary work vector wrk of length M. + * + * ----------------------------------------------------------------- + * DenseGEQRF and DenseORMQR are simply wrappers around denseGEQRF + * and denseORMQR, respectively, which perform all the work by + * directly accessing the data in the DlsMat A (i.e. the field cols) + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int DenseGEQRF(DlsMat A, realtype *beta, realtype *wrk); +SUNDIALS_EXPORT int DenseORMQR(DlsMat A, realtype *beta, realtype *vn, realtype *vm, + realtype *wrk); + +SUNDIALS_EXPORT int denseGEQRF(realtype **a, int m, int n, realtype *beta, realtype *v); +SUNDIALS_EXPORT int denseORMQR(realtype **a, int m, int n, realtype *beta, + realtype *v, realtype *w, realtype *wrk); + +/* + * ----------------------------------------------------------------- + * Function : DenseCopy + * ----------------------------------------------------------------- + * DenseCopy copies the contents of the M-by-N matrix A into the + * M-by-N matrix B. + * + * DenseCopy is a wrapper around denseCopy which accesses the data + * in the DlsMat A and B (i.e. the fields cols) + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void DenseCopy(DlsMat A, DlsMat B); +SUNDIALS_EXPORT void denseCopy(realtype **a, realtype **b, int m, int n); + +/* + * ----------------------------------------------------------------- + * Function: DenseScale + * ----------------------------------------------------------------- + * DenseScale scales the elements of the M-by-N matrix A by the + * constant c and stores the result back in A. + * + * DenseScale is a wrapper around denseScale which performs the actual + * scaling by accessing the data in the DlsMat A (i.e. the field + * cols). + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void DenseScale(realtype c, DlsMat A); +SUNDIALS_EXPORT void denseScale(realtype c, realtype **a, int m, int n); + + +/* + * ----------------------------------------------------------------- + * Function: denseAddIdentity + * ----------------------------------------------------------------- + * denseAddIdentity adds the identity matrix to the n-by-n matrix + * stored in the realtype** arrays. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void denseAddIdentity(realtype **a, int n); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/sundials/sundials_direct.h b/odemex/Parser/CVode/cv_src/include/sundials/sundials_direct.h new file mode 100644 index 0000000..f3d823b --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/sundials/sundials_direct.h @@ -0,0 +1,323 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.3 $ + * $Date: 2009/02/17 02:39:26 $ + * ----------------------------------------------------------------- + * Programmer: Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2006, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This header file contains definitions and declarations for use by + * generic direct linear solvers for Ax = b. It defines types for + * dense and banded matrices and corresponding accessor macros. + * ----------------------------------------------------------------- + */ + +#ifndef _SUNDIALS_DIRECT_H +#define _SUNDIALS_DIRECT_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ================================================================= + * C O N S T A N T S + * ================================================================= + */ + +/* + * SUNDIALS_DENSE: dense matrix + * SUNDIALS_BAND: banded matrix + */ + +#define SUNDIALS_DENSE 1 +#define SUNDIALS_BAND 2 + +/* + * ================================================================== + * Type definitions + * ================================================================== + */ + +/* + * ----------------------------------------------------------------- + * Type : DlsMat + * ----------------------------------------------------------------- + * The type DlsMat is defined to be a pointer to a structure + * with various sizes, a data field, and an array of pointers to + * the columns which defines a dense or band matrix for use in + * direct linear solvers. The M and N fields indicates the number + * of rows and columns, respectively. The data field is a one + * dimensional array used for component storage. The cols field + * stores the pointers in data for the beginning of each column. + * ----------------------------------------------------------------- + * For DENSE matrices, the relevant fields in DlsMat are: + * type = SUNDIALS_DENSE + * M - number of rows + * N - number of columns + * ldim - leading dimension (ldim >= M) + * data - pointer to a contiguous block of realtype variables + * ldata - length of the data array =ldim*N + * cols - array of pointers. cols[j] points to the first element + * of the j-th column of the matrix in the array data. + * + * The elements of a dense matrix are stored columnwise (i.e columns + * are stored one on top of the other in memory). + * If A is of type DlsMat, then the (i,j)th element of A (with + * 0 <= i < M and 0 <= j < N) is given by (A->data)[j*n+i]. + * + * The DENSE_COL and DENSE_ELEM macros below allow a user to access + * efficiently individual matrix elements without writing out explicit + * data structure references and without knowing too much about the + * underlying element storage. The only storage assumption needed is + * that elements are stored columnwise and that a pointer to the + * jth column of elements can be obtained via the DENSE_COL macro. + * ----------------------------------------------------------------- + * For BAND matrices, the relevant fields in DlsMat are: + * type = SUNDIALS_BAND + * M - number of rows + * N - number of columns + * mu - upper bandwidth, 0 <= mu <= min(M,N) + * ml - lower bandwidth, 0 <= ml <= min(M,N) + * s_mu - storage upper bandwidth, mu <= s_mu <= N-1. + * The dgbtrf routine writes the LU factors into the storage + * for A. The upper triangular factor U, however, may have + * an upper bandwidth as big as MIN(N-1,mu+ml) because of + * partial pivoting. The s_mu field holds the upper + * bandwidth allocated for A. + * ldim - leading dimension (ldim >= s_mu) + * data - pointer to a contiguous block of realtype variables + * ldata - length of the data array =ldim*(s_mu+ml+1) + * cols - array of pointers. cols[j] points to the first element + * of the j-th column of the matrix in the array data. + * + * The BAND_COL, BAND_COL_ELEM, and BAND_ELEM macros below allow a + * user to access individual matrix elements without writing out + * explicit data structure references and without knowing too much + * about the underlying element storage. The only storage assumption + * needed is that elements are stored columnwise and that a pointer + * into the jth column of elements can be obtained via the BAND_COL + * macro. The BAND_COL_ELEM macro selects an element from a column + * which has already been isolated via BAND_COL. The macro + * BAND_COL_ELEM allows the user to avoid the translation + * from the matrix location (i,j) to the index in the array returned + * by BAND_COL at which the (i,j)th element is stored. + * ----------------------------------------------------------------- + */ + +typedef struct _DlsMat { + int type; + int M; + int N; + int ldim; + int mu; + int ml; + int s_mu; + realtype *data; + int ldata; + realtype **cols; +} *DlsMat; + +/* + * ================================================================== + * Data accessor macros + * ================================================================== + */ + +/* + * ----------------------------------------------------------------- + * DENSE_COL and DENSE_ELEM + * ----------------------------------------------------------------- + * + * DENSE_COL(A,j) references the jth column of the M-by-N dense + * matrix A, 0 <= j < N. The type of the expression DENSE_COL(A,j) + * is (realtype *). After the assignment in the usage above, col_j + * may be treated as an array indexed from 0 to M-1. The (i,j)-th + * element of A is thus referenced by col_j[i]. + * + * DENSE_ELEM(A,i,j) references the (i,j)th element of the dense + * M-by-N matrix A, 0 <= i < M ; 0 <= j < N. + * + * ----------------------------------------------------------------- + */ + +#define DENSE_COL(A,j) ((A->cols)[j]) +#define DENSE_ELEM(A,i,j) ((A->cols)[j][i]) + +/* + * ----------------------------------------------------------------- + * BAND_COL, BAND_COL_ELEM, and BAND_ELEM + * ----------------------------------------------------------------- + * + * BAND_COL(A,j) references the diagonal element of the jth column + * of the N by N band matrix A, 0 <= j <= N-1. The type of the + * expression BAND_COL(A,j) is realtype *. The pointer returned by + * the call BAND_COL(A,j) can be treated as an array which is + * indexed from -(A->mu) to (A->ml). + * + * BAND_COL_ELEM references the (i,j)th entry of the band matrix A + * when used in conjunction with BAND_COL. The index (i,j) should + * satisfy j-(A->mu) <= i <= j+(A->ml). + * + * BAND_ELEM(A,i,j) references the (i,j)th element of the M-by-N + * band matrix A, where 0 <= i,j <= N-1. The location (i,j) should + * further satisfy j-(A->mu) <= i <= j+(A->ml). + * + * ----------------------------------------------------------------- + */ + +#define BAND_COL(A,j) (((A->cols)[j])+(A->s_mu)) +#define BAND_COL_ELEM(col_j,i,j) (col_j[(i)-(j)]) +#define BAND_ELEM(A,i,j) ((A->cols)[j][(i)-(j)+(A->s_mu)]) + +/* + * ================================================================== + * Exported function prototypes (functions working on dlsMat) + * ================================================================== + */ + +/* + * ----------------------------------------------------------------- + * Function: NewDenseMat + * ----------------------------------------------------------------- + * NewDenseMat allocates memory for an M-by-N dense matrix and + * returns the storage allocated (type DlsMat). NewDenseMat + * returns NULL if the request for matrix storage cannot be + * satisfied. See the above documentation for the type DlsMat + * for matrix storage details. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT DlsMat NewDenseMat(int M, int N); + +/* + * ----------------------------------------------------------------- + * Function: NewBandMat + * ----------------------------------------------------------------- + * NewBandMat allocates memory for an M-by-N band matrix + * with upper bandwidth mu, lower bandwidth ml, and storage upper + * bandwidth smu. Pass smu as follows depending on whether A will + * be LU factored: + * + * (1) Pass smu = mu if A will not be factored. + * + * (2) Pass smu = MIN(N-1,mu+ml) if A will be factored. + * + * NewBandMat returns the storage allocated (type DlsMat) or + * NULL if the request for matrix storage cannot be satisfied. + * See the documentation for the type DlsMat for matrix storage + * details. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT DlsMat NewBandMat(int N, int mu, int ml, int smu); + +/* + * ----------------------------------------------------------------- + * Functions: DestroyMat + * ----------------------------------------------------------------- + * DestroyMat frees the memory allocated by NewDenseMat or NewBandMat + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void DestroyMat(DlsMat A); + +/* + * ----------------------------------------------------------------- + * Function: NewIntArray + * ----------------------------------------------------------------- + * NewIntArray allocates memory an array of N integers and returns + * the pointer to the memory it allocates. If the request for + * memory storage cannot be satisfied, it returns NULL. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int *NewIntArray(int N); + +/* + * ----------------------------------------------------------------- + * Function: NewRealArray + * ----------------------------------------------------------------- + * NewRealArray allocates memory an array of N realtype and returns + * the pointer to the memory it allocates. If the request for + * memory storage cannot be satisfied, it returns NULL. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT realtype *NewRealArray(int N); + +/* + * ----------------------------------------------------------------- + * Function: DestroyArray + * ----------------------------------------------------------------- + * DestroyArray frees memory allocated by NewIntArray or by + * NewRealArray. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void DestroyArray(void *p); + +/* + * ----------------------------------------------------------------- + * Function : AddIdentity + * ----------------------------------------------------------------- + * AddIdentity adds 1.0 to the main diagonal (A_ii, i=1,2,...,N-1) of + * the M-by-N matrix A (M>= N) and stores the result back in A. + * AddIdentity is typically used with square matrices. + * AddIdentity does not check for M >= N and therefore a segmentation + * fault will occur if M < N! + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void AddIdentity(DlsMat A); + +/* + * ----------------------------------------------------------------- + * Function : SetToZero + * ----------------------------------------------------------------- + * SetToZero sets all the elements of the M-by-N matrix A to 0.0. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void SetToZero(DlsMat A); + +/* + * ----------------------------------------------------------------- + * Functions: PrintMat + * ----------------------------------------------------------------- + * This function prints the M-by-N (dense or band) matrix A to + * standard output as it would normally appear on paper. + * It is intended as debugging tools with small values of M and N. + * The elements are printed using the %g/%lg/%Lg option. + * A blank line is printed before and after the matrix. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void PrintMat(DlsMat A); + + +/* + * ================================================================== + * Exported function prototypes (functions working on realtype**) + * ================================================================== + */ + +SUNDIALS_EXPORT realtype **newDenseMat(int m, int n); +SUNDIALS_EXPORT realtype **newBandMat(int n, int smu, int ml); +SUNDIALS_EXPORT void destroyMat(realtype **a); +SUNDIALS_EXPORT int *newIntArray(int n); +SUNDIALS_EXPORT realtype *newRealArray(int m); +SUNDIALS_EXPORT void destroyArray(void *v); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/sundials/sundials_fnvector.h b/odemex/Parser/CVode/cv_src/include/sundials/sundials_fnvector.h new file mode 100644 index 0000000..bbc9a95 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/sundials/sundials_fnvector.h @@ -0,0 +1,41 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.1 $ + * $Date: 2006/07/05 15:27:52 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This file (companion of nvector.h) contains definitions + * needed for the initialization of vector operations in Fortran. + * ----------------------------------------------------------------- + */ + + +#ifndef _FNVECTOR_H +#define _FNVECTOR_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#ifndef _SUNDIALS_CONFIG_H +#define _SUNDIALS_CONFIG_H +#include +#endif + +/* SUNDIALS solver IDs */ + +#define FCMIX_CVODE 1 +#define FCMIX_IDA 2 +#define FCMIX_KINSOL 3 + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/sundials/sundials_iterative.h b/odemex/Parser/CVode/cv_src/include/sundials/sundials_iterative.h new file mode 100644 index 0000000..5e7e4bf --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/sundials/sundials_iterative.h @@ -0,0 +1,242 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2006/11/29 00:05:07 $ + * ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen and Alan C. Hindmarsh @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This header file contains declarations intended for use by + * generic iterative solvers of Ax = b. The enumeration gives + * symbolic names for the type of preconditioning to be used. + * The function type declarations give the prototypes for the + * functions to be called within an iterative linear solver, that + * are responsible for + * multiplying A by a given vector v (ATimesFn), and + * solving the preconditioner equation Pz = r (PSolveFn). + * ----------------------------------------------------------------- + */ + +#ifndef _ITERATIVE_H +#define _ITERATIVE_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + + +/* + * ----------------------------------------------------------------- + * enum : types of preconditioning + * ----------------------------------------------------------------- + * PREC_NONE : The iterative linear solver should not use + * preconditioning. + * + * PREC_LEFT : The iterative linear solver uses preconditioning on + * the left only. + * + * PREC_RIGHT : The iterative linear solver uses preconditioning on + * the right only. + * + * PREC_BOTH : The iterative linear solver uses preconditioning on + * both the left and the right. + * ----------------------------------------------------------------- + */ + +enum { PREC_NONE, PREC_LEFT, PREC_RIGHT, PREC_BOTH }; + +/* + * ----------------------------------------------------------------- + * enum : types of Gram-Schmidt routines + * ----------------------------------------------------------------- + * MODIFIED_GS : The iterative solver uses the modified + * Gram-Schmidt routine ModifiedGS listed in this + * file. + * + * CLASSICAL_GS : The iterative solver uses the classical + * Gram-Schmidt routine ClassicalGS listed in this + * file. + * ----------------------------------------------------------------- + */ + +enum { MODIFIED_GS = 1, CLASSICAL_GS = 2 }; + +/* + * ----------------------------------------------------------------- + * Type: ATimesFn + * ----------------------------------------------------------------- + * An ATimesFn multiplies Av and stores the result in z. The + * caller is responsible for allocating memory for the z vector. + * The parameter A_data is a pointer to any information about A + * which the function needs in order to do its job. The vector v + * is unchanged. An ATimesFn returns 0 if successful and a + * non-zero value if unsuccessful. + * ----------------------------------------------------------------- + */ + +typedef int (*ATimesFn)(void *A_data, N_Vector v, N_Vector z); + +/* + * ----------------------------------------------------------------- + * Type: PSolveFn + * ----------------------------------------------------------------- + * A PSolveFn solves the preconditioner equation Pz = r for the + * vector z. The caller is responsible for allocating memory for + * the z vector. The parameter P_data is a pointer to any + * information about P which the function needs in order to do + * its job. The parameter lr is input, and indicates whether P + * is to be taken as the left preconditioner or the right + * preconditioner: lr = 1 for left and lr = 2 for right. + * If preconditioning is on one side only, lr can be ignored. + * The vector r is unchanged. + * A PSolveFn returns 0 if successful and a non-zero value if + * unsuccessful. On a failure, a negative return value indicates + * an unrecoverable condition, while a positive value indicates + * a recoverable one, in which the calling routine may reattempt + * the solution after updating preconditioner data. + * ----------------------------------------------------------------- + */ + +typedef int (*PSolveFn)(void *P_data, N_Vector r, N_Vector z, int lr); + +/* + * ----------------------------------------------------------------- + * Function: ModifiedGS + * ----------------------------------------------------------------- + * ModifiedGS performs a modified Gram-Schmidt orthogonalization + * of the N_Vector v[k] against the p unit N_Vectors at + * v[k-1], v[k-2], ..., v[k-p]. + * + * v is an array of (k+1) N_Vectors v[i], i=0, 1, ..., k. + * v[k-1], v[k-2], ..., v[k-p] are assumed to have L2-norm + * equal to 1. + * + * h is the output k by k Hessenberg matrix of inner products. + * This matrix must be allocated row-wise so that the (i,j)th + * entry is h[i][j]. The inner products (v[i],v[k]), + * i=i0, i0+1, ..., k-1, are stored at h[i][k-1]. Here + * i0=MAX(0,k-p). + * + * k is the index of the vector in the v array that needs to be + * orthogonalized against previous vectors in the v array. + * + * p is the number of previous vectors in the v array against + * which v[k] is to be orthogonalized. + * + * new_vk_norm is a pointer to memory allocated by the caller to + * hold the Euclidean norm of the orthogonalized vector v[k]. + * + * If (k-p) < 0, then ModifiedGS uses p=k. The orthogonalized + * v[k] is NOT normalized and is stored over the old v[k]. Once + * the orthogonalization has been performed, the Euclidean norm + * of v[k] is stored in (*new_vk_norm). + * + * ModifiedGS returns 0 to indicate success. It cannot fail. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int ModifiedGS(N_Vector *v, realtype **h, int k, int p, + realtype *new_vk_norm); + +/* + * ----------------------------------------------------------------- + * Function: ClassicalGS + * ----------------------------------------------------------------- + * ClassicalGS performs a classical Gram-Schmidt + * orthogonalization of the N_Vector v[k] against the p unit + * N_Vectors at v[k-1], v[k-2], ..., v[k-p]. The parameters v, h, + * k, p, and new_vk_norm are as described in the documentation + * for ModifiedGS. + * + * temp is an N_Vector which can be used as workspace by the + * ClassicalGS routine. + * + * s is a length k array of realtype which can be used as + * workspace by the ClassicalGS routine. + * + * ClassicalGS returns 0 to indicate success. It cannot fail. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int ClassicalGS(N_Vector *v, realtype **h, int k, int p, + realtype *new_vk_norm, N_Vector temp, realtype *s); + +/* + * ----------------------------------------------------------------- + * Function: QRfact + * ----------------------------------------------------------------- + * QRfact performs a QR factorization of the Hessenberg matrix H. + * + * n is the problem size; the matrix H is (n+1) by n. + * + * h is the (n+1) by n Hessenberg matrix H to be factored. It is + * stored row-wise. + * + * q is an array of length 2*n containing the Givens rotations + * computed by this function. A Givens rotation has the form: + * | c -s | + * | s c |. + * The components of the Givens rotations are stored in q as + * (c, s, c, s, ..., c, s). + * + * job is a control flag. If job==0, then a new QR factorization + * is performed. If job!=0, then it is assumed that the first + * n-1 columns of h have already been factored and only the last + * column needs to be updated. + * + * QRfact returns 0 if successful. If a zero is encountered on + * the diagonal of the triangular factor R, then QRfact returns + * the equation number of the zero entry, where the equations are + * numbered from 1, not 0. If QRsol is subsequently called in + * this situation, it will return an error because it could not + * divide by the zero diagonal entry. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int QRfact(int n, realtype **h, realtype *q, int job); + +/* + * ----------------------------------------------------------------- + * Function: QRsol + * ----------------------------------------------------------------- + * QRsol solves the linear least squares problem + * + * min (b - H*x, b - H*x), x in R^n, + * + * where H is a Hessenberg matrix, and b is in R^(n+1). + * It uses the QR factors of H computed by QRfact. + * + * n is the problem size; the matrix H is (n+1) by n. + * + * h is a matrix (computed by QRfact) containing the upper + * triangular factor R of the original Hessenberg matrix H. + * + * q is an array of length 2*n (computed by QRfact) containing + * the Givens rotations used to factor H. + * + * b is the (n+1)-vector appearing in the least squares problem + * above. + * + * On return, b contains the solution x of the least squares + * problem, if QRsol was successful. + * + * QRsol returns a 0 if successful. Otherwise, a zero was + * encountered on the diagonal of the triangular factor R. + * In this case, QRsol returns the equation number (numbered + * from 1, not 0) of the zero entry. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int QRsol(int n, realtype **h, realtype *q, realtype *b); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/sundials/sundials_lapack.h b/odemex/Parser/CVode/cv_src/include/sundials/sundials_lapack.h new file mode 100644 index 0000000..4af89df --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/sundials/sundials_lapack.h @@ -0,0 +1,126 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.6 $ + * $Date: 2009/02/17 02:39:26 $ + * ----------------------------------------------------------------- + * Programmer: Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2006, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for a generic package of direct matrix + * operations for use with BLAS/LAPACK. + * ----------------------------------------------------------------- + */ + +#ifndef _SUNDIALS_LAPACK_H +#define _SUNDIALS_LAPACK_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* + * ================================================================== + * Blas and Lapack functions + * ================================================================== + */ + +#if defined(SUNDIALS_F77_FUNC) + +#define dcopy_f77 SUNDIALS_F77_FUNC(dcopy, DCOPY) +#define dscal_f77 SUNDIALS_F77_FUNC(dscal, DSCAL) +#define dgemv_f77 SUNDIALS_F77_FUNC(dgemv, DGEMV) +#define dtrsv_f77 SUNDIALS_F77_FUNC(dtrsv, DTRSV) +#define dsyrk_f77 SUNDIALS_F77_FUNC(dsyrk, DSKYR) + +#define dgbtrf_f77 SUNDIALS_F77_FUNC(dgbtrf, DGBTRF) +#define dgbtrs_f77 SUNDIALS_F77_FUNC(dgbtrs, DGBTRS) +#define dgetrf_f77 SUNDIALS_F77_FUNC(dgetrf, DGETRF) +#define dgetrs_f77 SUNDIALS_F77_FUNC(dgetrs, DGETRS) +#define dgeqp3_f77 SUNDIALS_F77_FUNC(dgeqp3, DGEQP3) +#define dgeqrf_f77 SUNDIALS_F77_FUNC(dgeqrf, DGEQRF) +#define dormqr_f77 SUNDIALS_F77_FUNC(dormqr, DORMQR) +#define dpotrf_f77 SUNDIALS_F77_FUNC(dpotrf, DPOTRF) +#define dpotrs_f77 SUNDIALS_F77_FUNC(dpotrs, DPOTRS) + +#else + +#define dcopy_f77 dcopy_ +#define dscal_f77 dscal_ +#define dgemv_f77 dgemv_ +#define dtrsv_f77 dtrsv_ +#define dsyrk_f77 dsyrk_ + +#define dgbtrf_f77 dgbtrf_ +#define dgbtrs_f77 dgbtrs_ +#define dgeqp3_f77 dgeqp3_ +#define dgeqrf_f77 dgeqrf_ +#define dgetrf_f77 dgetrf_ +#define dgetrs_f77 dgetrs_ +#define dormqr_f77 dormqr_ +#define dpotrf_f77 dpotrf_ +#define dpotrs_f77 dpotrs_ + +#endif + +/* Level-1 BLAS */ + +extern void dcopy_f77(int *n, const double *x, const int *inc_x, double *y, const int *inc_y); +extern void dscal_f77(int *n, const double *alpha, double *x, const int *inc_x); + +/* Level-2 BLAS */ + +extern void dgemv_f77(const char *trans, int *m, int *n, const double *alpha, const double *a, + int *lda, const double *x, int *inc_x, const double *beta, double *y, int *inc_y, + int len_trans); + +extern void dtrsv_f77(const char *uplo, const char *trans, const char *diag, const int *n, + const double *a, const int *lda, double *x, const int *inc_x, + int len_uplo, int len_trans, int len_diag); + +/* Level-3 BLAS */ + +extern void dsyrk_f77(const char *uplo, const char *trans, const int *n, const int *k, + const double *alpha, const double *a, const int *lda, const double *beta, + const double *c, const int *ldc, int len_uplo, int len_trans); + +/* LAPACK */ + +extern void dgbtrf_f77(const int *m, const int *n, const int *kl, const int *ku, + double *ab, int *ldab, int *ipiv, int *info); + +extern void dgbtrs_f77(const char *trans, const int *n, const int *kl, const int *ku, const int *nrhs, + double *ab, const int *ldab, int *ipiv, double *b, const int *ldb, + int *info, int len_trans); + + +extern void dgeqp3_f77(const int *m, const int *n, double *a, const int *lda, int *jpvt, double *tau, + double *work, const int *lwork, int *info); + +extern void dgeqrf_f77(const int *m, const int *n, double *a, const int *lda, double *tau, double *work, + const int *lwork, int *info); + +extern void dgetrf_f77(const int *m, const int *n, double *a, int *lda, int *ipiv, int *info); + +extern void dgetrs_f77(const char *trans, const int *n, const int *nrhs, double *a, const int *lda, + int *ipiv, double *b, const int *ldb, int *info, int len_trans); + + +extern void dormqr_f77(const char *side, const char *trans, const int *m, const int *n, const int *k, + double *a, const int *lda, double *tau, double *c, const int *ldc, + double *work, const int *lwork, int *info, int len_side, int len_trans); + +extern void dpotrf_f77(const char *uplo, const int *n, double *a, int *lda, int *info, int len_uplo); + +extern void dpotrs_f77(const char *uplo, const int *n, const int *nrhs, double *a, const int *lda, + double *b, const int *ldb, int * info, int len_uplo); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/sundials/sundials_math.h b/odemex/Parser/CVode/cv_src/include/sundials/sundials_math.h new file mode 100644 index 0000000..99de085 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/sundials/sundials_math.h @@ -0,0 +1,139 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2006/11/29 00:05:07 $ + * ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and + * Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for a simple C-language math library. The + * routines listed here work with the type realtype as defined in + * the header file sundials_types.h. + * ----------------------------------------------------------------- + */ + +#ifndef _SUNDIALSMATH_H +#define _SUNDIALSMATH_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ----------------------------------------------------------------- + * Macros : MIN and MAX + * ----------------------------------------------------------------- + * MIN(A,B) returns the minimum of A and B + * + * MAX(A,B) returns the maximum of A and B + * + * SQR(A) returns A^2 + * ----------------------------------------------------------------- + */ + +#ifndef MIN +#define MIN(A, B) ((A) < (B) ? (A) : (B)) +#endif + +#ifndef MAX +#define MAX(A, B) ((A) > (B) ? (A) : (B)) +#endif + +#ifndef SQR +#define SQR(A) ((A)*(A)) +#endif + +#ifndef ABS +#define ABS RAbs +#endif + +#ifndef SQRT +#define SQRT RSqrt +#endif + +#ifndef EXP +#define EXP RExp +#endif + +/* + * ----------------------------------------------------------------- + * Function : RPowerI + * ----------------------------------------------------------------- + * Usage : int exponent; + * realtype base, ans; + * ans = RPowerI(base,exponent); + * ----------------------------------------------------------------- + * RPowerI returns the value of base^exponent, where base is of type + * realtype and exponent is of type int. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT realtype RPowerI(realtype base, int exponent); + +/* + * ----------------------------------------------------------------- + * Function : RPowerR + * ----------------------------------------------------------------- + * Usage : realtype base, exponent, ans; + * ans = RPowerR(base,exponent); + * ----------------------------------------------------------------- + * RPowerR returns the value of base^exponent, where both base and + * exponent are of type realtype. If base < ZERO, then RPowerR + * returns ZERO. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT realtype RPowerR(realtype base, realtype exponent); + +/* + * ----------------------------------------------------------------- + * Function : RSqrt + * ----------------------------------------------------------------- + * Usage : realtype sqrt_x; + * sqrt_x = RSqrt(x); + * ----------------------------------------------------------------- + * RSqrt(x) returns the square root of x. If x < ZERO, then RSqrt + * returns ZERO. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT realtype RSqrt(realtype x); + +/* + * ----------------------------------------------------------------- + * Function : RAbs (a.k.a. ABS) + * ----------------------------------------------------------------- + * Usage : realtype abs_x; + * abs_x = RAbs(x); + * ----------------------------------------------------------------- + * RAbs(x) returns the absolute value of x. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT realtype RAbs(realtype x); + +/* + * ----------------------------------------------------------------- + * Function : RExp (a.k.a. EXP) + * ----------------------------------------------------------------- + * Usage : realtype exp_x; + * exp_x = RExp(x); + * ----------------------------------------------------------------- + * RExp(x) returns e^x (base-e exponential function). + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT realtype RExp(realtype x); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/sundials/sundials_nvector.h b/odemex/Parser/CVode/cv_src/include/sundials/sundials_nvector.h new file mode 100644 index 0000000..6142b32 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/sundials/sundials_nvector.h @@ -0,0 +1,373 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2006/11/29 00:05:07 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for a generic NVECTOR package. + * It defines the N_Vector structure (_generic_N_Vector) which + * contains the following fields: + * - an implementation-dependent 'content' field which contains + * the description and actual data of the vector + * - an 'ops' filed which contains a structure listing operations + * acting on such vectors + * + * Part I of this file contains type declarations for the + * _generic_N_Vector and _generic_N_Vector_Ops structures, as well + * as references to pointers to such structures (N_Vector). + * + * Part II of this file contains the prototypes for the vector + * functions which operate on N_Vector. + * + * At a minimum, a particular implementation of an NVECTOR must + * do the following: + * - specify the 'content' field of N_Vector, + * - implement the operations on those N_Vectors, + * - provide a constructor routine for new vectors + * + * Additionally, an NVECTOR implementation may provide the following: + * - macros to access the underlying N_Vector data + * - a constructor for an array of N_Vectors + * - a constructor for an empty N_Vector (i.e., a new N_Vector with + * a NULL data pointer). + * - a routine to print the content of an N_Vector + * ----------------------------------------------------------------- + */ + +#ifndef _NVECTOR_H +#define _NVECTOR_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ----------------------------------------------------------------- + * Generic definition of N_Vector + * ----------------------------------------------------------------- + */ + +/* Forward reference for pointer to N_Vector_Ops object */ +typedef struct _generic_N_Vector_Ops *N_Vector_Ops; + +/* Forward reference for pointer to N_Vector object */ +typedef struct _generic_N_Vector *N_Vector; + +/* Define array of N_Vectors */ +typedef N_Vector *N_Vector_S; + +/* Structure containing function pointers to vector operations */ +struct _generic_N_Vector_Ops { + N_Vector (*nvclone)(N_Vector); + N_Vector (*nvcloneempty)(N_Vector); + void (*nvdestroy)(N_Vector); + void (*nvspace)(N_Vector, long int *, long int *); + realtype* (*nvgetarraypointer)(N_Vector); + void (*nvsetarraypointer)(realtype *, N_Vector); + void (*nvlinearsum)(realtype, N_Vector, realtype, N_Vector, N_Vector); + void (*nvconst)(realtype, N_Vector); + void (*nvprod)(N_Vector, N_Vector, N_Vector); + void (*nvdiv)(N_Vector, N_Vector, N_Vector); + void (*nvscale)(realtype, N_Vector, N_Vector); + void (*nvabs)(N_Vector, N_Vector); + void (*nvinv)(N_Vector, N_Vector); + void (*nvaddconst)(N_Vector, realtype, N_Vector); + realtype (*nvdotprod)(N_Vector, N_Vector); + realtype (*nvmaxnorm)(N_Vector); + realtype (*nvwrmsnorm)(N_Vector, N_Vector); + realtype (*nvwrmsnormmask)(N_Vector, N_Vector, N_Vector); + realtype (*nvmin)(N_Vector); + realtype (*nvwl2norm)(N_Vector, N_Vector); + realtype (*nvl1norm)(N_Vector); + void (*nvcompare)(realtype, N_Vector, N_Vector); + booleantype (*nvinvtest)(N_Vector, N_Vector); + booleantype (*nvconstrmask)(N_Vector, N_Vector, N_Vector); + realtype (*nvminquotient)(N_Vector, N_Vector); +}; + +/* + * ----------------------------------------------------------------- + * A vector is a structure with an implementation-dependent + * 'content' field, and a pointer to a structure of vector + * operations corresponding to that implementation. + * ----------------------------------------------------------------- + */ + +struct _generic_N_Vector { + void *content; + struct _generic_N_Vector_Ops *ops; +}; + +/* + * ----------------------------------------------------------------- + * Functions exported by NVECTOR module + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * N_VClone + * Creates a new vector of the same type as an existing vector. + * It does not copy the vector, but rather allocates storage for + * the new vector. + * + * N_VCloneEmpty + * Creates a new vector of the same type as an existing vector, + * but does not allocate storage. + * + * N_VDestroy + * Destroys a vector created with N_VClone. + * + * N_VSpace + * Returns space requirements for one N_Vector (type 'realtype' in + * lrw and type 'long int' in liw). + * + * N_VGetArrayPointer + * Returns a pointer to the data component of the given N_Vector. + * NOTE: This function assumes that the internal data is stored + * as a contiguous 'realtype' array. This routine is only used in + * the solver-specific interfaces to the dense and banded linear + * solvers, as well as the interfaces to the banded preconditioners + * distributed with SUNDIALS. + * + * N_VSetArrayPointer + * Overwrites the data field in the given N_Vector with a user-supplied + * array of type 'realtype'. + * NOTE: This function assumes that the internal data is stored + * as a contiguous 'realtype' array. This routine is only used in + * the interfaces to the dense linear solver. + * + * N_VLinearSum + * Performs the operation z = a*x + b*y + * + * N_VConst + * Performs the operation z[i] = c for i = 0, 1, ..., N-1 + * + * N_VProd + * Performs the operation z[i] = x[i]*y[i] for i = 0, 1, ..., N-1 + * + * N_VDiv + * Performs the operation z[i] = x[i]/y[i] for i = 0, 1, ..., N-1 + * + * N_VScale + * Performs the operation z = c*x + * + * N_VAbs + * Performs the operation z[i] = |x[i]| for i = 0, 1, ..., N-1 + * + * N_VInv + * Performs the operation z[i] = 1/x[i] for i = 0, 1, ..., N-1 + * This routine does not check for division by 0. It should be + * called only with an N_Vector x which is guaranteed to have + * all non-zero components. + * + * N_VAddConst + * Performs the operation z[i] = x[i] + b for i = 0, 1, ..., N-1 + * + * N_VDotProd + * Returns the dot product of two vectors: + * sum (i = 0 to N-1) {x[i]*y[i]} + * + * N_VMaxNorm + * Returns the maximum norm of x: + * max (i = 0 to N-1) ABS(x[i]) + * + * N_VWrmsNorm + * Returns the weighted root mean square norm of x with weight + * vector w: + * sqrt [(sum (i = 0 to N-1) {(x[i]*w[i])^2})/N] + * + * N_VWrmsNormMask + * Returns the weighted root mean square norm of x with weight + * vector w, masked by the elements of id: + * sqrt [(sum (i = 0 to N-1) {(x[i]*w[i]*msk[i])^2})/N] + * where msk[i] = 1.0 if id[i] > 0 and + * msk[i] = 0.0 if id[i] < 0 + * + * N_VMin + * Returns the smallest element of x: + * min (i = 0 to N-1) x[i] + * + * N_VWL2Norm + * Returns the weighted Euclidean L2 norm of x with weight + * vector w: + * sqrt [(sum (i = 0 to N-1) {(x[i]*w[i])^2})] + * + * N_VL1Norm + * Returns the L1 norm of x: + * sum (i = 0 to N-1) {ABS(x[i])} + * + * N_VCompare + * Performs the operation + * z[i] = 1.0 if ABS(x[i]) >= c i = 0, 1, ..., N-1 + * 0.0 otherwise + * + * N_VInvTest + * Performs the operation z[i] = 1/x[i] with a test for + * x[i] == 0.0 before inverting x[i]. + * This routine returns TRUE if all components of x are non-zero + * (successful inversion) and returns FALSE otherwise. + * + * N_VConstrMask + * Performs the operation : + * m[i] = 1.0 if constraint test fails for x[i] + * m[i] = 0.0 if constraint test passes for x[i] + * where the constraint tests are as follows: + * If c[i] = +2.0, then x[i] must be > 0.0. + * If c[i] = +1.0, then x[i] must be >= 0.0. + * If c[i] = -1.0, then x[i] must be <= 0.0. + * If c[i] = -2.0, then x[i] must be < 0.0. + * This routine returns a boolean FALSE if any element failed + * the constraint test, TRUE if all passed. It also sets a + * mask vector m, with elements equal to 1.0 where the + * corresponding constraint test failed, and equal to 0.0 + * where the constraint test passed. + * This routine is specialized in that it is used only for + * constraint checking. + * + * N_VMinQuotient + * Performs the operation : + * minq = min ( num[i]/denom[i]) over all i such that + * denom[i] != 0. + * This routine returns the minimum of the quotients obtained + * by term-wise dividing num[i] by denom[i]. A zero element + * in denom will be skipped. If no such quotients are found, + * then the large value BIG_REAL is returned. + * + * ----------------------------------------------------------------- + * + * The following table lists the vector functions used by + * different modules in SUNDIALS. The symbols in the table + * have the following meaning: + * S - called by the solver; + * D - called by the dense linear solver module + * B - called by the band linear solver module + * Di - called by the diagonal linear solver module + * I - called by the iterative linear solver module + * BP - called by the band preconditioner module + * BBDP - called by the band-block diagonal preconditioner module + * F - called by the Fortran-to-C interface + * + * ------------------------------------------------ + * MODULES + * NVECTOR ------------------------------------------------ + * FUNCTIONS CVODE/CVODES IDA KINSOL + * ----------------------------------------------------------------- + * N_VClone S Di I S I BBDP S I BBDP + * ----------------------------------------------------------------- + * N_VCloneEmpty F F F + * ----------------------------------------------------------------- + * N_VDestroy S Di I S I BBDP S I BBDP + * ----------------------------------------------------------------- + * N_VSpace S S S + * ----------------------------------------------------------------- + * N_VGetArrayPointer D B BP BBDP F D B BBDP BBDP F + * ----------------------------------------------------------------- + * N_VSetArrayPointer D F D F + * ----------------------------------------------------------------- + * N_VLinearSum S D Di I S D I S I + * ----------------------------------------------------------------- + * N_VConst S I S I I + * ----------------------------------------------------------------- + * N_VProd S Di I S I S I + * ----------------------------------------------------------------- + * N_VDiv S Di I S I S I + * ----------------------------------------------------------------- + * N_VScale S D B Di I BP BBDP S D B I BBDP S I BBDP + * ----------------------------------------------------------------- + * N_VAbs S S S + * ----------------------------------------------------------------- + * N_VInv S Di S S + * ----------------------------------------------------------------- + * N_VAddConst S Di S + * ----------------------------------------------------------------- + * N_VDotProd I I I + * ----------------------------------------------------------------- + * N_VMaxNorm S S S + * ----------------------------------------------------------------- + * N_VWrmsNorm S D B I BP BBDP S + * ----------------------------------------------------------------- + * N_VWrmsNormMask S + * ----------------------------------------------------------------- + * N_VMin S S S + * ----------------------------------------------------------------- + * N_VWL2Norm S I + * ----------------------------------------------------------------- + * N_VL1Norm I + * ----------------------------------------------------------------- + * N_VCompare Di S + * ----------------------------------------------------------------- + * N_VInvTest Di + * ----------------------------------------------------------------- + * N_VConstrMask S S + * ----------------------------------------------------------------- + * N_VMinQuotient S S + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector N_VClone(N_Vector w); +SUNDIALS_EXPORT N_Vector N_VCloneEmpty(N_Vector w); +SUNDIALS_EXPORT void N_VDestroy(N_Vector v); +SUNDIALS_EXPORT void N_VSpace(N_Vector v, long int *lrw, long int *liw); +SUNDIALS_EXPORT realtype *N_VGetArrayPointer(N_Vector v); +SUNDIALS_EXPORT void N_VSetArrayPointer(realtype *v_data, N_Vector v); +SUNDIALS_EXPORT void N_VLinearSum(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VConst(realtype c, N_Vector z); +SUNDIALS_EXPORT void N_VProd(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VDiv(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VScale(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAbs(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VInv(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAddConst(N_Vector x, realtype b, N_Vector z); +SUNDIALS_EXPORT realtype N_VDotProd(N_Vector x, N_Vector y); +SUNDIALS_EXPORT realtype N_VMaxNorm(N_Vector x); +SUNDIALS_EXPORT realtype N_VWrmsNorm(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VWrmsNormMask(N_Vector x, N_Vector w, N_Vector id); +SUNDIALS_EXPORT realtype N_VMin(N_Vector x); +SUNDIALS_EXPORT realtype N_VWL2Norm(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VL1Norm(N_Vector x); +SUNDIALS_EXPORT void N_VCompare(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VInvTest(N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VConstrMask(N_Vector c, N_Vector x, N_Vector m); +SUNDIALS_EXPORT realtype N_VMinQuotient(N_Vector num, N_Vector denom); + +/* + * ----------------------------------------------------------------- + * Additional functions exported by NVECTOR module + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * N_VCloneEmptyVectorArray + * Creates (by cloning 'w') an array of 'count' empty N_Vectors + * + * N_VCloneVectorArray + * Creates (by cloning 'w') an array of 'count' N_Vectors + * + * N_VDestroyVectorArray + * Frees memory for an array of 'count' N_Vectors that was + * created by a call to N_VCloneVectorArray + * + * These functions are used by the SPGMR iterative linear solver + * module and by the CVODES and IDAS solvers. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector *N_VCloneEmptyVectorArray(int count, N_Vector w); +SUNDIALS_EXPORT N_Vector *N_VCloneVectorArray(int count, N_Vector w); +SUNDIALS_EXPORT void N_VDestroyVectorArray(N_Vector *vs, int count); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/sundials/sundials_spbcgs.h b/odemex/Parser/CVode/cv_src/include/sundials/sundials_spbcgs.h new file mode 100644 index 0000000..d569d1d --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/sundials/sundials_spbcgs.h @@ -0,0 +1,199 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2006/11/29 00:05:07 $ + * ----------------------------------------------------------------- + * Programmer(s): Peter Brown and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2004, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the implementation of the scaled, + * preconditioned Bi-CGSTAB (SPBCG) iterative linear solver. + * ----------------------------------------------------------------- + */ + +#ifndef _SPBCG_H +#define _SPBCG_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ----------------------------------------------------------------- + * Types: struct SpbcgMemRec and struct *SpbcgMem + * ----------------------------------------------------------------- + * A variable declaration of type struct *SpbcgMem denotes a pointer + * to a data structure of type struct SpbcgMemRec. The SpbcgMemRec + * structure contains numerous fields that must be accessed by the + * SPBCG linear solver module. + * + * l_max maximum Krylov subspace dimension that SpbcgSolve will + * be permitted to use + * + * r vector (type N_Vector) which holds the scaled, preconditioned + * linear system residual + * + * r_star vector (type N_Vector) which holds the initial scaled, + * preconditioned linear system residual + * + * p, q, u and Ap vectors (type N_Vector) used for workspace by + * the SPBCG algorithm + * + * vtemp scratch vector (type N_Vector) used as temporary vector + * storage + * ----------------------------------------------------------------- + */ + +typedef struct { + + int l_max; + + N_Vector r_star; + N_Vector r; + N_Vector p; + N_Vector q; + N_Vector u; + N_Vector Ap; + N_Vector vtemp; + +} SpbcgMemRec, *SpbcgMem; + +/* + * ----------------------------------------------------------------- + * Function : SpbcgMalloc + * ----------------------------------------------------------------- + * SpbcgMalloc allocates additional memory needed by the SPBCG + * linear solver module. + * + * l_max maximum Krylov subspace dimension that SpbcgSolve will + * be permitted to use + * + * vec_tmpl implementation-specific template vector (type N_Vector) + * (created using either N_VNew_Serial or N_VNew_Parallel) + * + * If successful, SpbcgMalloc returns a non-NULL memory pointer. If + * an error occurs, then a NULL pointer is returned. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT SpbcgMem SpbcgMalloc(int l_max, N_Vector vec_tmpl); + +/* + * ----------------------------------------------------------------- + * Function : SpbcgSolve + * ----------------------------------------------------------------- + * SpbcgSolve solves the linear system Ax = b by means of a scaled + * preconditioned Bi-CGSTAB (SPBCG) iterative method. + * + * mem pointer to an internal memory block allocated during a + * prior call to SpbcgMalloc + * + * A_data pointer to a data structure containing information + * about the coefficient matrix A (passed to user-supplied + * function referenced by atimes (function pointer)) + * + * x vector (type N_Vector) containing initial guess x_0 upon + * entry, but which upon return contains an approximate solution + * of the linear system Ax = b (solution only valid if return + * value is either SPBCG_SUCCESS or SPBCG_RES_REDUCED) + * + * b vector (type N_Vector) set to the right-hand side vector b + * of the linear system (undisturbed by function) + * + * pretype variable (type int) indicating the type of + * preconditioning to be used (see sundials_iterative.h) + * + * delta tolerance on the L2 norm of the scaled, preconditioned + * residual (if return value == SPBCG_SUCCESS, then + * ||sb*P1_inv*(b-Ax)||_L2 <= delta) + * + * P_data pointer to a data structure containing preconditioner + * information (passed to user-supplied function referenced + * by psolve (function pointer)) + * + * sx vector (type N_Vector) containing positive scaling factors + * for x (pass sx == NULL if scaling NOT required) + * + * sb vector (type N_Vector) containing positive scaling factors + * for b (pass sb == NULL if scaling NOT required) + * + * atimes user-supplied routine responsible for computing the + * matrix-vector product Ax (see sundials_iterative.h) + * + * psolve user-supplied routine responsible for solving the + * preconditioned linear system Pz = r (ignored if + * pretype == PREC_NONE) (see sundials_iterative.h) + * + * res_norm pointer (type realtype*) to the L2 norm of the + * scaled, preconditioned residual (if return value + * is either SPBCG_SUCCESS or SPBCG_RES_REDUCED, then + * *res_norm = ||sb*P1_inv*(b-Ax)||_L2, where x is + * the computed approximate solution, sb is the diagonal + * scaling matrix for the right-hand side b, and P1_inv + * is the inverse of the left-preconditioner matrix) + * + * nli pointer (type int*) to the total number of linear + * iterations performed + * + * nps pointer (type int*) to the total number of calls made + * to the psolve routine + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int SpbcgSolve(SpbcgMem mem, void *A_data, N_Vector x, N_Vector b, + int pretype, realtype delta, void *P_data, N_Vector sx, + N_Vector sb, ATimesFn atimes, PSolveFn psolve, + realtype *res_norm, int *nli, int *nps); + +/* Return values for SpbcgSolve */ + +#define SPBCG_SUCCESS 0 /* SPBCG algorithm converged */ +#define SPBCG_RES_REDUCED 1 /* SPBCG did NOT converge, but the + residual was reduced */ +#define SPBCG_CONV_FAIL 2 /* SPBCG algorithm failed to converge */ +#define SPBCG_PSOLVE_FAIL_REC 3 /* psolve failed recoverably */ +#define SPBCG_ATIMES_FAIL_REC 4 /* atimes failed recoverably */ +#define SPBCG_PSET_FAIL_REC 5 /* pset faild recoverably */ + +#define SPBCG_MEM_NULL -1 /* mem argument is NULL */ +#define SPBCG_ATIMES_FAIL_UNREC -2 /* atimes returned failure flag */ +#define SPBCG_PSOLVE_FAIL_UNREC -3 /* psolve failed unrecoverably */ +#define SPBCG_PSET_FAIL_UNREC -4 /* pset failed unrecoverably */ + +/* + * ----------------------------------------------------------------- + * Function : SpbcgFree + * ----------------------------------------------------------------- + * SpbcgFree frees the memory allocated by a call to SpbcgMalloc. + * It is illegal to use the pointer mem after a call to SpbcgFree. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void SpbcgFree(SpbcgMem mem); + +/* + * ----------------------------------------------------------------- + * Macro : SPBCG_VTEMP + * ----------------------------------------------------------------- + * This macro provides access to the vector r in the + * memory block of the SPBCG module. The argument mem is the + * memory pointer returned by SpbcgMalloc, of type SpbcgMem, + * and the macro value is of type N_Vector. + * + * Note: Only used by IDA (r contains P_inverse F if nli_inc == 0). + * ----------------------------------------------------------------- + */ + +#define SPBCG_VTEMP(mem) (mem->r) + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/sundials/sundials_spgmr.h b/odemex/Parser/CVode/cv_src/include/sundials/sundials_spgmr.h new file mode 100644 index 0000000..c557acd --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/sundials/sundials_spgmr.h @@ -0,0 +1,296 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2006/11/29 00:05:07 $ + * ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and + * Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the implementation of SPGMR Krylov + * iterative linear solver. The SPGMR algorithm is based on the + * Scaled Preconditioned GMRES (Generalized Minimal Residual) + * method. + * + * The SPGMR algorithm solves a linear system A x = b. + * Preconditioning is allowed on the left, right, or both. + * Scaling is allowed on both sides, and restarts are also allowed. + * We denote the preconditioner and scaling matrices as follows: + * P1 = left preconditioner + * P2 = right preconditioner + * S1 = diagonal matrix of scale factors for P1-inverse b + * S2 = diagonal matrix of scale factors for P2 x + * The matrices A, P1, and P2 are not required explicitly; only + * routines that provide A, P1-inverse, and P2-inverse as + * operators are required. + * + * In this notation, SPGMR applies the underlying GMRES method to + * the equivalent transformed system + * Abar xbar = bbar , where + * Abar = S1 (P1-inverse) A (P2-inverse) (S2-inverse) , + * bbar = S1 (P1-inverse) b , and xbar = S2 P2 x . + * + * The scaling matrices must be chosen so that vectors S1 + * P1-inverse b and S2 P2 x have dimensionless components. + * If preconditioning is done on the left only (P2 = I), by a + * matrix P, then S2 must be a scaling for x, while S1 is a + * scaling for P-inverse b, and so may also be taken as a scaling + * for x. Similarly, if preconditioning is done on the right only + * (P1 = I, P2 = P), then S1 must be a scaling for b, while S2 is + * a scaling for P x, and may also be taken as a scaling for b. + * + * The stopping test for the SPGMR iterations is on the L2 norm of + * the scaled preconditioned residual: + * || bbar - Abar xbar ||_2 < delta + * with an input test constant delta. + * + * The usage of this SPGMR solver involves supplying two routines + * and making three calls. The user-supplied routines are + * atimes (A_data, x, y) to compute y = A x, given x, + * and + * psolve (P_data, x, y, lr) + * to solve P1 x = y or P2 x = y for x, given y. + * The three user calls are: + * mem = SpgmrMalloc(lmax, vec_tmpl); + * to initialize memory, + * flag = SpgmrSolve(mem,A_data,x,b,..., + * P_data,s1,s2,atimes,psolve,...); + * to solve the system, and + * SpgmrFree(mem); + * to free the memory created by SpgmrMalloc. + * Complete details for specifying atimes and psolve and for the + * usage calls are given in the paragraphs below and in iterative.h. + * ----------------------------------------------------------------- + */ + +#ifndef _SPGMR_H +#define _SPGMR_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ----------------------------------------------------------------- + * Types: SpgmrMemRec, SpgmrMem + * ----------------------------------------------------------------- + * SpgmrMem is a pointer to an SpgmrMemRec which contains + * the memory needed by SpgmrSolve. The SpgmrMalloc routine + * returns a pointer of type SpgmrMem which should then be passed + * in subsequent calls to SpgmrSolve. The SpgmrFree routine frees + * the memory allocated by SpgmrMalloc. + * + * l_max is the maximum Krylov dimension that SpgmrSolve will be + * permitted to use. + * + * V is the array of Krylov basis vectors v_1, ..., v_(l_max+1), + * stored in V[0], ..., V[l_max], where l_max is the second + * parameter to SpgmrMalloc. Each v_i is a vector of type + * N_Vector. + * + * Hes is the (l_max+1) x l_max Hessenberg matrix. It is stored + * row-wise so that the (i,j)th element is given by Hes[i][j]. + * + * givens is a length 2*l_max array which represents the + * Givens rotation matrices that arise in the algorithm. The + * Givens rotation matrices F_0, F_1, ..., F_j, where F_i is + * + * 1 + * 1 + * c_i -s_i <--- row i + * s_i c_i + * 1 + * 1 + * + * are represented in the givens vector as + * givens[0]=c_0, givens[1]=s_0, givens[2]=c_1, givens[3]=s_1, + * ..., givens[2j]=c_j, givens[2j+1]=s_j. + * + * xcor is a vector (type N_Vector) which holds the scaled, + * preconditioned correction to the initial guess. + * + * yg is a length (l_max+1) array of realtype used to hold "short" + * vectors (e.g. y and g). + * + * vtemp is a vector (type N_Vector) used as temporary vector + * storage during calculations. + * ----------------------------------------------------------------- + */ + +typedef struct _SpgmrMemRec { + + int l_max; + + N_Vector *V; + realtype **Hes; + realtype *givens; + N_Vector xcor; + realtype *yg; + N_Vector vtemp; + +} SpgmrMemRec, *SpgmrMem; + +/* + * ----------------------------------------------------------------- + * Function : SpgmrMalloc + * ----------------------------------------------------------------- + * SpgmrMalloc allocates the memory used by SpgmrSolve. It + * returns a pointer of type SpgmrMem which the user of the + * SPGMR package should pass to SpgmrSolve. The parameter l_max + * is the maximum Krylov dimension that SpgmrSolve will be + * permitted to use. The parameter vec_tmpl is a pointer to an + * N_Vector used as a template to create new vectors by duplication. + * This routine returns NULL if there is a memory request failure. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT SpgmrMem SpgmrMalloc(int l_max, N_Vector vec_tmpl); + +/* + * ----------------------------------------------------------------- + * Function : SpgmrSolve + * ----------------------------------------------------------------- + * SpgmrSolve solves the linear system Ax = b using the SPGMR + * method. The return values are given by the symbolic constants + * below. The first SpgmrSolve parameter is a pointer to memory + * allocated by a prior call to SpgmrMalloc. + * + * mem is the pointer returned by SpgmrMalloc to the structure + * containing the memory needed by SpgmrSolve. + * + * A_data is a pointer to information about the coefficient + * matrix A. This pointer is passed to the user-supplied function + * atimes. + * + * x is the initial guess x_0 upon entry and the solution + * N_Vector upon exit with return value SPGMR_SUCCESS or + * SPGMR_RES_REDUCED. For all other return values, the output x + * is undefined. + * + * b is the right hand side N_Vector. It is undisturbed by this + * function. + * + * pretype is the type of preconditioning to be used. Its + * legal possible values are enumerated in iterativ.h. These + * values are PREC_NONE=0, PREC_LEFT=1, PREC_RIGHT=2, and + * PREC_BOTH=3. + * + * gstype is the type of Gram-Schmidt orthogonalization to be + * used. Its legal values are enumerated in iterativ.h. These + * values are MODIFIED_GS=0 and CLASSICAL_GS=1. + * + * delta is the tolerance on the L2 norm of the scaled, + * preconditioned residual. On return with value SPGMR_SUCCESS, + * this residual satisfies || s1 P1_inv (b - Ax) ||_2 <= delta. + * + * max_restarts is the maximum number of times the algorithm is + * allowed to restart. + * + * P_data is a pointer to preconditioner information. This + * pointer is passed to the user-supplied function psolve. + * + * s1 is an N_Vector of positive scale factors for P1-inv b, where + * P1 is the left preconditioner. (Not tested for positivity.) + * Pass NULL if no scaling on P1-inv b is required. + * + * s2 is an N_Vector of positive scale factors for P2 x, where + * P2 is the right preconditioner. (Not tested for positivity.) + * Pass NULL if no scaling on P2 x is required. + * + * atimes is the user-supplied function which performs the + * operation of multiplying A by a given vector. Its description + * is given in iterative.h. + * + * psolve is the user-supplied function which solves a + * preconditioner system Pz = r, where P is P1 or P2. Its full + * description is given in iterativ.h. The psolve function will + * not be called if pretype is NONE; in that case, the user + * should pass NULL for psolve. + * + * res_norm is a pointer to the L2 norm of the scaled, + * preconditioned residual. On return with value SPGMR_SUCCESS or + * SPGMR_RES_REDUCED, (*res_norm) contains the value + * || s1 P1_inv (b - Ax) ||_2 for the computed solution x. + * For all other return values, (*res_norm) is undefined. The + * caller is responsible for allocating the memory (*res_norm) + * to be filled in by SpgmrSolve. + * + * nli is a pointer to the number of linear iterations done in + * the execution of SpgmrSolve. The caller is responsible for + * allocating the memory (*nli) to be filled in by SpgmrSolve. + * + * nps is a pointer to the number of calls made to psolve during + * the execution of SpgmrSolve. The caller is responsible for + * allocating the memory (*nps) to be filled in by SpgmrSolve. + * + * Note: Repeated calls can be made to SpgmrSolve with varying + * input arguments. If, however, the problem size N or the + * maximum Krylov dimension l_max changes, then a call to + * SpgmrMalloc must be made to obtain new memory for SpgmrSolve + * to use. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int SpgmrSolve(SpgmrMem mem, void *A_data, N_Vector x, N_Vector b, + int pretype, int gstype, realtype delta, + int max_restarts, void *P_data, N_Vector s1, + N_Vector s2, ATimesFn atimes, PSolveFn psolve, + realtype *res_norm, int *nli, int *nps); + + +/* Return values for SpgmrSolve */ + +#define SPGMR_SUCCESS 0 /* Converged */ +#define SPGMR_RES_REDUCED 1 /* Did not converge, but reduced + norm of residual */ +#define SPGMR_CONV_FAIL 2 /* Failed to converge */ +#define SPGMR_QRFACT_FAIL 3 /* QRfact found singular matrix */ +#define SPGMR_PSOLVE_FAIL_REC 4 /* psolve failed recoverably */ +#define SPGMR_ATIMES_FAIL_REC 5 /* atimes failed recoverably */ +#define SPGMR_PSET_FAIL_REC 6 /* pset faild recoverably */ + +#define SPGMR_MEM_NULL -1 /* mem argument is NULL */ +#define SPGMR_ATIMES_FAIL_UNREC -2 /* atimes returned failure flag */ +#define SPGMR_PSOLVE_FAIL_UNREC -3 /* psolve failed unrecoverably */ +#define SPGMR_GS_FAIL -4 /* Gram-Schmidt routine faiuled */ +#define SPGMR_QRSOL_FAIL -5 /* QRsol found singular R */ +#define SPGMR_PSET_FAIL_UNREC -6 /* pset failed unrecoverably */ + +/* + * ----------------------------------------------------------------- + * Function : SpgmrFree + * ----------------------------------------------------------------- + * SpgmrMalloc frees the memory allocated by SpgmrMalloc. It is + * illegal to use the pointer mem after a call to SpgmrFree. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void SpgmrFree(SpgmrMem mem); + +/* + * ----------------------------------------------------------------- + * Macro: SPGMR_VTEMP + * ----------------------------------------------------------------- + * This macro provides access to the work vector vtemp in the + * memory block of the SPGMR module. The argument mem is the + * memory pointer returned by SpgmrMalloc, of type SpgmrMem, + * and the macro value is of type N_Vector. + * On a return from SpgmrSolve with *nli = 0, this vector + * contains the scaled preconditioned initial residual, + * s1 * P1_inverse * (b - A x_0). + * ----------------------------------------------------------------- + */ + +#define SPGMR_VTEMP(mem) (mem->vtemp) + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/sundials/sundials_sptfqmr.h b/odemex/Parser/CVode/cv_src/include/sundials/sundials_sptfqmr.h new file mode 100644 index 0000000..2ba5c37 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/sundials/sundials_sptfqmr.h @@ -0,0 +1,254 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2006/11/29 00:05:07 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the implementation of the scaled + * preconditioned Transpose-Free Quasi-Minimal Residual (SPTFQMR) + * linear solver. + * + * The SPTFQMR algorithm solves a linear system of the form Ax = b. + * Preconditioning is allowed on the left (PREC_LEFT), right + * (PREC_RIGHT), or both (PREC_BOTH). Scaling is allowed on both + * sides. We denote the preconditioner and scaling matrices as + * follows: + * P1 = left preconditioner + * P2 = right preconditioner + * S1 = diagonal matrix of scale factors for P1-inverse b + * S2 = diagonal matrix of scale factors for P2 x + * The matrices A, P1, and P2 are not required explicitly; only + * routines that provide A, P1-inverse, and P2-inverse as operators + * are required. + * + * In this notation, SPTFQMR applies the underlying TFQMR method to + * the equivalent transformed system: + * Abar xbar = bbar, where + * Abar = S1 (P1-inverse) A (P2-inverse) (S2-inverse), + * bbar = S1 (P1-inverse) b, and + * xbar = S2 P2 x. + * + * The scaling matrices must be chosen so that vectors + * S1 P1-inverse b and S2 P2 x have dimensionless components. If + * preconditioning is done on the left only (P2 = I), by a matrix P, + * then S2 must be a scaling for x, while S1 is a scaling for + * P-inverse b, and so may also be taken as a scaling for x. + * Similarly, if preconditioning is done on the right only (P1 = I, + * P2 = P), then S1 must be a scaling for b, while S2 is a scaling + * for P x, and may also be taken as a scaling for b. + * + * The stopping test for the SPTFQMR iterations is on the L2-norm of + * the scaled preconditioned residual: + * || bbar - Abar xbar ||_2 < delta + * with an input test constant delta. + * + * The usage of this SPTFQMR solver involves supplying two routines + * and making three calls. The user-supplied routines are: + * atimes(A_data, x, y) to compute y = A x, given x, + * and + * psolve(P_data, x, y, lr) to solve P1 x = y or P2 x = y for x, + * given y. + * The three user calls are: + * mem = SptfqmrMalloc(lmax, vec_tmpl); + * to initialize memory + * flag = SptfqmrSolve(mem, A_data, x, b, pretype, delta, P_data, + * sx, sb, atimes, psolve, res_norm, nli, nps); + * to solve the system, and + * SptfqmrFree(mem); + * to free the memory allocated by SptfqmrMalloc(). + * Complete details for specifying atimes() and psolve() and for the + * usage calls are given in the paragraphs below and in the header + * file sundials_iterative.h. + * ----------------------------------------------------------------- + */ + +#ifndef _SPTFQMR_H +#define _SPTFQMR_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ----------------------------------------------------------------- + * Types: struct SptfqmrMemRec and struct *SptfqmrMem + * ----------------------------------------------------------------- + * A variable declaration of type struct *SptfqmrMem denotes a pointer + * to a data structure of type struct SptfqmrMemRec. The SptfqmrMemRec + * structure contains numerous fields that must be accessed by the + * SPTFQMR linear solver module. + * + * l_max maximum Krylov subspace dimension that SptfqmrSolve will + * be permitted to use + * + * r_star vector (type N_Vector) which holds the initial scaled, + * preconditioned linear system residual + * + * q/d/v/p/u/r vectors (type N_Vector) used for workspace by + * the SPTFQMR algorithm + * + * vtemp1/vtemp2/vtemp3 scratch vectors (type N_Vector) used as + * temporary storage + * ----------------------------------------------------------------- + */ + +typedef struct { + + int l_max; + + N_Vector r_star; + N_Vector q; + N_Vector d; + N_Vector v; + N_Vector p; + N_Vector *r; + N_Vector u; + N_Vector vtemp1; + N_Vector vtemp2; + N_Vector vtemp3; + +} SptfqmrMemRec, *SptfqmrMem; + +/* + * ----------------------------------------------------------------- + * Function : SptfqmrMalloc + * ----------------------------------------------------------------- + * SptfqmrMalloc allocates additional memory needed by the SPTFQMR + * linear solver module. + * + * l_max maximum Krylov subspace dimension that SptfqmrSolve will + * be permitted to use + * + * vec_tmpl implementation-specific template vector (type N_Vector) + * (created using either N_VNew_Serial or N_VNew_Parallel) + * + * If successful, SptfqmrMalloc returns a non-NULL memory pointer. If + * an error occurs, then a NULL pointer is returned. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT SptfqmrMem SptfqmrMalloc(int l_max, N_Vector vec_tmpl); + +/* + * ----------------------------------------------------------------- + * Function : SptfqmrSolve + * ----------------------------------------------------------------- + * SptfqmrSolve solves the linear system Ax = b by means of a scaled + * preconditioned Transpose-Free Quasi-Minimal Residual (SPTFQMR) + * method. + * + * mem pointer to an internal memory block allocated during a + * prior call to SptfqmrMalloc + * + * A_data pointer to a data structure containing information + * about the coefficient matrix A (passed to user-supplied + * function referenced by atimes (function pointer)) + * + * x vector (type N_Vector) containing initial guess x_0 upon + * entry, but which upon return contains an approximate solution + * of the linear system Ax = b (solution only valid if return + * value is either SPTFQMR_SUCCESS or SPTFQMR_RES_REDUCED) + * + * b vector (type N_Vector) set to the right-hand side vector b + * of the linear system (undisturbed by function) + * + * pretype variable (type int) indicating the type of + * preconditioning to be used (see sundials_iterative.h) + * + * delta tolerance on the L2 norm of the scaled, preconditioned + * residual (if return value == SPTFQMR_SUCCESS, then + * ||sb*P1_inv*(b-Ax)||_L2 <= delta) + * + * P_data pointer to a data structure containing preconditioner + * information (passed to user-supplied function referenced + * by psolve (function pointer)) + * + * sx vector (type N_Vector) containing positive scaling factors + * for x (pass sx == NULL if scaling NOT required) + * + * sb vector (type N_Vector) containing positive scaling factors + * for b (pass sb == NULL if scaling NOT required) + * + * atimes user-supplied routine responsible for computing the + * matrix-vector product Ax (see sundials_iterative.h) + * + * psolve user-supplied routine responsible for solving the + * preconditioned linear system Pz = r (ignored if + * pretype == PREC_NONE) (see sundials_iterative.h) + * + * res_norm pointer (type realtype*) to the L2 norm of the + * scaled, preconditioned residual (if return value + * is either SPTFQMR_SUCCESS or SPTFQMR_RES_REDUCED, then + * *res_norm = ||sb*P1_inv*(b-Ax)||_L2, where x is + * the computed approximate solution, sb is the diagonal + * scaling matrix for the right-hand side b, and P1_inv + * is the inverse of the left-preconditioner matrix) + * + * nli pointer (type int*) to the total number of linear + * iterations performed + * + * nps pointer (type int*) to the total number of calls made + * to the psolve routine + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int SptfqmrSolve(SptfqmrMem mem, void *A_data, N_Vector x, N_Vector b, + int pretype, realtype delta, void *P_data, N_Vector sx, + N_Vector sb, ATimesFn atimes, PSolveFn psolve, + realtype *res_norm, int *nli, int *nps); + +/* Return values for SptfqmrSolve */ + +#define SPTFQMR_SUCCESS 0 /* SPTFQMR algorithm converged */ +#define SPTFQMR_RES_REDUCED 1 /* SPTFQMR did NOT converge, but the + residual was reduced */ +#define SPTFQMR_CONV_FAIL 2 /* SPTFQMR algorithm failed to converge */ +#define SPTFQMR_PSOLVE_FAIL_REC 3 /* psolve failed recoverably */ +#define SPTFQMR_ATIMES_FAIL_REC 4 /* atimes failed recoverably */ +#define SPTFQMR_PSET_FAIL_REC 5 /* pset faild recoverably */ + +#define SPTFQMR_MEM_NULL -1 /* mem argument is NULL */ +#define SPTFQMR_ATIMES_FAIL_UNREC -2 /* atimes returned failure flag */ +#define SPTFQMR_PSOLVE_FAIL_UNREC -3 /* psolve failed unrecoverably */ +#define SPTFQMR_PSET_FAIL_UNREC -4 /* pset failed unrecoverably */ + +/* + * ----------------------------------------------------------------- + * Function : SptfqmrFree + * ----------------------------------------------------------------- + * SptfqmrFree frees the memory allocated by a call to SptfqmrMalloc. + * It is illegal to use the pointer mem after a call to SptfqmrFree. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void SptfqmrFree(SptfqmrMem mem); + +/* + * ----------------------------------------------------------------- + * Macro : SPTFQMR_VTEMP + * ----------------------------------------------------------------- + * This macro provides access to the work vector vtemp1 in the + * memory block of the SPTFQMR module. The argument mem is the + * memory pointer returned by SptfqmrMalloc, of type SptfqmrMem, + * and the macro value is of type N_Vector. + * + * Note: Only used by IDA (vtemp1 contains P_inverse F if + * nli_inc == 0). + * ----------------------------------------------------------------- + */ + +#define SPTFQMR_VTEMP(mem) (mem->vtemp1) + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/sundials/sundials_types.h b/odemex/Parser/CVode/cv_src/include/sundials/sundials_types.h new file mode 100644 index 0000000..953f6e0 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/sundials/sundials_types.h @@ -0,0 +1,122 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2006/11/29 00:05:07 $ + * ----------------------------------------------------------------- + * Programmer(s): Scott Cohen, Alan Hindmarsh, Radu Serban, and + * Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + *------------------------------------------------------------------ + * This header file exports two types: realtype and booleantype, + * as well as the constants TRUE and FALSE. + * + * Users should include the header file sundials_types.h in every + * program file and use the exported name realtype instead of + * float, double or long double. + * + * The constants SUNDIALS_SINGLE_PRECISION, SUNDIALS_DOUBLE_PRECISION + * and SUNDIALS_LONG_DOUBLE_PRECISION indicate the underlying data + * type of realtype. It is set at the configuration stage. + * + * The legal types for realtype are float, double and long double. + * + * The macro RCONST gives the user a convenient way to define + * real-valued constants. To use the constant 1.0, for example, + * the user should write the following: + * + * #define ONE RCONST(1.0) + * + * If realtype is defined as a double, then RCONST(1.0) expands + * to 1.0. If realtype is defined as a float, then RCONST(1.0) + * expands to 1.0F. If realtype is defined as a long double, + * then RCONST(1.0) expands to 1.0L. There is never a need to + * explicitly cast 1.0 to (realtype). + *------------------------------------------------------------------ + */ + +#ifndef _SUNDIALSTYPES_H +#define _SUNDIALSTYPES_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#ifndef _SUNDIALS_CONFIG_H +#define _SUNDIALS_CONFIG_H +#include +#endif + +#include + +/* + *------------------------------------------------------------------ + * Type realtype + * Macro RCONST + * Constants BIG_REAL, SMALL_REAL, and UNIT_ROUNDOFF + *------------------------------------------------------------------ + */ + +#if defined(SUNDIALS_SINGLE_PRECISION) + +typedef float realtype; +# define RCONST(x) x##F +# define BIG_REAL FLT_MAX +# define SMALL_REAL FLT_MIN +# define UNIT_ROUNDOFF FLT_EPSILON + +#elif defined(SUNDIALS_DOUBLE_PRECISION) + +typedef double realtype; +# define RCONST(x) x +# define BIG_REAL DBL_MAX +# define SMALL_REAL DBL_MIN +# define UNIT_ROUNDOFF DBL_EPSILON + +#elif defined(SUNDIALS_EXTENDED_PRECISION) + +typedef long double realtype; +# define RCONST(x) x##L +# define BIG_REAL LDBL_MAX +# define SMALL_REAL LDBL_MIN +# define UNIT_ROUNDOFF LDBL_EPSILON + +#endif + +/* + *------------------------------------------------------------------ + * Type : booleantype + *------------------------------------------------------------------ + * Constants : FALSE and TRUE + *------------------------------------------------------------------ + * ANSI C does not have a built-in boolean data type. Below is the + * definition for a new type called booleantype. The advantage of + * using the name booleantype (instead of int) is an increase in + * code readability. It also allows the programmer to make a + * distinction between int and boolean data. Variables of type + * booleantype are intended to have only the two values FALSE and + * TRUE which are defined below to be equal to 0 and 1, + * respectively. + *------------------------------------------------------------------ + */ + +#ifndef booleantype +#define booleantype int +#endif + +#ifndef FALSE +#define FALSE 0 +#endif + +#ifndef TRUE +#define TRUE 1 +#endif + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/sundials/winDefine.h b/odemex/Parser/CVode/cv_src/include/sundials/winDefine.h new file mode 100644 index 0000000..1b97a07 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/sundials/winDefine.h @@ -0,0 +1,44 @@ +/* + Joep Vanlier, 2011 + + Licensing: + Copyright (C) 2009-2011 Joep Vanlier. All rights + reserved. + + Contact:joep.vanlier@gmail.com + + This file is part of the puaMAT. + + puaMAT is free software: you can redistribute it + and/or modify it under the terms of the GNU General + Public License as published by the Free Software + Foundation, either version 3 of the License, or (at + your option) any later version. + + puaMAT is distributed in the hope that it will be + useful, but WITHOUT ANY WARRANTY; without even the + implied warranty of MERCHANTABILITY or FITNESS FOR A + PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General + Public License along with puaMAT. If not, see + http://www.gnu.org/licenses/ +*/ + + + #define dcopy_ dcopy + #define dscal_ dscal + #define dgemv_ dgemv + #define dtrsv_ dtrsv + #define dgetrf_ dgetrf + #define dgetrs_ dgetrs + #define dgbtrs_ dgbtrs + #define dgbtrf_ dgbtrf + #define dsyrk_ dsyrk + #define dgeqp3_ dgeqp3 + #define dormqr_ dormqr + #define dpotrf_ dpotrf_ + #define dgeqrf_ dgeqrf + #define dpotrs_ dpotrs + diff --git a/odemex/Parser/CVode/cv_src/include/sundials_band.h b/odemex/Parser/CVode/cv_src/include/sundials_band.h new file mode 100644 index 0000000..95ee54c --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/sundials_band.h @@ -0,0 +1,153 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.5 $ + * $Date: 2009/02/17 02:39:26 $ + * ----------------------------------------------------------------- + * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for a generic BAND linear solver + * package, based on the DlsMat type defined in sundials_direct.h. + * + * There are two sets of band solver routines listed in + * this file: one set uses type DlsMat defined below and the + * other set uses the type realtype ** for band matrix arguments. + * Routines that work with the type DlsMat begin with "Band". + * Routines that work with realtype ** begin with "band" + * ----------------------------------------------------------------- + */ + +#ifndef _SUNDIALS_BAND_H +#define _SUNDIALS_BAND_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ----------------------------------------------------------------- + * Function : BandGBTRF + * ----------------------------------------------------------------- + * Usage : ier = BandGBTRF(A, p); + * if (ier != 0) ... A is singular + * ----------------------------------------------------------------- + * BandGBTRF performs the LU factorization of the N by N band + * matrix A. This is done using standard Gaussian elimination + * with partial pivoting. + * + * A successful LU factorization leaves the "matrix" A and the + * pivot array p with the following information: + * + * (1) p[k] contains the row number of the pivot element chosen + * at the beginning of elimination step k, k=0, 1, ..., N-1. + * + * (2) If the unique LU factorization of A is given by PA = LU, + * where P is a permutation matrix, L is a lower triangular + * matrix with all 1's on the diagonal, and U is an upper + * triangular matrix, then the upper triangular part of A + * (including its diagonal) contains U and the strictly lower + * triangular part of A contains the multipliers, I-L. + * + * BandGBTRF returns 0 if successful. Otherwise it encountered + * a zero diagonal element during the factorization. In this case + * it returns the column index (numbered from one) at which + * it encountered the zero. + * + * Important Note: A must be allocated to accommodate the increase + * in upper bandwidth that occurs during factorization. If + * mathematically, A is a band matrix with upper bandwidth mu and + * lower bandwidth ml, then the upper triangular factor U can + * have upper bandwidth as big as smu = MIN(n-1,mu+ml). The lower + * triangular factor L has lower bandwidth ml. Allocate A with + * call A = BandAllocMat(N,mu,ml,smu), where mu, ml, and smu are + * as defined above. The user does not have to zero the "extra" + * storage allocated for the purpose of factorization. This will + * handled by the BandGBTRF routine. + * + * BandGBTRF is only a wrapper around bandGBTRF. All work is done + * in bandGBTRF works directly on the data in the DlsMat A (i.e., + * the field cols). + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int BandGBTRF(DlsMat A, int *p); +SUNDIALS_EXPORT int bandGBTRF(realtype **a, int n, int mu, int ml, int smu, int *p); + +/* + * ----------------------------------------------------------------- + * Function : BandGBTRS + * ----------------------------------------------------------------- + * Usage : BandGBTRS(A, p, b); + * ----------------------------------------------------------------- + * BandGBTRS solves the N-dimensional system A x = b using + * the LU factorization in A and the pivot information in p + * computed in BandGBTRF. The solution x is returned in b. This + * routine cannot fail if the corresponding call to BandGBTRF + * did not fail. + * + * BandGBTRS is only a wrapper around bandGBTRS which does all the + * work directly on the data in the DlsMat A (i.e., the field cols). + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void BandGBTRS(DlsMat A, int *p, realtype *b); +SUNDIALS_EXPORT void bandGBTRS(realtype **a, int n, int smu, int ml, int *p, realtype *b); + +/* + * ----------------------------------------------------------------- + * Function : BandCopy + * ----------------------------------------------------------------- + * Usage : BandCopy(A, B, copymu, copyml); + * ----------------------------------------------------------------- + * BandCopy copies the submatrix with upper and lower bandwidths + * copymu, copyml of the N by N band matrix A into the N by N + * band matrix B. + * + * BandCopy is a wrapper around bandCopy which accesses the data + * in the DlsMat A and B (i.e. the fields cols) + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void BandCopy(DlsMat A, DlsMat B, int copymu, int copyml); +SUNDIALS_EXPORT void bandCopy(realtype **a, realtype **b, int n, int a_smu, int b_smu, + int copymu, int copyml); + +/* + * ----------------------------------------------------------------- + * Function: BandScale + * ----------------------------------------------------------------- + * Usage : BandScale(c, A); + * ----------------------------------------------------------------- + * A(i,j) <- c*A(i,j), j-(A->mu) <= i <= j+(A->ml). + * + * BandScale is a wrapper around bandScale which performs the actual + * scaling by accessing the data in the DlsMat A (i.e. the field + * cols). + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void BandScale(realtype c, DlsMat A); +SUNDIALS_EXPORT void bandScale(realtype c, realtype **a, int n, int mu, int ml, int smu); + +/* + * ----------------------------------------------------------------- + * Function: bandAddIdentity + * ----------------------------------------------------------------- + * bandAddIdentity adds the identity matrix to the n-by-n matrix + * stored in the realtype** arrays. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void bandAddIdentity(realtype **a, int n, int smu); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/sundials_config.in b/odemex/Parser/CVode/cv_src/include/sundials_config.in new file mode 100644 index 0000000..24e9be8 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/sundials_config.in @@ -0,0 +1,78 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.4 $ + * $Date: 2007/12/19 20:34:00 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + *------------------------------------------------------------------ + * SUNDIALS configuration header file + *------------------------------------------------------------------ + */ + +/* Define SUNDIALS version number */ +#define SUNDIALS_PACKAGE_VERSION "@PACKAGE_VERSION@" + +/* FCMIX: Define Fortran name-mangling macro for C identifiers. + * Depending on the inferred scheme, one of the following six + * macros will be defined: + * #define SUNDIALS_F77_FUNC(name,NAME) name + * #define SUNDIALS_F77_FUNC(name,NAME) name ## _ + * #define SUNDIALS_F77_FUNC(name,NAME) name ## __ + * #define SUNDIALS_F77_FUNC(name,NAME) NAME + * #define SUNDIALS_F77_FUNC(name,NAME) NAME ## _ + * #define SUNDIALS_F77_FUNC(name,NAME) NAME ## __ + */ +@F77_MANGLE_MACRO1@ + +/* FCMIX: Define Fortran name-mangling macro for C identifiers + * which contain underscores. + */ +@F77_MANGLE_MACRO2@ + +/* Define precision of SUNDIALS data type 'realtype' + * Depending on the precision level, one of the following + * three macros will be defined: + * #define SUNDIALS_SINGLE_PRECISION 1 + * #define SUNDIALS_DOUBLE_PRECISION 1 + * #define SUNDIALS_EXTENDED_PRECISION 1 + */ +@PRECISION_LEVEL@ + +/* Use generic math functions + * If it was decided that generic math functions can be used, then + * #define SUNDIALS_USE_GENERIC_MATH 1 + * otherwise + * #define SUNDIALS_USE_GENERIC_MATH 0 + */ +@GENERIC_MATH_LIB@ +#define SUNDIALS_BLAS_LAPACK 1 +/* Blas/Lapack available + * If working libraries for Blas/lapack support were found, then + * #define SUNDIALS_BLAS_LAPACK 1 + * otherwise + * #define SUNDIALS_BLAS_LAPACK 0 + */ +@BLAS_LAPACK_MACRO@ + +/* FNVECTOR: Allow user to specify different MPI communicator + * If it was found that the MPI implementation supports MPI_Comm_f2c, then + * #define SUNDIALS_MPI_COMM_F2C 1 + * otherwise + * #define SUNDIALS_MPI_COMM_F2C 0 + */ +@F77_MPI_COMM_F2C@ + +/* Mark SUNDIALS API functions for export/import + * When building shared SUNDIALS libraries under Windows, use + * #define SUNDIALS_EXPORT __declspec(dllexport) + * When linking to shared SUNDIALS libraries under Windows, use + * #define SUNDIALS_EXPORT __declspec(dllimport) + * In all other cases (other platforms or static libraries under + * Windows), the SUNDIALS_EXPORT macro is empty + */ +@SUNDIALS_EXPORT@ diff --git a/odemex/Parser/CVode/cv_src/include/sundials_dense.h b/odemex/Parser/CVode/cv_src/include/sundials_dense.h new file mode 100644 index 0000000..a3b1431 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/sundials_dense.h @@ -0,0 +1,187 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.7 $ + * $Date: 2009/02/17 02:39:26 $ + * ----------------------------------------------------------------- + * Programmer: Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2006, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for a generic package of DENSE matrix + * operations, based on the DlsMat type defined in sundials_direct.h. + * + * There are two sets of dense solver routines listed in + * this file: one set uses type DlsMat defined below and the + * other set uses the type realtype ** for dense matrix arguments. + * Routines that work with the type DlsMat begin with "Dense". + * Routines that work with realtype** begin with "dense". + * ----------------------------------------------------------------- + */ + +#ifndef _SUNDIALS_DENSE_H +#define _SUNDIALS_DENSE_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ----------------------------------------------------------------- + * Functions: DenseGETRF and DenseGETRS + * ----------------------------------------------------------------- + * DenseGETRF performs the LU factorization of the M by N dense + * matrix A. This is done using standard Gaussian elimination + * with partial (row) pivoting. Note that this applies only + * to matrices with M >= N and full column rank. + * + * A successful LU factorization leaves the matrix A and the + * pivot array p with the following information: + * + * (1) p[k] contains the row number of the pivot element chosen + * at the beginning of elimination step k, k=0, 1, ..., N-1. + * + * (2) If the unique LU factorization of A is given by PA = LU, + * where P is a permutation matrix, L is a lower trapezoidal + * matrix with all 1's on the diagonal, and U is an upper + * triangular matrix, then the upper triangular part of A + * (including its diagonal) contains U and the strictly lower + * trapezoidal part of A contains the multipliers, I-L. + * + * For square matrices (M=N), L is unit lower triangular. + * + * DenseGETRF returns 0 if successful. Otherwise it encountered + * a zero diagonal element during the factorization. In this case + * it returns the column index (numbered from one) at which + * it encountered the zero. + * + * DenseGETRS solves the N-dimensional system A x = b using + * the LU factorization in A and the pivot information in p + * computed in DenseGETRF. The solution x is returned in b. This + * routine cannot fail if the corresponding call to DenseGETRF + * did not fail. + * DenseGETRS does NOT check for a square matrix! + * + * ----------------------------------------------------------------- + * DenseGETRF and DenseGETRS are simply wrappers around denseGETRF + * and denseGETRS, respectively, which perform all the work by + * directly accessing the data in the DlsMat A (i.e. the field cols) + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int DenseGETRF(DlsMat A, int *p); +SUNDIALS_EXPORT void DenseGETRS(DlsMat A, int *p, realtype *b); + +SUNDIALS_EXPORT int denseGETRF(realtype **a, int m, int n, int *p); +SUNDIALS_EXPORT void denseGETRS(realtype **a, int n, int *p, realtype *b); + +/* + * ----------------------------------------------------------------- + * Functions : DensePOTRF and DensePOTRS + * ----------------------------------------------------------------- + * DensePOTRF computes the Cholesky factorization of a real symmetric + * positive definite matrix A. + * ----------------------------------------------------------------- + * DensePOTRS solves a system of linear equations A*X = B with a + * symmetric positive definite matrix A using the Cholesky factorization + * A = L*L**T computed by DensePOTRF. + * + * ----------------------------------------------------------------- + * DensePOTRF and DensePOTRS are simply wrappers around densePOTRF + * and densePOTRS, respectively, which perform all the work by + * directly accessing the data in the DlsMat A (i.e. the field cols) + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int DensePOTRF(DlsMat A); +SUNDIALS_EXPORT void DensePOTRS(DlsMat A, realtype *b); + +SUNDIALS_EXPORT int densePOTRF(realtype **a, int m); +SUNDIALS_EXPORT void densePOTRS(realtype **a, int m, realtype *b); + +/* + * ----------------------------------------------------------------- + * Functions : DenseGEQRF and DenseORMQR + * ----------------------------------------------------------------- + * DenseGEQRF computes a QR factorization of a real M-by-N matrix A: + * A = Q * R (with M>= N). + * + * DenseGEQRF requires a temporary work vector wrk of length M. + * ----------------------------------------------------------------- + * DenseORMQR computes the product w = Q * v where Q is a real + * orthogonal matrix defined as the product of k elementary reflectors + * + * Q = H(1) H(2) . . . H(k) + * + * as returned by DenseGEQRF. Q is an M-by-N matrix, v is a vector + * of length N and w is a vector of length M (with M>=N). + * + * DenseORMQR requires a temporary work vector wrk of length M. + * + * ----------------------------------------------------------------- + * DenseGEQRF and DenseORMQR are simply wrappers around denseGEQRF + * and denseORMQR, respectively, which perform all the work by + * directly accessing the data in the DlsMat A (i.e. the field cols) + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int DenseGEQRF(DlsMat A, realtype *beta, realtype *wrk); +SUNDIALS_EXPORT int DenseORMQR(DlsMat A, realtype *beta, realtype *vn, realtype *vm, + realtype *wrk); + +SUNDIALS_EXPORT int denseGEQRF(realtype **a, int m, int n, realtype *beta, realtype *v); +SUNDIALS_EXPORT int denseORMQR(realtype **a, int m, int n, realtype *beta, + realtype *v, realtype *w, realtype *wrk); + +/* + * ----------------------------------------------------------------- + * Function : DenseCopy + * ----------------------------------------------------------------- + * DenseCopy copies the contents of the M-by-N matrix A into the + * M-by-N matrix B. + * + * DenseCopy is a wrapper around denseCopy which accesses the data + * in the DlsMat A and B (i.e. the fields cols) + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void DenseCopy(DlsMat A, DlsMat B); +SUNDIALS_EXPORT void denseCopy(realtype **a, realtype **b, int m, int n); + +/* + * ----------------------------------------------------------------- + * Function: DenseScale + * ----------------------------------------------------------------- + * DenseScale scales the elements of the M-by-N matrix A by the + * constant c and stores the result back in A. + * + * DenseScale is a wrapper around denseScale which performs the actual + * scaling by accessing the data in the DlsMat A (i.e. the field + * cols). + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void DenseScale(realtype c, DlsMat A); +SUNDIALS_EXPORT void denseScale(realtype c, realtype **a, int m, int n); + + +/* + * ----------------------------------------------------------------- + * Function: denseAddIdentity + * ----------------------------------------------------------------- + * denseAddIdentity adds the identity matrix to the n-by-n matrix + * stored in the realtype** arrays. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void denseAddIdentity(realtype **a, int n); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/sundials_direct.h b/odemex/Parser/CVode/cv_src/include/sundials_direct.h new file mode 100644 index 0000000..f3d823b --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/sundials_direct.h @@ -0,0 +1,323 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.3 $ + * $Date: 2009/02/17 02:39:26 $ + * ----------------------------------------------------------------- + * Programmer: Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2006, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This header file contains definitions and declarations for use by + * generic direct linear solvers for Ax = b. It defines types for + * dense and banded matrices and corresponding accessor macros. + * ----------------------------------------------------------------- + */ + +#ifndef _SUNDIALS_DIRECT_H +#define _SUNDIALS_DIRECT_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ================================================================= + * C O N S T A N T S + * ================================================================= + */ + +/* + * SUNDIALS_DENSE: dense matrix + * SUNDIALS_BAND: banded matrix + */ + +#define SUNDIALS_DENSE 1 +#define SUNDIALS_BAND 2 + +/* + * ================================================================== + * Type definitions + * ================================================================== + */ + +/* + * ----------------------------------------------------------------- + * Type : DlsMat + * ----------------------------------------------------------------- + * The type DlsMat is defined to be a pointer to a structure + * with various sizes, a data field, and an array of pointers to + * the columns which defines a dense or band matrix for use in + * direct linear solvers. The M and N fields indicates the number + * of rows and columns, respectively. The data field is a one + * dimensional array used for component storage. The cols field + * stores the pointers in data for the beginning of each column. + * ----------------------------------------------------------------- + * For DENSE matrices, the relevant fields in DlsMat are: + * type = SUNDIALS_DENSE + * M - number of rows + * N - number of columns + * ldim - leading dimension (ldim >= M) + * data - pointer to a contiguous block of realtype variables + * ldata - length of the data array =ldim*N + * cols - array of pointers. cols[j] points to the first element + * of the j-th column of the matrix in the array data. + * + * The elements of a dense matrix are stored columnwise (i.e columns + * are stored one on top of the other in memory). + * If A is of type DlsMat, then the (i,j)th element of A (with + * 0 <= i < M and 0 <= j < N) is given by (A->data)[j*n+i]. + * + * The DENSE_COL and DENSE_ELEM macros below allow a user to access + * efficiently individual matrix elements without writing out explicit + * data structure references and without knowing too much about the + * underlying element storage. The only storage assumption needed is + * that elements are stored columnwise and that a pointer to the + * jth column of elements can be obtained via the DENSE_COL macro. + * ----------------------------------------------------------------- + * For BAND matrices, the relevant fields in DlsMat are: + * type = SUNDIALS_BAND + * M - number of rows + * N - number of columns + * mu - upper bandwidth, 0 <= mu <= min(M,N) + * ml - lower bandwidth, 0 <= ml <= min(M,N) + * s_mu - storage upper bandwidth, mu <= s_mu <= N-1. + * The dgbtrf routine writes the LU factors into the storage + * for A. The upper triangular factor U, however, may have + * an upper bandwidth as big as MIN(N-1,mu+ml) because of + * partial pivoting. The s_mu field holds the upper + * bandwidth allocated for A. + * ldim - leading dimension (ldim >= s_mu) + * data - pointer to a contiguous block of realtype variables + * ldata - length of the data array =ldim*(s_mu+ml+1) + * cols - array of pointers. cols[j] points to the first element + * of the j-th column of the matrix in the array data. + * + * The BAND_COL, BAND_COL_ELEM, and BAND_ELEM macros below allow a + * user to access individual matrix elements without writing out + * explicit data structure references and without knowing too much + * about the underlying element storage. The only storage assumption + * needed is that elements are stored columnwise and that a pointer + * into the jth column of elements can be obtained via the BAND_COL + * macro. The BAND_COL_ELEM macro selects an element from a column + * which has already been isolated via BAND_COL. The macro + * BAND_COL_ELEM allows the user to avoid the translation + * from the matrix location (i,j) to the index in the array returned + * by BAND_COL at which the (i,j)th element is stored. + * ----------------------------------------------------------------- + */ + +typedef struct _DlsMat { + int type; + int M; + int N; + int ldim; + int mu; + int ml; + int s_mu; + realtype *data; + int ldata; + realtype **cols; +} *DlsMat; + +/* + * ================================================================== + * Data accessor macros + * ================================================================== + */ + +/* + * ----------------------------------------------------------------- + * DENSE_COL and DENSE_ELEM + * ----------------------------------------------------------------- + * + * DENSE_COL(A,j) references the jth column of the M-by-N dense + * matrix A, 0 <= j < N. The type of the expression DENSE_COL(A,j) + * is (realtype *). After the assignment in the usage above, col_j + * may be treated as an array indexed from 0 to M-1. The (i,j)-th + * element of A is thus referenced by col_j[i]. + * + * DENSE_ELEM(A,i,j) references the (i,j)th element of the dense + * M-by-N matrix A, 0 <= i < M ; 0 <= j < N. + * + * ----------------------------------------------------------------- + */ + +#define DENSE_COL(A,j) ((A->cols)[j]) +#define DENSE_ELEM(A,i,j) ((A->cols)[j][i]) + +/* + * ----------------------------------------------------------------- + * BAND_COL, BAND_COL_ELEM, and BAND_ELEM + * ----------------------------------------------------------------- + * + * BAND_COL(A,j) references the diagonal element of the jth column + * of the N by N band matrix A, 0 <= j <= N-1. The type of the + * expression BAND_COL(A,j) is realtype *. The pointer returned by + * the call BAND_COL(A,j) can be treated as an array which is + * indexed from -(A->mu) to (A->ml). + * + * BAND_COL_ELEM references the (i,j)th entry of the band matrix A + * when used in conjunction with BAND_COL. The index (i,j) should + * satisfy j-(A->mu) <= i <= j+(A->ml). + * + * BAND_ELEM(A,i,j) references the (i,j)th element of the M-by-N + * band matrix A, where 0 <= i,j <= N-1. The location (i,j) should + * further satisfy j-(A->mu) <= i <= j+(A->ml). + * + * ----------------------------------------------------------------- + */ + +#define BAND_COL(A,j) (((A->cols)[j])+(A->s_mu)) +#define BAND_COL_ELEM(col_j,i,j) (col_j[(i)-(j)]) +#define BAND_ELEM(A,i,j) ((A->cols)[j][(i)-(j)+(A->s_mu)]) + +/* + * ================================================================== + * Exported function prototypes (functions working on dlsMat) + * ================================================================== + */ + +/* + * ----------------------------------------------------------------- + * Function: NewDenseMat + * ----------------------------------------------------------------- + * NewDenseMat allocates memory for an M-by-N dense matrix and + * returns the storage allocated (type DlsMat). NewDenseMat + * returns NULL if the request for matrix storage cannot be + * satisfied. See the above documentation for the type DlsMat + * for matrix storage details. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT DlsMat NewDenseMat(int M, int N); + +/* + * ----------------------------------------------------------------- + * Function: NewBandMat + * ----------------------------------------------------------------- + * NewBandMat allocates memory for an M-by-N band matrix + * with upper bandwidth mu, lower bandwidth ml, and storage upper + * bandwidth smu. Pass smu as follows depending on whether A will + * be LU factored: + * + * (1) Pass smu = mu if A will not be factored. + * + * (2) Pass smu = MIN(N-1,mu+ml) if A will be factored. + * + * NewBandMat returns the storage allocated (type DlsMat) or + * NULL if the request for matrix storage cannot be satisfied. + * See the documentation for the type DlsMat for matrix storage + * details. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT DlsMat NewBandMat(int N, int mu, int ml, int smu); + +/* + * ----------------------------------------------------------------- + * Functions: DestroyMat + * ----------------------------------------------------------------- + * DestroyMat frees the memory allocated by NewDenseMat or NewBandMat + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void DestroyMat(DlsMat A); + +/* + * ----------------------------------------------------------------- + * Function: NewIntArray + * ----------------------------------------------------------------- + * NewIntArray allocates memory an array of N integers and returns + * the pointer to the memory it allocates. If the request for + * memory storage cannot be satisfied, it returns NULL. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int *NewIntArray(int N); + +/* + * ----------------------------------------------------------------- + * Function: NewRealArray + * ----------------------------------------------------------------- + * NewRealArray allocates memory an array of N realtype and returns + * the pointer to the memory it allocates. If the request for + * memory storage cannot be satisfied, it returns NULL. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT realtype *NewRealArray(int N); + +/* + * ----------------------------------------------------------------- + * Function: DestroyArray + * ----------------------------------------------------------------- + * DestroyArray frees memory allocated by NewIntArray or by + * NewRealArray. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void DestroyArray(void *p); + +/* + * ----------------------------------------------------------------- + * Function : AddIdentity + * ----------------------------------------------------------------- + * AddIdentity adds 1.0 to the main diagonal (A_ii, i=1,2,...,N-1) of + * the M-by-N matrix A (M>= N) and stores the result back in A. + * AddIdentity is typically used with square matrices. + * AddIdentity does not check for M >= N and therefore a segmentation + * fault will occur if M < N! + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void AddIdentity(DlsMat A); + +/* + * ----------------------------------------------------------------- + * Function : SetToZero + * ----------------------------------------------------------------- + * SetToZero sets all the elements of the M-by-N matrix A to 0.0. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void SetToZero(DlsMat A); + +/* + * ----------------------------------------------------------------- + * Functions: PrintMat + * ----------------------------------------------------------------- + * This function prints the M-by-N (dense or band) matrix A to + * standard output as it would normally appear on paper. + * It is intended as debugging tools with small values of M and N. + * The elements are printed using the %g/%lg/%Lg option. + * A blank line is printed before and after the matrix. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void PrintMat(DlsMat A); + + +/* + * ================================================================== + * Exported function prototypes (functions working on realtype**) + * ================================================================== + */ + +SUNDIALS_EXPORT realtype **newDenseMat(int m, int n); +SUNDIALS_EXPORT realtype **newBandMat(int n, int smu, int ml); +SUNDIALS_EXPORT void destroyMat(realtype **a); +SUNDIALS_EXPORT int *newIntArray(int n); +SUNDIALS_EXPORT realtype *newRealArray(int m); +SUNDIALS_EXPORT void destroyArray(void *v); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/sundials_fnvector.h b/odemex/Parser/CVode/cv_src/include/sundials_fnvector.h new file mode 100644 index 0000000..bbc9a95 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/sundials_fnvector.h @@ -0,0 +1,41 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.1 $ + * $Date: 2006/07/05 15:27:52 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This file (companion of nvector.h) contains definitions + * needed for the initialization of vector operations in Fortran. + * ----------------------------------------------------------------- + */ + + +#ifndef _FNVECTOR_H +#define _FNVECTOR_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#ifndef _SUNDIALS_CONFIG_H +#define _SUNDIALS_CONFIG_H +#include +#endif + +/* SUNDIALS solver IDs */ + +#define FCMIX_CVODE 1 +#define FCMIX_IDA 2 +#define FCMIX_KINSOL 3 + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/sundials_iterative.h b/odemex/Parser/CVode/cv_src/include/sundials_iterative.h new file mode 100644 index 0000000..5e7e4bf --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/sundials_iterative.h @@ -0,0 +1,242 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2006/11/29 00:05:07 $ + * ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen and Alan C. Hindmarsh @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This header file contains declarations intended for use by + * generic iterative solvers of Ax = b. The enumeration gives + * symbolic names for the type of preconditioning to be used. + * The function type declarations give the prototypes for the + * functions to be called within an iterative linear solver, that + * are responsible for + * multiplying A by a given vector v (ATimesFn), and + * solving the preconditioner equation Pz = r (PSolveFn). + * ----------------------------------------------------------------- + */ + +#ifndef _ITERATIVE_H +#define _ITERATIVE_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + + +/* + * ----------------------------------------------------------------- + * enum : types of preconditioning + * ----------------------------------------------------------------- + * PREC_NONE : The iterative linear solver should not use + * preconditioning. + * + * PREC_LEFT : The iterative linear solver uses preconditioning on + * the left only. + * + * PREC_RIGHT : The iterative linear solver uses preconditioning on + * the right only. + * + * PREC_BOTH : The iterative linear solver uses preconditioning on + * both the left and the right. + * ----------------------------------------------------------------- + */ + +enum { PREC_NONE, PREC_LEFT, PREC_RIGHT, PREC_BOTH }; + +/* + * ----------------------------------------------------------------- + * enum : types of Gram-Schmidt routines + * ----------------------------------------------------------------- + * MODIFIED_GS : The iterative solver uses the modified + * Gram-Schmidt routine ModifiedGS listed in this + * file. + * + * CLASSICAL_GS : The iterative solver uses the classical + * Gram-Schmidt routine ClassicalGS listed in this + * file. + * ----------------------------------------------------------------- + */ + +enum { MODIFIED_GS = 1, CLASSICAL_GS = 2 }; + +/* + * ----------------------------------------------------------------- + * Type: ATimesFn + * ----------------------------------------------------------------- + * An ATimesFn multiplies Av and stores the result in z. The + * caller is responsible for allocating memory for the z vector. + * The parameter A_data is a pointer to any information about A + * which the function needs in order to do its job. The vector v + * is unchanged. An ATimesFn returns 0 if successful and a + * non-zero value if unsuccessful. + * ----------------------------------------------------------------- + */ + +typedef int (*ATimesFn)(void *A_data, N_Vector v, N_Vector z); + +/* + * ----------------------------------------------------------------- + * Type: PSolveFn + * ----------------------------------------------------------------- + * A PSolveFn solves the preconditioner equation Pz = r for the + * vector z. The caller is responsible for allocating memory for + * the z vector. The parameter P_data is a pointer to any + * information about P which the function needs in order to do + * its job. The parameter lr is input, and indicates whether P + * is to be taken as the left preconditioner or the right + * preconditioner: lr = 1 for left and lr = 2 for right. + * If preconditioning is on one side only, lr can be ignored. + * The vector r is unchanged. + * A PSolveFn returns 0 if successful and a non-zero value if + * unsuccessful. On a failure, a negative return value indicates + * an unrecoverable condition, while a positive value indicates + * a recoverable one, in which the calling routine may reattempt + * the solution after updating preconditioner data. + * ----------------------------------------------------------------- + */ + +typedef int (*PSolveFn)(void *P_data, N_Vector r, N_Vector z, int lr); + +/* + * ----------------------------------------------------------------- + * Function: ModifiedGS + * ----------------------------------------------------------------- + * ModifiedGS performs a modified Gram-Schmidt orthogonalization + * of the N_Vector v[k] against the p unit N_Vectors at + * v[k-1], v[k-2], ..., v[k-p]. + * + * v is an array of (k+1) N_Vectors v[i], i=0, 1, ..., k. + * v[k-1], v[k-2], ..., v[k-p] are assumed to have L2-norm + * equal to 1. + * + * h is the output k by k Hessenberg matrix of inner products. + * This matrix must be allocated row-wise so that the (i,j)th + * entry is h[i][j]. The inner products (v[i],v[k]), + * i=i0, i0+1, ..., k-1, are stored at h[i][k-1]. Here + * i0=MAX(0,k-p). + * + * k is the index of the vector in the v array that needs to be + * orthogonalized against previous vectors in the v array. + * + * p is the number of previous vectors in the v array against + * which v[k] is to be orthogonalized. + * + * new_vk_norm is a pointer to memory allocated by the caller to + * hold the Euclidean norm of the orthogonalized vector v[k]. + * + * If (k-p) < 0, then ModifiedGS uses p=k. The orthogonalized + * v[k] is NOT normalized and is stored over the old v[k]. Once + * the orthogonalization has been performed, the Euclidean norm + * of v[k] is stored in (*new_vk_norm). + * + * ModifiedGS returns 0 to indicate success. It cannot fail. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int ModifiedGS(N_Vector *v, realtype **h, int k, int p, + realtype *new_vk_norm); + +/* + * ----------------------------------------------------------------- + * Function: ClassicalGS + * ----------------------------------------------------------------- + * ClassicalGS performs a classical Gram-Schmidt + * orthogonalization of the N_Vector v[k] against the p unit + * N_Vectors at v[k-1], v[k-2], ..., v[k-p]. The parameters v, h, + * k, p, and new_vk_norm are as described in the documentation + * for ModifiedGS. + * + * temp is an N_Vector which can be used as workspace by the + * ClassicalGS routine. + * + * s is a length k array of realtype which can be used as + * workspace by the ClassicalGS routine. + * + * ClassicalGS returns 0 to indicate success. It cannot fail. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int ClassicalGS(N_Vector *v, realtype **h, int k, int p, + realtype *new_vk_norm, N_Vector temp, realtype *s); + +/* + * ----------------------------------------------------------------- + * Function: QRfact + * ----------------------------------------------------------------- + * QRfact performs a QR factorization of the Hessenberg matrix H. + * + * n is the problem size; the matrix H is (n+1) by n. + * + * h is the (n+1) by n Hessenberg matrix H to be factored. It is + * stored row-wise. + * + * q is an array of length 2*n containing the Givens rotations + * computed by this function. A Givens rotation has the form: + * | c -s | + * | s c |. + * The components of the Givens rotations are stored in q as + * (c, s, c, s, ..., c, s). + * + * job is a control flag. If job==0, then a new QR factorization + * is performed. If job!=0, then it is assumed that the first + * n-1 columns of h have already been factored and only the last + * column needs to be updated. + * + * QRfact returns 0 if successful. If a zero is encountered on + * the diagonal of the triangular factor R, then QRfact returns + * the equation number of the zero entry, where the equations are + * numbered from 1, not 0. If QRsol is subsequently called in + * this situation, it will return an error because it could not + * divide by the zero diagonal entry. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int QRfact(int n, realtype **h, realtype *q, int job); + +/* + * ----------------------------------------------------------------- + * Function: QRsol + * ----------------------------------------------------------------- + * QRsol solves the linear least squares problem + * + * min (b - H*x, b - H*x), x in R^n, + * + * where H is a Hessenberg matrix, and b is in R^(n+1). + * It uses the QR factors of H computed by QRfact. + * + * n is the problem size; the matrix H is (n+1) by n. + * + * h is a matrix (computed by QRfact) containing the upper + * triangular factor R of the original Hessenberg matrix H. + * + * q is an array of length 2*n (computed by QRfact) containing + * the Givens rotations used to factor H. + * + * b is the (n+1)-vector appearing in the least squares problem + * above. + * + * On return, b contains the solution x of the least squares + * problem, if QRsol was successful. + * + * QRsol returns a 0 if successful. Otherwise, a zero was + * encountered on the diagonal of the triangular factor R. + * In this case, QRsol returns the equation number (numbered + * from 1, not 0) of the zero entry. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int QRsol(int n, realtype **h, realtype *q, realtype *b); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/sundials_lapack.h b/odemex/Parser/CVode/cv_src/include/sundials_lapack.h new file mode 100644 index 0000000..4af89df --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/sundials_lapack.h @@ -0,0 +1,126 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.6 $ + * $Date: 2009/02/17 02:39:26 $ + * ----------------------------------------------------------------- + * Programmer: Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2006, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for a generic package of direct matrix + * operations for use with BLAS/LAPACK. + * ----------------------------------------------------------------- + */ + +#ifndef _SUNDIALS_LAPACK_H +#define _SUNDIALS_LAPACK_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* + * ================================================================== + * Blas and Lapack functions + * ================================================================== + */ + +#if defined(SUNDIALS_F77_FUNC) + +#define dcopy_f77 SUNDIALS_F77_FUNC(dcopy, DCOPY) +#define dscal_f77 SUNDIALS_F77_FUNC(dscal, DSCAL) +#define dgemv_f77 SUNDIALS_F77_FUNC(dgemv, DGEMV) +#define dtrsv_f77 SUNDIALS_F77_FUNC(dtrsv, DTRSV) +#define dsyrk_f77 SUNDIALS_F77_FUNC(dsyrk, DSKYR) + +#define dgbtrf_f77 SUNDIALS_F77_FUNC(dgbtrf, DGBTRF) +#define dgbtrs_f77 SUNDIALS_F77_FUNC(dgbtrs, DGBTRS) +#define dgetrf_f77 SUNDIALS_F77_FUNC(dgetrf, DGETRF) +#define dgetrs_f77 SUNDIALS_F77_FUNC(dgetrs, DGETRS) +#define dgeqp3_f77 SUNDIALS_F77_FUNC(dgeqp3, DGEQP3) +#define dgeqrf_f77 SUNDIALS_F77_FUNC(dgeqrf, DGEQRF) +#define dormqr_f77 SUNDIALS_F77_FUNC(dormqr, DORMQR) +#define dpotrf_f77 SUNDIALS_F77_FUNC(dpotrf, DPOTRF) +#define dpotrs_f77 SUNDIALS_F77_FUNC(dpotrs, DPOTRS) + +#else + +#define dcopy_f77 dcopy_ +#define dscal_f77 dscal_ +#define dgemv_f77 dgemv_ +#define dtrsv_f77 dtrsv_ +#define dsyrk_f77 dsyrk_ + +#define dgbtrf_f77 dgbtrf_ +#define dgbtrs_f77 dgbtrs_ +#define dgeqp3_f77 dgeqp3_ +#define dgeqrf_f77 dgeqrf_ +#define dgetrf_f77 dgetrf_ +#define dgetrs_f77 dgetrs_ +#define dormqr_f77 dormqr_ +#define dpotrf_f77 dpotrf_ +#define dpotrs_f77 dpotrs_ + +#endif + +/* Level-1 BLAS */ + +extern void dcopy_f77(int *n, const double *x, const int *inc_x, double *y, const int *inc_y); +extern void dscal_f77(int *n, const double *alpha, double *x, const int *inc_x); + +/* Level-2 BLAS */ + +extern void dgemv_f77(const char *trans, int *m, int *n, const double *alpha, const double *a, + int *lda, const double *x, int *inc_x, const double *beta, double *y, int *inc_y, + int len_trans); + +extern void dtrsv_f77(const char *uplo, const char *trans, const char *diag, const int *n, + const double *a, const int *lda, double *x, const int *inc_x, + int len_uplo, int len_trans, int len_diag); + +/* Level-3 BLAS */ + +extern void dsyrk_f77(const char *uplo, const char *trans, const int *n, const int *k, + const double *alpha, const double *a, const int *lda, const double *beta, + const double *c, const int *ldc, int len_uplo, int len_trans); + +/* LAPACK */ + +extern void dgbtrf_f77(const int *m, const int *n, const int *kl, const int *ku, + double *ab, int *ldab, int *ipiv, int *info); + +extern void dgbtrs_f77(const char *trans, const int *n, const int *kl, const int *ku, const int *nrhs, + double *ab, const int *ldab, int *ipiv, double *b, const int *ldb, + int *info, int len_trans); + + +extern void dgeqp3_f77(const int *m, const int *n, double *a, const int *lda, int *jpvt, double *tau, + double *work, const int *lwork, int *info); + +extern void dgeqrf_f77(const int *m, const int *n, double *a, const int *lda, double *tau, double *work, + const int *lwork, int *info); + +extern void dgetrf_f77(const int *m, const int *n, double *a, int *lda, int *ipiv, int *info); + +extern void dgetrs_f77(const char *trans, const int *n, const int *nrhs, double *a, const int *lda, + int *ipiv, double *b, const int *ldb, int *info, int len_trans); + + +extern void dormqr_f77(const char *side, const char *trans, const int *m, const int *n, const int *k, + double *a, const int *lda, double *tau, double *c, const int *ldc, + double *work, const int *lwork, int *info, int len_side, int len_trans); + +extern void dpotrf_f77(const char *uplo, const int *n, double *a, int *lda, int *info, int len_uplo); + +extern void dpotrs_f77(const char *uplo, const int *n, const int *nrhs, double *a, const int *lda, + double *b, const int *ldb, int * info, int len_uplo); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/sundials_math.h b/odemex/Parser/CVode/cv_src/include/sundials_math.h new file mode 100644 index 0000000..99de085 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/sundials_math.h @@ -0,0 +1,139 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2006/11/29 00:05:07 $ + * ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and + * Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for a simple C-language math library. The + * routines listed here work with the type realtype as defined in + * the header file sundials_types.h. + * ----------------------------------------------------------------- + */ + +#ifndef _SUNDIALSMATH_H +#define _SUNDIALSMATH_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ----------------------------------------------------------------- + * Macros : MIN and MAX + * ----------------------------------------------------------------- + * MIN(A,B) returns the minimum of A and B + * + * MAX(A,B) returns the maximum of A and B + * + * SQR(A) returns A^2 + * ----------------------------------------------------------------- + */ + +#ifndef MIN +#define MIN(A, B) ((A) < (B) ? (A) : (B)) +#endif + +#ifndef MAX +#define MAX(A, B) ((A) > (B) ? (A) : (B)) +#endif + +#ifndef SQR +#define SQR(A) ((A)*(A)) +#endif + +#ifndef ABS +#define ABS RAbs +#endif + +#ifndef SQRT +#define SQRT RSqrt +#endif + +#ifndef EXP +#define EXP RExp +#endif + +/* + * ----------------------------------------------------------------- + * Function : RPowerI + * ----------------------------------------------------------------- + * Usage : int exponent; + * realtype base, ans; + * ans = RPowerI(base,exponent); + * ----------------------------------------------------------------- + * RPowerI returns the value of base^exponent, where base is of type + * realtype and exponent is of type int. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT realtype RPowerI(realtype base, int exponent); + +/* + * ----------------------------------------------------------------- + * Function : RPowerR + * ----------------------------------------------------------------- + * Usage : realtype base, exponent, ans; + * ans = RPowerR(base,exponent); + * ----------------------------------------------------------------- + * RPowerR returns the value of base^exponent, where both base and + * exponent are of type realtype. If base < ZERO, then RPowerR + * returns ZERO. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT realtype RPowerR(realtype base, realtype exponent); + +/* + * ----------------------------------------------------------------- + * Function : RSqrt + * ----------------------------------------------------------------- + * Usage : realtype sqrt_x; + * sqrt_x = RSqrt(x); + * ----------------------------------------------------------------- + * RSqrt(x) returns the square root of x. If x < ZERO, then RSqrt + * returns ZERO. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT realtype RSqrt(realtype x); + +/* + * ----------------------------------------------------------------- + * Function : RAbs (a.k.a. ABS) + * ----------------------------------------------------------------- + * Usage : realtype abs_x; + * abs_x = RAbs(x); + * ----------------------------------------------------------------- + * RAbs(x) returns the absolute value of x. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT realtype RAbs(realtype x); + +/* + * ----------------------------------------------------------------- + * Function : RExp (a.k.a. EXP) + * ----------------------------------------------------------------- + * Usage : realtype exp_x; + * exp_x = RExp(x); + * ----------------------------------------------------------------- + * RExp(x) returns e^x (base-e exponential function). + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT realtype RExp(realtype x); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/sundials_nvector.h b/odemex/Parser/CVode/cv_src/include/sundials_nvector.h new file mode 100644 index 0000000..6142b32 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/sundials_nvector.h @@ -0,0 +1,373 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2006/11/29 00:05:07 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for a generic NVECTOR package. + * It defines the N_Vector structure (_generic_N_Vector) which + * contains the following fields: + * - an implementation-dependent 'content' field which contains + * the description and actual data of the vector + * - an 'ops' filed which contains a structure listing operations + * acting on such vectors + * + * Part I of this file contains type declarations for the + * _generic_N_Vector and _generic_N_Vector_Ops structures, as well + * as references to pointers to such structures (N_Vector). + * + * Part II of this file contains the prototypes for the vector + * functions which operate on N_Vector. + * + * At a minimum, a particular implementation of an NVECTOR must + * do the following: + * - specify the 'content' field of N_Vector, + * - implement the operations on those N_Vectors, + * - provide a constructor routine for new vectors + * + * Additionally, an NVECTOR implementation may provide the following: + * - macros to access the underlying N_Vector data + * - a constructor for an array of N_Vectors + * - a constructor for an empty N_Vector (i.e., a new N_Vector with + * a NULL data pointer). + * - a routine to print the content of an N_Vector + * ----------------------------------------------------------------- + */ + +#ifndef _NVECTOR_H +#define _NVECTOR_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ----------------------------------------------------------------- + * Generic definition of N_Vector + * ----------------------------------------------------------------- + */ + +/* Forward reference for pointer to N_Vector_Ops object */ +typedef struct _generic_N_Vector_Ops *N_Vector_Ops; + +/* Forward reference for pointer to N_Vector object */ +typedef struct _generic_N_Vector *N_Vector; + +/* Define array of N_Vectors */ +typedef N_Vector *N_Vector_S; + +/* Structure containing function pointers to vector operations */ +struct _generic_N_Vector_Ops { + N_Vector (*nvclone)(N_Vector); + N_Vector (*nvcloneempty)(N_Vector); + void (*nvdestroy)(N_Vector); + void (*nvspace)(N_Vector, long int *, long int *); + realtype* (*nvgetarraypointer)(N_Vector); + void (*nvsetarraypointer)(realtype *, N_Vector); + void (*nvlinearsum)(realtype, N_Vector, realtype, N_Vector, N_Vector); + void (*nvconst)(realtype, N_Vector); + void (*nvprod)(N_Vector, N_Vector, N_Vector); + void (*nvdiv)(N_Vector, N_Vector, N_Vector); + void (*nvscale)(realtype, N_Vector, N_Vector); + void (*nvabs)(N_Vector, N_Vector); + void (*nvinv)(N_Vector, N_Vector); + void (*nvaddconst)(N_Vector, realtype, N_Vector); + realtype (*nvdotprod)(N_Vector, N_Vector); + realtype (*nvmaxnorm)(N_Vector); + realtype (*nvwrmsnorm)(N_Vector, N_Vector); + realtype (*nvwrmsnormmask)(N_Vector, N_Vector, N_Vector); + realtype (*nvmin)(N_Vector); + realtype (*nvwl2norm)(N_Vector, N_Vector); + realtype (*nvl1norm)(N_Vector); + void (*nvcompare)(realtype, N_Vector, N_Vector); + booleantype (*nvinvtest)(N_Vector, N_Vector); + booleantype (*nvconstrmask)(N_Vector, N_Vector, N_Vector); + realtype (*nvminquotient)(N_Vector, N_Vector); +}; + +/* + * ----------------------------------------------------------------- + * A vector is a structure with an implementation-dependent + * 'content' field, and a pointer to a structure of vector + * operations corresponding to that implementation. + * ----------------------------------------------------------------- + */ + +struct _generic_N_Vector { + void *content; + struct _generic_N_Vector_Ops *ops; +}; + +/* + * ----------------------------------------------------------------- + * Functions exported by NVECTOR module + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * N_VClone + * Creates a new vector of the same type as an existing vector. + * It does not copy the vector, but rather allocates storage for + * the new vector. + * + * N_VCloneEmpty + * Creates a new vector of the same type as an existing vector, + * but does not allocate storage. + * + * N_VDestroy + * Destroys a vector created with N_VClone. + * + * N_VSpace + * Returns space requirements for one N_Vector (type 'realtype' in + * lrw and type 'long int' in liw). + * + * N_VGetArrayPointer + * Returns a pointer to the data component of the given N_Vector. + * NOTE: This function assumes that the internal data is stored + * as a contiguous 'realtype' array. This routine is only used in + * the solver-specific interfaces to the dense and banded linear + * solvers, as well as the interfaces to the banded preconditioners + * distributed with SUNDIALS. + * + * N_VSetArrayPointer + * Overwrites the data field in the given N_Vector with a user-supplied + * array of type 'realtype'. + * NOTE: This function assumes that the internal data is stored + * as a contiguous 'realtype' array. This routine is only used in + * the interfaces to the dense linear solver. + * + * N_VLinearSum + * Performs the operation z = a*x + b*y + * + * N_VConst + * Performs the operation z[i] = c for i = 0, 1, ..., N-1 + * + * N_VProd + * Performs the operation z[i] = x[i]*y[i] for i = 0, 1, ..., N-1 + * + * N_VDiv + * Performs the operation z[i] = x[i]/y[i] for i = 0, 1, ..., N-1 + * + * N_VScale + * Performs the operation z = c*x + * + * N_VAbs + * Performs the operation z[i] = |x[i]| for i = 0, 1, ..., N-1 + * + * N_VInv + * Performs the operation z[i] = 1/x[i] for i = 0, 1, ..., N-1 + * This routine does not check for division by 0. It should be + * called only with an N_Vector x which is guaranteed to have + * all non-zero components. + * + * N_VAddConst + * Performs the operation z[i] = x[i] + b for i = 0, 1, ..., N-1 + * + * N_VDotProd + * Returns the dot product of two vectors: + * sum (i = 0 to N-1) {x[i]*y[i]} + * + * N_VMaxNorm + * Returns the maximum norm of x: + * max (i = 0 to N-1) ABS(x[i]) + * + * N_VWrmsNorm + * Returns the weighted root mean square norm of x with weight + * vector w: + * sqrt [(sum (i = 0 to N-1) {(x[i]*w[i])^2})/N] + * + * N_VWrmsNormMask + * Returns the weighted root mean square norm of x with weight + * vector w, masked by the elements of id: + * sqrt [(sum (i = 0 to N-1) {(x[i]*w[i]*msk[i])^2})/N] + * where msk[i] = 1.0 if id[i] > 0 and + * msk[i] = 0.0 if id[i] < 0 + * + * N_VMin + * Returns the smallest element of x: + * min (i = 0 to N-1) x[i] + * + * N_VWL2Norm + * Returns the weighted Euclidean L2 norm of x with weight + * vector w: + * sqrt [(sum (i = 0 to N-1) {(x[i]*w[i])^2})] + * + * N_VL1Norm + * Returns the L1 norm of x: + * sum (i = 0 to N-1) {ABS(x[i])} + * + * N_VCompare + * Performs the operation + * z[i] = 1.0 if ABS(x[i]) >= c i = 0, 1, ..., N-1 + * 0.0 otherwise + * + * N_VInvTest + * Performs the operation z[i] = 1/x[i] with a test for + * x[i] == 0.0 before inverting x[i]. + * This routine returns TRUE if all components of x are non-zero + * (successful inversion) and returns FALSE otherwise. + * + * N_VConstrMask + * Performs the operation : + * m[i] = 1.0 if constraint test fails for x[i] + * m[i] = 0.0 if constraint test passes for x[i] + * where the constraint tests are as follows: + * If c[i] = +2.0, then x[i] must be > 0.0. + * If c[i] = +1.0, then x[i] must be >= 0.0. + * If c[i] = -1.0, then x[i] must be <= 0.0. + * If c[i] = -2.0, then x[i] must be < 0.0. + * This routine returns a boolean FALSE if any element failed + * the constraint test, TRUE if all passed. It also sets a + * mask vector m, with elements equal to 1.0 where the + * corresponding constraint test failed, and equal to 0.0 + * where the constraint test passed. + * This routine is specialized in that it is used only for + * constraint checking. + * + * N_VMinQuotient + * Performs the operation : + * minq = min ( num[i]/denom[i]) over all i such that + * denom[i] != 0. + * This routine returns the minimum of the quotients obtained + * by term-wise dividing num[i] by denom[i]. A zero element + * in denom will be skipped. If no such quotients are found, + * then the large value BIG_REAL is returned. + * + * ----------------------------------------------------------------- + * + * The following table lists the vector functions used by + * different modules in SUNDIALS. The symbols in the table + * have the following meaning: + * S - called by the solver; + * D - called by the dense linear solver module + * B - called by the band linear solver module + * Di - called by the diagonal linear solver module + * I - called by the iterative linear solver module + * BP - called by the band preconditioner module + * BBDP - called by the band-block diagonal preconditioner module + * F - called by the Fortran-to-C interface + * + * ------------------------------------------------ + * MODULES + * NVECTOR ------------------------------------------------ + * FUNCTIONS CVODE/CVODES IDA KINSOL + * ----------------------------------------------------------------- + * N_VClone S Di I S I BBDP S I BBDP + * ----------------------------------------------------------------- + * N_VCloneEmpty F F F + * ----------------------------------------------------------------- + * N_VDestroy S Di I S I BBDP S I BBDP + * ----------------------------------------------------------------- + * N_VSpace S S S + * ----------------------------------------------------------------- + * N_VGetArrayPointer D B BP BBDP F D B BBDP BBDP F + * ----------------------------------------------------------------- + * N_VSetArrayPointer D F D F + * ----------------------------------------------------------------- + * N_VLinearSum S D Di I S D I S I + * ----------------------------------------------------------------- + * N_VConst S I S I I + * ----------------------------------------------------------------- + * N_VProd S Di I S I S I + * ----------------------------------------------------------------- + * N_VDiv S Di I S I S I + * ----------------------------------------------------------------- + * N_VScale S D B Di I BP BBDP S D B I BBDP S I BBDP + * ----------------------------------------------------------------- + * N_VAbs S S S + * ----------------------------------------------------------------- + * N_VInv S Di S S + * ----------------------------------------------------------------- + * N_VAddConst S Di S + * ----------------------------------------------------------------- + * N_VDotProd I I I + * ----------------------------------------------------------------- + * N_VMaxNorm S S S + * ----------------------------------------------------------------- + * N_VWrmsNorm S D B I BP BBDP S + * ----------------------------------------------------------------- + * N_VWrmsNormMask S + * ----------------------------------------------------------------- + * N_VMin S S S + * ----------------------------------------------------------------- + * N_VWL2Norm S I + * ----------------------------------------------------------------- + * N_VL1Norm I + * ----------------------------------------------------------------- + * N_VCompare Di S + * ----------------------------------------------------------------- + * N_VInvTest Di + * ----------------------------------------------------------------- + * N_VConstrMask S S + * ----------------------------------------------------------------- + * N_VMinQuotient S S + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector N_VClone(N_Vector w); +SUNDIALS_EXPORT N_Vector N_VCloneEmpty(N_Vector w); +SUNDIALS_EXPORT void N_VDestroy(N_Vector v); +SUNDIALS_EXPORT void N_VSpace(N_Vector v, long int *lrw, long int *liw); +SUNDIALS_EXPORT realtype *N_VGetArrayPointer(N_Vector v); +SUNDIALS_EXPORT void N_VSetArrayPointer(realtype *v_data, N_Vector v); +SUNDIALS_EXPORT void N_VLinearSum(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VConst(realtype c, N_Vector z); +SUNDIALS_EXPORT void N_VProd(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VDiv(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VScale(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAbs(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VInv(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAddConst(N_Vector x, realtype b, N_Vector z); +SUNDIALS_EXPORT realtype N_VDotProd(N_Vector x, N_Vector y); +SUNDIALS_EXPORT realtype N_VMaxNorm(N_Vector x); +SUNDIALS_EXPORT realtype N_VWrmsNorm(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VWrmsNormMask(N_Vector x, N_Vector w, N_Vector id); +SUNDIALS_EXPORT realtype N_VMin(N_Vector x); +SUNDIALS_EXPORT realtype N_VWL2Norm(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VL1Norm(N_Vector x); +SUNDIALS_EXPORT void N_VCompare(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VInvTest(N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VConstrMask(N_Vector c, N_Vector x, N_Vector m); +SUNDIALS_EXPORT realtype N_VMinQuotient(N_Vector num, N_Vector denom); + +/* + * ----------------------------------------------------------------- + * Additional functions exported by NVECTOR module + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * N_VCloneEmptyVectorArray + * Creates (by cloning 'w') an array of 'count' empty N_Vectors + * + * N_VCloneVectorArray + * Creates (by cloning 'w') an array of 'count' N_Vectors + * + * N_VDestroyVectorArray + * Frees memory for an array of 'count' N_Vectors that was + * created by a call to N_VCloneVectorArray + * + * These functions are used by the SPGMR iterative linear solver + * module and by the CVODES and IDAS solvers. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector *N_VCloneEmptyVectorArray(int count, N_Vector w); +SUNDIALS_EXPORT N_Vector *N_VCloneVectorArray(int count, N_Vector w); +SUNDIALS_EXPORT void N_VDestroyVectorArray(N_Vector *vs, int count); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/sundials_spbcgs.h b/odemex/Parser/CVode/cv_src/include/sundials_spbcgs.h new file mode 100644 index 0000000..d569d1d --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/sundials_spbcgs.h @@ -0,0 +1,199 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2006/11/29 00:05:07 $ + * ----------------------------------------------------------------- + * Programmer(s): Peter Brown and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2004, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the implementation of the scaled, + * preconditioned Bi-CGSTAB (SPBCG) iterative linear solver. + * ----------------------------------------------------------------- + */ + +#ifndef _SPBCG_H +#define _SPBCG_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ----------------------------------------------------------------- + * Types: struct SpbcgMemRec and struct *SpbcgMem + * ----------------------------------------------------------------- + * A variable declaration of type struct *SpbcgMem denotes a pointer + * to a data structure of type struct SpbcgMemRec. The SpbcgMemRec + * structure contains numerous fields that must be accessed by the + * SPBCG linear solver module. + * + * l_max maximum Krylov subspace dimension that SpbcgSolve will + * be permitted to use + * + * r vector (type N_Vector) which holds the scaled, preconditioned + * linear system residual + * + * r_star vector (type N_Vector) which holds the initial scaled, + * preconditioned linear system residual + * + * p, q, u and Ap vectors (type N_Vector) used for workspace by + * the SPBCG algorithm + * + * vtemp scratch vector (type N_Vector) used as temporary vector + * storage + * ----------------------------------------------------------------- + */ + +typedef struct { + + int l_max; + + N_Vector r_star; + N_Vector r; + N_Vector p; + N_Vector q; + N_Vector u; + N_Vector Ap; + N_Vector vtemp; + +} SpbcgMemRec, *SpbcgMem; + +/* + * ----------------------------------------------------------------- + * Function : SpbcgMalloc + * ----------------------------------------------------------------- + * SpbcgMalloc allocates additional memory needed by the SPBCG + * linear solver module. + * + * l_max maximum Krylov subspace dimension that SpbcgSolve will + * be permitted to use + * + * vec_tmpl implementation-specific template vector (type N_Vector) + * (created using either N_VNew_Serial or N_VNew_Parallel) + * + * If successful, SpbcgMalloc returns a non-NULL memory pointer. If + * an error occurs, then a NULL pointer is returned. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT SpbcgMem SpbcgMalloc(int l_max, N_Vector vec_tmpl); + +/* + * ----------------------------------------------------------------- + * Function : SpbcgSolve + * ----------------------------------------------------------------- + * SpbcgSolve solves the linear system Ax = b by means of a scaled + * preconditioned Bi-CGSTAB (SPBCG) iterative method. + * + * mem pointer to an internal memory block allocated during a + * prior call to SpbcgMalloc + * + * A_data pointer to a data structure containing information + * about the coefficient matrix A (passed to user-supplied + * function referenced by atimes (function pointer)) + * + * x vector (type N_Vector) containing initial guess x_0 upon + * entry, but which upon return contains an approximate solution + * of the linear system Ax = b (solution only valid if return + * value is either SPBCG_SUCCESS or SPBCG_RES_REDUCED) + * + * b vector (type N_Vector) set to the right-hand side vector b + * of the linear system (undisturbed by function) + * + * pretype variable (type int) indicating the type of + * preconditioning to be used (see sundials_iterative.h) + * + * delta tolerance on the L2 norm of the scaled, preconditioned + * residual (if return value == SPBCG_SUCCESS, then + * ||sb*P1_inv*(b-Ax)||_L2 <= delta) + * + * P_data pointer to a data structure containing preconditioner + * information (passed to user-supplied function referenced + * by psolve (function pointer)) + * + * sx vector (type N_Vector) containing positive scaling factors + * for x (pass sx == NULL if scaling NOT required) + * + * sb vector (type N_Vector) containing positive scaling factors + * for b (pass sb == NULL if scaling NOT required) + * + * atimes user-supplied routine responsible for computing the + * matrix-vector product Ax (see sundials_iterative.h) + * + * psolve user-supplied routine responsible for solving the + * preconditioned linear system Pz = r (ignored if + * pretype == PREC_NONE) (see sundials_iterative.h) + * + * res_norm pointer (type realtype*) to the L2 norm of the + * scaled, preconditioned residual (if return value + * is either SPBCG_SUCCESS or SPBCG_RES_REDUCED, then + * *res_norm = ||sb*P1_inv*(b-Ax)||_L2, where x is + * the computed approximate solution, sb is the diagonal + * scaling matrix for the right-hand side b, and P1_inv + * is the inverse of the left-preconditioner matrix) + * + * nli pointer (type int*) to the total number of linear + * iterations performed + * + * nps pointer (type int*) to the total number of calls made + * to the psolve routine + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int SpbcgSolve(SpbcgMem mem, void *A_data, N_Vector x, N_Vector b, + int pretype, realtype delta, void *P_data, N_Vector sx, + N_Vector sb, ATimesFn atimes, PSolveFn psolve, + realtype *res_norm, int *nli, int *nps); + +/* Return values for SpbcgSolve */ + +#define SPBCG_SUCCESS 0 /* SPBCG algorithm converged */ +#define SPBCG_RES_REDUCED 1 /* SPBCG did NOT converge, but the + residual was reduced */ +#define SPBCG_CONV_FAIL 2 /* SPBCG algorithm failed to converge */ +#define SPBCG_PSOLVE_FAIL_REC 3 /* psolve failed recoverably */ +#define SPBCG_ATIMES_FAIL_REC 4 /* atimes failed recoverably */ +#define SPBCG_PSET_FAIL_REC 5 /* pset faild recoverably */ + +#define SPBCG_MEM_NULL -1 /* mem argument is NULL */ +#define SPBCG_ATIMES_FAIL_UNREC -2 /* atimes returned failure flag */ +#define SPBCG_PSOLVE_FAIL_UNREC -3 /* psolve failed unrecoverably */ +#define SPBCG_PSET_FAIL_UNREC -4 /* pset failed unrecoverably */ + +/* + * ----------------------------------------------------------------- + * Function : SpbcgFree + * ----------------------------------------------------------------- + * SpbcgFree frees the memory allocated by a call to SpbcgMalloc. + * It is illegal to use the pointer mem after a call to SpbcgFree. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void SpbcgFree(SpbcgMem mem); + +/* + * ----------------------------------------------------------------- + * Macro : SPBCG_VTEMP + * ----------------------------------------------------------------- + * This macro provides access to the vector r in the + * memory block of the SPBCG module. The argument mem is the + * memory pointer returned by SpbcgMalloc, of type SpbcgMem, + * and the macro value is of type N_Vector. + * + * Note: Only used by IDA (r contains P_inverse F if nli_inc == 0). + * ----------------------------------------------------------------- + */ + +#define SPBCG_VTEMP(mem) (mem->r) + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/sundials_spgmr.h b/odemex/Parser/CVode/cv_src/include/sundials_spgmr.h new file mode 100644 index 0000000..c557acd --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/sundials_spgmr.h @@ -0,0 +1,296 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2006/11/29 00:05:07 $ + * ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and + * Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the implementation of SPGMR Krylov + * iterative linear solver. The SPGMR algorithm is based on the + * Scaled Preconditioned GMRES (Generalized Minimal Residual) + * method. + * + * The SPGMR algorithm solves a linear system A x = b. + * Preconditioning is allowed on the left, right, or both. + * Scaling is allowed on both sides, and restarts are also allowed. + * We denote the preconditioner and scaling matrices as follows: + * P1 = left preconditioner + * P2 = right preconditioner + * S1 = diagonal matrix of scale factors for P1-inverse b + * S2 = diagonal matrix of scale factors for P2 x + * The matrices A, P1, and P2 are not required explicitly; only + * routines that provide A, P1-inverse, and P2-inverse as + * operators are required. + * + * In this notation, SPGMR applies the underlying GMRES method to + * the equivalent transformed system + * Abar xbar = bbar , where + * Abar = S1 (P1-inverse) A (P2-inverse) (S2-inverse) , + * bbar = S1 (P1-inverse) b , and xbar = S2 P2 x . + * + * The scaling matrices must be chosen so that vectors S1 + * P1-inverse b and S2 P2 x have dimensionless components. + * If preconditioning is done on the left only (P2 = I), by a + * matrix P, then S2 must be a scaling for x, while S1 is a + * scaling for P-inverse b, and so may also be taken as a scaling + * for x. Similarly, if preconditioning is done on the right only + * (P1 = I, P2 = P), then S1 must be a scaling for b, while S2 is + * a scaling for P x, and may also be taken as a scaling for b. + * + * The stopping test for the SPGMR iterations is on the L2 norm of + * the scaled preconditioned residual: + * || bbar - Abar xbar ||_2 < delta + * with an input test constant delta. + * + * The usage of this SPGMR solver involves supplying two routines + * and making three calls. The user-supplied routines are + * atimes (A_data, x, y) to compute y = A x, given x, + * and + * psolve (P_data, x, y, lr) + * to solve P1 x = y or P2 x = y for x, given y. + * The three user calls are: + * mem = SpgmrMalloc(lmax, vec_tmpl); + * to initialize memory, + * flag = SpgmrSolve(mem,A_data,x,b,..., + * P_data,s1,s2,atimes,psolve,...); + * to solve the system, and + * SpgmrFree(mem); + * to free the memory created by SpgmrMalloc. + * Complete details for specifying atimes and psolve and for the + * usage calls are given in the paragraphs below and in iterative.h. + * ----------------------------------------------------------------- + */ + +#ifndef _SPGMR_H +#define _SPGMR_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ----------------------------------------------------------------- + * Types: SpgmrMemRec, SpgmrMem + * ----------------------------------------------------------------- + * SpgmrMem is a pointer to an SpgmrMemRec which contains + * the memory needed by SpgmrSolve. The SpgmrMalloc routine + * returns a pointer of type SpgmrMem which should then be passed + * in subsequent calls to SpgmrSolve. The SpgmrFree routine frees + * the memory allocated by SpgmrMalloc. + * + * l_max is the maximum Krylov dimension that SpgmrSolve will be + * permitted to use. + * + * V is the array of Krylov basis vectors v_1, ..., v_(l_max+1), + * stored in V[0], ..., V[l_max], where l_max is the second + * parameter to SpgmrMalloc. Each v_i is a vector of type + * N_Vector. + * + * Hes is the (l_max+1) x l_max Hessenberg matrix. It is stored + * row-wise so that the (i,j)th element is given by Hes[i][j]. + * + * givens is a length 2*l_max array which represents the + * Givens rotation matrices that arise in the algorithm. The + * Givens rotation matrices F_0, F_1, ..., F_j, where F_i is + * + * 1 + * 1 + * c_i -s_i <--- row i + * s_i c_i + * 1 + * 1 + * + * are represented in the givens vector as + * givens[0]=c_0, givens[1]=s_0, givens[2]=c_1, givens[3]=s_1, + * ..., givens[2j]=c_j, givens[2j+1]=s_j. + * + * xcor is a vector (type N_Vector) which holds the scaled, + * preconditioned correction to the initial guess. + * + * yg is a length (l_max+1) array of realtype used to hold "short" + * vectors (e.g. y and g). + * + * vtemp is a vector (type N_Vector) used as temporary vector + * storage during calculations. + * ----------------------------------------------------------------- + */ + +typedef struct _SpgmrMemRec { + + int l_max; + + N_Vector *V; + realtype **Hes; + realtype *givens; + N_Vector xcor; + realtype *yg; + N_Vector vtemp; + +} SpgmrMemRec, *SpgmrMem; + +/* + * ----------------------------------------------------------------- + * Function : SpgmrMalloc + * ----------------------------------------------------------------- + * SpgmrMalloc allocates the memory used by SpgmrSolve. It + * returns a pointer of type SpgmrMem which the user of the + * SPGMR package should pass to SpgmrSolve. The parameter l_max + * is the maximum Krylov dimension that SpgmrSolve will be + * permitted to use. The parameter vec_tmpl is a pointer to an + * N_Vector used as a template to create new vectors by duplication. + * This routine returns NULL if there is a memory request failure. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT SpgmrMem SpgmrMalloc(int l_max, N_Vector vec_tmpl); + +/* + * ----------------------------------------------------------------- + * Function : SpgmrSolve + * ----------------------------------------------------------------- + * SpgmrSolve solves the linear system Ax = b using the SPGMR + * method. The return values are given by the symbolic constants + * below. The first SpgmrSolve parameter is a pointer to memory + * allocated by a prior call to SpgmrMalloc. + * + * mem is the pointer returned by SpgmrMalloc to the structure + * containing the memory needed by SpgmrSolve. + * + * A_data is a pointer to information about the coefficient + * matrix A. This pointer is passed to the user-supplied function + * atimes. + * + * x is the initial guess x_0 upon entry and the solution + * N_Vector upon exit with return value SPGMR_SUCCESS or + * SPGMR_RES_REDUCED. For all other return values, the output x + * is undefined. + * + * b is the right hand side N_Vector. It is undisturbed by this + * function. + * + * pretype is the type of preconditioning to be used. Its + * legal possible values are enumerated in iterativ.h. These + * values are PREC_NONE=0, PREC_LEFT=1, PREC_RIGHT=2, and + * PREC_BOTH=3. + * + * gstype is the type of Gram-Schmidt orthogonalization to be + * used. Its legal values are enumerated in iterativ.h. These + * values are MODIFIED_GS=0 and CLASSICAL_GS=1. + * + * delta is the tolerance on the L2 norm of the scaled, + * preconditioned residual. On return with value SPGMR_SUCCESS, + * this residual satisfies || s1 P1_inv (b - Ax) ||_2 <= delta. + * + * max_restarts is the maximum number of times the algorithm is + * allowed to restart. + * + * P_data is a pointer to preconditioner information. This + * pointer is passed to the user-supplied function psolve. + * + * s1 is an N_Vector of positive scale factors for P1-inv b, where + * P1 is the left preconditioner. (Not tested for positivity.) + * Pass NULL if no scaling on P1-inv b is required. + * + * s2 is an N_Vector of positive scale factors for P2 x, where + * P2 is the right preconditioner. (Not tested for positivity.) + * Pass NULL if no scaling on P2 x is required. + * + * atimes is the user-supplied function which performs the + * operation of multiplying A by a given vector. Its description + * is given in iterative.h. + * + * psolve is the user-supplied function which solves a + * preconditioner system Pz = r, where P is P1 or P2. Its full + * description is given in iterativ.h. The psolve function will + * not be called if pretype is NONE; in that case, the user + * should pass NULL for psolve. + * + * res_norm is a pointer to the L2 norm of the scaled, + * preconditioned residual. On return with value SPGMR_SUCCESS or + * SPGMR_RES_REDUCED, (*res_norm) contains the value + * || s1 P1_inv (b - Ax) ||_2 for the computed solution x. + * For all other return values, (*res_norm) is undefined. The + * caller is responsible for allocating the memory (*res_norm) + * to be filled in by SpgmrSolve. + * + * nli is a pointer to the number of linear iterations done in + * the execution of SpgmrSolve. The caller is responsible for + * allocating the memory (*nli) to be filled in by SpgmrSolve. + * + * nps is a pointer to the number of calls made to psolve during + * the execution of SpgmrSolve. The caller is responsible for + * allocating the memory (*nps) to be filled in by SpgmrSolve. + * + * Note: Repeated calls can be made to SpgmrSolve with varying + * input arguments. If, however, the problem size N or the + * maximum Krylov dimension l_max changes, then a call to + * SpgmrMalloc must be made to obtain new memory for SpgmrSolve + * to use. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int SpgmrSolve(SpgmrMem mem, void *A_data, N_Vector x, N_Vector b, + int pretype, int gstype, realtype delta, + int max_restarts, void *P_data, N_Vector s1, + N_Vector s2, ATimesFn atimes, PSolveFn psolve, + realtype *res_norm, int *nli, int *nps); + + +/* Return values for SpgmrSolve */ + +#define SPGMR_SUCCESS 0 /* Converged */ +#define SPGMR_RES_REDUCED 1 /* Did not converge, but reduced + norm of residual */ +#define SPGMR_CONV_FAIL 2 /* Failed to converge */ +#define SPGMR_QRFACT_FAIL 3 /* QRfact found singular matrix */ +#define SPGMR_PSOLVE_FAIL_REC 4 /* psolve failed recoverably */ +#define SPGMR_ATIMES_FAIL_REC 5 /* atimes failed recoverably */ +#define SPGMR_PSET_FAIL_REC 6 /* pset faild recoverably */ + +#define SPGMR_MEM_NULL -1 /* mem argument is NULL */ +#define SPGMR_ATIMES_FAIL_UNREC -2 /* atimes returned failure flag */ +#define SPGMR_PSOLVE_FAIL_UNREC -3 /* psolve failed unrecoverably */ +#define SPGMR_GS_FAIL -4 /* Gram-Schmidt routine faiuled */ +#define SPGMR_QRSOL_FAIL -5 /* QRsol found singular R */ +#define SPGMR_PSET_FAIL_UNREC -6 /* pset failed unrecoverably */ + +/* + * ----------------------------------------------------------------- + * Function : SpgmrFree + * ----------------------------------------------------------------- + * SpgmrMalloc frees the memory allocated by SpgmrMalloc. It is + * illegal to use the pointer mem after a call to SpgmrFree. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void SpgmrFree(SpgmrMem mem); + +/* + * ----------------------------------------------------------------- + * Macro: SPGMR_VTEMP + * ----------------------------------------------------------------- + * This macro provides access to the work vector vtemp in the + * memory block of the SPGMR module. The argument mem is the + * memory pointer returned by SpgmrMalloc, of type SpgmrMem, + * and the macro value is of type N_Vector. + * On a return from SpgmrSolve with *nli = 0, this vector + * contains the scaled preconditioned initial residual, + * s1 * P1_inverse * (b - A x_0). + * ----------------------------------------------------------------- + */ + +#define SPGMR_VTEMP(mem) (mem->vtemp) + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/sundials_sptfqmr.h b/odemex/Parser/CVode/cv_src/include/sundials_sptfqmr.h new file mode 100644 index 0000000..2ba5c37 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/sundials_sptfqmr.h @@ -0,0 +1,254 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2006/11/29 00:05:07 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the implementation of the scaled + * preconditioned Transpose-Free Quasi-Minimal Residual (SPTFQMR) + * linear solver. + * + * The SPTFQMR algorithm solves a linear system of the form Ax = b. + * Preconditioning is allowed on the left (PREC_LEFT), right + * (PREC_RIGHT), or both (PREC_BOTH). Scaling is allowed on both + * sides. We denote the preconditioner and scaling matrices as + * follows: + * P1 = left preconditioner + * P2 = right preconditioner + * S1 = diagonal matrix of scale factors for P1-inverse b + * S2 = diagonal matrix of scale factors for P2 x + * The matrices A, P1, and P2 are not required explicitly; only + * routines that provide A, P1-inverse, and P2-inverse as operators + * are required. + * + * In this notation, SPTFQMR applies the underlying TFQMR method to + * the equivalent transformed system: + * Abar xbar = bbar, where + * Abar = S1 (P1-inverse) A (P2-inverse) (S2-inverse), + * bbar = S1 (P1-inverse) b, and + * xbar = S2 P2 x. + * + * The scaling matrices must be chosen so that vectors + * S1 P1-inverse b and S2 P2 x have dimensionless components. If + * preconditioning is done on the left only (P2 = I), by a matrix P, + * then S2 must be a scaling for x, while S1 is a scaling for + * P-inverse b, and so may also be taken as a scaling for x. + * Similarly, if preconditioning is done on the right only (P1 = I, + * P2 = P), then S1 must be a scaling for b, while S2 is a scaling + * for P x, and may also be taken as a scaling for b. + * + * The stopping test for the SPTFQMR iterations is on the L2-norm of + * the scaled preconditioned residual: + * || bbar - Abar xbar ||_2 < delta + * with an input test constant delta. + * + * The usage of this SPTFQMR solver involves supplying two routines + * and making three calls. The user-supplied routines are: + * atimes(A_data, x, y) to compute y = A x, given x, + * and + * psolve(P_data, x, y, lr) to solve P1 x = y or P2 x = y for x, + * given y. + * The three user calls are: + * mem = SptfqmrMalloc(lmax, vec_tmpl); + * to initialize memory + * flag = SptfqmrSolve(mem, A_data, x, b, pretype, delta, P_data, + * sx, sb, atimes, psolve, res_norm, nli, nps); + * to solve the system, and + * SptfqmrFree(mem); + * to free the memory allocated by SptfqmrMalloc(). + * Complete details for specifying atimes() and psolve() and for the + * usage calls are given in the paragraphs below and in the header + * file sundials_iterative.h. + * ----------------------------------------------------------------- + */ + +#ifndef _SPTFQMR_H +#define _SPTFQMR_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ----------------------------------------------------------------- + * Types: struct SptfqmrMemRec and struct *SptfqmrMem + * ----------------------------------------------------------------- + * A variable declaration of type struct *SptfqmrMem denotes a pointer + * to a data structure of type struct SptfqmrMemRec. The SptfqmrMemRec + * structure contains numerous fields that must be accessed by the + * SPTFQMR linear solver module. + * + * l_max maximum Krylov subspace dimension that SptfqmrSolve will + * be permitted to use + * + * r_star vector (type N_Vector) which holds the initial scaled, + * preconditioned linear system residual + * + * q/d/v/p/u/r vectors (type N_Vector) used for workspace by + * the SPTFQMR algorithm + * + * vtemp1/vtemp2/vtemp3 scratch vectors (type N_Vector) used as + * temporary storage + * ----------------------------------------------------------------- + */ + +typedef struct { + + int l_max; + + N_Vector r_star; + N_Vector q; + N_Vector d; + N_Vector v; + N_Vector p; + N_Vector *r; + N_Vector u; + N_Vector vtemp1; + N_Vector vtemp2; + N_Vector vtemp3; + +} SptfqmrMemRec, *SptfqmrMem; + +/* + * ----------------------------------------------------------------- + * Function : SptfqmrMalloc + * ----------------------------------------------------------------- + * SptfqmrMalloc allocates additional memory needed by the SPTFQMR + * linear solver module. + * + * l_max maximum Krylov subspace dimension that SptfqmrSolve will + * be permitted to use + * + * vec_tmpl implementation-specific template vector (type N_Vector) + * (created using either N_VNew_Serial or N_VNew_Parallel) + * + * If successful, SptfqmrMalloc returns a non-NULL memory pointer. If + * an error occurs, then a NULL pointer is returned. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT SptfqmrMem SptfqmrMalloc(int l_max, N_Vector vec_tmpl); + +/* + * ----------------------------------------------------------------- + * Function : SptfqmrSolve + * ----------------------------------------------------------------- + * SptfqmrSolve solves the linear system Ax = b by means of a scaled + * preconditioned Transpose-Free Quasi-Minimal Residual (SPTFQMR) + * method. + * + * mem pointer to an internal memory block allocated during a + * prior call to SptfqmrMalloc + * + * A_data pointer to a data structure containing information + * about the coefficient matrix A (passed to user-supplied + * function referenced by atimes (function pointer)) + * + * x vector (type N_Vector) containing initial guess x_0 upon + * entry, but which upon return contains an approximate solution + * of the linear system Ax = b (solution only valid if return + * value is either SPTFQMR_SUCCESS or SPTFQMR_RES_REDUCED) + * + * b vector (type N_Vector) set to the right-hand side vector b + * of the linear system (undisturbed by function) + * + * pretype variable (type int) indicating the type of + * preconditioning to be used (see sundials_iterative.h) + * + * delta tolerance on the L2 norm of the scaled, preconditioned + * residual (if return value == SPTFQMR_SUCCESS, then + * ||sb*P1_inv*(b-Ax)||_L2 <= delta) + * + * P_data pointer to a data structure containing preconditioner + * information (passed to user-supplied function referenced + * by psolve (function pointer)) + * + * sx vector (type N_Vector) containing positive scaling factors + * for x (pass sx == NULL if scaling NOT required) + * + * sb vector (type N_Vector) containing positive scaling factors + * for b (pass sb == NULL if scaling NOT required) + * + * atimes user-supplied routine responsible for computing the + * matrix-vector product Ax (see sundials_iterative.h) + * + * psolve user-supplied routine responsible for solving the + * preconditioned linear system Pz = r (ignored if + * pretype == PREC_NONE) (see sundials_iterative.h) + * + * res_norm pointer (type realtype*) to the L2 norm of the + * scaled, preconditioned residual (if return value + * is either SPTFQMR_SUCCESS or SPTFQMR_RES_REDUCED, then + * *res_norm = ||sb*P1_inv*(b-Ax)||_L2, where x is + * the computed approximate solution, sb is the diagonal + * scaling matrix for the right-hand side b, and P1_inv + * is the inverse of the left-preconditioner matrix) + * + * nli pointer (type int*) to the total number of linear + * iterations performed + * + * nps pointer (type int*) to the total number of calls made + * to the psolve routine + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int SptfqmrSolve(SptfqmrMem mem, void *A_data, N_Vector x, N_Vector b, + int pretype, realtype delta, void *P_data, N_Vector sx, + N_Vector sb, ATimesFn atimes, PSolveFn psolve, + realtype *res_norm, int *nli, int *nps); + +/* Return values for SptfqmrSolve */ + +#define SPTFQMR_SUCCESS 0 /* SPTFQMR algorithm converged */ +#define SPTFQMR_RES_REDUCED 1 /* SPTFQMR did NOT converge, but the + residual was reduced */ +#define SPTFQMR_CONV_FAIL 2 /* SPTFQMR algorithm failed to converge */ +#define SPTFQMR_PSOLVE_FAIL_REC 3 /* psolve failed recoverably */ +#define SPTFQMR_ATIMES_FAIL_REC 4 /* atimes failed recoverably */ +#define SPTFQMR_PSET_FAIL_REC 5 /* pset faild recoverably */ + +#define SPTFQMR_MEM_NULL -1 /* mem argument is NULL */ +#define SPTFQMR_ATIMES_FAIL_UNREC -2 /* atimes returned failure flag */ +#define SPTFQMR_PSOLVE_FAIL_UNREC -3 /* psolve failed unrecoverably */ +#define SPTFQMR_PSET_FAIL_UNREC -4 /* pset failed unrecoverably */ + +/* + * ----------------------------------------------------------------- + * Function : SptfqmrFree + * ----------------------------------------------------------------- + * SptfqmrFree frees the memory allocated by a call to SptfqmrMalloc. + * It is illegal to use the pointer mem after a call to SptfqmrFree. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void SptfqmrFree(SptfqmrMem mem); + +/* + * ----------------------------------------------------------------- + * Macro : SPTFQMR_VTEMP + * ----------------------------------------------------------------- + * This macro provides access to the work vector vtemp1 in the + * memory block of the SPTFQMR module. The argument mem is the + * memory pointer returned by SptfqmrMalloc, of type SptfqmrMem, + * and the macro value is of type N_Vector. + * + * Note: Only used by IDA (vtemp1 contains P_inverse F if + * nli_inc == 0). + * ----------------------------------------------------------------- + */ + +#define SPTFQMR_VTEMP(mem) (mem->vtemp1) + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/include/sundials_types.h b/odemex/Parser/CVode/cv_src/include/sundials_types.h new file mode 100644 index 0000000..953f6e0 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/include/sundials_types.h @@ -0,0 +1,122 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2006/11/29 00:05:07 $ + * ----------------------------------------------------------------- + * Programmer(s): Scott Cohen, Alan Hindmarsh, Radu Serban, and + * Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + *------------------------------------------------------------------ + * This header file exports two types: realtype and booleantype, + * as well as the constants TRUE and FALSE. + * + * Users should include the header file sundials_types.h in every + * program file and use the exported name realtype instead of + * float, double or long double. + * + * The constants SUNDIALS_SINGLE_PRECISION, SUNDIALS_DOUBLE_PRECISION + * and SUNDIALS_LONG_DOUBLE_PRECISION indicate the underlying data + * type of realtype. It is set at the configuration stage. + * + * The legal types for realtype are float, double and long double. + * + * The macro RCONST gives the user a convenient way to define + * real-valued constants. To use the constant 1.0, for example, + * the user should write the following: + * + * #define ONE RCONST(1.0) + * + * If realtype is defined as a double, then RCONST(1.0) expands + * to 1.0. If realtype is defined as a float, then RCONST(1.0) + * expands to 1.0F. If realtype is defined as a long double, + * then RCONST(1.0) expands to 1.0L. There is never a need to + * explicitly cast 1.0 to (realtype). + *------------------------------------------------------------------ + */ + +#ifndef _SUNDIALSTYPES_H +#define _SUNDIALSTYPES_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#ifndef _SUNDIALS_CONFIG_H +#define _SUNDIALS_CONFIG_H +#include +#endif + +#include + +/* + *------------------------------------------------------------------ + * Type realtype + * Macro RCONST + * Constants BIG_REAL, SMALL_REAL, and UNIT_ROUNDOFF + *------------------------------------------------------------------ + */ + +#if defined(SUNDIALS_SINGLE_PRECISION) + +typedef float realtype; +# define RCONST(x) x##F +# define BIG_REAL FLT_MAX +# define SMALL_REAL FLT_MIN +# define UNIT_ROUNDOFF FLT_EPSILON + +#elif defined(SUNDIALS_DOUBLE_PRECISION) + +typedef double realtype; +# define RCONST(x) x +# define BIG_REAL DBL_MAX +# define SMALL_REAL DBL_MIN +# define UNIT_ROUNDOFF DBL_EPSILON + +#elif defined(SUNDIALS_EXTENDED_PRECISION) + +typedef long double realtype; +# define RCONST(x) x##L +# define BIG_REAL LDBL_MAX +# define SMALL_REAL LDBL_MIN +# define UNIT_ROUNDOFF LDBL_EPSILON + +#endif + +/* + *------------------------------------------------------------------ + * Type : booleantype + *------------------------------------------------------------------ + * Constants : FALSE and TRUE + *------------------------------------------------------------------ + * ANSI C does not have a built-in boolean data type. Below is the + * definition for a new type called booleantype. The advantage of + * using the name booleantype (instead of int) is an increase in + * code readability. It also allows the programmer to make a + * distinction between int and boolean data. Variables of type + * booleantype are intended to have only the two values FALSE and + * TRUE which are defined below to be equal to 0 and 1, + * respectively. + *------------------------------------------------------------------ + */ + +#ifndef booleantype +#define booleantype int +#endif + +#ifndef FALSE +#define FALSE 0 +#endif + +#ifndef TRUE +#define TRUE 1 +#endif + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/src/cvodes/CMakeLists.txt b/odemex/Parser/CVode/cv_src/src/cvodes/CMakeLists.txt new file mode 100644 index 0000000..d1724b7 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/cvodes/CMakeLists.txt @@ -0,0 +1,131 @@ +# --------------------------------------------------------------- +# $Revision: 1.4 $ +# $Date: 2009/02/17 02:58:47 $ +# --------------------------------------------------------------- +# Programmer: Radu Serban @ LLNL +# --------------------------------------------------------------- +# Copyright (c) 2007, The Regents of the University of California. +# Produced at the Lawrence Livermore National Laboratory. +# All rights reserved. +# For details, see the LICENSE file. +# --------------------------------------------------------------- +# CMakeLists.txt file for the CVODES library + +INSTALL(CODE "MESSAGE(\"\nInstall CVODES\n\")") + +# Add variable cvodes_SOURCES with the sources for the CVODES library +SET(cvodes_SOURCES + cvodes.c + cvodea.c + cvodes_io.c + cvodea_io.c + cvodes_direct.c + cvodes_band.c + cvodes_dense.c + cvodes_diag.c + cvodes_spils.c + cvodes_spbcgs.c + cvodes_spgmr.c + cvodes_sptfqmr.c + cvodes_bandpre.c + cvodes_bbdpre.c + ) + +# Add variable shared_SOURCES with the common SUNDIALS sources which will +# also be included in the CVODES library +SET(shared_SOURCES + sundials_nvector.c + sundials_math.c + sundials_direct.c + sundials_band.c + sundials_dense.c + sundials_iterative.c + sundials_spbcgs.c + sundials_spgmr.c + sundials_sptfqmr.c + ) + +# Add prefix with complete path to the common SUNDIALS sources +ADD_PREFIX(${sundials_SOURCE_DIR}/src/sundials/ shared_SOURCES) + +# Add variable cvodes_HEADERS with the exported CVODES header files +SET(cvodes_HEADERS + cvodes_band.h + cvodes_bandpre.h + cvodes_bbdpre.h + cvodes_dense.h + cvodes_diag.h + cvodes_direct.h + cvodes.h + cvodes_spbcgs.h + cvodes_spgmr.h + cvodes_spils.h + cvodes_sptfqmr.h + ) + +# Add prefix with complete path to the CVODES header files +ADD_PREFIX(${sundials_SOURCE_DIR}/include/cvodes/ cvodes_HEADERS) + +# If Blas/Lapack support was enabled, set-up additional file lists +IF(LAPACK_FOUND) + SET(cvodes_BL_SOURCES cvodes_lapack.c) + SET(cvodes_BL_HEADERS cvodes_lapack.h) + ADD_PREFIX(${sundials_SOURCE_DIR}/include/cvodes/ cvodes_BL_HEADERS) +ELSE(LAPACK_FOUND) + SET(cvodes_BL_SOURCES "") + SET(cvodes_BL_HEADERS "") +ENDIF(LAPACK_FOUND) + + +# Add source directories to include directories for access to +# implementation only header files. +INCLUDE_DIRECTORIES(.) +INCLUDE_DIRECTORIES(../sundials) + +# Define C preprocessor flag -DBUILD_SUNDIALS_LIBRARY +ADD_DEFINITIONS(-DBUILD_SUNDIALS_LIBRARY) + +# Build the static library +IF(BUILD_STATIC_LIBS) + + # Add the build target for the static CVODES library + ADD_LIBRARY(sundials_cvodes_static STATIC + ${cvodes_SOURCES} ${cvodes_BL_SOURCES} ${shared_SOURCES}) + + # Set the library name and make sure it is not deleted + SET_TARGET_PROPERTIES(sundials_cvodes_static + PROPERTIES OUTPUT_NAME sundials_cvodes CLEAN_DIRECT_OUTPUT 1) + + # Install the CVODES library + INSTALL(TARGETS sundials_cvodes_static DESTINATION lib) + +ENDIF(BUILD_STATIC_LIBS) + +# Build the shared library +IF(BUILD_SHARED_LIBS) + + # Add the build target for the CVODES library + ADD_LIBRARY(sundials_cvodes_shared SHARED + ${cvodes_SOURCES} ${cvodes_BL_SOURCES} ${shared_SOURCES}) + + # Set the library name and make sure it is not deleted + SET_TARGET_PROPERTIES(sundials_cvodes_shared + PROPERTIES OUTPUT_NAME sundials_cvodes CLEAN_DIRECT_OUTPUT 1) + + # Set VERSION and SOVERSION for shared libraries + SET_TARGET_PROPERTIES(sundials_cvodes_shared + PROPERTIES VERSION ${cvodeslib_VERSION} SOVERSION ${cvodeslib_SOVERSION}) + + # Install the CVODES library + INSTALL(TARGETS sundials_cvodes_shared DESTINATION lib) + +ENDIF(BUILD_SHARED_LIBS) + +# Install the CVODES header files +INSTALL(FILES ${cvodes_HEADERS} ${cvodes_BL_HEADERS} DESTINATION include/cvodes) + +# Install the CVODES implementation header file +INSTALL(FILES cvodes_impl.h DESTINATION include/cvodes) + +# +MESSAGE(STATUS "Added CVODES module") diff --git a/odemex/Parser/CVode/cv_src/src/cvodes/LICENSE b/odemex/Parser/CVode/cv_src/src/cvodes/LICENSE new file mode 100644 index 0000000..dd9a383 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/cvodes/LICENSE @@ -0,0 +1,59 @@ +Copyright (c) 2002, The Regents of the University of California. +Produced at the Lawrence Livermore National Laboratory +Written by A.C. Hindmarsh and R. Serban. +UCRL-CODE-155950 +All rights reserved. + +This file is part of CVODES v2.1.0. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the disclaimer below. + +2. Redistributions in binary form must reproduce the above copyright +notice, this list of conditions and the disclaimer (as noted below) +in the documentation and/or other materials provided with the +distribution. + +3. Neither the name of the UC/LLNL nor the names of its contributors +may be used to endorse or promote products derived from this software +without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS +FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE +REGENTS OF THE UNIVERSITY OF CALIFORNIA, THE U.S. DEPARTMENT OF ENERGY +OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +Additional BSD Notice +--------------------- +1. This notice is required to be provided under our contract with +the U.S. Department of Energy (DOE). This work was produced at the +University of California, Lawrence Livermore National Laboratory +under Contract No. W-7405-ENG-48 with the DOE. + +2. Neither the United States Government nor the University of +California nor any of their employees, makes any warranty, express +or implied, or assumes any liability or responsibility for the +accuracy, completeness, or usefulness of any information, apparatus, +product, or process disclosed, or represents that its use would not +infringe privately-owned rights. + +3. Also, reference herein to any specific commercial products, +process, or services by trade name, trademark, manufacturer or +otherwise does not necessarily constitute or imply its endorsement, +recommendation, or favoring by the United States Government or the +University of California. The views and opinions of authors expressed +herein do not necessarily state or reflect those of the United States +Government or the University of California, and shall not be used for +advertising or product endorsement purposes. diff --git a/odemex/Parser/CVode/cv_src/src/cvodes/Makefile.in b/odemex/Parser/CVode/cv_src/src/cvodes/Makefile.in new file mode 100644 index 0000000..9cf23cb --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/cvodes/Makefile.in @@ -0,0 +1,180 @@ +# ----------------------------------------------------------------- +# $Revision: 1.12 $ +# $Date: 2009/03/25 23:10:50 $ +# ----------------------------------------------------------------- +# Programmer(s): Radu Serban and Aaron Collier @ LLNL +# ----------------------------------------------------------------- +# Copyright (c) 2005, The Regents of the University of California. +# Produced at the Lawrence Livermore National Laboratory. +# All rights reserved. +# For details, see the LICENSE file. +# ----------------------------------------------------------------- +# Makefile for CVODES module +# +# @configure_input@ +# ----------------------------------------------------------------- + +SHELL = @SHELL@ + +@SET_MAKE@ + +srcdir = @srcdir@ +builddir = @builddir@ +abs_builddir = @abs_builddir@ +top_builddir = @top_builddir@ +prefix = @prefix@ +exec_prefix = @exec_prefix@ +includedir = @includedir@ +libdir = @libdir@ + +INSTALL = @INSTALL@ +INSTALL_LIB = @INSTALL_PROGRAM@ +INSTALL_HEADER = @INSTALL_DATA@ + +LIBTOOL = @LIBTOOL@ +LIBTOOL_DEPS = @LIBTOOL_DEPS@ + +CPP = @CPP@ +CPPFLAGS = @CPPFLAGS@ +CC = @CC@ +CFLAGS = @CFLAGS@ +LDFLAGS = @LDFLAGS@ +LIBS = @LIBS@ + +LAPACK_ENABLED = @LAPACK_ENABLED@ + +top_srcdir = $(srcdir)/../.. + +INCLUDES = -I$(top_srcdir)/include -I$(top_builddir)/include + +LIB_REVISION = 2:0:0 + +CVODES_LIB = libsundials_cvodes.la + +CVODES_SRC_FILES = cvodes.c cvodes_io.c cvodea.c cvodea_io.c cvodes_direct.c cvodes_band.c cvodes_dense.c cvodes_diag.c cvodes_spils.c cvodes_spbcgs.c cvodes_spgmr.c cvodes_sptfqmr.c cvodes_bandpre.c cvodes_bbdpre.c +CVODES_BL_SRC_FILES = cvodes_lapack.c + +CVODES_OBJ_FILES = $(CVODES_SRC_FILES:.c=.o) +CVODES_BL_OBJ_FILES = $(CVODES_BL_SRC_FILES:.c=.o) + +CVODES_LIB_FILES = $(CVODES_SRC_FILES:.c=.lo) +CVODES_BL_LIB_FILES = $(CVODES_BL_SRC_FILES:.c=.lo) + +SHARED_LIB_FILES = $(top_builddir)/src/sundials/sundials_band.lo \ + $(top_builddir)/src/sundials/sundials_dense.lo \ + $(top_builddir)/src/sundials/sundials_direct.lo \ + $(top_builddir)/src/sundials/sundials_iterative.lo \ + $(top_builddir)/src/sundials/sundials_spgmr.lo \ + $(top_builddir)/src/sundials/sundials_spbcgs.lo \ + $(top_builddir)/src/sundials/sundials_sptfqmr.lo \ + $(top_builddir)/src/sundials/sundials_math.lo \ + $(top_builddir)/src/sundials/sundials_nvector.lo + +mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs +rminstalldirs = $(SHELL) $(top_srcdir)/config/rminstalldirs + +# ---------------------------------------------------------------------------------------------------------------------- + +all: $(CVODES_LIB) + +$(CVODES_LIB): shared $(CVODES_LIB_FILES) + @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ + make lib_with_bl; \ + else \ + make lib_without_bl; \ + fi + +lib_without_bl: shared $(CVODES_LIB_FILES) + $(LIBTOOL) --mode=link $(CC) $(CFLAGS) -o $(CVODES_LIB) $(CVODES_LIB_FILES) $(SHARED_LIB_FILES) -rpath $(libdir) $(LDFLAGS) $(LIBS) -version-info $(LIB_REVISION) + +lib_with_bl: shared $(CVODES_LIB_FILES) $(CVODES_BL_LIB_FILES) + $(LIBTOOL) --mode=link $(CC) $(CFLAGS) -o $(CVODES_LIB) $(CVODES_LIB_FILES) $(CVODES_BL_LIB_FILES) $(SHARED_LIB_FILES) -rpath $(libdir) $(LDFLAGS) $(LIBS) -version-info $(LIB_REVISION) + +install: $(CVODES_LIB) + $(mkinstalldirs) $(includedir)/cvodes + $(mkinstalldirs) $(libdir) + $(LIBTOOL) --mode=install $(INSTALL_LIB) $(CVODES_LIB) $(libdir) + $(INSTALL_HEADER) $(top_srcdir)/include/cvodes/cvodes.h $(includedir)/cvodes/ + $(INSTALL_HEADER) $(top_srcdir)/include/cvodes/cvodes_direct.h $(includedir)/cvodes/ + $(INSTALL_HEADER) $(top_srcdir)/include/cvodes/cvodes_dense.h $(includedir)/cvodes/ + $(INSTALL_HEADER) $(top_srcdir)/include/cvodes/cvodes_band.h $(includedir)/cvodes/ + $(INSTALL_HEADER) $(top_srcdir)/include/cvodes/cvodes_diag.h $(includedir)/cvodes/ + $(INSTALL_HEADER) $(top_srcdir)/include/cvodes/cvodes_spils.h $(includedir)/cvodes/ + $(INSTALL_HEADER) $(top_srcdir)/include/cvodes/cvodes_spbcgs.h $(includedir)/cvodes/ + $(INSTALL_HEADER) $(top_srcdir)/include/cvodes/cvodes_spgmr.h $(includedir)/cvodes/ + $(INSTALL_HEADER) $(top_srcdir)/include/cvodes/cvodes_sptfqmr.h $(includedir)/cvodes/ + $(INSTALL_HEADER) $(top_srcdir)/include/cvodes/cvodes_bandpre.h $(includedir)/cvodes/ + $(INSTALL_HEADER) $(top_srcdir)/include/cvodes/cvodes_bbdpre.h $(includedir)/cvodes/ + $(INSTALL_HEADER) $(top_srcdir)/src/cvodes/cvodes_impl.h $(includedir)/cvodes/ + @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ + $(INSTALL_HEADER) $(top_srcdir)/include/cvodes/cvodes_lapack.h $(includedir)/cvodes/ ; \ + fi + +uninstall: + $(LIBTOOL) --mode=uninstall rm -f $(libdir)/$(CVODES_LIB) + rm -f $(includedir)/cvodes/cvodes.h + rm -f $(includedir)/cvodes/cvodes_direct.h + rm -f $(includedir)/cvodes/cvodes_dense.h + rm -f $(includedir)/cvodes/cvodes_band.h + rm -f $(includedir)/cvodes/cvodes_diag.h + rm -f $(includedir)/cvodes/cvodes_lapack.h + rm -f $(includedir)/cvodes/cvodes_spils.h + rm -f $(includedir)/cvodes/cvodes_spbcgs.h + rm -f $(includedir)/cvodes/cvodes_spgmr.h + rm -f $(includedir)/cvodes/cvodes_sptfqmr.h + rm -f $(includedir)/cvodes/cvodes_bandpre.h + rm -f $(includedir)/cvodes/cvodes_bbdpre.h + rm -f $(includedir)/cvodes/cvodes_impl.h + $(rminstalldirs) ${includedir}/cvodes + +shared: + @cd ${top_builddir}/src/sundials ; \ + ${MAKE} ; \ + cd ${abs_builddir} + +clean: + $(LIBTOOL) --mode=clean rm -f $(CVODES_LIB) + rm -f $(CVODES_LIB_FILES) + rm -f $(CVODES_BL_LIB_FILES) + rm -f $(CVODES_OBJ_FILES) + rm -f $(CVODES_BL_OBJ_FILES) + +distclean: clean + rm -f Makefile + +cvodes.lo: $(srcdir)/cvodes.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/cvodes.c +cvodes_io.lo: $(srcdir)/cvodes_io.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/cvodes_io.c +cvodea.lo: $(srcdir)/cvodea.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/cvodea.c +cvodea_io.lo: $(srcdir)/cvodea_io.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/cvodea_io.c +cvodes_direct.lo: $(srcdir)/cvodes_direct.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/cvodes_direct.c +cvodes_dense.lo: $(srcdir)/cvodes_dense.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/cvodes_dense.c +cvodes_band.lo: $(srcdir)/cvodes_band.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/cvodes_band.c +cvodes_diag.lo: $(srcdir)/cvodes_diag.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/cvodes_diag.c +cvodes_lapack.lo: $(srcdir)/cvodes_lapack.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/cvodes_lapack.c +cvodes_spils.lo: $(srcdir)/cvodes_spils.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/cvodes_spils.c +cvodes_spbcgs.lo: $(srcdir)/cvodes_spils.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/cvodes_spbcgs.c +cvodes_spgmr.lo: $(srcdir)/cvodes_spgmr.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/cvodes_spgmr.c +cvodes_sptfqmr.lo: $(srcdir)/cvodes_sptfqmr.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/cvodes_sptfqmr.c +cvodes_bandpre.lo: $(srcdir)/cvodes_bandpre.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/cvodes_bandpre.c +cvodes_bbdpre.lo: $(srcdir)/cvodes_bbdpre.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/cvodes_bbdpre.c + + +libtool: $(top_builddir)/$(LIBTOOL_DEPS) + @cd ${top_builddir} ; \ + ${SHELL} ./config.status --recheck ; \ + cd ${abs_builddir} diff --git a/odemex/Parser/CVode/cv_src/src/cvodes/README b/odemex/Parser/CVode/cv_src/src/cvodes/README new file mode 100644 index 0000000..cfd3885 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/cvodes/README @@ -0,0 +1,431 @@ + CVODES + Release 2.6.0, January 2008 + Alan C. Hindmarsh and Radu Serban + Center for Applied Scientific Computing, LLNL + +CVODES is a solver for stiff and nonstiff ODE systems (initial value +problem) given in explicit form y' = f(t,y,p) with sensitivity analysis +capabilities (both forward and adjoint modes). +It is written in ANSI standard C. + +CVODES can be used both on serial and parallel (MPI) computers. The +main difference is in the NVECTOR module of vector kernels. The desired +version is obtained when compiling the example files by linking the +appropriate library of NVECTOR kernels. In the parallel version, +communication between processors is done with the MPI (Message Passage +Interface) system. + +When used with the serial NVECTOR module, CVODES provides both direct (dense +and band) and preconditioned Krylov (iterative) linear solvers. Three different +iterative solvers are available: scaled preconditioned GMRES (SPGMR), scaled +preconditioned BiCGStab (SPBCG), and scaled preconditioned TFQMR (SPTFQMR). +When CVODES is used with the parallel NVECTOR module, only the Krylov linear solvers +are available. (An approximate diagonal Jacobian option is available with both +versions.) For the serial version, there is a banded preconditioner module +called CVBANDPRE available for use with the Krylov solvers, while for the parallel +version there is a preconditioner module called CVBBDPRE which provides a +band-block-diagonal preconditioner. + +CVODES is part of a software family called SUNDIALS: SUite of Nonlinear and +DIfferential/ALgebraic equation Solvers [4]. This suite consists of CVODE, +CVODES, IDA, IDAS, and KINSOL. The directory structure of the package supplied +reflects this family relationship. + +The notes below provide the location of documentation, directions for the +installation of the CVODES package, and relevant references. Following that +is a brief history of revisions to the package. + + +A. Documentation +---------------- + +/sundials/doc/cvodes/ contains PDF files for the CVODES User Guide [1] (cvs_guide.pdf) +and the CVODES Examples [2] (cvs_examples.pdf) documents. + + +B. Installation +--------------- + +For basic installation instructions see /sundials/INSTALL_NOTES. +For complete installation instructions see the "CVODES Installation Procedure" +chapter in the CVODES User Guide. + + +C. References +------------- + +[1] A. C. Hindmarsh and R. Serban, "User Documentation for CVODES v2.6.0," + LLNL technical report UCRL-SM-208111, November 2004. + +[2] A. C. Hindmarsh and R. Serban, "Example Programs for CVODES v2.6.0," + LLNL technical report UCRL-SM-208115, November 2004. + +[3] R. Serban and A. C. Hindmarsh, "CVODES: the Sensitivity-Enabled ODE + solver in SUNDIALS," Proceedings of IDETC/CIE 2005, Sept. 2005, + Long Beach, CA. + +[4] A. C. Hindmarsh, P. N. Brown, K. E. Grant, S. L. Lee, R. Serban, + D. E. Shumaker, and C. S. Woodward, "SUNDIALS, Suite of Nonlinear and + Differential/Algebraic Equation Solvers," ACM Trans. Math. Softw., + 31(3), pp. 363-396, 2005. + +D. Releases +----------- + +v. 2.6.0 - Jan. 2008 +v. 2.5.0 - Nov. 2006 +v. 2.4.0 - Mar. 2006 +v. 2.3.0 - May. 2005 +v. 2.2.0 - Apr. 2005 +v. 2.1.2 - Mar. 2005 +v. 2.1.1 - Jan. 2005 +v. 2.1.0 - Dec. 2004 +v. 1.0 - Jul. 2002 (first SUNDIALS release) + + +E. Revision History +------------------- + +v. 2.5.0 (Nov. 2006) ---> v. 2.6.0 (Jan. 2008) +--------------------------------------------------------- + +- New features + - added a new linear solver module based on Blas + Lapack for + both dense and banded matrices. + - added optional input to specify which direction of zero-crossing + is to be monitored while performing root-finding. The root information + array iroots (returned by CVodeGetRootInfo) also encodes the + direction of zero-crossing. + - added support for performing FSA of quadrature variables (see functions + CVode**QuadSens**). + - in the adjoint module, added support for integrating forward sensitivities + of states and quadrature variables during the forward integration + phase (e.g. for computing 2nd order sensitivity information using + the "forward over adjoint" method). + - in the adjoint module, added support for propagating backwards in time + multiple adjoint systems, each initialized at posibly different times. + - added option for reinitializing the adjoint module in order to + solve a new adjoint problem (with same number of steps between + check points and the same interpolation type). + +- Bug fixes + - in the rootfinding algorithm, fixed a bug resulting in unnecessary + evaluations of the root functions after reinitialization of the + solver right after a return at a root. + - in the initial step size calculation, restrict h based on tstop. + +- Changes to user interface + - renamed all **Malloc functions to **Init + - tolerances are now specified through separate functions instead of + the initialization functions CVodeInit (former CVodeMalloc) and + CVodeReInit. Depending on the tolerance type, one of 3 functions + must be called before the first call to CVode. + - tolerances for quadratures, sensitivities, and quadrature sensitivities + are specified in a manner similar to that for state variables, with the + exception that toelrances for quadratures and quadrature sensitivities + are required only if the corresponding variables are included in the + error test. + - removed function inputs from argument lists of all re-initialization + functions. + - all user-supplied functions now receive the same pointer to user data + (instead of having different ones for the system evaluation, Jacobian + information functions, etc.) + - removed CV_NORMAL_TSTOP and CV_ONE_STEP_TSTOP named constants for the + itask argument to CVode/CVodeF. A tstop value is now both set and activated + through CVodeSetStopTime. Once tstop is reached it is also deactivated. + A new value can be then spcified by calling again CVodeSetStopTime. + - common functionality for all direct linear solvers (dense, band, and + the new Lapack solver) has been collected into the DLS (Direct Linear + Solver) module, similar to the SPILS module for the iterative linear + solvers. All optional input and output functions for these linear + solver now have the prefix 'CVDls'. In addition, in order to include + the new Lapack-based linear solver, all dimensions for these linear + solvers (problem sizes, bandwidths, etc) are now of type 'int' + (instead of 'long int'). + - the initialization functions for the two preconditioner modules, + CVBANDPRE and CVBBDPRE were renamed ***Init (from ***Alloc) and they + do not return a pointer to preconditioner memory anymore. Instead, + all preconditioner module-related functions are now called with + the main solver memory pointer as their first argument. When using + one of these two modules, there is no need to use special functions + to attach one of the SPILS linear solvers (instead use one of + CVSpgmr, CVSpbcg, or CVSptfqmr). Moreover, there is no need to call + a memory deallocation function for the preconditioner module. + - CVodeSensMalloc was replaced by CVodeSensInit and CvodeSensInit1. + The sensitivity RHS function is now passed as an argument to these + initialization functions. The former takes as argument fS a function + of type CVSensRhsFn, while the latter takes as argument fS1 of type + CVSensRhs1Fn. Removed the functions CVodeSetSensRhsFn and CVodeSetSensRhs1Fn. + - changed the API for all functions in the adjoint module related to + initialization, set-up, and solution of backward problems. A backward problem + is always identified by its index (of type int) returned by the CvodeCreateB + function. + - the extraction functions CVodeGetQuad, CVodeGetSens, and CVodeGetSens1 + now return the values of quadrature and sensitivity variables, respectively, + at the same time as that at which CVode returned the solution (for dense + output of quadrature or sensitivity variables, the user can only use + CVodeGetQuadDky, CVodeGetSensDky, or CVodeGetSensDky1). Similar functions are + available for the new quadrature sensitivity feature. + +v. 2.4.0 (Mar. 2006) ---> v. 2.5.0 (Nov. 2006) +--------------------------------------------------------- + +- Bug fixes + - fixed wrong logic in final stopping tests: now we check if + tout was reached before checking if tstop was reached. + - added a roundoff factor when testing whether tn was just returned + (in root finding) to prevent an unnecessary return. + - fixed bug in CVodeB in searching for the current check point + (i.e. the check point for which interpolation data is available) + - fixed bug in CVodeF to ensure that in NORMAL mode no extra + step is taken (which sometimes resulted in an error from the + interpolated output function). + - changed address variable type in CVadjCheckPointRec structure from + 'unsigned int' to 'void *' to avoid address truncation/mangling on + 64-bit platforms (see CVS_P1). + +- Changes related to the build system + - reorganized source tree: header files in ${srcdir}/include/cvodes, + source files in ${srcdir}/src/cvodes,examples in ${srcdir}/examples/cvodes + - exported header files are installed unde ${includedir}/cvodes + +- Changes to user interface + - all included header files use relative paths from ${includedir} + - changed the API for specifying the DQ method used to approximate + the sensitivity equations: renamed CVodeSetSensRho to CVodeSetSensDQMethod. + The user passes two values: DQtype (CV_CENTERED or CV_FORWARD) and + DQrhomax (the cut-off value for switching between simultaneous and + separate approximations of the two terms in the sensi. eqs.) + +v. 2.3.0 (May. 2005) ---> v. 2.4.0 (Mar. 2006) +--------------------------------------------------------- + +- New features + - added CVSPBCG interface module to allow CVODES to interface with the + shared SPBCG (scaled preconditioned Bi-CGSTAB) linear solver module. + - added CVSPTFQMR interface module to allow CVODES to interface with + the shared SPTFQMR (scaled preconditioned TFQMR) linear solver module. + - added support for SPBCG and SPTFQMR to the CVBBDPRE and CVBANDPRE + preconditioner modules. + - added support for interpreting failures in user-supplied functions. + - added a new variable-degree polynomial interpolation method as an + an alternative to the current cubic Hermite interpolation for the + adjoint module. + +- Changes to user interface + - changed argument of CVodeFree, CVBandPrecFree, CVBBDPrecFree, and + CVadjFree to be the address of the respective memory block pointer, + so that its NULL value is propagated back to the calling function. + - added CVSPBCG module which defines appropriate CVSpbcg* functions to + allow CVODES to interface with the shared SPBCG linear solver module. + - added CVBBDSpbcg function to CVBBDPRE module and CVBPSpbcg function to + CVBANDPRE module to support SPBCG linear solver module. + - added CVBBDSptfqmr function to CVBBDPRE module and CVBPSptfqmr function to + CVBANDPRE module to support SPTFQMR linear solver module. + - changed function type names (not the actual definition) to accomodate + all the Scaled Preconditioned Iterative Linear Solvers now available: + CVSpgmrJactimesVecFn -> CVSpilsJacTimesVecFn + CVSpgmrPrecSetupFn -> CVSpilsPrecSetupFn + CVSpgmrPrecSolveFn -> CVSpilsPrecSolveFn + - changed function types so that all user-supplied functions return + an integer flag (not all of them currently used). + - changed some names for CVBBDPRE and CVBANDPRE function outputs + - added option for user-supplied error handler function. + - added a argument to CVadjMalloc to specify the type of interpolation + (possible values are CV_HERMITE for cubic Hermite and CV_POLYNOMIAL + for variable-order polynomial interpolation) + - renamed all exported header files (except for cvodes.h and cvodea.h all + header files have the prefix 'cvodes_') + - changed naming scheme for CVODES examples + +- Changes related to the build system + - the main CVODES header files (cvodes.h and cvodea.h) are still exported to + the install include directory. However, all other CVODES header files are + exported into a 'cvodes' subdirectory of the install include directory. + - the CVODES library now contains all shared object files (there is no separate + libsundials_shared library anymore) + +v. 2.2.0 (Apr. 2005) ---> v. 2.3.0 (May. 2005) +---------------------------------------------- + +- Bug fixes + - in the adjoint module, fixed bug in storing interpolation data at + a point corresponding to a check point (improperly scaled y'). + +- Changes to user interface + - removed CVadjGetcheckPointsList from the list of user-callable functions. + +v. 2.1.2 (Mar. 2005) ---> v. 2.2.0 (Apr. 2005) +---------------------------------------------- + +- New features + - added option for user-provided error weight computation function for + the solution vector (of type CVEwtFn specified through CVodeSetEwtFn). + +- Changes to user interface + - CVODES now stores tolerances through values rather than references + (to resolve potential scoping issues). + - CVODES now passes information back to the user through values rather + than references (error weights, estimated local errors, root info, + STAGGERED1 statistics, etc.) + - CVodeMalloc, CVodeReInit, CVodeSetTolerances: added option itol=CV_WF + to indicate user-supplied function for computing the error weights; + reltol is now declared as realtype. Note that it is now illegal to call + CVodeSetTolerances before CVodeMalloc. It is now legal to deallocate + the absolute tolerance N_Vector right after its use. + - Several optional input functions were combined into a single one + (CVodeRootInit and CvodeSetGdata, CVDenseSetJacFn and CVDenseSetJacData, + CVBandSetJacFn and CVBandSetJacData, CVSpgmrSetPrecSolveFn and + CVSpgmrSetPrecSetFn and CVSpgmrSetPrecData, CVSpgmrSetJacTimesVecFn and + CVSpgmrSetJacData). + - Removed CVodeSetQuadtolerances. CVodeSetQuadErrCon now sets both the + error control flag and the tolerances for quadratures. + - CVodeSetQuadErrCon, CVodeSetSensTolerances: the relative tolerance + must now be passed as a realtype. It is now illegal to call + CVodeSetQuadErrCon before CVodeQuadMalloc or to call CVodeSetSensTolerances + before CVodeSensMalloc. + - CvodeSensMalloc: removed p and plist from argument list. + - CVodeSensParams replaces CVodeSensPbar and sets p, pbar, and plist. NULL + can be passed for any of them if it will not be needed given the current + set of options. The array pbar must now contain Ns non-zero realtype + values giving order of magnitude for the parameters with respect to which + sensitivities will be computed. The array plist can now only have positive + entries. + - CVodeGetErrorWeights, CVodeGetQuadErrorWeights: the user is now responsible + for allocating space for the N_Vector in which error weights will be copied. + - CVodeGetEstLocalErrors: the user is now responsible for allocating space + for the N_Vector in which estimated local errors will be copied. + - CVodeGetRootInfo: the user is now responsible for allocating space + for the int array in which root information will be copied. + - CVodeGetNumStgrSensNonlinSolvIters, CVodeGetNumStgrSensNonlinSolvConvFails: + the user is now responsible for allocating space for the long int arrays + in which STAGGERED1 statistics will be copied. + - CVodeMallocB, CVodeReInitB, CVodeSetQuadErrConB: the relative tolerance + for the backward integration must now be passed as a realtype. It is now + illegal to call CVodeSetQuadErrConB before CVQuadMallocB. + - Passing a value of 0 for the maximum step size, the minimum step + size, or for maxsteps results in the solver using the corresponding + default value (infinity, 0, 500, respectively) + - User-callable functions in the adjoint module were modified similarly + to their corresponding counterparts for forward simulation. + + +v. 2.1.1 (Jan. 2005) ---> v. 2.1.2 (Mar. 2005) +---------------------------------------------- + +- Bug fixes + - fixed bug in CVode function: Initial setting of tretlast = *tret = tn removed + (correcting erroneous behavior at first call to CVRcheck3). + - removed redundant setting of tretlast = *tret = tn at CLOSE_ROOTS return from CVode. + - fixed bug in CVCompleteStep related to quadrature and sensitivity variables + (leading to wrong values at a BDF order increase) + - in CVUpperBoundH0, fixed a potential, although not harmful, use of + uninitialized memory + - changed implicit type conversion to explicit in check_flag() routine in + examples to avoid C++ compiler errors + +- Changes to documentation + - added section with numerical values of all input and output solver constants + - added more detailed notes on the type of absolute tolerances + - added more details on ownership of memory for the array returned by CVodeGetRootInfo + - corrected/added descriptions of error returns. + - added description of --with-mpi-flags option + +- Changes related to the build system + - fixed autoconf-related bug to allow configuration with the PGI Fortran compiler + - modified to use customized detection of the Fortran name mangling scheme + (autoconf's AC_F77_WRAPPERS routine is problematic on some platforms) + - added --with-mpi-flags as a configure option to allow user to specify + MPI-specific flags + - updated Makefiles for Fortran examples to avoid C++ compiler errors (now use + CC and MPICC to link) + + +v. 2.1.0 (Dec. 2004) ---> v. 2.1.1 (Jan. 2005) +---------------------------------------------- + +- New features + - added function CVodeSensToggle to allow activation/deactivation of + sensitivity calculations without memory allocation/deallocation. + +- Bug fixes + - fixed bug in CVCompleteStep related to quadrature and sensitivity variables + (leading to wrong values at a BDF order increase). + - in CVUpperBoundH0, fixed a potential, although not harmful, use of + uninitialized memory. + - fixed logic in testing for negative values of user-supplied absolute tolerances + for sensitivity variables. + +- Changes related to the build system + - changed order of compiler directives in header files to avoid compilation + errors when using a C++ compiler. + +v. 1.0 (Jul. 2002) ---> v. 2.1.0 (Dec. 2004) +-------------------------------------------- + +- New features + - added quadrature integration capabilities. + - added root finding capabilities. + - added option for different user data structures for ODE r.h.s. + and sensitivity r.h.s. + - in adjoint module, added interface to CVBBDPRE for the backward + phase. + - in adjoint module, added option for using CVDIAG during backward + phase. + - in adjoint module, added option for ONE_STEP integration during + backward phase. + - in adjoint module, added option to reinitialize the backward + integration phase (and perform a new backward integration using + the same check points). + - in adjoint module, relaxed assumption that t_final > t_0 (now + accepts t_final < t_0). + +- Bug fixes + - fixed bug in adjustment of sensitivity Nordsieck history array on an + order decrease (when using BDF). + - in adjoint module, fixed a potential use of memory before being set. + - in adjoint module, fixed a bug related to data saved at check points. + This addresses the case in which an order increase is deemed necessary + at the very first step after a check-point. + +- Changes related to the NVECTOR module + (see also the file sundials/shared/README) + - removed machEnv, redefined table of vector operations (now contained + in the N_Vector structure itself). + - all CVODES functions create new N_Vector variables through cloning, using + an N_Vector passed by the user as a template. + +- Changes to type names and CVODES constants + - removed type 'integertype'; instead use int or long int, as appropriate. + - restructured the list of return values from the various CVODES functions. + - changed all CVODES constants (inputs and return values) to have the + prefix 'CV_' (e.g. CV_SUCCESS). + - renamed various function types to have the prefix 'CV' (e.g. CVRhsFn). + +- Changes to optional input/ouput + - added CVodeSet* and CVodeGet* functions for optional inputs/outputs, + replacing the arrays iopt and ropt. + - added new optional inputs (e.g. maximum number of Newton iterations, + maximum number of convergence failures, etc). + - the value of the last return flag from any function within a linear + solver module can be obtained as an optional output (e.g. CVDenseGetLastFlag). + +- Changes to user-callable functions + - renamed header files to have prefix 'cv' instead of 'cvs' (e.g. cvdense.h + replaces cvsdense.h). + - added new function CVodeCreate which initializes the CVODES solver + object and returns a pointer to the CVODES memory block. + - removed N (problem size) from all functions except the initialization + functions for the direct linear solvers (CVDense and CVBand). + - shortened argument lists of most CVODES functions (the arguments that + were dropped can now be specified through CVodeSet* functions). + - removed reinitialization functions for band/dense/SPGMR linear + solvers (same functionality can be obtained using CV*Set* functions). + - in CVBBDPRE, added a new function, CVBBDSpgmr to initialize the + SPGMR linear solver with the BBD preconditioner. + - function names changed in CVBANDPRE and CVBBDPRE for uniformity. + +- Changes to user-supplied functions + - removed N (probem dimension) from argument lists. + - shortened argument lists for user dense/band/SPGMR Jacobian routines. + - in CVSPGMR, shortened argument lists for user preconditioner functions. diff --git a/odemex/Parser/CVode/cv_src/src/cvodes/cvodea.c b/odemex/Parser/CVode/cv_src/src/cvodes/cvodea.c new file mode 100644 index 0000000..46a4358 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/cvodes/cvodea.c @@ -0,0 +1,2967 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.23 $ + * $Date: 2007/11/26 16:19:59 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2006, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for the CVODEA adjoint integrator. + * ----------------------------------------------------------------- + */ + +/* + * ================================================================= + * IMPORTED HEADER FILES + * ================================================================= + */ + +#include +#include + +#include "cvodes_impl.h" + +#include +#include + +/* + * ================================================================= + * MACRO DEFINITIONS + * ================================================================= + */ + +#define loop for(;;) + +/* + * ================================================================= + * CVODEA PRIVATE CONSTANTS + * ================================================================= + */ + +#define ZERO RCONST(0.0) /* real 0.0 */ +#define ONE RCONST(1.0) /* real 1.0 */ +#define TWO RCONST(2.0) /* real 2.0 */ +#define HUNDRED RCONST(100.0) /* real 100.0 */ +#define FUZZ_FACTOR RCONST(1000000.0) /* fuzz factor for IMget */ + +/* + * ================================================================= + * PRIVATE FUNCTION PROTOTYPES + * ================================================================= + */ + +static CkpntMem CVAckpntInit(CVodeMem cv_mem); +static CkpntMem CVAckpntNew(CVodeMem cv_mem); +static void CVAckpntDelete(CkpntMem *ck_memPtr); + +static void CVAbckpbDelete(CVodeBMem *cvB_memPtr); + +static int CVAdataStore(CVodeMem cv_mem, CkpntMem ck_mem); +static int CVAckpntGet(CVodeMem cv_mem, CkpntMem ck_mem); + +static int CVAfindIndex(CVodeMem cv_mem, realtype t, + long int *indx, booleantype *newpoint); + +static booleantype CVAhermiteMalloc(CVodeMem cv_mem); +static void CVAhermiteFree(CVodeMem cv_mem); +static int CVAhermiteGetY(CVodeMem cv_mem, realtype t, N_Vector y, N_Vector *yS); +static int CVAhermiteStorePnt(CVodeMem cv_mem, DtpntMem d); + +static booleantype CVApolynomialMalloc(CVodeMem cv_mem); +static void CVApolynomialFree(CVodeMem cv_mem); +static int CVApolynomialGetY(CVodeMem cv_mem, realtype t, N_Vector y, N_Vector *yS); +static int CVApolynomialStorePnt(CVodeMem cv_mem, DtpntMem d); + +/* Wrappers */ + +static int CVArhs(realtype t, N_Vector yB, + N_Vector yBdot, void *cvode_mem); + +static int CVArhsQ(realtype t, N_Vector yB, + N_Vector qBdot, void *cvode_mem); + +/* + * ================================================================= + * EXPORTED FUNCTIONS IMPLEMENTATION + * ================================================================= + */ + +/* + * CVodeAdjInit + * + * This routine initializes ASA and allocates space for the adjoint + * memory structure. + */ + +int CVodeAdjInit(void *cvode_mem, long int steps, int interp) +{ + CVadjMem ca_mem; + CVodeMem cv_mem; + long int i, ii; + + /* --------------- + * Check arguments + * --------------- */ + + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeAdjInit", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem)cvode_mem; + + if (steps <= 0) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeAdjInit", MSGCV_BAD_STEPS); + return(CV_ILL_INPUT); + } + + if ( (interp != CV_HERMITE) && (interp != CV_POLYNOMIAL) ) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeAdjInit", MSGCV_BAD_INTERP); + return(CV_ILL_INPUT); + } + + /* ---------------------------- + * Allocate CVODEA memory block + * ---------------------------- */ + + ca_mem = NULL; + ca_mem = (CVadjMem) malloc(sizeof(struct CVadjMemRec)); + if (ca_mem == NULL) { + cvProcessError(cv_mem, CV_MEM_FAIL, "CVODEA", "CVodeAdjInit", MSGCV_MEM_FAIL); + return(CV_MEM_FAIL); + } + + /* Attach ca_mem to CVodeMem structure */ + + cv_mem->cv_adj_mem = ca_mem; + + /* ------------------------------ + * Initialization of check points + * ------------------------------ */ + + /* Set Check Points linked list to NULL */ + ca_mem->ck_mem = NULL; + + /* Initialize nckpnts to ZERO */ + ca_mem->ca_nckpnts = 0; + + /* No interpolation data is available */ + ca_mem->ca_ckpntData = NULL; + + /* ------------------------------------ + * Initialization of interpolation data + * ------------------------------------ */ + + /* Interpolation type */ + + ca_mem->ca_IMtype = interp; + + /* Number of steps between check points */ + + ca_mem->ca_nsteps = steps; + + /* Allocate space for the array of Data Point structures */ + + ca_mem->dt_mem = NULL; + ca_mem->dt_mem = (DtpntMem *) malloc((steps+1)*sizeof(struct DtpntMemRec *)); + if (ca_mem->dt_mem == NULL) { + free(ca_mem); ca_mem = NULL; + cvProcessError(cv_mem, CV_MEM_FAIL, "CVODEA", "CVodeAdjInit", MSGCV_MEM_FAIL); + return(CV_MEM_FAIL); + } + + for (i=0; i<=steps; i++) { + ca_mem->dt_mem[i] = NULL; + ca_mem->dt_mem[i] = (DtpntMem) malloc(sizeof(struct DtpntMemRec)); + if (ca_mem->dt_mem[i] == NULL) { + for(ii=0; iidt_mem[ii]); ca_mem->dt_mem[ii] = NULL;} + free(ca_mem->dt_mem); ca_mem->dt_mem = NULL; + free(ca_mem); ca_mem = NULL; + cvProcessError(cv_mem, CV_MEM_FAIL, "CVODEA", "CVodeAdjInit", MSGCV_MEM_FAIL); + return(CV_MEM_FAIL); + } + } + + /* Attach functions for the appropriate interpolation module */ + + switch(interp) { + + case CV_HERMITE: + + ca_mem->ca_IMmalloc = CVAhermiteMalloc; + ca_mem->ca_IMfree = CVAhermiteFree; + ca_mem->ca_IMget = CVAhermiteGetY; + ca_mem->ca_IMstore = CVAhermiteStorePnt; + + break; + + case CV_POLYNOMIAL: + + ca_mem->ca_IMmalloc = CVApolynomialMalloc; + ca_mem->ca_IMfree = CVApolynomialFree; + ca_mem->ca_IMget = CVApolynomialGetY; + ca_mem->ca_IMstore = CVApolynomialStorePnt; + + break; + + } + + /* The interpolation module has not been initialized yet */ + + ca_mem->ca_IMmallocDone = FALSE; + + /* By default we will store but not interpolate sensitivities + * - IMstoreSensi will be set in CVodeF to FALSE if FSA is not enabled + * or if the user can force this through CVodeSetAdjNoSensi + * - IMinterpSensi will be set in CVodeB to TRUE if IMstoreSensi is + * TRUE and if at least one backward problem requires sensitivities */ + + ca_mem->ca_IMstoreSensi = TRUE; + ca_mem->ca_IMinterpSensi = FALSE; + + /* ------------------------------------ + * Initialize list of backward problems + * ------------------------------------ */ + + ca_mem->cvB_mem = NULL; + ca_mem->ca_bckpbCrt = NULL; + ca_mem->ca_nbckpbs = 0; + + /* -------------------------------- + * CVodeF and CVodeB not called yet + * -------------------------------- */ + + ca_mem->ca_firstCVodeFcall = TRUE; + ca_mem->ca_tstopCVodeFcall = FALSE; + + ca_mem->ca_firstCVodeBcall = TRUE; + + /* --------------------------------------------- + * ASA initialized and allocated + * --------------------------------------------- */ + + cv_mem->cv_adj = TRUE; + cv_mem->cv_adjMallocDone = TRUE; + + return(CV_SUCCESS); +} + +/* CVodeAdjReInit + * + * This routine reinitializes the CVODEA memory structure assuming that the + * the number of steps between check points and the type of interpolation + * remain unchanged. + * The list of check points (and associated memory) is deleted. + * The list of backward problems is kept (however, new backward problems can + * be added to this list by calling CVodeCreateB). + * The CVODES memory for the forward and backward problems can be reinitialized + * separately by calling CVodeReInit and CVodeReInitB, respectively. + * NOTE: if a completely new list of backward problems is also needed, then + * simply free the adjoint memory (by calling CVodeAdjFree) and reinitialize + * ASA with CVodeAdjInit. + */ + +int CVodeAdjReInit(void *cvode_mem) +{ + CVadjMem ca_mem; + CVodeMem cv_mem; + + /* Check cvode_mem */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeAdjReInit", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeAdjReInit", MSGCV_NO_ADJ); + return(CV_NO_ADJ); + } + + ca_mem = cv_mem->cv_adj_mem; + + /* Free current list of Check Points */ + + while (ca_mem->ck_mem != NULL) CVAckpntDelete(&(ca_mem->ck_mem)); + + /* Initialization of check points */ + + ca_mem->ck_mem = NULL; + ca_mem->ca_nckpnts = 0; + ca_mem->ca_ckpntData = NULL; + + /* CVodeF and CVodeB not called yet */ + + ca_mem->ca_firstCVodeFcall = TRUE; + ca_mem->ca_tstopCVodeFcall = FALSE; + ca_mem->ca_firstCVodeBcall = TRUE; + + return(CV_SUCCESS); +} + +/* + * CVodeAdjFree + * + * This routine frees the memory allocated by CVodeAdjInit. + */ + +void CVodeAdjFree(void *cvode_mem) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + long int i; + + if (cvode_mem == NULL) return; + cv_mem = (CVodeMem) cvode_mem; + + if (cv_mem->cv_adjMallocDone) { + + ca_mem = cv_mem->cv_adj_mem; + + /* Delete check points one by one */ + while (ca_mem->ck_mem != NULL) CVAckpntDelete(&(ca_mem->ck_mem)); + + /* Free vectors at all data points */ + if (ca_mem->ca_IMmallocDone) { + ca_mem->ca_IMfree(cv_mem); + } + for(i=0; i<=ca_mem->ca_nsteps; i++) { + free(ca_mem->dt_mem[i]); + ca_mem->dt_mem[i] = NULL; + } + free(ca_mem->dt_mem); + ca_mem->dt_mem = NULL; + + /* Delete backward problems one by one */ + while (ca_mem->cvB_mem != NULL) CVAbckpbDelete(&(ca_mem->cvB_mem)); + + /* Free CVODEA memory */ + free(ca_mem); + cv_mem->cv_adj_mem = NULL; + + } + +} + +/* + * ----------------------------------------------------------------- + * Readibility Constants + * ----------------------------------------------------------------- + */ + +#define tinitial (ca_mem->ca_tinitial) +#define tfinal (ca_mem->ca_tfinal) +#define nckpnts (ca_mem->ca_nckpnts) +#define nsteps (ca_mem->ca_nsteps) +#define nbckpbs (ca_mem->ca_nbckpbs) +#define ckpntData (ca_mem->ca_ckpntData) +#define np (ca_mem->ca_np) +#define ytmp (ca_mem->ca_ytmp) +#define yStmp (ca_mem->ca_yStmp) +#define Y (ca_mem->ca_Y) +#define YS (ca_mem->ca_YS) +#define T (ca_mem->ca_T) + +#define IMmalloc (ca_mem->ca_IMmalloc) +#define IMfree (ca_mem->ca_IMfree) +#define IMget (ca_mem->ca_IMget) +#define IMstore (ca_mem->ca_IMstore) +#define IMmallocDone (ca_mem->ca_IMmallocDone) +#define IMstoreSensi (ca_mem->ca_IMstoreSensi) +#define IMinterpSensi (ca_mem->ca_IMinterpSensi) +#define IMnewData (ca_mem->ca_IMnewData) + +#define uround (cv_mem->cv_uround) +#define zn (cv_mem->cv_zn) +#define nst (cv_mem->cv_nst) +#define q (cv_mem->cv_q) +#define qu (cv_mem->cv_qu) +#define qprime (cv_mem->cv_qprime) +#define qwait (cv_mem->cv_qwait) +#define L (cv_mem->cv_L) +#define gammap (cv_mem->cv_gammap) +#define h (cv_mem->cv_h) +#define hprime (cv_mem->cv_hprime) +#define hscale (cv_mem->cv_hscale) +#define eta (cv_mem->cv_eta) +#define etamax (cv_mem->cv_etamax) +#define tn (cv_mem->cv_tn) +#define tretlast (cv_mem->cv_tretlast) +#define tau (cv_mem->cv_tau) +#define tq (cv_mem->cv_tq) +#define l (cv_mem->cv_l) +#define saved_tq5 (cv_mem->cv_saved_tq5) +#define forceSetup (cv_mem->cv_forceSetup) +#define f (cv_mem->cv_f) +#define lmm (cv_mem->cv_lmm) +#define iter (cv_mem->cv_iter) +#define reltol (cv_mem->cv_reltol) +#define user_data (cv_mem->cv_user_data) +#define errfp (cv_mem->cv_errfp) +#define h0u (cv_mem->cv_h0u) +#define tempv (cv_mem->cv_tempv) + +#define quadr (cv_mem->cv_quadr) +#define errconQ (cv_mem->cv_errconQ) +#define znQ (cv_mem->cv_znQ) +#define tempvQ (cv_mem->cv_tempvQ) + +#define sensi (cv_mem->cv_sensi) +#define Ns (cv_mem->cv_Ns) +#define errconS (cv_mem->cv_errconS) +#define znS (cv_mem->cv_znS) + +#define quadr_sensi (cv_mem->cv_quadr_sensi) +#define errconQS (cv_mem->cv_errconQS) +#define znQS (cv_mem->cv_znQS) + +#define t0_ (ck_mem->ck_t0) +#define t1_ (ck_mem->ck_t1) +#define zn_ (ck_mem->ck_zn) +#define znQ_ (ck_mem->ck_znQ) +#define znS_ (ck_mem->ck_znS) +#define znQS_ (ck_mem->ck_znQS) +#define quadr_ (ck_mem->ck_quadr) +#define sensi_ (ck_mem->ck_sensi) +#define quadr_sensi_ (ck_mem->ck_quadr_sensi) +#define Ns_ (ck_mem->ck_Ns) +#define zqm_ (ck_mem->ck_zqm) +#define nst_ (ck_mem->ck_nst) +#define tretlast_ (ck_mem->ck_tretlast) +#define q_ (ck_mem->ck_q) +#define qprime_ (ck_mem->ck_qprime) +#define qwait_ (ck_mem->ck_qwait) +#define L_ (ck_mem->ck_L) +#define gammap_ (ck_mem->ck_gammap) +#define h_ (ck_mem->ck_h) +#define hprime_ (ck_mem->ck_hprime) +#define hscale_ (ck_mem->ck_hscale) +#define eta_ (ck_mem->ck_eta) +#define etamax_ (ck_mem->ck_etamax) +#define tau_ (ck_mem->ck_tau) +#define tq_ (ck_mem->ck_tq) +#define l_ (ck_mem->ck_l) +#define saved_tq5_ (ck_mem->ck_saved_tq5) +#define next_ (ck_mem->ck_next) + + +/* + * CVodeF + * + * This routine integrates to tout and returns solution into yout. + * In the same time, it stores check point data every 'steps' steps. + * + * CVodeF can be called repeatedly by the user. + * + * ncheckPtr points to the number of check points stored so far. + */ + +int CVodeF(void *cvode_mem, realtype tout, N_Vector yout, + realtype *tret, int itask, int *ncheckPtr) +{ + CVadjMem ca_mem; + CVodeMem cv_mem; + CkpntMem tmp; + DtpntMem *dt_mem; + int flag, i; + booleantype iret, allocOK; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeF", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeF", MSGCV_NO_ADJ); + return(CV_NO_ADJ); + } + + ca_mem = cv_mem->cv_adj_mem; + + /* Check for yout != NULL */ + if (yout == NULL) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeF", MSGCV_YOUT_NULL); + return(CV_ILL_INPUT); + } + + /* Check for tret != NULL */ + if (tret == NULL) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeF", MSGCV_TRET_NULL); + return(CV_ILL_INPUT); + } + + /* Check for valid itask */ + if ( (itask != CV_NORMAL) && (itask != CV_ONE_STEP) ) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeF", MSGCV_BAD_ITASK); + return(CV_ILL_INPUT); + } + + /* All error checking done */ + + dt_mem = ca_mem->dt_mem; + + /* If tstop is enabled, store some info */ + if (cv_mem->cv_tstopset) { + ca_mem->ca_tstopCVodeFcall = TRUE; + ca_mem->ca_tstopCVodeF = cv_mem->cv_tstop; + } + + /* We will call CVode in CV_ONE_STEP mode, regardless + * of what itask is, so flag if we need to return */ + if (itask == CV_ONE_STEP) iret = TRUE; + else iret = FALSE; + + /* On the first step: + * - set tinitial + * - initialize list of check points + * - if needed, initialize the interpolation module + * - load dt_mem[0] + * On subsequent steps, test if taking a new step is necessary. + */ + if ( ca_mem->ca_firstCVodeFcall ) { + + tinitial = tn; + + ca_mem->ck_mem = CVAckpntInit(cv_mem); + if (ca_mem->ck_mem == NULL) { + cvProcessError(cv_mem, CV_MEM_FAIL, "CVODEA", "CVodeF", MSGCV_MEM_FAIL); + return(CV_MEM_FAIL); + } + + if ( !IMmallocDone ) { + + /* Do we need to store sensitivities? */ + if (!sensi) IMstoreSensi = FALSE; + + /* Allocate space for interpolation data */ + allocOK = IMmalloc(cv_mem); + if (!allocOK) { + cvProcessError(cv_mem, CV_MEM_FAIL, "CVODEA", "CVodeF", MSGCV_MEM_FAIL); + return(CV_MEM_FAIL); + } + + /* Rename zn and, if needed, znS for use in interpolation */ + for (i=0;it = ca_mem->ck_mem->ck_t0; + IMstore(cv_mem, dt_mem[0]); + + ca_mem->ca_firstCVodeFcall = FALSE; + + } else if ( (tn - tout)*h >= ZERO ) { + + /* If tout was passed, return interpolated solution. + No changes to ck_mem or dt_mem are needed. */ + *tret = tout; + flag = CVodeGetDky(cv_mem, tout, 0, yout); + *ncheckPtr = nckpnts; + IMnewData = TRUE; + ckpntData = ca_mem->ck_mem; + np = nst % nsteps + 1; + + return(flag); + + } + + /* Integrate to tout (in CV_ONE_STEP mode) while loading check points */ + loop { + + /* Perform one step of the integration */ + + flag = CVode(cv_mem, tout, yout, tret, CV_ONE_STEP); + if (flag < 0) break; + + /* Test if a new check point is needed */ + + if ( nst % nsteps == 0 ) { + + ca_mem->ck_mem->ck_t1 = *tret; + + /* Create a new check point, load it, and append it to the list */ + tmp = CVAckpntNew(cv_mem); + if (tmp == NULL) { + cvProcessError(cv_mem, CV_MEM_FAIL, "CVODEA", "CVodeF", MSGCV_MEM_FAIL); + flag = CV_MEM_FAIL; + break; + } + tmp->ck_next = ca_mem->ck_mem; + ca_mem->ck_mem = tmp; + nckpnts++; + forceSetup = TRUE; + + /* Reset i=0 and load dt_mem[0] */ + dt_mem[0]->t = ca_mem->ck_mem->ck_t0; + IMstore(cv_mem, dt_mem[0]); + + } else { + + /* Load next point in dt_mem */ + dt_mem[nst%nsteps]->t = *tret; + IMstore(cv_mem, dt_mem[nst%nsteps]); + + } + + /* Set t1 field of the current ckeck point structure + for the case in which there will be no future + check points */ + ca_mem->ck_mem->ck_t1 = *tret; + + /* tfinal is now set to *tret */ + tfinal = *tret; + + /* Return if in CV_ONE_STEP mode */ + if (iret) break; + + /* Return if tout reached */ + if ( (*tret - tout)*h >= ZERO ) { + *tret = tout; + CVodeGetDky(cv_mem, tout, 0, yout); + /* Reset tretlast in cv_mem so that CVodeGetQuad and CVodeGetSens + * evaluate quadratures and/or sensitivities at the proper time */ + cv_mem->cv_tretlast = tout; + break; + } + + } /* end of loop() */ + + /* Get ncheck from ca_mem */ + *ncheckPtr = nckpnts; + + /* Data is available for the last interval */ + IMnewData = TRUE; + ckpntData = ca_mem->ck_mem; + np = nst % nsteps + 1; + + return(flag); +} + + + +/* + * ================================================================= + * FUNCTIONS FOR BACKWARD PROBLEMS + * ================================================================= + */ + + +int CVodeCreateB(void *cvode_mem, int lmmB, int iterB, int *which) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem new_cvB_mem; + void *cvodeB_mem; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeCreateB", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeCreateB", MSGCV_NO_ADJ); + return(CV_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Allocate space for new CVodeBMem object */ + + new_cvB_mem = NULL; + new_cvB_mem = (CVodeBMem) malloc(sizeof(struct CVodeBMemRec)); + if (new_cvB_mem == NULL) { + cvProcessError(cv_mem, CV_MEM_FAIL, "CVODEA", "CVodeCreateB", MSGCV_MEM_FAIL); + return(CV_MEM_FAIL); + } + + /* Create and set a new CVODES object for the backward problem */ + + cvodeB_mem = CVodeCreate(lmmB, iterB); + if (cvodeB_mem == NULL) { + cvProcessError(cv_mem, CV_MEM_FAIL, "CVODEA", "CVodeCreateB", MSGCV_MEM_FAIL); + return(CV_MEM_FAIL); + } + + CVodeSetUserData(cvodeB_mem, cvode_mem); + + CVodeSetMaxHnilWarns(cvodeB_mem, -1); + + CVodeSetErrHandlerFn(cvodeB_mem, cv_mem->cv_ehfun, cv_mem->cv_eh_data); + CVodeSetErrFile(cvodeB_mem, cv_mem->cv_errfp); + + /* Set/initialize fields in the new CVodeBMem object, new_cvB_mem */ + + new_cvB_mem->cv_index = nbckpbs; + + new_cvB_mem->cv_mem = (CVodeMem) cvodeB_mem; + + new_cvB_mem->cv_f = NULL; + new_cvB_mem->cv_fs = NULL; + + new_cvB_mem->cv_fQ = NULL; + new_cvB_mem->cv_fQs = NULL; + + new_cvB_mem->cv_user_data = NULL; + + new_cvB_mem->cv_lmem = NULL; + new_cvB_mem->cv_lfree = NULL; + new_cvB_mem->cv_pmem = NULL; + new_cvB_mem->cv_pfree = NULL; + + new_cvB_mem->cv_y = NULL; + + new_cvB_mem->cv_f_withSensi = FALSE; + new_cvB_mem->cv_fQ_withSensi = FALSE; + + /* Attach the new object to the linked list cvB_mem */ + + new_cvB_mem->cv_next = ca_mem->cvB_mem; + ca_mem->cvB_mem = new_cvB_mem; + + /* Return the index of the newly created CVodeBMem object. + * This must be passed to CVodeInitB and to other ***B + * functions to set optional inputs for this backward problem */ + + *which = nbckpbs; + + nbckpbs++; + + return(CV_SUCCESS); +} + +int CVodeInitB(void *cvode_mem, int which, + CVRhsFnB fB, + realtype tB0, N_Vector yB0) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + int flag; + + /* Check if cvode_mem exists */ + + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeInitB", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeInitB", MSGCV_NO_ADJ); + return(CV_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check the value of which */ + + if ( which >= nbckpbs ) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeInitB", MSGCV_BAD_WHICH); + return(CV_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + /* Allocate and set the CVODES object */ + + flag = CVodeInit(cvodeB_mem, CVArhs, tB0, yB0); + + if (flag != CV_SUCCESS) return(flag); + + /* Copy fB function in cvB_mem */ + + cvB_mem->cv_f_withSensi = FALSE; + cvB_mem->cv_f = fB; + + /* Allocate space and initialize the y Nvector in cvB_mem */ + + cvB_mem->cv_t0 = tB0; + cvB_mem->cv_y = N_VClone(yB0); + N_VScale(ONE, yB0, cvB_mem->cv_y); + + return(CV_SUCCESS); +} + +int CVodeInitBS(void *cvode_mem, int which, + CVRhsFnBS fBs, + realtype tB0, N_Vector yB0) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + int flag; + + /* Check if cvode_mem exists */ + + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeInitBS", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeInitBS", MSGCV_NO_ADJ); + return(CV_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check the value of which */ + + if ( which >= nbckpbs ) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeInitBS", MSGCV_BAD_WHICH); + return(CV_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + /* Allocate and set the CVODES object */ + + flag = CVodeInit(cvodeB_mem, CVArhs, tB0, yB0); + + if (flag != CV_SUCCESS) return(flag); + + /* Copy fBs function in cvB_mem */ + + cvB_mem->cv_f_withSensi = TRUE; + cvB_mem->cv_fs = fBs; + + /* Allocate space and initialize the y Nvector in cvB_mem */ + + cvB_mem->cv_t0 = tB0; + cvB_mem->cv_y = N_VClone(yB0); + N_VScale(ONE, yB0, cvB_mem->cv_y); + + return(CV_SUCCESS); +} + + +int CVodeReInitB(void *cvode_mem, int which, + realtype tB0, N_Vector yB0) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeReInitB", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeReInitB", MSGCV_NO_ADJ); + return(CV_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check the value of which */ + if ( which >= nbckpbs ) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeReInitB", MSGCV_BAD_WHICH); + return(CV_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + /* Reinitialize CVODES object */ + + flag = CVodeReInit(cvodeB_mem, tB0, yB0); + + return(flag); +} + + +int CVodeSStolerancesB(void *cvode_mem, int which, realtype reltolB, realtype abstolB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + int flag; + + /* Check if cvode_mem exists */ + + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSStolerancesB", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSStolerancesB", MSGCV_NO_ADJ); + return(CV_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check the value of which */ + + if ( which >= nbckpbs ) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSStolerancesB", MSGCV_BAD_WHICH); + return(CV_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + /* Set tolerances */ + + flag = CVodeSStolerances(cvodeB_mem, reltolB, abstolB); + + return(flag); +} + + +int CVodeSVtolerancesB(void *cvode_mem, int which, realtype reltolB, N_Vector abstolB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + int flag; + + /* Check if cvode_mem exists */ + + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSVtolerancesB", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSVtolerancesB", MSGCV_NO_ADJ); + return(CV_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check the value of which */ + + if ( which >= nbckpbs ) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSVtolerancesB", MSGCV_BAD_WHICH); + return(CV_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + /* Set tolerances */ + + flag = CVodeSVtolerances(cvodeB_mem, reltolB, abstolB); + + return(flag); +} + + +int CVodeQuadInitB(void *cvode_mem, int which, + CVQuadRhsFnB fQB, N_Vector yQB0) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeQuadInitB", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeQuadInitB", MSGCV_NO_ADJ); + return(CV_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= nbckpbs ) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeQuadInitB", MSGCV_BAD_WHICH); + return(CV_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + flag = CVodeQuadInit(cvodeB_mem, CVArhsQ, yQB0); + if (flag != CV_SUCCESS) return(flag); + + cvB_mem->cv_fQ_withSensi = FALSE; + cvB_mem->cv_fQ = fQB; + + return(CV_SUCCESS); +} + +int CVodeQuadInitBS(void *cvode_mem, int which, + CVQuadRhsFnBS fQBs, N_Vector yQB0) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeQuadInitBS", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeQuadInitBS", MSGCV_NO_ADJ); + return(CV_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= nbckpbs ) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeQuadInitBS", MSGCV_BAD_WHICH); + return(CV_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + flag = CVodeQuadInit(cvodeB_mem, CVArhsQ, yQB0); + if (flag != CV_SUCCESS) return(flag); + + cvB_mem->cv_fQ_withSensi = TRUE; + cvB_mem->cv_fQs = fQBs; + + return(CV_SUCCESS); +} + +int CVodeQuadReInitB(void *cvode_mem, int which, N_Vector yQB0) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeQuadReInitB", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeQuadReInitB", MSGCV_NO_ADJ); + return(CV_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check the value of which */ + if ( which >= nbckpbs ) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeQuadReInitB", MSGCV_BAD_WHICH); + return(CV_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + flag = CVodeQuadReInit(cvodeB_mem, yQB0); + if (flag != CV_SUCCESS) return(flag); + + return(CV_SUCCESS); +} + +int CVodeQuadSStolerancesB(void *cvode_mem, int which, realtype reltolQB, realtype abstolQB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeQuadSStolerancesB", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeQuadSStolerancesB", MSGCV_NO_ADJ); + return(CV_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= nbckpbs ) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeQuadSStolerancesB", MSGCV_BAD_WHICH); + return(CV_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + flag = CVodeQuadSStolerances(cvodeB_mem, reltolQB, abstolQB); + + return(flag); +} + +int CVodeQuadSVtolerancesB(void *cvode_mem, int which, realtype reltolQB, N_Vector abstolQB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeQuadSStolerancesB", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeQuadSStolerancesB", MSGCV_NO_ADJ); + return(CV_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= nbckpbs ) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeQuadSStolerancesB", MSGCV_BAD_WHICH); + return(CV_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + flag = CVodeQuadSVtolerances(cvodeB_mem, reltolQB, abstolQB); + + return(flag); +} + +/* + * CVodeB + * + * This routine performs the backward integration towards tBout + * of all backward problems that were defined. + * When necessary, it performs a forward integration between two + * consecutive check points to update interpolation data. + * itask can be CV_NORMAL or CV_ONE_STEP only. + * + * On a successful return, CVodeB returns either CV_SUCCESS + * (in ONE_STEP mode or if tBout was reached in NORMAL mode) + * unless the return time happens to be a checkpoint, in which + * case it returns CV_TSTOP_RETURN) + * + * NOTE that CVodeB DOES NOT return the solution for the backward + * problem(s). Use CVodeGetB to extract the solution at tBret + * for any given backward problem. + */ + +int CVodeB(void *cvode_mem, realtype tBout, int itaskB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem, tmp_cvB_mem; + CkpntMem ck_mem; + int sign, flag; + realtype tBret, tBn, hB, troundoff; + booleantype gotCheckpoint, isActive, reachedTBout; + + /* Check if cvode_mem exists */ + + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeB", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeB", MSGCV_NO_ADJ); + return(CV_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check if any backward problem has been defined */ + + if ( nbckpbs == 0 ) { + cvProcessError(cv_mem, CV_NO_BCK, "CVODEA", "CVodeB", MSGCV_NO_BCK); + return(CV_NO_BCK); + } + cvB_mem = ca_mem->cvB_mem; + + /* Check whether CVodeF has been called */ + + if ( ca_mem->ca_firstCVodeFcall ) { + cvProcessError(cv_mem, CV_NO_FWD, "CVODEA", "CVodeB", MSGCV_NO_FWD); + return(CV_NO_FWD); + } + sign = (tfinal - tinitial > ZERO) ? 1 : -1; + + /* If this is the first call, loop over all backward problems and + * - check that tB0 is valid + * - check whether we need to interpolate forward sensitivities + */ + + if ( ca_mem->ca_firstCVodeBcall ) { + + tmp_cvB_mem = cvB_mem; + + while(tmp_cvB_mem != NULL) { + + tBn = tmp_cvB_mem->cv_mem->cv_tn; + if ( (sign*(tBn-tinitial) < ZERO) || (sign*(tfinal-tBn) < ZERO) ) { + cvProcessError(cv_mem, CV_BAD_TB0, "CVODEA", "CVodeB", MSGCV_BAD_TB0, tmp_cvB_mem->cv_index); + return(CV_BAD_TB0); + } + + if ( tmp_cvB_mem->cv_f_withSensi || tmp_cvB_mem->cv_fQ_withSensi ) IMinterpSensi = TRUE; + + tmp_cvB_mem = tmp_cvB_mem->cv_next; + + } + + if ( IMinterpSensi && !IMstoreSensi) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeB", MSGCV_BAD_SENSI); + return(CV_ILL_INPUT); + } + + ca_mem->ca_firstCVodeBcall = FALSE; + } + + /* Check if itaskB is legal */ + + if ( (itaskB != CV_NORMAL) && (itaskB != CV_ONE_STEP) ) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeB", MSGCV_BAD_ITASKB); + return(CV_ILL_INPUT); + } + + /* Check if tBout is legal */ + + if ( (sign*(tBout-tinitial) < ZERO) || (sign*(tfinal-tBout) < ZERO) ) { + if ( ABS(tBout-tinitial) < HUNDRED*uround ) { + tBout = tinitial; + } else { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeB", MSGCV_BAD_TBOUT); + return(CV_ILL_INPUT); + } + } + + /* Loop through the check points and stop as soon as a backward + * problem has its tn value larger than the current check point's + * t0_ value (taking into account the direction of integration) */ + + ck_mem = ca_mem->ck_mem; + + gotCheckpoint = FALSE; + + loop { + + tmp_cvB_mem = cvB_mem; + while(tmp_cvB_mem != NULL) { + tBn = tmp_cvB_mem->cv_mem->cv_tn; + hB = tmp_cvB_mem->cv_mem->cv_hu; + troundoff = HUNDRED*uround*(ABS(tBn) + ABS(hB)); + if ( sign * (tBn-t0_) > troundoff ) { + gotCheckpoint = TRUE; + break; + } + tmp_cvB_mem = tmp_cvB_mem->cv_next; + } + + if (gotCheckpoint) break; + + if (next_ == NULL) break; + + ck_mem = next_; + } + + /* Loop while propagating backward problems */ + + loop { + + /* Store interpolation data if not available. + This is the 2nd forward integration pass */ + + if (ck_mem != ckpntData) { + + flag = CVAdataStore(cv_mem, ck_mem); + if (flag != CV_SUCCESS) break; + + } + + /* Loop through all backward problems and, if needed, + * propagate their solution towards tBout */ + + tmp_cvB_mem = cvB_mem; + while (tmp_cvB_mem != NULL) { + + /* Decide if current backward problem is "active" */ + + isActive = TRUE; + + tBn = tmp_cvB_mem->cv_mem->cv_tn; + hB = tmp_cvB_mem->cv_mem->cv_hu; + troundoff = HUNDRED*uround*(ABS(tBn) + ABS(hB)); + + if ( sign * (tBn - t0_) < troundoff ) isActive = FALSE; + if ( sign * (tBn - tBout) < troundoff ) isActive = FALSE; + + if ( isActive ) { + + /* Store the address of current backward problem memory + * in ca_mem to be used in the wrapper functions */ + ca_mem->ca_bckpbCrt = tmp_cvB_mem; + + /* Integrate current backward problem */ + CVodeSetStopTime(tmp_cvB_mem->cv_mem, t0_); + flag = CVode(tmp_cvB_mem->cv_mem, tBout, tmp_cvB_mem->cv_y, &tBret, itaskB); + + /* If an error occured, exit while loop */ + if (flag < 0) break; + + /* Set the time at which we will report solution and/or quadratures */ + tmp_cvB_mem->cv_tout = tBret; + + } else { + + flag = CV_SUCCESS; + tmp_cvB_mem->cv_tout = tBn; + + } + + /* Move to next backward problem */ + + tmp_cvB_mem = tmp_cvB_mem->cv_next; + } + + /* If an error occured, return now */ + + if (flag <0) { + cvProcessError(cv_mem, flag, "CVODEA", "CVodeB", MSGCV_BACK_ERROR, tmp_cvB_mem->cv_index); + return(flag); + } + + /* If in CV_ONE_STEP mode, return now (flag=CV_SUCCESS or flag=CV_TSTOP_RETURN) */ + + if (itaskB == CV_ONE_STEP) break; + + /* If all backward problems have succesfully reached tBout, return now */ + + reachedTBout = TRUE; + + tmp_cvB_mem = cvB_mem; + while(tmp_cvB_mem != NULL) { + if ( sign*(tmp_cvB_mem->cv_tout - tBout) > 0 ) { + reachedTBout = FALSE; + break; + } + tmp_cvB_mem = tmp_cvB_mem->cv_next; + } + + if ( reachedTBout ) break; + + /* Move check point in linked list to next one */ + + ck_mem = next_; + + } + + return(flag); +} + + + +int CVodeGetB(void *cvode_mem, int which, realtype *tret, N_Vector yB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeGetB", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeGetB", MSGCV_NO_ADJ); + return(CV_NO_ADJ); + } + + ca_mem = cv_mem->cv_adj_mem; + + /* Check the value of which */ + if ( which >= nbckpbs ) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeGetB", MSGCV_BAD_WHICH); + return(CV_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + N_VScale(ONE, cvB_mem->cv_y, yB); + *tret = cvB_mem->cv_tout; + + return(CV_SUCCESS); +} + + +/* + * CVodeGetQuadB + */ + +int CVodeGetQuadB(void *cvode_mem, int which, realtype *tret, N_Vector qB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + long int nstB; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeGetQuadB", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeGetQuadB", MSGCV_NO_ADJ); + return(CV_NO_ADJ); + } + + ca_mem = cv_mem->cv_adj_mem; + + /* Check the value of which */ + if ( which >= nbckpbs ) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeGetQuadB", MSGCV_BAD_WHICH); + return(CV_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + /* If the integration for this backward problem has not started yet, + * simply return the current value of qB (i.e. the final conditions) */ + + flag = CVodeGetNumSteps(cvodeB_mem, &nstB); + + if (nstB == 0) { + N_VScale(ONE, cvB_mem->cv_mem->cv_znQ[0], qB); + *tret = cvB_mem->cv_tout; + } else { + flag = CVodeGetQuad(cvodeB_mem, tret, qB); + } + + return(flag); +} + + +/* + * ================================================================= + * PRIVATE FUNCTIONS FOR CHECK POINTS + * ================================================================= + */ + +/* + * CVAckpntInit + * + * This routine initializes the check point linked list with + * information from the initial time. + */ + +static CkpntMem CVAckpntInit(CVodeMem cv_mem) +{ + CkpntMem ck_mem; + int is; + + /* Allocate space for ckdata */ + ck_mem = NULL; + ck_mem = (CkpntMem) malloc(sizeof(struct CkpntMemRec)); + if (ck_mem == NULL) return(NULL); + + zn_[0] = N_VClone(tempv); + if (zn_[0] == NULL) { + free(ck_mem); ck_mem = NULL; + return(NULL); + } + + zn_[1] = N_VClone(tempv); + if (zn_[1] == NULL) { + N_VDestroy(zn_[0]); + free(ck_mem); ck_mem = NULL; + return(NULL); + } + + /* zn_[qmax] was not allocated */ + zqm_ = 0; + + /* Load ckdata from cv_mem */ + N_VScale(ONE, zn[0], zn_[0]); + t0_ = tn; + nst_ = 0; + q_ = 1; + h_ = 0.0; + + /* Do we need to carry quadratures */ + quadr_ = quadr && errconQ; + + if (quadr_) { + + znQ_[0] = N_VClone(tempvQ); + if (znQ_[0] == NULL) { + N_VDestroy(zn_[0]); + N_VDestroy(zn_[1]); + free(ck_mem); ck_mem = NULL; + return(NULL); + } + + N_VScale(ONE, znQ[0], znQ_[0]); + + } + + /* Do we need to carry sensitivities? */ + sensi_ = sensi; + + if (sensi_) { + + Ns_ = Ns; + + znS_[0] = N_VCloneVectorArray(Ns, tempv); + if (znS_[0] == NULL) { + N_VDestroy(zn_[0]); + N_VDestroy(zn_[1]); + if (quadr_) N_VDestroy(znQ_[0]); + free(ck_mem); ck_mem = NULL; + return(NULL); + } + + for (is=0; isck_next = NULL; + + /* Test if we need to allocate space for the last zn. + * NOTE: zn(qmax) may be needed for a hot restart, if an order + * increase is deemed necessary at the first step after a check point */ + qmax = cv_mem->cv_qmax; + zqm_ = (q < qmax) ? qmax : 0; + + for (j=0; j<=q; j++) { + zn_[j] = N_VClone(tempv); + if (zn_[j] == NULL) { + for (jj=0; jjck_next; + + /* free N_Vectors in tmp */ + for (j=0;j<=tmp->ck_q;j++) N_VDestroy(tmp->ck_zn[j]); + if (tmp->ck_zqm != 0) N_VDestroy(tmp->ck_zn[tmp->ck_zqm]); + + /* free N_Vectors for quadratures in tmp + * Note that at the check point at t_initial, only znQ_[0] + * was allocated */ + if (tmp->ck_quadr) { + + if (tmp->ck_next != NULL) { + for (j=0;j<=tmp->ck_q;j++) N_VDestroy(tmp->ck_znQ[j]); + if (tmp->ck_zqm != 0) N_VDestroy(tmp->ck_znQ[tmp->ck_zqm]); + } else { + N_VDestroy(tmp->ck_znQ[0]); + } + + } + + /* free N_Vectors for sensitivities in tmp + * Note that at the check point at t_initial, only znS_[0] + * was allocated */ + if (tmp->ck_sensi) { + + if (tmp->ck_next != NULL) { + for (j=0;j<=tmp->ck_q;j++) N_VDestroyVectorArray(tmp->ck_znS[j], tmp->ck_Ns); + if (tmp->ck_zqm != 0) N_VDestroyVectorArray(tmp->ck_znS[tmp->ck_zqm], tmp->ck_Ns); + } else { + N_VDestroyVectorArray(tmp->ck_znS[0], tmp->ck_Ns); + } + + } + + /* free N_Vectors for quadrature sensitivities in tmp + * Note that at the check point at t_initial, only znQS_[0] + * was allocated */ + if (tmp->ck_quadr_sensi) { + + if (tmp->ck_next != NULL) { + for (j=0;j<=tmp->ck_q;j++) N_VDestroyVectorArray(tmp->ck_znQS[j], tmp->ck_Ns); + if (tmp->ck_zqm != 0) N_VDestroyVectorArray(tmp->ck_znQS[tmp->ck_zqm], tmp->ck_Ns); + } else { + N_VDestroyVectorArray(tmp->ck_znQS[0], tmp->ck_Ns); + } + + } + + free(tmp); tmp = NULL; + +} + +/* + * ================================================================= + * PRIVATE FUNCTIONS FOR BACKWARD PROBLEMS + * ================================================================= + */ + +static void CVAbckpbDelete(CVodeBMem *cvB_memPtr) +{ + CVodeBMem tmp; + void *cvode_mem; + + if (*cvB_memPtr != NULL) { + + /* Save head of the list */ + tmp = *cvB_memPtr; + + /* Move head of the list */ + *cvB_memPtr = (*cvB_memPtr)->cv_next; + + /* Free CVODES memory in tmp */ + cvode_mem = (void *)(tmp->cv_mem); + CVodeFree(&cvode_mem); + + /* Free linear solver memory */ + if (tmp->cv_lfree != NULL) tmp->cv_lfree(tmp); + + /* Free preconditioner memory */ + if (tmp->cv_pfree != NULL) tmp->cv_pfree(tmp); + + /* Free workspace Nvector */ + N_VDestroy(tmp->cv_y); + + free(tmp); tmp = NULL; + + } + +} + +/* + * ================================================================= + * PRIVATE FUNCTIONS FOR INTERPOLATION + * ================================================================= + */ + +/* + * CVAdataStore + * + * This routine integrates the forward model starting at the check + * point ck_mem and stores y and yprime at all intermediate steps. + * + * Return values: + * CV_SUCCESS + * CV_REIFWD_FAIL + * CV_FWD_FAIL + */ + +static int CVAdataStore(CVodeMem cv_mem, CkpntMem ck_mem) +{ + CVadjMem ca_mem; + DtpntMem *dt_mem; + realtype t; + long int i; + int flag; + + ca_mem = cv_mem->cv_adj_mem; + dt_mem = ca_mem->dt_mem; + + /* Initialize cv_mem with data from ck_mem */ + flag = CVAckpntGet(cv_mem, ck_mem); + if (flag != CV_SUCCESS) + return(CV_REIFWD_FAIL); + + /* Set first structure in dt_mem[0] */ + dt_mem[0]->t = t0_; + IMstore(cv_mem, dt_mem[0]); + + /* Decide whether TSTOP must be activated */ + if (ca_mem->ca_tstopCVodeFcall) { + CVodeSetStopTime(cv_mem, ca_mem->ca_tstopCVodeF); + } + + /* Run CVode to set following structures in dt_mem[i] */ + i = 1; + do { + + flag = CVode(cv_mem, t1_, ytmp, &t, CV_ONE_STEP); + if (flag < 0) return(CV_FWD_FAIL); + + dt_mem[i]->t = t; + IMstore(cv_mem, dt_mem[i]); + i++; + + } while (tcv_ism, znS_[0]); + if (flag != CV_SUCCESS) return(flag); + } + + if (quadr_sensi_) { + flag = CVodeQuadSensReInit(cv_mem, znQS_[0]); + if (flag != CV_SUCCESS) return(flag); + } + + } else { + + qmax = cv_mem->cv_qmax; + + /* Copy parameters from check point data structure */ + + nst = nst_; + tretlast = tretlast_; + q = q_; + qprime = qprime_; + qwait = qwait_; + L = L_; + gammap = gammap_; + h = h_; + hprime = hprime_; + hscale = hscale_; + eta = eta_; + etamax = etamax_; + tn = t0_; + saved_tq5 = saved_tq5_; + + /* Copy the arrays from check point data structure */ + + for (j=0; j<=q; j++) N_VScale(ONE, zn_[j], zn[j]); + if ( q < qmax ) N_VScale(ONE, zn_[qmax], zn[qmax]); + + if (quadr_) { + for (j=0; j<=q; j++) N_VScale(ONE, znQ_[j], znQ[j]); + if ( q < qmax ) N_VScale(ONE, znQ_[qmax], znQ[qmax]); + } + + if (sensi_) { + for (is=0; iscv_adj_mem; + dt_mem = ca_mem->dt_mem; + + *newpoint = FALSE; + + /* Find the direction of integration */ + sign = (tfinal - tinitial > ZERO) ? 1 : -1; + + /* If this is the first time we use new data */ + if (IMnewData) { + ilast = np-1; + *newpoint = TRUE; + IMnewData = FALSE; + } + + /* Search for indx starting from ilast */ + to_left = ( sign*(t - dt_mem[ilast-1]->t) < ZERO); + to_right = ( sign*(t - dt_mem[ilast]->t) > ZERO); + + if ( to_left ) { + /* look for a new indx to the left */ + + *newpoint = TRUE; + + *indx = ilast; + loop { + if ( *indx == 0 ) break; + if ( sign*(t - dt_mem[*indx-1]->t) <= ZERO ) (*indx)--; + else break; + } + + if ( *indx == 0 ) + ilast = 1; + else + ilast = *indx; + + if ( *indx == 0 ) { + /* t is beyond leftmost limit. Is it too far? */ + if ( ABS(t - dt_mem[0]->t) > FUZZ_FACTOR * uround ) { + return(CV_GETY_BADT); + } + } + + } else if ( to_right ) { + /* look for a new indx to the right */ + + *newpoint = TRUE; + + *indx = ilast; + loop { + if ( sign*(t - dt_mem[*indx]->t) > ZERO) (*indx)++; + else break; + } + + ilast = *indx; + + + } else { + /* ilast is still OK */ + + *indx = ilast; + + } + + return(CV_SUCCESS); + + +} + +/* + * CVodeGetAdjY + * + * This routine returns the interpolated forward solution at time t. + * The user must allocate space for y. + */ + +int CVodeGetAdjY(void *cvode_mem, realtype t, N_Vector y) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + int flag; + + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeGetAdjY", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + ca_mem = cv_mem->cv_adj_mem; + + flag = IMget(cv_mem, t, y, NULL); + + return(flag); +} + +/* + * ----------------------------------------------------------------- + * Functions specific to cubic Hermite interpolation + * ----------------------------------------------------------------- + */ + +/* + * CVAhermiteMalloc + * + * This routine allocates memory for storing information at all + * intermediate points between two consecutive check points. + * This data is then used to interpolate the forward solution + * at any other time. + */ + +static booleantype CVAhermiteMalloc(CVodeMem cv_mem) +{ + CVadjMem ca_mem; + DtpntMem *dt_mem; + HermiteDataMem content; + long int i, ii=0; + booleantype allocOK; + + allocOK = TRUE; + + ca_mem = cv_mem->cv_adj_mem; + + /* Allocate space for the vectors ytmp and yStmp */ + + ytmp = N_VClone(tempv); + if (ytmp == NULL) { + return(FALSE); + } + + if (IMstoreSensi) { + yStmp = N_VCloneVectorArray(Ns, tempv); + if (yStmp == NULL) { + N_VDestroy(ytmp); + return(FALSE); + } + } + + /* Allocate space for the content field of the dt structures */ + + dt_mem = ca_mem->dt_mem; + + for (i=0; i<=nsteps; i++) { + + content = NULL; + content = (HermiteDataMem) malloc(sizeof(struct HermiteDataMemRec)); + if (content == NULL) { + ii = i; + allocOK = FALSE; + break; + } + + content->y = N_VClone(tempv); + if (content->y == NULL) { + free(content); content = NULL; + ii = i; + allocOK = FALSE; + break; + } + + content->yd = N_VClone(tempv); + if (content->yd == NULL) { + N_VDestroy(content->y); + free(content); content = NULL; + ii = i; + allocOK = FALSE; + break; + } + + if (IMstoreSensi) { + + content->yS = N_VCloneVectorArray(Ns, tempv); + if (content->yS == NULL) { + N_VDestroy(content->y); + N_VDestroy(content->yd); + free(content); content = NULL; + ii = i; + allocOK = FALSE; + break; + } + + content->ySd = N_VCloneVectorArray(Ns, tempv); + if (content->ySd == NULL) { + N_VDestroy(content->y); + N_VDestroy(content->yd); + N_VDestroyVectorArray(content->yS, Ns); + free(content); content = NULL; + ii = i; + allocOK = FALSE; + break; + } + + } + + dt_mem[i]->content = content; + + } + + /* If an error occurred, deallocate and return */ + + if (!allocOK) { + + N_VDestroy(ytmp); + + if (IMstoreSensi) { + N_VDestroyVectorArray(yStmp, Ns); + } + + for (i=0; icontent); + N_VDestroy(content->y); + N_VDestroy(content->yd); + if (IMstoreSensi) { + N_VDestroyVectorArray(content->yS, Ns); + N_VDestroyVectorArray(content->ySd, Ns); + } + free(dt_mem[i]->content); dt_mem[i]->content = NULL; + } + + } + + return(allocOK); +} + +/* + * CVAhermiteFree + * + * This routine frees the memory allocated for data storage. + */ + +static void CVAhermiteFree(CVodeMem cv_mem) +{ + CVadjMem ca_mem; + DtpntMem *dt_mem; + HermiteDataMem content; + long int i; + + ca_mem = cv_mem->cv_adj_mem; + + N_VDestroy(ytmp); + + if (IMstoreSensi) { + N_VDestroyVectorArray(yStmp, Ns); + } + + dt_mem = ca_mem->dt_mem; + + for (i=0; i<=nsteps; i++) { + content = (HermiteDataMem) (dt_mem[i]->content); + N_VDestroy(content->y); + N_VDestroy(content->yd); + if (IMstoreSensi) { + N_VDestroyVectorArray(content->yS, Ns); + N_VDestroyVectorArray(content->ySd, Ns); + } + free(dt_mem[i]->content); dt_mem[i]->content = NULL; + } +} + +/* + * CVAhermiteStorePnt ( -> IMstore ) + * + * This routine stores a new point (y,yd) in the structure d for use + * in the cubic Hermite interpolation. + * Note that the time is already stored. + */ + +static int CVAhermiteStorePnt(CVodeMem cv_mem, DtpntMem d) +{ + CVadjMem ca_mem; + HermiteDataMem content; + int is, retval; + + ca_mem = cv_mem->cv_adj_mem; + + content = (HermiteDataMem) d->content; + + /* Load solution */ + + N_VScale(ONE, zn[0], content->y); + + if (IMstoreSensi) { + for (is=0; isyS[is]); + } + + /* Load derivative */ + + if (nst == 0) { + + retval = f(tn, content->y, content->yd, user_data); + + if (IMstoreSensi) { + retval = cvSensRhsWrapper(cv_mem, tn, content->y, content->yd, + content->yS, content->ySd, + cv_mem->cv_tempv, cv_mem->cv_ftemp); + } + + } else { + + N_VScale(ONE/h, zn[1], content->yd); + + if (IMstoreSensi) { + for (is=0; isySd[is]); + } + + } + + return(0); +} + +/* + * CVAhermiteGetY ( -> IMget ) + * + * This routine uses cubic piece-wise Hermite interpolation for + * the forward solution vector. + * It is typically called by the wrapper routines before calling + * user provided routines (fB, djacB, bjacB, jtimesB, psolB) but + * can be directly called by the user through CVodeGetAdjY + */ + +static int CVAhermiteGetY(CVodeMem cv_mem, realtype t, + N_Vector y, N_Vector *yS) +{ + CVadjMem ca_mem; + DtpntMem *dt_mem; + HermiteDataMem content0, content1; + + realtype t0, t1, delta; + realtype factor1, factor2, factor3; + + N_Vector y0, yd0, y1, yd1; + N_Vector *yS0, *ySd0, *yS1, *ySd1; + + int flag, is, NS; + long int indx; + booleantype newpoint; + + + ca_mem = cv_mem->cv_adj_mem; + dt_mem = ca_mem->dt_mem; + + /* Local value of Ns */ + + NS = IMinterpSensi ? Ns : 0; + + /* Get the index in dt_mem */ + + flag = CVAfindIndex(cv_mem, t, &indx, &newpoint); + if (flag != CV_SUCCESS) return(flag); + + /* If we are beyond the left limit but close enough, + then return y at the left limit. */ + + if (indx == 0) { + content0 = (HermiteDataMem) (dt_mem[0]->content); + N_VScale(ONE, content0->y, y); + for (is=0; isyS[is], yS[is]); + return(CV_SUCCESS); + } + + /* Extract stuff from the appropriate data points */ + + t0 = dt_mem[indx-1]->t; + t1 = dt_mem[indx]->t; + delta = t1 - t0; + + content0 = (HermiteDataMem) (dt_mem[indx-1]->content); + y0 = content0->y; + yd0 = content0->yd; + if (IMinterpSensi) { + yS0 = content0->yS; + ySd0 = content0->ySd; + } + + if (newpoint) { + + /* Recompute Y0 and Y1 */ + + content1 = (HermiteDataMem) (dt_mem[indx]->content); + + y1 = content1->y; + yd1 = content1->yd; + + N_VLinearSum(ONE, y1, -ONE, y0, Y[0]); + N_VLinearSum(ONE, yd1, ONE, yd0, Y[1]); + N_VLinearSum(delta, Y[1], -TWO, Y[0], Y[1]); + N_VLinearSum(ONE, Y[0], -delta, yd0, Y[0]); + + + yS1 = content1->yS; + ySd1 = content1->ySd; + + for (is=0; iscv_adj_mem; + + /* Allocate space for the vectors ytmp and yStmp */ + + ytmp = N_VClone(tempv); + if (ytmp == NULL) { + return(FALSE); + } + + if (IMstoreSensi) { + yStmp = N_VCloneVectorArray(Ns, tempv); + if (yStmp == NULL) { + N_VDestroy(ytmp); + return(FALSE); + } + } + + /* Allocate space for the content field of the dt structures */ + + dt_mem = ca_mem->dt_mem; + + for (i=0; i<=nsteps; i++) { + + content = NULL; + content = (PolynomialDataMem) malloc(sizeof(struct PolynomialDataMemRec)); + if (content == NULL) { + ii = i; + allocOK = FALSE; + break; + } + + content->y = N_VClone(tempv); + if (content->y == NULL) { + free(content); content = NULL; + ii = i; + allocOK = FALSE; + break; + } + + if (IMstoreSensi) { + + content->yS = N_VCloneVectorArray(Ns, tempv); + if (content->yS == NULL) { + N_VDestroy(content->y); + free(content); content = NULL; + ii = i; + allocOK = FALSE; + break; + } + + } + + dt_mem[i]->content = content; + + } + + /* If an error occurred, deallocate and return */ + + if (!allocOK) { + + N_VDestroy(ytmp); + + if (IMstoreSensi) { + N_VDestroyVectorArray(yStmp, Ns); + } + + for (i=0; icontent); + N_VDestroy(content->y); + if (IMstoreSensi) { + N_VDestroyVectorArray(content->yS, Ns); + } + free(dt_mem[i]->content); dt_mem[i]->content = NULL; + } + + } + + return(allocOK); + +} + +/* + * CVApolynomialFree + * + * This routine frees the memeory allocated for data storage. + */ + +static void CVApolynomialFree(CVodeMem cv_mem) +{ + CVadjMem ca_mem; + DtpntMem *dt_mem; + PolynomialDataMem content; + long int i; + + ca_mem = cv_mem->cv_adj_mem; + + N_VDestroy(ytmp); + + if (IMstoreSensi) { + N_VDestroyVectorArray(yStmp, Ns); + } + + dt_mem = ca_mem->dt_mem; + + for (i=0; i<=nsteps; i++) { + content = (PolynomialDataMem) (dt_mem[i]->content); + N_VDestroy(content->y); + if (IMstoreSensi) { + N_VDestroyVectorArray(content->yS, Ns); + } + free(dt_mem[i]->content); dt_mem[i]->content = NULL; + } +} + +/* + * CVApolynomialStorePnt ( -> IMstore ) + * + * This routine stores a new point y in the structure d for use + * in the Polynomial interpolation. + * Note that the time is already stored. + */ + +static int CVApolynomialStorePnt(CVodeMem cv_mem, DtpntMem d) +{ + CVadjMem ca_mem; + PolynomialDataMem content; + int is; + + ca_mem = cv_mem->cv_adj_mem; + + content = (PolynomialDataMem) d->content; + + N_VScale(ONE, zn[0], content->y); + + if (IMstoreSensi) { + for (is=0; isyS[is]); + } + + content->order = qu; + + return(0); +} + +/* + * CVApolynomialGetY ( -> IMget ) + * + * This routine uses polynomial interpolation for the forward solution vector. + * It is typically called by the wrapper routines before calling + * user provided routines (fB, djacB, bjacB, jtimesB, psolB)) but + * can be directly called by the user through CVodeGetAdjY. + */ + +static int CVApolynomialGetY(CVodeMem cv_mem, realtype t, + N_Vector y, N_Vector *yS) +{ + CVadjMem ca_mem; + DtpntMem *dt_mem; + PolynomialDataMem content; + + int flag, dir, order, i, j, is, NS; + long int indx, base; + booleantype newpoint; + realtype dt, factor; + + ca_mem = cv_mem->cv_adj_mem; + dt_mem = ca_mem->dt_mem; + + /* Local value of Ns */ + + NS = IMinterpSensi ? Ns : 0; + + /* Get the index in dt_mem */ + + flag = CVAfindIndex(cv_mem, t, &indx, &newpoint); + if (flag != CV_SUCCESS) return(flag); + + /* If we are beyond the left limit but close enough, + then return y at the left limit. */ + + if (indx == 0) { + content = (PolynomialDataMem) (dt_mem[0]->content); + N_VScale(ONE, content->y, y); + for (is=0; isyS[is], yS[is]); + return(CV_SUCCESS); + } + + /* Scaling factor */ + + dt = ABS(dt_mem[indx]->t - dt_mem[indx-1]->t); + + /* Find the direction of the forward integration */ + + dir = (tfinal - tinitial > ZERO) ? 1 : -1; + + /* Establish the base point depending on the integration direction. + Modify the base if there are not enough points for the current order */ + + if (dir == 1) { + base = indx; + content = (PolynomialDataMem) (dt_mem[base]->content); + order = content->order; + if(indx < order) base += order-indx; + } else { + base = indx-1; + content = (PolynomialDataMem) (dt_mem[base]->content); + order = content->order; + if (np-indx > order) base -= indx+order-np; + } + + /* Recompute Y (divided differences for Newton polynomial) if needed */ + + if (newpoint) { + + /* Store 0-th order DD */ + if (dir == 1) { + for(j=0;j<=order;j++) { + T[j] = dt_mem[base-j]->t; + content = (PolynomialDataMem) (dt_mem[base-j]->content); + N_VScale(ONE, content->y, Y[j]); + for (is=0; isyS[is], YS[j][is]); + } + } else { + for(j=0;j<=order;j++) { + T[j] = dt_mem[base-1+j]->t; + content = (PolynomialDataMem) (dt_mem[base-1+j]->content); + N_VScale(ONE, content->y, Y[j]); + for (is=0; isyS[is], YS[j][is]); + } + } + + /* Compute higher-order DD */ + for(i=1;i<=order;i++) { + for(j=order;j>=i;j--) { + factor = dt/(T[j]-T[j-i]); + N_VLinearSum(factor, Y[j], -factor, Y[j-1], Y[j]); + for (is=0; is=0; i--) { + factor = (t-T[i])/dt; + N_VLinearSum(factor, y, ONE, Y[i], y); + for (is=0; iscv_adj_mem; + + cvB_mem = ca_mem->ca_bckpbCrt; + + /* Get forward solution from interpolation */ + + if (IMinterpSensi) + flag = IMget(cv_mem, t, ytmp, yStmp); + else + flag = IMget(cv_mem, t, ytmp, NULL); + + if (flag != CV_SUCCESS) { + cvProcessError(cv_mem, -1, "CVODEA", "CVArhs", MSGCV_BAD_TINTERP, t); + return(-1); + } + + /* Call the user's RHS function */ + + if (cvB_mem->cv_f_withSensi) + retval = (cvB_mem->cv_fs)(t, ytmp, yStmp, yB, yBdot, cvB_mem->cv_user_data); + else + retval = (cvB_mem->cv_f)(t, ytmp, yB, yBdot, cvB_mem->cv_user_data); + + return(retval); +} + +/* + * CVArhsQ + * + * This routine interfaces to the CVQuadRhsFnB (or CVQuadRhsFnBS) routine + * provided by the user. + */ + +static int CVArhsQ(realtype t, N_Vector yB, + N_Vector qBdot, void *cvode_mem) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + int flag, retval; + + cv_mem = (CVodeMem) cvode_mem; + + ca_mem = cv_mem->cv_adj_mem; + + cvB_mem = ca_mem->ca_bckpbCrt; + + /* Get forward solution from interpolation */ + + if (IMinterpSensi) + flag = IMget(cv_mem, t, ytmp, yStmp); + else + flag = IMget(cv_mem, t, ytmp, NULL); + + /* Call the user's RHS function */ + + if (cvB_mem->cv_fQ_withSensi) + retval = (cvB_mem->cv_fQs)(t, ytmp, yStmp, yB, qBdot, cvB_mem->cv_user_data); + else + retval = (cvB_mem->cv_fQ)(t, ytmp, yB, qBdot, cvB_mem->cv_user_data); + + return(retval); +} + + + diff --git a/odemex/Parser/CVode/cv_src/src/cvodes/cvodea_io.c b/odemex/Parser/CVode/cv_src/src/cvodes/cvodea_io.c new file mode 100644 index 0000000..6c6927d --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/cvodes/cvodea_io.c @@ -0,0 +1,716 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.9 $ + * $Date: 2007/06/05 20:55:57 $ + * ----------------------------------------------------------------- + * Programmer: Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2006, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for the optional input and output + * functions for the adjoint module in the CVODES solver. + * ----------------------------------------------------------------- + */ + +/* + * ================================================================= + * IMPORTED HEADER FILES + * ================================================================= + */ + +#include +#include + +#include "cvodes_impl.h" +#include + +/* + * ================================================================= + * CVODEA PRIVATE CONSTANTS + * ================================================================= + */ + +#define ONE RCONST(1.0) + +/* + * ================================================================= + * EXPORTED FUNCTIONS IMPLEMENTATION + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Readibility Constants + * ----------------------------------------------------------------- + */ + +#define IMtype (ca_mem->ca_IMtype) +#define ckpntData (ca_mem->ca_ckpntData) +#define nbckpbs (ca_mem->ca_nbckpbs) + +#define t0_ (ck_mem->ck_t0) +#define t1_ (ck_mem->ck_t1) +#define nst_ (ck_mem->ck_nst) +#define q_ (ck_mem->ck_q) +#define h_ (ck_mem->ck_h) +#define next_ (ck_mem->ck_next) + +/* + * ----------------------------------------------------------------- + * Optional input functions for ASA + * ----------------------------------------------------------------- + */ + +int CVodeSetAdjNoSensi(void *cvode_mem) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSetAdjNoSensi", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSetAdjNoSensi", MSGCV_NO_ADJ); + return(CV_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + ca_mem->ca_IMstoreSensi = FALSE; + + return(CV_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Optional input functions for backward integration + * ----------------------------------------------------------------- + */ + +int CVodeSetIterTypeB(void *cvode_mem, int which, int iterB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSetIterTypeB", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSetIterTypeB", MSGCV_NO_ADJ); + return(CV_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= nbckpbs ) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSetIterTypeB", MSGCV_BAD_WHICH); + return(CV_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + flag = CVodeSetIterType(cvodeB_mem, iterB); + + return(flag); +} + +int CVodeSetUserDataB(void *cvode_mem, int which, void *user_dataB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSetUserDataB", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSetUserDataB", MSGCV_NO_ADJ); + return(CV_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= nbckpbs ) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSetUserDataB", MSGCV_BAD_WHICH); + return(CV_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvB_mem->cv_user_data = user_dataB; + + return(CV_SUCCESS); +} + +int CVodeSetMaxOrdB(void *cvode_mem, int which, int maxordB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + int flag; + + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSetMaxOrdB", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSetMaxOrdB", MSGCV_NO_ADJ); + return(CV_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= nbckpbs ) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSetMaxOrdB", MSGCV_BAD_WHICH); + return(CV_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + flag = CVodeSetMaxOrd(cvodeB_mem, maxordB); + + return(flag); +} + + +int CVodeSetMaxNumStepsB(void *cvode_mem, int which, long int mxstepsB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSetMaxNumStepsB", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSetMaxNumStepsB", MSGCV_NO_ADJ); + return(CV_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= nbckpbs ) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSetMaxNumStepsB", MSGCV_BAD_WHICH); + return(CV_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + flag = CVodeSetMaxNumSteps(cvodeB_mem, mxstepsB); + + return(flag); +} + +int CVodeSetStabLimDetB(void *cvode_mem, int which, booleantype stldetB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSetStabLimDetB", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSetStabLimDetB", MSGCV_NO_ADJ); + return(CV_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= nbckpbs ) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSetStabLimDetB", MSGCV_BAD_WHICH); + return(CV_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + flag = CVodeSetStabLimDet(cvodeB_mem, stldetB); + + return(flag); +} + +int CVodeSetInitStepB(void *cvode_mem, int which, realtype hinB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSetInitStepB", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSetInitStepB", MSGCV_NO_ADJ); + return(CV_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= nbckpbs ) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSetInitStepB", MSGCV_BAD_WHICH); + return(CV_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + flag = CVodeSetInitStep(cvodeB_mem, hinB); + + return(flag); +} + +int CVodeSetMinStepB(void *cvode_mem, int which, realtype hminB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSetMinStepB", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSetMinStepB", MSGCV_NO_ADJ); + return(CV_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= nbckpbs ) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSetMinStepB", MSGCV_BAD_WHICH); + return(CV_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + flag = CVodeSetMinStep(cvodeB_mem, hminB); + + return(flag); +} + +int CVodeSetMaxStepB(void *cvode_mem, int which, realtype hmaxB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSetMaxStepB", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSetMaxStepB", MSGCV_NO_ADJ); + return(CV_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= nbckpbs ) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSetMaxStepB", MSGCV_BAD_WHICH); + return(CV_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + flag = CVodeSetMaxStep(cvodeB_mem, hmaxB); + + return(flag); +} + +/* + * CVodeSetQuad*B + * + * Wrappers for the backward phase around the corresponding + * CVODES quadrature optional input functions + */ + +int CVodeSetQuadErrConB(void *cvode_mem, int which, booleantype errconQB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSetQuadErrConB", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSetQuadErrConB", MSGCV_NO_ADJ); + return(CV_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= nbckpbs ) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSetQuadErrConB", MSGCV_BAD_WHICH); + return(CV_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + flag = CVodeSetQuadErrCon(cvodeB_mem, errconQB); + + return(flag); +} + +/* + * ----------------------------------------------------------------- + * Optional output functions for backward integration + * ----------------------------------------------------------------- + */ + +/* + * CVodeGetAdjCVodeBmem + * + * This function returns a (void *) pointer to the CVODES + * memory allocated for the backward problem. This pointer can + * then be used to call any of the CVodeGet* CVODES routines to + * extract optional output for the backward integration phase. + */ + +void *CVodeGetAdjCVodeBmem(void *cvode_mem, int which) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, 0, "CVODEA", "CVodeGetAdjCVodeBmem", MSGCV_NO_MEM); + return(NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, 0, "CVODEA", "CVodeGetAdjCVodeBmem", MSGCV_NO_ADJ); + return(NULL); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= nbckpbs ) { + cvProcessError(cv_mem, 0, "CVODEA", "CVodeGetAdjCVodeBmem", MSGCV_BAD_WHICH); + return(NULL); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + return(cvodeB_mem); +} + +/* + * CVodeGetAdjCheckPointsInfo + * + * This routine loads an array of nckpnts structures of type CVadjCheckPointRec. + * The user must allocate space for ckpnt. + */ + +int CVodeGetAdjCheckPointsInfo(void *cvode_mem, CVadjCheckPointRec *ckpnt) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CkpntMem ck_mem; + int i; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeGetAdjCheckPointsInfo", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeGetAdjCheckPointsInfo", MSGCV_NO_ADJ); + return(CV_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + ck_mem = ca_mem->ck_mem; + + i = 0; + + while (ck_mem != NULL) { + + ckpnt[i].my_addr = (void *) ck_mem; + ckpnt[i].next_addr = (void *) next_; + ckpnt[i].t0 = t0_; + ckpnt[i].t1 = t1_; + ckpnt[i].nstep = nst_; + ckpnt[i].order = q_; + ckpnt[i].step = h_; + + ck_mem = next_; + i++; + + } + + return(CV_SUCCESS); + +} + +/* + * CVodeGetAdjDataPointHermite + * + * This routine returns the solution stored in the data structure + * at the 'which' data point. Cubic Hermite interpolation. + */ + +int CVodeGetAdjDataPointHermite(void *cvode_mem, long int which, + realtype *t, N_Vector y, N_Vector yd) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + DtpntMem *dt_mem; + HermiteDataMem content; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeGetAdjDataPointHermite", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeGetAdjDataPointHermite", MSGCV_NO_ADJ); + return(CV_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + dt_mem = ca_mem->dt_mem; + + if (IMtype != CV_HERMITE) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVadjGetDataPointHermite", MSGCV_WRONG_INTERP); + return(CV_ILL_INPUT); + } + + *t = dt_mem[which]->t; + + content = (HermiteDataMem) (dt_mem[which]->content); + + if (y != NULL) + N_VScale(ONE, content->y, y); + + if (yd != NULL) + N_VScale(ONE, content->yd, yd); + + return(CV_SUCCESS); +} + +/* + * CVodeGetAdjDataPointPolynomial + * + * This routine returns the solution stored in the data structure + * at the 'which' data point. Polynomial interpolation. + */ + +int CVodeGetAdjDataPointPolynomial(void *cvode_mem, long int which, + realtype *t, int *order, N_Vector y) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + DtpntMem *dt_mem; + PolynomialDataMem content; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeGetAdjDataPointPolynomial", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeGetAdjDataPointPolynomial", MSGCV_NO_ADJ); + return(CV_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + dt_mem = ca_mem->dt_mem; + + if (IMtype != CV_POLYNOMIAL) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVadjGetDataPointPolynomial", MSGCV_WRONG_INTERP); + return(CV_ILL_INPUT); + } + + *t = dt_mem[which]->t; + + content = (PolynomialDataMem) (dt_mem[which]->content); + + if (y != NULL) + N_VScale(ONE, content->y, y); + + *order = content->order; + + return(CV_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * UNDOCUMENTED development user-callable functions + * ----------------------------------------------------------------- + */ + +/* + * CVodeGetAdjCurrentCheckPoint + * + * Returns the address of the 'active' check point. + */ + +int CVodeGetAdjCurrentCheckPoint(void *cvode_mem, void **addr) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeGetAdjCurrentCheckPoint", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeGetAdjCurrentCheckPoint", MSGCV_NO_ADJ); + return(CV_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + *addr = (void *) ckpntData; + + return(CV_SUCCESS); +} diff --git a/odemex/Parser/CVode/cv_src/src/cvodes/cvodes.c b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes.c new file mode 100644 index 0000000..dcbe1fc --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes.c @@ -0,0 +1,9026 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.29 $ + * $Date: 2009/05/06 21:49:02 $ + * ----------------------------------------------------------------- + * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2006, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for the main CVODES integrator + * with sensitivity analysis capabilities. + * ----------------------------------------------------------------- + * + * EXPORTED FUNCTIONS + * ------------------ + * + * Creation, allocation and re-initialization functions + * + * CVodeCreate + * + * CVodeInit + * CVodeReInit + * CVodeSStolerances + * CVodeSVtolerances + * CVodeWFtolerances + * + * CVodeQuadInit + * CVodeQuadReInit + * CVodeQuadSStolerances + * CVodeQuadSVtolerances + * + * CVodeSensInit + * CVodeSensInit1 + * CVodeSensReInit + * CVodeSensSStolerances + * CVodeSensSVtolerances + * CVodeSensEEtolerances + * + * CVodeQuadSensInit + * CVodeQuadSensReInit + * + * CVodeSensToggleOff + * + * CVodeRootInit + * + * Main solver function + * CVode + * + * Interpolated output and extraction functions + * CVodeGetDky + * CVodeGetQuad + * CVodeGetQuadDky + * CVodeGetSens + * CVodeGetSens1 + * CVodeGetSensDky + * CVodeGetSensDky1 + * CVodeGetQuadSens + * CVodeGetQuadSens1 + * CVodeGetQuadSensDky + * CVodeGetQuadSensDky1 + * + * Deallocation functions + * CVodeFree + * CVodeQuadFree + * CVodeSensFree + * CVodeQuadSensFree + * + * PRIVATE FUNCTIONS + * ----------------- + * + * cvCheckNvector + * + * Memory allocation/deallocation + * cvAllocVectors + * cvFreeVectors + * cvQuadAllocVectors + * cvQuadFreeVectors + * cvSensAllocVectors + * cvSensFreeVectors + * cvQuadSensAllocVectors + * cvQuadSensFreeVectors + * + * Initial stepsize calculation + * cvHin + * cvUpperBoundH0 + * cvYddNorm + * + * Initial setup + * cvInitialSetup + * cvEwtSet + * cvEwtSetSS + * cvEwtSetSV + * cvQuadEwtSet + * cvQuadEwtSetSS + * cvQuadEwtSetSV + * cvSensEwtSet + * cvSensEwtSetEE + * cvSensEwtSetSS + * cvSensEwtSetSV + * cvQuadSensEwtSet + * cvQuadSensEwtSetEE + * cvQuadSensEwtSetSS + * cvQuadSensEwtSetSV + * + * Main cvStep function + * cvStep + * + * Functions called at beginning of step + * cvAdjustParams + * cvAdjustOrder + * cvAdjustAdams + * cvAdjustBDF + * cvIncreaseBDF + * cvDecreaseBDF + * cvRescale + * cvPredict + * cvSet + * cvSetAdams + * cvAdamsStart + * cvAdamsFinish + * cvAltSum + * cvSetBDF + * cvSetTqBDF + * + * Nonlinear solver functions + * cvNls + * cvNlsFunctional + * cvNlsNewton + * cvNewtonIteration + * cvQuadNls + * cvStgrNls + * cvStgrNlsFunctional + * cvStgrNlsNewton + * cvStgrNewtonIteration + * cvStgr1Nls + * cvStgr1NlsFunctional + * cvStgr1NlsNewton + * cvStgr1NewtonIteration + * cvQuadSensNls + * cvHandleNFlag + * cvRestore + * + * Error Test + * cvDoErrorTest + * + * Functions called after a successful step + * cvCompleteStep + * cvPrepareNextStep + * cvSetEta + * cvComputeEtaqm1 + * cvComputeEtaqp1 + * cvChooseEta + * + * Function to handle failures + * cvHandleFailure + * + * Functions for BDF Stability Limit Detection + * cvBDFStab + * cvSLdet + * + * Functions for rootfinding + * cvRcheck1 + * cvRcheck2 + * cvRcheck3 + * cvRootFind + * + * Functions for combined norms + * cvQuadUpdateNorm + * cvSensNorm + * cvSensUpdateNorm + * cvQuadSensNorm + * cvQuadSensUpdateNorm + * + * Wrappers for sensitivity RHS + * cvSensRhsWrapper + * cvSensRhs1Wrapper + * + * Internal DQ approximations for sensitivity RHS + * cvSensRhsInternalDQ + * cvSensRhs1InternalDQ + * cvQuadSensRhsDQ + * + * Error message handling functions + * cvProcessError + * cvErrHandler + * + * ----------------------------------------------------------------- + */ + +/* + * ================================================================= + * IMPORTED HEADER FILES + * ================================================================= + */ + +#include +#include +#include +#include + +#include "cvodes_impl.h" +#include +#include + +/* + * ================================================================= + * MACRO DEFINITIONS + * ================================================================= + */ + +/* Macro: loop */ +#define loop for(;;) + +/* + * ================================================================= + * CVODES PRIVATE CONSTANTS + * ================================================================= + */ + +#define ZERO RCONST(0.0) +#define TINY RCONST(1.0e-10) +#define TENTH RCONST(0.1) +#define POINT2 RCONST(0.2) +#define FOURTH RCONST(0.25) +#define HALF RCONST(0.5) +#define ONE RCONST(1.0) +#define TWO RCONST(2.0) +#define THREE RCONST(3.0) +#define FOUR RCONST(4.0) +#define FIVE RCONST(5.0) +#define TWELVE RCONST(12.0) +#define HUN RCONST(100.0) + +/* + * ================================================================= + * CVODES ROUTINE-SPECIFIC CONSTANTS + * ================================================================= + */ + +/* + * Control constants for lower-level functions used by cvStep + * ---------------------------------------------------------- + * + * cvHin return values: + * CV_SUCCESS, + * CV_RHSFUNC_FAIL, CV_RPTD_RHSFUNC_ERR, + * CV_QRHSFUNC_FAIL, CV_RPTD_QRHSFUNC_ERR, + * CV_SRHSFUNC_FAIL, CV_RPTD_SRHSFUNC_ERR, + * CV_TOO_CLOSE + * + * cvStep control constants: + * DO_ERROR_TEST + * PREDICT_AGAIN + * + * cvStep return values: + * CV_SUCCESS, + * CV_CONV_FAILURE, CV_ERR_FAILURE, + * CV_LSETUP_FAIL, CV_LSOLVE_FAIL, + * CV_RTFUNC_FAIL, + * CV_RHSFUNC_FAIL, CV_QRHSFUNC_FAIL, CV_SRHSFUNC_FAIL, CV_QSRHSFUNC_FAIL, + * CV_FIRST_RHSFUNC_ERR, CV_FIRST_QRHSFUNC_ERR, CV_FIRST_SRHSFUNC_ERR, CV_FIRST_QSRHSFUNC_ERR, + * CV_UNREC_RHSFUNC_ERR, CV_UNREC_QRHSFUNC_ERR, CV_UNREC_SRHSFUNC_ERR, CV_UNREC_QSRHSFUNC_ERR, + * CV_REPTD_RHSFUNC_ERR, CV_REPTD_QRHSFUNC_ERR, CV_REPTD_SRHSFUNC_ERR, CV_REPTD_QSRHSFUNC_ERR, + * + * cvNls input nflag values: + * FIRST_CALL + * PREV_CONV_FAIL + * PREV_ERR_FAIL + * + * cvNls return values: + * CV_SUCCESS, + * CV_LSETUP_FAIL, CV_LSOLVE_FAIL, + * CV_RHSFUNC_FAIL, CV_SRHSFUNC_FAIL, + * CONV_FAIL, + * RHSFUNC_RECVR, SRHSFUNC_RECVR + * + * cvNewtonIteration return values: + * CV_SUCCESS, + * CV_LSOLVE_FAIL, + * CV_RHSFUNC_FAIL, CV_SRHSFUNC_FAIL, + * CONV_FAIL, TRY_AGAIN + * RHSFUNC_RECVR, SRHSFUNC_RECVR + * + */ + +#define DO_ERROR_TEST +2 +#define PREDICT_AGAIN +3 + +#define CONV_FAIL +4 +#define TRY_AGAIN +5 + +#define FIRST_CALL +6 +#define PREV_CONV_FAIL +7 +#define PREV_ERR_FAIL +8 + +#define RHSFUNC_RECVR +9 + +#define QRHSFUNC_RECVR +11 +#define SRHSFUNC_RECVR +12 +#define QSRHSFUNC_RECVR +13 + +/* + * Control constants for lower-level rootfinding functions + * ------------------------------------------------------- + * + * cvRcheck1 return values: + * CV_SUCCESS, + * CV_RTFUNC_FAIL, + * cvRcheck2 return values: + * CV_SUCCESS, + * CV_RTFUNC_FAIL, + * CLOSERT, + * RTFOUND + * cvRcheck3 return values: + * CV_SUCCESS, + * CV_RTFUNC_FAIL, + * RTFOUND + * cvRootFind return values: + * CV_SUCCESS, + * CV_RTFUNC_FAIL, + * RTFOUND + */ + +#define RTFOUND +1 +#define CLOSERT +3 + +/* + * Control constants for sensitivity DQ + * ------------------------------------ + */ + +#define CENTERED1 +1 +#define CENTERED2 +2 +#define FORWARD1 +3 +#define FORWARD2 +4 + +/* + * Control constants for type of sensitivity RHS + * --------------------------------------------- + */ + +#define CV_ONESENS 1 +#define CV_ALLSENS 2 + +/* + * Control constants for tolerances + * -------------------------------- + */ + +#define CV_NN 0 +#define CV_SS 1 +#define CV_SV 2 +#define CV_WF 3 +#define CV_EE 4 + +/* + * Algorithmic constants + * --------------------- + * + * CVodeGetDky and cvStep + * + * FUZZ_FACTOR fuzz factor used to estimate infinitesimal time intervals + * + * cvHin + * + * HLB_FACTOR factor for upper bound on initial step size + * HUB_FACTOR factor for lower bound on initial step size + * H_BIAS bias factor in selection of intial step size + * MAX_ITERS maximum attempts to compute the initial step size + * + * CVodeCreate + * + * CORTES constant in nonlinear iteration convergence test + * + * cvStep + * + * THRESH if eta < THRESH reject a change in step size or order + * ETAMX1 -+ + * ETAMX2 | + * ETAMX3 |-> bounds for eta (step size change) + * ETAMXF | + * ETAMIN | + * ETACF -+ + * ADDON safety factor in computing eta + * BIAS1 -+ + * BIAS2 |-> bias factors in eta selection + * BIAS3 -+ + * ONEPSM (1+epsilon) used in testing if the step size is below its bound + * + * SMALL_NST nst > SMALL_NST => use ETAMX3 + * MXNCF max no. of convergence failures during one step try + * MXNEF max no. of error test failures during one step try + * MXNEF1 max no. of error test failures before forcing a reduction of order + * SMALL_NEF if an error failure occurs and SMALL_NEF <= nef <= MXNEF1, then + * reset eta = MIN(eta, ETAMXF) + * LONG_WAIT number of steps to wait before considering an order change when + * q==1 and MXNEF1 error test failures have occurred + * + * cvNls + * + * NLS_MAXCOR maximum no. of corrector iterations for the nonlinear solver + * CRDOWN constant used in the estimation of the convergence rate (crate) + * of the iterates for the nonlinear equation + * DGMAX iter == CV_NEWTON, |gamma/gammap-1| > DGMAX => call lsetup + * RDIV declare divergence if ratio del/delp > RDIV + * MSBP max no. of steps between lsetup calls + * + */ + + +#define FUZZ_FACTOR RCONST(100.0) + +#define HLB_FACTOR RCONST(100.0) +#define HUB_FACTOR RCONST(0.1) +#define H_BIAS HALF +#define MAX_ITERS 4 + +#define CORTES RCONST(0.1) + +#define THRESH RCONST(1.5) +#define ETAMX1 RCONST(10000.0) +#define ETAMX2 RCONST(10.0) +#define ETAMX3 RCONST(10.0) +#define ETAMXF RCONST(0.2) +#define ETAMIN RCONST(0.1) +#define ETACF RCONST(0.25) +#define ADDON RCONST(0.000001) +#define BIAS1 RCONST(6.0) +#define BIAS2 RCONST(6.0) +#define BIAS3 RCONST(10.0) +#define ONEPSM RCONST(1.000001) + +#define SMALL_NST 10 +#define MXNCF 10 +#define MXNEF 7 +#define MXNEF1 3 +#define SMALL_NEF 2 +#define LONG_WAIT 10 + +#define NLS_MAXCOR 3 +#define CRDOWN RCONST(0.3) +#define DGMAX RCONST(0.3) + +#define RDIV TWO +#define MSBP 20 + +/* + * ================================================================= + * PRIVATE FUNCTION PROTOTYPES + * ================================================================= + */ + +static booleantype cvCheckNvector(N_Vector tmpl); + +/* Memory allocation/deallocation */ + +static booleantype cvAllocVectors(CVodeMem cv_mem, N_Vector tmpl); +static void cvFreeVectors(CVodeMem cv_mem); + +static booleantype cvQuadAllocVectors(CVodeMem cv_mem, N_Vector tmpl); +static void cvQuadFreeVectors(CVodeMem cv_mem); + +static booleantype cvSensAllocVectors(CVodeMem cv_mem, N_Vector tmpl); +static void cvSensFreeVectors(CVodeMem cv_mem); + +static booleantype cvQuadSensAllocVectors(CVodeMem cv_mem, N_Vector tmpl); +static void cvQuadSensFreeVectors(CVodeMem cv_mem); + +/* Initial stepsize calculation */ + +static int cvHin(CVodeMem cv_mem, realtype tout); +static realtype cvUpperBoundH0(CVodeMem cv_mem, realtype tdist); +static int cvYddNorm(CVodeMem cv_mem, realtype hg, realtype *yddnrm); + +/* Initial setup */ + +static int cvInitialSetup(CVodeMem cv_mem); + +static int cvEwtSetSS(CVodeMem cv_mem, N_Vector ycur, N_Vector weight); +static int cvEwtSetSV(CVodeMem cv_mem, N_Vector ycur, N_Vector weight); + +static int cvQuadEwtSet(CVodeMem cv_mem, N_Vector qcur, N_Vector weightQ); +static int cvQuadEwtSetSS(CVodeMem cv_mem, N_Vector qcur, N_Vector weightQ); +static int cvQuadEwtSetSV(CVodeMem cv_mem, N_Vector qcur, N_Vector weightQ); + +static int cvSensEwtSet(CVodeMem cv_mem, N_Vector *yScur, N_Vector *weightS); +static int cvSensEwtSetEE(CVodeMem cv_mem, N_Vector *yScur, N_Vector *weightS); +static int cvSensEwtSetSS(CVodeMem cv_mem, N_Vector *yScur, N_Vector *weightS); +static int cvSensEwtSetSV(CVodeMem cv_mem, N_Vector *yScur, N_Vector *weightS); + +static int cvQuadSensEwtSet(CVodeMem cv_mem, N_Vector *yQScur, N_Vector *weightQS); +static int cvQuadSensEwtSetEE(CVodeMem cv_mem, N_Vector *yQScur, N_Vector *weightQS); +static int cvQuadSensEwtSetSS(CVodeMem cv_mem, N_Vector *yQScur, N_Vector *weightQS); +static int cvQuadSensEwtSetSV(CVodeMem cv_mem, N_Vector *yQScur, N_Vector *weightQS); + +/* Main cvStep function */ + +static int cvStep(CVodeMem cv_mem); + +/* Function called at beginning of step */ + +static void cvAdjustParams(CVodeMem cv_mem); +static void cvAdjustOrder(CVodeMem cv_mem, int deltaq); +static void cvAdjustAdams(CVodeMem cv_mem, int deltaq); +static void cvAdjustBDF(CVodeMem cv_mem, int deltaq); +static void cvIncreaseBDF(CVodeMem cv_mem); +static void cvDecreaseBDF(CVodeMem cv_mem); +static void cvRescale(CVodeMem cv_mem); +static void cvPredict(CVodeMem cv_mem); +static void cvSet(CVodeMem cv_mem); +static void cvSetAdams(CVodeMem cv_mem); +static realtype cvAdamsStart(CVodeMem cv_mem, realtype m[]); +static void cvAdamsFinish(CVodeMem cv_mem, realtype m[], realtype M[], realtype hsum); +static realtype cvAltSum(int iend, realtype a[], int k); +static void cvSetBDF(CVodeMem cv_mem); +static void cvSetTqBDF(CVodeMem cv_mem, realtype hsum, realtype alpha0, + realtype alpha0_hat, realtype xi_inv, realtype xistar_inv); + +/* Nonlinear solver functions */ + +static int cvNls(CVodeMem cv_mem, int nflag); +static int cvNlsFunctional(CVodeMem cv_mem); +static int cvNlsNewton(CVodeMem cv_mem, int nflag); +static int cvNewtonIteration(CVodeMem cv_mem); + +static int cvQuadNls(CVodeMem cv_mem); + +static int cvStgrNls(CVodeMem cv_mem); +static int cvStgrNlsFunctional(CVodeMem cv_mem); +static int cvStgrNlsNewton(CVodeMem cv_mem); +static int cvStgrNewtonIteration(CVodeMem cv_mem); + +static int cvStgr1Nls(CVodeMem cv_mem, int is); +static int cvStgr1NlsFunctional(CVodeMem cv_mem, int is); +static int cvStgr1NlsNewton(CVodeMem cv_mem, int is); +static int cvStgr1NewtonIteration(CVodeMem cv_mem, int is); + +static int cvQuadSensNls(CVodeMem cv_mem); + +static int cvHandleNFlag(CVodeMem cv_mem, int *nflagPtr, realtype saved_t, + int *ncfPtr, long int *ncfnPtr); + +static void cvRestore(CVodeMem cv_mem, realtype saved_t); + +/* Error Test */ + +static int cvDoErrorTest(CVodeMem cv_mem, int *nflagPtr, realtype saved_t, + realtype acor_nrm, + int *nefPtr, long int *netfPtr, realtype *dsmPtr); + +/* Function called after a successful step */ + +static void cvCompleteStep(CVodeMem cv_mem); +static void cvPrepareNextStep(CVodeMem cv_mem, realtype dsm); +static void cvSetEta(CVodeMem cv_mem); +static realtype cvComputeEtaqm1(CVodeMem cv_mem); +static realtype cvComputeEtaqp1(CVodeMem cv_mem); +static void cvChooseEta(CVodeMem cv_mem); + +/* Function to handle failures */ + +static int cvHandleFailure(CVodeMem cv_mem,int flag); + +/* Functions for BDF Stability Limit Detection */ + +static void cvBDFStab(CVodeMem cv_mem); +static int cvSLdet(CVodeMem cv_mem); + +/* Functions for rootfinding */ + +static int cvRcheck1(CVodeMem cv_mem); +static int cvRcheck2(CVodeMem cv_mem); +static int cvRcheck3(CVodeMem cv_mem); +static int cvRootFind(CVodeMem cv_mem); + +/* Function for combined norms */ + +static realtype cvQuadUpdateNorm(CVodeMem cv_mem, realtype old_nrm, + N_Vector xQ, N_Vector wQ); + +static realtype cvSensNorm(CVodeMem cv_mem, N_Vector *xS, N_Vector *wS); +static realtype cvSensUpdateNorm(CVodeMem cv_mem, realtype old_nrm, + N_Vector *xS, N_Vector *wS); + +static realtype cvQuadSensNorm(CVodeMem cv_mem, N_Vector *xQS, N_Vector *wQS); +static realtype cvQuadSensUpdateNorm(CVodeMem cv_mem, realtype old_nrm, + N_Vector *xQS, N_Vector *wQS); + +/* Internal sensitivity RHS DQ functions */ + +static int cvQuadSensRhsInternalDQ(int Ns, realtype t, + N_Vector y, N_Vector *yS, + N_Vector yQdot, N_Vector *yQSdot, + void *cvode_mem, + N_Vector tmp, N_Vector tmpQ); + +static int cvQuadSensRhs1InternalDQ(CVodeMem cv_mem, int is, realtype t, + N_Vector y, N_Vector yS, + N_Vector yQdot, N_Vector yQSdot, + N_Vector tmp, N_Vector tmpQ); + +/* + * ================================================================= + * EXPORTED FUNCTIONS IMPLEMENTATION + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Creation, allocation and re-initialization functions + * ----------------------------------------------------------------- + */ + +/* + * CVodeCreate + * + * CVodeCreate creates an internal memory block for a problem to + * be solved by CVODES. + * If successful, CVodeCreate returns a pointer to the problem memory. + * This pointer should be passed to CVodeInit. + * If an initialization error occurs, CVodeCreate prints an error + * message to standard err and returns NULL. + */ + +void *CVodeCreate(int lmm, int iter) +{ + int maxord; + CVodeMem cv_mem; + + /* Test inputs */ + + if ((lmm != CV_ADAMS) && (lmm != CV_BDF)) { + cvProcessError(NULL, 0, "CVODES", "CVodeCreate", MSGCV_BAD_LMM); + return(NULL); + } + + if ((iter != CV_FUNCTIONAL) && (iter != CV_NEWTON)) { + cvProcessError(NULL, 0, "CVODES", "CVodeCreate", MSGCV_BAD_ITER); + return(NULL); + } + + cv_mem = NULL; + cv_mem = (CVodeMem) malloc(sizeof(struct CVodeMemRec)); + if (cv_mem == NULL) { + cvProcessError(NULL, 0, "CVODES", "CVodeCreate", MSGCV_CVMEM_FAIL); + return(NULL); + } + + maxord = (lmm == CV_ADAMS) ? ADAMS_Q_MAX : BDF_Q_MAX; + + /* copy input parameters into cv_mem */ + + cv_mem->cv_lmm = lmm; + cv_mem->cv_iter = iter; + + /* Set uround */ + + cv_mem->cv_uround = UNIT_ROUNDOFF; + + /* Set default values for integrator optional inputs */ + + cv_mem->cv_f = NULL; + cv_mem->cv_user_data = NULL; + cv_mem->cv_itol = CV_NN; + cv_mem->cv_user_efun = FALSE; + cv_mem->cv_efun = NULL; + cv_mem->cv_e_data = NULL; + cv_mem->cv_ehfun = cvErrHandler; + cv_mem->cv_eh_data = cv_mem; + cv_mem->cv_errfp = stderr; + cv_mem->cv_qmax = maxord; + cv_mem->cv_mxstep = MXSTEP_DEFAULT; + cv_mem->cv_mxhnil = MXHNIL_DEFAULT; + cv_mem->cv_sldeton = FALSE; + cv_mem->cv_hin = ZERO; + cv_mem->cv_hmin = HMIN_DEFAULT; + cv_mem->cv_hmax_inv = HMAX_INV_DEFAULT; + cv_mem->cv_tstopset = FALSE; + cv_mem->cv_maxcor = NLS_MAXCOR; + cv_mem->cv_maxnef = MXNEF; + cv_mem->cv_maxncf = MXNCF; + cv_mem->cv_nlscoef = CORTES; + + /* Initialize root finding variables */ + + cv_mem->cv_glo = NULL; + cv_mem->cv_ghi = NULL; + cv_mem->cv_grout = NULL; + cv_mem->cv_iroots = NULL; + cv_mem->cv_rootdir = NULL; + cv_mem->cv_gfun = NULL; + cv_mem->cv_nrtfn = 0; + cv_mem->cv_gactive = NULL; + cv_mem->cv_mxgnull = 1; + + /* Set default values for quad. optional inputs */ + + cv_mem->cv_quadr = FALSE; + cv_mem->cv_fQ = NULL; + cv_mem->cv_errconQ = FALSE; + cv_mem->cv_itolQ = CV_NN; + + /* Set default values for sensi. optional inputs */ + + cv_mem->cv_sensi = FALSE; + cv_mem->cv_fS_data = NULL; + cv_mem->cv_fS = cvSensRhsInternalDQ; + cv_mem->cv_fS1 = cvSensRhs1InternalDQ; + cv_mem->cv_fSDQ = TRUE; + cv_mem->cv_ifS = CV_ONESENS; + cv_mem->cv_DQtype = CV_CENTERED; + cv_mem->cv_DQrhomax = ZERO; + cv_mem->cv_p = NULL; + cv_mem->cv_pbar = NULL; + cv_mem->cv_plist = NULL; + cv_mem->cv_errconS = FALSE; + cv_mem->cv_maxcorS = NLS_MAXCOR; + cv_mem->cv_ncfS1 = NULL; + cv_mem->cv_ncfnS1 = NULL; + cv_mem->cv_nniS1 = NULL; + cv_mem->cv_itolS = CV_NN; + + /* Set default values for quad. sensi. optional inputs */ + + cv_mem->cv_quadr_sensi = FALSE; + cv_mem->cv_fQS = NULL; + cv_mem->cv_fQS_data = NULL; + cv_mem->cv_fQSDQ = TRUE; + cv_mem->cv_errconQS = FALSE; + cv_mem->cv_itolQS = CV_NN; + + /* Set default for ASA */ + + cv_mem->cv_adj = FALSE; + cv_mem->cv_adj_mem = NULL; + + /* Set the saved values for qmax_alloc */ + + cv_mem->cv_qmax_alloc = maxord; + cv_mem->cv_qmax_allocQ = maxord; + cv_mem->cv_qmax_allocS = maxord; + + /* Initialize lrw and liw */ + + cv_mem->cv_lrw = 65 + 2*L_MAX + NUM_TESTS; + cv_mem->cv_liw = 52; + + /* No mallocs have been done yet */ + + cv_mem->cv_VabstolMallocDone = FALSE; + cv_mem->cv_MallocDone = FALSE; + + cv_mem->cv_VabstolQMallocDone = FALSE; + cv_mem->cv_QuadMallocDone = FALSE; + + cv_mem->cv_VabstolSMallocDone = FALSE; + cv_mem->cv_SabstolSMallocDone = FALSE; + cv_mem->cv_SensMallocDone = FALSE; + + cv_mem->cv_VabstolQSMallocDone = FALSE; + cv_mem->cv_SabstolQSMallocDone = FALSE; + cv_mem->cv_QuadSensMallocDone = FALSE; + + cv_mem->cv_adjMallocDone = FALSE; + + /* Return pointer to CVODES memory block */ + + return((void *)cv_mem); +} + +/*-----------------------------------------------------------------*/ + +#define iter (cv_mem->cv_iter) +#define lmm (cv_mem->cv_lmm) +#define lrw (cv_mem->cv_lrw) +#define liw (cv_mem->cv_liw) + +/*-----------------------------------------------------------------*/ +/* Added by Joep Vanlier */ + +int CVodeSetMaxTime( void *cvode_mem, double maxTime ) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeInit", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + cv_mem->tMax = maxTime; +} + +/*-----------------------------------------------------------------*/ + +/* + * CVodeInit + * + * CVodeInit allocates and initializes memory for a problem. All + * problem inputs are checked for errors. If any error occurs during + * initialization, it is reported to the file whose file pointer is + * errfp and an error flag is returned. Otherwise, it returns CV_SUCCESS + */ + +int CVodeInit(void *cvode_mem, CVRhsFn f, realtype t0, N_Vector y0) +{ + CVodeMem cv_mem; + booleantype nvectorOK, allocOK; + long int lrw1, liw1; + int i,k; + + /* Check cvode_mem */ + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeInit", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Set max integration time Joep Vanlier */ + + cv_mem->tMax = DBL_MAX; + + /* Check for legal input parameters */ + + if (y0==NULL) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeInit", MSGCV_NULL_Y0); + return(CV_ILL_INPUT); + } + + if (f == NULL) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeInit", MSGCV_NULL_F); + return(CV_ILL_INPUT); + } + + /* Test if all required vector operations are implemented */ + + nvectorOK = cvCheckNvector(y0); + if(!nvectorOK) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeInit", MSGCV_BAD_NVECTOR); + return(CV_ILL_INPUT); + } + + /* Set space requirements for one N_Vector */ + + if (y0->ops->nvspace != NULL) { + N_VSpace(y0, &lrw1, &liw1); + } else { + lrw1 = 0; + liw1 = 0; + } + cv_mem->cv_lrw1 = lrw1; + cv_mem->cv_liw1 = liw1; + + /* Allocate the vectors (using y0 as a template) */ + + allocOK = cvAllocVectors(cv_mem, y0); + if (!allocOK) { + cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeInit", MSGCV_MEM_FAIL); + return(CV_MEM_FAIL); + } + + /* All error checking is complete at this point */ + + /* Copy the input parameters into CVODES state */ + + cv_mem->cv_f = f; + cv_mem->cv_tn = t0; + + /* Set step parameters */ + + cv_mem->cv_q = 1; + cv_mem->cv_L = 2; + cv_mem->cv_qwait = cv_mem->cv_L; + cv_mem->cv_etamax = ETAMX1; + + cv_mem->cv_qu = 0; + cv_mem->cv_hu = ZERO; + cv_mem->cv_tolsf = ONE; + + /* Set the linear solver addresses to NULL. + (We check != NULL later, in CVode, if using CV_NEWTON.) */ + + cv_mem->cv_linit = NULL; + cv_mem->cv_lsetup = NULL; + cv_mem->cv_lsolve = NULL; + cv_mem->cv_lfree = NULL; + cv_mem->cv_lmem = NULL; + + /* Set forceSetup to FALSE */ + + cv_mem->cv_forceSetup = FALSE; + + /* Initialize zn[0] in the history array */ + + N_VScale(ONE, y0, cv_mem->cv_zn[0]); + + /* Initialize all the counters */ + + cv_mem->cv_nst = 0; + cv_mem->cv_nfe = 0; + cv_mem->cv_ncfn = 0; + cv_mem->cv_netf = 0; + cv_mem->cv_nni = 0; + cv_mem->cv_nsetups = 0; + cv_mem->cv_nhnil = 0; + cv_mem->cv_nstlp = 0; + cv_mem->cv_nscon = 0; + cv_mem->cv_nge = 0; + + cv_mem->cv_irfnd = 0; + + /* Initialize other integrator optional outputs */ + + cv_mem->cv_h0u = ZERO; + cv_mem->cv_next_h = ZERO; + cv_mem->cv_next_q = 0; + + /* Initialize Stablilty Limit Detection data */ + /* NOTE: We do this even if stab lim det was not + turned on yet. This way, the user can turn it + on at any time */ + + cv_mem->cv_nor = 0; + for (i = 1; i <= 5; i++) + for (k = 1; k <= 3; k++) + cv_mem->cv_ssdat[i-1][k-1] = ZERO; + + /* Problem has been successfully initialized */ + + cv_mem->cv_MallocDone = TRUE; + + return(CV_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +#define lrw1 (cv_mem->cv_lrw1) +#define liw1 (cv_mem->cv_liw1) + +/*-----------------------------------------------------------------*/ + +/* + * CVodeReInit + * + * CVodeReInit re-initializes CVODES's memory for a problem, assuming + * it has already been allocated in a prior CVodeInit call. + * All problem specification inputs are checked for errors. + * If any error occurs during initialization, it is reported to the + * file whose file pointer is errfp. + * The return value is CV_SUCCESS = 0 if no errors occurred, or + * a negative value otherwise. + */ + +int CVodeReInit(void *cvode_mem, realtype t0, N_Vector y0) +{ + CVodeMem cv_mem; + int i,k; + + /* Check cvode_mem */ + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeReInit", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Check if cvode_mem was allocated */ + + if (cv_mem->cv_MallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_MALLOC, "CVODES", "CVodeReInit", MSGCV_NO_MALLOC); + return(CV_NO_MALLOC); + } + + /* Check for legal input parameters */ + + if (y0 == NULL) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeReInit", MSGCV_NULL_Y0); + return(CV_ILL_INPUT); + } + + /* Copy the input parameters into CVODES state */ + + cv_mem->cv_tn = t0; + + /* Set step parameters */ + + cv_mem->cv_q = 1; + cv_mem->cv_L = 2; + cv_mem->cv_qwait = cv_mem->cv_L; + cv_mem->cv_etamax = ETAMX1; + + cv_mem->cv_qu = 0; + cv_mem->cv_hu = ZERO; + cv_mem->cv_tolsf = ONE; + + /* Set forceSetup to FALSE */ + + cv_mem->cv_forceSetup = FALSE; + + /* Initialize zn[0] in the history array */ + + N_VScale(ONE, y0, cv_mem->cv_zn[0]); + + /* Initialize all the counters */ + + cv_mem->cv_nst = 0; + cv_mem->cv_nfe = 0; + cv_mem->cv_ncfn = 0; + cv_mem->cv_netf = 0; + cv_mem->cv_nni = 0; + cv_mem->cv_nsetups = 0; + cv_mem->cv_nhnil = 0; + cv_mem->cv_nstlp = 0; + cv_mem->cv_nscon = 0; + cv_mem->cv_nge = 0; + + cv_mem->cv_irfnd = 0; + + /* Initialize other integrator optional outputs */ + + cv_mem->cv_h0u = ZERO; + cv_mem->cv_next_h = ZERO; + cv_mem->cv_next_q = 0; + + /* Initialize Stablilty Limit Detection data */ + + cv_mem->cv_nor = 0; + for (i = 1; i <= 5; i++) + for (k = 1; k <= 3; k++) + cv_mem->cv_ssdat[i-1][k-1] = ZERO; + + /* Problem has been successfully re-initialized */ + + return(CV_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +/* + * CVodeSStolerances + * CVodeSVtolerances + * CVodeWFtolerances + * + * These functions specify the integration tolerances. One of them + * MUST be called before the first call to CVode. + * + * CVodeSStolerances specifies scalar relative and absolute tolerances. + * CVodeSVtolerances specifies scalar relative tolerance and a vector + * absolute tolerance (a potentially different absolute tolerance + * for each vector component). + * CVodeWFtolerances specifies a user-provides function (of type CVEwtFn) + * which will be called to set the error weight vector. + */ + +int CVodeSStolerances(void *cvode_mem, realtype reltol, realtype abstol) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSStolerances", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + if (cv_mem->cv_MallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_MALLOC, "CVODES", "CVodeSStolerances", MSGCV_NO_MALLOC); + return(CV_NO_MALLOC); + } + + /* Check inputs */ + + if (reltol < ZERO) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSStolerances", MSGCV_BAD_RELTOL); + return(CV_ILL_INPUT); + } + + if (abstol < ZERO) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSStolerances", MSGCV_BAD_ABSTOL); + return(CV_ILL_INPUT); + } + + /* Copy tolerances into memory */ + + cv_mem->cv_reltol = reltol; + cv_mem->cv_Sabstol = abstol; + + cv_mem->cv_itol = CV_SS; + + cv_mem->cv_user_efun = FALSE; + cv_mem->cv_efun = cvEwtSet; + cv_mem->cv_e_data = NULL; /* will be set to cvode_mem in InitialSetup */ + + return(CV_SUCCESS); +} + + +int CVodeSVtolerances(void *cvode_mem, realtype reltol, N_Vector abstol) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSVtolerances", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + if (cv_mem->cv_MallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_MALLOC, "CVODES", "CVodeSVtolerances", MSGCV_NO_MALLOC); + return(CV_NO_MALLOC); + } + + /* Check inputs */ + + if (reltol < ZERO) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSVtolerances", MSGCV_BAD_RELTOL); + return(CV_ILL_INPUT); + } + + if (N_VMin(abstol) < ZERO) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSVtolerances", MSGCV_BAD_ABSTOL); + return(CV_ILL_INPUT); + } + + /* Copy tolerances into memory */ + + if ( !(cv_mem->cv_VabstolMallocDone) ) { + cv_mem->cv_Vabstol = N_VClone(cv_mem->cv_ewt); + lrw += lrw1; + liw += liw1; + cv_mem->cv_VabstolMallocDone = TRUE; + } + + cv_mem->cv_reltol = reltol; + N_VScale(ONE, abstol, cv_mem->cv_Vabstol); + + cv_mem->cv_itol = CV_SV; + + cv_mem->cv_user_efun = FALSE; + cv_mem->cv_efun = cvEwtSet; + cv_mem->cv_e_data = NULL; /* will be set to cvode_mem in InitialSetup */ + + return(CV_SUCCESS); +} + + +int CVodeWFtolerances(void *cvode_mem, CVEwtFn efun) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeWFtolerances", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + if (cv_mem->cv_MallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_MALLOC, "CVODES", "CVodeWFtolerances", MSGCV_NO_MALLOC); + return(CV_NO_MALLOC); + } + + cv_mem->cv_itol = CV_WF; + + cv_mem->cv_user_efun = TRUE; + cv_mem->cv_efun = efun; + cv_mem->cv_e_data = NULL; /* will be set to user_data in InitialSetup */ + + return(CV_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +/* + * CVodeQuadInit + * + * CVodeQuadInit allocates and initializes quadrature related + * memory for a problem. All problem specification inputs are + * checked for errors. If any error occurs during initialization, + * it is reported to the file whose file pointer is errfp. + * The return value is CV_SUCCESS = 0 if no errors occurred, or + * a negative value otherwise. + */ + +int CVodeQuadInit(void *cvode_mem, CVQuadRhsFn fQ, N_Vector yQ0) +{ + CVodeMem cv_mem; + booleantype allocOK; + long int lrw1Q, liw1Q; + + /* Check cvode_mem */ + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeQuadInit", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Set space requirements for one N_Vector */ + N_VSpace(yQ0, &lrw1Q, &liw1Q); + cv_mem->cv_lrw1Q = lrw1Q; + cv_mem->cv_liw1Q = liw1Q; + + /* Allocate the vectors (using yQ0 as a template) */ + allocOK = cvQuadAllocVectors(cv_mem, yQ0); + if (!allocOK) { + cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeQuadInit", MSGCV_MEM_FAIL); + return(CV_MEM_FAIL); + } + + /* Initialize znQ[0] in the history array */ + N_VScale(ONE, yQ0, cv_mem->cv_znQ[0]); + + /* Copy the input parameters into CVODES state */ + cv_mem->cv_fQ = fQ; + + /* Initialize counters */ + cv_mem->cv_nfQe = 0; + cv_mem->cv_netfQ = 0; + + /* Quadrature integration turned ON */ + cv_mem->cv_quadr = TRUE; + cv_mem->cv_QuadMallocDone = TRUE; + + /* Quadrature initialization was successfull */ + return(CV_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +#define lrw1Q (cv_mem->cv_lrw1Q) +#define liw1Q (cv_mem->cv_liw1Q) + +/*-----------------------------------------------------------------*/ + +/* + * CVodeQuadReInit + * + * CVodeQuadReInit re-initializes CVODES's quadrature related memory + * for a problem, assuming it has already been allocated in prior + * calls to CVodeInit and CVodeQuadInit. + * All problem specification inputs are checked for errors. + * If any error occurs during initialization, it is reported to the + * file whose file pointer is errfp. + * The return value is CV_SUCCESS = 0 if no errors occurred, or + * a negative value otherwise. + */ + +int CVodeQuadReInit(void *cvode_mem, N_Vector yQ0) +{ + CVodeMem cv_mem; + + /* Check cvode_mem */ + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeQuadReInit", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Ckeck if quadrature was initialized? */ + if (cv_mem->cv_QuadMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_QUAD, "CVODES", "CVodeQuadReInit", MSGCV_NO_QUAD); + return(CV_NO_QUAD); + } + + /* Initialize znQ[0] in the history array */ + N_VScale(ONE, yQ0, cv_mem->cv_znQ[0]); + + /* Initialize counters */ + cv_mem->cv_nfQe = 0; + cv_mem->cv_netfQ = 0; + + /* Quadrature integration turned ON */ + cv_mem->cv_quadr = TRUE; + + /* Quadrature re-initialization was successfull */ + return(CV_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +/* + * CVodeQuadSStolerances + * CVodeQuadSVtolerances + * + * These functions specify the integration tolerances for sensitivity + * variables. One of them MUST be called before the first call to + * CVode IF error control on the quadrature variables is enabled + * (see CVodeSetQuadErrCon). + * + * CVodeQuadSStolerances specifies scalar relative and absolute tolerances. + * CVodeQuadSVtolerances specifies scalar relative tolerance and a vector + * absolute toleranc (a potentially different absolute tolerance for each + * vector component). + */ + +int CVodeQuadSStolerances(void *cvode_mem, realtype reltolQ, realtype abstolQ) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeQuadSStolerances", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Ckeck if quadrature was initialized? */ + + if (cv_mem->cv_QuadMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_QUAD, "CVODES", "CVodeQuadSStolerances", MSGCV_NO_QUAD); + return(CV_NO_QUAD); + } + + /* Test user-supplied tolerances */ + + if (reltolQ < ZERO) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSStolerances", MSGCV_BAD_RELTOLQ); + return(CV_ILL_INPUT); + } + + if (abstolQ < 0) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSStolerances", MSGCV_BAD_ABSTOLQ); + return(CV_ILL_INPUT); + } + + /* Copy tolerances into memory */ + + cv_mem->cv_itolQ = CV_SS; + + cv_mem->cv_reltolQ = reltolQ; + cv_mem->cv_SabstolQ = abstolQ; + + return(CV_SUCCESS); +} + +int CVodeQuadSVtolerances(void *cvode_mem, realtype reltolQ, N_Vector abstolQ) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeQuadSVtolerances", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Ckeck if quadrature was initialized? */ + + if (cv_mem->cv_QuadMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_QUAD, "CVODES", "CVodeQuadSVtolerances", MSGCV_NO_QUAD); + return(CV_NO_QUAD); + } + + /* Test user-supplied tolerances */ + + if (reltolQ < ZERO) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSVtolerances", MSGCV_BAD_RELTOLQ); + return(CV_ILL_INPUT); + } + + if (abstolQ == NULL) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSVtolerances", MSGCV_NULL_ABSTOLQ); + return(CV_ILL_INPUT); + } + + if (N_VMin(abstolQ) < ZERO) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSVtolerances", MSGCV_BAD_ABSTOLQ); + return(CV_ILL_INPUT); + } + + /* Copy tolerances into memory */ + + cv_mem->cv_itolQ = CV_SV; + + cv_mem->cv_reltolQ = reltolQ; + + if ( !(cv_mem->cv_VabstolQMallocDone) ) { + cv_mem->cv_VabstolQ = N_VClone(cv_mem->cv_tempvQ); + lrw += lrw1Q; + liw += liw1Q; + cv_mem->cv_VabstolQMallocDone = TRUE; + } + + N_VScale(ONE, abstolQ, cv_mem->cv_VabstolQ); + + return(CV_SUCCESS); +} + + +/*-----------------------------------------------------------------*/ + +#define stgr1alloc (cv_mem->cv_stgr1alloc) +#define nniS1 (cv_mem->cv_nniS1) +#define ncfnS1 (cv_mem->cv_ncfnS1) +#define ncfS1 (cv_mem->cv_ncfS1) + +/*-----------------------------------------------------------------*/ + +/* + * CVodeSensInit + * + * CVodeSensInit allocates and initializes sensitivity related + * memory for a problem (using a sensitivity RHS function of type + * CVSensRhsFn). All problem specification inputs are checked for + * errors. + * The return value is CV_SUCCESS = 0 if no errors occurred, or + * a negative value otherwise. + */ + +int CVodeSensInit(void *cvode_mem, int Ns, int ism, CVSensRhsFn fS, N_Vector *yS0) +{ + CVodeMem cv_mem; + booleantype allocOK; + int is; + + /* Check cvode_mem */ + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSensInit", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Check if CVodeSensInit or CVodeSensInit1 was already called */ + + if (cv_mem->cv_SensMallocDone) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensInit", MSGCV_SENSINIT_2); + return(CV_ILL_INPUT); + } + + /* Check if Ns is legal */ + + if (Ns<=0) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensInit", MSGCV_BAD_NS); + return(CV_ILL_INPUT); + } + cv_mem->cv_Ns = Ns; + + /* Check if ism is compatible */ + + if (ism==CV_STAGGERED1) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensInit", MSGCV_BAD_ISM_IFS); + return(CV_ILL_INPUT); + } + + /* Check if ism is legal */ + + if ((ism!=CV_SIMULTANEOUS) && (ism!=CV_STAGGERED)) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensInit", MSGCV_BAD_ISM); + return(CV_ILL_INPUT); + } + cv_mem->cv_ism = ism; + + /* Check if yS0 is non-null */ + + if (yS0 == NULL) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensInit", MSGCV_NULL_YS0); + return(CV_ILL_INPUT); + } + + /* Store sensitivity RHS-related data */ + + cv_mem->cv_ifS = CV_ALLSENS; + cv_mem->cv_fS1 = NULL; + + if (fS == NULL) { + + cv_mem->cv_fSDQ = TRUE; + cv_mem->cv_fS = cvSensRhsInternalDQ; + cv_mem->cv_fS_data = cvode_mem; + + } else { + + cv_mem->cv_fSDQ = FALSE; + cv_mem->cv_fS = fS; + cv_mem->cv_fS_data = cv_mem->cv_user_data; + + } + + /* No memory allocation for STAGGERED1 */ + + stgr1alloc = FALSE; + + /* Allocate the vectors (using yS0[0] as a template) */ + + allocOK = cvSensAllocVectors(cv_mem, yS0[0]); + if (!allocOK) { + cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeSensInit", MSGCV_MEM_FAIL); + return(CV_MEM_FAIL); + } + + /*---------------------------------------------- + All error checking is complete at this point + -----------------------------------------------*/ + + /* Initialize znS[0] in the history array */ + + for (is=0; iscv_znS[0][is]); + + /* Initialize all sensitivity related counters */ + + cv_mem->cv_nfSe = 0; + cv_mem->cv_nfeS = 0; + cv_mem->cv_ncfnS = 0; + cv_mem->cv_netfS = 0; + cv_mem->cv_nniS = 0; + cv_mem->cv_nsetupsS = 0; + + /* Set default values for plist and pbar */ + + for (is=0; iscv_plist[is] = is; + cv_mem->cv_pbar[is] = ONE; + } + + /* Sensitivities will be computed */ + + cv_mem->cv_sensi = TRUE; + cv_mem->cv_SensMallocDone = TRUE; + + /* Sensitivity initialization was successfull */ + + return(CV_SUCCESS); +} + +/* + * CVodeSensInit1 + * + * CVodeSensInit1 allocates and initializes sensitivity related + * memory for a problem (using a sensitivity RHS function of type + * CVSensRhs1Fn). All problem specification inputs are checked for + * errors. + * The return value is CV_SUCCESS = 0 if no errors occurred, or + * a negative value otherwise. + */ + +int CVodeSensInit1(void *cvode_mem, int Ns, int ism, CVSensRhs1Fn fS1, N_Vector *yS0) +{ + CVodeMem cv_mem; + booleantype allocOK; + int is; + + /* Check cvode_mem */ + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSensInit1", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Check if CVodeSensInit or CVodeSensInit1 was already called */ + + if (cv_mem->cv_SensMallocDone) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensInit1", MSGCV_SENSINIT_2); + return(CV_ILL_INPUT); + } + + /* Check if Ns is legal */ + + if (Ns<=0) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensInit1", MSGCV_BAD_NS); + return(CV_ILL_INPUT); + } + cv_mem->cv_Ns = Ns; + + /* Check if ism is legal */ + + if ((ism!=CV_SIMULTANEOUS) && (ism!=CV_STAGGERED) && (ism!=CV_STAGGERED1)) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensInit1", MSGCV_BAD_ISM); + return(CV_ILL_INPUT); + } + cv_mem->cv_ism = ism; + + /* Check if yS0 is non-null */ + + if (yS0 == NULL) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensInit1", MSGCV_NULL_YS0); + return(CV_ILL_INPUT); + } + + /* Store sensitivity RHS-related data */ + + cv_mem->cv_ifS = CV_ONESENS; + cv_mem->cv_fS = NULL; + + if (fS1 == NULL) { + + cv_mem->cv_fSDQ = TRUE; + cv_mem->cv_fS1 = cvSensRhs1InternalDQ; + cv_mem->cv_fS_data = cvode_mem; + + } else { + + cv_mem->cv_fSDQ = FALSE; + cv_mem->cv_fS1 = fS1; + cv_mem->cv_fS_data = cv_mem->cv_user_data; + + } + + /* Allocate ncfS1, ncfnS1, and nniS1 if needed */ + + if (ism == CV_STAGGERED1) { + stgr1alloc = TRUE; + ncfS1 = NULL; + ncfS1 = (int*)malloc(Ns*sizeof(int)); + ncfnS1 = NULL; + ncfnS1 = (long int*)malloc(Ns*sizeof(long int)); + nniS1 = NULL; + nniS1 = (long int*)malloc(Ns*sizeof(long int)); + if ( (ncfS1 == NULL) || (ncfnS1 == NULL) || (nniS1 == NULL) ) { + cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeSensInit1", MSGCV_MEM_FAIL); + return(CV_MEM_FAIL); + } + } else { + stgr1alloc = FALSE; + } + + /* Allocate the vectors (using yS0[0] as a template) */ + + allocOK = cvSensAllocVectors(cv_mem, yS0[0]); + if (!allocOK) { + if (stgr1alloc) { + free(ncfS1); ncfS1 = NULL; + free(ncfnS1); ncfnS1 = NULL; + free(nniS1); nniS1 = NULL; + } + cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeSensInit1", MSGCV_MEM_FAIL); + return(CV_MEM_FAIL); + } + + /*---------------------------------------------- + All error checking is complete at this point + -----------------------------------------------*/ + + /* Initialize znS[0] in the history array */ + + for (is=0; iscv_znS[0][is]); + + /* Initialize all sensitivity related counters */ + + cv_mem->cv_nfSe = 0; + cv_mem->cv_nfeS = 0; + cv_mem->cv_ncfnS = 0; + cv_mem->cv_netfS = 0; + cv_mem->cv_nniS = 0; + cv_mem->cv_nsetupsS = 0; + if (ism==CV_STAGGERED1) + for (is=0; iscv_plist[is] = is; + cv_mem->cv_pbar[is] = ONE; + } + + /* Sensitivities will be computed */ + + cv_mem->cv_sensi = TRUE; + cv_mem->cv_SensMallocDone = TRUE; + + /* Sensitivity initialization was successfull */ + + return(CV_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +#define Ns (cv_mem->cv_Ns) +#define ifS (cv_mem->cv_ifS) + +/*-----------------------------------------------------------------*/ + +/* + * CVodeSensReInit + * + * CVodeSensReInit re-initializes CVODES's sensitivity related memory + * for a problem, assuming it has already been allocated in prior + * calls to CVodeInit and CVodeSensInit/CVodeSensInit1. + * All problem specification inputs are checked for errors. + * The number of sensitivities Ns is assumed to be unchanged since + * the previous call to CVodeSensInit. + * If any error occurs during initialization, it is reported to the + * file whose file pointer is errfp. + * The return value is CV_SUCCESS = 0 if no errors occurred, or + * a negative value otherwise. + */ + +int CVodeSensReInit(void *cvode_mem, int ism, N_Vector *yS0) +{ + CVodeMem cv_mem; + int is; + + /* Check cvode_mem */ + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSensReInit", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was sensitivity initialized? */ + + if (cv_mem->cv_SensMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeSensReInit", MSGCV_NO_SENSI); + return(CV_NO_SENS); + } + + /* Check if ism is compatible */ + + if ((ifS==CV_ALLSENS) && (ism==CV_STAGGERED1)) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensReInit", MSGCV_BAD_ISM_IFS); + return(CV_ILL_INPUT); + } + + /* Check if ism is legal */ + + if ((ism!=CV_SIMULTANEOUS) && (ism!=CV_STAGGERED) && (ism!=CV_STAGGERED1)) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensReInit", MSGCV_BAD_ISM); + return(CV_ILL_INPUT); + } + cv_mem->cv_ism = ism; + + /* Check if yS0 is non-null */ + + if (yS0 == NULL) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensReInit", MSGCV_NULL_YS0); + return(CV_ILL_INPUT); + } + + /* Allocate ncfS1, ncfnS1, and nniS1 if needed */ + + if ( (ism==CV_STAGGERED1) && (stgr1alloc==FALSE) ) { + stgr1alloc = TRUE; + ncfS1 = NULL; + ncfS1 = (int*)malloc(Ns*sizeof(int)); + ncfnS1 = NULL; + ncfnS1 = (long int*)malloc(Ns*sizeof(long int)); + nniS1 = NULL; + nniS1 = (long int*)malloc(Ns*sizeof(long int)); + if ( (ncfS1==NULL) || (ncfnS1==NULL) || (nniS1==NULL) ) { + cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeSensReInit", MSGCV_MEM_FAIL); + return(CV_MEM_FAIL); + } + } + + /*---------------------------------------------- + All error checking is complete at this point + -----------------------------------------------*/ + + /* Initialize znS[0] in the history array */ + + for (is=0; iscv_znS[0][is]); + + /* Initialize all sensitivity related counters */ + + cv_mem->cv_nfSe = 0; + cv_mem->cv_nfeS = 0; + cv_mem->cv_ncfnS = 0; + cv_mem->cv_netfS = 0; + cv_mem->cv_nniS = 0; + cv_mem->cv_nsetupsS = 0; + if (ism==CV_STAGGERED1) + for (is=0; iscv_sensi = TRUE; + + return(CV_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +/* + * CVodeSensSStolerances + * CVodeSensSVtolerances + * CVodeSensEEtolerances + * + * These functions specify the integration tolerances for sensitivity + * variables. One of them MUST be called before the first call to CVode. + * + * CVodeSensSStolerances specifies scalar relative and absolute tolerances. + * CVodeSensSVtolerances specifies scalar relative tolerance and a vector + * absolute tolerance for each sensitivity vector (a potentially different + * absolute tolerance for each vector component). + * CVodeEEtolerances specifies that tolerances for sensitivity variables + * should be estimated from those provided for the state variables. + */ + +int CVodeSensSStolerances(void *cvode_mem, realtype reltolS, realtype *abstolS) +{ + CVodeMem cv_mem; + int is; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSensSStolerances", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was sensitivity initialized? */ + + if (cv_mem->cv_SensMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeSensSStolerances", MSGCV_NO_SENSI); + return(CV_NO_SENS); + } + + /* Test user-supplied tolerances */ + + if (reltolS < ZERO) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensSStolerances", MSGCV_BAD_RELTOLS); + return(CV_ILL_INPUT); + } + + if (abstolS == NULL) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensSStolerances", MSGCV_NULL_ABSTOLS); + return(CV_ILL_INPUT); + } + + for (is=0; iscv_itolS = CV_SS; + + cv_mem->cv_reltolS = reltolS; + + if ( !(cv_mem->cv_SabstolSMallocDone) ) { + cv_mem->cv_SabstolS = NULL; + cv_mem->cv_SabstolS = (realtype *)malloc(Ns*sizeof(realtype)); + lrw += Ns; + cv_mem->cv_SabstolSMallocDone = TRUE; + } + + for (is=0; iscv_SabstolS[is] = abstolS[is]; + + return(CV_SUCCESS); +} + +int CVodeSensSVtolerances(void *cvode_mem, realtype reltolS, N_Vector *abstolS) +{ + CVodeMem cv_mem; + int is; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSensSVtolerances", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was sensitivity initialized? */ + + if (cv_mem->cv_SensMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeSensSVtolerances", MSGCV_NO_SENSI); + return(CV_NO_SENS); + } + + Ns = cv_mem->cv_Ns; + + /* Test user-supplied tolerances */ + + if (reltolS < ZERO) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensSVtolerances", MSGCV_BAD_RELTOLS); + return(CV_ILL_INPUT); + } + + if (abstolS == NULL) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensSVtolerances", MSGCV_NULL_ABSTOLS); + return(CV_ILL_INPUT); + } + + for (is=0; iscv_itolS = CV_SV; + + cv_mem->cv_reltolS = reltolS; + + if ( !(cv_mem->cv_VabstolSMallocDone) ) { + cv_mem->cv_VabstolS = N_VCloneVectorArray(Ns, cv_mem->cv_tempv); + lrw += Ns*lrw1; + liw += Ns*liw1; + cv_mem->cv_VabstolSMallocDone = TRUE; + } + + for (is=0; iscv_VabstolS[is]); + + return(CV_SUCCESS); +} + + +int CVodeSensEEtolerances(void *cvode_mem) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSensEEtolerances", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was sensitivity initialized? */ + + if (cv_mem->cv_SensMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeSensEEtolerances", MSGCV_NO_SENSI); + return(CV_NO_SENS); + } + + cv_mem->cv_itolS = CV_EE; + + return(CV_SUCCESS); +} + + +/*-----------------------------------------------------------------*/ + +/* + * CVodeQuadSensInit + * + */ + +int CVodeQuadSensInit(void *cvode_mem, CVQuadSensRhsFn fQS, N_Vector *yQS0) +{ + CVodeMem cv_mem; + booleantype allocOK; + int is; + + /* Check cvode_mem */ + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeQuadSensInit", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Check if sensitivity analysis is active */ + if (!cv_mem->cv_sensi) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSensInit", MSGCV_NO_SENSI); + return(CV_ILL_INPUT); + } + + /* Check if yQS0 is non-null */ + if (yQS0 == NULL) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSensInit", MSGCV_NULL_YQS0); + return(CV_ILL_INPUT); + } + + /* Allocate the vectors (using yQS0[0] as a template) */ + allocOK = cvQuadSensAllocVectors(cv_mem, yQS0[0]); + if (!allocOK) { + cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeQuadSensInit", MSGCV_MEM_FAIL); + return(CV_MEM_FAIL); + } + + /*---------------------------------------------- + All error checking is complete at this point + -----------------------------------------------*/ + + /* Set fQS */ + if (fQS == NULL) { + + cv_mem->cv_fQSDQ = TRUE; + cv_mem->cv_fQS = cvQuadSensRhsInternalDQ; + + cv_mem->cv_fQS_data = cvode_mem; + + } else { + + cv_mem->cv_fQSDQ = FALSE; + cv_mem->cv_fQS = fQS; + + cv_mem->cv_fS_data = cv_mem->cv_user_data; + + } + + /* Initialize znQS[0] in the history array */ + for (is=0; iscv_znQS[0][is]); + + /* Initialize all sensitivity related counters */ + cv_mem->cv_nfQSe = 0; + cv_mem->cv_nfQeS = 0; + cv_mem->cv_netfQS = 0; + + /* Quadrature sensitivities will be computed */ + cv_mem->cv_quadr_sensi = TRUE; + cv_mem->cv_QuadSensMallocDone = TRUE; + + /* Sensitivity initialization was successfull */ + return(CV_SUCCESS); +} + +/* + * CVodeQuadSensReInit + * + */ + +int CVodeQuadSensReInit(void *cvode_mem, N_Vector *yQS0) +{ + CVodeMem cv_mem; + int is; + + /* Check cvode_mem */ + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeQuadSensReInit", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Check if sensitivity analysis is active */ + if (!cv_mem->cv_sensi) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSensReInit", MSGCV_NO_SENSI); + return(CV_NO_SENS); + } + + /* Was quadrature sensitivity initialized? */ + if (cv_mem->cv_QuadSensMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_QUADSENS, "CVODES", "CVodeQuadSensReInit", MSGCV_NO_QUADSENSI); + return(CV_NO_QUADSENS); + } + + /* Check if yQS0 is non-null */ + if (yQS0 == NULL) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSensReInit", MSGCV_NULL_YQS0); + return(CV_ILL_INPUT); + } + + /*---------------------------------------------- + All error checking is complete at this point + -----------------------------------------------*/ + + /* Initialize znQS[0] in the history array */ + for (is=0; iscv_znQS[0][is]); + + /* Initialize all sensitivity related counters */ + cv_mem->cv_nfQSe = 0; + cv_mem->cv_nfQeS = 0; + cv_mem->cv_netfQS = 0; + + /* Quadrature sensitivities will be computed */ + cv_mem->cv_quadr_sensi = TRUE; + + /* Problem has been successfully re-initialized */ + return(CV_SUCCESS); +} + + +/* + * CVodeQuadSensSStolerances + * CVodeQuadSensSVtolerances + * CVodeQuadSensEEtolerances + * + * These functions specify the integration tolerances for quadrature + * sensitivity variables. One of them MUST be called before the first + * call to CVode IF these variables are included in the error test. + * + * CVodeQuadSensSStolerances specifies scalar relative and absolute tolerances. + * CVodeQuadSensSVtolerances specifies scalar relative tolerance and a vector + * absolute tolerance for each quadrature sensitivity vector (a potentially + * different absolute tolerance for each vector component). + * CVodeQuadSensEEtolerances specifies that tolerances for sensitivity variables + * should be estimated from those provided for the quadrature variables. + * In this case, tolerances for the quadrature variables must be + * specified through a call to one of CVodeQuad**tolerances. + */ + +int CVodeQuadSensSStolerances(void *cvode_mem, realtype reltolQS, realtype *abstolQS) +{ + CVodeMem cv_mem; + int is; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeQuadSensSStolerances", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Check if sensitivity was initialized */ + + if (cv_mem->cv_SensMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeQuadSensSStolerances", MSGCV_NO_SENSI); + return(CV_NO_SENS); + } + + /* Ckeck if quadrature sensitivity was initialized? */ + + if (cv_mem->cv_QuadSensMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_QUADSENS, "CVODES", "CVodeQuadSSensSStolerances", MSGCV_NO_QUADSENSI); + return(CV_NO_QUAD); + } + + /* Test user-supplied tolerances */ + + if (reltolQS < ZERO) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSensSStolerances", MSGCV_BAD_RELTOLQS); + return(CV_ILL_INPUT); + } + + if (abstolQS == NULL) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSensSStolerances", MSGCV_NULL_ABSTOLQS); + return(CV_ILL_INPUT); + } + + for (is=0; iscv_itolQS = CV_SS; + + cv_mem->cv_reltolQS = reltolQS; + + if ( !(cv_mem->cv_SabstolQSMallocDone) ) { + cv_mem->cv_SabstolQS = NULL; + cv_mem->cv_SabstolQS = (realtype *)malloc(Ns*sizeof(realtype)); + lrw += Ns; + cv_mem->cv_SabstolQSMallocDone = TRUE; + } + + for (is=0; iscv_SabstolQS[is] = abstolQS[is]; + + return(CV_SUCCESS); +} + +int CVodeQuadSensSVtolerances(void *cvode_mem, realtype reltolQS, N_Vector *abstolQS) +{ + CVodeMem cv_mem; + int is; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeQuadSensSVtolerances", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* check if sensitivity was initialized */ + + if (cv_mem->cv_SensMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeQuadSensSVtolerances", MSGCV_NO_SENSI); + return(CV_NO_SENS); + } + + /* Ckeck if quadrature sensitivity was initialized? */ + + if (cv_mem->cv_QuadSensMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_QUADSENS, "CVODES", "CVodeQuadSensSVtolerances", MSGCV_NO_QUADSENSI); + return(CV_NO_QUAD); + } + + Ns = cv_mem->cv_Ns; + + /* Test user-supplied tolerances */ + + if (reltolQS < ZERO) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSensSVtolerances", MSGCV_BAD_RELTOLQS); + return(CV_ILL_INPUT); + } + + if (abstolQS == NULL) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensSVtolerances", MSGCV_NULL_ABSTOLQS); + return(CV_ILL_INPUT); + } + + for (is=0; iscv_itolQS = CV_SV; + + cv_mem->cv_reltolQS = reltolQS; + + if ( !(cv_mem->cv_VabstolQSMallocDone) ) { + cv_mem->cv_VabstolQS = N_VCloneVectorArray(Ns, cv_mem->cv_tempvQ); + lrw += Ns*lrw1Q; + liw += Ns*liw1Q; + cv_mem->cv_VabstolQSMallocDone = TRUE; + } + + for (is=0; iscv_VabstolQS[is]); + + return(CV_SUCCESS); +} + + +int CVodeQuadSensEEtolerances(void *cvode_mem) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeQuadSensEEtolerances", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* check if sensitivity was initialized */ + + if (cv_mem->cv_SensMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeQuadSensEEtolerances", MSGCV_NO_SENSI); + return(CV_NO_SENS); + } + + /* Ckeck if quadrature sensitivity was initialized? */ + + if (cv_mem->cv_QuadSensMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_QUADSENS, "CVODES", "CVodeQuadSensEEtolerances", MSGCV_NO_QUADSENSI); + return(CV_NO_QUAD); + } + + cv_mem->cv_itolQS = CV_EE; + + return(CV_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +/* + * CVodeSensToggleOff + * + * CVodeSensToggleOff deactivates sensitivity calculations. + * It does NOT deallocate sensitivity-related memory. + */ + +int CVodeSensToggleOff(void *cvode_mem) +{ + CVodeMem cv_mem; + + /* Check cvode_mem */ + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSensToggleOff", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Disable sensitivities */ + cv_mem->cv_sensi = FALSE; + cv_mem->cv_quadr_sensi = FALSE; + + return(CV_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +#define gfun (cv_mem->cv_gfun) +#define glo (cv_mem->cv_glo) +#define ghi (cv_mem->cv_ghi) +#define grout (cv_mem->cv_grout) +#define iroots (cv_mem->cv_iroots) +#define rootdir (cv_mem->cv_rootdir) +#define gactive (cv_mem->cv_gactive) + +/*-----------------------------------------------------------------*/ + +/* + * CVodeRootInit + * + * CVodeRootInit initializes a rootfinding problem to be solved + * during the integration of the ODE system. It loads the root + * function pointer and the number of root functions, and allocates + * workspace memory. The return value is CV_SUCCESS = 0 if no errors + * occurred, or a negative value otherwise. + */ + +int CVodeRootInit(void *cvode_mem, int nrtfn, CVRootFn g) +{ + CVodeMem cv_mem; + int i, nrt; + + /* Check cvode_mem */ + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeRootInit", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + nrt = (nrtfn < 0) ? 0 : nrtfn; + + /* If rerunning CVodeRootInit() with a different number of root + functions (changing number of gfun components), then free + currently held memory resources */ + if ((nrt != cv_mem->cv_nrtfn) && (cv_mem->cv_nrtfn > 0)) { + free(glo); glo = NULL; + free(ghi); ghi = NULL; + free(grout); grout = NULL; + free(iroots); iroots = NULL; + free(rootdir); rootdir = NULL; + free(gactive); gactive = NULL; + + lrw -= 3 * (cv_mem->cv_nrtfn); + liw -= 3 * (cv_mem->cv_nrtfn); + + } + + /* If CVodeRootInit() was called with nrtfn == 0, then set cv_nrtfn to + zero and cv_gfun to NULL before returning */ + if (nrt == 0) { + cv_mem->cv_nrtfn = nrt; + gfun = NULL; + return(CV_SUCCESS); + } + + /* If rerunning CVodeRootInit() with the same number of root functions + (not changing number of gfun components), then check if the root + function argument has changed */ + /* If g != NULL then return as currently reserved memory resources + will suffice */ + if (nrt == cv_mem->cv_nrtfn) { + if (g != gfun) { + if (g == NULL) { + free(glo); glo = NULL; + free(ghi); ghi = NULL; + free(grout); grout = NULL; + free(iroots); iroots = NULL; + free(rootdir); rootdir = NULL; + free(gactive); gactive = NULL; + + lrw -= 3*nrt; + liw -= 3*nrt; + + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeRootInit", MSGCV_NULL_G); + return(CV_ILL_INPUT); + } + else { + gfun = g; + return(CV_SUCCESS); + } + } + else return(CV_SUCCESS); + } + + /* Set variable values in CVode memory block */ + cv_mem->cv_nrtfn = nrt; + if (g == NULL) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeRootInit", MSGCV_NULL_G); + return(CV_ILL_INPUT); + } + else gfun = g; + + /* Allocate necessary memory and return */ + glo = NULL; + glo = (realtype *) malloc(nrt*sizeof(realtype)); + if (glo == NULL) { + cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeRootInit", MSGCV_MEM_FAIL); + return(CV_MEM_FAIL); + } + + ghi = NULL; + ghi = (realtype *) malloc(nrt*sizeof(realtype)); + if (ghi == NULL) { + free(glo); glo = NULL; + cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeRootInit", MSGCV_MEM_FAIL); + return(CV_MEM_FAIL); + } + + grout = NULL; + grout = (realtype *) malloc(nrt*sizeof(realtype)); + if (grout == NULL) { + free(glo); glo = NULL; + free(ghi); ghi = NULL; + cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeRootInit", MSGCV_MEM_FAIL); + return(CV_MEM_FAIL); + } + + iroots = NULL; + iroots = (int *) malloc(nrt*sizeof(int)); + if (iroots == NULL) { + free(glo); glo = NULL; + free(ghi); ghi = NULL; + free(grout); grout = NULL; + cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeRootInit", MSGCV_MEM_FAIL); + return(CV_MEM_FAIL); + } + + rootdir = NULL; + rootdir = (int *) malloc(nrt*sizeof(int)); + if (rootdir == NULL) { + free(glo); glo = NULL; + free(ghi); ghi = NULL; + free(grout); grout = NULL; + free(iroots); iroots = NULL; + cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeRootInit", MSGCV_MEM_FAIL); + return(CV_MEM_FAIL); + } + + + gactive = NULL; + gactive = (booleantype *) malloc(nrt*sizeof(booleantype)); + if (gactive == NULL) { + free(glo); glo = NULL; + free(ghi); ghi = NULL; + free(grout); grout = NULL; + free(iroots); iroots = NULL; + free(rootdir); rootdir = NULL; + cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeRootInit", MSGCV_MEM_FAIL); + return(CV_MEM_FAIL); + } + + + /* Set default values for rootdir (both directions) */ + for(i=0; icv_f) +#define user_data (cv_mem->cv_user_data) +#define efun (cv_mem->cv_efun) +#define e_data (cv_mem->cv_e_data) +#define qmax (cv_mem->cv_qmax) +#define mxstep (cv_mem->cv_mxstep) +#define mxhnil (cv_mem->cv_mxhnil) +#define sldeton (cv_mem->cv_sldeton) +#define hin (cv_mem->cv_hin) +#define hmin (cv_mem->cv_hmin) +#define hmax_inv (cv_mem->cv_hmax_inv) +#define tstop (cv_mem->cv_tstop) +#define tstopset (cv_mem->cv_tstopset) +#define maxnef (cv_mem->cv_maxnef) +#define maxncf (cv_mem->cv_maxncf) +#define maxcor (cv_mem->cv_maxcor) +#define nlscoef (cv_mem->cv_nlscoef) +#define itol (cv_mem->cv_itol) +#define reltol (cv_mem->cv_reltol) +#define Sabstol (cv_mem->cv_Sabstol) +#define Vabstol (cv_mem->cv_Vabstol) + +#define fQ (cv_mem->cv_fQ) +#define errconQ (cv_mem->cv_errconQ) +#define itolQ (cv_mem->cv_itolQ) +#define reltolQ (cv_mem->cv_reltolQ) +#define SabstolQ (cv_mem->cv_SabstolQ) +#define VabstolQ (cv_mem->cv_VabstolQ) + +#define ism (cv_mem->cv_ism) +#define fS (cv_mem->cv_fS) +#define fS1 (cv_mem->cv_fS1) +#define fS_data (cv_mem->cv_fS_data) +#define fSDQ (cv_mem->cv_fSDQ) +#define DQtype (cv_mem->cv_DQtype) +#define DQrhomax (cv_mem->cv_DQrhomax) +#define pbar (cv_mem->cv_pbar) +#define errconS (cv_mem->cv_errconS) +#define maxcorS (cv_mem->cv_maxcorS) +#define itolS (cv_mem->cv_itolS) +#define reltolS (cv_mem->cv_reltolS) +#define SabstolS (cv_mem->cv_SabstolS) +#define VabstolS (cv_mem->cv_VabstolS) +#define p (cv_mem->cv_p) +#define plist (cv_mem->cv_plist) + +#define fQS (cv_mem->cv_fQS) +#define fQS_data (cv_mem->cv_fQS_data) +#define fQSDQ (cv_mem->cv_fQSDQ) +#define errconQS (cv_mem->cv_errconQS) +#define itolQS (cv_mem->cv_itolQS) +#define reltolQS (cv_mem->cv_reltolQS) +#define SabstolQS (cv_mem->cv_SabstolQS) +#define VabstolQS (cv_mem->cv_VabstolQS) + +#define uround (cv_mem->cv_uround) +#define zn (cv_mem->cv_zn) +#define ewt (cv_mem->cv_ewt) +#define y (cv_mem->cv_y) +#define acor (cv_mem->cv_acor) +#define tempv (cv_mem->cv_tempv) +#define ftemp (cv_mem->cv_ftemp) +#define q (cv_mem->cv_q) +#define qprime (cv_mem->cv_qprime) +#define next_q (cv_mem->cv_next_q) +#define qwait (cv_mem->cv_qwait) +#define L (cv_mem->cv_L) +#define h (cv_mem->cv_h) +#define hprime (cv_mem->cv_hprime) +#define next_h (cv_mem->cv_next_h) +#define eta (cv_mem->cv_eta) +#define etaqm1 (cv_mem->cv_etaqm1) +#define etaq (cv_mem->cv_etaq) +#define etaqp1 (cv_mem->cv_etaqp1) +#define nscon (cv_mem->cv_nscon) +#define hscale (cv_mem->cv_hscale) +#define tn (cv_mem->cv_tn) +#define tau (cv_mem->cv_tau) +#define tq (cv_mem->cv_tq) +#define l (cv_mem->cv_l) +#define rl1 (cv_mem->cv_rl1) +#define gamma (cv_mem->cv_gamma) +#define gammap (cv_mem->cv_gammap) +#define gamrat (cv_mem->cv_gamrat) +#define crate (cv_mem->cv_crate) +#define acnrm (cv_mem->cv_acnrm) +#define mnewt (cv_mem->cv_mnewt) +#define etamax (cv_mem->cv_etamax) +#define nst (cv_mem->cv_nst) +#define nfe (cv_mem->cv_nfe) +#define ncfn (cv_mem->cv_ncfn) +#define netf (cv_mem->cv_netf) +#define nni (cv_mem->cv_nni) +#define nsetups (cv_mem->cv_nsetups) +#define nhnil (cv_mem->cv_nhnil) +#define linit (cv_mem->cv_linit) +#define lsetup (cv_mem->cv_lsetup) +#define lsolve (cv_mem->cv_lsolve) +#define lfree (cv_mem->cv_lfree) +#define lmem (cv_mem->cv_lmem) +#define qu (cv_mem->cv_qu) +#define nstlp (cv_mem->cv_nstlp) +#define h0u (cv_mem->cv_h0u) +#define hu (cv_mem->cv_hu) +#define saved_tq5 (cv_mem->cv_saved_tq5) +#define indx_acor (cv_mem->cv_indx_acor) +#define jcur (cv_mem->cv_jcur) +#define tolsf (cv_mem->cv_tolsf) +#define setupNonNull (cv_mem->cv_setupNonNull) +#define forceSetup (cv_mem->cv_forceSetup) +#define nor (cv_mem->cv_nor) +#define ssdat (cv_mem->cv_ssdat) + +#define nrtfn (cv_mem->cv_nrtfn) +#define tlo (cv_mem->cv_tlo) +#define thi (cv_mem->cv_thi) +#define tretlast (cv_mem->cv_tretlast) +#define toutc (cv_mem->cv_toutc) +#define trout (cv_mem->cv_trout) +#define ttol (cv_mem->cv_ttol) +#define taskc (cv_mem->cv_taskc) +#define irfnd (cv_mem->cv_irfnd) +#define nge (cv_mem->cv_nge) + +#define quadr (cv_mem->cv_quadr) +#define znQ (cv_mem->cv_znQ) +#define ewtQ (cv_mem->cv_ewtQ) +#define acorQ (cv_mem->cv_acorQ) +#define yQ (cv_mem->cv_yQ) +#define tempvQ (cv_mem->cv_tempvQ) +#define acnrmQ (cv_mem->cv_acnrmQ) +#define nfQe (cv_mem->cv_nfQe) +#define netfQ (cv_mem->cv_netfQ) +#define QuadMallocDone (cv_mem->cv_QuadMallocDone) + +#define sensi (cv_mem->cv_sensi) +#define znS (cv_mem->cv_znS) +#define ewtS (cv_mem->cv_ewtS) +#define acorS (cv_mem->cv_acorS) +#define yS (cv_mem->cv_yS) +#define tempvS (cv_mem->cv_tempvS) +#define ftempS (cv_mem->cv_ftempS) +#define crateS (cv_mem->cv_crateS) +#define acnrmS (cv_mem->cv_acnrmS) +#define nfSe (cv_mem->cv_nfSe) +#define nfeS (cv_mem->cv_nfeS) +#define nniS (cv_mem->cv_nniS) +#define ncfnS (cv_mem->cv_ncfnS) +#define netfS (cv_mem->cv_netfS) +#define nsetupsS (cv_mem->cv_nsetupsS) +#define stgr1alloc (cv_mem->cv_stgr1alloc) +#define SensMallocDone (cv_mem->cv_SensMallocDone) + +#define quadr_sensi (cv_mem->cv_quadr_sensi) +#define znQS (cv_mem->cv_znQS) +#define ewtQS (cv_mem->cv_ewtQS) +#define acorQS (cv_mem->cv_acorQS) +#define yQS (cv_mem->cv_yQS) +#define tempvQS (cv_mem->cv_tempvQS) +#define ftempQ (cv_mem->cv_ftempQ) +#define acnrmQS (cv_mem->cv_acnrmQS) +#define nfQSe (cv_mem->cv_nfQSe) +#define nfQeS (cv_mem->cv_nfQeS) +#define netfQS (cv_mem->cv_netfQS) + +#define QuadSensMallocDone (cv_mem->cv_QuadSensMallocDone) + + +/* + * ----------------------------------------------------------------- + * Main solver function + * ----------------------------------------------------------------- + */ + +/* + * CVode + * + * This routine is the main driver of the CVODES package. + * + * It integrates over a time interval defined by the user, by calling + * cvStep to do internal time steps. + * + * The first time that CVode is called for a successfully initialized + * problem, it computes a tentative initial step size h. + * + * CVode supports two modes, specified by itask: CV_NORMAL, CV_ONE_STEP. + * In the CV_NORMAL mode, the solver steps until it reaches or passes tout + * and then interpolates to obtain y(tout). + * In the CV_ONE_STEP mode, it takes one internal step and returns. + */ + +int CVode(void *cvode_mem, realtype tout, N_Vector yout, + realtype *tret, int itask ) +{ + CVodeMem cv_mem; + long int nstloc; + int retval, hflag, kflag, istate, is, ir, ier, irfndp; + realtype troundoff, tout_hin, rh, nrm; + booleantype inactive_roots; + time_t tStart, tEnd; + + /* + * ------------------------------------- + * 1. Check and process inputs + * ------------------------------------- + */ + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVode", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Check if cvode_mem was allocated */ + if (cv_mem->cv_MallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_MALLOC, "CVODES", "CVode", MSGCV_NO_MALLOC); + return(CV_NO_MALLOC); + } + + /* Check for yout != NULL */ + if ((y = yout) == NULL) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_YOUT_NULL); + return(CV_ILL_INPUT); + } + + /* Check for tret != NULL */ + if (tret == NULL) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_TRET_NULL); + return(CV_ILL_INPUT); + } + + /* Check for valid itask */ + if ( (itask != CV_NORMAL) && (itask != CV_ONE_STEP) ) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_BAD_ITASK); + return(CV_ILL_INPUT); + } + + if (itask == CV_NORMAL) toutc = tout; + taskc = itask; + + /* + * ---------------------------------------- + * 2. Initializations performed only at + * the first step (nst=0): + * - initial setup + * - initialize Nordsieck history array + * - compute initial step size + * - check for approach to tstop + * - check for approach to a root + * ---------------------------------------- + */ + + if (nst == 0) { + + /* Check inputs for corectness */ + ier = cvInitialSetup(cv_mem); + if (ier!= CV_SUCCESS) return(ier); + + /* + * Call f at (t0,y0), set zn[1] = y'(t0). + * If computing any quadratures, call fQ at (t0,y0), set znQ[1] = yQ'(t0) + * If computing sensitivities, call fS at (t0,y0,yS0), set znS[1][is] = yS'(t0), is=1,...,Ns. + * If computing quadr. sensi., call fQS at (t0,y0,yS0), set znQS[1][is] = yQS'(t0), is=1,...,Ns. + */ + + retval = f(tn, zn[0], zn[1], user_data); + nfe++; + if (retval < 0) { + cvProcessError(cv_mem, CV_RHSFUNC_FAIL, "CVODES", "CVode", MSGCV_RHSFUNC_FAILED, tn); + return(CV_RHSFUNC_FAIL); + } + if (retval > 0) { + cvProcessError(cv_mem, CV_FIRST_RHSFUNC_ERR, "CVODES", "CVode", MSGCV_RHSFUNC_FIRST); + return(CV_FIRST_RHSFUNC_ERR); + } + + if (quadr) { + retval = fQ(tn, zn[0], znQ[1], user_data); + nfQe++; + if (retval < 0) { + cvProcessError(cv_mem, CV_QRHSFUNC_FAIL, "CVODES", "CVode", MSGCV_QRHSFUNC_FAILED, tn); + return(CV_QRHSFUNC_FAIL); + } + if (retval > 0) { + cvProcessError(cv_mem, CV_FIRST_QRHSFUNC_ERR, "CVODES", "CVode", MSGCV_QRHSFUNC_FIRST); + return(CV_FIRST_QRHSFUNC_ERR); + } + } + + if (sensi) { + retval = cvSensRhsWrapper(cv_mem, tn, zn[0], zn[1], znS[0], znS[1], tempv, ftemp); + if (retval < 0) { + cvProcessError(cv_mem, CV_SRHSFUNC_FAIL, "CVODES", "CVode", MSGCV_SRHSFUNC_FAILED, tn); + return(CV_SRHSFUNC_FAIL); + } + if (retval > 0) { + cvProcessError(cv_mem, CV_FIRST_SRHSFUNC_ERR, "CVODES", "CVode", MSGCV_SRHSFUNC_FIRST); + return(CV_FIRST_SRHSFUNC_ERR); + } + } + + if (quadr_sensi) { + retval = fQS(Ns, tn, zn[0], znS[0], znQ[1], znQS[1], fQS_data, tempv, tempvQ); + nfQSe++; + if (retval < 0) { + cvProcessError(cv_mem, CV_QSRHSFUNC_FAIL, "CVODES", "CVode", MSGCV_QSRHSFUNC_FAILED, tn); + return(CV_QSRHSFUNC_FAIL); + } + if (retval > 0) { + cvProcessError(cv_mem, CV_FIRST_QSRHSFUNC_ERR, "CVODES", "CVode", MSGCV_QSRHSFUNC_FIRST); + return(CV_FIRST_QSRHSFUNC_ERR); + } + } + + /* Set initial h (from H0 or cvHin). */ + + h = hin; + if ( (h != ZERO) && ((tout-tn)*h < ZERO) ) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_BAD_H0); + return(CV_ILL_INPUT); + } + if (h == ZERO) { + tout_hin = tout; + if ( tstopset && (tout-tn)*(tout-tstop) > 0 ) tout_hin = tstop; + hflag = cvHin(cv_mem, tout_hin); + if (hflag != CV_SUCCESS) { + istate = cvHandleFailure(cv_mem, hflag); + return(istate); + } + } + rh = ABS(h)*hmax_inv; + if (rh > ONE) h /= rh; + if (ABS(h) < hmin) h *= hmin/ABS(h); + + /* Check for approach to tstop */ + + if (tstopset) { + if ( (tstop - tn)*h < ZERO ) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_BAD_TSTOP, tstop, tn); + return(CV_ILL_INPUT); + } + if ( (tn + h - tstop)*h > ZERO ) + h = (tstop - tn)*(ONE-FOUR*uround); + } + + /* + * Scale zn[1] by h. + * If computing any quadratures, scale znQ[1] by h. + * If computing sensitivities, scale znS[1][is] by h. + * If computing quadrature sensitivities, scale znQS[1][is] by h. + */ + + hscale = h; + h0u = h; + hprime = h; + + N_VScale(h, zn[1], zn[1]); + + if (quadr) + N_VScale(h, znQ[1], znQ[1]); + + if (sensi) + for (is=0; is 0) { + + retval = cvRcheck1(cv_mem); + + if (retval == CV_RTFUNC_FAIL) { + cvProcessError(cv_mem, CV_RTFUNC_FAIL, "CVODES", "cvRcheck1", MSGCV_RTFUNC_FAILED, tn); + return(CV_RTFUNC_FAIL); + } + + } + + } /* end first call block */ + + /* + * ------------------------------------------------------ + * 3. At following steps, perform stop tests: + * - check for root in last step + * - check if we passed tstop + * - check if we passed tout (NORMAL mode) + * - check if current tn was returned (ONE_STEP mode) + * - check if we are close to tstop + * (adjust step size if needed) + * ------------------------------------------------------- + */ + + if (nst > 0) { + + /* Estimate an infinitesimal time interval to be used as + a roundoff for time quantities (based on current time + and step size) */ + troundoff = FUZZ_FACTOR*uround*(ABS(tn) + ABS(h)); + + /* First check for a root in the last step taken, other than the + last root found, if any. If itask = CV_ONE_STEP and y(tn) was not + returned because of an intervening root, return y(tn) now. */ + if (nrtfn > 0) { + + irfndp = irfnd; + + retval = cvRcheck2(cv_mem); + + if (retval == CLOSERT) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "cvRcheck2", MSGCV_CLOSE_ROOTS, tlo); + return(CV_ILL_INPUT); + } else if (retval == CV_RTFUNC_FAIL) { + cvProcessError(cv_mem, CV_RTFUNC_FAIL, "CVODES", "cvRcheck2", MSGCV_RTFUNC_FAILED, tlo); + return(CV_RTFUNC_FAIL); + } else if (retval == RTFOUND) { + tretlast = *tret = tlo; + return(CV_ROOT_RETURN); + } + + /* If tn is distinct from tretlast (within roundoff), + check remaining interval for roots */ + if ( ABS(tn - tretlast) > troundoff ) { + + retval = cvRcheck3(cv_mem); + + if (retval == CV_SUCCESS) { /* no root found */ + irfnd = 0; + if ((irfndp == 1) && (itask == CV_ONE_STEP)) { + tretlast = *tret = tn; + N_VScale(ONE, zn[0], yout); + return(CV_SUCCESS); + } + } else if (retval == RTFOUND) { /* a new root was found */ + irfnd = 1; + tretlast = *tret = tlo; + return(CV_ROOT_RETURN); + } else if (retval == CV_RTFUNC_FAIL) { /* g failed */ + cvProcessError(cv_mem, CV_RTFUNC_FAIL, "CVODES", "cvRcheck3", MSGCV_RTFUNC_FAILED, tlo); + return(CV_RTFUNC_FAIL); + } + + } + + } /* end of root stop check */ + + /* In CV_NORMAL mode, test if tout was reached */ + if ( (itask == CV_NORMAL) && ((tn-tout)*h >= ZERO) ) { + tretlast = *tret = tout; + ier = CVodeGetDky(cv_mem, tout, 0, yout); + if (ier != CV_SUCCESS) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_BAD_TOUT, tout); + return(CV_ILL_INPUT); + } + return(CV_SUCCESS); + } + + /* In CV_ONE_STEP mode, test if tn was returned */ + if ( itask == CV_ONE_STEP && ABS(tn - tretlast) > troundoff ) { + tretlast = *tret = tn; + N_VScale(ONE, zn[0], yout); + return(CV_SUCCESS); + } + + /* Test for tn at tstop or near tstop */ + if ( tstopset ) { + + if ( ABS(tn - tstop) <= troundoff ) { + ier = CVodeGetDky(cv_mem, tstop, 0, yout); + if (ier != CV_SUCCESS) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_BAD_TSTOP, tstop, tn); + return(CV_ILL_INPUT); + } + tretlast = *tret = tstop; + tstopset = FALSE; + return(CV_TSTOP_RETURN); + } + + /* If next step would overtake tstop, adjust stepsize */ + if ( (tn + hprime - tstop)*h > ZERO ) { + hprime = (tstop - tn)*(ONE-FOUR*uround); + eta = hprime/h; + } + + } + + } /* end stopping tests block at nst>0 */ + + /* + * -------------------------------------------------- + * 4. Looping point for internal steps + * + * 4.1. check for errors (too many steps, too much + * accuracy requested, step size too small) + * 4.2. take a new step (call cvStep) + * 4.3. stop on error + * 4.4. perform stop tests: + * - check for root in last step + * - check if tout was passed + * - check if close to tstop + * - check if in ONE_STEP mode (must return) + * -------------------------------------------------- + */ + + nstloc = 0; + time( &tStart ); /* Added by J. Vanlier */ + loop { + time( &tEnd ); /* Added by J. Vanlier */ + if ( difftime( tEnd, tStart ) > cv_mem->tMax ) { /* Added by Joep Vanlier */ + fprintf(stderr, "Simulation time exceeded: t=%e, dt=%e\n", tn, h ); + cvProcessError(cv_mem, CV_TOO_MUCH_WORK, "CVODES", "CVode", MSGCV_MAX_STEPS, tn); + istate = CV_TOO_MUCH_WORK; + tretlast = *tret = tn; + N_VScale(ONE, zn[0], yout); + break; + } + + next_h = h; + next_q = q; + + /* Reset and check ewt, ewtQ, ewtS */ + if (nst > 0) { + + ier = efun(zn[0], ewt, e_data); + if(ier != 0) { + if (itol == CV_WF) cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_EWT_NOW_FAIL, tn); + else cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_EWT_NOW_BAD, tn); + istate = CV_ILL_INPUT; + tretlast = *tret = tn; + N_VScale(ONE, zn[0], yout); + break; + } + + if (quadr && errconQ) { + ier = cvQuadEwtSet(cv_mem, znQ[0], ewtQ); + if(ier != 0) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_EWTQ_NOW_BAD, tn); + istate = CV_ILL_INPUT; + tretlast = *tret = tn; + N_VScale(ONE, zn[0], yout); + break; + } + } + + if (sensi) { + ier = cvSensEwtSet(cv_mem, znS[0], ewtS); + if (ier != 0) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_EWTS_NOW_BAD, tn); + istate = CV_ILL_INPUT; + tretlast = *tret = tn; + N_VScale(ONE, zn[0], yout); + break; + } + } + + if (quadr_sensi && errconQS) { + ier = cvQuadSensEwtSet(cv_mem, znQS[0], ewtQS); + if (ier != 0) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_EWTQS_NOW_BAD, tn); + istate = CV_ILL_INPUT; + tretlast = *tret = tn; + N_VScale(ONE, zn[0], yout); + break; + } + } + + } + + /* Check for too many steps */ + if ( (mxstep>0) && (nstloc >= mxstep) ) { + cvProcessError(cv_mem, CV_TOO_MUCH_WORK, "CVODES", "CVode", MSGCV_MAX_STEPS, tn); + istate = CV_TOO_MUCH_WORK; + tretlast = *tret = tn; + N_VScale(ONE, zn[0], yout); + break; + } + + /* Check for too much accuracy requested */ + nrm = N_VWrmsNorm(zn[0], ewt); + if (quadr && errconQ) { + nrm = cvQuadUpdateNorm(cv_mem, nrm, znQ[0], ewtQ); + } + if (sensi && errconS) { + nrm = cvSensUpdateNorm(cv_mem, nrm, znS[0], ewtS); + } + if (quadr_sensi && errconQS) { + nrm = cvQuadSensUpdateNorm(cv_mem, nrm, znQS[0], ewtQS); + } + tolsf = uround * nrm; + if (tolsf > ONE) { + cvProcessError(cv_mem, CV_TOO_MUCH_ACC, "CVODES", "CVode", MSGCV_TOO_MUCH_ACC, tn); + istate = CV_TOO_MUCH_ACC; + tretlast = *tret = tn; + N_VScale(ONE, zn[0], yout); + tolsf *= TWO; + break; + } else { + tolsf = ONE; + } + + /* Check for h below roundoff level in tn */ + if (tn + h == tn) { + nhnil++; + if (nhnil <= mxhnil) + cvProcessError(cv_mem, CV_WARNING, "CVODES", "CVode", MSGCV_HNIL, tn, h); + if (nhnil == mxhnil) + cvProcessError(cv_mem, CV_WARNING, "CVODES", "CVode", MSGCV_HNIL_DONE); + } + + /* Call cvStep to take a step */ + kflag = cvStep(cv_mem); + + /* Process failed step cases, and exit loop */ + if (kflag != CV_SUCCESS) { + istate = cvHandleFailure(cv_mem, kflag); + tretlast = *tret = tn; + N_VScale(ONE, zn[0], yout); + break; + } + + nstloc++; + + /* Check for root in last step taken. */ + if (nrtfn > 0) { + + retval = cvRcheck3(cv_mem); + + if (retval == RTFOUND) { /* A new root was found */ + irfnd = 1; + istate = CV_ROOT_RETURN; + tretlast = *tret = tlo; + break; + } else if (retval == CV_RTFUNC_FAIL) { /* g failed */ + cvProcessError(cv_mem, CV_RTFUNC_FAIL, "CVODES", "cvRcheck3", MSGCV_RTFUNC_FAILED, tlo); + istate = CV_RTFUNC_FAIL; + break; + } + + /* If we are at the end of the first step and we still have + * some event functions that are inactive, issue a warning + * as this may indicate a user error in the implementation + * of the root function. */ + + if (nst==1) { + inactive_roots = FALSE; + for (ir=0; ircv_mxgnull > 0) && inactive_roots) { + cvProcessError(cv_mem, CV_WARNING, "CVODES", "CVode", MSGCV_INACTIVE_ROOTS); + } + } + + } + + /* In NORMAL mode, check if tout reached */ + if ( (itask == CV_NORMAL) && (tn-tout)*h >= ZERO ) { + istate = CV_SUCCESS; + tretlast = *tret = tout; + (void) CVodeGetDky(cv_mem, tout, 0, yout); + next_q = qprime; + next_h = hprime; + break; + } + + /* Check if tn is at tstop or near tstop */ + if ( tstopset ) { + + troundoff = FUZZ_FACTOR*uround*(ABS(tn) + ABS(h)); + if ( ABS(tn - tstop) <= troundoff) { + (void) CVodeGetDky(cv_mem, tstop, 0, yout); + tretlast = *tret = tstop; + tstopset = FALSE; + istate = CV_TSTOP_RETURN; + break; + } + + if ( (tn + hprime - tstop)*h > ZERO ) { + hprime = (tstop - tn)*(ONE-FOUR*uround); + eta = hprime/h; + } + + } + + /* In ONE_STEP mode, copy y and exit loop */ + if (itask == CV_ONE_STEP) { + istate = CV_SUCCESS; + tretlast = *tret = tn; + N_VScale(ONE, zn[0], yout); + next_q = qprime; + next_h = hprime; + break; + } + + } /* end looping for internal steps */ + + /* Load optional output */ + if (sensi && (ism==CV_STAGGERED1)) { + nniS = 0; + ncfnS = 0; + for (is=0; is q)) { + cvProcessError(cv_mem, CV_BAD_K, "CVODES", "CVodeGetDky", MSGCV_BAD_K); + return(CV_BAD_K); + } + + /* Allow for some slack */ + tfuzz = FUZZ_FACTOR * uround * (ABS(tn) + ABS(hu)); + if (hu < ZERO) tfuzz = -tfuzz; + tp = tn - hu - tfuzz; + tn1 = tn + tfuzz; + if ((t-tp)*(t-tn1) > ZERO) { + cvProcessError(cv_mem, CV_BAD_T, "CVODES", "CVodeGetDky", MSGCV_BAD_T, t, tn-hu, tn); + return(CV_BAD_T); + } + + /* Sum the differentiated interpolating polynomial */ + + s = (t - tn) / h; + for (j=q; j >= k; j--) { + c = ONE; + for (i=j; i >= j-k+1; i--) c *= i; + if (j == q) { + N_VScale(c, zn[q], dky); + } else { + N_VLinearSum(c, zn[j], s, dky, dky); + } + } + if (k == 0) return(CV_SUCCESS); + r = RPowerI(h,-k); + N_VScale(r, dky, dky); + return(CV_SUCCESS); +} + +/* + * CVodeGetQuad + * + * This routine extracts quadrature solution into yQout at the + * time which CVode returned the solution. + * This is just a wrapper that calls CVodeGetQuadDky with k=0. + */ + +int CVodeGetQuad(void *cvode_mem, realtype *tret, N_Vector yQout) +{ + CVodeMem cv_mem; + int flag; + + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuad", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + *tret = tretlast; + + flag = CVodeGetQuadDky(cvode_mem,tretlast,0,yQout); + + return(flag); +} + +/* + * CVodeGetQuadDky + * + * CVodeQuadDky computes the kth derivative of the yQ function at + * time t, where tn-hu <= t <= tn, tn denotes the current + * internal time reached, and hu is the last internal step size + * successfully used by the solver. The user may request + * k=0, 1, ..., qu, where qu is the current order. + * The derivative vector is returned in dky. This vector + * must be allocated by the caller. It is only legal to call this + * function after a successful return from CVode with quadrature + * computation enabled. + */ + +int CVodeGetQuadDky(void *cvode_mem, realtype t, int k, N_Vector dkyQ) +{ + realtype s, c, r; + realtype tfuzz, tp, tn1; + int i, j; + CVodeMem cv_mem; + + /* Check all inputs for legality */ + + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadDky", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + if(quadr != TRUE) { + cvProcessError(cv_mem, CV_NO_QUAD, "CVODES", "CVodeGetQuadDky", MSGCV_NO_QUAD); + return(CV_NO_QUAD); + } + + if (dkyQ == NULL) { + cvProcessError(cv_mem, CV_BAD_DKY, "CVODES", "CVodeGetQuadDky", MSGCV_NULL_DKY); + return(CV_BAD_DKY); + } + + if ((k < 0) || (k > q)) { + cvProcessError(cv_mem, CV_BAD_K, "CVODES", "CVodeGetQuadDky", MSGCV_BAD_K); + return(CV_BAD_K); + } + + /* Allow for some slack */ + tfuzz = FUZZ_FACTOR * uround * (ABS(tn) + ABS(hu)); + if (hu < ZERO) tfuzz = -tfuzz; + tp = tn - hu - tfuzz; + tn1 = tn + tfuzz; + if ((t-tp)*(t-tn1) > ZERO) { + cvProcessError(cv_mem, CV_BAD_T, "CVODES", "CVodeGetQuadDky", MSGCV_BAD_T); + return(CV_BAD_T); + } + + /* Sum the differentiated interpolating polynomial */ + + s = (t - tn) / h; + for (j=q; j >= k; j--) { + c = ONE; + for (i=j; i >= j-k+1; i--) c *= i; + if (j == q) { + N_VScale(c, znQ[q], dkyQ); + } else { + N_VLinearSum(c, znQ[j], s, dkyQ, dkyQ); + } + } + if (k == 0) return(CV_SUCCESS); + r = RPowerI(h,-k); + N_VScale(r, dkyQ, dkyQ); + return(CV_SUCCESS); + +} + +/* + * CVodeGetSens + * + * This routine extracts sensitivity solution into ySout at the + * time at which CVode returned the solution. + * This is just a wrapper that calls CVodeSensDky with k=0. + */ + +int CVodeGetSens(void *cvode_mem, realtype *tret, N_Vector *ySout) +{ + CVodeMem cv_mem; + int flag; + + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetSens", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + *tret = tretlast; + + flag = CVodeGetSensDky(cvode_mem,tretlast,0,ySout); + + return(flag); +} + +/* + * CVodeGetSens1 + * + * This routine extracts the is-th sensitivity solution into ySout + * at the time at which CVode returned the solution. + * This is just a wrapper that calls CVodeSensDky1 with k=0. + */ + +int CVodeGetSens1(void *cvode_mem, realtype *tret, int is, N_Vector ySout) +{ + CVodeMem cv_mem; + int flag; + + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetSens1", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + *tret = tretlast; + + flag = CVodeGetSensDky1(cvode_mem,tretlast,0,is,ySout); + + return(flag); +} + +/* + * CVodeGetSensDky + * + * If the user calls directly CVodeSensDky then s must be allocated + * prior to this call. When CVodeSensDky is called by + * CVodeGetSens, only ier=CV_SUCCESS, ier=CV_NO_SENS, or + * ier=CV_BAD_T are possible. + */ + +int CVodeGetSensDky(void *cvode_mem, realtype t, int k, N_Vector *dkyS) +{ + int ier=CV_SUCCESS; + int is; + CVodeMem cv_mem; + + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetSensDky", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + if (dkyS == NULL) { + cvProcessError(cv_mem, CV_BAD_DKY, "CVODES", "CVodeGetSensDky", MSGCV_NULL_DKYA); + return(CV_BAD_DKY); + } + + for (is=0; is q)) { + cvProcessError(cv_mem, CV_BAD_K, "CVODES", "CVodeGetSensDky1", MSGCV_BAD_K); + return(CV_BAD_K); + } + + if ((is < 0) || (is > Ns-1)) { + cvProcessError(cv_mem, CV_BAD_IS, "CVODES", "CVodeGetSensDky1", MSGCV_BAD_IS); + return(CV_BAD_IS); + } + + /* Allow for some slack */ + tfuzz = FUZZ_FACTOR * uround * (ABS(tn) + ABS(hu)); + if (hu < ZERO) tfuzz = -tfuzz; + tp = tn - hu - tfuzz; + tn1 = tn + tfuzz; + if ((t-tp)*(t-tn1) > ZERO) { + cvProcessError(cv_mem, CV_BAD_T, "CVODES", "CVodeGetSensDky1", MSGCV_BAD_T); + return(CV_BAD_T); + } + + /* Sum the differentiated interpolating polynomial */ + + s = (t - tn) / h; + for (j=q; j >= k; j--) { + c = ONE; + for (i=j; i >= j-k+1; i--) c *= i; + if (j == q) { + N_VScale(c, znS[q][is], dkyS); + } else { + N_VLinearSum(c, znS[j][is], s, dkyS, dkyS); + } + } + if (k == 0) return(CV_SUCCESS); + r = RPowerI(h,-k); + N_VScale(r, dkyS, dkyS); + return(CV_SUCCESS); + +} + +/* + * CVodeGetQuadSens and CVodeGetQuadSens1 + * + * Extraction functions for all or only one of the quadrature sensitivity + * vectors at the time at which CVode returned the ODE solution. + */ + +int CVodeGetQuadSens(void *cvode_mem, realtype *tret, N_Vector *yQSout) +{ + CVodeMem cv_mem; + int flag; + + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadSens", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + *tret = tretlast; + + flag = CVodeGetQuadSensDky(cvode_mem,tretlast,0,yQSout); + + return(flag); +} + +int CVodeGetQuadSens1(void *cvode_mem, realtype *tret, int is, N_Vector yQSout) +{ + CVodeMem cv_mem; + int flag; + + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadSens1", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + *tret = tretlast; + + flag = CVodeGetQuadSensDky1(cvode_mem,tretlast,0,is,yQSout); + + return(flag); +} + +/* + * CVodeGetQuadSensDky and CVodeGetQuadSensDky1 + * + * Dense output functions for all or only one of the quadrature sensitivity + * vectors (or derivative thereof). + */ + +int CVodeGetQuadSensDky(void *cvode_mem, realtype t, int k, N_Vector *dkyQS_all) +{ + int ier=CV_SUCCESS; + int is; + CVodeMem cv_mem; + + if (cvode_mem == NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadSensDky", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + if (dkyQS_all == NULL) { + cvProcessError(cv_mem, CV_BAD_DKY, "CVODES", "CVodeGetSensDky", MSGCV_NULL_DKYA); + return(CV_BAD_DKY); + } + + for (is=0; is q)) { + cvProcessError(cv_mem, CV_BAD_K, "CVODES", "CVodeGetQuadSensDky1", MSGCV_BAD_K); + return(CV_BAD_K); + } + + if ((is < 0) || (is > Ns-1)) { + cvProcessError(cv_mem, CV_BAD_IS, "CVODES", "CVodeGetQuadSensDky1", MSGCV_BAD_IS); + return(CV_BAD_IS); + } + + /* Allow for some slack */ + tfuzz = FUZZ_FACTOR * uround * (ABS(tn) + ABS(hu)); + if (hu < ZERO) tfuzz = -tfuzz; + tp = tn - hu - tfuzz; + tn1 = tn + tfuzz; + if ((t-tp)*(t-tn1) > ZERO) { + cvProcessError(cv_mem, CV_BAD_T, "CVODES", "CVodeGetQuadSensDky1", MSGCV_BAD_T); + return(CV_BAD_T); + } + + /* Sum the differentiated interpolating polynomial */ + + s = (t - tn) / h; + for (j=q; j >= k; j--) { + c = ONE; + for (i=j; i >= j-k+1; i--) c *= i; + if (j == q) { + N_VScale(c, znQS[q][is], dkyQS); + } else { + N_VLinearSum(c, znQS[j][is], s, dkyQS, dkyQS); + } + } + if (k == 0) return(CV_SUCCESS); + r = RPowerI(h,-k); + N_VScale(r, dkyQS, dkyQS); + return(CV_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Deallocation functions + * ----------------------------------------------------------------- + */ + +/* + * CVodeFree + * + * This routine frees the problem memory allocated by CVodeInit. + * Such memory includes all the vectors allocated by cvAllocVectors, + * and the memory lmem for the linear solver (deallocated by a call + * to lfree), as well as (if Ns!=0) all memory allocated for + * sensitivity computations by CVodeSensInit. + */ + +void CVodeFree(void **cvode_mem) +{ + CVodeMem cv_mem; + + if (*cvode_mem == NULL) return; + + cv_mem = (CVodeMem) (*cvode_mem); + + cvFreeVectors(cv_mem); + + CVodeQuadFree(cv_mem); + + CVodeSensFree(cv_mem); + + CVodeQuadSensFree(cv_mem); + + CVodeAdjFree(cv_mem); + + if (iter == CV_NEWTON && lfree != NULL) lfree(cv_mem); + + if (nrtfn > 0) { + free(glo); glo = NULL; + free(ghi); ghi = NULL; + free(grout); grout = NULL; + free(iroots); iroots = NULL; + free(rootdir); rootdir = NULL; + free(gactive); gactive = NULL; + } + + free(*cvode_mem); + *cvode_mem = NULL; +} + +/* + * CVodeQuadFree + * + * CVodeQuadFree frees the problem memory in cvode_mem allocated + * for quadrature integration. Its only argument is the pointer + * cvode_mem returned by CVodeCreate. + */ + +void CVodeQuadFree(void *cvode_mem) +{ + CVodeMem cv_mem; + + if (cvode_mem == NULL) return; + cv_mem = (CVodeMem) cvode_mem; + + if(QuadMallocDone) { + cvQuadFreeVectors(cv_mem); + QuadMallocDone = FALSE; + quadr = FALSE; + } +} + +/* + * CVodeSensFree + * + * CVodeSensFree frees the problem memory in cvode_mem allocated + * for sensitivity analysis. Its only argument is the pointer + * cvode_mem returned by CVodeCreate. + */ + +void CVodeSensFree(void *cvode_mem) +{ + CVodeMem cv_mem; + + if (cvode_mem == NULL) return; + cv_mem = (CVodeMem) cvode_mem; + + if(SensMallocDone) { + if (stgr1alloc) { + free(ncfS1); ncfS1 = NULL; + free(ncfnS1); ncfnS1 = NULL; + free(nniS1); nniS1 = NULL; + stgr1alloc = FALSE; + } + cvSensFreeVectors(cv_mem); + SensMallocDone = FALSE; + sensi = FALSE; + } +} + +/* + * CVodeQuadSensFree + * + * CVodeQuadSensFree frees the problem memory in cvode_mem allocated + * for quadrature sensitivity analysis. Its only argument is the pointer + * cvode_mem returned by CVodeCreate. + */ + +void CVodeQuadSensFree(void *cvode_mem) +{ + CVodeMem cv_mem; + + if (cvode_mem == NULL) return; + cv_mem = (CVodeMem) cvode_mem; + + if(QuadSensMallocDone) { + cvQuadSensFreeVectors(cv_mem); + QuadSensMallocDone = FALSE; + quadr_sensi = FALSE; + } +} + + +/* + * ================================================================= + * PRIVATE FUNCTIONS + * ================================================================= + */ + +/* + * cvCheckNvector + * This routine checks if all required vector operations are present. + * If any of them is missing it returns FALSE. + */ + +static booleantype cvCheckNvector(N_Vector tmpl) +{ + if((tmpl->ops->nvclone == NULL) || + (tmpl->ops->nvdestroy == NULL) || + (tmpl->ops->nvlinearsum == NULL) || + (tmpl->ops->nvconst == NULL) || + (tmpl->ops->nvprod == NULL) || + (tmpl->ops->nvdiv == NULL) || + (tmpl->ops->nvscale == NULL) || + (tmpl->ops->nvabs == NULL) || + (tmpl->ops->nvinv == NULL) || + (tmpl->ops->nvaddconst == NULL) || + (tmpl->ops->nvmaxnorm == NULL) || + (tmpl->ops->nvwrmsnorm == NULL) || + (tmpl->ops->nvmin == NULL)) + return(FALSE); + else + return(TRUE); +} + +/* + * ----------------------------------------------------------------- + * Memory allocation/deallocation + * ----------------------------------------------------------------- + */ + +/* + * cvAllocVectors + * + * This routine allocates the CVODES vectors ewt, acor, tempv, ftemp, and + * zn[0], ..., zn[maxord]. + * If all memory allocations are successful, cvAllocVectors returns TRUE. + * Otherwise all allocated memory is freed and cvAllocVectors returns FALSE. + * This routine also sets the optional outputs lrw and liw, which are + * (respectively) the lengths of the real and integer work spaces + * allocated here. + */ + +static booleantype cvAllocVectors(CVodeMem cv_mem, N_Vector tmpl) +{ + int i, j; + + /* Allocate ewt, acor, tempv, ftemp */ + + ewt = N_VClone(tmpl); + if (ewt == NULL) return(FALSE); + + acor = N_VClone(tmpl); + if (acor == NULL) { + N_VDestroy(ewt); + return(FALSE); + } + + tempv = N_VClone(tmpl); + if (tempv == NULL) { + N_VDestroy(ewt); + N_VDestroy(acor); + return(FALSE); + } + + ftemp = N_VClone(tmpl); + if (ftemp == NULL) { + N_VDestroy(tempv); + N_VDestroy(ewt); + N_VDestroy(acor); + return(FALSE); + } + + /* Allocate zn[0] ... zn[qmax] */ + + for (j=0; j <= qmax; j++) { + zn[j] = N_VClone(tmpl); + if (zn[j] == NULL) { + N_VDestroy(ewt); + N_VDestroy(acor); + N_VDestroy(tempv); + N_VDestroy(ftemp); + for (i=0; i < j; i++) N_VDestroy(zn[i]); + return(FALSE); + } + } + + /* Update solver workspace lengths */ + lrw += (qmax + 5)*lrw1; + liw += (qmax + 5)*liw1; + + /* Store the value of qmax used here */ + cv_mem->cv_qmax_alloc = qmax; + + return(TRUE); +} + +/* + * cvFreeVectors + * + * This routine frees the CVODES vectors allocated in cvAllocVectors. + */ + +static void cvFreeVectors(CVodeMem cv_mem) +{ + int j, maxord; + + maxord = cv_mem->cv_qmax_alloc; + + N_VDestroy(ewt); + N_VDestroy(acor); + N_VDestroy(tempv); + N_VDestroy(ftemp); + for (j=0; j <= maxord; j++) + N_VDestroy(zn[j]); + + lrw -= (maxord + 5)*lrw1; + liw -= (maxord + 5)*liw1; + + if (cv_mem->cv_VabstolMallocDone) { + N_VDestroy(Vabstol); + lrw -= lrw1; + liw -= liw1; + } +} + +/* + * CVodeQuadAllocVectors + * + * NOTE: Space for ewtQ is allocated even when errconQ=FALSE, + * although in this case, ewtQ is never used. The reason for this + * decision is to allow the user to re-initialize the quadrature + * computation with errconQ=TRUE, after an initialization with + * errconQ=FALSE, without new memory allocation within + * CVodeQuadReInit. + */ + +static booleantype cvQuadAllocVectors(CVodeMem cv_mem, N_Vector tmpl) +{ + int i, j; + + /* Allocate ewtQ */ + ewtQ = N_VClone(tmpl); + if (ewtQ == NULL) { + return(FALSE); + } + + /* Allocate acorQ */ + acorQ = N_VClone(tmpl); + if (acorQ == NULL) { + N_VDestroy(ewtQ); + return(FALSE); + } + + /* Allocate yQ */ + yQ = N_VClone(tmpl); + if (yQ == NULL) { + N_VDestroy(ewtQ); + N_VDestroy(acorQ); + return(FALSE); + } + + /* Allocate tempvQ */ + tempvQ = N_VClone(tmpl); + if (tempvQ == NULL) { + N_VDestroy(ewtQ); + N_VDestroy(acorQ); + N_VDestroy(yQ); + return(FALSE); + } + + /* Allocate zQn[0] ... zQn[maxord] */ + + for (j=0; j <= qmax; j++) { + znQ[j] = N_VClone(tmpl); + if (znQ[j] == NULL) { + N_VDestroy(ewtQ); + N_VDestroy(acorQ); + N_VDestroy(yQ); + N_VDestroy(tempvQ); + for (i=0; i < j; i++) N_VDestroy(znQ[i]); + return(FALSE); + } + } + + /* Store the value of qmax used here */ + cv_mem->cv_qmax_allocQ = qmax; + + /* Update solver workspace lengths */ + lrw += (qmax + 5)*lrw1Q; + liw += (qmax + 5)*liw1Q; + + return(TRUE); +} + +/* + * cvQuadFreeVectors + * + * This routine frees the CVODES vectors allocated in cvQuadAllocVectors. + */ + +static void cvQuadFreeVectors(CVodeMem cv_mem) +{ + int j, maxord; + + maxord = cv_mem->cv_qmax_allocQ; + + N_VDestroy(ewtQ); + N_VDestroy(acorQ); + N_VDestroy(yQ); + N_VDestroy(tempvQ); + + for (j=0; j<=maxord; j++) N_VDestroy(znQ[j]); + + lrw -= (maxord + 5)*lrw1Q; + liw -= (maxord + 5)*liw1Q; + + if (cv_mem->cv_VabstolQMallocDone) { + N_VDestroy(VabstolQ); + lrw -= lrw1Q; + liw -= liw1Q; + } + + cv_mem->cv_VabstolQMallocDone = FALSE; +} + +/* + * cvSensAllocVectors + * + * Create (through duplication) N_Vectors used for sensitivity analysis, + * using the N_Vector 'tmpl' as a template. + */ + +static booleantype cvSensAllocVectors(CVodeMem cv_mem, N_Vector tmpl) +{ + int i, j; + + /* Allocate yS */ + yS = N_VCloneVectorArray(Ns, tmpl); + if (yS == NULL) { + return(FALSE); + } + + /* Allocate ewtS */ + ewtS = N_VCloneVectorArray(Ns, tmpl); + if (ewtS == NULL) { + N_VDestroyVectorArray(yS, Ns); + return(FALSE); + } + + /* Allocate acorS */ + acorS = N_VCloneVectorArray(Ns, tmpl); + if (acorS == NULL) { + N_VDestroyVectorArray(yS, Ns); + N_VDestroyVectorArray(ewtS, Ns); + return(FALSE); + } + + /* Allocate tempvS */ + tempvS = N_VCloneVectorArray(Ns, tmpl); + if (tempvS == NULL) { + N_VDestroyVectorArray(yS, Ns); + N_VDestroyVectorArray(ewtS, Ns); + N_VDestroyVectorArray(acorS, Ns); + return(FALSE); + } + + /* Allocate ftempS */ + ftempS = N_VCloneVectorArray(Ns, tmpl); + if (ftempS == NULL) { + N_VDestroyVectorArray(yS, Ns); + N_VDestroyVectorArray(ewtS, Ns); + N_VDestroyVectorArray(acorS, Ns); + N_VDestroyVectorArray(tempvS, Ns); + return(FALSE); + } + + /* Allocate znS */ + for (j=0; j<=qmax; j++) { + znS[j] = N_VCloneVectorArray(Ns, tmpl); + if (znS[j] == NULL) { + N_VDestroyVectorArray(yS, Ns); + N_VDestroyVectorArray(ewtS, Ns); + N_VDestroyVectorArray(acorS, Ns); + N_VDestroyVectorArray(tempvS, Ns); + N_VDestroyVectorArray(ftempS, Ns); + for (i=0; icv_qmax_allocS = qmax; + + return(TRUE); +} + +/* + * cvSensFreeVectors + * + * This routine frees the CVODES vectors allocated in cvSensAllocVectors. + */ + +static void cvSensFreeVectors(CVodeMem cv_mem) +{ + int j, maxord; + + maxord = cv_mem->cv_qmax_allocS; + + N_VDestroyVectorArray(yS, Ns); + N_VDestroyVectorArray(ewtS, Ns); + N_VDestroyVectorArray(acorS, Ns); + N_VDestroyVectorArray(tempvS, Ns); + N_VDestroyVectorArray(ftempS, Ns); + + for (j=0; j<=maxord; j++) N_VDestroyVectorArray(znS[j], Ns); + + free(pbar); pbar = NULL; + free(plist); plist = NULL; + + lrw -= (maxord + 6)*Ns*lrw1 + Ns; + liw -= (maxord + 6)*Ns*liw1 + Ns; + + if (cv_mem->cv_VabstolSMallocDone) { + N_VDestroyVectorArray(VabstolS, Ns); + lrw -= Ns*lrw1; + liw -= Ns*liw1; + } + if (cv_mem->cv_SabstolSMallocDone) { + free(SabstolS); SabstolS = NULL; + lrw -= Ns; + } + cv_mem->cv_VabstolSMallocDone = FALSE; + cv_mem->cv_SabstolSMallocDone = FALSE; +} + +/* + * cvQuadSensAllocVectors + * + * Create (through duplication) N_Vectors used for quadrature sensitivity analysis, + * using the N_Vector 'tmpl' as a template. + */ + +static booleantype cvQuadSensAllocVectors(CVodeMem cv_mem, N_Vector tmpl) +{ + int i, j; + + /* Allocate ftempQ */ + ftempQ = N_VClone(tmpl); + if (ftempQ == NULL) { + return(FALSE); + } + + /* Allocate yQS */ + yQS = N_VCloneVectorArray(Ns, tmpl); + if (yQS == NULL) { + N_VDestroy(ftempQ); + return(FALSE); + } + + /* Allocate ewtQS */ + ewtQS = N_VCloneVectorArray(Ns, tmpl); + if (ewtQS == NULL) { + N_VDestroy(ftempQ); + N_VDestroyVectorArray(yQS, Ns); + return(FALSE); + } + + /* Allocate acorQS */ + acorQS = N_VCloneVectorArray(Ns, tmpl); + if (acorQS == NULL) { + N_VDestroy(ftempQ); + N_VDestroyVectorArray(yQS, Ns); + N_VDestroyVectorArray(ewtQS, Ns); + return(FALSE); + } + + /* Allocate tempvQS */ + tempvQS = N_VCloneVectorArray(Ns, tmpl); + if (tempvQS == NULL) { + N_VDestroy(ftempQ); + N_VDestroyVectorArray(yQS, Ns); + N_VDestroyVectorArray(ewtQS, Ns); + N_VDestroyVectorArray(acorQS, Ns); + return(FALSE); + } + + /* Allocate znQS */ + for (j=0; j<=qmax; j++) { + znQS[j] = N_VCloneVectorArray(Ns, tmpl); + if (znQS[j] == NULL) { + N_VDestroy(ftempQ); + N_VDestroyVectorArray(yQS, Ns); + N_VDestroyVectorArray(ewtQS, Ns); + N_VDestroyVectorArray(acorQS, Ns); + N_VDestroyVectorArray(tempvQS, Ns); + for (i=0; icv_qmax_allocQS = qmax; + + return(TRUE); +} + +/* + * cvQuadSensFreeVectors + * + * This routine frees the CVODES vectors allocated in cvQuadSensAllocVectors. + */ + +static void cvQuadSensFreeVectors(CVodeMem cv_mem) +{ + int j, maxord; + + maxord = cv_mem->cv_qmax_allocQS; + + N_VDestroy(ftempQ); + + N_VDestroyVectorArray(yQS, Ns); + N_VDestroyVectorArray(ewtQS, Ns); + N_VDestroyVectorArray(acorQS, Ns); + N_VDestroyVectorArray(tempvQS, Ns); + + for (j=0; j<=maxord; j++) N_VDestroyVectorArray(znQS[j], Ns); + + lrw -= (maxord + 5)*Ns*lrw1Q; + liw -= (maxord + 5)*Ns*liw1Q; + + if (cv_mem->cv_VabstolQSMallocDone) { + N_VDestroyVectorArray(VabstolQS, Ns); + lrw -= Ns*lrw1Q; + liw -= Ns*liw1Q; + } + if (cv_mem->cv_SabstolQSMallocDone) { + free(SabstolQS); SabstolQS = NULL; + lrw -= Ns; + } + cv_mem->cv_VabstolQSMallocDone = FALSE; + cv_mem->cv_SabstolQSMallocDone = FALSE; + +} + + +/* + * ----------------------------------------------------------------- + * Initial stepsize calculation + * ----------------------------------------------------------------- + */ + +/* + * cvHin + * + * This routine computes a tentative initial step size h0. + * If tout is too close to tn (= t0), then cvHin returns CV_TOO_CLOSE + * and h remains uninitialized. Note that here tout is either the value + * passed to CVode at the first call or the value of tstop (if tstop is + * enabled and it is closer to t0=tn than tout). + * If any RHS function fails unrecoverably, cvHin returns CV_*RHSFUNC_FAIL. + * If any RHS function fails recoverably too many times and recovery is + * not possible, cvHin returns CV_REPTD_*RHSFUNC_ERR. + * Otherwise, cvHin sets h to the chosen value h0 and returns CV_SUCCESS. + * + * The algorithm used seeks to find h0 as a solution of + * (WRMS norm of (h0^2 ydd / 2)) = 1, + * where ydd = estimated second derivative of y. Here, y includes + * all variables considered in the error test. + * + * We start with an initial estimate equal to the geometric mean of the + * lower and upper bounds on the step size. + * + * Loop up to MAX_ITERS times to find h0. + * Stop if new and previous values differ by a factor < 2. + * Stop if hnew/hg > 2 after one iteration, as this probably means + * that the ydd value is bad because of cancellation error. + * + * For each new proposed hg, we allow MAX_ITERS attempts to + * resolve a possible recoverable failure from f() by reducing + * the proposed stepsize by a factor of 0.2. If a legal stepsize + * still cannot be found, fall back on a previous value if possible, + * or else return CV_REPTD_RHSFUNC_ERR. + * + * Finally, we apply a bias (0.5) and verify that h0 is within bounds. + */ + +static int cvHin(CVodeMem cv_mem, realtype tout) +{ + int retval, sign, count1, count2; + realtype tdiff, tdist, tround, hlb, hub; + realtype hg, hgs, hs, hnew, hrat, h0, yddnrm; + booleantype hgOK, hnewOK; + + /* If tout is too close to tn, give up */ + + if ((tdiff = tout-tn) == ZERO) return(CV_TOO_CLOSE); + + sign = (tdiff > ZERO) ? 1 : -1; + tdist = ABS(tdiff); + tround = uround * MAX(ABS(tn), ABS(tout)); + + if (tdist < TWO*tround) return(CV_TOO_CLOSE); + + /* + Set lower and upper bounds on h0, and take geometric mean + as first trial value. + Exit with this value if the bounds cross each other. + */ + + hlb = HLB_FACTOR * tround; + hub = cvUpperBoundH0(cv_mem, tdist); + + hg = RSqrt(hlb*hub); + + if (hub < hlb) { + if (sign == -1) h = -hg; + else h = hg; + return(CV_SUCCESS); + } + + /* Outer loop */ + + hnewOK = FALSE; + hs = hg; /* safeguard against 'uninitialized variable' warning */ + + for(count1 = 1; count1 <= MAX_ITERS; count1++) { + + /* Attempts to estimate ydd */ + + hgOK = FALSE; + + for (count2 = 1; count2 <= MAX_ITERS; count2++) { + hgs = hg*sign; + retval = cvYddNorm(cv_mem, hgs, &yddnrm); + /* If a RHS function failed unrecoverably, give up */ + if (retval < 0) return(retval); + /* If successful, we can use ydd */ + if (retval == CV_SUCCESS) {hgOK = TRUE; break;} + /* A RHS function failed recoverably; cut step size and test it again */ + hg *= POINT2; + } + + /* If a RHS function failed recoverably MAX_ITERS times */ + + if (!hgOK) { + /* Exit if this is the first or second pass. No recovery possible */ + if (count1 <= 2) + if (retval == RHSFUNC_RECVR) return(CV_REPTD_RHSFUNC_ERR); + if (retval == QRHSFUNC_RECVR) return(CV_REPTD_QRHSFUNC_ERR); + if (retval == SRHSFUNC_RECVR) return(CV_REPTD_SRHSFUNC_ERR); + /* We have a fall-back option. The value hs is a previous hnew which + passed through f(). Use it and break */ + hnew = hs; + break; + } + + /* The proposed step size is feasible. Save it. */ + hs = hg; + + /* If the stopping criteria was met, or if this is the last pass, stop */ + if ( (hnewOK) || (count1 == MAX_ITERS)) {hnew = hg; break;} + + /* Propose new step size */ + hnew = (yddnrm*hub*hub > TWO) ? RSqrt(TWO/yddnrm) : RSqrt(hg*hub); + hrat = hnew/hg; + + /* Accept hnew if it does not differ from hg by more than a factor of 2 */ + if ((hrat > HALF) && (hrat < TWO)) { + hnewOK = TRUE; + } + + /* After one pass, if ydd seems to be bad, use fall-back value. */ + if ((count1 > 1) && (hrat > TWO)) { + hnew = hg; + hnewOK = TRUE; + } + + /* Send this value back through f() */ + hg = hnew; + + } + + /* Apply bounds, bias factor, and attach sign */ + + h0 = H_BIAS*hnew; + if (h0 < hlb) h0 = hlb; + if (h0 > hub) h0 = hub; + if (sign == -1) h0 = -h0; + h = h0; + + return(CV_SUCCESS); +} + +/* + * cvUpperBoundH0 + * + * This routine sets an upper bound on abs(h0) based on + * tdist = tn - t0 and the values of y[i]/y'[i]. + */ + +static realtype cvUpperBoundH0(CVodeMem cv_mem, realtype tdist) +{ + realtype hub_inv, hubQ_inv, hubS_inv, hubQS_inv, hub; + N_Vector temp1, temp2; + N_Vector tempQ1, tempQ2; + N_Vector *tempS1; + N_Vector *tempQS1; + int is; + + /* + * Bound based on |y|/|y'| -- allow at most an increase of + * HUB_FACTOR in y0 (based on a forward Euler step). The weight + * factor is used as a safeguard against zero components in y0. + */ + + temp1 = tempv; + temp2 = acor; + + N_VAbs(zn[0], temp2); + efun(zn[0], temp1, e_data); + N_VInv(temp1, temp1); + N_VLinearSum(HUB_FACTOR, temp2, ONE, temp1, temp1); + + N_VAbs(zn[1], temp2); + + N_VDiv(temp2, temp1, temp1); + hub_inv = N_VMaxNorm(temp1); + + /* Bound based on |yQ|/|yQ'| */ + + if (quadr && errconQ) { + + tempQ1 = tempvQ; + tempQ2 = acorQ; + + N_VAbs(znQ[0], tempQ2); + cvQuadEwtSet(cv_mem, znQ[0], tempQ1); + N_VInv(tempQ1, tempQ1); + N_VLinearSum(HUB_FACTOR, tempQ2, ONE, tempQ1, tempQ1); + + N_VAbs(znQ[1], tempQ2); + + N_VDiv(tempQ2, tempQ1, tempQ1); + hubQ_inv = N_VMaxNorm(tempQ1); + + if (hubQ_inv > hub_inv) hub_inv = hubQ_inv; + + } + + /* Bound based on |yS|/|yS'| */ + + if (sensi && errconS) { + + tempS1 = acorS; + cvSensEwtSet(cv_mem, znS[0], tempS1); + + for (is=0; is hub_inv) hub_inv = hubS_inv; + + } + + } + + /* Bound based on |yQS|/|yQS'| */ + + if (quadr_sensi && errconQS) { + + tempQ1 = tempvQ; + tempQ2 = acorQ; + + tempQS1 = acorQS; + cvQuadSensEwtSet(cv_mem, znQS[0], tempQS1); + + for (is=0; is hub_inv) hub_inv = hubQS_inv; + + } + + } + + + /* + * bound based on tdist -- allow at most a step of magnitude + * HUB_FACTOR * tdist + */ + + hub = HUB_FACTOR*tdist; + + /* Use the smaler of the two */ + + if (hub*hub_inv > ONE) hub = ONE/hub_inv; + + return(hub); +} + +/* + * cvYddNorm + * + * This routine computes an estimate of the second derivative of Y + * using a difference quotient, and returns its WRMS norm. + * + * Y contains all variables included in the error test. + */ + +static int cvYddNorm(CVodeMem cv_mem, realtype hg, realtype *yddnrm) +{ + int retval, is; + N_Vector wrk1, wrk2; + + /* y <- h*y'(t) + y(t) */ + + N_VLinearSum(hg, zn[1], ONE, zn[0], y); + + if (sensi && errconS) + for (is=0; is 0) return(RHSFUNC_RECVR); + + if (quadr && errconQ) { + retval = fQ(tn+hg, y, tempvQ, user_data); + nfQe++; + if (retval < 0) return(CV_QRHSFUNC_FAIL); + if (retval > 0) return(QRHSFUNC_RECVR); + } + + if (sensi && errconS) { + wrk1 = ftemp; + wrk2 = acor; + retval = cvSensRhsWrapper(cv_mem, tn+hg, y, tempv, yS, tempvS, wrk1, wrk2); + if (retval < 0) return(CV_SRHSFUNC_FAIL); + if (retval > 0) return(SRHSFUNC_RECVR); + } + + if (quadr_sensi && errconQS) { + wrk1 = ftemp; + wrk2 = acorQ; + retval = fQS(Ns, tn+hg, y, yS, tempvQ, tempvQS, fQS_data, wrk1, wrk2); + + nfQSe++; + if (retval < 0) return(CV_QSRHSFUNC_FAIL); + if (retval > 0) return(QSRHSFUNC_RECVR); + } + + /* Load estimate of ||y''|| into tempv: + * tempv <- (1/h) * f(t+h, h*y'(t)+y(t)) - y'(t) */ + + N_VLinearSum(ONE, tempv, -ONE, zn[1], tempv); + N_VScale(ONE/hg, tempv, tempv); + *yddnrm = N_VWrmsNorm(tempv, ewt); + + if (quadr && errconQ) { + N_VLinearSum(ONE, tempvQ, -ONE, znQ[1], tempvQ); + N_VScale(ONE/hg, tempvQ, tempvQ); + *yddnrm = cvQuadUpdateNorm(cv_mem, *yddnrm, tempvQ, ewtQ); + } + + if (sensi && errconS) { + for (is=0; iscv_user_efun) e_data = user_data; + else e_data = cv_mem; + + /* Load intial error weights */ + ier = efun(zn[0], ewt, e_data); + if (ier != 0) { + if (itol == CV_WF) + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_EWT_FAIL); + else + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_BAD_EWT); + return(CV_ILL_INPUT); + } + + /* Quadrature initial setup */ + + if (quadr && errconQ) { + + /* Did the user specify tolerances? */ + if (itolQ == CV_NN) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_NO_TOLQ); + return(CV_ILL_INPUT); + } + + /* Load ewtQ */ + ier = cvQuadEwtSet(cv_mem, znQ[0], ewtQ); + if (ier != 0) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_BAD_EWTQ); + return(CV_ILL_INPUT); + } + + } + + if (!quadr) errconQ = FALSE; + + /* Forward sensitivity initial setup */ + + if (sensi) { + + /* Did the user specify tolerances? */ + if (itolS == CV_NN) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_NO_TOLS); + return(CV_ILL_INPUT); + } + + /* If using the internal DQ functions, we must have access to the problem parameters */ + if(fSDQ && (p == NULL)) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_NULL_P); + return(CV_ILL_INPUT); + } + + /* Load ewtS */ + ier = cvSensEwtSet(cv_mem, znS[0], ewtS); + if (ier != 0) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_BAD_EWTS); + return(CV_ILL_INPUT); + } + + } + + /* FSA of quadrature variables */ + + if (quadr_sensi) { + + /* If using the internal DQ functions, we must have access to fQ + * (i.e. quadrature integration must be enabled) and to the problem parameters */ + + if (fQSDQ) { + + /* Test if quadratures are defined, so we can use fQ */ + if (!quadr) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_NULL_FQ); + return(CV_ILL_INPUT); + } + + /* Test if we have the problem parameters */ + if(p == NULL) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_NULL_P); + return(CV_ILL_INPUT); + } + + } + + if (errconQS) { + + /* Did the user specify tolerances? */ + if (itolQS == CV_NN) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_NO_TOLQS); + return(CV_ILL_INPUT); + } + + /* If needed, did the user provide quadrature tolerances? */ + if ( (itolQS == CV_EE) && (itolQ == CV_NN) ) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_NO_TOLQ); + return(CV_ILL_INPUT); + } + + /* Load ewtQS */ + ier = cvQuadSensEwtSet(cv_mem, znQS[0], ewtQS); + if (ier != 0) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_BAD_EWTQS); + return(CV_ILL_INPUT); + } + + } + + } else { + + errconQS = FALSE; + + } + + /* Check if lsolve function exists (if needed) and call linit function (if it exists) */ + if (iter == CV_NEWTON) { + if (lsolve == NULL) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_LSOLVE_NULL); + return(CV_ILL_INPUT); + } + if (linit != NULL) { + ier = linit(cv_mem); + if (ier != 0) { + cvProcessError(cv_mem, CV_LINIT_FAIL, "CVODES", "CVode", MSGCV_LINIT_FAIL); + return(CV_LINIT_FAIL); + } + } + } + + return(CV_SUCCESS); +} + +/* + * cvEwtSet + * + * This routine is responsible for setting the error weight vector ewt, + * according to tol_type, as follows: + * + * (1) ewt[i] = 1 / (reltol * ABS(ycur[i]) + *abstol), i=0,...,neq-1 + * if tol_type = CV_SS + * (2) ewt[i] = 1 / (reltol * ABS(ycur[i]) + abstol[i]), i=0,...,neq-1 + * if tol_type = CV_SV + * + * cvEwtSet returns 0 if ewt is successfully set as above to a + * positive vector and -1 otherwise. In the latter case, ewt is + * considered undefined. + * + * All the real work is done in the routines cvEwtSetSS, cvEwtSetSV. + */ + +int cvEwtSet(N_Vector ycur, N_Vector weight, void *data) +{ + CVodeMem cv_mem; + int flag = 0; + + /* data points to cv_mem here */ + + cv_mem = (CVodeMem) data; + + switch(itol) { + case CV_SS: + flag = cvEwtSetSS(cv_mem, ycur, weight); + break; + case CV_SV: + flag = cvEwtSetSV(cv_mem, ycur, weight); + break; + } + + return(flag); +} + +/* + * cvEwtSetSS + * + * This routine sets ewt as decribed above in the case tol_type = CV_SS. + * It tests for non-positive components before inverting. cvEwtSetSS + * returns 0 if ewt is successfully set to a positive vector + * and -1 otherwise. In the latter case, ewt is considered undefined. + */ + +static int cvEwtSetSS(CVodeMem cv_mem, N_Vector ycur, N_Vector weight) +{ + N_VAbs(ycur, tempv); + N_VScale(reltol, tempv, tempv); + N_VAddConst(tempv, Sabstol, tempv); + if (N_VMin(tempv) <= ZERO) return(-1); + N_VInv(tempv, weight); + + return(0); +} + +/* + * cvEwtSetSV + * + * This routine sets ewt as decribed above in the case tol_type = CV_SV. + * It tests for non-positive components before inverting. cvEwtSetSV + * returns 0 if ewt is successfully set to a positive vector + * and -1 otherwise. In the latter case, ewt is considered undefined. + */ + +static int cvEwtSetSV(CVodeMem cv_mem, N_Vector ycur, N_Vector weight) +{ + N_VAbs(ycur, tempv); + N_VLinearSum(reltol, tempv, ONE, Vabstol, tempv); + if (N_VMin(tempv) <= ZERO) return(-1); + N_VInv(tempv, weight); + return(0); +} + +/* + * cvQuadEwtSet + * + */ + +static int cvQuadEwtSet(CVodeMem cv_mem, N_Vector qcur, N_Vector weightQ) +{ + int flag=0; + + switch (itolQ) { + case CV_SS: + flag = cvQuadEwtSetSS(cv_mem, qcur, weightQ); + break; + case CV_SV: + flag = cvQuadEwtSetSV(cv_mem, qcur, weightQ); + break; + } + + return(flag); + +} + +/* + * cvQuadEwtSetSS + * + */ + +static int cvQuadEwtSetSS(CVodeMem cv_mem, N_Vector qcur, N_Vector weightQ) +{ + N_VAbs(qcur, tempvQ); + N_VScale(reltolQ, tempvQ, tempvQ); + N_VAddConst(tempvQ, SabstolQ, tempvQ); + if (N_VMin(tempvQ) <= ZERO) return(-1); + N_VInv(tempvQ, weightQ); + + return(0); +} + +/* + * cvQuadEwtSetSV + * + */ + +static int cvQuadEwtSetSV(CVodeMem cv_mem, N_Vector qcur, N_Vector weightQ) +{ + N_VAbs(qcur, tempvQ); + N_VLinearSum(reltolQ, tempvQ, ONE, VabstolQ, tempvQ); + if (N_VMin(tempvQ) <= ZERO) return(-1); + N_VInv(tempvQ, weightQ); + + return(0); +} + +/* + * cvSensEwtSet + * + */ + +static int cvSensEwtSet(CVodeMem cv_mem, N_Vector *yScur, N_Vector *weightS) +{ + int flag=0; + + switch (itolS) { + case CV_EE: + flag = cvSensEwtSetEE(cv_mem, yScur, weightS); + break; + case CV_SS: + flag = cvSensEwtSetSS(cv_mem, yScur, weightS); + break; + case CV_SV: + flag = cvSensEwtSetSV(cv_mem, yScur, weightS); + break; + } + + return(flag); +} + +/* + * cvSensEwtSetEE + * + * In this case, the error weight vector for the i-th sensitivity is set to + * + * ewtS_i = pbar_i * efun(pbar_i*yS_i) + * + * In other words, the scaled sensitivity pbar_i * yS_i has the same error + * weight vector calculation as the solution vector. + * + */ + +static int cvSensEwtSetEE(CVodeMem cv_mem, N_Vector *yScur, N_Vector *weightS) +{ + int is; + N_Vector pyS; + int flag; + + /* Use tempvS[0] as temporary storage for the scaled sensitivity */ + pyS = tempvS[0]; + + for (is=0; is 0) && (hprime != h)) cvAdjustParams(cv_mem); + + /* Looping point for attempts to take a step */ + + saved_t = tn; + nflag = FIRST_CALL; + + loop { + + cvPredict(cv_mem); + cvSet(cv_mem); + + /* ------ Correct state variables ------ */ + + nflag = cvNls(cv_mem, nflag); + kflag = cvHandleNFlag(cv_mem, &nflag, saved_t, &ncf, &ncfn); + + /* Go back in loop if we need to predict again (nflag=PREV_CONV_FAIL) */ + if (kflag == PREDICT_AGAIN) continue; + + /* Return if nonlinear solve failed and recovery not possible. */ + if (kflag != DO_ERROR_TEST) return(kflag); + + /* Perform error test (nflag=CV_SUCCESS) */ + eflag = cvDoErrorTest(cv_mem, &nflag, saved_t, acnrm, &nef, &netf, &dsm); + + /* Go back in loop if we need to predict again (nflag=PREV_ERR_FAIL) */ + if (eflag == TRY_AGAIN) continue; + + /* Return if error test failed and recovery not possible. */ + if (eflag != CV_SUCCESS) return(eflag); + + /* Error test passed (eflag=CV_SUCCESS, nflag=CV_SUCCESS), go on */ + + /* ------ Correct the quadrature variables ------ */ + + if (quadr) { + + ncf = nef = 0; /* reset counters for states */ + + nflag = cvQuadNls(cv_mem); + kflag = cvHandleNFlag(cv_mem, &nflag, saved_t, &ncf, &ncfn); + + if (kflag == PREDICT_AGAIN) continue; + if (kflag != DO_ERROR_TEST) return(kflag); + + /* Error test on quadratures */ + if (errconQ) { + acnrmQ = N_VWrmsNorm(acorQ, ewtQ); + eflag = cvDoErrorTest(cv_mem, &nflag, saved_t, acnrmQ, &nefQ, &netfQ, &dsmQ); + + if (eflag == TRY_AGAIN) continue; + if (eflag != CV_SUCCESS) return(eflag); + + /* Set dsm = max(dsm, dsmQ) to be used in cvPrepareNextStep */ + if (dsmQ > dsm) dsm = dsmQ; + } + + } + + /* ------ Correct the sensitivity variables (STAGGERED or STAGGERED1) ------- */ + + if (do_sensi_stg || do_sensi_stg1) { + + ncf = nef = 0; /* reset counters for states */ + if (quadr) nefQ = 0; /* reset counter for quadratures */ + + /* Evaluate f at converged y, needed for future evaluations of sens. RHS + * If f() fails recoverably, treat it as a convergence failure and + * attempt the step again */ + + retval = f(tn, y, ftemp, user_data); + nfe++; + if (retval < 0) return(CV_RHSFUNC_FAIL); + if (retval > 0) { + nflag = PREV_CONV_FAIL; + continue; + } + + if (do_sensi_stg) { + /* Nonlinear solve for sensitivities (all-at-once) */ + nflag = cvStgrNls(cv_mem); + kflag = cvHandleNFlag(cv_mem, &nflag, saved_t, &ncfS, &ncfnS); + } else { + /* Nonlinear solve for sensitivities (one-by-one) */ + for (is=0; is dsm) dsm = dsmS; + + } + + } + + /* ------ Correct the quadrature sensitivity variables ------ */ + + if (quadr_sensi) { + + /* Reset local convergence and error test failure counters */ + ncf = nef = 0; + if (quadr) nefQ = 0; + if (do_sensi_stg) ncfS = nefS = 0; + if (do_sensi_stg1) { + for (is=0; is dsm) dsm = dsmQS; + } + + + } + + + /* Everything went fine; exit loop */ + break; + + } + + /* Nonlinear system solve and error test were both successful. + Update data, and consider change of step and/or order. */ + + cvCompleteStep(cv_mem); + + cvPrepareNextStep(cv_mem, dsm); + + /* If Stablilty Limit Detection is turned on, call stability limit + detection routine for possible order reduction. */ + + if (sldeton) cvBDFStab(cv_mem); + + etamax = (nst <= SMALL_NST) ? ETAMX2 : ETAMX3; + + /* Finally, we rescale the acor array to be the + estimated local error vector. */ + + N_VScale(tq[2], acor, acor); + + if (quadr) + N_VScale(tq[2], acorQ, acorQ); + + if (sensi) + for (is=0; is xi_0 = 0 + */ + + for (i=0; i <= qmax; i++) l[i] = ZERO; + l[1] = ONE; + hsum = ZERO; + for (j=1; j <= q-2; j++) { + hsum += tau[j]; + xi = hsum / hscale; + for (i=j+1; i >= 1; i--) l[i] = l[i]*xi + l[i-1]; + } + + for (j=1; j <= q-2; j++) l[j+1] = q * (l[j] / (j+1)); + + for (j=2; j < q; j++) + N_VLinearSum(-l[j], zn[q], ONE, zn[j], zn[j]); + + if (quadr) + for (j=2; j < q; j++) + N_VLinearSum(-l[j], znQ[q], ONE, znQ[j], znQ[j]); + + if (sensi) + for (is=0; is 1) { + for (j=1; j < q; j++) { + hsum += tau[j+1]; + xi = hsum / hscale; + prod *= xi; + alpha0 -= ONE / (j+1); + alpha1 += ONE / xi; + for (i=j+2; i >= 2; i--) l[i] = l[i]*xiold + l[i-1]; + xiold = xi; + } + } + A1 = (-alpha0 - alpha1) / prod; + + /* + zn[indx_acor] contains the value Delta_n = y_n - y_n(0) + This value was stored there at the previous successful + step (in cvCompleteStep) + + A1 contains dbar = (1/xi* - 1/xi_q)/prod(xi_j) + */ + + N_VScale(A1, zn[indx_acor], zn[L]); + for (j=2; j <= q; j++) + N_VLinearSum(l[j], zn[L], ONE, zn[j], zn[j]); + + if (quadr) { + N_VScale(A1, znQ[indx_acor], znQ[L]); + for (j=2; j <= q; j++) + N_VLinearSum(l[j], znQ[L], ONE, znQ[j], znQ[j]); + } + + if (sensi) { + for (is=0; is= 2; i--) l[i] = l[i]*xi + l[i-1]; + } + + for (j=2; j < q; j++) + N_VLinearSum(-l[j], zn[q], ONE, zn[j], zn[j]); + + if (quadr) { + for (j=2; j < q; j++) + N_VLinearSum(-l[j], znQ[q], ONE, znQ[j], znQ[j]); + } + + if (sensi) { + for (is=0; is ZERO) tn = tstop; + } + + for (k = 1; k <= q; k++) + for (j = q; j >= k; j--) + N_VLinearSum(ONE, zn[j-1], ONE, zn[j], zn[j-1]); + + if (quadr) { + for (k = 1; k <= q; k++) + for (j = q; j >= k; j--) + N_VLinearSum(ONE, znQ[j-1], ONE, znQ[j], znQ[j-1]); + } + + if (sensi) { + for (is=0; is= k; j--) + N_VLinearSum(ONE, znS[j-1][is], ONE, znS[j][is], znS[j-1][is]); + } + } + + if (quadr_sensi) { + for (is=0; is= k; j--) + N_VLinearSum(ONE, znQS[j-1][is], ONE, znQS[j][is], znQS[j-1][is]); + } + } + +} + +/* + * cvSet + * + * This routine is a high level routine which calls cvSetAdams or + * cvSetBDF to set the polynomial l, the test quantity array tq, + * and the related variables rl1, gamma, and gamrat. + * + * The array tq is loaded with constants used in the control of estimated + * local errors and in the nonlinear convergence test. Specifically, while + * running at order q, the components of tq are as follows: + * tq[1] = a coefficient used to get the est. local error at order q-1 + * tq[2] = a coefficient used to get the est. local error at order q + * tq[3] = a coefficient used to get the est. local error at order q+1 + * tq[4] = constant used in nonlinear iteration convergence test + * tq[5] = coefficient used to get the order q+2 derivative vector used in + * the est. local error at order q+1 + */ + +static void cvSet(CVodeMem cv_mem) +{ + switch(lmm) { + case CV_ADAMS: + cvSetAdams(cv_mem); + break; + case CV_BDF: + cvSetBDF(cv_mem); + break; + } + rl1 = ONE / l[1]; + gamma = h * rl1; + if (nst == 0) gammap = gamma; + gamrat = (nst > 0) ? gamma / gammap : ONE; /* protect x / x != 1.0 */ +} + +/* + * cvSetAdams + * + * This routine handles the computation of l and tq for the + * case lmm == CV_ADAMS. + * + * The components of the array l are the coefficients of a + * polynomial Lambda(x) = l_0 + l_1 x + ... + l_q x^q, given by + * q-1 + * (d/dx) Lambda(x) = c * PRODUCT (1 + x / xi_i) , where + * i=1 + * Lambda(-1) = 0, Lambda(0) = 1, and c is a normalization factor. + * Here xi_i = [t_n - t_(n-i)] / h. + * + * The array tq is set to test quantities used in the convergence + * test, the error test, and the selection of h at a new order. + */ + +static void cvSetAdams(CVodeMem cv_mem) +{ + realtype m[L_MAX], M[3], hsum; + + if (q == 1) { + l[0] = l[1] = tq[1] = tq[5] = ONE; + tq[2] = HALF; + tq[3] = ONE/TWELVE; + tq[4] = nlscoef / tq[2]; /* = 0.1 / tq[2] */ + return; + } + + hsum = cvAdamsStart(cv_mem, m); + + M[0] = cvAltSum(q-1, m, 1); + M[1] = cvAltSum(q-1, m, 2); + + cvAdamsFinish(cv_mem, m, M, hsum); +} + +/* + * cvAdamsStart + * + * This routine generates in m[] the coefficients of the product + * polynomial needed for the Adams l and tq coefficients for q > 1. + */ + +static realtype cvAdamsStart(CVodeMem cv_mem, realtype m[]) +{ + realtype hsum, xi_inv, sum; + int i, j; + + hsum = h; + m[0] = ONE; + for (i=1; i <= q; i++) m[i] = ZERO; + for (j=1; j < q; j++) { + if ((j==q-1) && (qwait == 1)) { + sum = cvAltSum(q-2, m, 2); + tq[1] = q * sum / m[q-2]; + } + xi_inv = h / hsum; + for (i=j; i >= 1; i--) m[i] += m[i-1] * xi_inv; + hsum += tau[j]; + /* The m[i] are coefficients of product(1 to j) (1 + x/xi_i) */ + } + return(hsum); +} + +/* + * cvAdamsFinish + * + * This routine completes the calculation of the Adams l and tq. + */ + +static void cvAdamsFinish(CVodeMem cv_mem, realtype m[], realtype M[], realtype hsum) +{ + int i; + realtype M0_inv, xi, xi_inv; + + M0_inv = ONE / M[0]; + + l[0] = ONE; + for (i=1; i <= q; i++) l[i] = M0_inv * (m[i-1] / i); + xi = hsum / h; + xi_inv = ONE / xi; + + tq[2] = M[1] * M0_inv / xi; + tq[5] = xi / l[q]; + + if (qwait == 1) { + for (i=q; i >= 1; i--) m[i] += m[i-1] * xi_inv; + M[2] = cvAltSum(q, m, 2); + tq[3] = M[2] * M0_inv / L; + } + + tq[4] = nlscoef / tq[2]; +} + +/* + * cvAltSum + * + * cvAltSum returns the value of the alternating sum + * sum (i= 0 ... iend) [ (-1)^i * (a[i] / (i + k)) ]. + * If iend < 0 then cvAltSum returns 0. + * This operation is needed to compute the integral, from -1 to 0, + * of a polynomial x^(k-1) M(x) given the coefficients of M(x). + */ + +static realtype cvAltSum(int iend, realtype a[], int k) +{ + int i, sign; + realtype sum; + + if (iend < 0) return(ZERO); + + sum = ZERO; + sign = 1; + for (i=0; i <= iend; i++) { + sum += sign * (a[i] / (i+k)); + sign = -sign; + } + return(sum); +} + +/* + * cvSetBDF + * + * This routine computes the coefficients l and tq in the case + * lmm == CV_BDF. cvSetBDF calls cvSetTqBDF to set the test + * quantity array tq. + * + * The components of the array l are the coefficients of a + * polynomial Lambda(x) = l_0 + l_1 x + ... + l_q x^q, given by + * q-1 + * Lambda(x) = (1 + x / xi*_q) * PRODUCT (1 + x / xi_i) , where + * i=1 + * xi_i = [t_n - t_(n-i)] / h. + * + * The array tq is set to test quantities used in the convergence + * test, the error test, and the selection of h at a new order. + */ + +static void cvSetBDF(CVodeMem cv_mem) +{ + realtype alpha0, alpha0_hat, xi_inv, xistar_inv, hsum; + int i,j; + + l[0] = l[1] = xi_inv = xistar_inv = ONE; + for (i=2; i <= q; i++) l[i] = ZERO; + alpha0 = alpha0_hat = -ONE; + hsum = h; + if (q > 1) { + for (j=2; j < q; j++) { + hsum += tau[j-1]; + xi_inv = h / hsum; + alpha0 -= ONE / j; + for (i=j; i >= 1; i--) l[i] += l[i-1]*xi_inv; + /* The l[i] are coefficients of product(1 to j) (1 + x/xi_i) */ + } + + /* j = q */ + alpha0 -= ONE / q; + xistar_inv = -l[1] - alpha0; + hsum += tau[q-1]; + xi_inv = h / hsum; + alpha0_hat = -l[1] - xi_inv; + for (i=q; i >= 1; i--) l[i] += l[i-1]*xistar_inv; + } + + cvSetTqBDF(cv_mem, hsum, alpha0, alpha0_hat, xi_inv, xistar_inv); +} + +/* + * cvSetTqBDF + * + * This routine sets the test quantity array tq in the case + * lmm == CV_BDF. + */ + +static void cvSetTqBDF(CVodeMem cv_mem, realtype hsum, realtype alpha0, + realtype alpha0_hat, realtype xi_inv, realtype xistar_inv) +{ + realtype A1, A2, A3, A4, A5, A6; + realtype C, Cpinv, Cppinv; + + A1 = ONE - alpha0_hat + alpha0; + A2 = ONE + q * A1; + tq[2] = ABS(A1 / (alpha0 * A2)); + tq[5] = ABS(A2 * xistar_inv / (l[q] * xi_inv)); + if (qwait == 1) { + C = xistar_inv / l[q]; + A3 = alpha0 + ONE / q; + A4 = alpha0_hat + xi_inv; + Cpinv = (ONE - A4 + A3) / A3; + tq[1] = ABS(C * Cpinv); + hsum += tau[q]; + xi_inv = h / hsum; + A5 = alpha0 - (ONE / (q+1)); + A6 = alpha0_hat - xi_inv; + Cppinv = (ONE - A6 + A5) / A2; + tq[3] = ABS(Cppinv / (xi_inv * (q+2) * A5)); + } + tq[4] = nlscoef / tq[2]; +} + +/* + * ----------------------------------------------------------------- + * Nonlinear solver functions + * ----------------------------------------------------------------- + */ + +/* + * cvNls + * + * This routine attempts to solve the nonlinear system associated + * with a single implicit step of the linear multistep method. + * Depending on iter, it calls cvNlsFunctional or cvNlsNewton + * to do the work. + */ + +static int cvNls(CVodeMem cv_mem, int nflag) +{ + int flag=CV_SUCCESS; + + switch(iter) { + case CV_FUNCTIONAL: + flag = cvNlsFunctional(cv_mem); + break; + case CV_NEWTON: + flag = cvNlsNewton(cv_mem, nflag); + break; + } + + return(flag); + +} + +/* + * cvNlsFunctional + * + * This routine attempts to solve the nonlinear system using + * functional iteration (no matrices involved). + * + * This routine also handles the functional iteration of the + * combined system (states + sensitivities) when sensitivities are + * computed using the CV_SIMULTANEOUS approach. + * + * Possible return values are: + * + * CV_SUCCESS ---> continue with error test + * + * CV_RHSFUNC_FAIL -+ + * CV_SRHSFUNC_FAIL -+-> halt the integration + * + * CONV_FAIL -+ + * RHSFUNC_RECVR |-> predict again or stop if too many + * SRHSFUNC_RECVR -+ + * + */ + +static int cvNlsFunctional(CVodeMem cv_mem) +{ + int m; + realtype del, delS, Del, Delp, dcon; + int retval, is; + booleantype do_sensi_sim; + N_Vector wrk1, wrk2; + + /* Are we computing sensitivities with the CV_SIMULTANEOUS approach? */ + do_sensi_sim = (sensi && (ism==CV_SIMULTANEOUS)); + + /* Initialize counter and evaluate f at predicted y */ + crate = ONE; + m = 0; + + /* Initialize delS and Delp to avoid compiler warning message */ + delS = Delp = ZERO; + + retval = f(tn, zn[0], tempv, user_data); + nfe++; + if (retval < 0) return(CV_RHSFUNC_FAIL); + if (retval > 0) return(RHSFUNC_RECVR); + + if (do_sensi_sim) { + wrk1 = ftemp; + wrk2 = ftempS[0]; + retval = cvSensRhsWrapper(cv_mem, tn, zn[0], tempv, znS[0], tempvS, wrk1, wrk2); + if (retval < 0) return(CV_SRHSFUNC_FAIL); + if (retval > 0) return(SRHSFUNC_RECVR); + } + + /* Initialize correction to zero */ + + N_VConst(ZERO, acor); + if (do_sensi_sim) { + for (is=0; is 0, an estimate of the convergence + rate constant is stored in crate, and used in the test. + + Recall that, even when errconS=FALSE, all variables are used in the + convergence test. Hence, we use Del (and not del). However, acnrm + is used in the error test and thus it has different forms + depending on errconS (and this explains why we have to carry around + del and delS) + */ + + Del = (do_sensi_sim) ? delS : del; + if (m > 0) crate = MAX(CRDOWN * crate, Del / Delp); + dcon = Del * MIN(ONE, crate) / tq[4]; + + if (dcon <= ONE) { + if (m == 0) + if (do_sensi_sim && errconS) acnrm = delS; + else acnrm = del; + else { + acnrm = N_VWrmsNorm(acor, ewt); + if (do_sensi_sim && errconS) + acnrm = cvSensUpdateNorm(cv_mem, acnrm, acorS, ewtS); + } + return(CV_SUCCESS); /* Convergence achieved */ + } + + /* Stop at maxcor iterations or if iter. seems to be diverging */ + + m++; + if ((m==maxcor) || ((m >= 2) && (Del > RDIV * Delp))) return(CONV_FAIL); + + /* Save norm of correction, evaluate f, and loop again */ + + Delp = Del; + + retval = f(tn, y, tempv, user_data); + nfe++; + if (retval < 0) return(CV_RHSFUNC_FAIL); + if (retval > 0) return(RHSFUNC_RECVR); + + if (do_sensi_sim) { + wrk1 = ftemp; + wrk2 = ftempS[0]; + retval = cvSensRhsWrapper(cv_mem, tn, y, tempv, yS, tempvS, wrk1, wrk2); + if (retval < 0) return(CV_SRHSFUNC_FAIL); + if (retval > 0) return(SRHSFUNC_RECVR); + } + + } /* end loop */ + +} + +/* + * cvNlsNewton + * + * This routine handles the Newton iteration. It calls lsetup if + * indicated, calls cvNewtonIteration to perform the iteration, and + * retries a failed attempt at Newton iteration if that is indicated. + * See return values at top of this file. + * + * This routine also handles the Newton iteration of the combined + * system when sensitivities are computed using the CV_SIMULTANEOUS + * approach. Since in that case we use a quasi-Newton on the + * combined system (by approximating the Jacobian matrix by its + * block diagonal) and thus only solve linear systems with + * multiple right hand sides (all sharing the same coefficient + * matrix - whatever iteration matrix we decide on) we set-up + * the linear solver to handle N equations at a time. + * + * Possible return values: + * + * CV_SUCCESS ---> continue with error test + * + * CV_RHSFUNC_FAIL -+ + * CV_LSETUP_FAIL | + * CV_LSOLVE_FAIL |-> halt the integration + * CV_SRHSFUNC_FAIL -+ + * + * CONV_FAIL -+ + * RHSFUNC_RECVR |-> predict again or stop if too many + * SRHSFUNC_RECVR -+ + * + */ + +static int cvNlsNewton(CVodeMem cv_mem, int nflag) +{ + N_Vector vtemp1, vtemp2, vtemp3, wrk1, wrk2; + int convfail, ier; + booleantype callSetup, do_sensi_sim; + int retval, is; + + /* Are we computing sensitivities with the CV_SIMULTANEOUS approach? */ + do_sensi_sim = (sensi && (ism==CV_SIMULTANEOUS)); + + vtemp1 = acor; /* rename acor as vtemp1 for readability */ + vtemp2 = y; /* rename y as vtemp2 for readability */ + vtemp3 = tempv; /* rename tempv as vtemp3 for readability */ + + /* Set flag convfail, input to lsetup for its evaluation decision */ + convfail = ((nflag == FIRST_CALL) || (nflag == PREV_ERR_FAIL)) ? + CV_NO_FAILURES : CV_FAIL_OTHER; + + /* Decide whether or not to call setup routine (if one exists) */ + if (setupNonNull) { + callSetup = (nflag == PREV_CONV_FAIL) || (nflag == PREV_ERR_FAIL) || + (nst == 0) || (nst >= nstlp + MSBP) || (ABS(gamrat-ONE) > DGMAX); + + /* Decide whether to force a call to setup */ + if (forceSetup) { + callSetup = TRUE; + convfail = CV_FAIL_OTHER; + } + + } else { + crate = ONE; + crateS = ONE; /* if NO lsetup all conv. rates are set to ONE */ + callSetup = FALSE; + } + + /* Looping point for the solution of the nonlinear system. + Evaluate f at the predicted y, call lsetup if indicated, and + call cvNewtonIteration for the Newton iteration itself. */ + + loop { + + retval = f(tn, zn[0], ftemp, user_data); + nfe++; + if (retval < 0) return(CV_RHSFUNC_FAIL); + if (retval > 0) return(RHSFUNC_RECVR); + + if (do_sensi_sim) { + wrk1 = tempv; + wrk2 = tempvS[0]; + retval = cvSensRhsWrapper(cv_mem, tn, zn[0], ftemp, znS[0], ftempS, wrk1, wrk2); + if (retval < 0) return(CV_SRHSFUNC_FAIL); + if (retval > 0) return(SRHSFUNC_RECVR); + } + + if (callSetup) { + ier = lsetup(cv_mem, convfail, zn[0], ftemp, &jcur, + vtemp1, vtemp2, vtemp3); + nsetups++; + callSetup = FALSE; + forceSetup = FALSE; + gamrat = ONE; + gammap = gamma; + crate = ONE; + crateS = ONE; /* after lsetup all conv. rates are reset to ONE */ + nstlp = nst; + /* Return if lsetup failed */ + if (ier < 0) return(CV_LSETUP_FAIL); + if (ier > 0) return(CONV_FAIL); + } + + /* Set acor to zero and load prediction into y vector */ + N_VConst(ZERO, acor); + N_VScale(ONE, zn[0], y); + + if (do_sensi_sim) + for (is=0; is 0) { + if ((!jcur) && (setupNonNull)) return(TRY_AGAIN); + else return(CONV_FAIL); + } + + /* Solve the sensitivity linear systems and do the same + tests on the return value of lsolve. */ + + if (do_sensi_sim) { + + for (is=0; is 0) { + if ((!jcur) && (setupNonNull)) return(TRY_AGAIN); + else return(CONV_FAIL); + } + } + } + + /* Get WRMS norm of correction; add correction to acor and y */ + + del = N_VWrmsNorm(b, ewt); + N_VLinearSum(ONE, acor, ONE, b, acor); + N_VLinearSum(ONE, zn[0], ONE, acor, y); + + if (do_sensi_sim) { + delS = cvSensUpdateNorm(cv_mem, del, bS, ewtS); + for (is=0; is 0, an estimate of the convergence + rate constant is stored in crate, and used in the test. */ + + Del = (do_sensi_sim) ? delS : del; + if (m > 0) crate = MAX(CRDOWN * crate, Del/Delp); + dcon = Del * MIN(ONE, crate) / tq[4]; + + if (dcon <= ONE) { + if (m == 0) + if (do_sensi_sim && errconS) acnrm = delS; + else acnrm = del; + else { + acnrm = N_VWrmsNorm(acor, ewt); + if (do_sensi_sim && errconS) + acnrm = cvSensUpdateNorm(cv_mem, acnrm, acorS, ewtS); + } + jcur = FALSE; + return(CV_SUCCESS); /* Convergence achieved */ + } + + mnewt = ++m; + + /* Stop at maxcor iterations or if iter. seems to be diverging. + If still not converged and Jacobian data is not current, + signal to try the solution again */ + if ((m == maxcor) || ((m >= 2) && (Del > RDIV * Delp))) { + if ((!jcur) && (setupNonNull)) return(TRY_AGAIN); + else return(CONV_FAIL); + } + + /* Save norm of correction, evaluate f, and loop again */ + Delp = Del; + retval = f(tn, y, ftemp, user_data); + nfe++; + if (retval < 0) return(CV_RHSFUNC_FAIL); + if (retval > 0) { + if ((!jcur) && (setupNonNull)) return(TRY_AGAIN); + else return(RHSFUNC_RECVR); + } + + if (do_sensi_sim) { + wrk1 = tempv; + wrk2 = tempvS[0]; + retval = cvSensRhsWrapper(cv_mem, tn, y, ftemp, yS, ftempS, wrk1, wrk2); + if (retval < 0) return(CV_SRHSFUNC_FAIL); + if (retval > 0) { + if ((!jcur) && (setupNonNull)) return(TRY_AGAIN); + else return(SRHSFUNC_RECVR); + } + } + + } /* end loop */ + +} + +/* + * cvQuadNls + * + * This routine solves for the quadrature variables at the new step. + * It does not solve a nonlinear system, but rather updates the + * quadrature variables. The name for this function is just for + * uniformity purposes. + * + * Possible return values (interpreted by cvHandleNFlag) + * + * CV_SUCCESS -> continue with error test + * CV_QRHSFUNC_FAIL -> halt the integration + * QRHSFUNC_RECVR -> predict again or stop if too many + * + */ + +static int cvQuadNls(CVodeMem cv_mem) +{ + int retval; + + /* Save quadrature correction in acorQ */ + retval = fQ(tn, y, acorQ, user_data); + nfQe++; + if (retval < 0) return(CV_QRHSFUNC_FAIL); + if (retval > 0) return(QRHSFUNC_RECVR); + + /* If needed, save the value of yQdot = fQ into ftempQ + * for use in evaluating fQS */ + if (quadr_sensi) { + N_VScale(ONE, acorQ, ftempQ); + } + + N_VLinearSum(h, acorQ, -ONE, znQ[1], acorQ); + N_VScale(rl1, acorQ, acorQ); + + /* Apply correction to quadrature variables */ + N_VLinearSum(ONE, znQ[0], ONE, acorQ, yQ); + + return(CV_SUCCESS); +} + +/* + * cvQuadSensNls + * + * This routine solves for the quadrature sensitivity variables + * at the new step. It does not solve a nonlinear system, but + * rather updates the quadrature variables. The name for this + * function is just for uniformity purposes. + * + * Possible return values (interpreted by cvHandleNFlag) + * + * CV_SUCCESS -> continue with error test + * CV_QSRHSFUNC_FAIL -> halt the integration + * QSRHSFUNC_RECVR -> predict again or stop if too many + * + */ + +static int cvQuadSensNls(CVodeMem cv_mem) +{ + int is, retval; + + /* Save quadrature correction in acorQ */ + retval = fQS(Ns, tn, y, yS, ftempQ, acorQS, user_data, tempv, tempvQ); + nfQSe++; + if (retval < 0) return(CV_QSRHSFUNC_FAIL); + if (retval > 0) return(QSRHSFUNC_RECVR); + + + for (is=0; is 0) return(SRHSFUNC_RECVR); + + /* Initialize correction to zero */ + for (is=0; is 0, an estimate of the convergence + rate constant is stored in crateS, and used in the test. + acnrmS contains the norm of the corrections (yS_n-yS_n(0)) and + will be used in the error test (if errconS==TRUE) */ + if (m > 0) crateS = MAX(CRDOWN * crateS, Del / Delp); + dcon = Del * MIN(ONE, crateS) / tq[4]; + + if (dcon <= ONE) { + if (errconS) + acnrmS = (m==0)? Del : cvSensNorm(cv_mem, acorS, ewtS); + return(CV_SUCCESS); /* Convergence achieved */ + } + + /* Stop at maxcor iterations or if iter. seems to be diverging */ + m++; + if ((m==maxcorS) || ((m >= 2) && (Del > RDIV * Delp))) return(CONV_FAIL); + + /* Save norm of correction, evaluate f, and loop again */ + Delp = Del; + + wrk1 = tempv; + wrk2 = ftempS[0]; + retval = cvSensRhsWrapper(cv_mem, tn, y, ftemp, yS, tempvS, wrk1, wrk2); + if (retval < 0) return(CV_SRHSFUNC_FAIL); + if (retval > 0) return(SRHSFUNC_RECVR); + + } /* end loop */ + +} + +/* + * cvStgrNlsNewton + * + * This routine attempts to solve the sensitivity linear systems using + * Newton iteration. It calls cvStgrNlsNewton to perform the actual + * iteration. If the Newton iteration fails with out-of-date Jacobian + * data (ier=TRY_AGAIN), it calls lsetup and retries the Newton iteration. + * This second try is unlikely to happen when using a Krylov linear solver. + * + * Possible return values: + * + * CV_SUCCESS + * + * CV_LSOLVE_FAIL -+ + * CV_LSETUP_FAIL | + * CV_SRHSFUNC_FAIL -+ + * + * CONV_FAIL -+ + * SRHSFUNC_RECVR -+ + */ + +static int cvStgrNlsNewton(CVodeMem cv_mem) +{ + int retval, is; + int convfail, ier; + N_Vector vtemp1, vtemp2, vtemp3, wrk1, wrk2; + + loop { + + /* Set acorS to zero and load prediction into yS vector */ + for (is=0; is 0) return(SRHSFUNC_RECVR); + + /* Do the Newton iteration */ + ier = cvStgrNewtonIteration(cv_mem); + + /* If the solve was successful (ier=CV_SUCCESS) or if an error + that cannot be fixed by a call to lsetup occured + (ier = CV_LSOLVE_FAIL or CONV_FAIL) return */ + if (ier != TRY_AGAIN) return(ier); + + /* There was a convergence failure and the Jacobian-related data + appears not to be current. Call lsetup with convfail=CV_FAIL_BAD_J + and then loop again */ + convfail = CV_FAIL_BAD_J; + + /* Rename some vectors for readibility */ + vtemp1 = tempv; + vtemp2 = yS[0]; + vtemp3 = ftempS[0]; + + /* Call linear solver setup at converged y */ + ier = lsetup(cv_mem, convfail, y, ftemp, &jcur, + vtemp1, vtemp2, vtemp3); + nsetups++; + nsetupsS++; + gamrat = ONE; + gammap = gamma; + crate = ONE; + crateS = ONE; /* after lsetup all conv. rates are reset to ONE */ + nstlp = nst; + + /* Return if lsetup failed */ + if (ier < 0) return(CV_LSETUP_FAIL); + if (ier > 0) return(CONV_FAIL); + + } /* end loop */ + +} + +/* + * cvStgrNewtonIteration + * + * This routine performs the Newton iteration for all sensitivities. + * If the iteration succeeds, it returns the value CV_SUCCESS. + * If not, it may signal the cvStgrNlsNewton routine to call lsetup and + * reattempt the iteration, by returning the value TRY_AGAIN. (In this case, + * cvStgrNlsNewton must set convfail to CV_FAIL_BAD_J before calling setup again). + * Otherwise, this routine returns one of the appropriate values + * CV_LSOLVE_FAIL or CONV_FAIL back to cvStgrNlsNewton. + */ + +static int cvStgrNewtonIteration(CVodeMem cv_mem) +{ + int m, retval; + realtype Del, Delp, dcon; + N_Vector *bS, wrk1, wrk2; + int is; + + m = 0; + + /* Initialize Delp to avoid compiler warning message */ + Delp = ZERO; + + /* ftemp <- f(t_n, y_n) + y <- y_n + ftempS <- fS(t_n, y_n(0), s_n(0)) + acorS <- 0 + yS <- yS_n(0) */ + + loop { + + /* Evaluate the residual of the nonlinear systems */ + for (is=0; is 0) { + if ((!jcur) && (setupNonNull)) return(TRY_AGAIN); + else return(CONV_FAIL); + } + + } + + /* Get norm of correction; add correction to acorS and yS */ + Del = cvSensNorm(cv_mem, bS, ewtS); + for (is=0; is 0, an estimate of the convergence + rate constant is stored in crateS, and used in the test. */ + if (m > 0) crateS = MAX(CRDOWN * crateS, Del/Delp); + dcon = Del * MIN(ONE, crateS) / tq[4]; + if (dcon <= ONE) { + if (errconS) + acnrmS = (m==0) ? Del : cvSensNorm(cv_mem, acorS, ewtS); + jcur = FALSE; + return(CV_SUCCESS); /* Convergence achieved */ + } + + m++; + + /* Stop at maxcor iterations or if iter. seems to be diverging. + If still not converged and Jacobian data is not current, + signal to try the solution again */ + if ((m == maxcorS) || ((m >= 2) && (Del > RDIV * Delp))) { + if ((!jcur) && (setupNonNull)) return(TRY_AGAIN); + else return(CONV_FAIL); + } + + /* Save norm of correction, evaluate fS, and loop again */ + Delp = Del; + + wrk1 = tempv; + wrk2 = tempvS[0]; + retval = cvSensRhsWrapper(cv_mem, tn, y, ftemp, yS, ftempS, wrk1, wrk2); + if (retval < 0) return(CV_SRHSFUNC_FAIL); + if (retval > 0) { + if ((!jcur) && (setupNonNull)) return(TRY_AGAIN); + else return(SRHSFUNC_RECVR); + } + + } /* end loop */ + +} + +/* + * cvStgr1Nls + * + * This is a high-level routine that attempts to solve the i-th + * sensitivity linear system using nonlinear iterations (CV_FUNCTIONAL + * or CV_NEWTON - depending on the value of iter) once the states y_n + * were obtained and passed the error test. + */ + +static int cvStgr1Nls(CVodeMem cv_mem, int is) +{ + int flag=CV_SUCCESS; + + switch(iter) { + case CV_FUNCTIONAL: + flag = cvStgr1NlsFunctional(cv_mem,is); + break; + case CV_NEWTON: + flag = cvStgr1NlsNewton(cv_mem,is); + break; + } + + return(flag); + +} + +/* + * cvStgr1NlsFunctional + * + * This routine attempts to solve the i-th sensitivity linear system + * using functional iteration (no matrices involved). + * + * Possible return values: + * CV_SUCCESS, + * CV_SRHSFUNC_FAIL, + * CONV_FAIL, SRHSFUNC_RECVR + */ + +static int cvStgr1NlsFunctional(CVodeMem cv_mem, int is) +{ + int retval, m; + realtype Del, Delp, dcon; + N_Vector wrk1, wrk2; + + /* Initialize estimated conv. rate and counter */ + crateS = ONE; + m = 0; + + /* Initialize Delp to avoid compiler warning message */ + Delp = ZERO; + + /* Evaluate fS at predicted yS but with converged y (and corresponding f) */ + wrk1 = tempv; + wrk2 = ftempS[0]; + retval = cvSensRhs1Wrapper(cv_mem, tn, y, ftemp, is, znS[0][is], tempvS[is], wrk1, wrk2); + if (retval < 0) return(CV_SRHSFUNC_FAIL); + if (retval > 0) return(SRHSFUNC_RECVR); + + /* Initialize correction to zero */ + N_VConst(ZERO,acorS[is]); + + /* Loop until convergence; accumulate corrections in acorS */ + + loop { + + nniS1[is]++; + + /* Correct yS from last fS value */ + N_VLinearSum(h, tempvS[is], -ONE, znS[1][is], tempvS[is]); + N_VScale(rl1, tempvS[is], tempvS[is]); + N_VLinearSum(ONE, znS[0][is], ONE, tempvS[is], yS[is]); + + /* Get WRMS norm of current correction to use in convergence test */ + N_VLinearSum(ONE, tempvS[is], -ONE, acorS[is], acorS[is]); + Del = N_VWrmsNorm(acorS[is], ewtS[is]); + N_VScale(ONE, tempvS[is], acorS[is]); + + /* Test for convergence. If m > 0, an estimate of the convergence + rate constant is stored in crateS, and used in the test. */ + + if (m > 0) crateS = MAX(CRDOWN * crateS, Del / Delp); + dcon = Del * MIN(ONE, crateS) / tq[4]; + + if (dcon <= ONE) { + return(CV_SUCCESS); /* Convergence achieved */ + } + + /* Stop at maxcor iterations or if iter. seems to be diverging */ + m++; + if ((m==maxcorS) || ((m >= 2) && (Del > RDIV * Delp))) return(CONV_FAIL); + + /* Save norm of correction, evaluate f, and loop again */ + Delp = Del; + + wrk1 = tempv; + wrk2 = ftempS[0]; + + retval = cvSensRhs1Wrapper(cv_mem, tn, y, ftemp, is, yS[is], tempvS[is], wrk1, wrk2); + if (retval < 0) return(CV_SRHSFUNC_FAIL); + if (retval > 0) return(SRHSFUNC_RECVR); + + } /* end loop */ + +} + +/* + * cvStgr1NlsNewton + * + * This routine attempts to solve the i-th sensitivity linear system + * using Newton iteration. It calls cvStgr1NlsNewton to perform the + * actual iteration. If the Newton iteration fails with out-of-date + * Jacobian data (ier=TRY_AGAIN), it calls lsetup and retries the + * Newton iteration. This second try is unlikely to happen when + * using a Krylov linear solver. + * + * Possible return values: + * + * CV_SUCCESS + * + * CV_LSOLVE_FAIL + * CV_LSETUP_FAIL + * CV_SRHSFUNC_FAIL + * + * CONV_FAIL + * SRHSFUNC_RECVR + */ + +static int cvStgr1NlsNewton(CVodeMem cv_mem, int is) +{ + int convfail, retval, ier; + N_Vector vtemp1, vtemp2, vtemp3, wrk1, wrk2; + + loop { + + /* Set acorS to zero and load prediction into yS vector */ + N_VConst(ZERO, acorS[is]); + N_VScale(ONE, znS[0][is], yS[is]); + + /* Evaluate fS at predicted yS but with converged y (and corresponding f) */ + wrk1 = tempv; + wrk2 = tempvS[0]; + retval = cvSensRhs1Wrapper(cv_mem, tn, y, ftemp, is, yS[is], ftempS[is], wrk1, wrk2); + if (retval < 0) return(CV_SRHSFUNC_FAIL); + if (retval > 0) return(SRHSFUNC_RECVR); + + /* Do the Newton iteration */ + ier = cvStgr1NewtonIteration(cv_mem, is); + + /* If the solve was successful (ier=CV_SUCCESS) or if an error + that cannot be fixed by a call to lsetup occured + (ier = CV_LSOLVE_FAIL or CONV_FAIL) return */ + if (ier != TRY_AGAIN) return(ier); + + /* There was a convergence failure and the Jacobian-related data + appears not to be current. Call lsetup with convfail=CV_FAIL_BAD_J + and then loop again */ + convfail = CV_FAIL_BAD_J; + + /* Rename some vectors for readibility */ + vtemp1 = tempv; + vtemp2 = yS[0]; + vtemp3 = ftempS[0]; + + /* Call linear solver setup at converged y */ + ier = lsetup(cv_mem, convfail, y, ftemp, &jcur, + vtemp1, vtemp2, vtemp3); + nsetups++; + nsetupsS++; + gamrat = ONE; + crate = ONE; + crateS = ONE; /* after lsetup all conv. rates are reset to ONE */ + gammap = gamma; + nstlp = nst; + + /* Return if lsetup failed */ + if (ier < 0) return(CV_LSETUP_FAIL); + if (ier > 0) return(CONV_FAIL); + + } /* end loop */ + +} + +/* + * cvStgr1NewtonIteration + * + * This routine performs the Newton iteration for the i-th sensitivity. + * If the iteration succeeds, it returns the value CV_SUCCESS. + * If not, it may signal the cvStgr1NlsNewton routine to call lsetup + * and reattempt the iteration, by returning the value TRY_AGAIN. + * (In this case, cvStgr1NlsNewton must set convfail to CV_FAIL_BAD_J + * before calling setup again). Otherwise, this routine returns one + * of the appropriate values CV_LSOLVE_FAIL or CONV_FAIL back to + * cvStgr1NlsNewton. + */ + +static int cvStgr1NewtonIteration(CVodeMem cv_mem, int is) +{ + int m, retval; + realtype Del, Delp, dcon; + N_Vector *bS, wrk1, wrk2; + + m = 0; + + /* Initialize Delp to avoid compiler warning message */ + Delp = ZERO; + + /* ftemp <- f(t_n, y_n) + y <- y_n + ftempS[is] <- fS(is, t_n, y_n(0), s_n(0)) + acorS[is] <- 0 + yS[is] <- yS_n(0)[is] */ + + loop { + + /* Evaluate the residual of the nonlinear systems */ + N_VLinearSum(rl1, znS[1][is], ONE, acorS[is], tempvS[is]); + N_VLinearSum(gamma, ftempS[is], -ONE, tempvS[is], tempvS[is]); + + /* Call the lsolve function */ + bS = tempvS; + + nniS1[is]++; + + retval = lsolve(cv_mem, bS[is], ewtS[is], y, ftemp); + + /* Unrecoverable error in lsolve */ + if (retval < 0) return(CV_LSOLVE_FAIL); + + /* Recoverable error in lsolve and Jacobian data not current */ + if (retval > 0) { + if ((!jcur) && (setupNonNull)) return(TRY_AGAIN); + else return(CONV_FAIL); + } + + /* Get norm of correction; add correction to acorS and yS */ + Del = N_VWrmsNorm(bS[is], ewtS[is]); + N_VLinearSum(ONE, acorS[is], ONE, bS[is], acorS[is]); + N_VLinearSum(ONE, znS[0][is], ONE, acorS[is], yS[is]); + + /* Test for convergence. If m > 0, an estimate of the convergence + rate constant is stored in crateS, and used in the test. */ + if (m > 0) crateS = MAX(CRDOWN * crateS, Del/Delp); + dcon = Del * MIN(ONE, crateS) / tq[4]; + if (dcon <= ONE) { + jcur = FALSE; + return(CV_SUCCESS); /* Convergence achieved */ + } + + m++; + + /* Stop at maxcor iterations or if iter. seems to be diverging. + If still not converged and Jacobian data is not current, + signal to try the solution again */ + if ((m == maxcorS) || ((m >= 2) && (Del > RDIV * Delp))) { + if ((!jcur) && (setupNonNull)) return(TRY_AGAIN); + else return(CONV_FAIL); + } + + /* Save norm of correction, evaluate fS, and loop again */ + Delp = Del; + + wrk1 = tempv; + wrk2 = tempvS[0]; + retval = cvSensRhs1Wrapper(cv_mem, tn, y, ftemp, is, yS[is], ftempS[is], wrk1, wrk2); + if (retval < 0) return(CV_SRHSFUNC_FAIL); + if (retval > 0) { + if ((!jcur) && (setupNonNull)) return(TRY_AGAIN); + else return(SRHSFUNC_RECVR); + } + + } /* end loop */ + +} + +/* + * cvHandleNFlag + * + * This routine takes action on the return value nflag = *nflagPtr + * returned by cvNls, as follows: + * + * If cvNls succeeded in solving the nonlinear system, then + * cvHandleNFlag returns the constant DO_ERROR_TEST, which tells cvStep + * to perform the error test. + * + * If the nonlinear system was not solved successfully, then ncfn and + * ncf = *ncfPtr are incremented and Nordsieck array zn is restored. + * + * If the solution of the nonlinear system failed due to an + * unrecoverable failure by setup, we return the value CV_LSETUP_FAIL. + * + * If it failed due to an unrecoverable failure in solve, then we return + * the value CV_LSOLVE_FAIL. + * + * If it failed due to an unrecoverable failure in rhs, then we return + * the value CV_RHSFUNC_FAIL. + * + * If it failed due to an unrecoverable failure in quad rhs, then we return + * the value CV_QRHSFUNC_FAIL. + * + * If it failed due to an unrecoverable failure in sensi rhs, then we return + * the value CV_SRHSFUNC_FAIL. + * + * Otherwise, a recoverable failure occurred when solving the + * nonlinear system (cvNls returned nflag = CONV_FAIL, RHSFUNC_RECVR, or + * SRHSFUNC_RECVR). + * In this case, if ncf is now equal to maxncf or |h| = hmin, + * we return the value CV_CONV_FAILURE (if nflag=CONV_FAIL), or + * CV_REPTD_RHSFUNC_ERR (if nflag=RHSFUNC_RECVR), or CV_REPTD_SRHSFUNC_ERR + * (if nflag=SRHSFUNC_RECVR). + * If not, we set *nflagPtr = PREV_CONV_FAIL and return the value + * PREDICT_AGAIN, telling cvStep to reattempt the step. + * + */ + +static int cvHandleNFlag(CVodeMem cv_mem, int *nflagPtr, realtype saved_t, + int *ncfPtr, long int *ncfnPtr) +{ + int nflag; + + nflag = *nflagPtr; + + if (nflag == CV_SUCCESS) return(DO_ERROR_TEST); + + /* The nonlinear soln. failed; increment ncfn and restore zn */ + (*ncfnPtr)++; + cvRestore(cv_mem, saved_t); + + /* Return if lsetup, lsolve, or some rhs failed unrecoverably */ + if (nflag == CV_LSETUP_FAIL) return(CV_LSETUP_FAIL); + if (nflag == CV_LSOLVE_FAIL) return(CV_LSOLVE_FAIL); + if (nflag == CV_RHSFUNC_FAIL) return(CV_RHSFUNC_FAIL); + if (nflag == CV_QRHSFUNC_FAIL) return(CV_QRHSFUNC_FAIL); + if (nflag == CV_SRHSFUNC_FAIL) return(CV_SRHSFUNC_FAIL); + if (nflag == CV_QSRHSFUNC_FAIL) return(CV_QSRHSFUNC_FAIL); + + /* At this point, nflag = CONV_FAIL, RHSFUNC_RECVR, or SRHSFUNC_RECVR; + increment ncf */ + + (*ncfPtr)++; + etamax = ONE; + + /* If we had maxncf failures or |h| = hmin, + return CV_CONV_FAILURE, CV_REPTD_RHSFUNC_ERR, + CV_REPTD_QRHSFUNC_ERR, or CV_REPTD_SRHSFUNC_ERR */ + + if ((ABS(h) <= hmin*ONEPSM) || (*ncfPtr == maxncf)) { + if (nflag == CONV_FAIL) return(CV_CONV_FAILURE); + if (nflag == RHSFUNC_RECVR) return(CV_REPTD_RHSFUNC_ERR); + if (nflag == QRHSFUNC_RECVR) return(CV_REPTD_QRHSFUNC_ERR); + if (nflag == SRHSFUNC_RECVR) return(CV_REPTD_SRHSFUNC_ERR); + if (nflag == QSRHSFUNC_RECVR) return(CV_REPTD_QSRHSFUNC_ERR); + } + + /* Reduce step size; return to reattempt the step */ + + eta = MAX(ETACF, hmin / ABS(h)); + *nflagPtr = PREV_CONV_FAIL; + cvRescale(cv_mem); + + return(PREDICT_AGAIN); +} + +/* + * cvRestore + * + * This routine restores the value of tn to saved_t and undoes the + * prediction. After execution of cvRestore, the Nordsieck array zn has + * the same values as before the call to cvPredict. + */ + +static void cvRestore(CVodeMem cv_mem, realtype saved_t) +{ + int j, k; + int is; + + tn = saved_t; + for (k = 1; k <= q; k++) + for (j = q; j >= k; j--) + N_VLinearSum(ONE, zn[j-1], -ONE, zn[j], zn[j-1]); + + if (quadr) { + for (k = 1; k <= q; k++) + for (j = q; j >= k; j--) + N_VLinearSum(ONE, znQ[j-1], -ONE, znQ[j], znQ[j-1]); + } + + if (sensi) { + for (is=0; is= k; j--) + N_VLinearSum(ONE, znS[j-1][is], -ONE, znS[j][is], znS[j-1][is]); + } + } + + if (quadr_sensi) { + for (is=0; is= k; j--) + N_VLinearSum(ONE, znQS[j-1][is], -ONE, znQS[j][is], znQS[j-1][is]); + } + } +} + +/* + * ----------------------------------------------------------------- + * Error Test + * ----------------------------------------------------------------- + */ + +/* + * cvDoErrorTest + * + * This routine performs the local error test, for the state, quadrature, + * or sensitivity variables. Its last three arguments change depending + * on which variables the error test is to be performed on. + * + * The weighted local error norm dsm is loaded into *dsmPtr, and + * the test dsm ?<= 1 is made. + * + * If the test passes, cvDoErrorTest returns CV_SUCCESS. + * + * If the test fails, we undo the step just taken (call cvRestore) and + * + * - if maxnef error test failures have occurred or if ABS(h) = hmin, + * we return CV_ERR_FAILURE. + * + * - if more than MXNEF1 error test failures have occurred, an order + * reduction is forced. If already at order 1, restart by reloading + * zn from scratch (also znQ and znS if appropriate). + * If f() fails, we return CV_RHSFUNC_FAIL or CV_UNREC_RHSFUNC_ERR; + * if fQ() fails, we return CV_QRHSFUNC_FAIL or CV_UNREC_QRHSFUNC_ERR; + * if cvSensRhsWrapper() fails, we return CV_SRHSFUNC_FAIL or CV_UNREC_SRHSFUNC_ERR; + * (no recovery is possible at this stage). + * + * - otherwise, set *nflagPtr to PREV_ERR_FAIL, and return TRY_AGAIN. + * + */ + +static int cvDoErrorTest(CVodeMem cv_mem, int *nflagPtr, realtype saved_t, + realtype acor_nrm, + int *nefPtr, long int *netfPtr, realtype *dsmPtr) +{ + realtype dsm; + int retval, is; + N_Vector wrk1, wrk2; + + dsm = acor_nrm * tq[2]; + + /* If est. local error norm dsm passes test, return CV_SUCCESS */ + *dsmPtr = dsm; + if (dsm <= ONE) return(CV_SUCCESS); + + /* Test failed; increment counters, set nflag, and restore zn array */ + (*nefPtr)++; + (*netfPtr)++; + *nflagPtr = PREV_ERR_FAIL; + cvRestore(cv_mem, saved_t); + + /* At maxnef failures or |h| = hmin, return CV_ERR_FAILURE */ + if ((ABS(h) <= hmin*ONEPSM) || (*nefPtr == maxnef)) return(CV_ERR_FAILURE); + + /* Set etamax = 1 to prevent step size increase at end of this step */ + etamax = ONE; + + /* Set h ratio eta from dsm, rescale, and return for retry of step */ + if (*nefPtr <= MXNEF1) { + eta = ONE / (RPowerR(BIAS2*dsm,ONE/L) + ADDON); + eta = MAX(ETAMIN, MAX(eta, hmin / ABS(h))); + if (*nefPtr >= SMALL_NEF) eta = MIN(eta, ETAMXF); + cvRescale(cv_mem); + return(TRY_AGAIN); + } + + /* After MXNEF1 failures, force an order reduction and retry step */ + if (q > 1) { + eta = MAX(ETAMIN, hmin / ABS(h)); + cvAdjustOrder(cv_mem,-1); + L = q; + q--; + qwait = L; + cvRescale(cv_mem); + return(TRY_AGAIN); + } + + /* If already at order 1, restart: reload zn, znQ, znS, znQS from scratch */ + eta = MAX(ETAMIN, hmin / ABS(h)); + h *= eta; + next_h = h; + hscale = h; + qwait = LONG_WAIT; + nscon = 0; + + retval = f(tn, zn[0], tempv, user_data); + nfe++; + if (retval < 0) return(CV_RHSFUNC_FAIL); + if (retval > 0) return(CV_UNREC_RHSFUNC_ERR); + + N_VScale(h, tempv, zn[1]); + + if (quadr) { + + retval = fQ(tn, zn[0], tempvQ, user_data); + nfQe++; + if (retval < 0) return(CV_QRHSFUNC_FAIL); + if (retval > 0) return(CV_UNREC_QRHSFUNC_ERR); + + N_VScale(h, tempvQ, znQ[1]); + + } + + if (sensi) { + + wrk1 = ftemp; + wrk2 = ftempS[0]; + + retval = cvSensRhsWrapper(cv_mem, tn, zn[0], tempv, znS[0], tempvS, wrk1, wrk2); + if (retval < 0) return(CV_SRHSFUNC_FAIL); + if (retval > 0) return(CV_UNREC_SRHSFUNC_ERR); + + for (is=0; is 0) return(CV_UNREC_QSRHSFUNC_ERR); + + for (is=0; is= 2; i--) tau[i] = tau[i-1]; + if ((q==1) && (nst > 1)) tau[2] = tau[1]; + tau[1] = h; + + /* Apply correction to column j of zn: l_j * Delta_n */ + + for (j=0; j <= q; j++) + N_VLinearSum(l[j], acor, ONE, zn[j], zn[j]); + + if (quadr) { + for (j=0; j <= q; j++) + N_VLinearSum(l[j], acorQ, ONE, znQ[j], znQ[j]); + } + + if (sensi) { + for (is=0; is 1) { + + ddn = N_VWrmsNorm(zn[q], ewt); + + if ( quadr && errconQ) { + ddn = cvQuadUpdateNorm(cv_mem, ddn, znQ[q], ewtQ); + } + + if ( sensi && errconS ) { + ddn = cvSensUpdateNorm(cv_mem, ddn, znS[q], ewtS); + } + + if ( quadr_sensi && errconQS ) { + ddn = cvQuadSensUpdateNorm(cv_mem, ddn, znQS[q], ewtQS); + } + + ddn = ddn * tq[1]; + + etaqm1 = ONE/(RPowerR(BIAS1*ddn, ONE/q) + ADDON); + + } + + return(etaqm1); +} + +/* + * cvComputeEtaqp1 + * + * This routine computes and returns the value of etaqp1 for a + * possible increase in order by 1. + */ + +static realtype cvComputeEtaqp1(CVodeMem cv_mem) +{ + realtype dup, cquot; + int is; + + etaqp1 = ZERO; + + if (q != qmax) { + + if (saved_tq5 == ZERO) return(etaqp1); + + cquot = (tq[5] / saved_tq5) * RPowerI(h/tau[2], L); + + N_VLinearSum(-cquot, zn[qmax], ONE, acor, tempv); + + dup = N_VWrmsNorm(tempv, ewt); + + if ( quadr && errconQ ) { + N_VLinearSum(-cquot, znQ[qmax], ONE, acorQ, tempvQ); + dup = cvQuadUpdateNorm(cv_mem, dup, tempvQ, ewtQ); + } + + if ( sensi && errconS ) { + for (is=0; is= 3) { + for (k = 1; k <= 3; k++) + for (i = 5; i >= 2; i--) + ssdat[i][k] = ssdat[i-1][k]; + factorial = 1; + for (i = 1; i <= q-1; i++) factorial *= i; + sq = factorial*q*(q+1)*acnrm/MAX(tq[5],TINY); + sqm1 = factorial*q*N_VWrmsNorm(zn[q], ewt); + sqm2 = factorial*N_VWrmsNorm(zn[q-1], ewt); + ssdat[1][1] = sqm2*sqm2; + ssdat[1][2] = sqm1*sqm1; + ssdat[1][3] = sq*sq; + } + + if (qprime >= q) { + + /* If order is 3 or greater, and enough ssdat has been saved, + nscon >= q+5, then call stability limit detection routine. */ + + if ( (q >= 3) && (nscon >= q+5) ) { + ldflag = cvSLdet(cv_mem); + if (ldflag > 3) { + /* A stability limit violation is indicated by + a return flag of 4, 5, or 6. + Reduce new order. */ + qprime = q-1; + eta = etaqm1; + eta = MIN(eta,etamax); + eta = eta/MAX(ONE,ABS(h)*hmax_inv*eta); + hprime = h*eta; + nor = nor + 1; + } + } + } + else { + /* Otherwise, let order increase happen, and + reset stability limit counter, nscon. */ + nscon = 0; + } +} + +/* + * cvSLdet + * + * This routine detects stability limitation using stored scaled + * derivatives data. cvSLdet returns the magnitude of the + * dominate characteristic root, rr. The presents of a stability + * limit is indicated by rr > "something a little less then 1.0", + * and a positive kflag. This routine should only be called if + * order is greater than or equal to 3, and data has been collected + * for 5 time steps. + * + * Returned values: + * kflag = 1 -> Found stable characteristic root, normal matrix case + * kflag = 2 -> Found stable characteristic root, quartic solution + * kflag = 3 -> Found stable characteristic root, quartic solution, + * with Newton correction + * kflag = 4 -> Found stability violation, normal matrix case + * kflag = 5 -> Found stability violation, quartic solution + * kflag = 6 -> Found stability violation, quartic solution, + * with Newton correction + * + * kflag < 0 -> No stability limitation, + * or could not compute limitation. + * + * kflag = -1 -> Min/max ratio of ssdat too small. + * kflag = -2 -> For normal matrix case, vmax > vrrt2*vrrt2 + * kflag = -3 -> For normal matrix case, The three ratios + * are inconsistent. + * kflag = -4 -> Small coefficient prevents elimination of quartics. + * kflag = -5 -> R value from quartics not consistent. + * kflag = -6 -> No corrected root passes test on qk values + * kflag = -7 -> Trouble solving for sigsq. + * kflag = -8 -> Trouble solving for B, or R via B. + * kflag = -9 -> R via sigsq[k] disagrees with R from data. + */ + +static int cvSLdet(CVodeMem cv_mem) +{ + int i, k, j, it, kmin=0, kflag=0; + realtype rat[5][4], rav[4], qkr[4], sigsq[4], smax[4], ssmax[4]; + realtype drr[4], rrc[4],sqmx[4], qjk[4][4], vrat[5], qc[6][4], qco[6][4]; + realtype rr, rrcut, vrrtol, vrrt2, sqtol, rrtol; + realtype smink, smaxk, sumrat, sumrsq, vmin, vmax, drrmax, adrr; + realtype tem, sqmax, saqk, qp, s, sqmaxk, saqj, sqmin; + realtype rsa, rsb, rsc, rsd, rd1a, rd1b, rd1c; + realtype rd2a, rd2b, rd3a, cest1, corr1; + realtype ratp, ratm, qfac1, qfac2, bb, rrb; + + /* The following are cutoffs and tolerances used by this routine */ + + rrcut = RCONST(0.98); + vrrtol = RCONST(1.0e-4); + vrrt2 = RCONST(5.0e-4); + sqtol = RCONST(1.0e-3); + rrtol = RCONST(1.0e-2); + + rr = ZERO; + + /* Index k corresponds to the degree of the interpolating polynomial. */ + /* k = 1 -> q-1 */ + /* k = 2 -> q */ + /* k = 3 -> q+1 */ + + /* Index i is a backward-in-time index, i = 1 -> current time, */ + /* i = 2 -> previous step, etc */ + + /* get maxima, minima, and variances, and form quartic coefficients */ + + for (k=1; k<=3; k++) { + smink = ssdat[1][k]; + smaxk = ZERO; + + for (i=1; i<=5; i++) { + smink = MIN(smink,ssdat[i][k]); + smaxk = MAX(smaxk,ssdat[i][k]); + } + + if (smink < TINY*smaxk) { + kflag = -1; + return(kflag); + } + smax[k] = smaxk; + ssmax[k] = smaxk*smaxk; + + sumrat = ZERO; + sumrsq = ZERO; + for (i=1; i<=4; i++) { + rat[i][k] = ssdat[i][k]/ssdat[i+1][k]; + sumrat = sumrat + rat[i][k]; + sumrsq = sumrsq + rat[i][k]*rat[i][k]; + } + rav[k] = FOURTH*sumrat; + vrat[k] = ABS(FOURTH*sumrsq - rav[k]*rav[k]); + + qc[5][k] = ssdat[1][k]*ssdat[3][k] - ssdat[2][k]*ssdat[2][k]; + qc[4][k] = ssdat[2][k]*ssdat[3][k] - ssdat[1][k]*ssdat[4][k]; + qc[3][k] = ZERO; + qc[2][k] = ssdat[2][k]*ssdat[5][k] - ssdat[3][k]*ssdat[4][k]; + qc[1][k] = ssdat[4][k]*ssdat[4][k] - ssdat[3][k]*ssdat[5][k]; + + for (i=1; i<=5; i++) { + qco[i][k] = qc[i][k]; + } + } /* End of k loop */ + + /* Isolate normal or nearly-normal matrix case. Three quartic will + have common or nearly-common roots in this case. + Return a kflag = 1 if this procedure works. If three root + differ more than vrrt2, return error kflag = -3. */ + + vmin = MIN(vrat[1],MIN(vrat[2],vrat[3])); + vmax = MAX(vrat[1],MAX(vrat[2],vrat[3])); + + if (vmin < vrrtol*vrrtol) { + + if (vmax > vrrt2*vrrt2) { + kflag = -2; + return(kflag); + } else { + rr = (rav[1] + rav[2] + rav[3])/THREE; + drrmax = ZERO; + for (k = 1;k<=3;k++) { + adrr = ABS(rav[k] - rr); + drrmax = MAX(drrmax, adrr); + } + if (drrmax > vrrt2) + kflag = -3; + kflag = 1; + /* can compute charactistic root, drop to next section */ + } + + } else { + + /* use the quartics to get rr. */ + + if (ABS(qco[1][1]) < TINY*ssmax[1]) { + kflag = -4; + return(kflag); + } + + tem = qco[1][2]/qco[1][1]; + for (i=2; i<=5; i++) { + qco[i][2] = qco[i][2] - tem*qco[i][1]; + } + + qco[1][2] = ZERO; + tem = qco[1][3]/qco[1][1]; + for (i=2; i<=5; i++) { + qco[i][3] = qco[i][3] - tem*qco[i][1]; + } + qco[1][3] = ZERO; + + if (ABS(qco[2][2]) < TINY*ssmax[2]) { + kflag = -4; + return(kflag); + } + + tem = qco[2][3]/qco[2][2]; + for (i=3; i<=5; i++) { + qco[i][3] = qco[i][3] - tem*qco[i][2]; + } + + if (ABS(qco[4][3]) < TINY*ssmax[3]) { + kflag = -4; + return(kflag); + } + + rr = -qco[5][3]/qco[4][3]; + + if (rr < TINY || rr > HUN) { + kflag = -5; + return(kflag); + } + + for (k=1; k<=3; k++) { + qkr[k] = qc[5][k] + rr*(qc[4][k] + rr*rr*(qc[2][k] + rr*qc[1][k])); + } + + sqmax = ZERO; + for (k=1; k<=3; k++) { + saqk = ABS(qkr[k])/ssmax[k]; + if (saqk > sqmax) sqmax = saqk; + } + + if (sqmax < sqtol) { + kflag = 2; + + /* can compute charactistic root, drop to "given rr,etc" */ + + } else { + + /* do Newton corrections to improve rr. */ + + for (it=1; it<=3; it++) { + for (k=1; k<=3; k++) { + qp = qc[4][k] + rr*rr*(THREE*qc[2][k] + rr*FOUR*qc[1][k]); + drr[k] = ZERO; + if (ABS(qp) > TINY*ssmax[k]) drr[k] = -qkr[k]/qp; + rrc[k] = rr + drr[k]; + } + + for (k=1; k<=3; k++) { + s = rrc[k]; + sqmaxk = ZERO; + for (j=1; j<=3; j++) { + qjk[j][k] = qc[5][j] + s*(qc[4][j] + + s*s*(qc[2][j] + s*qc[1][j])); + saqj = ABS(qjk[j][k])/ssmax[j]; + if (saqj > sqmaxk) sqmaxk = saqj; + } + sqmx[k] = sqmaxk; + } + + sqmin = sqmx[1] + ONE; + for (k=1; k<=3; k++) { + if (sqmx[k] < sqmin) { + kmin = k; + sqmin = sqmx[k]; + } + } + rr = rrc[kmin]; + + if (sqmin < sqtol) { + kflag = 3; + /* can compute charactistic root */ + /* break out of Newton correction loop and drop to "given rr,etc" */ + break; + } else { + for (j=1; j<=3; j++) { + qkr[j] = qjk[j][kmin]; + } + } + } /* end of Newton correction loop */ + + if (sqmin > sqtol) { + kflag = -6; + return(kflag); + } + } /* end of if (sqmax < sqtol) else */ + } /* end of if (vmin < vrrtol*vrrtol) else, quartics to get rr. */ + + /* given rr, find sigsq[k] and verify rr. */ + /* All positive kflag drop to this section */ + + for (k=1; k<=3; k++) { + rsa = ssdat[1][k]; + rsb = ssdat[2][k]*rr; + rsc = ssdat[3][k]*rr*rr; + rsd = ssdat[4][k]*rr*rr*rr; + rd1a = rsa - rsb; + rd1b = rsb - rsc; + rd1c = rsc - rsd; + rd2a = rd1a - rd1b; + rd2b = rd1b - rd1c; + rd3a = rd2a - rd2b; + + if (ABS(rd1b) < TINY*smax[k]) { + kflag = -7; + return(kflag); + } + + cest1 = -rd3a/rd1b; + if (cest1 < TINY || cest1 > FOUR) { + kflag = -7; + return(kflag); + } + corr1 = (rd2b/cest1)/(rr*rr); + sigsq[k] = ssdat[3][k] + corr1; + } + + if (sigsq[2] < TINY) { + kflag = -8; + return(kflag); + } + + ratp = sigsq[3]/sigsq[2]; + ratm = sigsq[1]/sigsq[2]; + qfac1 = FOURTH*(q*q - ONE); + qfac2 = TWO/(q - ONE); + bb = ratp*ratm - ONE - qfac1*ratp; + tem = ONE - qfac2*bb; + + if (ABS(tem) < TINY) { + kflag = -8; + return(kflag); + } + + rrb = ONE/tem; + + if (ABS(rrb - rr) > rrtol) { + kflag = -9; + return(kflag); + } + + /* Check to see if rr is above cutoff rrcut */ + if (rr > rrcut) { + if (kflag == 1) kflag = 4; + if (kflag == 2) kflag = 5; + if (kflag == 3) kflag = 6; + } + + /* All positive kflag returned at this point */ + + return(kflag); + +} + +/* + * ----------------------------------------------------------------- + * Functions for rootfinding + * ----------------------------------------------------------------- + */ + +/* + * cvRcheck1 + * + * This routine completes the initialization of rootfinding memory + * information, and checks whether g has a zero both at and very near + * the initial point of the IVP. + * + * This routine returns an int equal to: + * CV_RTFUNC_FAIL = -12 if the g function failed, or + * CV_SUCCESS = 0 otherwise. + */ + +static int cvRcheck1(CVodeMem cv_mem) +{ + int i, retval; + realtype smallh, hratio; + booleantype zroot; + + for (i = 0; i < nrtfn; i++) iroots[i] = 0; + tlo = tn; + ttol = (ABS(tn) + ABS(h))*uround*HUN; + + /* Evaluate g at initial t and check for zero values. */ + retval = gfun(tlo, zn[0], glo, user_data); + nge = 1; + if (retval != 0) return(CV_RTFUNC_FAIL); + + zroot = FALSE; + for (i = 0; i < nrtfn; i++) { + if (ABS(glo[i]) == ZERO) { + zroot = TRUE; + gactive[i] = FALSE; + } + } + if (!zroot) return(CV_SUCCESS); + + /* Some g_i is zero at t0; look at g at t0+(small increment). */ + hratio = MAX(ttol/ABS(h), TENTH); + smallh = hratio*h; + tlo += smallh; + N_VLinearSum(ONE, zn[0], hratio, zn[1], y); + retval = gfun(tlo, y, glo, user_data); + nge++; + if (retval != 0) return(CV_RTFUNC_FAIL); + + /* We check now only the components of g which were exactly 0.0 at t0 + * to see if we can 'activate' them. */ + + for (i = 0; i < nrtfn; i++) { + if (!gactive[i] && ABS(glo[i]) != ZERO) { + gactive[i] = TRUE; + } + } + + return(CV_SUCCESS); +} + +/* + * cvRcheck2 + * + * This routine checks for exact zeros of g at the last root found, + * if the last return was a root. It then checks for a close + * pair of zeros (an error condition), and for a new root at a + * nearby point. The left endpoint (tlo) of the search interval + * is adjusted if necessary to assure that all g_i are nonzero + * there, before returning to do a root search in the interval. + * + * On entry, tlo = tretlast is the last value of tret returned by + * CVode. This may be the previous tn, the previous tout value, or + * the last root location. + * + * This routine returns an int equal to: + * CV_RTFUNC_FAIL = -12 if the g function failed, or + * CLOSERT = 3 if a close pair of zeros was found, or + * RTFOUND = 1 if a new zero of g was found near tlo, or + * CV_SUCCESS = 0 otherwise. + */ + +static int cvRcheck2(CVodeMem cv_mem) +{ + int i, retval; + realtype smallh, hratio; + booleantype zroot; + + if (irfnd == 0) return(CV_SUCCESS); + + (void) CVodeGetDky(cv_mem, tlo, 0, y); + retval = gfun(tlo, y, glo, user_data); + nge++; + if (retval != 0) return(CV_RTFUNC_FAIL); + + zroot = FALSE; + for (i = 0; i < nrtfn; i++) iroots[i] = 0; + for (i = 0; i < nrtfn; i++) { + if (!gactive[i]) continue; + if (ABS(glo[i]) == ZERO) { + zroot = TRUE; + iroots[i] = 1; + } + } + if (!zroot) return(CV_SUCCESS); + + /* One or more g_i has a zero at tlo. Check g at tlo+smallh. */ + ttol = (ABS(tn) + ABS(h))*uround*HUN; + smallh = (h > ZERO) ? ttol : -ttol; + tlo += smallh; + if ( (tlo - tn)*h >= ZERO) { + hratio = smallh/h; + N_VLinearSum(ONE, y, hratio, zn[1], y); + } else { + (void) CVodeGetDky(cv_mem, tlo, 0, y); + } + retval = gfun(tlo, y, glo, user_data); + nge++; + if (retval != 0) return(CV_RTFUNC_FAIL); + + zroot = FALSE; + for (i = 0; i < nrtfn; i++) { + if (ABS(glo[i]) == ZERO) { + if (!gactive[i]) continue; + if (iroots[i] == 1) return(CLOSERT); + zroot = TRUE; + iroots[i] = 1; + } + } + if (zroot) return(RTFOUND); + return(CV_SUCCESS); + +} + +/* + * cvRcheck3 + * + * This routine interfaces to cvRootFind to look for a root of g + * between tlo and either tn or tout, whichever comes first. + * Only roots beyond tlo in the direction of integration are sought. + * + * This routine returns an int equal to: + * CV_RTFUNC_FAIL = -12 if the g function failed, or + * RTFOUND = 1 if a root of g was found, or + * CV_SUCCESS = 0 otherwise. + */ + +static int cvRcheck3(CVodeMem cv_mem) +{ + int i, retval, ier; + + /* Set thi = tn or tout, whichever comes first; set y = y(thi). */ + if (taskc == CV_ONE_STEP) { + thi = tn; + N_VScale(ONE, zn[0], y); + } + if (taskc == CV_NORMAL) { + if ( (toutc - tn)*h >= ZERO) { + thi = tn; + N_VScale(ONE, zn[0], y); + } else { + thi = toutc; + (void) CVodeGetDky(cv_mem, thi, 0, y); + } + } + + /* Set ghi = g(thi) and call cvRootFind to search (tlo,thi) for roots. */ + retval = gfun(thi, y, ghi, user_data); + nge++; + if (retval != 0) return(CV_RTFUNC_FAIL); + + ttol = (ABS(tn) + ABS(h))*uround*HUN; + ier = cvRootFind(cv_mem); + if (ier == CV_RTFUNC_FAIL) return(CV_RTFUNC_FAIL); + for(i=0; i 0, search for roots of g_i only if + * g_i is increasing; if rootdir[i] < 0, search for + * roots of g_i only if g_i is decreasing; otherwise + * always search for roots of g_i. + * + * gactive = array specifying whether a component of g should + * or should not be monitored. gactive[i] is initially + * set to TRUE for all i=0,...,nrtfn-1, but it may be + * reset to FALSE if at the first step g[i] is 0.0 + * both at the I.C. and at a small perturbation of them. + * gactive[i] is then set back on TRUE only after the + * corresponding g function moves away from 0.0. + * + * nge = cumulative counter for gfun calls. + * + * ttol = a convergence tolerance for trout. Input only. + * When a root at trout is found, it is located only to + * within a tolerance of ttol. Typically, ttol should + * be set to a value on the order of + * 100 * UROUND * max (ABS(tlo), ABS(thi)) + * where UROUND is the unit roundoff of the machine. + * + * tlo, thi = endpoints of the interval in which roots are sought. + * On input, and must be distinct, but tlo - thi may + * be of either sign. The direction of integration is + * assumed to be from tlo to thi. On return, tlo and thi + * are the endpoints of the final relevant interval. + * + * glo, ghi = arrays of length nrtfn containing the vectors g(tlo) + * and g(thi) respectively. Input and output. On input, + * none of the glo[i] should be zero. + * + * trout = root location, if a root was found, or thi if not. + * Output only. If a root was found other than an exact + * zero of g, trout is the endpoint thi of the final + * interval bracketing the root, with size at most ttol. + * + * grout = array of length nrtfn containing g(trout) on return. + * + * iroots = int array of length nrtfn with root information. + * Output only. If a root was found, iroots indicates + * which components g_i have a root at trout. For + * i = 0, ..., nrtfn-1, iroots[i] = 1 if g_i has a root + * and g_i is increasing, iroots[i] = -1 if g_i has a + * root and g_i is decreasing, and iroots[i] = 0 if g_i + * has no roots or g_i varies in the direction opposite + * to that indicated by rootdir[i]. + * + * This routine returns an int equal to: + * CV_RTFUNC_FAIL = -12 if the g function failed, or + * RTFOUND = 1 if a root of g was found, or + * CV_SUCCESS = 0 otherwise. + */ + +static int cvRootFind(CVodeMem cv_mem) +{ + realtype alpha, tmid, gfrac, maxfrac, fracint, fracsub; + int i, retval, imax, side, sideprev; + booleantype zroot, sgnchg; + + imax = 0; + + /* First check for change in sign in ghi or for a zero in ghi. */ + maxfrac = ZERO; + zroot = FALSE; + sgnchg = FALSE; + for (i = 0; i < nrtfn; i++) { + if(!gactive[i]) continue; + if (ABS(ghi[i]) == ZERO) { + if(rootdir[i]*glo[i] <= ZERO) { + zroot = TRUE; + } + } else { + if ( (glo[i]*ghi[i] < ZERO) && (rootdir[i]*glo[i] <= ZERO) ) { + gfrac = ABS(ghi[i]/(ghi[i] - glo[i])); + if (gfrac > maxfrac) { + sgnchg = TRUE; + maxfrac = gfrac; + imax = i; + } + } + } + } + + /* If no sign change was found, reset trout and grout. Then return + CV_SUCCESS if no zero was found, or set iroots and return RTFOUND. */ + if (!sgnchg) { + trout = thi; + for (i = 0; i < nrtfn; i++) grout[i] = ghi[i]; + if (!zroot) return(CV_SUCCESS); + for (i = 0; i < nrtfn; i++) { + iroots[i] = 0; + if(!gactive[i]) continue; + if (ABS(ghi[i]) == ZERO) iroots[i] = glo[i] > 0 ? -1:1; + } + return(RTFOUND); + } + + /* Initialize alpha to avoid compiler warning */ + alpha = ONE; + + /* A sign change was found. Loop to locate nearest root. */ + + side = 0; sideprev = -1; + loop { /* Looping point */ + + /* Set weight alpha. + On the first two passes, set alpha = 1. Thereafter, reset alpha + according to the side (low vs high) of the subinterval in which + the sign change was found in the previous two passes. + If the sides were opposite, set alpha = 1. + If the sides were the same, then double alpha (if high side), + or halve alpha (if low side). + The next guess tmid is the secant method value if alpha = 1, but + is closer to tlo if alpha < 1, and closer to thi if alpha > 1. */ + + if (sideprev == side) { + alpha = (side == 2) ? alpha*TWO : alpha*HALF; + } else { + alpha = ONE; + } + + /* Set next root approximation tmid and get g(tmid). + If tmid is too close to tlo or thi, adjust it inward, + by a fractional distance that is between 0.1 and 0.5. */ + tmid = thi - (thi - tlo)*ghi[imax]/(ghi[imax] - alpha*glo[imax]); + if (ABS(tmid - tlo) < HALF*ttol) { + fracint = ABS(thi - tlo)/ttol; + fracsub = (fracint > FIVE) ? TENTH : HALF/fracint; + tmid = tlo + fracsub*(thi - tlo); + } + if (ABS(thi - tmid) < HALF*ttol) { + fracint = ABS(thi - tlo)/ttol; + fracsub = (fracint > FIVE) ? TENTH : HALF/fracint; + tmid = thi - fracsub*(thi - tlo); + } + + (void) CVodeGetDky(cv_mem, tmid, 0, y); + retval = gfun(tmid, y, grout, user_data); + nge++; + if (retval != 0) return(CV_RTFUNC_FAIL); + + /* Check to see in which subinterval g changes sign, and reset imax. + Set side = 1 if sign change is on low side, or 2 if on high side. */ + maxfrac = ZERO; + zroot = FALSE; + sgnchg = FALSE; + sideprev = side; + for (i = 0; i < nrtfn; i++) { + if(!gactive[i]) continue; + if (ABS(grout[i]) == ZERO) { + if(rootdir[i]*glo[i] <= ZERO) { + zroot = TRUE; + } + } else { + if ( (glo[i]*grout[i] < ZERO) && (rootdir[i]*glo[i] <= ZERO) ) { + gfrac = ABS(grout[i]/(grout[i] - glo[i])); + if (gfrac > maxfrac) { + sgnchg = TRUE; + maxfrac = gfrac; + imax = i; + } + } + } + } + if (sgnchg) { + /* Sign change found in (tlo,tmid); replace thi with tmid. */ + thi = tmid; + for (i = 0; i < nrtfn; i++) ghi[i] = grout[i]; + side = 1; + /* Stop at root thi if converged; otherwise loop. */ + if (ABS(thi - tlo) <= ttol) break; + continue; /* Return to looping point. */ + } + + if (zroot) { + /* No sign change in (tlo,tmid), but g = 0 at tmid; return root tmid. */ + thi = tmid; + for (i = 0; i < nrtfn; i++) ghi[i] = grout[i]; + break; + } + + /* No sign change in (tlo,tmid), and no zero at tmid. + Sign change must be in (tmid,thi). Replace tlo with tmid. */ + tlo = tmid; + for (i = 0; i < nrtfn; i++) glo[i] = grout[i]; + side = 2; + /* Stop at root thi if converged; otherwise loop back. */ + if (ABS(thi - tlo) <= ttol) break; + + } /* End of root-search loop */ + + /* Reset trout and grout, set iroots, and return RTFOUND. */ + trout = thi; + for (i = 0; i < nrtfn; i++) { + grout[i] = ghi[i]; + iroots[i] = 0; + if(!gactive[i]) continue; + if ( (ABS(ghi[i]) == ZERO) && (rootdir[i]*glo[i] <= ZERO) ) + iroots[i] = glo[i] > 0 ? -1:1; + if ( (glo[i]*ghi[i] < ZERO) && (rootdir[i]*glo[i] <= ZERO) ) + iroots[i] = glo[i] > 0 ? -1:1; + } + return(RTFOUND); +} + +/* + * ----------------------------------------------------------------- + * Functions for combined norms + * ----------------------------------------------------------------- + */ + +/* + * cvQuadUpdateNorm + * + * Updates the norm old_nrm to account for all quadratures. + */ + +static realtype cvQuadUpdateNorm(CVodeMem cv_mem, realtype old_nrm, + N_Vector xQ, N_Vector wQ) +{ + realtype qnrm; + + qnrm = N_VWrmsNorm(xQ, wQ); + if (old_nrm > qnrm) return(old_nrm); + else return(qnrm); +} + +/* + * cvSensNorm + * + * This routine returns the maximum over the weighted root mean + * square norm of xS with weight vectors wS: + * + * max { wrms(xS[0],wS[0]) ... wrms(xS[Ns-1],wS[Ns-1]) } + * + * Called by cvSensUpdateNorm or directly in the CV_STAGGERED approach + * during the NLS solution and before the error test. + */ + +static realtype cvSensNorm(CVodeMem cv_mem, N_Vector *xS, N_Vector *wS) +{ + int is; + realtype nrm, snrm; + + nrm = N_VWrmsNorm(xS[0],wS[0]); + for (is=1; is nrm ) nrm = snrm; + } + + return(nrm); +} + +/* + * cvSensUpdateNorm + * + * Updates the norm old_nrm to account for all sensitivities. + */ + +static realtype cvSensUpdateNorm(CVodeMem cv_mem, realtype old_nrm, + N_Vector *xS, N_Vector *wS) +{ + realtype snrm; + + snrm = cvSensNorm(cv_mem, xS, wS); + if (old_nrm > snrm) return(old_nrm); + else return(snrm); +} + +/* + * cvQuadSensNorm + * + * This routine returns the maximum over the weighted root mean + * square norm of xQS with weight vectors wQS: + * + * max { wrms(xQS[0],wS[0]) ... wrms(xQS[Ns-1],wS[Ns-1]) } + * + * Called by cvQuadSensUpdateNorm. + */ + +static realtype cvQuadSensNorm(CVodeMem cv_mem, N_Vector *xQS, N_Vector *wQS) +{ + int is; + realtype nrm, snrm; + + nrm = N_VWrmsNorm(xQS[0],wQS[0]); + for (is=1; is nrm ) nrm = snrm; + } + + return(nrm); +} + +/* + * cvSensUpdateNorm + * + * Updates the norm old_nrm to account for all quadrature sensitivities. + */ + +static realtype cvQuadSensUpdateNorm(CVodeMem cv_mem, realtype old_nrm, + N_Vector *xQS, N_Vector *wQS) +{ + realtype snrm; + + snrm = cvQuadSensNorm(cv_mem, xQS, wQS); + if (old_nrm > snrm) return(old_nrm); + else return(snrm); +} + +/* + * ----------------------------------------------------------------- + * Wrappers for sensitivity RHS + * ----------------------------------------------------------------- + */ + +/* + * cvSensRhsWrapper + * + * CVSensRhs is a high level routine that returns right hand side + * of sensitivity equations. Depending on the 'ifS' flag, it either + * calls directly the fS routine (ifS=CV_ALLSENS) or (if ifS=CV_ONESENS) + * calls the fS1 routine in a loop over all sensitivities. + * + * CVSensRhs is called: + * (*) by CVode at the first step + * (*) by cvYddNorm if errcon=TRUE + * (*) by cvNlsFunctional, cvNlsNewton, and cvNewtonIteration + * if ism=CV_SIMULTANEOUS + * (*) by cvDoErrorTest when restarting from scratch + * (*) in the corrector loop if ism=CV_STAGGERED + * (*) by cvStgrDoErrorTest when restarting from scratch + * + * The return value is that of the sensitivity RHS function fS, + * + */ + +int cvSensRhsWrapper(CVodeMem cv_mem, realtype time, + N_Vector ycur, N_Vector fcur, + N_Vector *yScur, N_Vector *fScur, + N_Vector temp1, N_Vector temp2) +{ + int retval=0, is; + + if (ifS==CV_ALLSENS) { + retval = fS(Ns, time, ycur, fcur, yScur, fScur, + fS_data, temp1, temp2); + nfSe++; + } else { + for (is=0; iscv_ehfun) +#define eh_data (cv_mem->cv_eh_data) + +void cvProcessError(CVodeMem cv_mem, + int error_code, const char *module, const char *fname, + const char *msgfmt, ...) +{ + va_list ap; + char msg[256]; + + /* Initialize the argument pointer variable + (msgfmt is the last required argument to cvProcessError) */ + + va_start(ap, msgfmt); + + /* Compose the message */ + + vsprintf(msg, msgfmt, ap); + + if (cv_mem == NULL) { /* We write to stderr */ + +#ifndef NO_FPRINTF_OUTPUT + fprintf(stderr, "\n[%s ERROR] %s\n ", module, fname); + fprintf(stderr, msg); + fprintf(stderr, "\n\n"); +#endif + + } else { /* We can call ehfun */ + + /* Call ehfun */ + + ehfun(error_code, module, fname, msg, eh_data); + + } + + /* Finalize argument processing */ + + va_end(ap); + + return; + +} + +/* + * cvErrHandler is the default error handling function. + * It sends the error message to the stream pointed to by cv_errfp + */ + +#define errfp (cv_mem->cv_errfp) + +void cvErrHandler(int error_code, const char *module, + const char *function, char *msg, void *data) +{ + CVodeMem cv_mem; + char err_type[10]; + + /* data points to cv_mem here */ + + cv_mem = (CVodeMem) data; + + if (error_code == CV_WARNING) + sprintf(err_type,"WARNING"); + else + sprintf(err_type,"ERROR"); + +#ifndef NO_FPRINTF_OUTPUT + if (errfp!=NULL) { + fprintf(errfp,"\n[%s %s] %s\n",module,err_type,function); + fprintf(errfp," %s\n\n",msg); + } +#endif + + return; +} diff --git a/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_band.c b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_band.c new file mode 100644 index 0000000..f9a9db2 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_band.c @@ -0,0 +1,458 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.13 $ + * $Date: 2009/02/17 02:42:29 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for the CVSBAND linear solver. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include +#include "cvodes_direct_impl.h" +#include "cvodes_impl.h" + +#include + +/* Constants */ + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) +#define TWO RCONST(2.0) + +/* CVSBAND linit, lsetup, lsolve, and lfree routines */ +static int cvBandInit(CVodeMem cv_mem); +static int cvBandSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, + N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, + N_Vector vtemp2, N_Vector vtemp3); +static int cvBandSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, + N_Vector ycur, N_Vector fcur); +static void cvBandFree(CVodeMem cv_mem); + +/* CVSBAND lfreeB function */ +static void cvBandFreeB(CVodeBMem cvB_mem); + +/* + * ================================================================ + * + * PART I - forward problems + * + * ================================================================ + */ + + +/* Readability Replacements */ + +#define lmm (cv_mem->cv_lmm) +#define f (cv_mem->cv_f) +#define nst (cv_mem->cv_nst) +#define tn (cv_mem->cv_tn) +#define h (cv_mem->cv_h) +#define gamma (cv_mem->cv_gamma) +#define gammap (cv_mem->cv_gammap) +#define gamrat (cv_mem->cv_gamrat) +#define ewt (cv_mem->cv_ewt) +#define nfe (cv_mem->cv_nfe) +#define linit (cv_mem->cv_linit) +#define lsetup (cv_mem->cv_lsetup) +#define lsolve (cv_mem->cv_lsolve) +#define lfree (cv_mem->cv_lfree) +#define lmem (cv_mem->cv_lmem) +#define vec_tmpl (cv_mem->cv_tempv) +#define setupNonNull (cv_mem->cv_setupNonNull) + +#define mtype (cvdls_mem->d_type) +#define n (cvdls_mem->d_n) +#define jacDQ (cvdls_mem->d_jacDQ) +#define jac (cvdls_mem->d_bjac) +#define M (cvdls_mem->d_M) +#define mu (cvdls_mem->d_mu) +#define ml (cvdls_mem->d_ml) +#define smu (cvdls_mem->d_smu) +#define pivots (cvdls_mem->d_pivots) +#define savedJ (cvdls_mem->d_savedJ) +#define nstlj (cvdls_mem->d_nstlj) +#define nje (cvdls_mem->d_nje) +#define nfeDQ (cvdls_mem->d_nfeDQ) +#define J_data (cvdls_mem->d_J_data) +#define last_flag (cvdls_mem->d_last_flag) + +/* + * ----------------------------------------------------------------- + * CVBand + * ----------------------------------------------------------------- + * This routine initializes the memory record and sets various function + * fields specific to the band linear solver module. CVBand first calls + * the existing lfree routine if this is not NULL. It then sets the + * cv_linit, cv_lsetup, cv_lsolve, and cv_lfree fields in (*cvode_mem) + * to be cvBandInit, cvBandSetup, cvBandSolve, and cvBandFree, + * respectively. It allocates memory for a structure of type + * CVDlsMemRec and sets the cv_lmem field in (*cvode_mem) to the + * address of this structure. It sets setupNonNull in (*cvode_mem) to be + * TRUE, b_mu to be mupper, b_ml to be mlower, and the b_jac field to be + * CVBandDQJac. + * Finally, it allocates memory for M, savedJ, and pivot. The CVBand + * return value is SUCCESS = 0, LMEM_FAIL = -1, or LIN_ILL_INPUT = -2. + * + * NOTE: The band linear solver assumes a serial implementation + * of the NVECTOR package. Therefore, CVBand will first + * test for compatible a compatible N_Vector internal + * representation by checking that the function + * N_VGetArrayPointer exists. + * ----------------------------------------------------------------- + */ + +int CVBand(void *cvode_mem, int N, int mupper, int mlower) +{ + CVodeMem cv_mem; + CVDlsMem cvdls_mem; + + /* Return immediately if cvode_mem is NULL */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVDLS_MEM_NULL, "CVSBAND", "CVBand", MSGD_CVMEM_NULL); + return(CVDLS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Test if the NVECTOR package is compatible with the BAND solver */ + if (vec_tmpl->ops->nvgetarraypointer == NULL) { + cvProcessError(cv_mem, CVDLS_ILL_INPUT, "CVSBAND", "CVBand", MSGD_BAD_NVECTOR); + return(CVDLS_ILL_INPUT); + } + + if (lfree != NULL) lfree(cv_mem); + + /* Set four main function fields in cv_mem */ + linit = cvBandInit; + lsetup = cvBandSetup; + lsolve = cvBandSolve; + lfree = cvBandFree; + + /* Get memory for CVDlsMemRec */ + cvdls_mem = NULL; + cvdls_mem = (CVDlsMem) malloc(sizeof(struct CVDlsMemRec)); + if (cvdls_mem == NULL) { + cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSBAND", "CVBand", MSGD_MEM_FAIL); + return(CVDLS_MEM_FAIL); + } + + /* Set matrix type */ + mtype = SUNDIALS_BAND; + + /* Initialize Jacobian-related data */ + jacDQ = TRUE; + jac = NULL; + J_data = NULL; + + last_flag = CVDLS_SUCCESS; + + setupNonNull = TRUE; + + /* Load problem dimension */ + n = N; + + /* Load half-bandwiths in cvdls_mem */ + ml = mlower; + mu = mupper; + + /* Test ml and mu for legality */ + if ((ml < 0) || (mu < 0) || (ml >= N) || (mu >= N)) { + cvProcessError(cv_mem, CVDLS_ILL_INPUT, "CVSBAND", "CVBand", MSGD_BAD_SIZES); + return(CVDLS_ILL_INPUT); + } + + /* Set extended upper half-bandwith for M (required for pivoting) */ + smu = MIN(N-1, mu + ml); + + /* Allocate memory for M, savedJ, and pivot arrays */ + M = NULL; + M = NewBandMat(N, mu, ml, smu); + if (M == NULL) { + cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSBAND", "CVBand", MSGD_MEM_FAIL); + free(cvdls_mem); cvdls_mem = NULL; + return(CVDLS_MEM_FAIL); + } + savedJ = NULL; + savedJ = NewBandMat(N, mu, ml, mu); + if (savedJ == NULL) { + cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSBAND", "CVBand", MSGD_MEM_FAIL); + DestroyMat(M); + free(cvdls_mem); cvdls_mem = NULL; + return(CVDLS_MEM_FAIL); + } + pivots = NULL; + pivots = NewIntArray(N); + if (pivots == NULL) { + cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSBAND", "CVBand", MSGD_MEM_FAIL); + DestroyMat(M); + DestroyMat(savedJ); + free(cvdls_mem); cvdls_mem = NULL; + return(CVDLS_MEM_FAIL); + } + + /* Attach linear solver memory to integrator memory */ + lmem = cvdls_mem; + + return(CVDLS_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * cvBandInit + * ----------------------------------------------------------------- + * This routine does remaining initializations specific to the band + * linear solver. + * ----------------------------------------------------------------- + */ + +static int cvBandInit(CVodeMem cv_mem) +{ + CVDlsMem cvdls_mem; + + cvdls_mem = (CVDlsMem) lmem; + + nje = 0; + nfeDQ = 0; + nstlj = 0; + + /* Set Jacobian function and data, depending on jacDQ */ + if (jacDQ) { + jac = cvDlsBandDQJac; + J_data = cv_mem; + } else { + J_data = cv_mem->cv_user_data; + } + + last_flag = CVDLS_SUCCESS; + return(0); +} + +/* + * ----------------------------------------------------------------- + * cvBandSetup + * ----------------------------------------------------------------- + * This routine does the setup operations for the band linear solver. + * It makes a decision whether or not to call the Jacobian evaluation + * routine based on various state variables, and if not it uses the + * saved copy. In any case, it constructs the Newton matrix + * M = I - gamma*J, updates counters, and calls the band LU + * factorization routine. + * ----------------------------------------------------------------- + */ + +static int cvBandSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, + N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, + N_Vector vtemp2, N_Vector vtemp3) +{ + CVDlsMem cvdls_mem; + booleantype jbad, jok; + realtype dgamma; + int ier, retval; + + cvdls_mem = (CVDlsMem) lmem; + + /* Use nst, gamma/gammap, and convfail to set J eval. flag jok */ + + dgamma = ABS((gamma/gammap) - ONE); + jbad = (nst == 0) || (nst > nstlj + CVD_MSBJ) || + ((convfail == CV_FAIL_BAD_J) && (dgamma < CVD_DGMAX)) || + (convfail == CV_FAIL_OTHER); + jok = !jbad; + + if (jok) { + + /* If jok = TRUE, use saved copy of J */ + *jcurPtr = FALSE; + BandCopy(savedJ, M, mu, ml); + + } else { + + /* If jok = FALSE, call jac routine for new J value */ + nje++; + nstlj = nst; + *jcurPtr = TRUE; + SetToZero(M); + + retval = jac(n, mu, ml, tn, ypred, fpred, M, J_data, vtemp1, vtemp2, vtemp3); + if (retval < 0) { + cvProcessError(cv_mem, CVDLS_JACFUNC_UNRECVR, "CVSBAND", "cvBandSetup", MSGD_JACFUNC_FAILED); + last_flag = CVDLS_JACFUNC_UNRECVR; + return(-1); + } + if (retval > 0) { + last_flag = CVDLS_JACFUNC_RECVR; + return(1); + } + + BandCopy(M, savedJ, mu, ml); + + } + + /* Scale and add I to get M = I - gamma*J */ + BandScale(-gamma, M); + AddIdentity(M); + + /* Do LU factorization of M */ + ier = BandGBTRF(M, pivots); + + /* Return 0 if the LU was complete; otherwise return 1 */ + if (ier > 0) { + last_flag = ier; + return(1); + } + last_flag = CVDLS_SUCCESS; + return(0); +} + +/* + * ----------------------------------------------------------------- + * cvBandSolve + * ----------------------------------------------------------------- + * This routine handles the solve operation for the band linear solver + * by calling the band backsolve routine. The return value is 0. + * ----------------------------------------------------------------- + */ + +static int cvBandSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, + N_Vector ycur, N_Vector fcur) +{ + CVDlsMem cvdls_mem; + realtype *bd; + + cvdls_mem = (CVDlsMem) lmem; + + bd = N_VGetArrayPointer(b); + + BandGBTRS(M, pivots, bd); + + /* If CV_BDF, scale the correction to account for change in gamma */ + if ((lmm == CV_BDF) && (gamrat != ONE)) { + N_VScale(TWO/(ONE + gamrat), b, b); + } + + last_flag = CVDLS_SUCCESS; + return(0); +} + +/* + * ----------------------------------------------------------------- + * cvBandFree + * ----------------------------------------------------------------- + * This routine frees memory specific to the band linear solver. + * ----------------------------------------------------------------- + */ + +static void cvBandFree(CVodeMem cv_mem) +{ + CVDlsMem cvdls_mem; + + cvdls_mem = (CVDlsMem) lmem; + + DestroyMat(M); + DestroyMat(savedJ); + DestroyArray(pivots); + free(cvdls_mem); cvdls_mem = NULL; +} + +/* + * ================================================================ + * + * PART II - backward problems + * + * ================================================================ + */ + +/* + * CVBandB is a wraper around CVBand. It attaches the CVSBAND linear solver + * to the backward problem memory block. + */ + +int CVBandB(void *cvode_mem, int which, + int nB, int mupperB, int mlowerB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + CVDlsMemB cvdlsB_mem; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVDLS_MEM_NULL, "CVSBAND", "CVBandB", MSGD_CVMEM_NULL); + return(CVDLS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CVDLS_NO_ADJ, "CVSBAND", "CVBandB", MSGD_NO_ADJ); + return(CVDLS_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= ca_mem->ca_nbckpbs ) { + cvProcessError(cv_mem, CVDLS_ILL_INPUT, "CVSBAND", "CVBandB", MSGCV_BAD_WHICH); + return(CVDLS_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + /* Get memory for CVDlsMemRecB */ + cvdlsB_mem = (CVDlsMemB) malloc(sizeof(struct CVDlsMemRecB)); + if (cvdlsB_mem == NULL) { + cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSBAND", "CVBandB", MSGD_MEM_FAIL); + return(CVDLS_MEM_FAIL); + } + + /* set matrix type */ + cvdlsB_mem->d_typeB = SUNDIALS_BAND; + + /* initialize Jacobian function */ + cvdlsB_mem->d_bjacB = NULL; + + /* attach lmemB and lfreeB */ + cvB_mem->cv_lmem = cvdlsB_mem; + cvB_mem->cv_lfree = cvBandFreeB; + + flag = CVBand(cvodeB_mem, nB, mupperB, mlowerB); + + if (flag != CVDLS_SUCCESS) { + free(cvdlsB_mem); + cvdlsB_mem = NULL; + } + + return(flag); +} + +/* + * cvBandFreeB frees the memory associated with the CVSBAND linear + * solver for backward integration. + */ + +static void cvBandFreeB(CVodeBMem cvB_mem) +{ + CVDlsMemB cvdlsB_mem; + + cvdlsB_mem = (CVDlsMemB) (cvB_mem->cv_lmem); + + free(cvdlsB_mem); +} + diff --git a/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_bandpre.c b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_bandpre.c new file mode 100644 index 0000000..eb67265 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_bandpre.c @@ -0,0 +1,544 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.10 $ + * $Date: 2009/02/17 02:42:29 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This file contains implementations of the banded difference + * quotient Jacobian-based preconditioner and solver routines for + * use with the CVSPILS linear solvers. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "cvodes_impl.h" +#include "cvodes_bandpre_impl.h" +#include "cvodes_spils_impl.h" + +#include +#include +#include + +#include + +#define MIN_INC_MULT RCONST(1000.0) +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + +/* Prototypes of cvBandPrecSetup and cvBandPrecSolve */ + +static int cvBandPrecSetup(realtype t, N_Vector y, N_Vector fy, + booleantype jok, booleantype *jcurPtr, + realtype gamma, void *bp_data, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); + +static int cvBandPrecSolve(realtype t, N_Vector y, N_Vector fy, + N_Vector r, N_Vector z, + realtype gamma, realtype delta, + int lr, void *bp_data, N_Vector tmp); + +/* Prototype for cvBandPrecFree */ + +static void cvBandPrecFree(CVodeMem cv_mem); + +/* Prototype for difference quotient Jacobian calculation routine */ + +static int cvBandPrecDQJac(CVBandPrecData pdata, + realtype t, N_Vector y, N_Vector fy, + N_Vector ftemp, N_Vector ytemp); + +/* + * ================================================================ + * + * PART I - forward problems + * + * ================================================================ + */ + +/* Redability replacements */ + +#define vec_tmpl (cv_mem->cv_tempv) + +/* + * ----------------------------------------------------------------- + * Initialization, Free, and Get Functions + * NOTE: The band linear solver assumes a serial implementation + * of the NVECTOR package. Therefore, CVBandPrecInit will + * first test for a compatible N_Vector internal representation + * by checking that the function N_VGetArrayPointer exists. + * ----------------------------------------------------------------- + */ +int CVBandPrecInit(void *cvode_mem, int N, int mu, int ml) +{ + CVodeMem cv_mem; + CVSpilsMem cvspils_mem; + CVBandPrecData pdata; + int mup, mlp, storagemu; + int flag; + + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVBANDPRE", "CVBandPrecInit", MSGBP_MEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Test if one of the SPILS linear solvers has been attached */ + if (cv_mem->cv_lmem == NULL) { + cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVBANDPRE", "CVBandPrecInit", MSGBP_LMEM_NULL); + return(CVSPILS_LMEM_NULL); + } + cvspils_mem = (CVSpilsMem) cv_mem->cv_lmem; + + /* Test if the NVECTOR package is compatible with the BAND preconditioner */ + if(vec_tmpl->ops->nvgetarraypointer == NULL) { + cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVBANDPRE", "CVBandPrecInit", MSGBP_BAD_NVECTOR); + return(CVSPILS_ILL_INPUT); + } + + pdata = NULL; + pdata = (CVBandPrecData) malloc(sizeof *pdata); /* Allocate data memory */ + if (pdata == NULL) { + cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBANDPRE", "CVBandPrecInit", MSGBP_MEM_FAIL); + return(CVSPILS_MEM_FAIL); + } + + /* Load pointers and bandwidths into pdata block. */ + pdata->cvode_mem = cvode_mem; + pdata->N = N; + pdata->mu = mup = MIN(N-1, MAX(0,mu)); + pdata->ml = mlp = MIN(N-1, MAX(0,ml)); + + /* Initialize nfeBP counter */ + pdata->nfeBP = 0; + + /* Allocate memory for saved banded Jacobian approximation. */ + pdata->savedJ = NULL; + pdata->savedJ = NewBandMat(N, mup, mlp, mup); + if (pdata->savedJ == NULL) { + free(pdata); pdata = NULL; + cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBANDPRE", "CVBandPrecInit", MSGBP_MEM_FAIL); + return(CVSPILS_MEM_FAIL); + } + + + /* Allocate memory for banded preconditioner. */ + storagemu = MIN(N-1, mup+mlp); + pdata->savedP = NULL; + pdata->savedP = NewBandMat(N, mup, mlp, storagemu); + if (pdata->savedP == NULL) { + DestroyMat(pdata->savedJ); + free(pdata); pdata = NULL; + cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBANDPRE", "CVBandPrecInit", MSGBP_MEM_FAIL); + return(CVSPILS_MEM_FAIL); + } + + /* Allocate memory for pivot array. */ + pdata->pivots = NULL; + pdata->pivots = NewIntArray(N); + if (pdata->savedJ == NULL) { + DestroyMat(pdata->savedP); + DestroyMat(pdata->savedJ); + free(pdata); pdata = NULL; + cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBANDPRE", "CVBandPrecInit", MSGBP_MEM_FAIL); + return(CVSPILS_MEM_FAIL); + } + + /* Overwrite the P_data field in the SPILS memory */ + cvspils_mem->s_P_data = pdata; + + /* Attach the pfree function */ + cvspils_mem->s_pfree = cvBandPrecFree; + + /* Attach preconditioner solve and setup functions */ + flag = CVSpilsSetPreconditioner(cvode_mem, cvBandPrecSetup, cvBandPrecSolve); + + return(flag); +} + +int CVBandPrecGetWorkSpace(void *cvode_mem, long int *lenrwBP, long int *leniwBP) +{ + CVodeMem cv_mem; + CVSpilsMem cvspils_mem; + CVBandPrecData pdata; + int N, ml, mu, smu; + + + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVBANDPRE", "CVBandPrecGetWorkSpace", MSGBP_MEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + if (cv_mem->cv_lmem == NULL) { + cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVBANDPRE", "CVBandPrecGetWorkSpace", MSGBP_LMEM_NULL); + return(CVSPILS_LMEM_NULL); + } + cvspils_mem = (CVSpilsMem) cv_mem->cv_lmem; + + if (cvspils_mem->s_P_data == NULL) { + cvProcessError(cv_mem, CVSPILS_PMEM_NULL, "CVBANDPRE", "CVBandPrecGetWorkSpace", MSGBP_PMEM_NULL); + return(CVSPILS_PMEM_NULL); + } + pdata = (CVBandPrecData) cvspils_mem->s_P_data; + + N = pdata->N; + mu = pdata->mu; + ml = pdata->ml; + smu = MIN( N-1, mu + ml); + + *leniwBP = pdata->N; + *lenrwBP = N * ( 2*ml + smu + mu + 2 ); + + return(CVSPILS_SUCCESS); +} + +int CVBandPrecGetNumRhsEvals(void *cvode_mem, long int *nfevalsBP) +{ + CVodeMem cv_mem; + CVSpilsMem cvspils_mem; + CVBandPrecData pdata; + + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVBANDPRE", "CVBandPrecGetNumRhsEvals", MSGBP_MEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + if (cv_mem->cv_lmem == NULL) { + cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVBANDPRE", "CVBandPrecGetNumRhsEvals", MSGBP_LMEM_NULL); + return(CVSPILS_LMEM_NULL); + } + cvspils_mem = (CVSpilsMem) cv_mem->cv_lmem; + + if (cvspils_mem->s_P_data == NULL) { + cvProcessError(cv_mem, CVSPILS_PMEM_NULL, "CVBANDPRE", "CVBandPrecGetNumRhsEvals", MSGBP_PMEM_NULL); + return(CVSPILS_PMEM_NULL); + } + pdata = (CVBandPrecData) cvspils_mem->s_P_data; + + *nfevalsBP = pdata->nfeBP; + + return(CVSPILS_SUCCESS); +} + +/* Readability Replacements */ + +#define N (pdata->N) +#define mu (pdata->mu) +#define ml (pdata->ml) +#define pivots (pdata->pivots) +#define savedJ (pdata->savedJ) +#define savedP (pdata->savedP) +#define nfeBP (pdata->nfeBP) + +/* + * ----------------------------------------------------------------- + * cvBandPrecSetup + * ----------------------------------------------------------------- + * Together cvBandPrecSetup and cvBandPrecSolve use a banded + * difference quotient Jacobian to create a preconditioner. + * cvBandPrecSetup calculates a new J, if necessary, then + * calculates P = I - gamma*J, and does an LU factorization of P. + * + * The parameters of cvBandPrecSetup are as follows: + * + * t is the current value of the independent variable. + * + * y is the current value of the dependent variable vector, + * namely the predicted value of y(t). + * + * fy is the vector f(t,y). + * + * jok is an input flag indicating whether Jacobian-related + * data needs to be recomputed, as follows: + * jok == FALSE means recompute Jacobian-related data + * from scratch. + * jok == TRUE means that Jacobian data from the + * previous PrecSetup call will be reused + * (with the current value of gamma). + * A cvBandPrecSetup call with jok == TRUE should only + * occur after a call with jok == FALSE. + * + * *jcurPtr is a pointer to an output integer flag which is + * set by CVBandPrecond as follows: + * *jcurPtr = TRUE if Jacobian data was recomputed. + * *jcurPtr = FALSE if Jacobian data was not recomputed, + * but saved data was reused. + * + * gamma is the scalar appearing in the Newton matrix. + * + * bp_data is a pointer to preconditoner data (set by CVBandPrecInit) + * + * tmp1, tmp2, and tmp3 are pointers to memory allocated + * for vectors of length N for work space. This + * routine uses only tmp1 and tmp2. + * + * The value to be returned by the cvBandPrecSetup function is + * 0 if successful, or + * 1 if the band factorization failed. + * ----------------------------------------------------------------- + */ + +static int cvBandPrecSetup(realtype t, N_Vector y, N_Vector fy, + booleantype jok, booleantype *jcurPtr, + realtype gamma, void *bp_data, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) +{ + CVBandPrecData pdata; + CVodeMem cv_mem; + int retval; + + /* Assume matrix and pivots have already been allocated. */ + pdata = (CVBandPrecData) bp_data; + + cv_mem = (CVodeMem) pdata->cvode_mem; + + if (jok) { + + /* If jok = TRUE, use saved copy of J. */ + *jcurPtr = FALSE; + BandCopy(savedJ, savedP, mu, ml); + + } else { + + /* If jok = FALSE, call cvBandPrecDQJac for new J value. */ + *jcurPtr = TRUE; + SetToZero(savedJ); + + retval = cvBandPrecDQJac(pdata, t, y, fy, tmp1, tmp2); + if (retval < 0) { + cvProcessError(cv_mem, -1, "CVBANDPRE", "cvBandPrecSetup", MSGBP_RHSFUNC_FAILED); + return(-1); + } + if (retval > 0) { + return(1); + } + + BandCopy(savedJ, savedP, mu, ml); + + } + + /* Scale and add I to get savedP = I - gamma*J. */ + BandScale(-gamma, savedP); + AddIdentity(savedP); + + /* Do LU factorization of matrix. */ + retval = BandGBTRF(savedP, pivots); + + /* Return 0 if the LU was complete; otherwise return 1. */ + if (retval > 0) return(1); + return(0); +} + +/* + * ----------------------------------------------------------------- + * cvBandPrecSolve + * ----------------------------------------------------------------- + * cvBandPrecSolve solves a linear system P z = r, where P is the + * matrix computed by CVBandPrecond. + * + * The parameters of cvBandPrecSolve used here are as follows: + * + * r is the right-hand side vector of the linear system. + * + * bp_data is a pointer to preconditoner data (set by CVBandPrecInit) + * + * z is the output vector computed by cvBandPrecSolve. + * + * The value returned by the cvBandPrecSolve function is always 0, + * indicating success. + * ----------------------------------------------------------------- + */ + +static int cvBandPrecSolve(realtype t, N_Vector y, N_Vector fy, + N_Vector r, N_Vector z, + realtype gamma, realtype delta, + int lr, void *bp_data, N_Vector tmp) +{ + CVBandPrecData pdata; + realtype *zd; + + /* Assume matrix and pivots have already been allocated. */ + pdata = (CVBandPrecData) bp_data; + + /* Copy r to z. */ + N_VScale(ONE, r, z); + + /* Do band backsolve on the vector z. */ + zd = N_VGetArrayPointer(z); + + BandGBTRS(savedP, pivots, zd); + + return(0); +} + + +static void cvBandPrecFree(CVodeMem cv_mem) +{ + CVSpilsMem cvspils_mem; + CVBandPrecData pdata; + + if (cv_mem->cv_lmem == NULL) return; + cvspils_mem = (CVSpilsMem) cv_mem->cv_lmem; + + if (cvspils_mem->s_P_data == NULL) return; + pdata = (CVBandPrecData) cvspils_mem->s_P_data; + + DestroyMat(savedJ); + DestroyMat(savedP); + DestroyArray(pivots); + + free(pdata); + pdata = NULL; +} + + +#define ewt (cv_mem->cv_ewt) +#define uround (cv_mem->cv_uround) +#define h (cv_mem->cv_h) +#define f (cv_mem->cv_f) +#define user_data (cv_mem->cv_user_data) + +/* + * ----------------------------------------------------------------- + * cvBandPrecDQJac + * ----------------------------------------------------------------- + * This routine generates a banded difference quotient approximation to + * the Jacobian of f(t,y). It assumes that a band matrix of type + * BandMat is stored column-wise, and that elements within each column + * are contiguous. This makes it possible to get the address of a column + * of J via the macro BAND_COL and to write a simple for loop to set + * each of the elements of a column in succession. + * ----------------------------------------------------------------- + */ + +static int cvBandPrecDQJac(CVBandPrecData pdata, + realtype t, N_Vector y, N_Vector fy, + N_Vector ftemp, N_Vector ytemp) +{ + CVodeMem cv_mem; + realtype fnorm, minInc, inc, inc_inv, srur; + int group, i, j, width, ngroups, i1, i2; + realtype *col_j, *ewt_data, *fy_data, *ftemp_data, *y_data, *ytemp_data; + int retval; + + cv_mem = (CVodeMem) pdata->cvode_mem; + + /* Obtain pointers to the data for ewt, fy, ftemp, y, ytemp. */ + ewt_data = N_VGetArrayPointer(ewt); + fy_data = N_VGetArrayPointer(fy); + ftemp_data = N_VGetArrayPointer(ftemp); + y_data = N_VGetArrayPointer(y); + ytemp_data = N_VGetArrayPointer(ytemp); + + /* Load ytemp with y = predicted y vector. */ + N_VScale(ONE, y, ytemp); + + /* Set minimum increment based on uround and norm of f. */ + srur = RSqrt(uround); + fnorm = N_VWrmsNorm(fy, ewt); + minInc = (fnorm != ZERO) ? + (MIN_INC_MULT * ABS(h) * uround * N * fnorm) : ONE; + + /* Set bandwidth and number of column groups for band differencing. */ + width = ml + mu + 1; + ngroups = MIN(width, N); + + for (group = 1; group <= ngroups; group++) { + + /* Increment all y_j in group. */ + for(j = group-1; j < N; j += width) { + inc = MAX(srur*ABS(y_data[j]), minInc/ewt_data[j]); + ytemp_data[j] += inc; + } + + /* Evaluate f with incremented y. */ + + retval = f(t, ytemp, ftemp, user_data); + nfeBP++; + if (retval != 0) return(retval); + + /* Restore ytemp, then form and load difference quotients. */ + for (j = group-1; j < N; j += width) { + ytemp_data[j] = y_data[j]; + col_j = BAND_COL(savedJ,j); + inc = MAX(srur*ABS(y_data[j]), minInc/ewt_data[j]); + inc_inv = ONE/inc; + i1 = MAX(0, j-mu); + i2 = MIN(j+ml, N-1); + for (i=i1; i <= i2; i++) + BAND_COL_ELEM(col_j,i,j) = + inc_inv * (ftemp_data[i] - fy_data[i]); + } + } + + return(0); +} + +/* + * ================================================================ + * + * PART II - backward problems + * + * ================================================================ + */ + +/* + * CVBandPrecInitB, CVBPSp*B + * + * Wrappers for the backward phase around the corresponding + * CVODES functions + */ + +int CVBandPrecInitB(void *cvode_mem, int which, int nB, int muB, int mlB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVBANDPRE", "CVBandPrecInitB", MSGBP_MEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CVSPILS_NO_ADJ, "CVBANDPRE", "CVBandPrecInitB", MSGBP_NO_ADJ); + return(CVSPILS_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= ca_mem->ca_nbckpbs ) { + cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVBANDPRE", "CVBandPrecInitB", MSGBP_BAD_WHICH); + return(CVSPILS_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvB_mem->cv_pfree = NULL; + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + flag = CVBandPrecInit(cvodeB_mem, nB, muB, mlB); + + return(flag); +} + diff --git a/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_bandpre_impl.h b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_bandpre_impl.h new file mode 100644 index 0000000..6fd91c5 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_bandpre_impl.h @@ -0,0 +1,77 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.9 $ + * $Date: 2007/11/26 16:19:59 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * Implementation header file for the CVBANDPRE module. + * ----------------------------------------------------------------- + */ + +#ifndef _CVSBANDPRE_IMPL_H +#define _CVSBANDPRE_IMPL_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include +#include + +/* + * ----------------------------------------------------------------- + * Type: CVBandPrecData + * ----------------------------------------------------------------- + */ + +typedef struct CVBandPrecDataRec { + + /* Data set by user in CVBandPrecInit */ + + int N; + int ml, mu; + + /* Data set by CVBandPrecSetup */ + + DlsMat savedJ; + DlsMat savedP; + int *pivots; + + /* Rhs calls */ + + long int nfeBP; + + /* Pointer to cvode_mem */ + + void *cvode_mem; + +} *CVBandPrecData; + +/* + * ----------------------------------------------------------------- + * CVBANDPRE error messages + * ----------------------------------------------------------------- + */ + +#define MSGBP_MEM_NULL "Integrator memory is NULL." +#define MSGBP_LMEM_NULL "Linear solver memory is NULL. One of the SPILS linear solvers must be attached." +#define MSGBP_MEM_FAIL "A memory request failed." +#define MSGBP_BAD_NVECTOR "A required vector operation is not implemented." +#define MSGBP_PMEM_NULL "Band preconditioner memory is NULL. CVBandPrecInit must be called." +#define MSGBP_RHSFUNC_FAILED "The right-hand side routine failed in an unrecoverable manner." + +#define MSGBP_NO_ADJ "Illegal attempt to call before calling CVodeAdjInit." +#define MSGBP_BAD_WHICH "Illegal value for parameter which." + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_bbdpre.c b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_bbdpre.c new file mode 100644 index 0000000..849d27d --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_bbdpre.c @@ -0,0 +1,784 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.13 $ + * $Date: 2009/02/17 02:42:29 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This file contains implementations of routines for a + * band-block-diagonal preconditioner, i.e. a block-diagonal + * matrix with banded blocks, for use with CVODE, a CVSPILS linear + * solver, and the parallel implementation of NVECTOR. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "cvodes_impl.h" +#include "cvodes_bbdpre_impl.h" +#include "cvodes_spils_impl.h" + +#include +#include +#include + +#include + +#define MIN_INC_MULT RCONST(1000.0) + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + +/* Prototypes of functions cvBBDPrecSetup and cvBBDPrecSolve */ +static int cvBBDPrecSetup(realtype t, N_Vector y, N_Vector fy, + booleantype jok, booleantype *jcurPtr, + realtype gamma, void *bbd_data, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); +static int cvBBDPrecSolve(realtype t, N_Vector y, N_Vector fy, + N_Vector r, N_Vector z, + realtype gamma, realtype delta, + int lr, void *bbd_data, N_Vector tmp); + +/* Prototype for cvBBDPrecFree */ +static void cvBBDPrecFree(CVodeMem cv_mem); + +/* Wrapper functions for adjoint code */ +static int cvGlocWrapper(int NlocalB, realtype t, N_Vector yB, N_Vector gB, + void *cvadj_mem); +static int cvCfnWrapper(int NlocalB, realtype t, N_Vector yB, void *cvadj_mem); + +/* Prototype for difference quotient Jacobian calculation routine */ +static int cvBBDDQJac(CVBBDPrecData pdata, realtype t, + N_Vector y, N_Vector gy, + N_Vector ytemp, N_Vector gtemp); + +/* Prototype for the pfree routine */ +static void CVBBDPrecFreeB(CVodeBMem cvB_mem); + +/* + * ================================================================ + * + * PART I - forward problems + * + * ================================================================ + */ + +/* Redability replacements */ + +#define uround (cv_mem->cv_uround) +#define vec_tmpl (cv_mem->cv_tempv) + +/* + * ----------------------------------------------------------------- + * User-Callable Functions: initialization, reinit and free + * ----------------------------------------------------------------- + */ + +int CVBBDPrecInit(void *cvode_mem, int Nlocal, + int mudq, int mldq, + int mukeep, int mlkeep, + realtype dqrely, + CVLocalFn gloc, CVCommFn cfn) +{ + CVodeMem cv_mem; + CVSpilsMem cvspils_mem; + CVBBDPrecData pdata; + int muk, mlk, storage_mu; + int flag; + + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVBBDPRE", "CVBBDPrecInit", MSGBBD_MEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Test if one of the SPILS linear solvers has been attached */ + if (cv_mem->cv_lmem == NULL) { + cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVBBDPRE", "CVBBDPrecInit", MSGBBD_LMEM_NULL); + return(CVSPILS_LMEM_NULL); + } + cvspils_mem = (CVSpilsMem) cv_mem->cv_lmem; + + /* Test if the NVECTOR package is compatible with the BLOCK BAND preconditioner */ + if(vec_tmpl->ops->nvgetarraypointer == NULL) { + cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVBBDPRE", "CVBBDPrecInit", MSGBBD_BAD_NVECTOR); + return(CVSPILS_ILL_INPUT); + } + + /* Allocate data memory */ + pdata = NULL; + pdata = (CVBBDPrecData) malloc(sizeof *pdata); + if (pdata == NULL) { + cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBBDPRE", "CVBBDPrecInit", MSGBBD_MEM_FAIL); + return(CVSPILS_MEM_FAIL); + } + + /* Set pointers to gloc and cfn; load half-bandwidths */ + pdata->cvode_mem = cvode_mem; + pdata->gloc = gloc; + pdata->cfn = cfn; + pdata->mudq = MIN(Nlocal-1, MAX(0,mudq)); + pdata->mldq = MIN(Nlocal-1, MAX(0,mldq)); + muk = MIN(Nlocal-1, MAX(0,mukeep)); + mlk = MIN(Nlocal-1, MAX(0,mlkeep)); + pdata->mukeep = muk; + pdata->mlkeep = mlk; + + /* Allocate memory for saved Jacobian */ + pdata->savedJ = NewBandMat(Nlocal, muk, mlk, muk); + if (pdata->savedJ == NULL) { + free(pdata); pdata = NULL; + cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBBDPRE", "CVBBDPrecInit", MSGBBD_MEM_FAIL); + return(CVSPILS_MEM_FAIL); + } + + /* Allocate memory for preconditioner matrix */ + storage_mu = MIN(Nlocal-1, muk + mlk); + pdata->savedP = NULL; + pdata->savedP = NewBandMat(Nlocal, muk, mlk, storage_mu); + if (pdata->savedP == NULL) { + DestroyMat(pdata->savedJ); + free(pdata); pdata = NULL; + cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBBDPRE", "CVBBDPrecInit", MSGBBD_MEM_FAIL); + return(CVSPILS_MEM_FAIL); + } + /* Allocate memory for pivots */ + pdata->pivots = NULL; + pdata->pivots = NewIntArray(Nlocal); + if (pdata->savedJ == NULL) { + DestroyMat(pdata->savedP); + DestroyMat(pdata->savedJ); + free(pdata); pdata = NULL; + cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBBDPRE", "CVBBDPrecInit", MSGBBD_MEM_FAIL); + return(CVSPILS_MEM_FAIL); + } + + /* Set pdata->dqrely based on input dqrely (0 implies default). */ + pdata->dqrely = (dqrely > ZERO) ? dqrely : RSqrt(uround); + + /* Store Nlocal to be used in CVBBDPrecSetup */ + pdata->n_local = Nlocal; + + /* Set work space sizes and initialize nge */ + pdata->rpwsize = Nlocal*(muk + 2*mlk + storage_mu + 2); + pdata->ipwsize = Nlocal; + pdata->nge = 0; + + /* Overwrite the P_data field in the SPILS memory */ + cvspils_mem->s_P_data = pdata; + + /* Attach the pfree function */ + cvspils_mem->s_pfree = cvBBDPrecFree; + + /* Attach preconditioner solve and setup functions */ + flag = CVSpilsSetPreconditioner(cvode_mem, cvBBDPrecSetup, cvBBDPrecSolve); + + return(flag); +} + + +int CVBBDPrecReInit(void *cvode_mem, + int mudq, int mldq, + realtype dqrely) +{ + CVodeMem cv_mem; + CVSpilsMem cvspils_mem; + CVBBDPrecData pdata; + int Nlocal; + + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVBBDPRE", "CVBBDPrecReInit", MSGBBD_MEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Test if one of the SPILS linear solvers has been attached */ + if (cv_mem->cv_lmem == NULL) { + cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVBBDPRE", "CVBBDPrecReInit", MSGBBD_LMEM_NULL); + return(CVSPILS_LMEM_NULL); + } + cvspils_mem = (CVSpilsMem) cv_mem->cv_lmem; + + /* Test if the preconditioner data is non-NULL */ + if (cvspils_mem->s_P_data == NULL) { + cvProcessError(cv_mem, CVSPILS_PMEM_NULL, "CVBBDPRE", "CVBBDPrecReInit", MSGBBD_PMEM_NULL); + return(CVSPILS_PMEM_NULL); + } + pdata = (CVBBDPrecData) cvspils_mem->s_P_data; + + /* Load half-bandwidths */ + Nlocal = pdata->n_local; + pdata->mudq = MIN(Nlocal-1, MAX(0,mudq)); + pdata->mldq = MIN(Nlocal-1, MAX(0,mldq)); + + /* Set pdata->dqrely based on input dqrely (0 implies default). */ + pdata->dqrely = (dqrely > ZERO) ? dqrely : RSqrt(uround); + + /* Re-initialize nge */ + pdata->nge = 0; + + return(CVSPILS_SUCCESS); +} + +int CVBBDPrecGetWorkSpace(void *cvode_mem, long int *lenrwBBDP, long int *leniwBBDP) +{ + CVodeMem cv_mem; + CVSpilsMem cvspils_mem; + CVBBDPrecData pdata; + + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVBBDPRE", "CVBBDPrecGetWorkSpace", MSGBBD_MEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + if (cv_mem->cv_lmem == NULL) { + cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVBBDPRE", "CVBBDPrecGetWorkSpace", MSGBBD_LMEM_NULL); + return(CVSPILS_LMEM_NULL); + } + cvspils_mem = (CVSpilsMem) cv_mem->cv_lmem; + + if (cvspils_mem->s_P_data == NULL) { + cvProcessError(cv_mem, CVSPILS_PMEM_NULL, "CVBBDPRE", "CVBBDPrecGetWorkSpace", MSGBBD_PMEM_NULL); + return(CVSPILS_PMEM_NULL); + } + pdata = (CVBBDPrecData) cvspils_mem->s_P_data; + + *lenrwBBDP = pdata->rpwsize; + *leniwBBDP = pdata->ipwsize; + + return(CVSPILS_SUCCESS); +} + +int CVBBDPrecGetNumGfnEvals(void *cvode_mem, long int *ngevalsBBDP) +{ + CVodeMem cv_mem; + CVSpilsMem cvspils_mem; + CVBBDPrecData pdata; + + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVBBDPRE", "CVBBDPrecGetNumGfnEvals", MSGBBD_MEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + if (cv_mem->cv_lmem == NULL) { + cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVBBDPRE", "CVBBDPrecGetNumGfnEvals", MSGBBD_LMEM_NULL); + return(CVSPILS_LMEM_NULL); + } + cvspils_mem = (CVSpilsMem) cv_mem->cv_lmem; + + if (cvspils_mem->s_P_data == NULL) { + cvProcessError(cv_mem, CVSPILS_PMEM_NULL, "CVBBDPRE", "CVBBDPrecGetNumGfnEvals", MSGBBD_PMEM_NULL); + return(CVSPILS_PMEM_NULL); + } + pdata = (CVBBDPrecData) cvspils_mem->s_P_data; + + *ngevalsBBDP = pdata->nge; + + return(CVSPILS_SUCCESS); +} + +/* Readability Replacements */ + +#define Nlocal (pdata->n_local) +#define mudq (pdata->mudq) +#define mldq (pdata->mldq) +#define mukeep (pdata->mukeep) +#define mlkeep (pdata->mlkeep) +#define dqrely (pdata->dqrely) +#define gloc (pdata->gloc) +#define cfn (pdata->cfn) +#define savedJ (pdata->savedJ) +#define savedP (pdata->savedP) +#define pivots (pdata->pivots) +#define nge (pdata->nge) + +/* + * ----------------------------------------------------------------- + * Function : cvBBDPrecSetup + * ----------------------------------------------------------------- + * cvBBDPrecSetup generates and factors a banded block of the + * preconditioner matrix on each processor, via calls to the + * user-supplied gloc and cfn functions. It uses difference + * quotient approximations to the Jacobian elements. + * + * cvBBDPrecSetup calculates a new J,if necessary, then calculates + * P = I - gamma*J, and does an LU factorization of P. + * + * The parameters of cvBBDPrecSetup used here are as follows: + * + * t is the current value of the independent variable. + * + * y is the current value of the dependent variable vector, + * namely the predicted value of y(t). + * + * fy is the vector f(t,y). + * + * jok is an input flag indicating whether Jacobian-related + * data needs to be recomputed, as follows: + * jok == FALSE means recompute Jacobian-related data + * from scratch. + * jok == TRUE means that Jacobian data from the + * previous CVBBDPrecon call can be reused + * (with the current value of gamma). + * A CVBBDPrecon call with jok == TRUE should only occur + * after a call with jok == FALSE. + * + * jcurPtr is a pointer to an output integer flag which is + * set by CVBBDPrecon as follows: + * *jcurPtr = TRUE if Jacobian data was recomputed. + * *jcurPtr = FALSE if Jacobian data was not recomputed, + * but saved data was reused. + * + * gamma is the scalar appearing in the Newton matrix. + * + * bbd_data is a pointer to the preconditioner data set by + * CVBBDPrecInit + * + * tmp1, tmp2, and tmp3 are pointers to memory allocated + * for NVectors which are be used by cvBBDPrecSetup + * as temporary storage or work space. + * + * Return value: + * The value returned by this cvBBDPrecSetup function is the int + * 0 if successful, + * 1 for a recoverable error (step will be retried). + * ----------------------------------------------------------------- + */ + +static int cvBBDPrecSetup(realtype t, N_Vector y, N_Vector fy, + booleantype jok, booleantype *jcurPtr, + realtype gamma, void *bbd_data, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) +{ + CVBBDPrecData pdata; + CVodeMem cv_mem; + int ier, retval; + + pdata = (CVBBDPrecData) bbd_data; + + cv_mem = (CVodeMem) pdata->cvode_mem; + + if (jok) { + + /* If jok = TRUE, use saved copy of J */ + *jcurPtr = FALSE; + BandCopy(savedJ, savedP, mukeep, mlkeep); + + } else { + + /* Otherwise call cvBBDDQJac for new J value */ + *jcurPtr = TRUE; + SetToZero(savedJ); + + retval = cvBBDDQJac(pdata, t, y, tmp1, tmp2, tmp3); + if (retval < 0) { + cvProcessError(cv_mem, -1, "CVBBDPRE", "cvBBDPrecSetup", MSGBBD_FUNC_FAILED); + return(-1); + } + if (retval > 0) { + return(1); + } + + BandCopy(savedJ, savedP, mukeep, mlkeep); + + } + + /* Scale and add I to get P = I - gamma*J */ + BandScale(-gamma, savedP); + AddIdentity(savedP); + + /* Do LU factorization of P in place */ + ier = BandGBTRF(savedP, pivots); + + /* Return 0 if the LU was complete; otherwise return 1 */ + if (ier > 0) return(1); + return(0); +} + +/* + * ----------------------------------------------------------------- + * Function : cvBBDPrecSolve + * ----------------------------------------------------------------- + * cvBBDPrecSolve solves a linear system P z = r, with the + * band-block-diagonal preconditioner matrix P generated and + * factored by cvBBDPrecSetup. + * + * The parameters of cvBBDPrecSolve used here are as follows: + * + * r is the right-hand side vector of the linear system. + * + * bbd_data is a pointer to the preconditioner data set by + * CVBBDPrecInit. + * + * z is the output vector computed by cvBBDPrecSolve. + * + * The value returned by the cvBBDPrecSolve function is always 0, + * indicating success. + * ----------------------------------------------------------------- + */ + +static int cvBBDPrecSolve(realtype t, N_Vector y, N_Vector fy, + N_Vector r, N_Vector z, + realtype gamma, realtype delta, + int lr, void *bbd_data, N_Vector tmp) +{ + CVBBDPrecData pdata; + realtype *zd; + + pdata = (CVBBDPrecData) bbd_data; + + /* Copy r to z, then do backsolve and return */ + N_VScale(ONE, r, z); + + zd = N_VGetArrayPointer(z); + + BandGBTRS(savedP, pivots, zd); + + return(0); +} + + +static void cvBBDPrecFree(CVodeMem cv_mem) +{ + CVSpilsMem cvspils_mem; + CVBBDPrecData pdata; + + if (cv_mem->cv_lmem == NULL) return; + cvspils_mem = (CVSpilsMem) cv_mem->cv_lmem; + + if (cvspils_mem->s_P_data == NULL) return; + pdata = (CVBBDPrecData) cvspils_mem->s_P_data; + + DestroyMat(savedJ); + DestroyMat(savedP); + DestroyArray(pivots); + + free(pdata); + pdata = NULL; +} + + + +#define ewt (cv_mem->cv_ewt) +#define h (cv_mem->cv_h) +#define user_data (cv_mem->cv_user_data) + +/* + * ----------------------------------------------------------------- + * Function : cvBBDDQJac + * ----------------------------------------------------------------- + * This routine generates a banded difference quotient approximation + * to the local block of the Jacobian of g(t,y). It assumes that a + * band matrix of type BandMat is stored columnwise, and that elements + * within each column are contiguous. All matrix elements are generated + * as difference quotients, by way of calls to the user routine gloc. + * By virtue of the band structure, the number of these calls is + * bandwidth + 1, where bandwidth = mldq + mudq + 1. + * But the band matrix kept has bandwidth = mlkeep + mukeep + 1. + * This routine also assumes that the local elements of a vector are + * stored contiguously. + * ----------------------------------------------------------------- + */ + +static int cvBBDDQJac(CVBBDPrecData pdata, realtype t, + N_Vector y, N_Vector gy, + N_Vector ytemp, N_Vector gtemp) +{ + CVodeMem cv_mem; + realtype gnorm, minInc, inc, inc_inv; + int group, i, j, width, ngroups, i1, i2; + realtype *y_data, *ewt_data, *gy_data, *gtemp_data, *ytemp_data, *col_j; + int retval; + + cv_mem = (CVodeMem) pdata->cvode_mem; + + /* Load ytemp with y = predicted solution vector */ + N_VScale(ONE, y, ytemp); + + /* Call cfn and gloc to get base value of g(t,y) */ + if (cfn != NULL) { + retval = cfn(Nlocal, t, y, user_data); + if (retval != 0) return(retval); + } + + retval = gloc(Nlocal, t, ytemp, gy, user_data); + nge++; + if (retval != 0) return(retval); + + /* Obtain pointers to the data for various vectors */ + y_data = N_VGetArrayPointer(y); + gy_data = N_VGetArrayPointer(gy); + ewt_data = N_VGetArrayPointer(ewt); + ytemp_data = N_VGetArrayPointer(ytemp); + gtemp_data = N_VGetArrayPointer(gtemp); + + /* Set minimum increment based on uround and norm of g */ + gnorm = N_VWrmsNorm(gy, ewt); + minInc = (gnorm != ZERO) ? + (MIN_INC_MULT * ABS(h) * uround * Nlocal * gnorm) : ONE; + + /* Set bandwidth and number of column groups for band differencing */ + width = mldq + mudq + 1; + ngroups = MIN(width, Nlocal); + + /* Loop over groups */ + for (group=1; group <= ngroups; group++) { + + /* Increment all y_j in group */ + for(j=group-1; j < Nlocal; j+=width) { + inc = MAX(dqrely*ABS(y_data[j]), minInc/ewt_data[j]); + ytemp_data[j] += inc; + } + + /* Evaluate g with incremented y */ + retval = gloc(Nlocal, t, ytemp, gtemp, user_data); + nge++; + if (retval != 0) return(retval); + + /* Restore ytemp, then form and load difference quotients */ + for (j=group-1; j < Nlocal; j+=width) { + ytemp_data[j] = y_data[j]; + col_j = BAND_COL(savedJ,j); + inc = MAX(dqrely*ABS(y_data[j]), minInc/ewt_data[j]); + inc_inv = ONE/inc; + i1 = MAX(0, j-mukeep); + i2 = MIN(j+mlkeep, Nlocal-1); + for (i=i1; i <= i2; i++) + BAND_COL_ELEM(col_j,i,j) = + inc_inv * (gtemp_data[i] - gy_data[i]); + } + } + + return(0); +} + + +/* + * ================================================================ + * + * PART II - backward problems + * + * ================================================================ + */ + + +/* Additional readability replacements */ + +#define ytmp (ca_mem->ca_ytmp) +#define yStmp (ca_mem->ca_yStmp) +#define IMget (ca_mem->ca_IMget) + +#define gloc_B (cvbbdB_mem->glocB) +#define cfn_B (cvbbdB_mem->cfnB) + +/* + * CVBBDPrecInitB, CVBPSp*B + * + * Wrappers for the backward phase around the corresponding CVODES functions + */ + +int CVBBDPrecInitB(void *cvode_mem, int which, int NlocalB, + int mudqB, int mldqB, + int mukeepB, int mlkeepB, + realtype dqrelyB, + CVLocalFnB glocB, CVCommFnB cfnB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + CVBBDPrecDataB cvbbdB_mem; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVBBDPRE", "CVBBDPrecInitB", MSGBBD_MEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CVSPILS_NO_ADJ, "CVBBDPRE", "CVBBDPrecInitB", MSGBBD_NO_ADJ); + return(CVSPILS_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= ca_mem->ca_nbckpbs ) { + cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVBBDPRE", "CVBBDPrecInitB", MSGBBD_BAD_WHICH); + return(CVSPILS_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + /* Initialize the BBD preconditioner */ + flag = CVBBDPrecInit(cvodeB_mem, NlocalB, + mudqB, mldqB, + mukeepB, mlkeepB, + dqrelyB, + cvGlocWrapper, cvCfnWrapper); + + if (flag != CV_SUCCESS) return(flag); + + + /* Get memory for CVBBDPrecDataB to store the user-provided + * functions which will be called from the wrappers */ + cvbbdB_mem = NULL; + cvbbdB_mem = (CVBBDPrecDataB) malloc(sizeof(* cvbbdB_mem)); + if (cvbbdB_mem == NULL) { + cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBBDPRE", "CVBBDPrecInitB", MSGBBD_MEM_FAIL); + return(CVSPILS_MEM_FAIL); + } + + gloc_B = glocB; + cfn_B = cfnB; + + /* attach pmem and pfree */ + cvB_mem->cv_pmem = cvbbdB_mem; + cvB_mem->cv_pfree = CVBBDPrecFreeB; + + return(CVSPILS_SUCCESS); +} + +int CVBBDPrecReInitB(void *cvode_mem, int which, + int mudqB, int mldqB, + realtype dqrelyB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVBBDPRE", "CVBBDPrecReInitB", MSGBBD_MEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CVSPILS_NO_ADJ, "CVBBDPRE", "CVBBDPrecReInitB", MSGBBD_NO_ADJ); + return(CVSPILS_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= ca_mem->ca_nbckpbs ) { + cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVBBDPRE", "CVBBDPrecReInitB", MSGBBD_BAD_WHICH); + return(CVSPILS_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + flag = CVBBDPrecReInit(cvodeB_mem, mudqB, mldqB, dqrelyB); + + return(flag); +} + + +static void CVBBDPrecFreeB(CVodeBMem cvB_mem) +{ + free(cvB_mem->cv_pmem); + cvB_mem->cv_pmem = NULL; +} + + +/* + * cvGlocWrapper + * + * This routine interfaces to the CVLocalFnB routine + * provided by the user. + */ + +static int cvGlocWrapper(int NlocalB, realtype t, N_Vector yB, N_Vector gB, void *cvode_mem) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + CVBBDPrecDataB cvbbdB_mem; + int retval, flag; + + cv_mem = (CVodeMem) cvode_mem; + + ca_mem = cv_mem->cv_adj_mem; + + cvB_mem = ca_mem->ca_bckpbCrt; + + cvbbdB_mem = (CVBBDPrecDataB) (cvB_mem->cv_pmem); + + /* Forward solution from interpolation */ + flag = IMget(cv_mem, t, ytmp, NULL); + if (flag != CV_SUCCESS) { + cvProcessError(cv_mem, -1, "CVBBDPRE", "cvGlocWrapper", MSGBBD_BAD_TINTERP); + return(-1); + } + + /* Call user's adjoint glocB routine */ + retval = gloc_B(NlocalB, t, ytmp, yB, gB, cvB_mem->cv_user_data); + + return(retval); +} + +/* + * cvCfnWrapper + * + * This routine interfaces to the CVCommFnB routine + * provided by the user. + */ + +static int cvCfnWrapper(int NlocalB, realtype t, N_Vector yB, void *cvode_mem) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + CVBBDPrecDataB cvbbdB_mem; + int retval, flag; + + cv_mem = (CVodeMem) cvode_mem; + + ca_mem = cv_mem->cv_adj_mem; + + cvB_mem = ca_mem->ca_bckpbCrt; + + cvbbdB_mem = (CVBBDPrecDataB) (cvB_mem->cv_pmem); + + if (cfn_B == NULL) return(0); + + /* Forward solution from interpolation */ + flag = IMget(cv_mem, t, ytmp, NULL); + if (flag != CV_SUCCESS) { + cvProcessError(cv_mem, -1, "CVBBDPRE", "cvCfnWrapper", MSGBBD_BAD_TINTERP); + return(-1); + } + + /* Call user's adjoint cfnB routine */ + retval = cfn_B(NlocalB, t, ytmp, yB, cvB_mem->cv_user_data); + + return(retval); +} + diff --git a/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_bbdpre_impl.h b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_bbdpre_impl.h new file mode 100644 index 0000000..04ef61b --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_bbdpre_impl.h @@ -0,0 +1,102 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.7 $ + * $Date: 2007/04/30 17:41:06 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * Implementation header file for the CVBBDPRE module. + * ----------------------------------------------------------------- + */ + +#ifndef _CVSBBDPRE_IMPL_H +#define _CVSBBDPRE_IMPL_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ----------------------------------------------------------------- + * Type: CVBBDPrecData + * ----------------------------------------------------------------- + */ + +typedef struct CVBBDPrecDataRec { + + /* passed by user to CVBBDPrecAlloc and used by PrecSetup/PrecSolve */ + + int mudq, mldq, mukeep, mlkeep; + realtype dqrely; + CVLocalFn gloc; + CVCommFn cfn; + + /* set by CVBBDPrecSetup and used by CVBBDPrecSolve */ + + DlsMat savedJ; + DlsMat savedP; + int *pivots; + + /* set by CVBBDPrecAlloc and used by CVBBDPrecSetup */ + + int n_local; + + /* available for optional output */ + + long int rpwsize; + long int ipwsize; + long int nge; + + /* pointer to cvode_mem */ + + void *cvode_mem; + +} *CVBBDPrecData; + + +/* + * ----------------------------------------------------------------- + * Type: CVBBDPrecDataB + * ----------------------------------------------------------------- + */ + +typedef struct CVBBDPrecDataRecB { + + /* BBD user functions (glocB and cfnB) for backward run */ + CVLocalFnB glocB; + CVCommFnB cfnB; + +} *CVBBDPrecDataB; + +/* + * ----------------------------------------------------------------- + * CVBBDPRE error messages + * ----------------------------------------------------------------- + */ + +#define MSGBBD_MEM_NULL "Integrator memory is NULL." +#define MSGBBD_LMEM_NULL "Linear solver memory is NULL. One of the SPILS linear solvers must be attached." +#define MSGBBD_MEM_FAIL "A memory request failed." +#define MSGBBD_BAD_NVECTOR "A required vector operation is not implemented." +#define MSGBBD_PMEM_NULL "BBD peconditioner memory is NULL. CVBBDPrecInit must be called." +#define MSGBBD_FUNC_FAILED "The gloc or cfn routine failed in an unrecoverable manner." + +#define MSGBBD_NO_ADJ "Illegal attempt to call before calling CVodeAdjInit." +#define MSGBBD_BAD_WHICH "Illegal value for the which parameter." +#define MSGBBD_PDATAB_NULL "BBD preconditioner memory is NULL for the backward integration." +#define MSGBBD_BAD_TINTERP "Bad t for interpolation." + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_dense.c b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_dense.c new file mode 100644 index 0000000..b7cbb6b --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_dense.c @@ -0,0 +1,438 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.13 $ + * $Date: 2009/02/17 02:42:29 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for the CVSDENSE linear solver. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include +#include "cvodes_direct_impl.h" +#include "cvodes_impl.h" + +#include + +/* Constants */ + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) +#define TWO RCONST(2.0) + +/* CVSDENSE linit, lsetup, lsolve, and lfree routines */ +static int cvDenseInit(CVodeMem cv_mem); +static int cvDenseSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, + N_Vector fpred, booleantype *jcurPtr, + N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); +static int cvDenseSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, + N_Vector ycur, N_Vector fcur); +static void cvDenseFree(CVodeMem cv_mem); + +/* CVSDENSE lfreeB function */ +static void cvDenseFreeB(CVodeBMem cvb_mem); + +/* + * ================================================================ + * + * PART I - forward problems + * + * ================================================================ + */ + + +/* Readability Replacements */ + +#define lmm (cv_mem->cv_lmm) +#define f (cv_mem->cv_f) +#define nst (cv_mem->cv_nst) +#define tn (cv_mem->cv_tn) +#define h (cv_mem->cv_h) +#define gamma (cv_mem->cv_gamma) +#define gammap (cv_mem->cv_gammap) +#define gamrat (cv_mem->cv_gamrat) +#define ewt (cv_mem->cv_ewt) +#define linit (cv_mem->cv_linit) +#define lsetup (cv_mem->cv_lsetup) +#define lsolve (cv_mem->cv_lsolve) +#define lfree (cv_mem->cv_lfree) +#define lmem (cv_mem->cv_lmem) +#define vec_tmpl (cv_mem->cv_tempv) +#define setupNonNull (cv_mem->cv_setupNonNull) + +#define mtype (cvdls_mem->d_type) +#define n (cvdls_mem->d_n) +#define jacDQ (cvdls_mem->d_jacDQ) +#define jac (cvdls_mem->d_djac) +#define M (cvdls_mem->d_M) +#define pivots (cvdls_mem->d_pivots) +#define savedJ (cvdls_mem->d_savedJ) +#define nstlj (cvdls_mem->d_nstlj) +#define nje (cvdls_mem->d_nje) +#define nfeDQ (cvdls_mem->d_nfeDQ) +#define J_data (cvdls_mem->d_J_data) +#define last_flag (cvdls_mem->d_last_flag) + +/* + * ----------------------------------------------------------------- + * CVDense + * ----------------------------------------------------------------- + * This routine initializes the memory record and sets various function + * fields specific to the dense linear solver module. CVDense first + * calls the existing lfree routine if this is not NULL. Then it sets + * the cv_linit, cv_lsetup, cv_lsolve, cv_lfree fields in (*cvode_mem) + * to be cvDenseInit, cvDenseSetup, cvDenseSolve, and cvDenseFree, + * respectively. It allocates memory for a structure of type + * CVDlsMemRec and sets the cv_lmem field in (*cvode_mem) to the + * address of this structure. It sets setupNonNull in (*cvode_mem) to + * TRUE, and the d_jac field to the default CVDenseDQJac. + * Finally, it allocates memory for M, savedJ, and pivots. + * The return value is SUCCESS = 0, or LMEM_FAIL = -1. + * + * NOTE: The dense linear solver assumes a serial implementation + * of the NVECTOR package. Therefore, CVDense will first + * test for compatible a compatible N_Vector internal + * representation by checking that N_VGetArrayPointer and + * N_VSetArrayPointer exist. + * ----------------------------------------------------------------- + */ + +int CVDense(void *cvode_mem, int N) +{ + CVodeMem cv_mem; + CVDlsMem cvdls_mem; + + /* Return immediately if cvode_mem is NULL */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVDLS_MEM_NULL, "CVSDENSE", "CVDense", MSGD_CVMEM_NULL); + return(CVDLS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Test if the NVECTOR package is compatible with the DENSE solver */ + if (vec_tmpl->ops->nvgetarraypointer == NULL || + vec_tmpl->ops->nvsetarraypointer == NULL) { + cvProcessError(cv_mem, CVDLS_ILL_INPUT, "CVSDENSE", "CVDense", MSGD_BAD_NVECTOR); + return(CVDLS_ILL_INPUT); + } + + if (lfree !=NULL) lfree(cv_mem); + + /* Set four main function fields in cv_mem */ + linit = cvDenseInit; + lsetup = cvDenseSetup; + lsolve = cvDenseSolve; + lfree = cvDenseFree; + + /* Get memory for CVDlsMemRec */ + cvdls_mem = NULL; + cvdls_mem = (CVDlsMem) malloc(sizeof(struct CVDlsMemRec)); + if (cvdls_mem == NULL) { + cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSDENSE", "CVDense", MSGD_MEM_FAIL); + return(CVDLS_MEM_FAIL); + } + + /* Set matrix type */ + mtype = SUNDIALS_DENSE; + + /* Initialize Jacobian-related data */ + jacDQ = TRUE; + jac = NULL; + J_data = NULL; + + last_flag = CVDLS_SUCCESS; + + setupNonNull = TRUE; + + /* Set problem dimension */ + n = N; + + /* Allocate memory for M, savedJ, and pivot array */ + + M = NULL; + M = NewDenseMat(N, N); + if (M == NULL) { + cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSDENSE", "CVDense", MSGD_MEM_FAIL); + free(cvdls_mem); cvdls_mem = NULL; + return(CVDLS_MEM_FAIL); + } + savedJ = NULL; + savedJ = NewDenseMat(N, N); + if (savedJ == NULL) { + cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSDENSE", "CVDense", MSGD_MEM_FAIL); + DestroyMat(M); + free(cvdls_mem); cvdls_mem = NULL; + return(CVDLS_MEM_FAIL); + } + pivots = NULL; + pivots = NewIntArray(N); + if (pivots == NULL) { + cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSDENSE", "CVDense", MSGD_MEM_FAIL); + DestroyMat(M); + DestroyMat(savedJ); + free(cvdls_mem); cvdls_mem = NULL; + return(CVDLS_MEM_FAIL); + } + + /* Attach linear solver memory to integrator memory */ + lmem = cvdls_mem; + + return(CVDLS_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * cvDenseInit + * ----------------------------------------------------------------- + * This routine does remaining initializations specific to the dense + * linear solver. + * ----------------------------------------------------------------- + */ + +static int cvDenseInit(CVodeMem cv_mem) +{ + CVDlsMem cvdls_mem; + + cvdls_mem = (CVDlsMem) lmem; + + nje = 0; + nfeDQ = 0; + nstlj = 0; + + /* Set Jacobian function and data, depending on jacDQ */ + if (jacDQ) { + jac = cvDlsDenseDQJac; + J_data = cv_mem; + } else { + J_data = cv_mem->cv_user_data; + } + + last_flag = CVDLS_SUCCESS; + return(0); +} + +/* + * ----------------------------------------------------------------- + * cvDenseSetup + * ----------------------------------------------------------------- + * This routine does the setup operations for the dense linear solver. + * It makes a decision whether or not to call the Jacobian evaluation + * routine based on various state variables, and if not it uses the + * saved copy. In any case, it constructs the Newton matrix + * M = I - gamma*J, updates counters, and calls the dense LU + * factorization routine. + * ----------------------------------------------------------------- + */ + +static int cvDenseSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, + N_Vector fpred, booleantype *jcurPtr, + N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) +{ + CVDlsMem cvdls_mem; + booleantype jbad, jok; + realtype dgamma; + int ier, retval; + + cvdls_mem = (CVDlsMem) lmem; + + /* Use nst, gamma/gammap, and convfail to set J eval. flag jok */ + + dgamma = ABS((gamma/gammap) - ONE); + jbad = (nst == 0) || (nst > nstlj + CVD_MSBJ) || + ((convfail == CV_FAIL_BAD_J) && (dgamma < CVD_DGMAX)) || + (convfail == CV_FAIL_OTHER); + jok = !jbad; + + if (jok) { + + /* If jok = TRUE, use saved copy of J */ + *jcurPtr = FALSE; + DenseCopy(savedJ, M); + + } else { + + /* If jok = FALSE, call jac routine for new J value */ + nje++; + nstlj = nst; + *jcurPtr = TRUE; + SetToZero(M); + + retval = jac(n, tn, ypred, fpred, M, J_data, vtemp1, vtemp2, vtemp3); + if (retval < 0) { + cvProcessError(cv_mem, CVDLS_JACFUNC_UNRECVR, "CVSDENSE", "cvDenseSetup", MSGD_JACFUNC_FAILED); + last_flag = CVDLS_JACFUNC_UNRECVR; + return(-1); + } + if (retval > 0) { + last_flag = CVDLS_JACFUNC_RECVR; + return(1); + } + + DenseCopy(M, savedJ); + + } + + /* Scale and add I to get M = I - gamma*J */ + DenseScale(-gamma, M); + AddIdentity(M); + + /* Do LU factorization of M */ + ier = DenseGETRF(M, pivots); + + /* Return 0 if the LU was complete; otherwise return 1 */ + last_flag = ier; + if (ier > 0) return(1); + return(0); +} + +/* + * ----------------------------------------------------------------- + * cvDenseSolve + * ----------------------------------------------------------------- + * This routine handles the solve operation for the dense linear solver + * by calling the dense backsolve routine. The returned value is 0. + * ----------------------------------------------------------------- + */ + +static int cvDenseSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, + N_Vector ycur, N_Vector fcur) +{ + CVDlsMem cvdls_mem; + realtype *bd; + + cvdls_mem = (CVDlsMem) lmem; + + bd = N_VGetArrayPointer(b); + + DenseGETRS(M, pivots, bd); + + /* If CV_BDF, scale the correction to account for change in gamma */ + if ((lmm == CV_BDF) && (gamrat != ONE)) { + N_VScale(TWO/(ONE + gamrat), b, b); + } + + last_flag = CVDLS_SUCCESS; + return(0); +} + +/* + * ----------------------------------------------------------------- + * cvDenseFree + * ----------------------------------------------------------------- + * This routine frees memory specific to the dense linear solver. + * ----------------------------------------------------------------- + */ + +static void cvDenseFree(CVodeMem cv_mem) +{ + CVDlsMem cvdls_mem; + + cvdls_mem = (CVDlsMem) lmem; + + DestroyMat(M); + DestroyMat(savedJ); + DestroyArray(pivots); + free(cvdls_mem); cvdls_mem = NULL; +} + +/* + * ================================================================ + * + * PART II - backward problems + * + * ================================================================ + */ + +/* + * CVDenseB is a wraper around CVDense. It attaches the CVSDENSE linear solver + * to the backward problem memory block. + */ + +int CVDenseB(void *cvode_mem, int which, int nB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + CVDlsMemB cvdlsB_mem; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVDLS_MEM_NULL, "CVSDENSE", "CVDenseB", MSGD_CVMEM_NULL); + return(CVDLS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CVDLS_NO_ADJ, "CVSDENSE", "CVDenseB", MSGD_NO_ADJ); + return(CVDLS_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= ca_mem->ca_nbckpbs ) { + cvProcessError(cv_mem, CVDLS_ILL_INPUT, "CVSDENSE", "CVDenseB", MSGD_BAD_WHICH); + return(CVDLS_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + /* Get memory for CVDlsMemRecB */ + cvdlsB_mem = (CVDlsMemB) malloc(sizeof(struct CVDlsMemRecB)); + if (cvdlsB_mem == NULL) { + cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSDENSE", "CVDenseB", MSGD_MEM_FAIL); + return(CVDLS_MEM_FAIL); + } + + /* set matrix type */ + cvdlsB_mem->d_typeB = SUNDIALS_DENSE; + + /* initialize Jacobian function */ + cvdlsB_mem->d_djacB = NULL; + + /* attach lmemB and lfreeB */ + cvB_mem->cv_lmem = cvdlsB_mem; + cvB_mem->cv_lfree = cvDenseFreeB; + + flag = CVDense(cvodeB_mem, nB); + + if (flag != CVDLS_SUCCESS) { + free(cvdlsB_mem); + cvdlsB_mem = NULL; + } + + return(flag); +} + +/* + * cvDenseFreeB frees the memory associated with the CVSDENSE linear + * solver for backward integration. + */ + +static void cvDenseFreeB(CVodeBMem cvB_mem) +{ + CVDlsMemB cvdlsB_mem; + + cvdlsB_mem = (CVDlsMemB) (cvB_mem->cv_lmem); + + free(cvdlsB_mem); +} + diff --git a/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_diag.c b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_diag.c new file mode 100644 index 0000000..f1fb320 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_diag.c @@ -0,0 +1,507 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.7 $ + * $Date: 2007/11/26 16:19:59 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for the CVDIAG linear solver. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "cvodes_diag_impl.h" +#include "cvodes_impl.h" + +/* Other Constants */ + +#define FRACT RCONST(0.1) +#define ONE RCONST(1.0) + +/* CVDIAG linit, lsetup, lsolve, and lfree routines */ + +static int CVDiagInit(CVodeMem cv_mem); + +static int CVDiagSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, + N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, + N_Vector vtemp2, N_Vector vtemp3); + +static int CVDiagSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, + N_Vector ycur, N_Vector fcur); + +static void CVDiagFree(CVodeMem cv_mem); + + +/* + * ================================================================ + * + * PART I - forward problems + * + * ================================================================ + */ + + +/* Readability Replacements */ + +#define lrw1 (cv_mem->cv_lrw1) +#define liw1 (cv_mem->cv_liw1) +#define f (cv_mem->cv_f) +#define uround (cv_mem->cv_uround) +#define tn (cv_mem->cv_tn) +#define h (cv_mem->cv_h) +#define rl1 (cv_mem->cv_rl1) +#define gamma (cv_mem->cv_gamma) +#define ewt (cv_mem->cv_ewt) +#define nfe (cv_mem->cv_nfe) +#define zn (cv_mem->cv_zn) +#define linit (cv_mem->cv_linit) +#define lsetup (cv_mem->cv_lsetup) +#define lsolve (cv_mem->cv_lsolve) +#define lfree (cv_mem->cv_lfree) +#define lmem (cv_mem->cv_lmem) +#define vec_tmpl (cv_mem->cv_tempv) +#define setupNonNull (cv_mem->cv_setupNonNull) + +#define gammasv (cvdiag_mem->di_gammasv) +#define M (cvdiag_mem->di_M) +#define bit (cvdiag_mem->di_bit) +#define bitcomp (cvdiag_mem->di_bitcomp) +#define nfeDI (cvdiag_mem->di_nfeDI) +#define last_flag (cvdiag_mem->di_last_flag) + + +/* + * ----------------------------------------------------------------- + * CVDiag + * ----------------------------------------------------------------- + * This routine initializes the memory record and sets various function + * fields specific to the diagonal linear solver module. CVDense first + * calls the existing lfree routine if this is not NULL. Then it sets + * the cv_linit, cv_lsetup, cv_lsolve, cv_lfree fields in (*cvode_mem) + * to be CVDiagInit, CVDiagSetup, CVDiagSolve, and CVDiagFree, + * respectively. It allocates memory for a structure of type + * CVDiagMemRec and sets the cv_lmem field in (*cvode_mem) to the + * address of this structure. It sets setupNonNull in (*cvode_mem) to + * TRUE. Finally, it allocates memory for M, bit, and bitcomp. + * The CVDiag return value is SUCCESS = 0, LMEM_FAIL = -1, or + * LIN_ILL_INPUT=-2. + * ----------------------------------------------------------------- + */ + +int CVDiag(void *cvode_mem) +{ + CVodeMem cv_mem; + CVDiagMem cvdiag_mem; + + /* Return immediately if cvode_mem is NULL */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVDIAG_MEM_NULL, "CVDIAG", "CVDiag", MSGDG_CVMEM_NULL); + return(CVDIAG_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Check if N_VCompare and N_VInvTest are present */ + if(vec_tmpl->ops->nvcompare == NULL || + vec_tmpl->ops->nvinvtest == NULL) { + cvProcessError(cv_mem, CVDIAG_ILL_INPUT, "CVDIAG", "CVDiag", MSGDG_BAD_NVECTOR); + return(CVDIAG_ILL_INPUT); + } + + if (lfree != NULL) lfree(cv_mem); + + /* Set four main function fields in cv_mem */ + linit = CVDiagInit; + lsetup = CVDiagSetup; + lsolve = CVDiagSolve; + lfree = CVDiagFree; + + /* Get memory for CVDiagMemRec */ + cvdiag_mem = NULL; + cvdiag_mem = (CVDiagMem) malloc(sizeof(CVDiagMemRec)); + if (cvdiag_mem == NULL) { + cvProcessError(cv_mem, CVDIAG_MEM_FAIL, "CVDIAG", "CVDiag", MSGDG_MEM_FAIL); + return(CVDIAG_MEM_FAIL); + } + + last_flag = CVDIAG_SUCCESS; + + /* Set flag setupNonNull = TRUE */ + setupNonNull = TRUE; + + /* Allocate memory for M, bit, and bitcomp */ + + M = N_VClone(vec_tmpl); + if (M == NULL) { + cvProcessError(cv_mem, CVDIAG_MEM_FAIL, "CVDIAG", "CVDiag", MSGDG_MEM_FAIL); + free(cvdiag_mem); cvdiag_mem = NULL; + return(CVDIAG_MEM_FAIL); + } + bit = N_VClone(vec_tmpl); + if (bit == NULL) { + cvProcessError(cv_mem, CVDIAG_MEM_FAIL, "CVDIAG", "CVDiag", MSGDG_MEM_FAIL); + N_VDestroy(M); + free(cvdiag_mem); cvdiag_mem = NULL; + return(CVDIAG_MEM_FAIL); + } + bitcomp = N_VClone(vec_tmpl); + if (bitcomp == NULL) { + cvProcessError(cv_mem, CVDIAG_MEM_FAIL, "CVDIAG", "CVDiag", MSGDG_MEM_FAIL); + N_VDestroy(M); + N_VDestroy(bit); + free(cvdiag_mem); cvdiag_mem = NULL; + return(CVDIAG_MEM_FAIL); + } + + /* Attach linear solver memory to integrator memory */ + lmem = cvdiag_mem; + + return(CVDIAG_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * CVDiagGetWorkSpace + * ----------------------------------------------------------------- + */ + +int CVDiagGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS) +{ + CVodeMem cv_mem; + + /* Return immediately if cvode_mem is NULL */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVDIAG_MEM_NULL, "CVDIAG", "CVDiagGetWorkSpace", MSGDG_CVMEM_NULL); + return(CVDIAG_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + *lenrwLS = 3*lrw1; + *leniwLS = 3*liw1; + + return(CVDIAG_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * CVDiagGetNumRhsEvals + * ----------------------------------------------------------------- + */ + +int CVDiagGetNumRhsEvals(void *cvode_mem, long int *nfevalsLS) +{ + CVodeMem cv_mem; + CVDiagMem cvdiag_mem; + + /* Return immediately if cvode_mem is NULL */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVDIAG_MEM_NULL, "CVDIAG", "CVDiagGetNumRhsEvals", MSGDG_CVMEM_NULL); + return(CVDIAG_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + if (lmem == NULL) { + cvProcessError(cv_mem, CVDIAG_LMEM_NULL, "CVDIAG", "CVDiagGetNumRhsEvals", MSGDG_LMEM_NULL); + return(CVDIAG_LMEM_NULL); + } + cvdiag_mem = (CVDiagMem) lmem; + + *nfevalsLS = nfeDI; + + return(CVDIAG_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * CVDiagGetLastFlag + * ----------------------------------------------------------------- + */ + +int CVDiagGetLastFlag(void *cvode_mem, int *flag) +{ + CVodeMem cv_mem; + CVDiagMem cvdiag_mem; + + /* Return immediately if cvode_mem is NULL */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVDIAG_MEM_NULL, "CVDIAG", "CVDiagGetLastFlag", MSGDG_CVMEM_NULL); + return(CVDIAG_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + if (lmem == NULL) { + cvProcessError(cv_mem, CVDIAG_LMEM_NULL, "CVDIAG", "CVDiagGetLastFlag", MSGDG_LMEM_NULL); + return(CVDIAG_LMEM_NULL); + } + cvdiag_mem = (CVDiagMem) lmem; + + *flag = last_flag; + + return(CVDIAG_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * CVDiagGetReturnFlagName + * ----------------------------------------------------------------- + */ + +char *CVDiagGetReturnFlagName(int flag) +{ + char *name; + + name = (char *)malloc(30*sizeof(char)); + + switch(flag) { + case CVDIAG_SUCCESS: + sprintf(name,"CVDIAG_SUCCESS"); + break; + case CVDIAG_MEM_NULL: + sprintf(name,"CVDIAG_MEM_NULL"); + break; + case CVDIAG_LMEM_NULL: + sprintf(name,"CVDIAG_LMEM_NULL"); + break; + case CVDIAG_ILL_INPUT: + sprintf(name,"CVDIAG_ILL_INPUT"); + break; + case CVDIAG_MEM_FAIL: + sprintf(name,"CVDIAG_MEM_FAIL"); + break; + case CVDIAG_INV_FAIL: + sprintf(name,"CVDIAG_INV_FAIL"); + break; + case CVDIAG_RHSFUNC_UNRECVR: + sprintf(name,"CVDIAG_RHSFUNC_UNRECVR"); + break; + case CVDIAG_RHSFUNC_RECVR: + sprintf(name,"CVDIAG_RHSFUNC_RECVR"); + break; + case CVDIAG_NO_ADJ: + sprintf(name,"CVDIAG_NO_ADJ"); + break; + default: + sprintf(name,"NONE"); + } + + return(name); +} + +/* + * ----------------------------------------------------------------- + * CVDiagInit + * ----------------------------------------------------------------- + * This routine does remaining initializations specific to the diagonal + * linear solver. + * ----------------------------------------------------------------- + */ + +static int CVDiagInit(CVodeMem cv_mem) +{ + CVDiagMem cvdiag_mem; + + cvdiag_mem = (CVDiagMem) lmem; + + nfeDI = 0; + + last_flag = CVDIAG_SUCCESS; + return(0); +} + +/* + * ----------------------------------------------------------------- + * CVDiagSetup + * ----------------------------------------------------------------- + * This routine does the setup operations for the diagonal linear + * solver. It constructs a diagonal approximation to the Newton matrix + * M = I - gamma*J, updates counters, and inverts M. + * ----------------------------------------------------------------- + */ + +static int CVDiagSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, + N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, + N_Vector vtemp2, N_Vector vtemp3) +{ + realtype r; + N_Vector ftemp, y; + booleantype invOK; + CVDiagMem cvdiag_mem; + int retval; + + cvdiag_mem = (CVDiagMem) lmem; + + /* Rename work vectors for use as temporary values of y and f */ + ftemp = vtemp1; + y = vtemp2; + + /* Form y with perturbation = FRACT*(func. iter. correction) */ + r = FRACT * rl1; + N_VLinearSum(h, fpred, -ONE, zn[1], ftemp); + N_VLinearSum(r, ftemp, ONE, ypred, y); + + /* Evaluate f at perturbed y */ + retval = f(tn, y, M, cv_mem->cv_user_data); + nfeDI++; + if (retval < 0) { + cvProcessError(cv_mem, CVDIAG_RHSFUNC_UNRECVR, "CVDIAG", "CVDiagSetup", MSGDG_RHSFUNC_FAILED); + last_flag = CVDIAG_RHSFUNC_UNRECVR; + return(-1); + } + if (retval > 0) { + last_flag = CVDIAG_RHSFUNC_RECVR; + return(1); + } + + /* Construct M = I - gamma*J with J = diag(deltaf_i/deltay_i) */ + N_VLinearSum(ONE, M, -ONE, fpred, M); + N_VLinearSum(FRACT, ftemp, -h, M, M); + N_VProd(ftemp, ewt, y); + /* Protect against deltay_i being at roundoff level */ + N_VCompare(uround, y, bit); + N_VAddConst(bit, -ONE, bitcomp); + N_VProd(ftemp, bit, y); + N_VLinearSum(FRACT, y, -ONE, bitcomp, y); + N_VDiv(M, y, M); + N_VProd(M, bit, M); + N_VLinearSum(ONE, M, -ONE, bitcomp, M); + + /* Invert M with test for zero components */ + invOK = N_VInvTest(M, M); + if (!invOK) { + last_flag = CVDIAG_INV_FAIL; + return(1); + } + + /* Set jcur = TRUE, save gamma in gammasv, and return */ + *jcurPtr = TRUE; + gammasv = gamma; + last_flag = CVDIAG_SUCCESS; + return(0); +} + +/* + * ----------------------------------------------------------------- + * CVDiagSolve + * ----------------------------------------------------------------- + * This routine performs the solve operation for the diagonal linear + * solver. If necessary it first updates gamma in M = I - gamma*J. + * ----------------------------------------------------------------- + */ + +static int CVDiagSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, + N_Vector ycur, N_Vector fcur) +{ + booleantype invOK; + realtype r; + CVDiagMem cvdiag_mem; + + cvdiag_mem = (CVDiagMem) lmem; + + /* If gamma has changed, update factor in M, and save gamma value */ + + if (gammasv != gamma) { + r = gamma / gammasv; + N_VInv(M, M); + N_VAddConst(M, -ONE, M); + N_VScale(r, M, M); + N_VAddConst(M, ONE, M); + invOK = N_VInvTest(M, M); + if (!invOK) { + last_flag = CVDIAG_INV_FAIL; + return (1); + } + gammasv = gamma; + } + + /* Apply M-inverse to b */ + N_VProd(b, M, b); + + last_flag = CVDIAG_SUCCESS; + return(0); +} + +/* + * ----------------------------------------------------------------- + * CVDiagFree + * ----------------------------------------------------------------- + * This routine frees memory specific to the diagonal linear solver. + * ----------------------------------------------------------------- + */ + +static void CVDiagFree(CVodeMem cv_mem) +{ + CVDiagMem cvdiag_mem; + + cvdiag_mem = (CVDiagMem) lmem; + + N_VDestroy(M); + N_VDestroy(bit); + N_VDestroy(bitcomp); + free(cvdiag_mem); cvdiag_mem = NULL; +} + + +/* + * ================================================================ + * + * PART II - backward problems + * + * ================================================================ + */ + + +/* + * CVDiagB + * + * Wrappers for the backward phase around the corresponding + * CVODES functions + */ + +int CVDiagB(void *cvode_mem, int which) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVDIAG_MEM_NULL, "CVSDIAG", "CVDiagB", MSGDG_CVMEM_NULL); + return(CVDIAG_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CVDIAG_NO_ADJ, "CVSDIAG", "CVDiagB", MSGDG_NO_ADJ); + return(CVDIAG_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= ca_mem->ca_nbckpbs ) { + cvProcessError(cv_mem, CVDIAG_ILL_INPUT, "CVSDIAG", "CVDiagB", MSGDG_BAD_WHICH); + return(CVDIAG_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + flag = CVDiag(cvodeB_mem); + + return(flag); +} + diff --git a/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_diag_impl.h b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_diag_impl.h new file mode 100644 index 0000000..aa39e8d --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_diag_impl.h @@ -0,0 +1,68 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.4 $ + * $Date: 2007/03/22 18:05:51 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * Implementation header file for the diagonal linear solver, CVDIAG. + * ----------------------------------------------------------------- + */ + +#ifndef _CVSDIAG_IMPL_H +#define _CVSDIAG_IMPL_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ----------------------------------------------------------------- + * Types: CVDiagMemRec, CVDiagMem + * ----------------------------------------------------------------- + * The type CVDiagMem is pointer to a CVDiagMemRec. + * This structure contains CVDiag solver-specific data. + * ----------------------------------------------------------------- + */ + +typedef struct { + + realtype di_gammasv; /* gammasv = gamma at the last call to setup */ + /* or solve */ + + N_Vector di_M; /* M = (I - gamma J)^{-1} , gamma = h / l1 */ + + N_Vector di_bit; /* temporary storage vector */ + + N_Vector di_bitcomp; /* temporary storage vector */ + + long int di_nfeDI; /* no. of calls to f due to difference + quotient diagonal Jacobian approximation */ + + int di_last_flag; /* last error return flag */ + +} CVDiagMemRec, *CVDiagMem; + +/* Error Messages */ + +#define MSGDG_CVMEM_NULL "Integrator memory is NULL." +#define MSGDG_MEM_FAIL "A memory request failed." +#define MSGDG_BAD_NVECTOR "A required vector operation is not implemented." +#define MSGDG_LMEM_NULL "CVDIAG memory is NULL." +#define MSGDG_RHSFUNC_FAILED "The right-hand side routine failed in an unrecoverable manner." + +#define MSGDG_NO_ADJ "Illegal attempt to call before calling CVodeAdjMalloc." +#define MSGDG_BAD_WHICH "Illegal value for which." + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_direct.c b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_direct.c new file mode 100644 index 0000000..191c0b3 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_direct.c @@ -0,0 +1,711 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.9 $ + * $Date: 2008/04/18 19:42:40 $ + * ----------------------------------------------------------------- + * Programmer: Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2006, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for the CVSDLS linear solvers + * ----------------------------------------------------------------- + */ + +/* + * ================================================================= + * IMPORTED HEADER FILES + * ================================================================= + */ + +#include +#include + +#include "cvodes_impl.h" +#include "cvodes_direct_impl.h" +#include + +/* + * ================================================================= + * FUNCTION SPECIFIC CONSTANTS + * ================================================================= + */ + +/* Constant for DQ Jacobian approximation */ +#define MIN_INC_MULT RCONST(1000.0) + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) +#define TWO RCONST(2.0) + +/* + * ================================================================= + * PRIVATE FUNCTION PROTOTYPES + * ================================================================= + */ + +static int cvDlsDenseJacBWrapper(int nB, realtype t, + N_Vector yB, N_Vector fyB, + DlsMat JB, void *cvode_mem, + N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); + +static int cvDlsBandJacBWrapper(int nB, int mupperB, int mlowerB, + realtype t, N_Vector yB, N_Vector fyB, + DlsMat Jac, void *cvode_mem, + N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); + + +/* + * ================================================================= + * READIBILITY REPLACEMENTS + * ================================================================= + */ + +#define f (cv_mem->cv_f) +#define user_data (cv_mem->cv_user_data) +#define uround (cv_mem->cv_uround) +#define nst (cv_mem->cv_nst) +#define tn (cv_mem->cv_tn) +#define h (cv_mem->cv_h) +#define gamma (cv_mem->cv_gamma) +#define gammap (cv_mem->cv_gammap) +#define gamrat (cv_mem->cv_gamrat) +#define ewt (cv_mem->cv_ewt) + +#define lmem (cv_mem->cv_lmem) + +#define mtype (cvdls_mem->d_type) +#define n (cvdls_mem->d_n) +#define ml (cvdls_mem->d_ml) +#define mu (cvdls_mem->d_mu) +#define smu (cvdls_mem->d_smu) +#define jacDQ (cvdls_mem->d_jacDQ) +#define djac (cvdls_mem->d_djac) +#define bjac (cvdls_mem->d_bjac) +#define M (cvdls_mem->d_M) +#define savedJ (cvdls_mem->d_savedJ) +#define pivots (cvdls_mem->d_pivots) +#define nstlj (cvdls_mem->d_nstlj) +#define nje (cvdls_mem->d_nje) +#define nfeDQ (cvdls_mem->d_nfeDQ) +#define last_flag (cvdls_mem->d_last_flag) + +/* + * ================================================================= + * EXPORTED FUNCTIONS (FORWARD INTEGRATION) + * ================================================================= + */ + +/* + * CVDlsSetDenseJacFn specifies the dense Jacobian function. + */ +int CVDlsSetDenseJacFn(void *cvode_mem, CVDlsDenseJacFn jac) +{ + CVodeMem cv_mem; + CVDlsMem cvdls_mem; + + /* Return immediately if cvode_mem is NULL */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVDLS_MEM_NULL, "CVDLS", "CVDlsSetDenseJacFn", MSGD_CVMEM_NULL); + return(CVDLS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + if (lmem == NULL) { + cvProcessError(cv_mem, CVDLS_LMEM_NULL, "CVDLS", "CVDlsSetDenseJacFn", MSGD_LMEM_NULL); + return(CVDLS_LMEM_NULL); + } + cvdls_mem = (CVDlsMem) lmem; + + if (jac != NULL) { + jacDQ = FALSE; + djac = jac; + } else { + jacDQ = TRUE; + } + + return(CVDLS_SUCCESS); +} + +/* + * CVDlsSetBandJacFn specifies the band Jacobian function. + */ +int CVDlsSetBandJacFn(void *cvode_mem, CVDlsBandJacFn jac) +{ + CVodeMem cv_mem; + CVDlsMem cvdls_mem; + + /* Return immediately if cvode_mem is NULL */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVDLS_MEM_NULL, "CVDLS", "CVDlsSetBandJacFn", MSGD_CVMEM_NULL); + return(CVDLS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + if (lmem == NULL) { + cvProcessError(cv_mem, CVDLS_LMEM_NULL, "CVDLS", "CVDlsSetBandJacFn", MSGD_LMEM_NULL); + return(CVDLS_LMEM_NULL); + } + cvdls_mem = (CVDlsMem) lmem; + + if (jac != NULL) { + jacDQ = FALSE; + bjac = jac; + } else { + jacDQ = TRUE; + } + + return(CVDLS_SUCCESS); +} + +/* + * CVDlsGetWorkSpace returns the length of workspace allocated for the + * CVDLS linear solver. + */ +int CVDlsGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS) +{ + CVodeMem cv_mem; + CVDlsMem cvdls_mem; + + /* Return immediately if cvode_mem is NULL */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVDLS_MEM_NULL, "CVSDLS", "CVDlsGetWorkSpace", MSGD_CVMEM_NULL); + return(CVDLS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + if (lmem == NULL) { + cvProcessError(cv_mem, CVDLS_LMEM_NULL, "CVSDLS", "CVDlsGetWorkSpace", MSGD_LMEM_NULL); + return(CVDLS_LMEM_NULL); + } + cvdls_mem = (CVDlsMem) lmem; + + if (mtype == SUNDIALS_DENSE) { + *lenrwLS = 2*n*n; + *leniwLS = n; + } else if (mtype == SUNDIALS_BAND) { + *lenrwLS = n*(smu + mu + 2*ml + 2); + *leniwLS = n; + } + + return(CVDLS_SUCCESS); +} + +/* + * CVDlsGetNumJacEvals returns the number of Jacobian evaluations. + */ +int CVDlsGetNumJacEvals(void *cvode_mem, long int *njevals) +{ + CVodeMem cv_mem; + CVDlsMem cvdls_mem; + + /* Return immediately if cvode_mem is NULL */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVDLS_MEM_NULL, "CVSDLS", "CVDlsGetNumJacEvals", MSGD_CVMEM_NULL); + return(CVDLS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + if (lmem == NULL) { + cvProcessError(cv_mem, CVDLS_LMEM_NULL, "CVSDLS", "CVDlsGetNumJacEvals", MSGD_LMEM_NULL); + return(CVDLS_LMEM_NULL); + } + cvdls_mem = (CVDlsMem) lmem; + + *njevals = nje; + + return(CVDLS_SUCCESS); +} + +/* + * CVDlsGetNumRhsEvals returns the number of calls to the ODE function + * needed for the DQ Jacobian approximation. + */ +int CVDlsGetNumRhsEvals(void *cvode_mem, long int *nfevalsLS) +{ + CVodeMem cv_mem; + CVDlsMem cvdls_mem; + + /* Return immediately if cvode_mem is NULL */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVDLS_MEM_NULL, "CVSDLS", "CVDlsGetNumRhsEvals", MSGD_CVMEM_NULL); + return(CVDLS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + if (lmem == NULL) { + cvProcessError(cv_mem, CVDLS_LMEM_NULL, "CVSDLS", "CVDlsGetNumRhsEvals", MSGD_LMEM_NULL); + return(CVDLS_LMEM_NULL); + } + cvdls_mem = (CVDlsMem) lmem; + + *nfevalsLS = nfeDQ; + + return(CVDLS_SUCCESS); +} + +/* + * CVDlsGetReturnFlagName returns the name associated with a CVDLS + * return value. + */ +char *CVDlsGetReturnFlagName(int flag) +{ + char *name; + + name = (char *)malloc(30*sizeof(char)); + + switch(flag) { + case CVDLS_SUCCESS: + sprintf(name,"CVDLS_SUCCESS"); + break; + case CVDLS_MEM_NULL: + sprintf(name,"CVDLS_MEM_NULL"); + break; + case CVDLS_LMEM_NULL: + sprintf(name,"CVDLS_LMEM_NULL"); + break; + case CVDLS_ILL_INPUT: + sprintf(name,"CVDLS_ILL_INPUT"); + break; + case CVDLS_MEM_FAIL: + sprintf(name,"CVDLS_MEM_FAIL"); + break; + case CVDLS_JACFUNC_UNRECVR: + sprintf(name,"CVDLS_JACFUNC_UNRECVR"); + break; + case CVDLS_JACFUNC_RECVR: + sprintf(name,"CVDLS_JACFUNC_RECVR"); + break; + default: + sprintf(name,"NONE"); + } + + return(name); +} + +/* + * CVDlsGetLastFlag returns the last flag set in a CVDLS function. + */ +int CVDlsGetLastFlag(void *cvode_mem, int *flag) +{ + CVodeMem cv_mem; + CVDlsMem cvdls_mem; + + /* Return immediately if cvode_mem is NULL */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVDLS_MEM_NULL, "CVSDLS", "CVDlsGetLastFlag", MSGD_CVMEM_NULL); + return(CVDLS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + if (lmem == NULL) { + cvProcessError(cv_mem, CVDLS_LMEM_NULL, "CVSDLS", "CVDlsGetLastFlag", MSGD_LMEM_NULL); + return(CVDLS_LMEM_NULL); + } + cvdls_mem = (CVDlsMem) lmem; + + *flag = last_flag; + + return(CVDLS_SUCCESS); +} + +/* + * ================================================================= + * DQ JACOBIAN APPROXIMATIONS + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * cvDlsDenseDQJac + * ----------------------------------------------------------------- + * This routine generates a dense difference quotient approximation to + * the Jacobian of f(t,y). It assumes that a dense matrix of type + * DlsMat is stored column-wise, and that elements within each column + * are contiguous. The address of the jth column of J is obtained via + * the macro DENSE_COL and this pointer is associated with an N_Vector + * using the N_VGetArrayPointer/N_VSetArrayPointer functions. + * Finally, the actual computation of the jth column of the Jacobian is + * done with a call to N_VLinearSum. + * ----------------------------------------------------------------- + */ + +int cvDlsDenseDQJac(int N, realtype t, + N_Vector y, N_Vector fy, + DlsMat Jac, void *data, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) +{ + realtype fnorm, minInc, inc, inc_inv, yjsaved, srur; + realtype *tmp2_data, *y_data, *ewt_data; + N_Vector ftemp, jthCol; + int j; + int retval = 0; + + CVodeMem cv_mem; + CVDlsMem cvdls_mem; + + /* data points to cvode_mem */ + cv_mem = (CVodeMem) data; + cvdls_mem = (CVDlsMem) lmem; + + /* Save pointer to the array in tmp2 */ + tmp2_data = N_VGetArrayPointer(tmp2); + + /* Rename work vectors for readibility */ + ftemp = tmp1; + jthCol = tmp2; + + /* Obtain pointers to the data for ewt, y */ + ewt_data = N_VGetArrayPointer(ewt); + y_data = N_VGetArrayPointer(y); + + /* Set minimum increment based on uround and norm of f */ + srur = RSqrt(uround); + fnorm = N_VWrmsNorm(fy, ewt); + minInc = (fnorm != ZERO) ? + (MIN_INC_MULT * ABS(h) * uround * N * fnorm) : ONE; + + for (j = 0; j < N; j++) { + + /* Generate the jth col of J(tn,y) */ + + N_VSetArrayPointer(DENSE_COL(Jac,j), jthCol); + + yjsaved = y_data[j]; + inc = MAX(srur*ABS(yjsaved), minInc/ewt_data[j]); + y_data[j] += inc; + + retval = f(t, y, ftemp, user_data); + nfeDQ++; + if (retval != 0) break; + + y_data[j] = yjsaved; + + inc_inv = ONE/inc; + N_VLinearSum(inc_inv, ftemp, -inc_inv, fy, jthCol); + + DENSE_COL(Jac,j) = N_VGetArrayPointer(jthCol); + } + + /* Restore original array pointer in tmp2 */ + N_VSetArrayPointer(tmp2_data, tmp2); + + return(retval); +} + +/* + * ----------------------------------------------------------------- + * cvDlsBandDQJac + * ----------------------------------------------------------------- + * This routine generates a banded difference quotient approximation to + * the Jacobian of f(t,y). It assumes that a band matrix of type + * DlsMat is stored column-wise, and that elements within each column + * are contiguous. This makes it possible to get the address of a column + * of J via the macro BAND_COL and to write a simple for loop to set + * each of the elements of a column in succession. + * ----------------------------------------------------------------- + */ + +int cvDlsBandDQJac(int N, int mupper, int mlower, + realtype t, N_Vector y, N_Vector fy, + DlsMat Jac, void *data, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) +{ + N_Vector ftemp, ytemp; + realtype fnorm, minInc, inc, inc_inv, srur; + realtype *col_j, *ewt_data, *fy_data, *ftemp_data, *y_data, *ytemp_data; + int group, i, j, width, ngroups, i1, i2; + int retval = 0; + + CVodeMem cv_mem; + CVDlsMem cvdls_mem; + + /* data points to cvode_mem */ + cv_mem = (CVodeMem) data; + cvdls_mem = (CVDlsMem) lmem; + + /* Rename work vectors for use as temporary values of y and f */ + ftemp = tmp1; + ytemp = tmp2; + + /* Obtain pointers to the data for ewt, fy, ftemp, y, ytemp */ + ewt_data = N_VGetArrayPointer(ewt); + fy_data = N_VGetArrayPointer(fy); + ftemp_data = N_VGetArrayPointer(ftemp); + y_data = N_VGetArrayPointer(y); + ytemp_data = N_VGetArrayPointer(ytemp); + + /* Load ytemp with y = predicted y vector */ + N_VScale(ONE, y, ytemp); + + /* Set minimum increment based on uround and norm of f */ + srur = RSqrt(uround); + fnorm = N_VWrmsNorm(fy, ewt); + minInc = (fnorm != ZERO) ? + (MIN_INC_MULT * ABS(h) * uround * N * fnorm) : ONE; + + /* Set bandwidth and number of column groups for band differencing */ + width = mlower + mupper + 1; + ngroups = MIN(width, N); + + /* Loop over column groups. */ + for (group=1; group <= ngroups; group++) { + + /* Increment all y_j in group */ + for(j=group-1; j < N; j+=width) { + inc = MAX(srur*ABS(y_data[j]), minInc/ewt_data[j]); + ytemp_data[j] += inc; + } + + /* Evaluate f with incremented y */ + + retval = f(tn, ytemp, ftemp, user_data); + nfeDQ++; + if (retval != 0) break; + + /* Restore ytemp, then form and load difference quotients */ + for (j=group-1; j < N; j+=width) { + ytemp_data[j] = y_data[j]; + col_j = BAND_COL(Jac,j); + inc = MAX(srur*ABS(y_data[j]), minInc/ewt_data[j]); + inc_inv = ONE/inc; + i1 = MAX(0, j-mupper); + i2 = MIN(j+mlower, N-1); + for (i=i1; i <= i2; i++) + BAND_COL_ELEM(col_j,i,j) = inc_inv * (ftemp_data[i] - fy_data[i]); + } + } + + return(retval); +} + +/* + * ================================================================= + * BACKWARD INTEGRATION SUPPORT + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Additional readability replacements + * ----------------------------------------------------------------- + */ + +#define ytmp (ca_mem->ca_ytmp) +#define yStmp (ca_mem->ca_yStmp) +#define IMget (ca_mem->ca_IMget) + +#define mtypeB (cvdlsB_mem->d_typeB) +#define djacB (cvdlsB_mem->d_djacB) +#define bjacB (cvdlsB_mem->d_bjacB) + +/* + * ----------------------------------------------------------------- + * EXPORTED FUNCTIONS + * ----------------------------------------------------------------- + */ + +int CVDlsSetDenseJacFnB(void *cvode_mem, int which, CVDlsDenseJacFnB jacB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + CVDlsMemB cvdlsB_mem; + void *cvodeB_mem; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVDLS_MEM_NULL, "CVSDLS", "CVDlsSetDenseJacFnB", MSGD_CVMEM_NULL); + return(CVDLS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CVDLS_NO_ADJ, "CVSDLS", "CVDlsSetDenseJacFnB", MSGD_NO_ADJ); + return(CVDLS_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= ca_mem->ca_nbckpbs ) { + cvProcessError(cv_mem, CVDLS_ILL_INPUT, "CVSDLS", "CVDlsSetDenseJacFnB", MSGD_BAD_WHICH); + return(CVDLS_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + if (cvB_mem->cv_lmem == NULL) { + cvProcessError(cv_mem, CVDLS_LMEMB_NULL, "CVSDLS", "CVDlsSetDenseJacFnB", MSGD_LMEMB_NULL); + return(CVDLS_LMEMB_NULL); + } + cvdlsB_mem = (CVDlsMemB) (cvB_mem->cv_lmem); + + djacB = jacB; + + if (jacB != NULL) { + flag = CVDlsSetDenseJacFn(cvodeB_mem, cvDlsDenseJacBWrapper); + } else { + flag = CVDlsSetDenseJacFn(cvodeB_mem, NULL); + } + + return(flag); +} + +int CVDlsSetBandJacFnB(void *cvode_mem, int which, CVDlsBandJacFnB jacB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + CVDlsMemB cvdlsB_mem; + void *cvodeB_mem; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVDLS_MEM_NULL, "CVSDLS", "CVDlsSetBandJacFnB", MSGD_CVMEM_NULL); + return(CVDLS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CVDLS_NO_ADJ, "CVSDLS", "CVDlsSetBandJacFnB", MSGD_NO_ADJ); + return(CVDLS_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= ca_mem->ca_nbckpbs ) { + cvProcessError(cv_mem, CVDLS_ILL_INPUT, "CVSDLS", "CVDlsSetBandJacFnB", MSGD_BAD_WHICH); + return(CVDLS_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + if (cvB_mem->cv_lmem == NULL) { + cvProcessError(cv_mem, CVDLS_LMEMB_NULL, "CVSDLS", "CVDlsSetBandJacFnB", MSGD_LMEMB_NULL); + return(CVDLS_LMEMB_NULL); + } + cvdlsB_mem = (CVDlsMemB) (cvB_mem->cv_lmem); + + bjacB = jacB; + + if (jacB != NULL) { + flag = CVDlsSetBandJacFn(cvodeB_mem, cvDlsBandJacBWrapper); + } else { + flag = CVDlsSetBandJacFn(cvodeB_mem, NULL); + } + + return(flag); +} + + +/* + * ----------------------------------------------------------------- + * PRIVATE INTERFACE FUNCTIONS + * ----------------------------------------------------------------- + */ + +/* + * cvDlsDenseJacBWrapper + * + * This routine interfaces to the CVDlsDenseJacFnB routine provided + * by the user. cvDlsDenseJacBWrapper is of type CVDlsDenseJacFn. + * NOTE: data here contains cvode_mem + */ + + +static int cvDlsDenseJacBWrapper(int nB, realtype t, + N_Vector yB, N_Vector fyB, + DlsMat JB, void *cvode_mem, + N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + CVDlsMemB cvdlsB_mem; + int retval, flag; + + cv_mem = (CVodeMem) cvode_mem; + + ca_mem = cv_mem->cv_adj_mem; + + cvB_mem = ca_mem->ca_bckpbCrt; + + cvdlsB_mem = (CVDlsMemB) (cvB_mem->cv_lmem); + + /* Forward solution from interpolation */ + flag = IMget(cv_mem, t, ytmp, NULL); + if (flag != CV_SUCCESS) { + cvProcessError(cv_mem, -1, "CVSDLS", "cvDlsDenseJacBWrapper", MSGD_BAD_TINTERP); + return(-1); + } + + /* Call user's adjoint dense djacB routine (of type CVDlsDenseJacFnB) */ + retval = djacB(nB, t, ytmp, yB, fyB, JB, cvB_mem->cv_user_data, + tmp1B, tmp2B, tmp3B); + + return(retval); + +} + + +/* + * cvDlsBandJacBWrapper + * + * This routine interfaces to the CVBandJacFnB routine provided + * by the user. cvDlsBandJacBWrapper is of type CVDlsBandJacFn. + * NOTE: data here contains cvode_mem + */ + +static int cvDlsBandJacBWrapper(int nB, int mupperB, int mlowerB, + realtype t, N_Vector yB, N_Vector fyB, + DlsMat JB, void *cvode_mem, + N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + CVDlsMemB cvdlsB_mem; + int retval, flag; + + cv_mem = (CVodeMem) cvode_mem; + + ca_mem = cv_mem->cv_adj_mem; + + cvB_mem = ca_mem->ca_bckpbCrt; + + cvdlsB_mem = (CVDlsMemB) (cvB_mem->cv_lmem); + + /* Forward solution from interpolation */ + flag = IMget(cv_mem, t, ytmp, NULL); + if (flag != CV_SUCCESS) { + cvProcessError(cv_mem, -1, "CVSDLS", "cvDlsBandJacBWrapper", MSGD_BAD_TINTERP); + return(-1); + } + + /* Call user's adjoint band bjacB routine (of type CVDlsBandJacFnB) */ + retval = bjacB(nB, mupperB, mlowerB, t, ytmp, yB, fyB, JB, cvB_mem->cv_user_data, + tmp1B, tmp2B, tmp3B); + + return(retval); +} + diff --git a/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_direct_impl.h b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_direct_impl.h new file mode 100644 index 0000000..9ec60da --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_direct_impl.h @@ -0,0 +1,153 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.8 $ + * $Date: 2008/04/18 19:42:40 $ + * ----------------------------------------------------------------- + * Programmer: Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2006, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * Common implementation header file for the CVDLS linear solvers. + * ----------------------------------------------------------------- + */ + +#ifndef _CVSDLS_IMPL_H +#define _CVSDLS_IMPL_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ================================================================= + * C V S D I R E C T I N T E R N A L C O N S T A N T S + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * CVDLS solver constants + * ----------------------------------------------------------------- + * CVD_MSBJ maximum number of steps between Jacobian evaluations + * CVD_DGMAX maximum change in gamma between Jacobian evaluations + * ----------------------------------------------------------------- + */ + +#define CVD_MSBJ 50 +#define CVD_DGMAX RCONST(0.2) + +/* + * ================================================================= + * PART I: F O R W A R D P R O B L E M S + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Types: CVDlsMemRec, CVDlsMem + * ----------------------------------------------------------------- + * CVDlsMem is pointer to a CVDlsMemRec structure. + * ----------------------------------------------------------------- + */ + +typedef struct CVDlsMemRec { + + int d_type; /* SUNDIALS_DENSE or SUNDIALS_BAND */ + + int d_n; /* problem dimension */ + + int d_ml; /* lower bandwidth of Jacobian */ + int d_mu; /* upper bandwidth of Jacobian */ + int d_smu; /* upper bandwith of M = MIN(N-1,d_mu+d_ml) */ + + booleantype d_jacDQ; /* TRUE if using internal DQ Jacobian approx. */ + CVDlsDenseJacFn d_djac; /* dense Jacobian routine to be called */ + CVDlsBandJacFn d_bjac; /* band Jacobian routine to be called */ + void *d_J_data; /* data pointer passed to djac or bjac */ + + DlsMat d_M; /* M = I - gamma * df/dy */ + DlsMat d_savedJ; /* savedJ = old Jacobian */ + + int *d_pivots; /* pivots = pivot array for PM = LU */ + + long int d_nstlj; /* nstlj = nst at last Jacobian eval. */ + + long int d_nje; /* nje = no. of calls to jac */ + + long int d_nfeDQ; /* no. of calls to f due to DQ Jacobian approx. */ + + int d_last_flag; /* last error return flag */ + +} *CVDlsMem; + +/* + * ----------------------------------------------------------------- + * Prototypes of internal functions + * ----------------------------------------------------------------- + */ + +int cvDlsDenseDQJac(int N, realtype t, + N_Vector y, N_Vector fy, + DlsMat Jac, void *data, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); + +int cvDlsBandDQJac(int N, int mupper, int mlower, + realtype t, N_Vector y, N_Vector fy, + DlsMat Jac, void *data, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); + + +/* + * ================================================================= + * PART II: B A C K W A R D P R O B L E M S + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Types : CVDlsMemRecB, CVDlsMemB + * ----------------------------------------------------------------- + * A CVDLS linear solver's specification function attaches such + * a structure to the lmemB filed of CVodeBMem + * ----------------------------------------------------------------- + */ + +typedef struct CVDlsMemRecB { + + int d_typeB; + + CVDlsDenseJacFnB d_djacB; + CVDlsBandJacFnB d_bjacB; + +} *CVDlsMemB; + + +/* + * ================================================================= + * E R R O R M E S S A G E S + * ================================================================= + */ + +#define MSGD_CVMEM_NULL "Integrator memory is NULL." +#define MSGD_BAD_NVECTOR "A required vector operation is not implemented." +#define MSGD_BAD_SIZES "Illegal bandwidth parameter(s). Must have 0 <= ml, mu <= N-1." +#define MSGD_MEM_FAIL "A memory request failed." +#define MSGD_LMEM_NULL "Linear solver memory is NULL." +#define MSGD_JACFUNC_FAILED "The Jacobian routine failed in an unrecoverable manner." + + +#define MSGD_NO_ADJ "Illegal attempt to call before calling CVodeAdjMalloc." +#define MSGD_BAD_WHICH "Illegal value for which." +#define MSGD_LMEMB_NULL "Linear solver memory is NULL for the backward integration." +#define MSGD_BAD_TINTERP "Bad t for interpolation." + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_impl.h b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_impl.h new file mode 100644 index 0000000..0bb7173 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_impl.h @@ -0,0 +1,1089 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.21 $ + * $Date: 2007/11/26 16:19:59 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * Implementation header file for the main CVODES integrator. + * ----------------------------------------------------------------- + */ + +#ifndef _CVODES_IMPL_H +#define _CVODES_IMPL_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +#include +#include +#include + +/* + * ================================================================= + * I N T E R N A L C V O D E S C O N S T A N T S + * ================================================================= + */ + +/* Basic CVODES constants */ + +#define ADAMS_Q_MAX 12 /* max value of q for lmm == ADAMS */ +#define BDF_Q_MAX 5 /* max value of q for lmm == BDF */ +#define Q_MAX ADAMS_Q_MAX /* max value of q for either lmm */ +#define L_MAX (Q_MAX+1) /* max value of L for either lmm */ +#define NUM_TESTS 5 /* number of error test quantities */ + +#define HMIN_DEFAULT RCONST(0.0) /* hmin default value */ +#define HMAX_INV_DEFAULT RCONST(0.0) /* hmax_inv default value */ +#define MXHNIL_DEFAULT 10 /* mxhnil default value */ +#define MXSTEP_DEFAULT 500 /* mxstep default value */ + +/* + * ================================================================= + * F O R W A R D P O I N T E R R E F E R E N C E S + * ================================================================= + */ + +typedef struct CVadjMemRec *CVadjMem; +typedef struct CkpntMemRec *CkpntMem; +typedef struct DtpntMemRec *DtpntMem; +typedef struct CVodeBMemRec *CVodeBMem; + +/* + * ================================================================= + * M A I N I N T E G R A T O R M E M O R Y B L O C K + * ================================================================= + */ + + +/* + * ----------------------------------------------------------------- + * Types: struct CVodeMemRec, CVodeMem + * ----------------------------------------------------------------- + * The type CVodeMem is type pointer to struct CVodeMemRec. + * This structure contains fields to keep track of problem state. + * ----------------------------------------------------------------- + */ + +typedef struct CVodeMemRec { + + realtype cv_uround; /* machine unit roundoff */ + + /*-------------------------- + Problem Specification Data + --------------------------*/ + + CVRhsFn cv_f; /* y' = f(t,y(t)) */ + void *cv_user_data; /* user pointer passed to f */ + + int cv_lmm; /* lmm = ADAMS or BDF */ + int cv_iter; /* iter = FUNCTIONAL or NEWTON */ + + int cv_itol; /* itol = CV_SS, CV_SV, or CV_WF, or CV_NN */ + realtype cv_reltol; /* relative tolerance */ + realtype cv_Sabstol; /* scalar absolute tolerance */ + N_Vector cv_Vabstol; /* vector absolute tolerance */ + booleantype cv_user_efun; /* TRUE if user sets efun */ + CVEwtFn cv_efun; /* function to set ewt */ + void *cv_e_data; /* user pointer passed to efun */ + double tMax; /* Maximum integration time, Added by Joep Vanlier */ + + /*----------------------- + Quadrature Related Data + -----------------------*/ + + booleantype cv_quadr; /* TRUE if integrating quadratures */ + + CVQuadRhsFn cv_fQ; /* q' = fQ(t, y(t)) */ + + booleantype cv_errconQ; /* TRUE if quadrs. are included in error test */ + + int cv_itolQ; /* itolQ = CV_SS or CV_SV */ + realtype cv_reltolQ; /* relative tolerance for quadratures */ + realtype cv_SabstolQ; /* scalar absolute tolerance for quadratures */ + N_Vector cv_VabstolQ; /* vector absolute tolerance for quadratures */ + + /*------------------------ + Sensitivity Related Data + ------------------------*/ + + booleantype cv_sensi; /* TRUE if computing sensitivities */ + + int cv_Ns; /* Number of sensitivities */ + + int cv_ism; /* ism = SIMULTANEOUS or STAGGERED */ + + CVSensRhsFn cv_fS; /* fS = (df/dy)*yS + (df/dp) */ + CVSensRhs1Fn cv_fS1; /* fS1 = (df/dy)*yS_i + (df/dp) */ + void *cv_fS_data; /* data pointer passed to fS */ + booleantype cv_fSDQ; /* TRUE if using internal DQ functions */ + int cv_ifS; /* ifS = ALLSENS or ONESENS */ + + realtype *cv_p; /* parameters in f(t,y,p) */ + realtype *cv_pbar; /* scale factors for parameters */ + int *cv_plist; /* list of sensitivities */ + int cv_DQtype; /* central/forward finite differences */ + realtype cv_DQrhomax; /* cut-off value for separate/simultaneous FD */ + + booleantype cv_errconS; /* TRUE if yS are considered in err. control */ + + int cv_itolS; + realtype cv_reltolS; /* relative tolerance for sensitivities */ + realtype *cv_SabstolS; /* scalar absolute tolerances for sensi. */ + N_Vector *cv_VabstolS; /* vector absolute tolerances for sensi. */ + + /*----------------------------------- + Quadrature Sensitivity Related Data + -----------------------------------*/ + + booleantype cv_quadr_sensi; /* TRUE if computing sensitivties of quadrs. */ + + CVQuadSensRhsFn cv_fQS; /* fQS = (dfQ/dy)*yS + (dfQ/dp) */ + void *cv_fQS_data; /* data pointer passed to fQS */ + booleantype cv_fQSDQ; /* TRUE if using internal DQ functions */ + + booleantype cv_errconQS; /* TRUE if yQS are considered in err. con. */ + + int cv_itolQS; + realtype cv_reltolQS; /* relative tolerance for yQS */ + realtype *cv_SabstolQS; /* scalar absolute tolerances for yQS */ + N_Vector *cv_VabstolQS; /* vector absolute tolerances for yQS */ + + /*----------------------- + Nordsieck History Array + -----------------------*/ + + N_Vector cv_zn[L_MAX]; /* Nordsieck array, of size N x (q+1). + zn[j] is a vector of length N (j=0,...,q) + zn[j] = [1/factorial(j)] * h^j * + (jth derivative of the interpolating poly.) */ + + /*------------------- + Vectors of length N + -------------------*/ + + N_Vector cv_ewt; /* error weight vector */ + N_Vector cv_y; /* y is used as temporary storage by the solver. + The memory is provided by the user to CVode + where the vector is named yout. */ + N_Vector cv_acor; /* In the context of the solution of the + nonlinear equation, acor = y_n(m) - y_n(0). + On return, this vector is scaled to give + the estimated local error in y. */ + N_Vector cv_tempv; /* temporary storage vector */ + N_Vector cv_ftemp; /* temporary storage vector */ + + /*-------------------------- + Quadrature Related Vectors + --------------------------*/ + + N_Vector cv_znQ[L_MAX]; /* Nordsieck arrays for quadratures */ + N_Vector cv_ewtQ; /* error weight vector for quadratures */ + N_Vector cv_yQ; /* Unlike y, yQ is not allocated by the user */ + N_Vector cv_acorQ; /* acorQ = yQ_n(m) - yQ_n(0) */ + N_Vector cv_tempvQ; /* temporary storage vector (~ tempv) */ + + /*--------------------------- + Sensitivity Related Vectors + ---------------------------*/ + + N_Vector *cv_znS[L_MAX]; /* Nordsieck arrays for sensitivities */ + N_Vector *cv_ewtS; /* error weight vectors for sensitivities */ + N_Vector *cv_yS; /* yS=yS0 (allocated by the user) */ + N_Vector *cv_acorS; /* acorS = yS_n(m) - yS_n(0) */ + N_Vector *cv_tempvS; /* temporary storage vector (~ tempv) */ + N_Vector *cv_ftempS; /* temporary storage vector (~ ftemp) */ + + booleantype cv_stgr1alloc; /* Did we allocate ncfS1, ncfnS1, and nniS1? */ + + /*-------------------------------------- + Quadrature Sensitivity Related Vectors + --------------------------------------*/ + + N_Vector *cv_znQS[L_MAX]; /* Nordsieck arrays for quadr. sensitivities */ + N_Vector *cv_ewtQS; /* error weight vectors for sensitivities */ + N_Vector *cv_yQS; /* Unlike yS, yQS is not allocated by the user */ + N_Vector *cv_acorQS; /* acorQS = yQS_n(m) - yQS_n(0) */ + N_Vector *cv_tempvQS; /* temporary storage vector (~ tempv) */ + N_Vector cv_ftempQ; /* temporary storage vector (~ ftemp) */ + + /*----------------- + Tstop information + -----------------*/ + + booleantype cv_tstopset; + realtype cv_tstop; + + /*--------- + Step Data + ---------*/ + + int cv_q; /* current order */ + int cv_qprime; /* order to be used on the next step + * qprime = q-1, q, or q+1 */ + int cv_next_q; /* order to be used on the next step */ + int cv_qwait; /* number of internal steps to wait before + * considering a change in q */ + int cv_L; /* L = q + 1 */ + + realtype cv_hin; + realtype cv_h; /* current step size */ + realtype cv_hprime; /* step size to be used on the next step */ + realtype cv_next_h; /* step size to be used on the next step */ + realtype cv_eta; /* eta = hprime / h */ + realtype cv_hscale; /* value of h used in zn */ + realtype cv_tn; /* current internal value of t */ + realtype cv_tretlast; /* last value of t returned */ + + realtype cv_tau[L_MAX+1]; /* array of previous q+1 successful step + * sizes indexed from 1 to q+1 */ + realtype cv_tq[NUM_TESTS+1]; /* array of test quantities indexed from + * 1 to NUM_TESTS(=5) */ + realtype cv_l[L_MAX]; /* coefficients of l(x) (degree q poly) */ + + realtype cv_rl1; /* the scalar 1/l[1] */ + realtype cv_gamma; /* gamma = h * rl1 */ + realtype cv_gammap; /* gamma at the last setup call */ + realtype cv_gamrat; /* gamma / gammap */ + + realtype cv_crate; /* est. corrector conv. rate in Nls */ + realtype cv_crateS; /* est. corrector conv. rate in NlsStgr */ + realtype cv_acnrm; /* | acor | */ + realtype cv_acnrmQ; /* | acorQ | */ + realtype cv_acnrmS; /* | acorS | */ + realtype cv_acnrmQS; /* | acorQS | */ + realtype cv_nlscoef; /* coeficient in nonlinear convergence test */ + int cv_mnewt; /* Newton iteration counter */ + int *cv_ncfS1; /* Array of Ns local counters for conv. + * failures (used in CVStep for STAGGERED1) */ + + /*------ + Limits + ------*/ + + int cv_qmax; /* q <= qmax */ + long int cv_mxstep; /* maximum number of internal steps for one + user call */ + int cv_maxcor; /* maximum number of corrector iterations for + the solution of the nonlinear equation */ + int cv_maxcorS; + int cv_mxhnil; /* max. number of warning messages issued to the + user that t + h == t for the next internal step */ + int cv_maxnef; /* maximum number of error test failures */ + int cv_maxncf; /* maximum number of nonlinear conv. failures */ + + realtype cv_hmin; /* |h| >= hmin */ + realtype cv_hmax_inv; /* |h| <= 1/hmax_inv */ + realtype cv_etamax; /* eta <= etamax */ + + /*---------- + Counters + ----------*/ + + long int cv_nst; /* number of internal steps taken */ + + long int cv_nfe; /* number of f calls */ + long int cv_nfQe; /* number of fQ calls */ + long int cv_nfSe; /* number of fS calls */ + long int cv_nfeS; /* number of f calls from sensi DQ */ + long int cv_nfQSe; /* number of fQS calls */ + long int cv_nfQeS; /* number of fQ calls from sensi DQ */ + + + long int cv_ncfn; /* number of corrector convergence failures */ + long int cv_ncfnS; /* number of total sensi. corr. conv. failures */ + long int *cv_ncfnS1; /* number of sensi. corrector conv. failures */ + + long int cv_nni; /* number of nonlinear iterations performed */ + long int cv_nniS; /* number of total sensi. nonlinear iterations */ + long int *cv_nniS1; /* number of sensi. nonlinear iterations */ + + long int cv_netf; /* number of error test failures */ + long int cv_netfQ; /* number of quadr. error test failures */ + long int cv_netfS; /* number of sensi. error test failures */ + long int cv_netfQS; /* number of quadr. sensi. error test failures */ + + long int cv_nsetups; /* number of setup calls */ + long int cv_nsetupsS; /* number of setup calls due to sensitivities */ + + int cv_nhnil; /* number of messages issued to the user that + t + h == t for the next iternal step */ + + /*----------------------------- + Space requirements for CVODES + -----------------------------*/ + + long int cv_lrw1; /* no. of realtype words in 1 N_Vector y */ + long int cv_liw1; /* no. of integer words in 1 N_Vector y */ + long int cv_lrw1Q; /* no. of realtype words in 1 N_Vector yQ */ + long int cv_liw1Q; /* no. of integer words in 1 N_Vector yQ */ + long int cv_lrw; /* no. of realtype words in CVODES work vectors */ + long int cv_liw; /* no. of integer words in CVODES work vectors */ + + /*---------------- + Step size ratios + ----------------*/ + + realtype cv_etaqm1; /* ratio of new to old h for order q-1 */ + realtype cv_etaq; /* ratio of new to old h for order q */ + realtype cv_etaqp1; /* ratio of new to old h for order q+1 */ + + /*------------------ + Linear Solver Data + ------------------*/ + + /* Linear Solver functions to be called */ + + int (*cv_linit)(struct CVodeMemRec *cv_mem); + + int (*cv_lsetup)(struct CVodeMemRec *cv_mem, int convfail, + N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, + N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); + + int (*cv_lsolve)(struct CVodeMemRec *cv_mem, N_Vector b, N_Vector weight, + N_Vector ycur, N_Vector fcur); + + void (*cv_lfree)(struct CVodeMemRec *cv_mem); + + /* Linear Solver specific memory */ + + void *cv_lmem; + + /* Flag to request a call to the setup routine */ + + booleantype cv_forceSetup; + + /*------------ + Saved Values + ------------*/ + + int cv_qu; /* last successful q value used */ + long int cv_nstlp; /* step number of last setup call */ + realtype cv_h0u; /* actual initial stepsize */ + realtype cv_hu; /* last successful h value used */ + realtype cv_saved_tq5; /* saved value of tq[5] */ + booleantype cv_jcur; /* is Jacobian info for linear solver current? */ + realtype cv_tolsf; /* tolerance scale factor */ + int cv_qmax_alloc; /* qmax used when allocating mem */ + int cv_qmax_allocQ; /* qmax used when allocating quad. mem */ + int cv_qmax_allocS; /* qmax used when allocating sensi. mem */ + int cv_qmax_allocQS; /* qmax used when allocating quad. sensi. mem */ + int cv_indx_acor; /* index of zn vector in which acor is saved */ + booleantype cv_setupNonNull; /* Does setup do something? */ + + /*-------------------------------------------------------------------- + Flags turned ON by CVodeInit, CVodeSensMalloc, and CVodeQuadMalloc + and read by CVodeReInit, CVodeSensReInit, and CVodeQuadReInit + --------------------------------------------------------------------*/ + + booleantype cv_VabstolMallocDone; + booleantype cv_MallocDone; + + booleantype cv_VabstolQMallocDone; + booleantype cv_QuadMallocDone; + + booleantype cv_VabstolSMallocDone; + booleantype cv_SabstolSMallocDone; + booleantype cv_SensMallocDone; + + booleantype cv_VabstolQSMallocDone; + booleantype cv_SabstolQSMallocDone; + booleantype cv_QuadSensMallocDone; + + /*------------------------------------------- + Error handler function and error ouput file + -------------------------------------------*/ + + CVErrHandlerFn cv_ehfun; /* Error messages are handled by ehfun */ + void *cv_eh_data; /* dats pointer passed to ehfun */ + FILE *cv_errfp; /* CVODES error messages are sent to errfp */ + + /*------------------------- + Stability Limit Detection + -------------------------*/ + + booleantype cv_sldeton; /* Is Stability Limit Detection on? */ + realtype cv_ssdat[6][4]; /* scaled data array for STALD */ + int cv_nscon; /* counter for STALD method */ + long int cv_nor; /* counter for number of order reductions */ + + /*---------------- + Rootfinding Data + ----------------*/ + + CVRootFn cv_gfun; /* Function g for roots sought */ + int cv_nrtfn; /* number of components of g */ + int *cv_iroots; /* array for root information */ + int *cv_rootdir; /* array specifying direction of zero-crossing */ + realtype cv_tlo; /* nearest endpoint of interval in root search */ + realtype cv_thi; /* farthest endpoint of interval in root search */ + realtype cv_trout; /* t value returned by rootfinding routine */ + realtype *cv_glo; /* saved array of g values at t = tlo */ + realtype *cv_ghi; /* saved array of g values at t = thi */ + realtype *cv_grout; /* array of g values at t = trout */ + realtype cv_toutc; /* copy of tout (if NORMAL mode) */ + realtype cv_ttol; /* tolerance on root location trout */ + int cv_taskc; /* copy of parameter itask */ + int cv_irfnd; /* flag showing whether last step had a root */ + long int cv_nge; /* counter for g evaluations */ + booleantype *cv_gactive; /* array with active/inactive event functions */ + int cv_mxgnull; /* number of warning messages about possible g==0 */ + + /*------------------------ + Adjoint sensitivity data + ------------------------*/ + + booleantype cv_adj; /* TRUE if performing ASA */ + + struct CVadjMemRec *cv_adj_mem; /* Pointer to adjoint memory structure */ + + booleantype cv_adjMallocDone; + +} *CVodeMem; + + +/* + * ================================================================= + * A D J O I N T M O D U L E M E M O R Y B L O C K + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Types : struct CkpntMemRec, CkpntMem + * ----------------------------------------------------------------- + * The type CkpntMem is type pointer to struct CkpntMemRec. + * This structure contains fields to store all information at a + * check point that is needed to 'hot' start cvodes. + * ----------------------------------------------------------------- + */ + +struct CkpntMemRec { + + /* Integration limits */ + realtype ck_t0; + realtype ck_t1; + + /* Nordsieck History Array */ + N_Vector ck_zn[L_MAX]; + + /* Do we need to carry quadratures? */ + booleantype ck_quadr; + + /* Nordsieck History Array for quadratures */ + N_Vector ck_znQ[L_MAX]; + + /* Do we need to carry sensitivities? */ + booleantype ck_sensi; + + /* number of sensitivities */ + int ck_Ns; + + /* Nordsieck History Array for sensitivities */ + N_Vector *ck_znS[L_MAX]; + + /* Do we need to carry quadrature sensitivities? */ + booleantype ck_quadr_sensi; + + /* Nordsieck History Array for quadrature sensitivities */ + N_Vector *ck_znQS[L_MAX]; + + /* Was ck_zn[qmax] allocated? + ck_zqm = 0 - no + ck_zqm = qmax - yes */ + int ck_zqm; + + /* Step data */ + long int ck_nst; + realtype ck_tretlast; + int ck_q; + int ck_qprime; + int ck_qwait; + int ck_L; + realtype ck_gammap; + realtype ck_h; + realtype ck_hprime; + realtype ck_hscale; + realtype ck_eta; + realtype ck_etamax; + realtype ck_tau[L_MAX+1]; + realtype ck_tq[NUM_TESTS+1]; + realtype ck_l[L_MAX]; + + /* Saved values */ + realtype ck_saved_tq5; + + /* Pointer to next structure in list */ + struct CkpntMemRec *ck_next; + +}; + +/* + * ----------------------------------------------------------------- + * Types for functions provided by an interpolation module + * ----------------------------------------------------------------- + * cvaIMMallocFn: Type for a function that initializes the content + * field of the structures in the dt array + * cvaIMFreeFn: Type for a function that deallocates the content + * field of the structures in the dt array + * cvaIMGetYFn: Type for a function that returns the + * interpolated forward solution. + * cvaIMStorePnt: Type for a function that stores a new + * point in the structure d + * ----------------------------------------------------------------- + */ + +typedef booleantype (*cvaIMMallocFn)(CVodeMem cv_mem); +typedef void (*cvaIMFreeFn)(CVodeMem cv_mem); +typedef int (*cvaIMGetYFn)(CVodeMem cv_mem, realtype t, N_Vector y, N_Vector *yS); +typedef int (*cvaIMStorePntFn)(CVodeMem cv_mem, DtpntMem d); + +/* + * ----------------------------------------------------------------- + * Type : struct DtpntMemRec + * ----------------------------------------------------------------- + * This structure contains fields to store all information at a + * data point that is needed to interpolate solution of forward + * simulations. Its content field depends on IMtype. + * ----------------------------------------------------------------- + */ + +struct DtpntMemRec { + realtype t; /* time */ + void *content; /* IMtype-dependent content */ +}; + +/* Data for cubic Hermite interpolation */ +typedef struct HermiteDataMemRec { + N_Vector y; + N_Vector yd; + N_Vector *yS; + N_Vector *ySd; +} *HermiteDataMem; + +/* Data for polynomial interpolation */ +typedef struct PolynomialDataMemRec { + N_Vector y; + N_Vector *yS; + int order; +} *PolynomialDataMem; + + +/* + * ----------------------------------------------------------------- + * Type : struct CVodeBMemRec + * ----------------------------------------------------------------- + * The type CVodeBMem is a pointer to a structure which stores all + * information for ONE backward problem. + * The CVadjMem structure contains a linked list of CVodeBMem pointers + * ----------------------------------------------------------------- + */ + +struct CVodeBMemRec { + + /* Index of this backward problem */ + int cv_index; + + /* Time at which the backward problem is intialized */ + realtype cv_t0; + + /* CVODES memory for this backward problem */ + CVodeMem cv_mem; + + /* Flags to indicate that this backward problem's RHS or quad RHS + * require forward sensitivities */ + booleantype cv_f_withSensi; + booleantype cv_fQ_withSensi; + + /* Right hand side function for backward run */ + CVRhsFnB cv_f; + CVRhsFnBS cv_fs; + + /* Right hand side quadrature function for backward run */ + CVQuadRhsFnB cv_fQ; + CVQuadRhsFnBS cv_fQs; + + /* User user_data */ + void *cv_user_data; + + /* Memory block for a linear solver's interface to CVODEA */ + void *cv_lmem; + + /* Function to free any memory allocated by the linear solver */ + void (*cv_lfree)(CVodeBMem cvB_mem); + + /* Memory block for a preconditioner's module interface to CVODEA */ + void *cv_pmem; + + /* Function to free any memory allocated by the preconditioner module */ + void (*cv_pfree)(CVodeBMem cvB_mem); + + /* Time at which to extract solution / quadratures */ + realtype cv_tout; + + /* Workspace Nvector */ + N_Vector cv_y; + + /* Pointer to next structure in list */ + struct CVodeBMemRec *cv_next; + +}; + +/* + * ----------------------------------------------------------------- + * Type : struct CVadjMemRec + * ----------------------------------------------------------------- + * The type CVadjMem is type pointer to struct CVadjMemRec. + * This structure contins fields to store all information + * necessary for adjoint sensitivity analysis. + * ----------------------------------------------------------------- + */ + +struct CVadjMemRec { + + /* -------------------- + * Forward problem data + * -------------------- */ + + /* Integration interval */ + realtype ca_tinitial, ca_tfinal; + + /* Flag for first call to CVodeF */ + booleantype ca_firstCVodeFcall; + + /* Flag if CVodeF was called with TSTOP */ + booleantype ca_tstopCVodeFcall; + realtype ca_tstopCVodeF; + + /* ---------------------- + * Backward problems data + * ---------------------- */ + + /* Storage for backward problems */ + struct CVodeBMemRec *cvB_mem; + + /* Number of backward problems */ + int ca_nbckpbs; + + /* Address of current backward problem */ + struct CVodeBMemRec *ca_bckpbCrt; + + /* Flag for first call to CVodeB */ + booleantype ca_firstCVodeBcall; + + /* ---------------- + * Check point data + * ---------------- */ + + /* Storage for check point information */ + struct CkpntMemRec *ck_mem; + + /* Number of check points */ + int ca_nckpnts; + + /* address of the check point structure for which data is available */ + struct CkpntMemRec *ca_ckpntData; + + /* ------------------ + * Interpolation data + * ------------------ */ + + /* Number of steps between 2 check points */ + long int ca_nsteps; + + /* Storage for data from forward runs */ + struct DtpntMemRec **dt_mem; + + /* Actual number of data points in dt_mem (typically np=nsteps+1) */ + long int ca_np; + + /* Interpolation type */ + int ca_IMtype; + + /* Functions set by the interpolation module */ + cvaIMMallocFn ca_IMmalloc; + cvaIMFreeFn ca_IMfree; + cvaIMStorePntFn ca_IMstore; /* store a new interpolation point */ + cvaIMGetYFn ca_IMget; /* interpolate forward solution */ + + /* Flags controlling the interpolation module */ + booleantype ca_IMmallocDone; /* IM initialized? */ + booleantype ca_IMnewData; /* new data available in dt_mem?*/ + booleantype ca_IMstoreSensi; /* store sensitivities? */ + booleantype ca_IMinterpSensi; /* interpolate sensitivities? */ + + /* Workspace for the interpolation module */ + N_Vector ca_Y[L_MAX]; /* pointers to zn[i] */ + N_Vector *ca_YS[L_MAX]; /* pointers to znS[i] */ + realtype ca_T[L_MAX]; + + /* ------------------------------- + * Workspace for wrapper functions + * ------------------------------- */ + + N_Vector ca_ytmp; + + N_Vector *ca_yStmp; + +}; + + +/* + * ================================================================= + * I N T E R F A C E T O L I N E A R S O L V E R S + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Communication between CVODE and a CVODE Linear Solver + * ----------------------------------------------------------------- + * convfail (input to cv_lsetup) + * + * CV_NO_FAILURES : Either this is the first cv_setup call for this + * step, or the local error test failed on the + * previous attempt at this step (but the Newton + * iteration converged). + * + * CV_FAIL_BAD_J : This value is passed to cv_lsetup if + * + * (a) The previous Newton corrector iteration + * did not converge and the linear solver's + * setup routine indicated that its Jacobian- + * related data is not current + * or + * (b) During the previous Newton corrector + * iteration, the linear solver's solve routine + * failed in a recoverable manner and the + * linear solver's setup routine indicated that + * its Jacobian-related data is not current. + * + * CV_FAIL_OTHER : During the current internal step try, the + * previous Newton iteration failed to converge + * even though the linear solver was using current + * Jacobian-related data. + * ----------------------------------------------------------------- + */ + +/* Constants for convfail (input to cv_lsetup) */ + +#define CV_NO_FAILURES 0 +#define CV_FAIL_BAD_J 1 +#define CV_FAIL_OTHER 2 + +/* + * ----------------------------------------------------------------- + * int (*cv_linit)(CVodeMem cv_mem); + * ----------------------------------------------------------------- + * The purpose of cv_linit is to complete initializations for a + * specific linear solver, such as counters and statistics. + * An LInitFn should return 0 if it has successfully initialized the + * CVODE linear solver and a negative value otherwise. + * If an error does occur, an appropriate message should be sent to + * the error handler function. + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * int (*cv_lsetup)(CVodeMem cv_mem, int convfail, N_Vector ypred, + * N_Vector fpred, booleantype *jcurPtr, + * N_Vector vtemp1, N_Vector vtemp2, + * N_Vector vtemp3); + * ----------------------------------------------------------------- + * The job of cv_lsetup is to prepare the linear solver for + * subsequent calls to cv_lsolve. It may recompute Jacobian- + * related data is it deems necessary. Its parameters are as + * follows: + * + * cv_mem - problem memory pointer of type CVodeMem. See the + * typedef earlier in this file. + * + * convfail - a flag to indicate any problem that occurred during + * the solution of the nonlinear equation on the + * current time step for which the linear solver is + * being used. This flag can be used to help decide + * whether the Jacobian data kept by a CVODE linear + * solver needs to be updated or not. + * Its possible values have been documented above. + * + * ypred - the predicted y vector for the current CVODE internal + * step. + * + * fpred - f(tn, ypred). + * + * jcurPtr - a pointer to a boolean to be filled in by cv_lsetup. + * The function should set *jcurPtr=TRUE if its Jacobian + * data is current after the call and should set + * *jcurPtr=FALSE if its Jacobian data is not current. + * Note: If cv_lsetup calls for re-evaluation of + * Jacobian data (based on convfail and CVODE state + * data), it should return *jcurPtr=TRUE always; + * otherwise an infinite loop can result. + * + * vtemp1 - temporary N_Vector provided for use by cv_lsetup. + * + * vtemp3 - temporary N_Vector provided for use by cv_lsetup. + * + * vtemp3 - temporary N_Vector provided for use by cv_lsetup. + * + * The cv_lsetup routine should return 0 if successful, a positive + * value for a recoverable error, and a negative value for an + * unrecoverable error. + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * int (*cv_lsolve)(CVodeMem cv_mem, N_Vector b, N_Vector weight, + * N_Vector ycur, N_Vector fcur); + * ----------------------------------------------------------------- + * cv_lsolve must solve the linear equation P x = b, where + * P is some approximation to (I - gamma J), J = (df/dy)(tn,ycur) + * and the RHS vector b is input. The N-vector ycur contains + * the solver's current approximation to y(tn) and the vector + * fcur contains the N_Vector f(tn,ycur). The solution is to be + * returned in the vector b. cv_lsolve returns a positive value + * for a recoverable error and a negative value for an + * unrecoverable error. Success is indicated by a 0 return value. + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * void (*cv_lfree)(CVodeMem cv_mem); + * ----------------------------------------------------------------- + * cv_lfree should free up any memory allocated by the linear + * solver. This routine is called once a problem has been + * completed and the linear solver is no longer needed. + * ----------------------------------------------------------------- + */ + +/* + * ================================================================= + * C V O D E S I N T E R N A L F U N C T I O N S + * ================================================================= + */ + +/* Prototype of internal ewtSet function */ + +int cvEwtSet(N_Vector ycur, N_Vector weight, void *data); + +/* High level error handler */ + +void cvProcessError(CVodeMem cv_mem, + int error_code, const char *module, const char *fname, + const char *msgfmt, ...); + +/* Prototype of internal errHandler function */ + +void cvErrHandler(int error_code, const char *module, const char *function, + char *msg, void *data); + +/* Prototypes for internal sensitivity rhs wrappers */ + +int cvSensRhsWrapper(CVodeMem cv_mem, realtype time, + N_Vector ycur, N_Vector fcur, + N_Vector *yScur, N_Vector *fScur, + N_Vector temp1, N_Vector temp2); + +int cvSensRhs1Wrapper(CVodeMem cv_mem, realtype time, + N_Vector ycur, N_Vector fcur, + int is, N_Vector yScur, N_Vector fScur, + N_Vector temp1, N_Vector temp2); + +/* Prototypes for internal sensitivity rhs DQ functions */ + +int cvSensRhsInternalDQ(int Ns, realtype t, + N_Vector y, N_Vector ydot, + N_Vector *yS, N_Vector *ySdot, + void *fS_data, + N_Vector tempv, N_Vector ftemp); + +int cvSensRhs1InternalDQ(int Ns, realtype t, + N_Vector y, N_Vector ydot, + int is, N_Vector yS, N_Vector ySdot, + void *fS_data, + N_Vector tempv, N_Vector ftemp); + +/* + * ================================================================= + * C V O D E S E R R O R M E S S A G E S + * ================================================================= + */ + +#if defined(SUNDIALS_EXTENDED_PRECISION) + +#define MSG_TIME "t = %Lg" +#define MSG_TIME_H "t = %Lg and h = %Lg" +#define MSG_TIME_INT "t = %Lg is not between tcur - hu = %Lg and tcur = %Lg." +#define MSG_TIME_TOUT "tout = %Lg" +#define MSG_TIME_TSTOP "tstop = %Lg" + +#elif defined(SUNDIALS_DOUBLE_PRECISION) + +#define MSG_TIME "t = %lg" +#define MSG_TIME_H "t = %lg and h = %lg" +#define MSG_TIME_INT "t = %lg is not between tcur - hu = %lg and tcur = %lg." +#define MSG_TIME_TOUT "tout = %lg" +#define MSG_TIME_TSTOP "tstop = %lg" + +#else + +#define MSG_TIME "t = %g" +#define MSG_TIME_H "t = %g and h = %g" +#define MSG_TIME_INT "t = %g is not between tcur - hu = %g and tcur = %g." +#define MSG_TIME_TOUT "tout = %g" +#define MSG_TIME_TSTOP "tstop = %g" + +#endif + + +/* Initialization and I/O error messages */ + +#define MSGCV_NO_MEM "cvode_mem = NULL illegal." +#define MSGCV_CVMEM_FAIL "Allocation of cvode_mem failed." +#define MSGCV_MEM_FAIL "A memory request failed." +#define MSGCV_BAD_LMM "Illegal value for lmm. The legal values are CV_ADAMS and CV_BDF." +#define MSGCV_BAD_ITER "Illegal value for iter. The legal values are CV_FUNCTIONAL and CV_NEWTON." +#define MSGCV_NO_MALLOC "Attempt to call before CVodeInit." +#define MSGCV_NEG_MAXORD "maxord <= 0 illegal." +#define MSGCV_BAD_MAXORD "Illegal attempt to increase maximum method order." +#define MSGCV_SET_SLDET "Attempt to use stability limit detection with the CV_ADAMS method illegal." +#define MSGCV_NEG_HMIN "hmin < 0 illegal." +#define MSGCV_NEG_HMAX "hmax < 0 illegal." +#define MSGCV_BAD_HMIN_HMAX "Inconsistent step size limits: hmin > hmax." +#define MSGCV_BAD_RELTOL "reltol < 0 illegal." +#define MSGCV_BAD_ABSTOL "abstol has negative component(s) (illegal)." +#define MSGCV_NULL_ABSTOL "abstol = NULL illegal." +#define MSGCV_NULL_Y0 "y0 = NULL illegal." +#define MSGCV_NULL_F "f = NULL illegal." +#define MSGCV_NULL_G "g = NULL illegal." +#define MSGCV_BAD_NVECTOR "A required vector operation is not implemented." +#define MSGCV_BAD_K "Illegal value for k." +#define MSGCV_NULL_DKY "dky = NULL illegal." +#define MSGCV_BAD_T "Illegal value for t." MSG_TIME_INT +#define MSGCV_NO_ROOT "Rootfinding was not initialized." + +#define MSGCV_NO_QUAD "Quadrature integration not activated." +#define MSGCV_BAD_ITOLQ "Illegal value for itolQ. The legal values are CV_SS and CV_SV." +#define MSGCV_NULL_ABSTOLQ "abstolQ = NULL illegal." +#define MSGCV_BAD_RELTOLQ "reltolQ < 0 illegal." +#define MSGCV_BAD_ABSTOLQ "abstolQ has negative component(s) (illegal)." + +#define MSGCV_SENSINIT_2 "Sensitivity analysis already initialized." +#define MSGCV_NO_SENSI "Forward sensitivity analysis not activated." +#define MSGCV_BAD_ITOLS "Illegal value for itolS. The legal values are CV_SS, CV_SV, and CV_EE." +#define MSGCV_NULL_ABSTOLS "abstolS = NULL illegal." +#define MSGCV_BAD_RELTOLS "reltolS < 0 illegal." +#define MSGCV_BAD_ABSTOLS "abstolS has negative component(s) (illegal)." +#define MSGCV_BAD_PBAR "pbar has zero component(s) (illegal)." +#define MSGCV_BAD_PLIST "plist has negative component(s) (illegal)." +#define MSGCV_BAD_NS "NS <= 0 illegal." +#define MSGCV_NULL_YS0 "yS0 = NULL illegal." +#define MSGCV_BAD_ISM "Illegal value for ism. Legal values are: CV_SIMULTANEOUS, CV_STAGGERED and CV_STAGGERED1." +#define MSGCV_BAD_IFS "Illegal value for ifS. Legal values are: CV_ALLSENS and CV_ONESENS." +#define MSGCV_BAD_ISM_IFS "Illegal ism = CV_STAGGERED1 for CVodeSensInit." +#define MSGCV_BAD_IS "Illegal value for is." +#define MSGCV_NULL_DKYA "dkyA = NULL illegal." +#define MSGCV_BAD_DQTYPE "Illegal value for DQtype. Legal values are: CV_CENTERED and CV_FORWARD." +#define MSGCV_BAD_DQRHO "DQrhomax < 0 illegal." + +#define MSGCV_BAD_ITOLQS "Illegal value for itolQS. The legal values are CV_SS, CV_SV, and CV_EE." +#define MSGCV_NULL_ABSTOLQS "abstolQS = NULL illegal." +#define MSGCV_BAD_RELTOLQS "reltolQS < 0 illegal." +#define MSGCV_BAD_ABSTOLQS "abstolQS has negative component(s) (illegal)." +#define MSGCV_NO_QUADSENSI "Forward sensitivity analysis for quadrature variables not activated." +#define MSGCV_NULL_YQS0 "yQS0 = NULL illegal." + +/* CVode Error Messages */ + +#define MSGCV_NO_TOL "No integration tolerances have been specified." +#define MSGCV_LSOLVE_NULL "The linear solver's solve routine is NULL." +#define MSGCV_YOUT_NULL "yout = NULL illegal." +#define MSGCV_TRET_NULL "tret = NULL illegal." +#define MSGCV_BAD_EWT "Initial ewt has component(s) equal to zero (illegal)." +#define MSGCV_EWT_NOW_BAD "At " MSG_TIME ", a component of ewt has become <= 0." +#define MSGCV_BAD_ITASK "Illegal value for itask." +#define MSGCV_BAD_H0 "h0 and tout - t0 inconsistent." +#define MSGCV_BAD_TOUT "Trouble interpolating at " MSG_TIME_TOUT ". tout too far back in direction of integration" +#define MSGCV_EWT_FAIL "The user-provide EwtSet function failed." +#define MSGCV_EWT_NOW_FAIL "At " MSG_TIME ", the user-provide EwtSet function failed." +#define MSGCV_LINIT_FAIL "The linear solver's init routine failed." +#define MSGCV_HNIL_DONE "The above warning has been issued mxhnil times and will not be issued again for this problem." +#define MSGCV_TOO_CLOSE "tout too close to t0 to start integration." +#define MSGCV_MAX_STEPS "At " MSG_TIME ", mxstep steps taken before reaching tout." +#define MSGCV_TOO_MUCH_ACC "At " MSG_TIME ", too much accuracy requested." +#define MSGCV_HNIL "Internal " MSG_TIME_H " are such that t + h = t on the next step. The solver will continue anyway." +#define MSGCV_ERR_FAILS "At " MSG_TIME_H ", the error test failed repeatedly or with |h| = hmin." +#define MSGCV_CONV_FAILS "At " MSG_TIME_H ", the corrector convergence test failed repeatedly or with |h| = hmin." +#define MSGCV_SETUP_FAILED "At " MSG_TIME ", the setup routine failed in an unrecoverable manner." +#define MSGCV_SOLVE_FAILED "At " MSG_TIME ", the solve routine failed in an unrecoverable manner." +#define MSGCV_RHSFUNC_FAILED "At " MSG_TIME ", the right-hand side routine failed in an unrecoverable manner." +#define MSGCV_RHSFUNC_UNREC "At " MSG_TIME ", the right-hand side failed in a recoverable manner, but no recovery is possible." +#define MSGCV_RHSFUNC_REPTD "At " MSG_TIME " repeated recoverable right-hand side function errors." +#define MSGCV_RHSFUNC_FIRST "The right-hand side routine failed at the first call." +#define MSGCV_RTFUNC_FAILED "At " MSG_TIME ", the rootfinding routine failed in an unrecoverable manner." +#define MSGCV_CLOSE_ROOTS "Root found at and very near " MSG_TIME "." +#define MSGCV_BAD_TSTOP "The value " MSG_TIME_TSTOP " is behind current " MSG_TIME " in the direction of integration." +#define MSGCV_INACTIVE_ROOTS "At the end of the first step, there are still some root functions identically 0. This warning will not be issued again." + +#define MSGCV_NO_TOLQ "No integration tolerances for quadrature variables have been specified." +#define MSGCV_BAD_EWTQ "Initial ewtQ has component(s) equal to zero (illegal)." +#define MSGCV_EWTQ_NOW_BAD "At " MSG_TIME ", a component of ewtQ has become <= 0." +#define MSGCV_QRHSFUNC_FAILED "At " MSG_TIME ", the quadrature right-hand side routine failed in an unrecoverable manner." +#define MSGCV_QRHSFUNC_UNREC "At " MSG_TIME ", the quadrature right-hand side failed in a recoverable manner, but no recovery is possible." +#define MSGCV_QRHSFUNC_REPTD "At " MSG_TIME " repeated recoverable quadrature right-hand side function errors." +#define MSGCV_QRHSFUNC_FIRST "The quadrature right-hand side routine failed at the first call." + +#define MSGCV_NO_TOLS "No integration tolerances for sensitivity variables have been specified." +#define MSGCV_NULL_P "p = NULL when using internal DQ for sensitivity RHS illegal." +#define MSGCV_BAD_EWTS "Initial ewtS has component(s) equal to zero (illegal)." +#define MSGCV_EWTS_NOW_BAD "At " MSG_TIME ", a component of ewtS has become <= 0." +#define MSGCV_SRHSFUNC_FAILED "At " MSG_TIME ", the sensitivity right-hand side routine failed in an unrecoverable manner." +#define MSGCV_SRHSFUNC_UNREC "At " MSG_TIME ", the sensitivity right-hand side failed in a recoverable manner, but no recovery is possible." +#define MSGCV_SRHSFUNC_REPTD "At " MSG_TIME " repeated recoverable sensitivity right-hand side function errors." +#define MSGCV_SRHSFUNC_FIRST "The sensitivity right-hand side routine failed at the first call." + +#define MSGCV_NULL_FQ "CVODES is expected to use DQ to evaluate the RHS of quad. sensi., but quadratures were not initialized." +#define MSGCV_NO_TOLQS "No integration tolerances for quadrature sensitivity variables have been specified." +#define MSGCV_BAD_EWTQS "Initial ewtQS has component(s) equal to zero (illegal)." +#define MSGCV_EWTQS_NOW_BAD "At " MSG_TIME ", a component of ewtQS has become <= 0." +#define MSGCV_QSRHSFUNC_FAILED "At " MSG_TIME ", the quadrature sensitivity right-hand side routine failed in an unrecoverable manner." +#define MSGCV_QSRHSFUNC_UNREC "At " MSG_TIME ", the quadrature sensitivity right-hand side failed in a recoverable manner, but no recovery is possible." +#define MSGCV_QSRHSFUNC_REPTD "At " MSG_TIME " repeated recoverable quadrature sensitivity right-hand side function errors." +#define MSGCV_QSRHSFUNC_FIRST "The quadrature sensitivity right-hand side routine failed at the first call." + +/* + * ================================================================= + * C V O D E A E R R O R M E S S A G E S + * ================================================================= + */ + +#define MSGCV_NO_ADJ "Illegal attempt to call before calling CVodeAdjMalloc." +#define MSGCV_BAD_STEPS "Steps nonpositive illegal." +#define MSGCV_BAD_INTERP "Illegal value for interp." +#define MSGCV_BAD_WHICH "Illegal value for which." +#define MSGCV_NO_BCK "No backward problems have been defined yet." +#define MSGCV_NO_FWD "Illegal attempt to call before calling CVodeF." +#define MSGCV_BAD_TB0 "The initial time tB0 for problem %d is outside the interval over which the forward problem was solved." +#define MSGCV_BAD_SENSI "At least one backward problem requires sensitivities, but they were not stored for interpolation." +#define MSGCV_BAD_ITASKB "Illegal value for itaskB. Legal values are CV_NORMAL and CV_ONE_STEP." +#define MSGCV_BAD_TBOUT "The final time tBout is outside the interval over which the forward problem was solved." +#define MSGCV_BACK_ERROR "Error occured while integrating backward problem # %d" +#define MSGCV_BAD_TINTERP "Bad t = %g for interpolation." +#define MSGCV_WRONG_INTERP "This function cannot be called for the specified interp type." + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_io.c b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_io.c new file mode 100644 index 0000000..12e616a --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_io.c @@ -0,0 +1,1877 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.18 $ + * $Date: 2008/04/15 16:35:33 $ + * ----------------------------------------------------------------- + * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for the optional input and output + * functions for the CVODES solver. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "cvodes_impl.h" + +#include +#include + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + +/* + * ================================================================= + * CVODES optional input functions + * ================================================================= + */ + +/* + * CVodeSetErrHandlerFn + * + * Specifies the error handler function + */ + +int CVodeSetErrHandlerFn(void *cvode_mem, CVErrHandlerFn ehfun, void *eh_data) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetErrHandlerFn", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + cv_mem->cv_ehfun = ehfun; + cv_mem->cv_eh_data = eh_data; + + return(CV_SUCCESS); +} + +/* + * CVodeSetErrFile + * + * Specifies the FILE pointer for output (NULL means no messages) + */ + +int CVodeSetErrFile(void *cvode_mem, FILE *errfp) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetErrFile", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + cv_mem->cv_errfp = errfp; + + return(CV_SUCCESS); +} + +/* + * CVodeSetIterType + * + * Specifies the iteration type (CV_FUNCTIONAL or CV_NEWTON) + */ + +int CVodeSetIterType(void *cvode_mem, int iter) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetIterType", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + if ((iter != CV_FUNCTIONAL) && (iter != CV_NEWTON)) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetIterType", MSGCV_BAD_ITER); + return (CV_ILL_INPUT); + } + + cv_mem->cv_iter = iter; + + return(CV_SUCCESS); +} + +/* + * CVodeSetUserData + * + * Specifies the user data pointer for f + */ + +int CVodeSetUserData(void *cvode_mem, void *user_data) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetUserData", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + cv_mem->cv_user_data = user_data; + + return(CV_SUCCESS); +} + +/* + * CVodeSetMaxOrd + * + * Specifies the maximum method order + */ + +int CVodeSetMaxOrd(void *cvode_mem, int maxord) +{ + CVodeMem cv_mem; + int qmax_alloc; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetMaxOrd", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + if (maxord <= 0) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetMaxOrd", MSGCV_NEG_MAXORD); + return(CV_ILL_INPUT); + } + + /* Cannot increase maximum order beyond the value that + was used when allocating memory */ + qmax_alloc = cv_mem->cv_qmax_alloc; + qmax_alloc = MIN(qmax_alloc, cv_mem->cv_qmax_allocQ); + qmax_alloc = MIN(qmax_alloc, cv_mem->cv_qmax_allocS); + + if (maxord > qmax_alloc) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetMaxOrd", MSGCV_BAD_MAXORD); + return(CV_ILL_INPUT); + } + + cv_mem->cv_qmax = maxord; + + return(CV_SUCCESS); +} + +/* + * CVodeSetMaxNumSteps + * + * Specifies the maximum number of integration steps + */ + +int CVodeSetMaxNumSteps(void *cvode_mem, long int mxsteps) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetMaxNumSteps", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + /* Passing mxsteps=0 sets the default. Passing mxsteps<0 disables the test. */ + if (mxsteps == 0) + cv_mem->cv_mxstep = MXSTEP_DEFAULT; + else + cv_mem->cv_mxstep = mxsteps; + + return(CV_SUCCESS); +} + +/* + * CVodeSetMaxHnilWarns + * + * Specifies the maximum number of warnings for small h + */ + +int CVodeSetMaxHnilWarns(void *cvode_mem, int mxhnil) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetMaxHnilWarns", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + cv_mem->cv_mxhnil = mxhnil; + + return(CV_SUCCESS); +} + +/* + *CVodeSetStabLimDet + * + * Turns on/off the stability limit detection algorithm + */ + +int CVodeSetStabLimDet(void *cvode_mem, booleantype sldet) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetStabLimDet", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + if( sldet && (cv_mem->cv_lmm != CV_BDF) ) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetStabLimDet", MSGCV_SET_SLDET); + return(CV_ILL_INPUT); + } + + cv_mem->cv_sldeton = sldet; + + return(CV_SUCCESS); +} + +/* + * CVodeSetInitStep + * + * Specifies the initial step size + */ + +int CVodeSetInitStep(void *cvode_mem, realtype hin) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetInitStep", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + cv_mem->cv_hin = hin; + + return(CV_SUCCESS); +} + +/* + * CVodeSetMinStep + * + * Specifies the minimum step size + */ + +int CVodeSetMinStep(void *cvode_mem, realtype hmin) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetMinStep", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + if (hmin<0) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetMinStep", MSGCV_NEG_HMIN); + return(CV_ILL_INPUT); + } + + /* Passing 0 sets hmin = zero */ + if (hmin == ZERO) { + cv_mem->cv_hmin = HMIN_DEFAULT; + return(CV_SUCCESS); + } + + if (hmin * cv_mem->cv_hmax_inv > ONE) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetMinStep", MSGCV_BAD_HMIN_HMAX); + return(CV_ILL_INPUT); + } + + cv_mem->cv_hmin = hmin; + + return(CV_SUCCESS); +} + +/* + * CVodeSetMaxStep + * + * Specifies the maximum step size + */ + +int CVodeSetMaxStep(void *cvode_mem, realtype hmax) +{ + realtype hmax_inv; + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetMaxStep", MSGCV_NO_MEM); + return (CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + if (hmax < 0) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetMaxStep", MSGCV_NEG_HMAX); + return(CV_ILL_INPUT); + } + + /* Passing 0 sets hmax = infinity */ + if (hmax == ZERO) { + cv_mem->cv_hmax_inv = HMAX_INV_DEFAULT; + return(CV_SUCCESS); + } + + hmax_inv = ONE/hmax; + if (hmax_inv * cv_mem->cv_hmin > ONE) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetMaxStep", MSGCV_BAD_HMIN_HMAX); + return(CV_ILL_INPUT); + } + + cv_mem->cv_hmax_inv = hmax_inv; + + return(CV_SUCCESS); +} + +/* + * CVodeSetStopTime + * + * Specifies the time beyond which the integration is not to proceed. + */ + +int CVodeSetStopTime(void *cvode_mem, realtype tstop) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetStopTime", MSGCV_NO_MEM); + return (CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* If CVode was called at least once, test if tstop is legal + * (i.e. if it was not already passed). + * If CVodeSetStopTime is called before the first call to CVode, + * tstop will be checked in CVode. */ + if (cv_mem->cv_nst > 0) { + + if ( (tstop - cv_mem->cv_tn) * cv_mem->cv_h < ZERO ) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetStopTime", MSGCV_BAD_TSTOP, cv_mem->cv_tn); + return(CV_ILL_INPUT); + } + + } + + cv_mem->cv_tstop = tstop; + cv_mem->cv_tstopset = TRUE; + + return(CV_SUCCESS); +} + +/* + * CVodeSetMaxErrTestFails + * + * Specifies the maximum number of error test failures during one + * step try. + */ + +int CVodeSetMaxErrTestFails(void *cvode_mem, int maxnef) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetMaxErrTestFails", MSGCV_NO_MEM); + return (CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + cv_mem->cv_maxnef = maxnef; + + return(CV_SUCCESS); +} + +/* + * CVodeSetMaxConvFails + * + * Specifies the maximum number of nonlinear convergence failures + * during one step try. + */ + +int CVodeSetMaxConvFails(void *cvode_mem, int maxncf) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetMaxConvFails", MSGCV_NO_MEM); + return (CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + cv_mem->cv_maxncf = maxncf; + + return(CV_SUCCESS); +} + +/* + * CVodeSetMaxNonlinIters + * + * Specifies the maximum number of nonlinear iterations during + * one solve. + */ + +int CVodeSetMaxNonlinIters(void *cvode_mem, int maxcor) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetMaxNonlinIters", MSGCV_NO_MEM); + return (CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + cv_mem->cv_maxcor = maxcor; + + return(CV_SUCCESS); +} + +/* + * CVodeSetNonlinConvCoef + * + * Specifies the coeficient in the nonlinear solver convergence + * test + */ + +int CVodeSetNonlinConvCoef(void *cvode_mem, realtype nlscoef) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetNonlinConvCoef", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + cv_mem->cv_nlscoef = nlscoef; + + return(CV_SUCCESS); +} + +/* + * CVodeSetRootDirection + * + * Specifies the direction of zero-crossings to be monitored. + * The default is to monitor both crossings. + */ + +int CVodeSetRootDirection(void *cvode_mem, int *rootdir) +{ + CVodeMem cv_mem; + int i, nrt; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetRootDirection", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + nrt = cv_mem->cv_nrtfn; + if (nrt==0) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetRootDirection", MSGCV_NO_ROOT); + return(CV_ILL_INPUT); + } + + for(i=0; icv_rootdir[i] = rootdir[i]; + + return(CV_SUCCESS); +} + + +/* + * CVodeSetNoInactiveRootWarn + * + * Disables issuing a warning if some root function appears + * to be identically zero at the beginning of the integration + */ + +int CVodeSetNoInactiveRootWarn(void *cvode_mem) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetNoInactiveRootWarn", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + cv_mem->cv_mxgnull = 0; + + return(CV_SUCCESS); +} + +/* + * ================================================================= + * Quadrature optional input functions + * ================================================================= + */ + +int CVodeSetQuadErrCon(void *cvode_mem, booleantype errconQ) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetQuadErrCon", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + cv_mem->cv_errconQ = errconQ; + + return(CV_SUCCESS); +} + +/* + * ================================================================= + * FSA optional input functions + * ================================================================= + */ + +int CVodeSetSensDQMethod(void *cvode_mem, int DQtype, realtype DQrhomax) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetSensDQMethod", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + if ( (DQtype != CV_CENTERED) && (DQtype != CV_FORWARD) ) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetSensDQMethod", MSGCV_BAD_DQTYPE); + return(CV_ILL_INPUT); + } + + if (DQrhomax < ZERO ) { + cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetSensDQMethod", MSGCV_BAD_DQRHO); + return(CV_ILL_INPUT); + } + + cv_mem->cv_DQtype = DQtype; + cv_mem->cv_DQrhomax = DQrhomax; + + return(CV_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int CVodeSetSensErrCon(void *cvode_mem, booleantype errconS) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetSensErrCon", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + cv_mem->cv_errconS = errconS; + + return(CV_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int CVodeSetSensMaxNonlinIters(void *cvode_mem, int maxcorS) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetSensMaxNonlinIters", MSGCV_NO_MEM); + return (CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + cv_mem->cv_maxcorS = maxcorS; + + return(CV_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int CVodeSetSensParams(void *cvode_mem, realtype *p, realtype *pbar, int *plist) +{ + CVodeMem cv_mem; + int is, Ns; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetSensParams", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + /* Was sensitivity initialized? */ + + if (cv_mem->cv_SensMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeSetSensParams", MSGCV_NO_SENSI); + return(CV_NO_SENS); + } + + Ns = cv_mem->cv_Ns; + + /* Parameters */ + + cv_mem->cv_p = p; + + /* pbar */ + + if (pbar != NULL) + for (is=0; iscv_pbar[is] = ABS(pbar[is]); + } + else + for (is=0; iscv_pbar[is] = ONE; + + /* plist */ + + if (plist != NULL) + for (is=0; iscv_plist[is] = plist[is]; + } + else + for (is=0; iscv_plist[is] = is; + + return(CV_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int CVodeSetQuadSensErrCon(void *cvode_mem, booleantype errconQS) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetQuadSensErrCon", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was sensitivity initialized? */ + + if (cv_mem->cv_SensMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeSetQuadSensTolerances", MSGCV_NO_SENSI); + return(CV_NO_SENS); + } + + /* Ckeck if quadrature sensitivity was initialized? */ + + if (cv_mem->cv_QuadSensMallocDone == FALSE) { + cvProcessError(cv_mem, CV_NO_QUADSENS, "CVODES", "CVodeSetQuadSensErrCon", MSGCV_NO_QUADSENSI); + return(CV_NO_QUAD); + } + + cv_mem->cv_errconQS = errconQS; + + return(CV_SUCCESS); +} + +/* + * ================================================================= + * CVODES optional output functions + * ================================================================= + */ + +/* + * Readability constants + */ + +#define nst (cv_mem->cv_nst) +#define nfe (cv_mem->cv_nfe) +#define ncfn (cv_mem->cv_ncfn) +#define netf (cv_mem->cv_netf) +#define nni (cv_mem->cv_nni) +#define nsetups (cv_mem->cv_nsetups) +#define qu (cv_mem->cv_qu) +#define next_q (cv_mem->cv_next_q) +#define ewt (cv_mem->cv_ewt) +#define hu (cv_mem->cv_hu) +#define next_h (cv_mem->cv_next_h) +#define h0u (cv_mem->cv_h0u) +#define tolsf (cv_mem->cv_tolsf) +#define acor (cv_mem->cv_acor) +#define lrw (cv_mem->cv_lrw) +#define liw (cv_mem->cv_liw) +#define nge (cv_mem->cv_nge) +#define iroots (cv_mem->cv_iroots) +#define nor (cv_mem->cv_nor) +#define sldeton (cv_mem->cv_sldeton) +#define tn (cv_mem->cv_tn) +#define efun (cv_mem->cv_efun) + +/* + * CVodeGetNumSteps + * + * Returns the current number of integration steps + */ + +int CVodeGetNumSteps(void *cvode_mem, long int *nsteps) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetNumSteps", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + *nsteps = nst; + + return(CV_SUCCESS); +} + +/* + * CVodeGetNumRhsEvals + * + * Returns the current number of calls to f + */ + +int CVodeGetNumRhsEvals(void *cvode_mem, long int *nfevals) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetNumRhsEvals", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + *nfevals = nfe; + + return(CV_SUCCESS); +} + +/* + * CVodeGetNumLinSolvSetups + * + * Returns the current number of calls to the linear solver setup routine + */ + +int CVodeGetNumLinSolvSetups(void *cvode_mem, long int *nlinsetups) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetNumLinSolvSetups", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + *nlinsetups = nsetups; + + return(CV_SUCCESS); +} + +/* + * CVodeGetNumErrTestFails + * + * Returns the current number of error test failures + */ + +int CVodeGetNumErrTestFails(void *cvode_mem, long int *netfails) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetNumErrTestFails", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + *netfails = netf; + + return(CV_SUCCESS); +} + +/* + * CVodeGetLastOrder + * + * Returns the order on the last succesful step + */ + +int CVodeGetLastOrder(void *cvode_mem, int *qlast) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetLastOrder", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + *qlast = qu; + + return(CV_SUCCESS); +} + +/* + * CVodeGetCurrentOrder + * + * Returns the order to be attempted on the next step + */ + +int CVodeGetCurrentOrder(void *cvode_mem, int *qcur) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetCurrentOrder", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + *qcur = next_q; + + return(CV_SUCCESS); +} + +/* + * CVodeGetNumStabLimOrderReds + * + * Returns the number of order reductions triggered by the stability + * limit detection algorithm + */ + +int CVodeGetNumStabLimOrderReds(void *cvode_mem, long int *nslred) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetNumStabLimOrderReds", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + if (sldeton==FALSE) + *nslred = 0; + else + *nslred = nor; + + return(CV_SUCCESS); +} + +/* + * CVodeGetActualInitStep + * + * Returns the step size used on the first step + */ + +int CVodeGetActualInitStep(void *cvode_mem, realtype *hinused) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetActualInitStep", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + *hinused = h0u; + + return(CV_SUCCESS); +} + +/* + * CVodeGetLastStep + * + * Returns the step size used on the last successful step + */ + +int CVodeGetLastStep(void *cvode_mem, realtype *hlast) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetLastStep", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + *hlast = hu; + + return(CV_SUCCESS); +} + +/* + * CVodeGetCurrentStep + * + * Returns the step size to be attempted on the next step + */ + +int CVodeGetCurrentStep(void *cvode_mem, realtype *hcur) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetCurrentStep", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + *hcur = next_h; + + return(CV_SUCCESS); +} + +/* + * CVodeGetCurrentTime + * + * Returns the current value of the independent variable + */ + +int CVodeGetCurrentTime(void *cvode_mem, realtype *tcur) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetCurrentTime", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + *tcur = tn; + + return(CV_SUCCESS); +} + +/* + * CVodeGetTolScaleFactor + * + * Returns a suggested factor for scaling tolerances + */ + +int CVodeGetTolScaleFactor(void *cvode_mem, realtype *tolsfact) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetTolScaleFactor", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + *tolsfact = tolsf; + + return(CV_SUCCESS); +} + +/* + * CVodeGetErrWeights + * + * This routine returns the current weight vector. + */ + +int CVodeGetErrWeights(void *cvode_mem, N_Vector eweight) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetErrWeights", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + N_VScale(ONE, ewt, eweight); + + return(CV_SUCCESS); +} + +/* + * CVodeGetEstLocalErrors + * + * Returns an estimate of the local error + */ + +int CVodeGetEstLocalErrors(void *cvode_mem, N_Vector ele) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetEstLocalErrors", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + N_VScale(ONE, acor, ele); + + return(CV_SUCCESS); +} + +/* + * CVodeGetWorkSpace + * + * Returns integrator work space requirements + */ + +int CVodeGetWorkSpace(void *cvode_mem, long int *lenrw, long int *leniw) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetWorkSpace", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + *leniw = liw; + *lenrw = lrw; + + return(CV_SUCCESS); +} + +/* + * CVodeGetIntegratorStats + * + * Returns integrator statistics + */ + +int CVodeGetIntegratorStats(void *cvode_mem, long int *nsteps, long int *nfevals, + long int *nlinsetups, long int *netfails, int *qlast, + int *qcur, realtype *hinused, realtype *hlast, + realtype *hcur, realtype *tcur) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetIntegratorStats", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + *nsteps = nst; + *nfevals = nfe; + *nlinsetups = nsetups; + *netfails = netf; + *qlast = qu; + *qcur = next_q; + *hinused = h0u; + *hlast = hu; + *hcur = next_h; + *tcur = tn; + + return(CV_SUCCESS); +} + +/* + * CVodeGetNumGEvals + * + * Returns the current number of calls to g (for rootfinding) + */ + +int CVodeGetNumGEvals(void *cvode_mem, long int *ngevals) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetNumGEvals", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + *ngevals = nge; + + return(CV_SUCCESS); +} + +/* + * CVodeGetRootInfo + * + * Returns pointer to array rootsfound showing roots found + */ + +int CVodeGetRootInfo(void *cvode_mem, int *rootsfound) +{ + CVodeMem cv_mem; + int i, nrt; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetRootInfo", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + nrt = cv_mem->cv_nrtfn; + + for (i=0; icv_quadr) +#define nfQe (cv_mem->cv_nfQe) +#define netfQ (cv_mem->cv_netfQ) +#define ewtQ (cv_mem->cv_ewtQ) +#define errconQ (cv_mem->cv_errconQ) + +/*-----------------------------------------------------------------*/ + +int CVodeGetQuadNumRhsEvals(void *cvode_mem, long int *nfQevals) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadNumRhsEvals", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + if (quadr==FALSE) { + cvProcessError(cv_mem, CV_NO_QUAD, "CVODES", "CVodeGetQuadNumRhsEvals", MSGCV_NO_QUAD); + return(CV_NO_QUAD); + } + + *nfQevals = nfQe; + + return(CV_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int CVodeGetQuadNumErrTestFails(void *cvode_mem, long int *nQetfails) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadNumErrTestFails", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + if (quadr==FALSE) { + cvProcessError(cv_mem, CV_NO_QUAD, "CVODES", "CVodeGetQuadNumErrTestFails", MSGCV_NO_QUAD); + return(CV_NO_QUAD); + } + + *nQetfails = netfQ; + + return(CV_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int CVodeGetQuadErrWeights(void *cvode_mem, N_Vector eQweight) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadErrWeights", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + if (quadr==FALSE) { + cvProcessError(cv_mem, CV_NO_QUAD, "CVODES", "CVodeGetQuadErrWeights", MSGCV_NO_QUAD); + return(CV_NO_QUAD); + } + + if(errconQ) N_VScale(ONE, ewtQ, eQweight); + + return(CV_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int CVodeGetQuadStats(void *cvode_mem, long int *nfQevals, long int *nQetfails) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadStats", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + if (quadr==FALSE) { + cvProcessError(cv_mem, CV_NO_QUAD, "CVODES", "CVodeGetQuadStats", MSGCV_NO_QUAD); + return(CV_NO_QUAD); + } + + *nfQevals = nfQe; + *nQetfails = netfQ; + + return(CV_SUCCESS); +} + +/* + * ================================================================= + * Quadrature FSA optional output functions + * ================================================================= + */ + +/* + * Readability constants + */ + +#define quadr_sensi (cv_mem->cv_quadr_sensi) +#define nfQSe (cv_mem->cv_nfQSe) +#define netfQS (cv_mem->cv_netfQS) +#define ewtQS (cv_mem->cv_ewtQS) +#define errconQS (cv_mem->cv_errconQS) + +/*-----------------------------------------------------------------*/ + +int CVodeGetQuadSensNumRhsEvals(void *cvode_mem, long int *nfQSevals) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadSensNumRhsEvals", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + if (quadr_sensi == FALSE) { + cvProcessError(cv_mem, CV_NO_QUADSENS, "CVODES", "CVodeGetQuadSensNumRhsEvals", MSGCV_NO_QUADSENSI); + return(CV_NO_QUADSENS); + } + + *nfQSevals = nfQSe; + + return(CV_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int CVodeGetQuadSensNumErrTestFails(void *cvode_mem, long int *nQSetfails) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadSensNumErrTestFails", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + if (quadr_sensi == FALSE) { + cvProcessError(cv_mem, CV_NO_QUADSENS, "CVODES", "CVodeGetQuadSensNumErrTestFails", MSGCV_NO_QUADSENSI); + return(CV_NO_QUADSENS); + } + + *nQSetfails = netfQS; + + return(CV_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int CVodeGetQuadSensErrWeights(void *cvode_mem, N_Vector *eQSweight) +{ + CVodeMem cv_mem; + int is, Ns; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadSensErrWeights", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + if (quadr_sensi == FALSE) { + cvProcessError(cv_mem, CV_NO_QUADSENS, "CVODES", "CVodeGetQuadSensErrWeights", MSGCV_NO_QUADSENSI); + return(CV_NO_QUADSENS); + } + Ns = cv_mem->cv_Ns; + + if (errconQS) + for (is=0; iscv_sensi) +#define ism (cv_mem->cv_ism) +#define ewtS (cv_mem->cv_ewtS) +#define nfSe (cv_mem->cv_nfSe) +#define nfeS (cv_mem->cv_nfeS) +#define nniS (cv_mem->cv_nniS) +#define ncfnS (cv_mem->cv_ncfnS) +#define netfS (cv_mem->cv_netfS) +#define nsetupsS (cv_mem->cv_nsetupsS) +#define nniS1 (cv_mem->cv_nniS1) +#define ncfnS1 (cv_mem->cv_ncfnS1) +#define ncfS1 (cv_mem->cv_ncfS1) + +/*-----------------------------------------------------------------*/ + +int CVodeGetSensNumRhsEvals(void *cvode_mem, long int *nfSevals) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetSensNumRhsEvals", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + if (sensi==FALSE) { + cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeGetSensNumRhsEvals", MSGCV_NO_SENSI); + return(CV_NO_SENS); + } + + *nfSevals = nfSe; + + return(CV_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int CVodeGetNumRhsEvalsSens(void *cvode_mem, long int *nfevalsS) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetNumRhsEvalsSens", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + if (sensi==FALSE) { + cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeGetNumRhsEvalsSens", MSGCV_NO_SENSI); + return(CV_NO_SENS); + } + + *nfevalsS = nfeS; + + return(CV_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int CVodeGetSensNumErrTestFails(void *cvode_mem, long int *nSetfails) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetSensNumErrTestFails", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + if (sensi==FALSE) { + cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeGetSensNumErrTestFails", MSGCV_NO_SENSI); + return(CV_NO_SENS); + } + + *nSetfails = netfS; + + return(CV_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int CVodeGetSensNumLinSolvSetups(void *cvode_mem, long int *nlinsetupsS) +{ + CVodeMem cv_mem; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetSensNumLinSolvSetups", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + if (sensi==FALSE) { + cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeGetSensNumLinSolvSetups", MSGCV_NO_SENSI); + return(CV_NO_SENS); + } + + *nlinsetupsS = nsetupsS; + + return(CV_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int CVodeGetSensErrWeights(void *cvode_mem, N_Vector *eSweight) +{ + CVodeMem cv_mem; + int is, Ns; + + if (cvode_mem==NULL) { + cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetSensErrWeights", MSGCV_NO_MEM); + return(CV_MEM_NULL); + } + + cv_mem = (CVodeMem) cvode_mem; + + if (sensi==FALSE) { + cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeGetSensErrWeights", MSGCV_NO_SENSI); + return(CV_NO_SENS); + } + + Ns = cv_mem->cv_Ns; + + for (is=0; iscv_Ns; + + if (sensi==FALSE) { + cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeGetStgrSensNumNonlinSolvIters", MSGCV_NO_SENSI); + return(CV_NO_SENS); + } + + if(ism==CV_STAGGERED1) + for(is=0; iscv_Ns; + + if (sensi==FALSE) { + cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeGetStgrSensNumNonlinSolvConvFails", MSGCV_NO_SENSI); + return(CV_NO_SENS); + } + + if(ism==CV_STAGGERED1) + for(is=0; is +#include + +#include +#include "cvodes_direct_impl.h" +#include "cvodes_impl.h" + +#include + +/* Constants */ + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) +#define TWO RCONST(2.0) + +/* + * ================================================================= + * PROTOTYPES FOR PRIVATE FUNCTIONS + * ================================================================= + */ + +/* CVSLAPACK DENSE linit, lsetup, lsolve, and lfree routines */ +static int cvLapackDenseInit(CVodeMem cv_mem); +static int cvLapackDenseSetup(CVodeMem cv_mem, int convfail, + N_Vector yP, N_Vector fctP, + booleantype *jcurPtr, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); +static int cvLapackDenseSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, + N_Vector yC, N_Vector fctC); +static void cvLapackDenseFree(CVodeMem cv_mem); + +/* CVSLAPACK BAND linit, lsetup, lsolve, and lfree routines */ +static int cvLapackBandInit(CVodeMem cv_mem); +static int cvLapackBandSetup(CVodeMem cv_mem, int convfail, + N_Vector yP, N_Vector fctP, + booleantype *jcurPtr, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); +static int cvLapackBandSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, + N_Vector yC, N_Vector fctC); +static void cvLapackBandFree(CVodeMem cv_mem); + +/* CVSLAPACK lfreeB functions */ +static void cvLapackDenseFreeB(CVodeBMem cvB_mem); +static void cvLapackBandFreeB(CVodeBMem cvB_mem); + +/* + * ================================================================ + * + * PART I - forward problems + * + * ================================================================ + */ + +/* Readability Replacements */ + +#define lmm (cv_mem->cv_lmm) +#define f (cv_mem->cv_f) +#define uround (cv_mem->cv_uround) +#define nst (cv_mem->cv_nst) +#define tn (cv_mem->cv_tn) +#define h (cv_mem->cv_h) +#define gamma (cv_mem->cv_gamma) +#define gammap (cv_mem->cv_gammap) +#define gamrat (cv_mem->cv_gamrat) +#define ewt (cv_mem->cv_ewt) + +#define linit (cv_mem->cv_linit) +#define lsetup (cv_mem->cv_lsetup) +#define lsolve (cv_mem->cv_lsolve) +#define lfree (cv_mem->cv_lfree) +#define lmem (cv_mem->cv_lmem) +#define tempv (cv_mem->cv_tempv) +#define setupNonNull (cv_mem->cv_setupNonNull) + +#define mtype (cvdls_mem->d_type) +#define n (cvdls_mem->d_n) +#define jacDQ (cvdls_mem->d_jacDQ) +#define djac (cvdls_mem->d_djac) +#define bjac (cvdls_mem->d_bjac) +#define M (cvdls_mem->d_M) +#define mu (cvdls_mem->d_mu) +#define ml (cvdls_mem->d_ml) +#define smu (cvdls_mem->d_smu) +#define pivots (cvdls_mem->d_pivots) +#define savedJ (cvdls_mem->d_savedJ) +#define nstlj (cvdls_mem->d_nstlj) +#define nje (cvdls_mem->d_nje) +#define nfeDQ (cvdls_mem->d_nfeDQ) +#define J_data (cvdls_mem->d_J_data) +#define last_flag (cvdls_mem->d_last_flag) + +/* + * ----------------------------------------------------------------- + * CVLapackDense + * ----------------------------------------------------------------- + * This routine initializes the memory record and sets various function + * fields specific to the linear solver module. CVLapackDense first + * calls the existing lfree routine if this is not NULL. Then it sets + * the cv_linit, cv_lsetup, cv_lsolve, cv_lfree fields in (*cvode_mem) + * to be cvLapackDenseInit, cvLapackDenseSetup, cvLapackDenseSolve, + * and cvLapackDenseFree, respectively. It allocates memory for a + * structure of type CVDlsMemRec and sets the cv_lmem field in + * (*cvode_mem) to the address of this structure. It sets setupNonNull + * in (*cvode_mem) to TRUE, and the d_jac field to the default + * cvDlsDenseDQJac. Finally, it allocates memory for M, pivots, and + * (if needed) savedJ. + * The return value is SUCCESS = 0, or LMEM_FAIL = -1. + * + * NOTE: The dense linear solver assumes a serial implementation + * of the NVECTOR package. Therefore, CVLapackDense will first + * test for a compatible N_Vector internal representation + * by checking that N_VGetArrayPointer and N_VSetArrayPointer + * exist. + * ----------------------------------------------------------------- + */ +int CVLapackDense(void *cvode_mem, int N) +{ + CVodeMem cv_mem; + CVDlsMem cvdls_mem; + + /* Return immediately if cvode_mem is NULL */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVDLS_MEM_NULL, "CVSLAPACK", "CVLapackDense", MSGD_CVMEM_NULL); + return(CVDLS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Test if the NVECTOR package is compatible with the CVSLAPACK solver */ + if (tempv->ops->nvgetarraypointer == NULL || + tempv->ops->nvsetarraypointer == NULL) { + cvProcessError(cv_mem, CVDLS_ILL_INPUT, "CVSLAPACK", "CVLapackDense", MSGD_BAD_NVECTOR); + return(CVDLS_ILL_INPUT); + } + + if (lfree !=NULL) lfree(cv_mem); + + /* Set four main function fields in cv_mem */ + linit = cvLapackDenseInit; + lsetup = cvLapackDenseSetup; + lsolve = cvLapackDenseSolve; + lfree = cvLapackDenseFree; + + /* Get memory for CVDlsMemRec */ + cvdls_mem = NULL; + cvdls_mem = (CVDlsMem) malloc(sizeof(struct CVDlsMemRec)); + if (cvdls_mem == NULL) { + cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSLAPACK", "CVLapackDense", MSGD_MEM_FAIL); + return(CVDLS_MEM_FAIL); + } + + /* Set matrix type */ + mtype = SUNDIALS_DENSE; + + /* Initialize Jacobian-related data */ + jacDQ = TRUE; + djac = NULL; + J_data = NULL; + + last_flag = CVDLS_SUCCESS; + setupNonNull = TRUE; + + /* Set problem dimension */ + n = N; + + /* Allocate memory for M, pivot array, and (if needed) savedJ */ + M = NULL; + pivots = NULL; + savedJ = NULL; + + M = NewDenseMat(N, N); + if (M == NULL) { + cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSLAPACK", "CVLapackDense", MSGD_MEM_FAIL); + free(cvdls_mem); + return(CVDLS_MEM_FAIL); + } + pivots = NewIntArray(N); + if (pivots == NULL) { + cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSLAPACK", "CVLapackDense", MSGD_MEM_FAIL); + DestroyMat(M); + free(cvdls_mem); + return(CVDLS_MEM_FAIL); + } + savedJ = NewDenseMat(N, N); + if (savedJ == NULL) { + cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSLAPACK", "CVLapackDense", MSGD_MEM_FAIL); + DestroyMat(M); + DestroyArray(pivots); + free(cvdls_mem); + return(CVDLS_MEM_FAIL); + } + + /* Attach linear solver memory to integrator memory */ + lmem = cvdls_mem; + + return(CVDLS_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * CVLapackBand + * ----------------------------------------------------------------- + * This routine initializes the memory record and sets various function + * fields specific to the band linear solver module. It first calls + * the existing lfree routine if this is not NULL. It then sets the + * cv_linit, cv_lsetup, cv_lsolve, and cv_lfree fields in (*cvode_mem) + * to be cvLapackBandInit, cvLapackBandSetup, cvLapackBandSolve, + * and cvLapackBandFree, respectively. It allocates memory for a + * structure of type CVLapackBandMemRec and sets the cv_lmem field in + * (*cvode_mem) to the address of this structure. It sets setupNonNull + * in (*cvode_mem) to be TRUE, mu to be mupper, ml to be mlower, and + * the jacE and jacI field to NULL. + * Finally, it allocates memory for M, pivots, and (if needed) savedJ. + * The CVLapackBand return value is CVDLS_SUCCESS = 0, + * CVDLS_MEM_FAIL = -1, or CVDLS_ILL_INPUT = -2. + * + * NOTE: The CVSLAPACK linear solver assumes a serial implementation + * of the NVECTOR package. Therefore, CVLapackBand will first + * test for compatible a compatible N_Vector internal + * representation by checking that the function + * N_VGetArrayPointer exists. + * ----------------------------------------------------------------- + */ +int CVLapackBand(void *cvode_mem, int N, int mupper, int mlower) +{ + CVodeMem cv_mem; + CVDlsMem cvdls_mem; + + /* Return immediately if cvode_mem is NULL */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVDLS_MEM_NULL, "CVSLAPACK", "CVLapackBand", MSGD_CVMEM_NULL); + return(CVDLS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Test if the NVECTOR package is compatible with the BAND solver */ + if (tempv->ops->nvgetarraypointer == NULL) { + cvProcessError(cv_mem, CVDLS_ILL_INPUT, "CVSLAPACK", "CVLapackBand", MSGD_BAD_NVECTOR); + return(CVDLS_ILL_INPUT); + } + + if (lfree != NULL) lfree(cv_mem); + + /* Set four main function fields in cv_mem */ + linit = cvLapackBandInit; + lsetup = cvLapackBandSetup; + lsolve = cvLapackBandSolve; + lfree = cvLapackBandFree; + + /* Get memory for CVDlsMemRec */ + cvdls_mem = NULL; + cvdls_mem = (CVDlsMem) malloc(sizeof(struct CVDlsMemRec)); + if (cvdls_mem == NULL) { + cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSLAPACK", "CVLapackBand", MSGD_MEM_FAIL); + return(CVDLS_MEM_FAIL); + } + + /* Set matrix type */ + mtype = SUNDIALS_BAND; + + /* Initialize Jacobian-related data */ + jacDQ = TRUE; + bjac = NULL; + J_data = NULL; + + last_flag = CVDLS_SUCCESS; + setupNonNull = TRUE; + + /* Load problem dimension */ + n = N; + + /* Load half-bandwiths in cvdls_mem */ + ml = mlower; + mu = mupper; + + /* Test ml and mu for legality */ + if ((ml < 0) || (mu < 0) || (ml >= N) || (mu >= N)) { + cvProcessError(cv_mem, CVDLS_ILL_INPUT, "CVSLAPACK", "CVLapackBand", MSGD_BAD_SIZES); + return(CVDLS_ILL_INPUT); + } + + /* Set extended upper half-bandwith for M (required for pivoting) */ + smu = MIN(N-1, mu + ml); + + /* Allocate memory for M, savedJ, and pivot arrays */ + M = NULL; + pivots = NULL; + savedJ = NULL; + + M = NewBandMat(N, mu, ml, smu); + if (M == NULL) { + cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSLAPACK", "CVLapackBand", MSGD_MEM_FAIL); + free(cvdls_mem); + return(CVDLS_MEM_FAIL); + } + pivots = NewIntArray(N); + if (pivots == NULL) { + cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSLAPACK", "CVLapackBand", MSGD_MEM_FAIL); + DestroyMat(M); + free(cvdls_mem); + return(CVDLS_MEM_FAIL); + } + savedJ = NewBandMat(N, mu, ml, smu); + if (savedJ == NULL) { + cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSLAPACK", "CVLapackBand", MSGD_MEM_FAIL); + DestroyMat(M); + DestroyArray(pivots); + free(cvdls_mem); + return(CVDLS_MEM_FAIL); + } + + /* Attach linear solver memory to integrator memory */ + lmem = cvdls_mem; + + return(CVDLS_SUCCESS); +} + +/* + * ================================================================= + * PRIVATE FUNCTIONS FOR IMPLICIT INTEGRATION WITH DENSE JACOBIANS + * ================================================================= + */ + +/* + * cvLapackDenseInit does remaining initializations specific to the dense + * linear solver. + */ +static int cvLapackDenseInit(CVodeMem cv_mem) +{ + CVDlsMem cvdls_mem; + + cvdls_mem = (CVDlsMem) lmem; + + nje = 0; + nfeDQ = 0; + nstlj = 0; + + /* Set Jacobian function and data, depending on jacDQ */ + if (jacDQ) { + djac = cvDlsDenseDQJac; + J_data = cv_mem; + } else { + J_data = cv_mem->cv_user_data; + } + + last_flag = CVDLS_SUCCESS; + return(0); +} + +/* + * cvLapackDenseSetup does the setup operations for the dense linear solver. + * It makes a decision whether or not to call the Jacobian evaluation + * routine based on various state variables, and if not it uses the + * saved copy. In any case, it constructs the Newton matrix M = I - gamma*J + * updates counters, and calls the dense LU factorization routine. + */ +static int cvLapackDenseSetup(CVodeMem cv_mem, int convfail, + N_Vector yP, N_Vector fctP, + booleantype *jcurPtr, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) +{ + CVDlsMem cvdls_mem; + realtype dgamma, fact; + booleantype jbad, jok; + int ier, retval, one = 1; + + cvdls_mem = (CVDlsMem) lmem; + + /* Use nst, gamma/gammap, and convfail to set J eval. flag jok */ + dgamma = ABS((gamma/gammap) - ONE); + jbad = (nst == 0) || (nst > nstlj + CVD_MSBJ) || + ((convfail == CV_FAIL_BAD_J) && (dgamma < CVD_DGMAX)) || + (convfail == CV_FAIL_OTHER); + jok = !jbad; + + if (jok) { + + /* If jok = TRUE, use saved copy of J */ + *jcurPtr = FALSE; + dcopy_f77(&(savedJ->ldata), savedJ->data, &one, M->data, &one); + + } else { + + /* If jok = FALSE, call jac routine for new J value */ + nje++; + nstlj = nst; + *jcurPtr = TRUE; + SetToZero(M); + + retval = djac(n, tn, yP, fctP, M, J_data, tmp1, tmp2, tmp3); + if (retval == 0) { + dcopy_f77(&(M->ldata), M->data, &one, savedJ->data, &one); + } else if (retval < 0) { + cvProcessError(cv_mem, CVDLS_JACFUNC_UNRECVR, "CVSLAPACK", "cvLapackDenseSetup", MSGD_JACFUNC_FAILED); + last_flag = CVDLS_JACFUNC_UNRECVR; + return(-1); + } else if (retval > 0) { + last_flag = CVDLS_JACFUNC_RECVR; + return(1); + } + + } + + /* Scale J by - gamma */ + fact = -gamma; + dscal_f77(&(M->ldata), &fact, M->data, &one); + + /* Add identity to get M = I - gamma*J*/ + AddIdentity(M); + + /* Do LU factorization of M */ + dgetrf_f77(&n, &n, M->data, &(M->ldim), pivots, &ier); + + /* Return 0 if the LU was complete; otherwise return 1 */ + last_flag = ier; + if (ier > 0) return(1); + return(0); +} + +/* + * cvLapackDenseSolve handles the solve operation for the dense linear solver + * by calling the dense backsolve routine. + */ +static int cvLapackDenseSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, + N_Vector yC, N_Vector fctC) +{ + CVDlsMem cvdls_mem; + realtype *bd, fact; + int ier, one = 1; + + cvdls_mem = (CVDlsMem) lmem; + + bd = N_VGetArrayPointer(b); + + dgetrs_f77("N", &n, &one, M->data, &(M->ldim), pivots, bd, &n, &ier, 1); + if (ier > 0) return(1); + + /* For BDF, scale the correction to account for change in gamma */ + if ((lmm == CV_BDF) && (gamrat != ONE)) { + fact = TWO/(ONE + gamrat); + dscal_f77(&n, &fact, bd, &one); + } + + last_flag = CVDLS_SUCCESS; + return(0); +} + +/* + * cvLapackDenseFree frees memory specific to the dense linear solver. + */ +static void cvLapackDenseFree(CVodeMem cv_mem) +{ + CVDlsMem cvdls_mem; + + cvdls_mem = (CVDlsMem) lmem; + + DestroyMat(M); + DestroyArray(pivots); + DestroyMat(savedJ); + free(cvdls_mem); + cvdls_mem = NULL; +} + +/* + * ================================================================= + * PRIVATE FUNCTIONS FOR IMPLICIT INTEGRATION WITH BAND JACOBIANS + * ================================================================= + */ + +/* + * cvLapackBandInit does remaining initializations specific to the band + * linear solver. + */ +static int cvLapackBandInit(CVodeMem cv_mem) +{ + CVDlsMem cvdls_mem; + + cvdls_mem = (CVDlsMem) lmem; + + nje = 0; + nfeDQ = 0; + nstlj = 0; + + /* Set Jacobian function and data, depending on jacDQ */ + if (jacDQ) { + bjac = cvDlsBandDQJac; + J_data = cv_mem; + } else { + J_data = cv_mem->cv_user_data; + } + + last_flag = CVDLS_SUCCESS; + return(0); +} + +/* + * cvLapackBandSetup does the setup operations for the band linear solver. + * It makes a decision whether or not to call the Jacobian evaluation + * routine based on various state variables, and if not it uses the + * saved copy. In any case, it constructs the Newton matrix M = I - gamma*J, + * updates counters, and calls the band LU factorization routine. + */ +static int cvLapackBandSetup(CVodeMem cv_mem, int convfail, + N_Vector yP, N_Vector fctP, + booleantype *jcurPtr, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) +{ + CVDlsMem cvdls_mem; + realtype dgamma, fact; + booleantype jbad, jok; + int ier, retval, one = 1; + + cvdls_mem = (CVDlsMem) lmem; + + /* Use nst, gamma/gammap, and convfail to set J eval. flag jok */ + dgamma = ABS((gamma/gammap) - ONE); + jbad = (nst == 0) || (nst > nstlj + CVD_MSBJ) || + ((convfail == CV_FAIL_BAD_J) && (dgamma < CVD_DGMAX)) || + (convfail == CV_FAIL_OTHER); + jok = !jbad; + + if (jok) { + + /* If jok = TRUE, use saved copy of J */ + *jcurPtr = FALSE; + dcopy_f77(&(savedJ->ldata), savedJ->data, &one, M->data, &one); + + } else { + + /* If jok = FALSE, call jac routine for new J value */ + nje++; + nstlj = nst; + *jcurPtr = TRUE; + SetToZero(M); + + retval = bjac(n, mu, ml, tn, yP, fctP, M, J_data, tmp1, tmp2, tmp3); + if (retval == 0) { + dcopy_f77(&(M->ldata), M->data, &one, savedJ->data, &one); + } else if (retval < 0) { + cvProcessError(cv_mem, CVDLS_JACFUNC_UNRECVR, "CVSLAPACK", "cvLapackBandSetup", MSGD_JACFUNC_FAILED); + last_flag = CVDLS_JACFUNC_UNRECVR; + return(-1); + } else if (retval > 0) { + last_flag = CVDLS_JACFUNC_RECVR; + return(1); + } + + } + + /* Scale J by - gamma */ + fact = -gamma; + dscal_f77(&(M->ldata), &fact, M->data, &one); + + /* Add identity to get M = I - gamma*J*/ + AddIdentity(M); + + /* Do LU factorization of M */ + dgbtrf_f77(&n, &n, &ml, &mu, M->data, &(M->ldim), pivots, &ier); + + /* Return 0 if the LU was complete; otherwise return 1 */ + last_flag = ier; + if (ier > 0) return(1); + return(0); + +} + +/* + * cvLapackBandSolve handles the solve operation for the band linear solver + * by calling the band backsolve routine. + */ +static int cvLapackBandSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, + N_Vector yC, N_Vector fctC) +{ + CVDlsMem cvdls_mem; + realtype *bd, fact; + int ier, one = 1; + + cvdls_mem = (CVDlsMem) lmem; + + bd = N_VGetArrayPointer(b); + + dgbtrs_f77("N", &n, &ml, &mu, &one, M->data, &(M->ldim), pivots, bd, &n, &ier, 1); + if (ier > 0) return(1); + + /* For BDF, scale the correction to account for change in gamma */ + if ((lmm == CV_BDF) && (gamrat != ONE)) { + fact = TWO/(ONE + gamrat); + dscal_f77(&n, &fact, bd, &one); + } + + last_flag = CVDLS_SUCCESS; + return(0); +} + +/* + * cvLapackBandFree frees memory specific to the band linear solver. + */ +static void cvLapackBandFree(CVodeMem cv_mem) +{ + CVDlsMem cvdls_mem; + + cvdls_mem = (CVDlsMem) lmem; + + DestroyMat(M); + DestroyArray(pivots); + DestroyMat(savedJ); + free(cvdls_mem); + cvdls_mem = NULL; +} + +/* + * ================================================================ + * + * PART II - backward problems + * + * ================================================================ + */ + +/* + * CVLapackDenseB is a wraper around CVLapackDense. It attaches the + * dense CVSLAPACK linear solver to the backward problem memory block. + */ + +int CVLapackDenseB(void *cvode_mem, int which, int nB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + CVDlsMemB cvdlsB_mem; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVDLS_MEM_NULL, "CVSLAPACK", "CVLapackDenseB", MSGD_CVMEM_NULL); + return(CVDLS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CVDLS_NO_ADJ, "CVSLAPACK", "CVLapackDenseB", MSGD_NO_ADJ); + return(CVDLS_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= ca_mem->ca_nbckpbs ) { + cvProcessError(cv_mem, CVDLS_ILL_INPUT, "CVSLAPACK", "CVLapackDenseB", MSGCV_BAD_WHICH); + return(CVDLS_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + /* Get memory for CVDlsMemRecB */ + cvdlsB_mem = (CVDlsMemB) malloc(sizeof(struct CVDlsMemRecB)); + if (cvdlsB_mem == NULL) { + cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSLAPACK", "CVLapackDenseB", MSGD_MEM_FAIL); + return(CVDLS_MEM_FAIL); + } + + /* set matrix type */ + cvdlsB_mem->d_typeB = SUNDIALS_DENSE; + + /* initialize Jacobian function */ + cvdlsB_mem->d_djacB = NULL; + + /* attach lmemB and lfreeB */ + cvB_mem->cv_lmem = cvdlsB_mem; + cvB_mem->cv_lfree = cvLapackDenseFreeB; + + flag = CVLapackDense(cvodeB_mem, nB); + + if (flag != CVDLS_SUCCESS) { + free(cvdlsB_mem); + cvdlsB_mem = NULL; + } + + return(flag); +} + +/* + * cvLapackDenseFreeB frees the memory associated with the dense CVSLAPACK + * linear solver for backward integration. + */ + +static void cvLapackDenseFreeB(CVodeBMem cvB_mem) +{ + CVDlsMemB cvdlsB_mem; + + cvdlsB_mem = (CVDlsMemB) (cvB_mem->cv_lmem); + + free(cvdlsB_mem); +} + +/* + * CVLapackBandB is a wraper around CVLapackBand. It attaches the band + * CVSLAPACK linear solver to the backward problem memory block. + */ + +int CVLapackBandB(void *cvode_mem, int which, + int nB, int mupperB, int mlowerB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + CVDlsMemB cvdlsB_mem; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVDLS_MEM_NULL, "CVSLAPACK", "CVLapackBandB", MSGD_CVMEM_NULL); + return(CVDLS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CVDLS_NO_ADJ, "CVSLAPACK", "CVLapackBandB", MSGD_NO_ADJ); + return(CVDLS_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= ca_mem->ca_nbckpbs ) { + cvProcessError(cv_mem, CVDLS_ILL_INPUT, "CVSLAPACK", "CVLapackBandB", MSGCV_BAD_WHICH); + return(CVDLS_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + /* Get memory for CVDlsMemRecB */ + cvdlsB_mem = (CVDlsMemB) malloc(sizeof(struct CVDlsMemRecB)); + if (cvdlsB_mem == NULL) { + cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSLAPACK", "CVLapackBandB", MSGD_MEM_FAIL); + return(CVDLS_MEM_FAIL); + } + + /* set matrix type */ + cvdlsB_mem->d_typeB = SUNDIALS_BAND; + + /* initialize Jacobian function */ + cvdlsB_mem->d_bjacB = NULL; + + /* attach lmemB and lfreeB */ + cvB_mem->cv_lmem = cvdlsB_mem; + cvB_mem->cv_lfree = cvLapackBandFreeB; + + flag = CVLapackBand(cvodeB_mem, nB, mupperB, mlowerB); + + if (flag != CVDLS_SUCCESS) { + free(cvdlsB_mem); + cvdlsB_mem = NULL; + } + + return(flag); +} + +/* + * cvLapackBandFreeB frees the memory associated with the band CVSLAPACK + * linear solver for backward integration. + */ + +static void cvLapackBandFreeB(CVodeBMem cvB_mem) +{ + CVDlsMemB cvdlsB_mem; + + cvdlsB_mem = (CVDlsMemB) (cvB_mem->cv_lmem); + + free(cvdlsB_mem); +} diff --git a/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_spbcgs.c b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_spbcgs.c new file mode 100644 index 0000000..31fda60 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_spbcgs.c @@ -0,0 +1,571 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.11 $ + * $Date: 2008/09/03 20:26:21 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for the CVSPBCG linear solver. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include +#include "cvodes_spils_impl.h" +#include "cvodes_impl.h" + +#include +#include + +/* Constants */ + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + +/* CVSPBCG linit, lsetup, lsolve, and lfree routines */ + +static int CVSpbcgInit(CVodeMem cv_mem); + +static int CVSpbcgSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, + N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, + N_Vector vtemp2, N_Vector vtemp3); + +static int CVSpbcgSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, + N_Vector ynow, N_Vector fnow); + +static void CVSpbcgFree(CVodeMem cv_mem); + +/* CVSPBCG lfreeB function */ + +static void CVSpbcgFreeB(CVodeBMem cvB_mem); + +/* + * ================================================================ + * + * PART I - forward problems + * + * ================================================================ + */ + +/* Readability Replacements */ + +#define tq (cv_mem->cv_tq) +#define nst (cv_mem->cv_nst) +#define tn (cv_mem->cv_tn) +#define gamma (cv_mem->cv_gamma) +#define gammap (cv_mem->cv_gammap) +#define f (cv_mem->cv_f) +#define user_data (cv_mem->cv_user_data) +#define ewt (cv_mem->cv_ewt) +#define errfp (cv_mem->cv_errfp) +#define mnewt (cv_mem->cv_mnewt) +#define linit (cv_mem->cv_linit) +#define lsetup (cv_mem->cv_lsetup) +#define lsolve (cv_mem->cv_lsolve) +#define lfree (cv_mem->cv_lfree) +#define lmem (cv_mem->cv_lmem) +#define vec_tmpl (cv_mem->cv_tempv) +#define setupNonNull (cv_mem->cv_setupNonNull) + +#define sqrtN (cvspils_mem->s_sqrtN) +#define ytemp (cvspils_mem->s_ytemp) +#define x (cvspils_mem->s_x) +#define ycur (cvspils_mem->s_ycur) +#define fcur (cvspils_mem->s_fcur) +#define delta (cvspils_mem->s_delta) +#define deltar (cvspils_mem->s_deltar) +#define npe (cvspils_mem->s_npe) +#define nli (cvspils_mem->s_nli) +#define nps (cvspils_mem->s_nps) +#define ncfl (cvspils_mem->s_ncfl) +#define nstlpre (cvspils_mem->s_nstlpre) +#define njtimes (cvspils_mem->s_njtimes) +#define nfes (cvspils_mem->s_nfes) +#define spils_mem (cvspils_mem->s_spils_mem) + +#define jtimesDQ (cvspils_mem->s_jtimesDQ) +#define jtimes (cvspils_mem->s_jtimes) +#define j_data (cvspils_mem->s_j_data) + +#define last_flag (cvspils_mem->s_last_flag) + +/* + * ----------------------------------------------------------------- + * Function : CVSpbcg + * ----------------------------------------------------------------- + * This routine initializes the memory record and sets various function + * fields specific to the Spbcg linear solver module. CVSpbcg first + * calls the existing lfree routine if this is not NULL. It then sets + * the cv_linit, cv_lsetup, cv_lsolve, cv_lfree fields in (*cvode_mem) + * to be CVSpbcgInit, CVSpbcgSetup, CVSpbcgSolve, and CVSpbcgFree, + * respectively. It allocates memory for a structure of type + * CVSpilsMemRec and sets the cv_lmem field in (*cvode_mem) to the + * address of this structure. It sets setupNonNull in (*cvode_mem), + * and sets various fields in the CVSpilsMemRec structure. + * Finally, CVSpbcg allocates memory for ytemp and x, and calls + * SpbcgMalloc to allocate memory for the Spbcg solver. + * ----------------------------------------------------------------- + */ + +int CVSpbcg(void *cvode_mem, int pretype, int maxl) +{ + CVodeMem cv_mem; + CVSpilsMem cvspils_mem; + SpbcgMem spbcg_mem; + int mxl; + + /* Return immediately if cvode_mem is NULL */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPBCG", "CVSpbcg", MSGS_CVMEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Check if N_VDotProd is present */ + if (vec_tmpl->ops->nvdotprod == NULL) { + cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPBCG", "CVSpbcg", MSGS_BAD_NVECTOR); + return(CVSPILS_ILL_INPUT); + } + + if (lfree != NULL) lfree(cv_mem); + + /* Set four main function fields in cv_mem */ + linit = CVSpbcgInit; + lsetup = CVSpbcgSetup; + lsolve = CVSpbcgSolve; + lfree = CVSpbcgFree; + + /* Get memory for CVSpilsMemRec */ + cvspils_mem = NULL; + cvspils_mem = (CVSpilsMem) malloc(sizeof(struct CVSpilsMemRec)); + if (cvspils_mem == NULL) { + cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPBCG", "CVSpbcg", MSGS_MEM_FAIL); + return(CVSPILS_MEM_FAIL); + } + + /* Set ILS type */ + cvspils_mem->s_type = SPILS_SPBCG; + + /* Set Spbcg parameters that have been passed in call sequence */ + cvspils_mem->s_pretype = pretype; + mxl = cvspils_mem->s_maxl = (maxl <= 0) ? CVSPILS_MAXL : maxl; + + /* Set defaults for Jacobian-related fileds */ + jtimesDQ = TRUE; + jtimes = NULL; + j_data = NULL; + + /* Set defaults for preconditioner-related fields */ + cvspils_mem->s_pset = NULL; + cvspils_mem->s_psolve = NULL; + cvspils_mem->s_pfree = NULL; + cvspils_mem->s_P_data = cv_mem->cv_user_data; + + /* Set default values for the rest of the Spbcg parameters */ + cvspils_mem->s_eplifac = CVSPILS_EPLIN; + + cvspils_mem->s_last_flag = CVSPILS_SUCCESS; + + setupNonNull = FALSE; + + /* Check for legal pretype */ + if ((pretype != PREC_NONE) && (pretype != PREC_LEFT) && + (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) { + cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPBCG", "CVSpbcg", MSGS_BAD_PRETYPE); + return(CVSPILS_ILL_INPUT); + } + + /* Allocate memory for ytemp and x */ + ytemp = N_VClone(vec_tmpl); + if (ytemp == NULL) { + cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPBCG", "CVSpbcg", MSGS_MEM_FAIL); + free(cvspils_mem); cvspils_mem = NULL; + return(CVSPILS_MEM_FAIL); + } + x = N_VClone(vec_tmpl); + if (x == NULL) { + cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPBCG", "CVSpbcg", MSGS_MEM_FAIL); + N_VDestroy(ytemp); + free(cvspils_mem); cvspils_mem = NULL; + return(CVSPILS_MEM_FAIL); + } + + /* Compute sqrtN from a dot product */ + N_VConst(ONE, ytemp); + sqrtN = RSqrt(N_VDotProd(ytemp, ytemp)); + + /* Call SpbcgMalloc to allocate workspace for Spbcg */ + spbcg_mem = NULL; + spbcg_mem = SpbcgMalloc(mxl, vec_tmpl); + if (spbcg_mem == NULL) { + cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPBCG", "CVSpbcg", MSGS_MEM_FAIL); + N_VDestroy(ytemp); + N_VDestroy(x); + free(cvspils_mem); cvspils_mem = NULL; + return(CVSPILS_MEM_FAIL); + } + + /* Attach SPBCG memory to spils memory structure */ + spils_mem = (void *) spbcg_mem; + + /* Attach linear solver memory to integrator memory */ + lmem = cvspils_mem; + + return(CVSPILS_SUCCESS); +} + + + +/* Additional readability replacements */ + +#define pretype (cvspils_mem->s_pretype) +#define eplifac (cvspils_mem->s_eplifac) +#define maxl (cvspils_mem->s_maxl) +#define psolve (cvspils_mem->s_psolve) +#define pset (cvspils_mem->s_pset) +#define P_data (cvspils_mem->s_P_data) + +/* + * ----------------------------------------------------------------- + * Function : CVSpbcgInit + * ----------------------------------------------------------------- + * This routine does remaining initializations specific to the Spbcg + * linear solver. + * ----------------------------------------------------------------- + */ + +static int CVSpbcgInit(CVodeMem cv_mem) +{ + CVSpilsMem cvspils_mem; + SpbcgMem spbcg_mem; + + cvspils_mem = (CVSpilsMem) lmem; + spbcg_mem = (SpbcgMem) spils_mem; + + + /* Initialize counters */ + npe = nli = nps = ncfl = nstlpre = 0; + njtimes = nfes = 0; + + /* Check for legal combination pretype - psolve */ + if ((pretype != PREC_NONE) && (psolve == NULL)) { + cvProcessError(cv_mem, -1, "CVSPBCG", "CVSpbcgInit", MSGS_PSOLVE_REQ); + last_flag = CVSPILS_ILL_INPUT; + return(-1); + } + + /* Set setupNonNull = TRUE iff there is preconditioning + (pretype != PREC_NONE) and there is a preconditioning + setup phase (pset != NULL) */ + setupNonNull = (pretype != PREC_NONE) && (pset != NULL); + + /* Set Jacobian-related fields, based on jtimesDQ */ + if (jtimesDQ) { + jtimes = CVSpilsDQJtimes; + j_data = cv_mem; + } else { + j_data = user_data; + } + + /* Set maxl in the SPBCG memory in case it was changed by the user */ + spbcg_mem->l_max = maxl; + + last_flag = CVSPILS_SUCCESS; + return(0); +} + +/* + * ----------------------------------------------------------------- + * Function : CVSpbcgSetup + * ----------------------------------------------------------------- + * This routine does the setup operations for the Spbcg linear solver. + * It makes a decision as to whether or not to signal for reevaluation + * of Jacobian data in the pset routine, based on various state + * variables, then it calls pset. If we signal for reevaluation, + * then we reset jcur = *jcurPtr to TRUE, regardless of the pset output. + * In any case, if jcur == TRUE, we increment npe and save nst in nstlpre. + * ----------------------------------------------------------------- + */ + +static int CVSpbcgSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, + N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, + N_Vector vtemp2, N_Vector vtemp3) +{ + booleantype jbad, jok; + realtype dgamma; + int retval; + CVSpilsMem cvspils_mem; + + cvspils_mem = (CVSpilsMem) lmem; + + /* Use nst, gamma/gammap, and convfail to set J eval. flag jok */ + dgamma = ABS((gamma/gammap) - ONE); + jbad = (nst == 0) || (nst > nstlpre + CVSPILS_MSBPRE) || + ((convfail == CV_FAIL_BAD_J) && (dgamma < CVSPILS_DGMAX)) || + (convfail == CV_FAIL_OTHER); + *jcurPtr = jbad; + jok = !jbad; + + /* Call pset routine and possibly reset jcur */ + retval = pset(tn, ypred, fpred, jok, jcurPtr, gamma, P_data, + vtemp1, vtemp2, vtemp3); + if (retval < 0) { + cvProcessError(cv_mem, SPBCG_PSET_FAIL_UNREC, "CVSPBCG", "CVSpbcgSetup", MSGS_PSET_FAILED); + last_flag = SPBCG_PSET_FAIL_UNREC; + } + if (retval > 0) { + last_flag = SPBCG_PSET_FAIL_REC; + } + + if (jbad) *jcurPtr = TRUE; + + /* If jcur = TRUE, increment npe and save nst value */ + if (*jcurPtr) { + npe++; + nstlpre = nst; + } + + last_flag = SPBCG_SUCCESS; + + /* Return the same value that pset returned */ + return(retval); +} + +/* + * ----------------------------------------------------------------- + * Function : CVSpbcgSolve + * ----------------------------------------------------------------- + * This routine handles the call to the generic solver SpbcgSolve + * for the solution of the linear system Ax = b with the SPBCG method. + * The solution x is returned in the vector b. + * + * If the WRMS norm of b is small, we return x = b (if this is the first + * Newton iteration) or x = 0 (if a later Newton iteration). + * + * Otherwise, we set the tolerance parameter and initial guess (x = 0), + * call SpbcgSolve, and copy the solution x into b. The x-scaling and + * b-scaling arrays are both equal to weight. + * + * The counters nli, nps, and ncfl are incremented, and the return value + * is set according to the success of SpbcgSolve. The success flag is + * returned if SpbcgSolve converged, or if this is the first Newton + * iteration and the residual norm was reduced below its initial value. + * ----------------------------------------------------------------- + */ + +static int CVSpbcgSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, + N_Vector ynow, N_Vector fnow) +{ + realtype bnorm, res_norm; + CVSpilsMem cvspils_mem; + SpbcgMem spbcg_mem; + int nli_inc, nps_inc, retval; + + cvspils_mem = (CVSpilsMem) lmem; + + spbcg_mem = (SpbcgMem) spils_mem; + + /* Test norm(b); if small, return x = 0 or x = b */ + deltar = eplifac * tq[4]; + + bnorm = N_VWrmsNorm(b, weight); + if (bnorm <= deltar) { + if (mnewt > 0) N_VConst(ZERO, b); + return(0); + } + + /* Set vectors ycur and fcur for use by the Atimes and Psolve routines */ + ycur = ynow; + fcur = fnow; + + /* Set inputs delta and initial guess x = 0 to SpbcgSolve */ + delta = deltar * sqrtN; + N_VConst(ZERO, x); + + /* Call SpbcgSolve and copy x to b */ + retval = SpbcgSolve(spbcg_mem, cv_mem, x, b, pretype, delta, + cv_mem, weight, weight, CVSpilsAtimes, CVSpilsPSolve, + &res_norm, &nli_inc, &nps_inc); + + N_VScale(ONE, x, b); + + /* Increment counters nli, nps, and ncfl */ + nli += nli_inc; + nps += nps_inc; + if (retval != SPBCG_SUCCESS) ncfl++; + + /* Interpret return value from SpbcgSolve */ + + last_flag = retval; + + switch(retval) { + + case SPBCG_SUCCESS: + return(0); + break; + case SPBCG_RES_REDUCED: + if (mnewt == 0) return(0); + else return(1); + break; + case SPBCG_CONV_FAIL: + return(1); + break; + case SPBCG_PSOLVE_FAIL_REC: + return(1); + break; + case SPBCG_ATIMES_FAIL_REC: + return(1); + break; + case SPBCG_MEM_NULL: + return(-1); + break; + case SPBCG_ATIMES_FAIL_UNREC: + cvProcessError(cv_mem, SPBCG_ATIMES_FAIL_UNREC, "CVSPBCG", "CVSpbcgSolve", MSGS_JTIMES_FAILED); + return(-1); + break; + case SPBCG_PSOLVE_FAIL_UNREC: + cvProcessError(cv_mem, SPBCG_PSOLVE_FAIL_UNREC, "CVSPBCG", "CVSpbcgSolve", MSGS_PSOLVE_FAILED); + return(-1); + break; + } + + return(0); + +} + +/* + * ----------------------------------------------------------------- + * Function : CVSpbcgFree + * ----------------------------------------------------------------- + * This routine frees memory specific to the Spbcg linear solver. + * ----------------------------------------------------------------- + */ + +static void CVSpbcgFree(CVodeMem cv_mem) +{ + CVSpilsMem cvspils_mem; + SpbcgMem spbcg_mem; + + cvspils_mem = (CVSpilsMem) lmem; + + N_VDestroy(ytemp); + N_VDestroy(x); + + spbcg_mem = (SpbcgMem) spils_mem; + SpbcgFree(spbcg_mem); + + if (cvspils_mem->s_pfree != NULL) (cvspils_mem->s_pfree)(cv_mem); + + free(cvspils_mem); cvspils_mem = NULL; +} + + +/* + * ================================================================ + * + * PART II - backward problems + * + * ================================================================ + */ + + +/* Additional readability replacements */ + +#define pset_B (cvspilsB_mem->s_psetB) +#define psolve_B (cvspilsB_mem->s_psolveB) +#define jtimes_B (cvspilsB_mem->s_jtimesB) +#define P_data_B (cvspilsB_mem->s_P_dataB) + +/* + * CVSpbcgB + * + * Wrapper for the backward phase + */ + +int CVSpbcgB(void *cvode_mem, int which, int pretypeB, int maxlB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + CVSpilsMemB cvspilsB_mem; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPBCG", "CVSpbcgB", MSGS_CVMEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CVSPILS_NO_ADJ, "CVSPBCG", "CVSpbcgB", MSGS_NO_ADJ); + return(CVSPILS_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= ca_mem->ca_nbckpbs ) { + cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPBCG", "CVSpbcgB", MSGS_BAD_WHICH); + return(CVSPILS_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + /* Get memory for CVSpilsMemRecB */ + cvspilsB_mem = NULL; + cvspilsB_mem = (CVSpilsMemB) malloc(sizeof(struct CVSpilsMemRecB)); + if (cvspilsB_mem == NULL) { + cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPBCG", "CVSpbcgB", MSGS_MEM_FAIL); + return(CVSPILS_MEM_FAIL); + } + + pset_B = NULL; + psolve_B = NULL; + P_data_B = NULL; + + /* initialize Jacobian function */ + jtimes_B = NULL; + + /* attach lmemB and lfree */ + cvB_mem->cv_lmem = cvspilsB_mem; + cvB_mem->cv_lfree = CVSpbcgFreeB; + + flag = CVSpbcg(cvodeB_mem, pretypeB, maxlB); + + if (flag != CVSPILS_SUCCESS) { + free(cvspilsB_mem); + cvspilsB_mem = NULL; + } + + return(flag); +} + +/* + * CVSpbcgFreeB + */ + + +static void CVSpbcgFreeB(CVodeBMem cvB_mem) +{ + CVSpilsMemB cvspilsB_mem; + + cvspilsB_mem = (CVSpilsMemB) (cvB_mem->cv_lmem); + + free(cvspilsB_mem); +} diff --git a/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_spgmr.c b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_spgmr.c new file mode 100644 index 0000000..2eaa05a --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_spgmr.c @@ -0,0 +1,577 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.11 $ + * $Date: 2008/09/03 20:26:21 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for the CVSPGMR linear solver. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include +#include "cvodes_spils_impl.h" +#include "cvodes_impl.h" + +#include +#include + +/* Constants */ + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + +/* CVSPGMR linit, lsetup, lsolve, and lfree routines */ + +static int CVSpgmrInit(CVodeMem cv_mem); + +static int CVSpgmrSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, + N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, + N_Vector vtemp2, N_Vector vtemp3); + +static int CVSpgmrSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, + N_Vector ynow, N_Vector fnow); + +static void CVSpgmrFree(CVodeMem cv_mem); + +/* CVSPGMR lfreeB function */ + +static void CVSpgmrFreeB(CVodeBMem cvB_mem); + +/* + * ================================================================ + * + * PART I - forward problems + * + * ================================================================ + */ + + +/* Readability Replacements */ + +#define tq (cv_mem->cv_tq) +#define nst (cv_mem->cv_nst) +#define tn (cv_mem->cv_tn) +#define h (cv_mem->cv_h) +#define gamma (cv_mem->cv_gamma) +#define gammap (cv_mem->cv_gammap) +#define f (cv_mem->cv_f) +#define user_data (cv_mem->cv_user_data) +#define ewt (cv_mem->cv_ewt) +#define mnewt (cv_mem->cv_mnewt) +#define ropt (cv_mem->cv_ropt) +#define linit (cv_mem->cv_linit) +#define lsetup (cv_mem->cv_lsetup) +#define lsolve (cv_mem->cv_lsolve) +#define lfree (cv_mem->cv_lfree) +#define lmem (cv_mem->cv_lmem) +#define vec_tmpl (cv_mem->cv_tempv) +#define setupNonNull (cv_mem->cv_setupNonNull) + +#define sqrtN (cvspils_mem->s_sqrtN) +#define ytemp (cvspils_mem->s_ytemp) +#define x (cvspils_mem->s_x) +#define ycur (cvspils_mem->s_ycur) +#define fcur (cvspils_mem->s_fcur) +#define delta (cvspils_mem->s_delta) +#define deltar (cvspils_mem->s_deltar) +#define npe (cvspils_mem->s_npe) +#define nli (cvspils_mem->s_nli) +#define nps (cvspils_mem->s_nps) +#define ncfl (cvspils_mem->s_ncfl) +#define nstlpre (cvspils_mem->s_nstlpre) +#define njtimes (cvspils_mem->s_njtimes) +#define nfes (cvspils_mem->s_nfes) +#define spils_mem (cvspils_mem->s_spils_mem) + +#define jtimesDQ (cvspils_mem->s_jtimesDQ) +#define jtimes (cvspils_mem->s_jtimes) +#define j_data (cvspils_mem->s_j_data) + +#define last_flag (cvspils_mem->s_last_flag) + +/* + * ----------------------------------------------------------------- + * CVSpgmr + * ----------------------------------------------------------------- + * This routine initializes the memory record and sets various function + * fields specific to the Spgmr linear solver module. CVSpgmr first + * calls the existing lfree routine if this is not NULL. It then sets + * the cv_linit, cv_lsetup, cv_lsolve, cv_lfree fields in (*cvode_mem) + * to be CVSpgmrInit, CVSpgmrSetup, CVSpgmrSolve, and CVSpgmrFree, + * respectively. It allocates memory for a structure of type + * CVSpilsMemRec and sets the cv_lmem field in (*cvode_mem) to the + * address of this structure. It sets setupNonNull in (*cvode_mem), + * and sets various fields in the CVSpilsMemRec structure. + * Finally, CVSpgmr allocates memory for ytemp and x, and calls + * SpgmrMalloc to allocate memory for the Spgmr solver. + * ----------------------------------------------------------------- + */ + +int CVSpgmr(void *cvode_mem, int pretype, int maxl) +{ + CVodeMem cv_mem; + CVSpilsMem cvspils_mem; + SpgmrMem spgmr_mem; + int mxl; + + /* Return immediately if cvode_mem is NULL */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPGMR", "CVSpgmr", MSGS_CVMEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Check if N_VDotProd is present */ + if(vec_tmpl->ops->nvdotprod == NULL) { + cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPGMR", "CVSpgmr", MSGS_BAD_NVECTOR); + return(CVSPILS_ILL_INPUT); + } + + if (lfree != NULL) lfree(cv_mem); + + /* Set four main function fields in cv_mem */ + linit = CVSpgmrInit; + lsetup = CVSpgmrSetup; + lsolve = CVSpgmrSolve; + lfree = CVSpgmrFree; + + /* Get memory for CVSpilsMemRec */ + cvspils_mem = NULL; + cvspils_mem = (CVSpilsMem) malloc(sizeof(struct CVSpilsMemRec)); + if (cvspils_mem == NULL) { + cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPGMR", "CVSpgmr", MSGS_MEM_FAIL); + return(CVSPILS_MEM_FAIL); + } + + /* Set ILS type */ + cvspils_mem->s_type = SPILS_SPGMR; + + /* Set Spgmr parameters that have been passed in call sequence */ + cvspils_mem->s_pretype = pretype; + mxl = cvspils_mem->s_maxl = (maxl <= 0) ? CVSPILS_MAXL : maxl; + + /* Set defaults for Jacobian-related fileds */ + jtimesDQ = TRUE; + jtimes = NULL; + j_data = NULL; + + /* Set defaults for preconditioner-related fields */ + cvspils_mem->s_pset = NULL; + cvspils_mem->s_psolve = NULL; + cvspils_mem->s_pfree = NULL; + cvspils_mem->s_P_data = cv_mem->cv_user_data; + + /* Set default values for the rest of the Spgmr parameters */ + cvspils_mem->s_gstype = MODIFIED_GS; + cvspils_mem->s_eplifac = CVSPILS_EPLIN; + + cvspils_mem->s_last_flag = CVSPILS_SUCCESS; + + setupNonNull = FALSE; + + /* Check for legal pretype */ + if ((pretype != PREC_NONE) && (pretype != PREC_LEFT) && + (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) { + cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPGMR", "CVSpgmr", MSGS_BAD_PRETYPE); + return(CVSPILS_ILL_INPUT); + } + + /* Allocate memory for ytemp and x */ + ytemp = N_VClone(vec_tmpl); + if (ytemp == NULL) { + cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPGMR", "CVSpgmr", MSGS_MEM_FAIL); + free(cvspils_mem); cvspils_mem = NULL; + return(CVSPILS_MEM_FAIL); + } + x = N_VClone(vec_tmpl); + if (x == NULL) { + cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPGMR", "CVSpgmr", MSGS_MEM_FAIL); + N_VDestroy(ytemp); + free(cvspils_mem); cvspils_mem = NULL; + return(CVSPILS_MEM_FAIL); + } + + /* Compute sqrtN from a dot product */ + N_VConst(ONE, ytemp); + sqrtN = RSqrt( N_VDotProd(ytemp, ytemp) ); + + /* Call SpgmrMalloc to allocate workspace for Spgmr */ + spgmr_mem = NULL; + spgmr_mem = SpgmrMalloc(mxl, vec_tmpl); + if (spgmr_mem == NULL) { + cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPGMR", "CVSpgmr", MSGS_MEM_FAIL); + N_VDestroy(ytemp); + N_VDestroy(x); + free(cvspils_mem); cvspils_mem = NULL; + return(CVSPILS_MEM_FAIL); + } + + /* Attach SPGMR memory to spils memory structure */ + spils_mem = (void *) spgmr_mem; + + /* Attach linear solver memory to integrator memory */ + lmem = cvspils_mem; + + return(CVSPILS_SUCCESS); +} + + +/* Additional readability Replacements */ + +#define pretype (cvspils_mem->s_pretype) +#define gstype (cvspils_mem->s_gstype) +#define eplifac (cvspils_mem->s_eplifac) +#define maxl (cvspils_mem->s_maxl) +#define psolve (cvspils_mem->s_psolve) +#define pset (cvspils_mem->s_pset) +#define P_data (cvspils_mem->s_P_data) + +/* + * ----------------------------------------------------------------- + * CVSpgmrInit + * ----------------------------------------------------------------- + * This routine does remaining initializations specific to the Spgmr + * linear solver. + * ----------------------------------------------------------------- + */ + +static int CVSpgmrInit(CVodeMem cv_mem) +{ + CVSpilsMem cvspils_mem; + cvspils_mem = (CVSpilsMem) lmem; + + /* Initialize counters */ + npe = nli = nps = ncfl = nstlpre = 0; + njtimes = nfes = 0; + + /* Check for legal combination pretype - psolve */ + if ((pretype != PREC_NONE) && (psolve == NULL)) { + cvProcessError(cv_mem, -1, "CVSPGMR", "CVSpgmrInit", MSGS_PSOLVE_REQ); + last_flag = CVSPILS_ILL_INPUT; + return(-1); + } + + /* Set setupNonNull = TRUE iff there is preconditioning (pretype != PREC_NONE) + and there is a preconditioning setup phase (pset != NULL) */ + setupNonNull = (pretype != PREC_NONE) && (pset != NULL); + + /* Set Jacobian-related fields, based on jtimesDQ */ + if (jtimesDQ) { + jtimes = CVSpilsDQJtimes; + j_data = cv_mem; + } else { + j_data = user_data; + } + + last_flag = CVSPILS_SUCCESS; + return(0); +} + +/* + * ----------------------------------------------------------------- + * CVSpgmrSetup + * ----------------------------------------------------------------- + * This routine does the setup operations for the Spgmr linear solver. + * It makes a decision as to whether or not to signal for re-evaluation + * of Jacobian data in the pset routine, based on various state + * variables, then it calls pset. If we signal for re-evaluation, + * then we reset jcur = *jcurPtr to TRUE, regardless of the pset output. + * In any case, if jcur == TRUE, we increment npe and save nst in nstlpre. + * ----------------------------------------------------------------- + */ + +static int CVSpgmrSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, + N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, + N_Vector vtemp2, N_Vector vtemp3) +{ + booleantype jbad, jok; + realtype dgamma; + int retval; + CVSpilsMem cvspils_mem; + + cvspils_mem = (CVSpilsMem) lmem; + + /* Use nst, gamma/gammap, and convfail to set J eval. flag jok */ + dgamma = ABS((gamma/gammap) - ONE); + jbad = (nst == 0) || (nst > nstlpre + CVSPILS_MSBPRE) || + ((convfail == CV_FAIL_BAD_J) && (dgamma < CVSPILS_DGMAX)) || + (convfail == CV_FAIL_OTHER); + *jcurPtr = jbad; + jok = !jbad; + + /* Call pset routine and possibly reset jcur */ + retval = pset(tn, ypred, fpred, jok, jcurPtr, gamma, P_data, + vtemp1, vtemp2, vtemp3); + if (retval < 0) { + cvProcessError(cv_mem, SPGMR_PSET_FAIL_UNREC, "CVSPGMR", "CVSpgmrSetup", MSGS_PSET_FAILED); + last_flag = SPGMR_PSET_FAIL_UNREC; + } + if (retval > 0) { + last_flag = SPGMR_PSET_FAIL_REC; + } + + if (jbad) *jcurPtr = TRUE; + + /* If jcur = TRUE, increment npe and save nst value */ + if (*jcurPtr) { + npe++; + nstlpre = nst; + } + + last_flag = SPGMR_SUCCESS; + + /* Return the same value that pset returned */ + return(retval); +} + +/* + * ----------------------------------------------------------------- + * CVSpgmrSolve + * ----------------------------------------------------------------- + * This routine handles the call to the generic solver SpgmrSolve + * for the solution of the linear system Ax = b with the SPGMR method, + * without restarts. The solution x is returned in the vector b. + * + * If the WRMS norm of b is small, we return x = b (if this is the first + * Newton iteration) or x = 0 (if a later Newton iteration). + * + * Otherwise, we set the tolerance parameter and initial guess (x = 0), + * call SpgmrSolve, and copy the solution x into b. The x-scaling and + * b-scaling arrays are both equal to weight, and no restarts are allowed. + * + * The counters nli, nps, and ncfl are incremented, and the return value + * is set according to the success of SpgmrSolve. The success flag is + * returned if SpgmrSolve converged, or if this is the first Newton + * iteration and the residual norm was reduced below its initial value. + * ----------------------------------------------------------------- + */ + +static int CVSpgmrSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, + N_Vector ynow, N_Vector fnow) +{ + realtype bnorm, res_norm; + CVSpilsMem cvspils_mem; + SpgmrMem spgmr_mem; + int nli_inc, nps_inc, retval; + + cvspils_mem = (CVSpilsMem) lmem; + + spgmr_mem = (SpgmrMem) spils_mem; + + /* Test norm(b); if small, return x = 0 or x = b */ + deltar = eplifac*tq[4]; + + bnorm = N_VWrmsNorm(b, weight); + if (bnorm <= deltar) { + if (mnewt > 0) N_VConst(ZERO, b); + return(0); + } + + /* Set vectors ycur and fcur for use by the Atimes and Psolve routines */ + ycur = ynow; + fcur = fnow; + + /* Set inputs delta and initial guess x = 0 to SpgmrSolve */ + delta = deltar * sqrtN; + N_VConst(ZERO, x); + + /* Call SpgmrSolve and copy x to b */ + retval = SpgmrSolve(spgmr_mem, cv_mem, x, b, pretype, gstype, delta, 0, + cv_mem, weight, weight, CVSpilsAtimes, CVSpilsPSolve, + &res_norm, &nli_inc, &nps_inc); + + N_VScale(ONE, x, b); + + /* Increment counters nli, nps, and ncfl */ + nli += nli_inc; + nps += nps_inc; + if (retval != SPGMR_SUCCESS) ncfl++; + + /* Interpret return value from SpgmrSolve */ + + last_flag = retval; + + switch(retval) { + + case SPGMR_SUCCESS: + return(0); + break; + case SPGMR_RES_REDUCED: + if (mnewt == 0) return(0); + else return(1); + break; + case SPGMR_CONV_FAIL: + return(1); + break; + case SPGMR_QRFACT_FAIL: + return(1); + break; + case SPGMR_PSOLVE_FAIL_REC: + return(1); + break; + case SPGMR_ATIMES_FAIL_REC: + return(1); + break; + case SPGMR_MEM_NULL: + return(-1); + break; + case SPGMR_ATIMES_FAIL_UNREC: + cvProcessError(cv_mem, SPGMR_ATIMES_FAIL_UNREC, "CVSPGMR", "CVSpgmrSolve", MSGS_JTIMES_FAILED); + return(-1); + break; + case SPGMR_PSOLVE_FAIL_UNREC: + cvProcessError(cv_mem, SPGMR_PSOLVE_FAIL_UNREC, "CVSPGMR", "CVSpgmrSolve", MSGS_PSOLVE_FAILED); + return(-1); + break; + case SPGMR_GS_FAIL: + return(-1); + break; + case SPGMR_QRSOL_FAIL: + return(-1); + break; + } + + return(0); + +} + +/* + * ----------------------------------------------------------------- + * CVSpgmrFree + * ----------------------------------------------------------------- + * This routine frees memory specific to the Spgmr linear solver. + * ----------------------------------------------------------------- + */ + +static void CVSpgmrFree(CVodeMem cv_mem) +{ + CVSpilsMem cvspils_mem; + SpgmrMem spgmr_mem; + + cvspils_mem = (CVSpilsMem) lmem; + + N_VDestroy(ytemp); + N_VDestroy(x); + + spgmr_mem = (SpgmrMem) spils_mem; + SpgmrFree(spgmr_mem); + + if (cvspils_mem->s_pfree != NULL) (cvspils_mem->s_pfree)(cv_mem); + + free(cvspils_mem); cvspils_mem = NULL; +} + + +/* + * ================================================================ + * + * PART II - backward problems + * + * ================================================================ + */ + + +/* Additional readability replacements */ + +#define pset_B (cvspilsB_mem->s_psetB) +#define psolve_B (cvspilsB_mem->s_psolveB) +#define jtimes_B (cvspilsB_mem->s_jtimesB) +#define P_data_B (cvspilsB_mem->s_P_dataB) + +/* + * CVSpgmrB + * + * Wrapper for the backward phase + * + */ + +int CVSpgmrB(void *cvode_mem, int which, int pretypeB, int maxlB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + CVSpilsMemB cvspilsB_mem; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPGMR", "CVSpgmrB", MSGS_CVMEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CVSPILS_NO_ADJ, "CVSPGMR", "CVSpgmrB", MSGS_NO_ADJ); + return(CVSPILS_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= ca_mem->ca_nbckpbs ) { + cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPGMR", "CVSpgmrB", MSGS_BAD_WHICH); + return(CVSPILS_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + /* Get memory for CVSpilsMemRecB */ + cvspilsB_mem = NULL; + cvspilsB_mem = (CVSpilsMemB) malloc(sizeof(struct CVSpilsMemRecB)); + if (cvspilsB_mem == NULL) { + cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPGMR", "CVSpgmrB", MSGS_MEM_FAIL); + return(CVSPILS_MEM_FAIL); + } + + pset_B = NULL; + psolve_B = NULL; + P_data_B = NULL; + + /* initialize Jacobian function */ + jtimes_B = NULL; + + /* attach lmemB and lfreeB */ + cvB_mem->cv_lmem = cvspilsB_mem; + cvB_mem->cv_lfree = CVSpgmrFreeB; + + flag = CVSpgmr(cvodeB_mem, pretypeB, maxlB); + + if (flag != CVSPILS_SUCCESS) { + free(cvspilsB_mem); + cvspilsB_mem = NULL; + } + + return(flag); +} + + +/* + * CVSpgmrFreeB + */ + + +static void CVSpgmrFreeB(CVodeBMem cvB_mem) +{ + CVSpilsMemB cvspilsB_mem; + + cvspilsB_mem = (CVSpilsMemB) (cvB_mem->cv_lmem); + + free(cvspilsB_mem); +} diff --git a/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_spils.c b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_spils.c new file mode 100644 index 0000000..14759b6 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_spils.c @@ -0,0 +1,1182 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.10 $ + * $Date: 2008/09/03 20:26:21 $ + * ----------------------------------------------------------------- + * Programmer(s):Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for the CVSPILS linear solvers. + * + * Part II contains wrappers for using the CVODES iterative linear + * solvers on adjoint (backward) problems. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "cvodes_impl.h" +#include "cvodes_spils_impl.h" + +/* Private constants */ + +#define ZERO RCONST(0.0) +#define PT25 RCONST(0.25) +#define ONE RCONST(1.0) + +/* Algorithmic constants */ + +#define MAX_ITERS 3 /* max. number of attempts to recover in DQ J*v */ + +/* + * ================================================================= + * PRIVATE FUNCTION PROTOTYPES + * ================================================================= + */ + +/* + * cvSpilsPrecSetupBWrapper has type CVSpilsPrecSetupFn + * It wraps around the user-provided function of type CVSpilsPrecSetupFnB + */ + +static int cvSpilsPrecSetupBWrapper(realtype t, N_Vector yB, + N_Vector fyB, booleantype jokB, + booleantype *jcurPtrB, realtype gammaB, + void *cvode_mem, + N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); + +/* + * cvSpilsPrecSolveBWrapper has type CVSpilsPrecSolveFn + * It wraps around the user-provided function of type CVSpilsPrecSolveFnB + */ + +static int cvSpilsPrecSolveBWrapper(realtype t, N_Vector yB, N_Vector fyB, + N_Vector rB, N_Vector zB, + realtype gammaB, realtype deltaB, + int lrB, void *cvode_mem, N_Vector tmpB); + +/* + * cvSpilsJacTimesVecBWrapper has type CVSpilsJacTimesVecFn + * It wraps around the user-provided function of type CVSpilsJacTimesVecFnB + */ + +static int cvSpilsJacTimesVecBWrapper(N_Vector vB, N_Vector JvB, realtype t, + N_Vector yB, N_Vector fyB, + void *cvode_mem, N_Vector tmpB); + +/* + * ================================================================ + * + * PART I - forward problems + * + * ================================================================ + */ + +/* Readability Replacements */ + +#define lrw1 (cv_mem->cv_lrw1) +#define liw1 (cv_mem->cv_liw1) +#define tq (cv_mem->cv_tq) +#define tn (cv_mem->cv_tn) +#define h (cv_mem->cv_h) +#define gamma (cv_mem->cv_gamma) +#define nfe (cv_mem->cv_nfe) +#define f (cv_mem->cv_f) +#define user_data (cv_mem->cv_user_data) +#define ewt (cv_mem->cv_ewt) +#define lmem (cv_mem->cv_lmem) + +#define ils_type (cvspils_mem->s_type) +#define sqrtN (cvspils_mem->s_sqrtN) +#define ytemp (cvspils_mem->s_ytemp) +#define x (cvspils_mem->s_x) +#define ycur (cvspils_mem->s_ycur) +#define fcur (cvspils_mem->s_fcur) +#define delta (cvspils_mem->s_delta) +#define npe (cvspils_mem->s_npe) +#define nli (cvspils_mem->s_nli) +#define nps (cvspils_mem->s_nps) +#define ncfl (cvspils_mem->s_ncfl) +#define njtimes (cvspils_mem->s_njtimes) +#define nfes (cvspils_mem->s_nfes) + +#define jtimesDQ (cvspils_mem->s_jtimesDQ) +#define jtimes (cvspils_mem->s_jtimes) +#define j_data (cvspils_mem->s_j_data) + +#define last_flag (cvspils_mem->s_last_flag) + + +/* + * ----------------------------------------------------------------- + * OPTIONAL INPUT and OUTPUT FUNCTIONS + * ----------------------------------------------------------------- + */ + + +/* + * ----------------------------------------------------------------- + * CVSpilsSetPrecType + * ----------------------------------------------------------------- + */ + +int CVSpilsSetPrecType(void *cvode_mem, int pretype) +{ + CVodeMem cv_mem; + CVSpilsMem cvspils_mem; + + /* Return immediately if cvode_mem is NULL */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsSetPrecType", MSGS_CVMEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + if (lmem == NULL) { + cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsSetPrecType", MSGS_LMEM_NULL); + return(CVSPILS_LMEM_NULL); + } + cvspils_mem = (CVSpilsMem) lmem; + + /* Check for legal pretype */ + if ((pretype != PREC_NONE) && (pretype != PREC_LEFT) && + (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) { + cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPILS", "CVSpilsSetPrecType", MSGS_BAD_PRETYPE); + return(CVSPILS_ILL_INPUT); + } + + cvspils_mem->s_pretype = pretype; + + return(CVSPILS_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * CVSpilsSetGSType + * ----------------------------------------------------------------- + */ + +int CVSpilsSetGSType(void *cvode_mem, int gstype) +{ + CVodeMem cv_mem; + CVSpilsMem cvspils_mem; + + /* Return immediately if cvode_mem is NULL */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsSetGSType", MSGS_CVMEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + if (lmem == NULL) { + cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsSetGSType", MSGS_LMEM_NULL); + return(CVSPILS_LMEM_NULL); + } + cvspils_mem = (CVSpilsMem) lmem; + + if (ils_type != SPILS_SPGMR) { + cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPILS", "CVSpilsSetGSType", MSGS_BAD_LSTYPE); + return(CVSPILS_ILL_INPUT); + } + + /* Check for legal gstype */ + if ((gstype != MODIFIED_GS) && (gstype != CLASSICAL_GS)) { + cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPILS", "CVSpilsSetGSType", MSGS_BAD_GSTYPE); + return(CVSPILS_ILL_INPUT); + } + + cvspils_mem->s_gstype = gstype; + + return(CVSPILS_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Function : CVSpilsSetMaxl + * ----------------------------------------------------------------- + */ + +int CVSpilsSetMaxl(void *cvode_mem, int maxl) +{ + CVodeMem cv_mem; + CVSpilsMem cvspils_mem; + int mxl; + + /* Return immediately if cvode_mem is NULL */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsSetMaxl", MSGS_CVMEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + if (lmem == NULL) { + cvProcessError(NULL, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsSetMaxl", MSGS_LMEM_NULL); + return(CVSPILS_LMEM_NULL); + } + cvspils_mem = (CVSpilsMem) lmem; + + if (ils_type == SPILS_SPGMR) { + cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPILS", "CVSpilsSetMaxl", MSGS_BAD_LSTYPE); + return(CVSPILS_ILL_INPUT); + } + + mxl = (maxl <= 0) ? CVSPILS_MAXL : maxl; + cvspils_mem->s_maxl = mxl; + + /* spbcg_mem->l_max = mxl; */ + + return(CVSPILS_SUCCESS); +} + + +/* + * ----------------------------------------------------------------- + * CVSpilsSetEpsLin + * ----------------------------------------------------------------- + */ + +int CVSpilsSetEpsLin(void *cvode_mem, realtype eplifac) +{ + CVodeMem cv_mem; + CVSpilsMem cvspils_mem; + + /* Return immediately if cvode_mem is NULL */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsSetEpsLin", MSGS_CVMEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + if (lmem == NULL) { + cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsSetEpsLin", MSGS_LMEM_NULL); + return(CVSPILS_LMEM_NULL); + } + cvspils_mem = (CVSpilsMem) lmem; + + /* Check for legal eplifac */ + if(eplifac < ZERO) { + cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPILS", "CVSpilsSetEpsLin", MSGS_BAD_EPLIN); + return(CVSPILS_ILL_INPUT); + } + + cvspils_mem->s_eplifac = (eplifac == ZERO) ? CVSPILS_EPLIN : eplifac; + + return(CVSPILS_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * CVSpilsSetPrecSetupFn + * ----------------------------------------------------------------- + */ + +int CVSpilsSetPreconditioner(void *cvode_mem, + CVSpilsPrecSetupFn pset, CVSpilsPrecSolveFn psolve) +{ + CVodeMem cv_mem; + CVSpilsMem cvspils_mem; + + /* Return immediately if cvode_mem is NULL */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsSetPreconditioner", MSGS_CVMEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + if (lmem == NULL) { + cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsSetPreconditioner", MSGS_LMEM_NULL); + return(CVSPILS_LMEM_NULL); + } + cvspils_mem = (CVSpilsMem) lmem; + + cvspils_mem->s_pset = pset; + cvspils_mem->s_psolve = psolve; + + return(CVSPILS_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * CVSpilsSetJacTimesVecFn + * ----------------------------------------------------------------- + */ + +int CVSpilsSetJacTimesVecFn(void *cvode_mem, CVSpilsJacTimesVecFn jtv) +{ + CVodeMem cv_mem; + CVSpilsMem cvspils_mem; + + /* Return immediately if cvode_mem is NULL */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsSetJacTimesVecFn", MSGS_CVMEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + if (lmem == NULL) { + cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsSetJacTimesVecFn", MSGS_LMEM_NULL); + return(CVSPILS_LMEM_NULL); + } + cvspils_mem = (CVSpilsMem) lmem; + + if (jtv != NULL) { + jtimesDQ = FALSE; + jtimes = jtv; + } else { + jtimesDQ = TRUE; + } + + return(CVSPILS_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * CVSpilsGetWorkSpace + * ----------------------------------------------------------------- + */ + +int CVSpilsGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS) +{ + CVodeMem cv_mem; + CVSpilsMem cvspils_mem; + int maxl; + + /* Return immediately if cvode_mem is NULL */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsGetWorkSpace", MSGS_CVMEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + if (lmem == NULL) { + cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsGetWorkSpace", MSGS_LMEM_NULL); + return(CVSPILS_LMEM_NULL); + } + cvspils_mem = (CVSpilsMem) lmem; + + + switch(ils_type) { + case SPILS_SPGMR: + maxl = cvspils_mem->s_maxl; + *lenrwLS = lrw1*(maxl + 5) + maxl*(maxl + 4) + 1; + *leniwLS = liw1*(maxl + 5); + break; + case SPILS_SPBCG: + *lenrwLS = lrw1 * 9; + *leniwLS = liw1 * 9; + break; + case SPILS_SPTFQMR: + *lenrwLS = lrw1*11; + *leniwLS = liw1*11; + break; + } + + + return(CVSPILS_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * CVSpilsGetNumPrecEvals + * ----------------------------------------------------------------- + */ + +int CVSpilsGetNumPrecEvals(void *cvode_mem, long int *npevals) +{ + CVodeMem cv_mem; + CVSpilsMem cvspils_mem; + + /* Return immediately if cvode_mem is NULL */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsGetNumPrecEvals", MSGS_CVMEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + if (lmem == NULL) { + cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsGetNumPrecEvals", MSGS_LMEM_NULL); + return(CVSPILS_LMEM_NULL); + } + cvspils_mem = (CVSpilsMem) lmem; + + *npevals = npe; + + return(CVSPILS_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * CVSpilsGetNumPrecSolves + * ----------------------------------------------------------------- + */ + +int CVSpilsGetNumPrecSolves(void *cvode_mem, long int *npsolves) +{ + CVodeMem cv_mem; + CVSpilsMem cvspils_mem; + + /* Return immediately if cvode_mem is NULL */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsGetNumPrecSolves", MSGS_CVMEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + if (lmem == NULL) { + cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsGetNumPrecSolves", MSGS_LMEM_NULL); + return(CVSPILS_LMEM_NULL); + } + cvspils_mem = (CVSpilsMem) lmem; + + *npsolves = nps; + + return(CVSPILS_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * CVSpilsGetNumLinIters + * ----------------------------------------------------------------- + */ + +int CVSpilsGetNumLinIters(void *cvode_mem, long int *nliters) +{ + CVodeMem cv_mem; + CVSpilsMem cvspils_mem; + + /* Return immediately if cvode_mem is NULL */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsGetNumLinIters", MSGS_CVMEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + if (lmem == NULL) { + cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsGetNumLinIters", MSGS_LMEM_NULL); + return(CVSPILS_LMEM_NULL); + } + cvspils_mem = (CVSpilsMem) lmem; + + *nliters = nli; + + return(CVSPILS_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * CVSpilsGetNumConvFails + * ----------------------------------------------------------------- + */ + +int CVSpilsGetNumConvFails(void *cvode_mem, long int *nlcfails) +{ + CVodeMem cv_mem; + CVSpilsMem cvspils_mem; + + /* Return immediately if cvode_mem is NULL */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsGetNumConvFails", MSGS_CVMEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + if (lmem == NULL) { + cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsGetNumConvFails", MSGS_LMEM_NULL); + return(CVSPILS_LMEM_NULL); + } + cvspils_mem = (CVSpilsMem) lmem; + + *nlcfails = ncfl; + + return(CVSPILS_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * CVSpilsGetNumJtimesEvals + * ----------------------------------------------------------------- + */ + +int CVSpilsGetNumJtimesEvals(void *cvode_mem, long int *njvevals) +{ + CVodeMem cv_mem; + CVSpilsMem cvspils_mem; + + /* Return immediately if cvode_mem is NULL */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsGetNumJtimesEvals", MSGS_CVMEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + if (lmem == NULL) { + cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsGetNumJtimesEvals", MSGS_LMEM_NULL); + return(CVSPILS_LMEM_NULL); + } + cvspils_mem = (CVSpilsMem) lmem; + + *njvevals = njtimes; + + return(CVSPILS_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * CVSpilsGetNumRhsEvals + * ----------------------------------------------------------------- + */ + +int CVSpilsGetNumRhsEvals(void *cvode_mem, long int *nfevalsLS) +{ + CVodeMem cv_mem; + CVSpilsMem cvspils_mem; + + /* Return immediately if cvode_mem is NULL */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsGetNumRhsEvals", MSGS_CVMEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + if (lmem == NULL) { + cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsGetNumRhsEvals", MSGS_LMEM_NULL); + return(CVSPILS_LMEM_NULL); + } + cvspils_mem = (CVSpilsMem) lmem; + + *nfevalsLS = nfes; + + return(CVSPILS_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * CVSpilsGetLastFlag + * ----------------------------------------------------------------- + */ + +int CVSpilsGetLastFlag(void *cvode_mem, int *flag) +{ + CVodeMem cv_mem; + CVSpilsMem cvspils_mem; + + /* Return immediately if cvode_mem is NULL */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsGetLastFlag", MSGS_CVMEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + if (lmem == NULL) { + cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsGetLastFlag", MSGS_LMEM_NULL); + return(CVSPILS_LMEM_NULL); + } + cvspils_mem = (CVSpilsMem) lmem; + + *flag = last_flag; + + return(CVSPILS_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * CVSpilsGetReturnFlagName + * ----------------------------------------------------------------- + */ + +char *CVSpilsGetReturnFlagName(int flag) +{ + char *name; + + name = (char *)malloc(30*sizeof(char)); + + switch(flag) { + case CVSPILS_SUCCESS: + sprintf(name,"CVSPILS_SUCCESS"); + break; + case CVSPILS_MEM_NULL: + sprintf(name,"CVSPILS_MEM_NULL"); + break; + case CVSPILS_LMEM_NULL: + sprintf(name,"CVSPILS_LMEM_NULL"); + break; + case CVSPILS_ILL_INPUT: + sprintf(name,"CVSPILS_ILL_INPUT"); + break; + case CVSPILS_MEM_FAIL: + sprintf(name,"CVSPILS_MEM_FAIL"); + break; + case CVSPILS_PMEM_NULL: + sprintf(name,"CVSPILS_PMEM_NULL"); + break; + case CVSPILS_NO_ADJ: + sprintf(name,"CVSPILS_NO_ADJ"); + break; + case CVSPILS_LMEMB_NULL: + sprintf(name,"CVSPILS_LMEMB_NULL"); + break; + default: + sprintf(name,"NONE"); + } + + return(name); +} + +/* + * ----------------------------------------------------------------- + * CVSPILS private functions + * ----------------------------------------------------------------- + */ + + +/* Additional readability Replacements */ + +#define pretype (cvspils_mem->s_pretype) +#define eplifac (cvspils_mem->s_eplifac) +#define maxl (cvspils_mem->s_maxl) +#define psolve (cvspils_mem->s_psolve) +#define P_data (cvspils_mem->s_P_data) + +/* + * ----------------------------------------------------------------- + * CVSpilsAtimes + * ----------------------------------------------------------------- + * This routine generates the matrix-vector product z = Mv, where + * M = I - gamma*J. The product J*v is obtained by calling the jtimes + * routine. It is then scaled by -gamma and added to v to obtain M*v. + * The return value is the same as the value returned by jtimes -- + * 0 if successful, nonzero otherwise. + * ----------------------------------------------------------------- + */ + +int CVSpilsAtimes(void *cvode_mem, N_Vector v, N_Vector z) +{ + CVodeMem cv_mem; + CVSpilsMem cvspils_mem; + int retval; + + cv_mem = (CVodeMem) cvode_mem; + cvspils_mem = (CVSpilsMem) lmem; + + retval = jtimes(v, z, tn, ycur, fcur, j_data, ytemp); + njtimes++; + if (retval != 0) return(retval); + + N_VLinearSum(ONE, v, -gamma, z, z); + + return(0); +} + +/* + * ----------------------------------------------------------------- + * CVSpilsPSolve + * ----------------------------------------------------------------- + * This routine interfaces between the generic SpgmrSolve routine and + * the user's psolve routine. It passes to psolve all required state + * information from cvode_mem. Its return value is the same as that + * returned by psolve. Note that the generic SPGMR solver guarantees + * that CVSpilsPSolve will not be called in the case in which + * preconditioning is not done. This is the only case in which the + * user's psolve routine is allowed to be NULL. + * ----------------------------------------------------------------- + */ + +int CVSpilsPSolve(void *cvode_mem, N_Vector r, N_Vector z, int lr) +{ + CVodeMem cv_mem; + CVSpilsMem cvspils_mem; + int retval; + + cv_mem = (CVodeMem) cvode_mem; + cvspils_mem = (CVSpilsMem)lmem; + + /* This call is counted in nps within the CVSp***Solve routine */ + retval = psolve(tn, ycur, fcur, r, z, gamma, delta, lr, P_data, ytemp); + + return(retval); +} + +/* + * ----------------------------------------------------------------- + * CVSpilsDQJtimes + * ----------------------------------------------------------------- + * This routine generates a difference quotient approximation to + * the Jacobian times vector f_y(t,y) * v. The approximation is + * Jv = vnrm[f(y + v/vnrm) - f(y)], where vnrm = (WRMS norm of v) is + * input, i.e. the WRMS norm of v/vnrm is 1. + * ----------------------------------------------------------------- + */ + +int CVSpilsDQJtimes(N_Vector v, N_Vector Jv, realtype t, + N_Vector y, N_Vector fy, + void *data, N_Vector work) +{ + CVodeMem cv_mem; + CVSpilsMem cvspils_mem; + realtype sig, siginv; + int iter, retval; + + /* data is cvode_mem */ + cv_mem = (CVodeMem) data; + cvspils_mem = (CVSpilsMem) lmem; + + /* Initialize perturbation to 1/||v|| */ + sig = ONE/N_VWrmsNorm(v, ewt); + + for (iter=0; iter 0) return(+1); + + /* Replace Jv by (Jv - fy)/sig */ + siginv = ONE/sig; + N_VLinearSum(siginv, Jv, -siginv, fy, Jv); + + return(0); +} + +/* + * ================================================================ + * + * PART II - backward problems + * + * ================================================================ + */ + +/* Readability replacements */ + +#define ytmp (ca_mem->ca_ytmp) +#define yStmp (ca_mem->ca_yStmp) +#define IMget (ca_mem->ca_IMget) + +#define pset_B (cvspilsB_mem->s_psetB) +#define psolve_B (cvspilsB_mem->s_psolveB) +#define jtimes_B (cvspilsB_mem->s_jtimesB) + +/* + * ----------------------------------------------------------------- + * OPTIONAL INPUT and OUTPUT FUNCTIONS + * ----------------------------------------------------------------- + */ + +int CVSpilsSetPrecTypeB(void *cvode_mem, int which, int pretypeB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsSetPrecTypeB", MSGS_CVMEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CVSPILS_NO_ADJ, "CVSPILS", "CVSpilsSetPrecTypeB", MSGS_NO_ADJ); + return(CVSPILS_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= ca_mem->ca_nbckpbs ) { + cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPILS", "CVSpilsSetPrecTypeB", MSGS_BAD_WHICH); + return(CVSPILS_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + flag = CVSpilsSetPrecType(cvodeB_mem, pretypeB); + + return(flag); +} + +int CVSpilsSetGSTypeB(void *cvode_mem, int which, int gstypeB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsSetGSTypeB", MSGS_CVMEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CVSPILS_NO_ADJ, "CVSPILS", "CVSpilsSetGSTypeB", MSGS_NO_ADJ); + return(CVSPILS_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= ca_mem->ca_nbckpbs ) { + cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPILS", "CVSpilsSetGSTypeB", MSGS_BAD_WHICH); + return(CVSPILS_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + flag = CVSpilsSetGSType(cvodeB_mem,gstypeB); + + return(flag); +} + +int CVSpilsSetEpsLinB(void *cvode_mem, int which, realtype eplifacB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsSetEpsLinB", MSGS_CVMEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CVSPILS_NO_ADJ, "CVSPILS", "CVSpilsSetEpsLinB", MSGS_NO_ADJ); + return(CVSPILS_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= ca_mem->ca_nbckpbs ) { + cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPILS", "CVSpilsSetEpsLinB", MSGS_BAD_WHICH); + return(CVSPILS_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + flag = CVSpilsSetEpsLin(cvodeB_mem,eplifacB); + + return(flag); +} + +int CVSpilsSetMaxlB(void *cvode_mem, int which, int maxlB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsSetMaxlB", MSGS_CVMEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CVSPILS_NO_ADJ, "CVSPILS", "CVSpilsSetMaxlB", MSGS_NO_ADJ); + return(CVSPILS_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= ca_mem->ca_nbckpbs ) { + cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPILS", "CVSpilsSetMaxlB", MSGS_BAD_WHICH); + return(CVSPILS_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + flag = CVSpilsSetMaxl(cvodeB_mem,maxlB); + + return(flag); +} + +int CVSpilsSetPreconditionerB(void *cvode_mem, int which, + CVSpilsPrecSetupFnB psetB, + CVSpilsPrecSolveFnB psolveB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + CVSpilsMemB cvspilsB_mem; + void *cvodeB_mem; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsSetPreconsitionerB", MSGS_CVMEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CVSPILS_NO_ADJ, "CVSPILS", "CVSpilsSetPreconsitionerB", MSGS_NO_ADJ); + return(CVSPILS_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= ca_mem->ca_nbckpbs ) { + cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPILS", "CVSpilsSetPreconsitionerB", MSGS_BAD_WHICH); + return(CVSPILS_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + if (cvB_mem->cv_lmem == NULL) { + cvProcessError(cv_mem, CVSPILS_LMEMB_NULL, "CVSPILS", "CVSpilsSetPreconditonerB", MSGS_LMEMB_NULL); + return(CVSPILS_LMEMB_NULL); + } + cvspilsB_mem = (CVSpilsMemB) (cvB_mem->cv_lmem); + + pset_B = psetB; + psolve_B = psolveB; + + flag = CVSpilsSetPreconditioner(cvodeB_mem, cvSpilsPrecSetupBWrapper, cvSpilsPrecSolveBWrapper); + + return(flag); +} + +int CVSpilsSetJacTimesVecFnB(void *cvode_mem, int which, CVSpilsJacTimesVecFnB jtvB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + CVSpilsMemB cvspilsB_mem; + void *cvodeB_mem; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsSetJacTimesVecFnB", MSGS_CVMEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CVSPILS_NO_ADJ, "CVSPILS", "CVSpilsSetJacTimesVecFnB", MSGS_NO_ADJ); + return(CVSPILS_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= ca_mem->ca_nbckpbs ) { + cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPILS", "CVSpilsSetJacTimesVecFnB", MSGS_BAD_WHICH); + return(CVSPILS_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + if (cvB_mem->cv_lmem == NULL) { + cvProcessError(cv_mem, CVSPILS_LMEMB_NULL, "CVSPILS", "CVSpilsSetJacTimesVecFnB", MSGS_LMEMB_NULL); + return(CVSPILS_LMEMB_NULL); + } + cvspilsB_mem = (CVSpilsMemB) (cvB_mem->cv_lmem); + + jtimes_B = jtvB; + + if (jtvB != NULL) { + flag = CVSpilsSetJacTimesVecFn(cvodeB_mem, cvSpilsJacTimesVecBWrapper); + } else { + flag = CVSpilsSetJacTimesVecFn(cvodeB_mem, NULL); + } + + return(flag); +} + + +/* + * ----------------------------------------------------------------- + * CVSPILS private functions + * ----------------------------------------------------------------- + */ + +/* + * cvSpilsPrecSetupBWrapper + * + * This routine interfaces to the CVSpilsPrecSetupFnB routine + * provided by the user. + */ + +static int cvSpilsPrecSetupBWrapper(realtype t, N_Vector yB, + N_Vector fyB, booleantype jokB, + booleantype *jcurPtrB, realtype gammaB, + void *cvode_mem, + N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + CVSpilsMemB cvspilsB_mem; + int retval, flag; + + cv_mem = (CVodeMem) cvode_mem; + + ca_mem = cv_mem->cv_adj_mem; + + cvB_mem = ca_mem->ca_bckpbCrt; + + cvspilsB_mem = (CVSpilsMemB) (cvB_mem->cv_lmem); + + /* Forward solution from interpolation */ + flag = IMget(cv_mem, t, ytmp, NULL); + if (flag != CV_SUCCESS) { + cvProcessError(cv_mem, -1, "CVSPILS", "cvSpilsPrecSetupBWrapper", MSGS_BAD_TINTERP); + return(-1); + } + + /* Call user's adjoint precondB routine */ + retval = pset_B(t, ytmp, yB, fyB, jokB, jcurPtrB, gammaB, + cvB_mem->cv_user_data, tmp1B, tmp2B, tmp3B); + + return(retval); +} + + +/* + * cvSpilsPrecSolveBWrapper + * + * This routine interfaces to the CVSpilsPrecSolveFnB routine + * provided by the user. + */ + +static int cvSpilsPrecSolveBWrapper(realtype t, N_Vector yB, N_Vector fyB, + N_Vector rB, N_Vector zB, + realtype gammaB, realtype deltaB, + int lrB, void *cvode_mem, N_Vector tmpB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + CVSpilsMemB cvspilsB_mem; + int retval, flag; + + cv_mem = (CVodeMem) cvode_mem; + + ca_mem = cv_mem->cv_adj_mem; + + cvB_mem = ca_mem->ca_bckpbCrt; + + cvspilsB_mem = (CVSpilsMemB) (cvB_mem->cv_lmem); + + /* Forward solution from interpolation */ + flag = IMget(cv_mem, t, ytmp, NULL); + if (flag != CV_SUCCESS) { + cvProcessError(cv_mem, -1, "CVSPILS", "cvSpilsPrecSolveBWrapper", MSGS_BAD_TINTERP); + return(-1); + } + + /* Call user's adjoint psolveB routine */ + retval = psolve_B(t, ytmp, yB, fyB, rB, zB, gammaB, deltaB, + lrB, cvB_mem->cv_user_data, tmpB); + + return(retval); +} + + +/* + * cvSpilsJacTimesVecBWrapper + * + * This routine interfaces to the CVSpilsJacTimesVecFnB routine + * provided by the user. + */ + +static int cvSpilsJacTimesVecBWrapper(N_Vector vB, N_Vector JvB, realtype t, + N_Vector yB, N_Vector fyB, + void *cvode_mem, N_Vector tmpB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + CVSpilsMemB cvspilsB_mem; + int retval, flag; + + cv_mem = (CVodeMem) cvode_mem; + + ca_mem = cv_mem->cv_adj_mem; + + cvB_mem = ca_mem->ca_bckpbCrt; + + cvspilsB_mem = (CVSpilsMemB) (cvB_mem->cv_lmem); + + /* Forward solution from interpolation */ + flag = IMget(cv_mem, t, ytmp, NULL); + if (flag != CV_SUCCESS) { + cvProcessError(cv_mem, -1, "CVSPILS", "cvSpilsJacTimesVecBWrapper", MSGS_BAD_TINTERP); + return(-1); + } + + /* Call user's adjoint jtimesB routine */ + retval = jtimes_B(vB, JvB, t, ytmp, yB, fyB, cvB_mem->cv_user_data, tmpB); + + return(retval); +} + diff --git a/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_spils_impl.h b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_spils_impl.h new file mode 100644 index 0000000..a847ecb --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_spils_impl.h @@ -0,0 +1,183 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.8 $ + * $Date: 2008/09/03 20:26:21 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * Common implementation header file for the scaled, preconditioned + * iterative linear solvers + * ----------------------------------------------------------------- + */ + +#ifndef _CVSSPILS_IMPL_H +#define _CVSSPILS_IMPL_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include "cvodes_impl.h" + +/* + * ================================================================= + * C V S P I L S I N T E R N A L C O N S T A N T S + * ================================================================= + */ + +/* Types of iterative linear solvers */ + +#define SPILS_SPGMR 1 +#define SPILS_SPBCG 2 +#define SPILS_SPTFQMR 3 + +/* + * ================================================================= + * PART I: F O R W A R D P R O B L E M S + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Types : CVSpilsMemRec, CVSpilsMem + * ----------------------------------------------------------------- + * The type CVSpilsMem is pointer to a CVSpilsMemRec. + * ----------------------------------------------------------------- + */ + +typedef struct CVSpilsMemRec { + + int s_type; /* type of scaled preconditioned iterative LS */ + + int s_pretype; /* type of preconditioning */ + int s_gstype; /* type of Gram-Schmidt orthogonalization */ + realtype s_sqrtN; /* sqrt(N) */ + realtype s_eplifac; /* eplifac = user specified or EPLIN_DEFAULT */ + realtype s_deltar; /* deltar = delt * tq4 */ + realtype s_delta; /* delta = deltar * sqrtN */ + int s_maxl; /* maxl = maximum dimension of the Krylov space */ + + long int s_nstlpre; /* value of nst at the last pset call */ + long int s_npe; /* npe = total number of pset calls */ + long int s_nli; /* nli = total number of linear iterations */ + long int s_nps; /* nps = total number of psolve calls */ + long int s_ncfl; /* ncfl = total number of convergence failures */ + long int s_njtimes; /* njtimes = total number of calls to jtimes */ + long int s_nfes; /* nfeSG = total number of calls to f for + difference quotient Jacobian-vector products */ + + N_Vector s_ytemp; /* temp vector passed to jtimes and psolve */ + N_Vector s_x; /* temp vector used by CVSpilsSolve */ + N_Vector s_ycur; /* CVODE current y vector in Newton Iteration */ + N_Vector s_fcur; /* fcur = f(tn, ycur) */ + + void* s_spils_mem; /* memory used by the generic solver */ + + /* Preconditioner computation + * (a) user-provided: + * - P_data == user_data + * - pfree == NULL (the user dealocates memory for user_data) + * (b) internal preconditioner module + * - P_data == cvode_mem + * - pfree == set by the prec. module and called in CVodeFree + */ + CVSpilsPrecSetupFn s_pset; + CVSpilsPrecSolveFn s_psolve; + void (*s_pfree)(CVodeMem cv_mem); + void *s_P_data; + + /* Jacobian times vector compuation + * (a) jtimes function provided by the user: + * - j_data == user_data + * - jtimesDQ == FALSE + * (b) internal jtimes + * - j_data == cvode_mem + * - jtimesDQ == TRUE + */ + booleantype s_jtimesDQ; + CVSpilsJacTimesVecFn s_jtimes; + void *s_j_data; + + int s_last_flag; /* last error flag returned by any function */ + +} *CVSpilsMem; + +/* + * ----------------------------------------------------------------- + * Prototypes of internal functions + * ----------------------------------------------------------------- + */ + +/* Atimes and PSolve routines called by generic solver */ + +int CVSpilsAtimes(void *cv_mem, N_Vector v, N_Vector z); + +int CVSpilsPSolve(void *cv_mem, N_Vector r, N_Vector z, int lr); + +/* Difference quotient approximation for Jac times vector */ + +int CVSpilsDQJtimes(N_Vector v, N_Vector Jv, realtype t, + N_Vector y, N_Vector fy, void *data, + N_Vector work); +/* + * ================================================================= + * PART II: B A C K W A R D P R O B L E M S + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Types : CVSpilsMemRecB, CVSpilsMemB + * ----------------------------------------------------------------- + * CVSpgmrB, CVSpbcgB, and CVSptfqmr attach such a structure to the + * lmemB filed of CVodeBMem + * ----------------------------------------------------------------- + */ + +typedef struct CVSpilsMemRecB { + + CVSpilsJacTimesVecFnB s_jtimesB; + CVSpilsPrecSetupFnB s_psetB; + CVSpilsPrecSolveFnB s_psolveB; + void *s_P_dataB; + +} *CVSpilsMemB; + + +/* + * ================================================================= + * E R R O R M E S S A G E S + * ================================================================= + */ + +#define MSGS_CVMEM_NULL "Integrator memory is NULL." +#define MSGS_MEM_FAIL "A memory request failed." +#define MSGS_BAD_NVECTOR "A required vector operation is not implemented." +#define MSGS_BAD_LSTYPE "Incompatible linear solver type." +#define MSGS_BAD_PRETYPE "Illegal value for pretype. Legal values are PREC_NONE, PREC_LEFT, PREC_RIGHT, and PREC_BOTH." +#define MSGS_PSOLVE_REQ "pretype != PREC_NONE, but PSOLVE = NULL is illegal." +#define MSGS_LMEM_NULL "Linear solver memory is NULL." +#define MSGS_BAD_GSTYPE "Illegal value for gstype. Legal values are MODIFIED_GS and CLASSICAL_GS." +#define MSGS_BAD_EPLIN "eplifac < 0 illegal." + +#define MSGS_PSET_FAILED "The preconditioner setup routine failed in an unrecoverable manner." +#define MSGS_PSOLVE_FAILED "The preconditioner solve routine failed in an unrecoverable manner." +#define MSGS_JTIMES_FAILED "The Jacobian x vector routine failed in an unrecoverable manner." + +#define MSGS_NO_ADJ "Illegal attempt to call before calling CVodeAdjMalloc." +#define MSGS_BAD_WHICH "Illegal value for which." +#define MSGS_LMEMB_NULL "Linear solver memory is NULL for the backward integration." +#define MSGS_BAD_TINTERP "Bad t for interpolation." + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_sptfqmr.c b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_sptfqmr.c new file mode 100644 index 0000000..32a2881 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/cvodes/cvodes_sptfqmr.c @@ -0,0 +1,568 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.11 $ + * $Date: 2008/09/03 20:26:21 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for the CVSPTFQMR linear solver. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include +#include "cvodes_spils_impl.h" +#include "cvodes_impl.h" + +#include +#include + +/* Constants */ + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + +/* CVSPTFQMR linit, lsetup, lsolve, and lfree routines */ + +static int CVSptfqmrInit(CVodeMem cv_mem); + +static int CVSptfqmrSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, + N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, + N_Vector vtemp2, N_Vector vtemp3); + +static int CVSptfqmrSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, + N_Vector ynow, N_Vector fnow); + +static void CVSptfqmrFree(CVodeMem cv_mem); + +/* CVSPTFQMR lfreeB function */ + +static void CVSptfqmrFreeB(CVodeBMem cvB_mem); + +/* + * ================================================================ + * + * PART I - forward problems + * + * ================================================================ + */ + +/* Readability Replacements */ + +#define tq (cv_mem->cv_tq) +#define nst (cv_mem->cv_nst) +#define tn (cv_mem->cv_tn) +#define gamma (cv_mem->cv_gamma) +#define gammap (cv_mem->cv_gammap) +#define f (cv_mem->cv_f) +#define user_data (cv_mem->cv_user_data) +#define ewt (cv_mem->cv_ewt) +#define errfp (cv_mem->cv_errfp) +#define mnewt (cv_mem->cv_mnewt) +#define linit (cv_mem->cv_linit) +#define lsetup (cv_mem->cv_lsetup) +#define lsolve (cv_mem->cv_lsolve) +#define lfree (cv_mem->cv_lfree) +#define lmem (cv_mem->cv_lmem) +#define vec_tmpl (cv_mem->cv_tempv) +#define setupNonNull (cv_mem->cv_setupNonNull) + +#define sqrtN (cvspils_mem->s_sqrtN) +#define ytemp (cvspils_mem->s_ytemp) +#define x (cvspils_mem->s_x) +#define ycur (cvspils_mem->s_ycur) +#define fcur (cvspils_mem->s_fcur) +#define delta (cvspils_mem->s_delta) +#define deltar (cvspils_mem->s_deltar) +#define npe (cvspils_mem->s_npe) +#define nli (cvspils_mem->s_nli) +#define nps (cvspils_mem->s_nps) +#define ncfl (cvspils_mem->s_ncfl) +#define nstlpre (cvspils_mem->s_nstlpre) +#define njtimes (cvspils_mem->s_njtimes) +#define nfes (cvspils_mem->s_nfes) +#define spils_mem (cvspils_mem->s_spils_mem) + +#define jtimesDQ (cvspils_mem->s_jtimesDQ) +#define jtimes (cvspils_mem->s_jtimes) +#define j_data (cvspils_mem->s_j_data) + +#define last_flag (cvspils_mem->s_last_flag) + +/* + * ----------------------------------------------------------------- + * Function : CVSptfqmr + * ----------------------------------------------------------------- + * This routine initializes the memory record and sets various function + * fields specific to the Sptfqmr linear solver module. CVSptfqmr first + * calls the existing lfree routine if this is not NULL. It then sets + * the cv_linit, cv_lsetup, cv_lsolve, cv_lfree fields in (*cvode_mem) + * to be CVSptfqmrInit, CVSptfqmrSetup, CVSptfqmrSolve, and CVSptfqmrFree, + * respectively. It allocates memory for a structure of type + * CVSpilsMemRec and sets the cv_lmem field in (*cvode_mem) to the + * address of this structure. It sets setupNonNull in (*cvode_mem), + * and sets various fields in the CVSpilsMemRec structure. + * Finally, CVSptfqmr allocates memory for ytemp and x, and calls + * SptfqmrMalloc to allocate memory for the Sptfqmr solver. + * ----------------------------------------------------------------- + */ + +int CVSptfqmr(void *cvode_mem, int pretype, int maxl) +{ + CVodeMem cv_mem; + CVSpilsMem cvspils_mem; + SptfqmrMem sptfqmr_mem; + int mxl; + + /* Return immediately if cvode_mem is NULL */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPTFQMR", "CVSptfqmr", MSGS_CVMEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Check if N_VDotProd is present */ + if (vec_tmpl->ops->nvdotprod == NULL) { + cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPTFQMR", "CVSptfqmr", MSGS_BAD_NVECTOR); + return(CVSPILS_ILL_INPUT); + } + + if (lfree != NULL) lfree(cv_mem); + + /* Set four main function fields in cv_mem */ + linit = CVSptfqmrInit; + lsetup = CVSptfqmrSetup; + lsolve = CVSptfqmrSolve; + lfree = CVSptfqmrFree; + + /* Get memory for CVSpilsMemRec */ + cvspils_mem = NULL; + cvspils_mem = (CVSpilsMem) malloc(sizeof(struct CVSpilsMemRec)); + if (cvspils_mem == NULL) { + cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPTFQMR", "CVSptfqmr", MSGS_MEM_FAIL); + return(CVSPILS_MEM_FAIL); + } + + /* Set ILS type */ + cvspils_mem->s_type = SPILS_SPTFQMR; + + /* Set Sptfqmr parameters that have been passed in call sequence */ + cvspils_mem->s_pretype = pretype; + mxl = cvspils_mem->s_maxl = (maxl <= 0) ? CVSPILS_MAXL : maxl; + + /* Set defaults for Jacobian-related fileds */ + jtimesDQ = TRUE; + jtimes = NULL; + j_data = NULL; + + /* Set defaults for preconditioner-related fields */ + cvspils_mem->s_pset = NULL; + cvspils_mem->s_psolve = NULL; + cvspils_mem->s_pfree = NULL; + cvspils_mem->s_P_data = cv_mem->cv_user_data; + + /* Set default values for the rest of the Sptfqmr parameters */ + cvspils_mem->s_eplifac = CVSPILS_EPLIN; + + cvspils_mem->s_last_flag = CVSPILS_SUCCESS; + + setupNonNull = FALSE; + + /* Check for legal pretype */ + if ((pretype != PREC_NONE) && (pretype != PREC_LEFT) && + (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) { + cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPTFQMR", "CVSptfqmr", MSGS_BAD_PRETYPE); + return(CVSPILS_ILL_INPUT); + } + + /* Allocate memory for ytemp and x */ + ytemp = N_VClone(vec_tmpl); + if (ytemp == NULL) { + cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPTFQMR", "CVSptfqmr", MSGS_MEM_FAIL); + free(cvspils_mem); cvspils_mem = NULL; + return(CVSPILS_MEM_FAIL); + } + x = N_VClone(vec_tmpl); + if (x == NULL) { + cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPTFQMR", "CVSptfqmr", MSGS_MEM_FAIL); + N_VDestroy(ytemp); + free(cvspils_mem); cvspils_mem = NULL; + return(CVSPILS_MEM_FAIL); + } + + /* Compute sqrtN from a dot product */ + N_VConst(ONE, ytemp); + sqrtN = RSqrt(N_VDotProd(ytemp, ytemp)); + + /* Call SptfqmrMalloc to allocate workspace for Sptfqmr */ + sptfqmr_mem = NULL; + sptfqmr_mem = SptfqmrMalloc(mxl, vec_tmpl); + if (sptfqmr_mem == NULL) { + cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPTFQMR", "CVSptfqmr", MSGS_MEM_FAIL); + N_VDestroy(ytemp); + N_VDestroy(x); + free(cvspils_mem); cvspils_mem = NULL; + return(CVSPILS_MEM_FAIL); + } + + /* Attach SPTFQMR memory to spils memory structure */ + spils_mem = (void *) sptfqmr_mem; + + /* Attach linear solver memory to integrator memory */ + lmem = cvspils_mem; + + return(CVSPILS_SUCCESS); +} + +/* Additional readability replacements */ + +#define pretype (cvspils_mem->s_pretype) +#define eplifac (cvspils_mem->s_eplifac) +#define maxl (cvspils_mem->s_maxl) +#define psolve (cvspils_mem->s_psolve) +#define pset (cvspils_mem->s_pset) +#define P_data (cvspils_mem->s_P_data) + +/* + * ----------------------------------------------------------------- + * Function : CVSptfqmrInit + * ----------------------------------------------------------------- + * This routine does remaining initializations specific to the Sptfqmr + * linear solver. + * ----------------------------------------------------------------- + */ + +static int CVSptfqmrInit(CVodeMem cv_mem) +{ + CVSpilsMem cvspils_mem; + SptfqmrMem sptfqmr_mem; + + cvspils_mem = (CVSpilsMem) lmem; + sptfqmr_mem = (SptfqmrMem) spils_mem; + + /* Initialize counters */ + npe = nli = nps = ncfl = nstlpre = 0; + njtimes = nfes = 0; + + /* Check for legal combination pretype - psolve */ + if ((pretype != PREC_NONE) && (psolve == NULL)) { + cvProcessError(cv_mem, -1, "CVSPTFQMR", "CVSptfqmrInit", MSGS_PSOLVE_REQ); + last_flag = CVSPILS_ILL_INPUT; + return(-1); + } + + /* Set setupNonNull = TRUE iff there is preconditioning + (pretype != PREC_NONE) and there is a preconditioning + setup phase (pset != NULL) */ + setupNonNull = (pretype != PREC_NONE) && (pset != NULL); + + /* Set Jacobian-related fields, based on jtimesDQ */ + if (jtimesDQ) { + jtimes = CVSpilsDQJtimes; + j_data = cv_mem; + } else { + j_data = user_data; + } + + /* Set maxl in the SPTFQMR memory in case it was changed by the user */ + sptfqmr_mem->l_max = maxl; + + last_flag = CVSPILS_SUCCESS; + return(0); +} + +/* + * ----------------------------------------------------------------- + * Function : CVSptfqmrSetup + * ----------------------------------------------------------------- + * This routine does the setup operations for the Sptfqmr linear solver. + * It makes a decision as to whether or not to signal for reevaluation + * of Jacobian data in the pset routine, based on various state + * variables, then it calls pset. If we signal for reevaluation, + * then we reset jcur = *jcurPtr to TRUE, regardless of the pset output. + * In any case, if jcur == TRUE, we increment npe and save nst in nstlpre. + * ----------------------------------------------------------------- + */ + +static int CVSptfqmrSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, + N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, + N_Vector vtemp2, N_Vector vtemp3) +{ + booleantype jbad, jok; + realtype dgamma; + int retval; + CVSpilsMem cvspils_mem; + + cvspils_mem = (CVSpilsMem) lmem; + + /* Use nst, gamma/gammap, and convfail to set J eval. flag jok */ + dgamma = ABS((gamma/gammap) - ONE); + jbad = (nst == 0) || (nst > nstlpre + CVSPILS_MSBPRE) || + ((convfail == CV_FAIL_BAD_J) && (dgamma < CVSPILS_DGMAX)) || + (convfail == CV_FAIL_OTHER); + *jcurPtr = jbad; + jok = !jbad; + + /* Call pset routine and possibly reset jcur */ + retval = pset(tn, ypred, fpred, jok, jcurPtr, gamma, P_data, + vtemp1, vtemp2, vtemp3); + if (retval < 0) { + cvProcessError(cv_mem, SPTFQMR_PSET_FAIL_UNREC, "CVSPTFQMR", "CVSptfqmrSetup", MSGS_PSET_FAILED); + last_flag = SPTFQMR_PSET_FAIL_UNREC; + } + if (retval > 0) { + last_flag = SPTFQMR_PSET_FAIL_REC; + } + + if (jbad) *jcurPtr = TRUE; + + /* If jcur = TRUE, increment npe and save nst value */ + if (*jcurPtr) { + npe++; + nstlpre = nst; + } + + last_flag = SPTFQMR_SUCCESS; + + /* Return the same value that pset returned */ + return(retval); +} + +/* + * ----------------------------------------------------------------- + * Function : CVSptfqmrSolve + * ----------------------------------------------------------------- + * This routine handles the call to the generic solver SptfqmrSolve + * for the solution of the linear system Ax = b with the SPTFQMR method. + * The solution x is returned in the vector b. + * + * If the WRMS norm of b is small, we return x = b (if this is the first + * Newton iteration) or x = 0 (if a later Newton iteration). + * + * Otherwise, we set the tolerance parameter and initial guess (x = 0), + * call SptfqmrSolve, and copy the solution x into b. The x-scaling and + * b-scaling arrays are both equal to weight. + * + * The counters nli, nps, and ncfl are incremented, and the return value + * is set according to the success of SptfqmrSolve. The success flag is + * returned if SptfqmrSolve converged, or if this is the first Newton + * iteration and the residual norm was reduced below its initial value. + * ----------------------------------------------------------------- + */ + +static int CVSptfqmrSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, + N_Vector ynow, N_Vector fnow) +{ + realtype bnorm, res_norm; + CVSpilsMem cvspils_mem; + SptfqmrMem sptfqmr_mem; + int nli_inc, nps_inc, retval; + + cvspils_mem = (CVSpilsMem) lmem; + + sptfqmr_mem = (SptfqmrMem) spils_mem; + + /* Test norm(b); if small, return x = 0 or x = b */ + deltar = eplifac * tq[4]; + + bnorm = N_VWrmsNorm(b, weight); + if (bnorm <= deltar) { + if (mnewt > 0) N_VConst(ZERO, b); + return(0); + } + + /* Set vectors ycur and fcur for use by the Atimes and Psolve routines */ + ycur = ynow; + fcur = fnow; + + /* Set inputs delta and initial guess x = 0 to SptfqmrSolve */ + delta = deltar * sqrtN; + N_VConst(ZERO, x); + + /* Call SptfqmrSolve and copy x to b */ + retval = SptfqmrSolve(sptfqmr_mem, cv_mem, x, b, pretype, delta, + cv_mem, weight, weight, CVSpilsAtimes, CVSpilsPSolve, + &res_norm, &nli_inc, &nps_inc); + + N_VScale(ONE, x, b); + + /* Increment counters nli, nps, and ncfl */ + nli += nli_inc; + nps += nps_inc; + if (retval != SPTFQMR_SUCCESS) ncfl++; + + /* Interpret return value from SpgmrSolve */ + + last_flag = retval; + + switch(retval) { + + case SPTFQMR_SUCCESS: + return(0); + break; + case SPTFQMR_RES_REDUCED: + if (mnewt == 0) return(0); + else return(1); + break; + case SPTFQMR_CONV_FAIL: + return(1); + break; + case SPTFQMR_PSOLVE_FAIL_REC: + return(1); + break; + case SPTFQMR_ATIMES_FAIL_REC: + return(1); + break; + case SPTFQMR_MEM_NULL: + return(-1); + break; + case SPTFQMR_ATIMES_FAIL_UNREC: + cvProcessError(cv_mem, SPTFQMR_ATIMES_FAIL_UNREC, "CVSPTFQMR", "CVSptfqmrSolve", MSGS_JTIMES_FAILED); + return(-1); + break; + case SPTFQMR_PSOLVE_FAIL_UNREC: + cvProcessError(cv_mem, SPTFQMR_PSOLVE_FAIL_UNREC, "CVSPTFQMR", "CVSptfqmrSolve", MSGS_PSOLVE_FAILED); + return(-1); + break; + } + + return(0); + +} + +/* + * ----------------------------------------------------------------- + * Function : CVSptfqmrFree + * ----------------------------------------------------------------- + * This routine frees memory specific to the Sptfqmr linear solver. + * ----------------------------------------------------------------- + */ + +static void CVSptfqmrFree(CVodeMem cv_mem) +{ + CVSpilsMem cvspils_mem; + SptfqmrMem sptfqmr_mem; + + cvspils_mem = (CVSpilsMem) lmem; + + N_VDestroy(ytemp); + N_VDestroy(x); + + sptfqmr_mem = (SptfqmrMem) spils_mem; + SptfqmrFree(sptfqmr_mem); + + if (cvspils_mem->s_pfree != NULL) (cvspils_mem->s_pfree)(cv_mem); + + free(cvspils_mem); cvspils_mem = NULL; + + return; +} + +/* + * ================================================================ + * + * PART II - backward problems + * + * ================================================================ + */ + +/* Additional readability replacements */ + +#define pset_B (cvspilsB_mem->s_psetB) +#define psolve_B (cvspilsB_mem->s_psolveB) +#define jtimes_B (cvspilsB_mem->s_jtimesB) +#define P_data_B (cvspilsB_mem->s_P_dataB) + +/* + * CVSptfqmrB + * + * Wrapper for the backward phase + */ + +int CVSptfqmrB(void *cvode_mem, int which, int pretypeB, int maxlB) +{ + CVodeMem cv_mem; + CVadjMem ca_mem; + CVodeBMem cvB_mem; + void *cvodeB_mem; + CVSpilsMemB cvspilsB_mem; + int flag; + + /* Check if cvode_mem exists */ + if (cvode_mem == NULL) { + cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPTFQMR", "CVSptfqmrB", MSGS_CVMEM_NULL); + return(CVSPILS_MEM_NULL); + } + cv_mem = (CVodeMem) cvode_mem; + + /* Was ASA initialized? */ + if (cv_mem->cv_adjMallocDone == FALSE) { + cvProcessError(cv_mem, CVSPILS_NO_ADJ, "CVSPTFQMR", "CVSptfqmrB", MSGS_NO_ADJ); + return(CVSPILS_NO_ADJ); + } + ca_mem = cv_mem->cv_adj_mem; + + /* Check which */ + if ( which >= ca_mem->ca_nbckpbs ) { + cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPTFQMR", "CVSptfqmrB", MSGS_BAD_WHICH); + return(CVSPILS_ILL_INPUT); + } + + /* Find the CVodeBMem entry in the linked list corresponding to which */ + cvB_mem = ca_mem->cvB_mem; + while (cvB_mem != NULL) { + if ( which == cvB_mem->cv_index ) break; + cvB_mem = cvB_mem->cv_next; + } + + cvodeB_mem = (void *) (cvB_mem->cv_mem); + + /* Get memory for CVSpilsMemRecB */ + cvspilsB_mem = NULL; + cvspilsB_mem = (CVSpilsMemB) malloc(sizeof(struct CVSpilsMemRecB)); + if (cvspilsB_mem == NULL) { + cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPTFQMR", "CVSptfqmrB", MSGS_MEM_FAIL); + return(CVSPILS_MEM_FAIL); + } + + pset_B = NULL; + psolve_B = NULL; + P_data_B = NULL; + + /* initialize Jacobian function */ + jtimes_B = NULL; + + /* attach lmemB and lfreeB */ + cvB_mem->cv_lmem = cvspilsB_mem; + cvB_mem->cv_lfree = CVSptfqmrFreeB; + + flag = CVSptfqmr(cvodeB_mem, pretypeB, maxlB); + + if (flag != CVSPILS_SUCCESS) { + free(cvspilsB_mem); + cvspilsB_mem = NULL; + } + + return(flag); +} + +/* + * CVSptfqmrFreeB + */ + + +static void CVSptfqmrFreeB(CVodeBMem cvB_mem) +{ + CVSpilsMemB cvspilsB_mem; + + cvspilsB_mem = (CVSpilsMemB) (cvB_mem->cv_lmem); + + free(cvspilsB_mem); +} diff --git a/odemex/Parser/CVode/cv_src/src/nvec_par/CMakeLists.txt b/odemex/Parser/CVode/cv_src/src/nvec_par/CMakeLists.txt new file mode 100644 index 0000000..f5e359f --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/nvec_par/CMakeLists.txt @@ -0,0 +1,89 @@ +# --------------------------------------------------------------- +# $Revision: 1.3 $ +# $Date: 2009/02/17 02:58:48 $ +# --------------------------------------------------------------- +# Programmer: Radu Serban @ LLNL +# --------------------------------------------------------------- +# Copyright (c) 2007, The Regents of the University of California. +# Produced at the Lawrence Livermore National Laboratory. +# All rights reserved. +# For details, see the LICENSE file. +# --------------------------------------------------------------- +# CMakeLists.txt file for the parallel NVECTOR library + +INSTALL(CODE "MESSAGE(\"\nInstall NVECTOR_PARALLEL\n\")") + +IF(MPI_MPICC) + # use MPI_MPICC as the compiler + SET(CMAKE_C_COMPILER ${MPI_MPICC}) +ELSE(MPI_MPICC) + # add MPI_INCLUDE_PATH to include directories + INCLUDE_DIRECTORIES(${MPI_INCLUDE_PATH}) +ENDIF(MPI_MPICC) + +# Add variable nvecparallel_SOURCES with the sources for the NVECPARALLEL lib +SET(nvecparallel_SOURCES nvector_parallel.c) + +# Add variable shared_SOURCES with the common SUNDIALS sources which will +# also be included in the NVECPARALLEL library +SET(shared_SOURCES sundials_math.c) +ADD_PREFIX(${sundials_SOURCE_DIR}/src/sundials/ shared_SOURCES) + +# Add variable nvecparallel_HEADERS with the exported NVECPARALLEL header files +SET(nvecparallel_HEADERS nvector_parallel.h) +ADD_PREFIX(${sundials_SOURCE_DIR}/include/nvector/ nvecparallel_HEADERS) + +# Add source directory to include directories +INCLUDE_DIRECTORIES(.) + +# Define C preprocessor flag -DBUILD_SUNDIALS_LIBRARY +ADD_DEFINITIONS(-DBUILD_SUNDIALS_LIBRARY) + +# Rules for building and installing the static library: +# - Add the build target for the NVECPARALLEL library +# - Set the library name and make sure it is not deleted +# - Install the NVECSERIAL library +IF(BUILD_STATIC_LIBS) + ADD_LIBRARY(sundials_nvecparallel_static STATIC ${nvecparallel_SOURCES} ${shared_SOURCES}) + SET_TARGET_PROPERTIES(sundials_nvecparallel_static + PROPERTIES OUTPUT_NAME sundials_nvecparallel CLEAN_DIRECT_OUTPUT 1) + INSTALL(TARGETS sundials_nvecparallel_static DESTINATION lib) +ENDIF(BUILD_STATIC_LIBS) + +# Rules for building and installing the shared library: +# - Add the build target for the NVECPARALLEL library +# - Set the library name and make sure it is not deleted +# - Set VERSION and SOVERSION for shared libraries +# - Install the NVECSERIAL library +IF(BUILD_SHARED_LIBS) + ADD_LIBRARY(sundials_nvecparallel_shared SHARED ${nvecparallel_SOURCES} ${shared_SOURCES}) + SET_TARGET_PROPERTIES(sundials_nvecparallel_shared + PROPERTIES OUTPUT_NAME sundials_nvecparallel CLEAN_DIRECT_OUTPUT 1) + SET_TARGET_PROPERTIES(sundials_nvecparallel_shared + PROPERTIES VERSION ${nveclib_VERSION} SOVERSION ${nveclib_SOVERSION}) + INSTALL(TARGETS sundials_nvecparallel_shared DESTINATION lib) +ENDIF(BUILD_SHARED_LIBS) + +# Install the NVECPARALLEL header files +INSTALL(FILES ${nvecparallel_HEADERS} DESTINATION include/nvector) + +# If FCMIX is enabled and MPI-F77 works, build and install the FNVECPARALLEL library +IF(FCMIX_ENABLE AND MPIF_FOUND) + SET(fnvecparallel_SOURCES fnvector_parallel.c) + IF(BUILD_STATIC_LIBS) + ADD_LIBRARY(sundials_fnvecparallel_static STATIC ${fnvecparallel_SOURCES}) + SET_TARGET_PROPERTIES(sundials_fnvecparallel_static + PROPERTIES OUTPUT_NAME sundials_fnvecparallel CLEAN_DIRECT_OUTPUT 1) + INSTALL(TARGETS sundials_fnvecparallel_static DESTINATION lib) + ENDIF(BUILD_STATIC_LIBS) + IF(BUILD_SHARED_LIBS) + ADD_LIBRARY(sundials_fnvecparallel_shared SHARED ${fnvecparallel_SOURCES}) + SET_TARGET_PROPERTIES(sundials_fnvecparallel_shared + PROPERTIES OUTPUT_NAME sundials_fnvecparallel CLEAN_DIRECT_OUTPUT 1) + SET_TARGET_PROPERTIES(sundials_fnvecparallel_shared + PROPERTIES VERSION ${nveclib_VERSION} SOVERSION ${nveclib_SOVERSION}) + INSTALL(TARGETS sundials_fnvecparallel_shared DESTINATION lib) + ENDIF(BUILD_SHARED_LIBS) +ENDIF(FCMIX_ENABLE AND MPIF_FOUND) +# +MESSAGE(STATUS "Added NVECTOR_PARALLEL module") diff --git a/odemex/Parser/CVode/cv_src/src/nvec_par/Makefile.in b/odemex/Parser/CVode/cv_src/src/nvec_par/Makefile.in new file mode 100644 index 0000000..bd7ea4f --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/nvec_par/Makefile.in @@ -0,0 +1,128 @@ +# ----------------------------------------------------------------- +# $Revision: 1.8 $ +# $Date: 2007/01/29 17:36:28 $ +# ----------------------------------------------------------------- +# Programmer(s): Radu Serban and Aaron Collier @ LLNL +# ----------------------------------------------------------------- +# Copyright (c) 2002, The Regents of the University of California. +# Produced at the Lawrence Livermore National Laboratory. +# All rights reserved. +# For details, see the LICENSE file. +# ----------------------------------------------------------------- +# Makefile for parallel NVECTOR module +# +# @configure_input@ +# ----------------------------------------------------------------- + +SHELL = @SHELL@ + +@SET_MAKE@ + +srcdir = @srcdir@ +builddir = @builddir@ +abs_builddir = @abs_builddir@ +top_builddir = @top_builddir@ +prefix = @prefix@ +exec_prefix = @exec_prefix@ +includedir = @includedir@ +libdir = @libdir@ + +INSTALL = @INSTALL@ +INSTALL_LIB = @INSTALL_PROGRAM@ +INSTALL_HEADER = @INSTALL_DATA@ + +LIBTOOL = @LIBTOOL@ +LIBTOOL_DEPS = @LIBTOOL_DEPS@ + +MPICC = @MPICC@ +MPI_INC_DIR = @MPI_INC_DIR@ +MPI_LIB_DIR = @MPI_LIB_DIR@ +MPI_LIBS = @MPI_LIBS@ +MPI_FLAGS = @MPI_FLAGS@ +CPPFLAGS = @CPPFLAGS@ +CFLAGS = @CFLAGS@ +LDFLAGS = @LDFLAGS@ +LIBS = @LIBS@ + +FCMIX_ENABLED = @FCMIX_ENABLED@ + +top_srcdir = $(srcdir)/../.. + +INCLUDES = -I$(top_srcdir)/include -I$(top_builddir)/include -I$(MPI_INC_DIR) + +LIB_REVISION = 0:2:0 + +NVECPAR_LIB = libsundials_nvecparallel.la +NVECPAR_LIB_FILES = nvector_parallel.lo + +FNVECPAR_LIB = libsundials_fnvecparallel.la +FNVECPAR_LIB_FILES = fnvector_parallel.lo + +SHARED_LIB_FILES = $(top_builddir)/src/sundials/sundials_math.lo + +mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs +rminstalldirs = $(SHELL) $(top_srcdir)/config/rminstalldirs + +all: $(NVECPAR_LIB) $(FNVECPAR_LIB) + +$(NVECPAR_LIB): shared $(NVECPAR_LIB_FILES) + $(LIBTOOL) --mode=link $(MPICC) $(CFLAGS) $(MPI_FLAGS) -o $(NVECPAR_LIB) $(NVECPAR_LIB_FILES) $(SHARED_LIB_FILES) $(LDFLAGS) -L$(MPI_LIB_DIR) $(MPI_LIBS) $(LIBS) -rpath $(libdir) -version-info $(LIB_REVISION) + +$(FNVECPAR_LIB): $(FNVECPAR_LIB_FILES) + @if test "X${FCMIX_ENABLED}" = "Xyes"; then \ + echo "${LIBTOOL} --mode=link ${MPICC} ${CFLAGS} ${MPI_FLAGS} -o ${FNVECPAR_LIB} ${FNVECPAR_LIB_FILES} ${SHARED_LIB_FILES} ${LDFLAGS} -L${MPI_LIB_DIR} ${MPI_LIBS} ${LIBS} -rpath ${libdir} -version-info ${LIB_REVISION}" ; \ + ${LIBTOOL} --mode=link ${MPICC} ${CFLAGS} ${MPI_FLAGS} -o ${FNVECPAR_LIB} ${FNVECPAR_LIB_FILES} ${SHARED_LIB_FILES} ${LDFLAGS} -L${MPI_LIB_DIR} ${MPI_LIBS} ${LIBS} -rpath ${libdir} -version-info ${LIB_REVISION} ; \ + fi + +install: $(NVECPAR_LIB) $(FNVECPAR_LIB) + $(mkinstalldirs) $(includedir)/nvector + $(mkinstalldirs) $(libdir) + $(LIBTOOL) --mode=install $(INSTALL_LIB) $(NVECPAR_LIB) $(libdir) + $(INSTALL_HEADER) $(top_srcdir)/include/nvector/nvector_parallel.h $(includedir)/nvector/ + @if test "X${FCMIX_ENABLED}" = "Xyes"; then \ + echo "${LIBTOOL} --mode=install ${INSTALL_LIB} ${FNVECPAR_LIB} ${libdir}" ; \ + ${LIBTOOL} --mode=install ${INSTALL_LIB} ${FNVECPAR_LIB} ${libdir} ; \ + fi + +uninstall: + $(LIBTOOL) --mode=uninstall rm -f $(libdir)/$(NVECPAR_LIB) + @if test "X${FCMIX_ENABLED}" = "Xyes"; then \ + echo "${LIBTOOL} --mode=uninstall rm -f ${libdir}/${FNVECPAR_LIB}" ; \ + ${LIBTOOL} --mode=uninstall rm -f ${libdir}/${FNVECPAR_LIB} ; \ + fi + rm -f $(includedir)/nvector/nvector_parallel.h + $(rminstalldirs) ${includedir}/nvector + +shared: + @cd ${top_builddir}/src/sundials ; \ + ${MAKE} ; \ + cd ${abs_builddir} + +clean: + $(LIBTOOL) --mode=clean rm -f $(NVECPAR_LIB) + rm -f $(NVECPAR_LIB_FILES) + rm -f nvector_parallel.o + @if test "X${FCMIX_ENABLED}" = "Xyes"; then \ + echo "${LIBTOOL} --mode=clean rm -f ${FNVECPAR_LIB}" ; \ + ${LIBTOOL} --mode=clean rm -f ${FNVECPAR_LIB} ; \ + echo "rm -f ${FNVECPAR_LIB_FILES}" ; \ + rm -f ${FNVECPAR_LIB_FILES} ; \ + echo "rm -f fnvector_parallel.o" ; \ + rm -f fnvector_parallel.o ; \ + fi + +distclean: clean + rm -f Makefile + +nvector_parallel.lo: $(srcdir)/nvector_parallel.c + $(LIBTOOL) --mode=compile $(MPICC) $(CPPFLAGS) $(MPI_FLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/nvector_parallel.c +fnvector_parallel.lo: $(srcdir)/fnvector_parallel.c + @if test "X${FCMIX_ENABLED}" = "Xyes"; then \ + echo "${LIBTOOL} --mode=compile ${MPICC} ${CPPFLAGS} ${MPI_FLAGS} $(INCLUDES) ${CFLAGS} -c ${srcdir}/fnvector_parallel.c" ; \ + ${LIBTOOL} --mode=compile ${MPICC} ${CPPFLAGS} ${MPI_FLAGS} $(INCLUDES) ${CFLAGS} -c ${srcdir}/fnvector_parallel.c ; \ + fi + +libtool: $(top_builddir)/$(LIBTOOL_DEPS) + @cd ${top_builddir} ; \ + ${SHELL} ./config.status --recheck ; \ + cd ${abs_builddir} diff --git a/odemex/Parser/CVode/cv_src/src/nvec_par/README b/odemex/Parser/CVode/cv_src/src/nvec_par/README new file mode 100644 index 0000000..726603e --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/nvec_par/README @@ -0,0 +1,135 @@ + NVECTOR_PARALLEL + Release 2.4.0, January 2008 + +MPI parallel implementation of the NVECTOR module for SUNDIALS. + +NVECTOR_PARALLEL defines the content field of N_Vector to be a structure +containing the global and local lengths of the vector, a pointer to the +beginning of a contiguous local data array, an MPI communicator, and a +boolean flag indicating ownership of the data array. + +NVECTOR_PARALLEL defines seven macros to provide access to the content of +a parallel N_Vector, several constructors for variables of type N_Vector, +a constructor for an array of variables of type N_Vector, and destructors +for N_Vector and N_Vector array. + +NVECTOR_PARALLEL provides implementations for all vector operations defined +by the generic NVECTOR module in the table of operations. + + +A. Documentation +---------------- + +The MPI parallel NVECTOR implementation is fully described in the user documentation +for any of the SUNDIALS solvers [1-5]. A PDF file for the user guide for a particular +solver is available in the solver's subdirectory under doc/. + + +B. Installation +--------------- + +For basic installation instructions see /sundials/INSTALL_NOTES. +For complete installation instructions see any of the user guides. + + +C. References +------------- + +[1] A. C. Hindmarsh and R. Serban, "User Documentation for CVODE v2.4.0," + LLLNL technical report UCRL-MA-208108, November 2004. + +[2] A. C. Hindmarsh and R. Serban, "User Documentation for CVODES v2.4.0," + LLNL technical report UCRL-MA-208111, November 2004. + +[3] A. C. Hindmarsh and R. Serban, "User Documentation for IDA v2.4.0," + LLNL technical report UCRL-MA-208112, November 2004. + +[4] R. Serban and C. Petra, "User Documentation for IDAS v1.0.0," + LLNL technical report UCRL-SM-234051, August 2007. + +[5] A. M. Collier, A. C. Hindmarsh, R. Serban,and C. S. Woodward, "User + Documentation for KINSOL v2.4.0," LLNL technical report UCRL-MA-208116, + November 2004. + + +D. Releases +----------- + +v. 2.4.0 - Jan. 2008 +v. 2.3.0 - Nov. 2006 +v. 2.2.0 - Mar. 2006 +v. 2.1.1 - May. 2005 +v. 2.1.0 - Apr. 2005 +v. 2.0.2 - Mar. 2005 +v. 2.0.1 - Jan. 2005 +v. 2.0 - Dec. 2004 +v. 1.0 - Jul. 2002 (first SUNDIALS release) + + +E. Revision History +------------------- + +v. 2.3.0 (Nov. 2006) ---> v. 2.4.0 (Jan. 2008) +--------------------------------------------------------- + +- none + +v. 2.2.0 (Mar. 2006) ---> v. 2.3.0 (Nov. 2006) +---------------------------------------------- + +- Changes related to the build system + - reorganized source tree. Header files in ${srcdir}/include/nvector; + sources in ${srcdir}/src/nvec_par + - exported header files in ${includedir}/sundials + +v. 2.1.1 (May. 2005) ---> v. 2.2.0 (Mar. 2006) +---------------------------------------------- + +- none + +v. 2.1.0 (Apr. 2005) ---> v. 2.1.1 (May. 2005) +---------------------------------------------- + +- Changes to user interface + - added argument to initialization routines to allow user to specify a + different MPI communicator + +- Changes to data structures + - added N_VCloneEmpty to global vector operations table + +v. 2.0.2 (Mar. 2005) ---> v. 2.1.0 (Apr. 2005) +---------------------------------------------- + +- none + +v. 2.0.1 (Jan. 2005) ---> v. 2.0.2 (Mar. 2005) +---------------------------------------------- + +- Changes related to the build system + - fixed autoconf-related bug to allow configuration with the PGI Fortran compiler + - modified to use customized detection of the Fortran name mangling scheme + (autoconf's AC_F77_WRAPPERS routine is problematic on some platforms) + - added --with-mpi-flags as a configure option to allow user to specify + MPI-specific flags + - updated Makefiles for Fortran examples to avoid C++ compiler errors (now use + CC and MPICC to link) + +v. 2.0 (Dec. 2004) ---> v. 2.0.1 (Jan. 2005) +-------------------------------------------- + +- Changes related to the build system + - changed order of compiler directives in header files to avoid compilation + errors when using a C++ compiler. + +v. 1.0 (Jul. 2002) ---> v. 2.0 (Dec. 2004) +------------------------------------------ + +- Revised to correspond to new generic NVECTOR module + (see sundials/shared/README). +- Extended the list of user-callable functions provided by NVECTOR_PARALLEL + outside the table of vector operations. +- Revised parallel N_VMin and N_VMinQuotient to use BIG_REAL if + local N is 0 or no quotients found. +- Revised the F/C interface to use underscore flags for name mapping + and to use precision flag from configure. +- Revised F/C routine NVECTOR names for uniformity. diff --git a/odemex/Parser/CVode/cv_src/src/nvec_par/fnvector_parallel.c b/odemex/Parser/CVode/cv_src/src/nvec_par/fnvector_parallel.c new file mode 100644 index 0000000..6ece6b9 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/nvec_par/fnvector_parallel.c @@ -0,0 +1,182 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.1 $ + * $Date: 2006/07/05 15:32:37 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This file (companion of nvector_parallel.h) contains the + * implementation needed for the Fortran initialization of parallel + * vector operations. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "fnvector_parallel.h" + +/* Define global vector variables */ + +N_Vector F2C_CVODE_vec; +N_Vector F2C_CVODE_vecQ; +N_Vector *F2C_CVODE_vecS; +N_Vector F2C_CVODE_vecB; +N_Vector F2C_CVODE_vecQB; + +N_Vector F2C_IDA_vec; +N_Vector F2C_IDA_vecQ; +N_Vector *F2C_IDA_vecS; +N_Vector F2C_IDA_vecB; +N_Vector F2C_IDA_vecQB; + +N_Vector F2C_KINSOL_vec; + +#ifndef SUNDIALS_MPI_COMM_F2C +#define MPI_Fint int +#endif + +/* Fortran callable interfaces */ + +void FNV_INITP(MPI_Fint *comm, int *code, long int *L, long int *N, int *ier) +{ + MPI_Comm F2C_comm; + +#ifdef SUNDIALS_MPI_COMM_F2C + F2C_comm = MPI_Comm_f2c(*comm); +#else + F2C_comm = MPI_COMM_WORLD; +#endif + + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + F2C_CVODE_vec = NULL; + F2C_CVODE_vec = N_VNewEmpty_Parallel(F2C_comm, *L, *N); + if (F2C_CVODE_vec == NULL) *ier = -1; + break; + case FCMIX_IDA: + F2C_IDA_vec = NULL; + F2C_IDA_vec = N_VNewEmpty_Parallel(F2C_comm, *L, *N); + if (F2C_IDA_vec == NULL) *ier = -1; + break; + case FCMIX_KINSOL: + F2C_KINSOL_vec = NULL; + F2C_KINSOL_vec = N_VNewEmpty_Parallel(F2C_comm, *L, *N); + if (F2C_KINSOL_vec == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + +void FNV_INITP_Q(MPI_Fint *comm, int *code, long int *Lq, long int *Nq, int *ier) +{ + MPI_Comm F2C_comm; + +#ifdef SUNDIALS_MPI_COMM_F2C + F2C_comm = MPI_Comm_f2c(*comm); +#else + F2C_comm = MPI_COMM_WORLD; +#endif + + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + F2C_CVODE_vecQ = NULL; + F2C_CVODE_vecQ = N_VNewEmpty_Parallel(F2C_comm, *Lq, *Nq); + if (F2C_CVODE_vecQ == NULL) *ier = -1; + break; + case FCMIX_IDA: + F2C_IDA_vecQ = NULL; + F2C_IDA_vecQ = N_VNewEmpty_Parallel(F2C_comm, *Lq, *Nq); + if (F2C_IDA_vecQ == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + +void FNV_INITP_B(MPI_Fint *comm, int *code, long int *LB, long int *NB, int *ier) +{ + MPI_Comm F2C_comm; + +#ifdef SUNDIALS_MPI_COMM_F2C + F2C_comm = MPI_Comm_f2c(*comm); +#else + F2C_comm = MPI_COMM_WORLD; +#endif + + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + F2C_CVODE_vecB = NULL; + F2C_CVODE_vecB = N_VNewEmpty_Parallel(F2C_comm, *LB, *NB); + if (F2C_CVODE_vecB == NULL) *ier = -1; + break; + case FCMIX_IDA: + F2C_IDA_vecB = NULL; + F2C_IDA_vecB = N_VNewEmpty_Parallel(F2C_comm, *LB, *NB); + if (F2C_IDA_vecB == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + +void FNV_INITP_QB(MPI_Fint *comm, int *code, long int *LqB, long int *NqB, int *ier) +{ + MPI_Comm F2C_comm; + +#ifdef SUNDIALS_MPI_COMM_F2C + F2C_comm = MPI_Comm_f2c(*comm); +#else + F2C_comm = MPI_COMM_WORLD; +#endif + + + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + F2C_CVODE_vecQB = NULL; + F2C_CVODE_vecQB = N_VNewEmpty_Parallel(F2C_comm, *LqB, *NqB); + if (F2C_CVODE_vecQB == NULL) *ier = -1; + break; + case FCMIX_IDA: + F2C_IDA_vecQB = NULL; + F2C_IDA_vecQB = N_VNewEmpty_Parallel(F2C_comm, *LqB, *NqB); + if (F2C_IDA_vecQB == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + +void FNV_INITP_S(int *code, int *Ns, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + F2C_CVODE_vecS = NULL; + F2C_CVODE_vecS = (N_Vector *) N_VCloneVectorArrayEmpty_Parallel(*Ns, F2C_CVODE_vec); + if (F2C_CVODE_vecS == NULL) *ier = -1; + break; + case FCMIX_IDA: + F2C_IDA_vecS = NULL; + F2C_IDA_vecS = (N_Vector *) N_VCloneVectorArrayEmpty_Parallel(*Ns, F2C_IDA_vec); + if (F2C_IDA_vecS == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} diff --git a/odemex/Parser/CVode/cv_src/src/nvec_par/fnvector_parallel.h b/odemex/Parser/CVode/cv_src/src/nvec_par/fnvector_parallel.h new file mode 100644 index 0000000..79837bb --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/nvec_par/fnvector_parallel.h @@ -0,0 +1,88 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.3 $ + * $Date: 2006/11/29 00:05:09 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This file (companion of nvector_parallel.c) contains the + * definitions needed for the initialization of parallel + * vector operations in Fortran. + * ----------------------------------------------------------------- + */ + +#ifndef _FNVECTOR_PARALLEL_H +#define _FNVECTOR_PARALLEL_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +#if defined(F77_FUNC) + +#define FNV_INITP F77_FUNC(fnvinitp, FNVINITP) +#define FNV_INITP_Q F77_FUNC_(fnvinitp_q, FNVINITP_Q) +#define FNV_INITP_S F77_FUNC_(fnvinitp_s, FNVINITP_S) +#define FNV_INITP_B F77_FUNC_(fnvinitp_b, FNVINITP_B) +#define FNV_INITP_QB F77_FUNC_(fnvinitp_qb, FNVINITP_QB) + +#else + +#define FNV_INITP fnvinitp_ +#define FNV_INITP_Q fnvinitp_q_ +#define FNV_INITP_S fnvinitp_s_ +#define FNV_INITP_B fnvinitp_b_ +#define FNV_INITP_QB fnvinitp_qb_ + +#endif + +/* Declarations of global variables */ + +extern N_Vector F2C_CVODE_vec; +extern N_Vector F2C_CVODE_vecQ; +extern N_Vector *F2C_CVODE_vecS; +extern N_Vector F2C_CVODE_vecB; +extern N_Vector F2C_CVODE_vecQB; + +extern N_Vector F2C_IDA_vec; +extern N_Vector F2C_IDA_vecQ; +extern N_Vector *F2C_IDA_vecS; +extern N_Vector F2C_IDA_vecB; +extern N_Vector F2C_IDA_vecQB; + +extern N_Vector F2C_KINSOL_vec; + +/* + * Prototypes of exported functions + * + * FNV_INITP - initializes parallel vector operations for main problem + * FNV_INITP_Q - initializes parallel vector operations for quadratures + * FNV_INITP_S - initializes parallel vector operations for sensitivities + * FNV_INITP_B - initializes parallel vector operations for adjoint problem + * FNV_INITP_QB - initializes parallel vector operations for adjoint quadratures + * + */ + +#ifndef SUNDIALS_MPI_COMM_F2C +#define MPI_Fint int +#endif + +void FNV_INITP(MPI_Fint *comm, int *code, long int *L, long int *N, int *ier); +void FNV_INITP_Q(MPI_Fint *comm, int *code, long int *Lq, long int *Nq, int *ier); +void FNV_INITP_B(MPI_Fint *comm, int *code, long int *LB, long int *NB, int *ier); +void FNV_INITP_QB(MPI_Fint *comm, int *code, long int *LqB, long int *NqB, int *ier); +void FNV_INITP_S(int *code, int *Ns, int *ier); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/src/nvec_par/nvector_parallel.c b/odemex/Parser/CVode/cv_src/src/nvec_par/nvector_parallel.c new file mode 100644 index 0000000..8a53fab --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/nvec_par/nvector_parallel.c @@ -0,0 +1,1152 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.1 $ + * $Date: 2006/07/05 15:32:37 $ + * ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, Radu Serban, + * and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for a parallel MPI implementation + * of the NVECTOR package. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include +#include + +#define ZERO RCONST(0.0) +#define HALF RCONST(0.5) +#define ONE RCONST(1.0) +#define ONEPT5 RCONST(1.5) + +/* Error Message */ + +#define BAD_N1 "N_VNew_Parallel -- Sum of local vector lengths differs from " +#define BAD_N2 "input global length. \n\n" +#define BAD_N BAD_N1 BAD_N2 + +/* Private function prototypes */ + +/* Reduction operations add/max/min over the processor group */ +static realtype VAllReduce_Parallel(realtype d, int op, MPI_Comm comm); +/* z=x */ +static void VCopy_Parallel(N_Vector x, N_Vector z); +/* z=x+y */ +static void VSum_Parallel(N_Vector x, N_Vector y, N_Vector z); +/* z=x-y */ +static void VDiff_Parallel(N_Vector x, N_Vector y, N_Vector z); +/* z=-x */ +static void VNeg_Parallel(N_Vector x, N_Vector z); +/* z=c(x+y) */ +static void VScaleSum_Parallel(realtype c, N_Vector x, N_Vector y, N_Vector z); +/* z=c(x-y) */ +static void VScaleDiff_Parallel(realtype c, N_Vector x, N_Vector y, N_Vector z); +/* z=ax+y */ +static void VLin1_Parallel(realtype a, N_Vector x, N_Vector y, N_Vector z); +/* z=ax-y */ +static void VLin2_Parallel(realtype a, N_Vector x, N_Vector y, N_Vector z); +/* y <- ax+y */ +static void Vaxpy_Parallel(realtype a, N_Vector x, N_Vector y); +/* x <- ax */ +static void VScaleBy_Parallel(realtype a, N_Vector x); + +/* + * ----------------------------------------------------------------- + * exported functions + * ----------------------------------------------------------------- + */ + +/* ---------------------------------------------------------------- + * Function to create a new parallel vector with empty data array + */ + +N_Vector N_VNewEmpty_Parallel(MPI_Comm comm, + long int local_length, + long int global_length) +{ + N_Vector v; + N_Vector_Ops ops; + N_VectorContent_Parallel content; + long int n, Nsum; + + /* Compute global length as sum of local lengths */ + n = local_length; + MPI_Allreduce(&n, &Nsum, 1, PVEC_INTEGER_MPI_TYPE, MPI_SUM, comm); + if (Nsum != global_length) { + printf(BAD_N); + return(NULL); + } + + /* Create vector */ + v = NULL; + v = (N_Vector) malloc(sizeof *v); + if (v == NULL) return(NULL); + + /* Create vector operation structure */ + ops = NULL; + ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); + if (ops == NULL) { free(v); return(NULL); } + + ops->nvclone = N_VClone_Parallel; + ops->nvcloneempty = N_VCloneEmpty_Parallel; + ops->nvdestroy = N_VDestroy_Parallel; + ops->nvspace = N_VSpace_Parallel; + ops->nvgetarraypointer = N_VGetArrayPointer_Parallel; + ops->nvsetarraypointer = N_VSetArrayPointer_Parallel; + ops->nvlinearsum = N_VLinearSum_Parallel; + ops->nvconst = N_VConst_Parallel; + ops->nvprod = N_VProd_Parallel; + ops->nvdiv = N_VDiv_Parallel; + ops->nvscale = N_VScale_Parallel; + ops->nvabs = N_VAbs_Parallel; + ops->nvinv = N_VInv_Parallel; + ops->nvaddconst = N_VAddConst_Parallel; + ops->nvdotprod = N_VDotProd_Parallel; + ops->nvmaxnorm = N_VMaxNorm_Parallel; + ops->nvwrmsnormmask = N_VWrmsNormMask_Parallel; + ops->nvwrmsnorm = N_VWrmsNorm_Parallel; + ops->nvmin = N_VMin_Parallel; + ops->nvwl2norm = N_VWL2Norm_Parallel; + ops->nvl1norm = N_VL1Norm_Parallel; + ops->nvcompare = N_VCompare_Parallel; + ops->nvinvtest = N_VInvTest_Parallel; + ops->nvconstrmask = N_VConstrMask_Parallel; + ops->nvminquotient = N_VMinQuotient_Parallel; + + /* Create content */ + content = NULL; + content = (N_VectorContent_Parallel) malloc(sizeof(struct _N_VectorContent_Parallel)); + if (content == NULL) { free(ops); free(v); return(NULL); } + + /* Attach lengths and communicator */ + content->local_length = local_length; + content->global_length = global_length; + content->comm = comm; + content->own_data = FALSE; + content->data = NULL; + + /* Attach content and ops */ + v->content = content; + v->ops = ops; + + return(v); +} + +/* ---------------------------------------------------------------- + * Function to create a new parallel vector + */ + +N_Vector N_VNew_Parallel(MPI_Comm comm, + long int local_length, + long int global_length) +{ + N_Vector v; + realtype *data; + + v = NULL; + v = N_VNewEmpty_Parallel(comm, local_length, global_length); + if (v == NULL) return(NULL); + + /* Create data */ + if(local_length > 0) { + + /* Allocate memory */ + data = NULL; + data = (realtype *) malloc(local_length * sizeof(realtype)); + if(data == NULL) { N_VDestroy_Parallel(v); return(NULL); } + + /* Attach data */ + NV_OWN_DATA_P(v) = TRUE; + NV_DATA_P(v) = data; + + } + + return(v); +} + +/* ---------------------------------------------------------------- + * Function to create a parallel N_Vector with user data component + */ + +N_Vector N_VMake_Parallel(MPI_Comm comm, + long int local_length, + long int global_length, + realtype *v_data) +{ + N_Vector v; + + v = NULL; + v = N_VNewEmpty_Parallel(comm, local_length, global_length); + if (v == NULL) return(NULL); + + if (local_length > 0) { + /* Attach data */ + NV_OWN_DATA_P(v) = FALSE; + NV_DATA_P(v) = v_data; + } + + return(v); +} + +/* ---------------------------------------------------------------- + * Function to create an array of new parallel vectors. + */ + +N_Vector *N_VCloneVectorArray_Parallel(int count, N_Vector w) +{ + N_Vector *vs; + int j; + + if (count <= 0) return(NULL); + + vs = NULL; + vs = (N_Vector *) malloc(count * sizeof(N_Vector)); + if(vs == NULL) return(NULL); + + for (j = 0; j < count; j++) { + vs[j] = NULL; + vs[j] = N_VClone_Parallel(w); + if (vs[j] == NULL) { + N_VDestroyVectorArray_Parallel(vs, j-1); + return(NULL); + } + } + + return(vs); +} + +/* ---------------------------------------------------------------- + * Function to create an array of new parallel vectors with empty + * (NULL) data array. + */ + +N_Vector *N_VCloneVectorArrayEmpty_Parallel(int count, N_Vector w) +{ + N_Vector *vs; + int j; + + if (count <= 0) return(NULL); + + vs = NULL; + vs = (N_Vector *) malloc(count * sizeof(N_Vector)); + if(vs == NULL) return(NULL); + + for (j = 0; j < count; j++) { + vs[j] = NULL; + vs[j] = N_VCloneEmpty_Parallel(w); + if (vs[j] == NULL) { + N_VDestroyVectorArray_Parallel(vs, j-1); + return(NULL); + } + } + + return(vs); +} + +/* ---------------------------------------------------------------- + * Function to free an array created with N_VCloneVectorArray_Parallel + */ + +void N_VDestroyVectorArray_Parallel(N_Vector *vs, int count) +{ + int j; + + for (j = 0; j < count; j++) N_VDestroy_Parallel(vs[j]); + + free(vs); vs = NULL; + + return; +} + +/* ---------------------------------------------------------------- + * Function to print a parallel vector + */ + +void N_VPrint_Parallel(N_Vector x) +{ + long int i, N; + realtype *xd; + + xd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + + for (i = 0; i < N; i++) { +#if defined(SUNDIALS_EXTENDED_PRECISION) + printf("%Lg\n", xd[i]); +#elif defined(SUNDIALS_DOUBLE_PRECISION) + printf("%lg\n", xd[i]); +#else + printf("%g\n", xd[i]); +#endif + } + printf("\n"); + + return; +} + +/* + * ----------------------------------------------------------------- + * implementation of vector operations + * ----------------------------------------------------------------- + */ + +N_Vector N_VCloneEmpty_Parallel(N_Vector w) +{ + N_Vector v; + N_Vector_Ops ops; + N_VectorContent_Parallel content; + + if (w == NULL) return(NULL); + + /* Create vector */ + v = NULL; + v = (N_Vector) malloc(sizeof *v); + if (v == NULL) return(NULL); + + /* Create vector operation structure */ + ops = NULL; + ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); + if (ops == NULL) { free(v); return(NULL); } + + ops->nvclone = w->ops->nvclone; + ops->nvcloneempty = w->ops->nvcloneempty; + ops->nvdestroy = w->ops->nvdestroy; + ops->nvspace = w->ops->nvspace; + ops->nvgetarraypointer = w->ops->nvgetarraypointer; + ops->nvsetarraypointer = w->ops->nvsetarraypointer; + ops->nvlinearsum = w->ops->nvlinearsum; + ops->nvconst = w->ops->nvconst; + ops->nvprod = w->ops->nvprod; + ops->nvdiv = w->ops->nvdiv; + ops->nvscale = w->ops->nvscale; + ops->nvabs = w->ops->nvabs; + ops->nvinv = w->ops->nvinv; + ops->nvaddconst = w->ops->nvaddconst; + ops->nvdotprod = w->ops->nvdotprod; + ops->nvmaxnorm = w->ops->nvmaxnorm; + ops->nvwrmsnormmask = w->ops->nvwrmsnormmask; + ops->nvwrmsnorm = w->ops->nvwrmsnorm; + ops->nvmin = w->ops->nvmin; + ops->nvwl2norm = w->ops->nvwl2norm; + ops->nvl1norm = w->ops->nvl1norm; + ops->nvcompare = w->ops->nvcompare; + ops->nvinvtest = w->ops->nvinvtest; + ops->nvconstrmask = w->ops->nvconstrmask; + ops->nvminquotient = w->ops->nvminquotient; + + /* Create content */ + content = NULL; + content = (N_VectorContent_Parallel) malloc(sizeof(struct _N_VectorContent_Parallel)); + if (content == NULL) { free(ops); free(v); return(NULL); } + + /* Attach lengths and communicator */ + content->local_length = NV_LOCLENGTH_P(w); + content->global_length = NV_GLOBLENGTH_P(w); + content->comm = NV_COMM_P(w); + content->own_data = FALSE; + content->data = NULL; + + /* Attach content and ops */ + v->content = content; + v->ops = ops; + + return(v); +} + +N_Vector N_VClone_Parallel(N_Vector w) +{ + N_Vector v; + realtype *data; + long int local_length; + + v = NULL; + v = N_VCloneEmpty_Parallel(w); + if (v == NULL) return(NULL); + + local_length = NV_LOCLENGTH_P(w); + + /* Create data */ + if(local_length > 0) { + + /* Allocate memory */ + data = NULL; + data = (realtype *) malloc(local_length * sizeof(realtype)); + if(data == NULL) { N_VDestroy_Parallel(v); return(NULL); } + + /* Attach data */ + NV_OWN_DATA_P(v) = TRUE; + NV_DATA_P(v) = data; + } + + return(v); +} + +void N_VDestroy_Parallel(N_Vector v) +{ + if ((NV_OWN_DATA_P(v) == TRUE) && (NV_DATA_P(v) != NULL)) { + free(NV_DATA_P(v)); + NV_DATA_P(v) = NULL; + } + free(v->content); v->content = NULL; + free(v->ops); v->ops = NULL; + free(v); v = NULL; + + return; +} + +void N_VSpace_Parallel(N_Vector v, long int *lrw, long int *liw) +{ + MPI_Comm comm; + int npes; + + comm = NV_COMM_P(v); + MPI_Comm_size(comm, &npes); + + *lrw = NV_GLOBLENGTH_P(v); + *liw = 2*npes; + + return; +} + +realtype *N_VGetArrayPointer_Parallel(N_Vector v) +{ + return((realtype *) NV_DATA_P(v)); +} + +void N_VSetArrayPointer_Parallel(realtype *v_data, N_Vector v) +{ + if (NV_LOCLENGTH_P(v) > 0) NV_DATA_P(v) = v_data; + + return; +} + +void N_VLinearSum_Parallel(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z) +{ + long int i, N; + realtype c, *xd, *yd, *zd; + N_Vector v1, v2; + booleantype test; + + xd = yd = zd = NULL; + + if ((b == ONE) && (z == y)) { /* BLAS usage: axpy y <- ax+y */ + Vaxpy_Parallel(a, x, y); + return; + } + + if ((a == ONE) && (z == x)) { /* BLAS usage: axpy x <- by+x */ + Vaxpy_Parallel(b, y, x); + return; + } + + /* Case: a == b == 1.0 */ + + if ((a == ONE) && (b == ONE)) { + VSum_Parallel(x, y, z); + return; + } + + /* Cases: (1) a == 1.0, b = -1.0, (2) a == -1.0, b == 1.0 */ + + if ((test = ((a == ONE) && (b == -ONE))) || ((a == -ONE) && (b == ONE))) { + v1 = test ? y : x; + v2 = test ? x : y; + VDiff_Parallel(v2, v1, z); + return; + } + + /* Cases: (1) a == 1.0, b == other or 0.0, (2) a == other or 0.0, b == 1.0 */ + /* if a or b is 0.0, then user should have called N_VScale */ + + if ((test = (a == ONE)) || (b == ONE)) { + c = test ? b : a; + v1 = test ? y : x; + v2 = test ? x : y; + VLin1_Parallel(c, v1, v2, z); + return; + } + + /* Cases: (1) a == -1.0, b != 1.0, (2) a != 1.0, b == -1.0 */ + + if ((test = (a == -ONE)) || (b == -ONE)) { + c = test ? b : a; + v1 = test ? y : x; + v2 = test ? x : y; + VLin2_Parallel(c, v1, v2, z); + return; + } + + /* Case: a == b */ + /* catches case both a and b are 0.0 - user should have called N_VConst */ + + if (a == b) { + VScaleSum_Parallel(a, x, y, z); + return; + } + + /* Case: a == -b */ + + if (a == -b) { + VScaleDiff_Parallel(a, x, y, z); + return; + } + + /* Do all cases not handled above: + (1) a == other, b == 0.0 - user should have called N_VScale + (2) a == 0.0, b == other - user should have called N_VScale + (3) a,b == other, a !=b, a != -b */ + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + yd = NV_DATA_P(y); + zd = NV_DATA_P(z); + + for (i = 0; i < N; i++) + zd[i] = (a*xd[i])+(b*yd[i]); + + return; +} + +void N_VConst_Parallel(realtype c, N_Vector z) +{ + long int i, N; + realtype *zd; + + zd = NULL; + + N = NV_LOCLENGTH_P(z); + zd = NV_DATA_P(z); + + for (i = 0; i < N; i++) zd[i] = c; + + return; +} + +void N_VProd_Parallel(N_Vector x, N_Vector y, N_Vector z) +{ + long int i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + yd = NV_DATA_P(y); + zd = NV_DATA_P(z); + + for (i = 0; i < N; i++) + zd[i] = xd[i]*yd[i]; + + return; +} + +void N_VDiv_Parallel(N_Vector x, N_Vector y, N_Vector z) +{ + long int i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + yd = NV_DATA_P(y); + zd = NV_DATA_P(z); + + for (i = 0; i < N; i++) + zd[i] = xd[i]/yd[i]; + + return; +} + +void N_VScale_Parallel(realtype c, N_Vector x, N_Vector z) +{ + long int i, N; + realtype *xd, *zd; + + xd = zd = NULL; + + if (z == x) { /* BLAS usage: scale x <- cx */ + VScaleBy_Parallel(c, x); + return; + } + + if (c == ONE) { + VCopy_Parallel(x, z); + } else if (c == -ONE) { + VNeg_Parallel(x, z); + } else { + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + zd = NV_DATA_P(z); + for (i = 0; i < N; i++) + zd[i] = c*xd[i]; + } + + return; +} + +void N_VAbs_Parallel(N_Vector x, N_Vector z) +{ + long int i, N; + realtype *xd, *zd; + + xd = zd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + zd = NV_DATA_P(z); + + for (i = 0; i < N; i++) + zd[i] = ABS(xd[i]); + + return; +} + +void N_VInv_Parallel(N_Vector x, N_Vector z) +{ + long int i, N; + realtype *xd, *zd; + + xd = zd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + zd = NV_DATA_P(z); + + for (i = 0; i < N; i++) + zd[i] = ONE/xd[i]; + + return; +} + +void N_VAddConst_Parallel(N_Vector x, realtype b, N_Vector z) +{ + long int i, N; + realtype *xd, *zd; + + xd = zd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + zd = NV_DATA_P(z); + + for (i = 0; i < N; i++) zd[i] = xd[i]+b; + + return; +} + +realtype N_VDotProd_Parallel(N_Vector x, N_Vector y) +{ + long int i, N; + realtype sum, *xd, *yd, gsum; + MPI_Comm comm; + + sum = ZERO; + xd = yd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + yd = NV_DATA_P(y); + comm = NV_COMM_P(x); + + for (i = 0; i < N; i++) sum += xd[i]*yd[i]; + + gsum = VAllReduce_Parallel(sum, 1, comm); + + return(gsum); +} + +realtype N_VMaxNorm_Parallel(N_Vector x) +{ + long int i, N; + realtype max, *xd, gmax; + MPI_Comm comm; + + xd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + comm = NV_COMM_P(x); + + max = ZERO; + + for (i = 0; i < N; i++) { + if (ABS(xd[i]) > max) max = ABS(xd[i]); + } + + gmax = VAllReduce_Parallel(max, 2, comm); + + return(gmax); +} + +realtype N_VWrmsNorm_Parallel(N_Vector x, N_Vector w) +{ + long int i, N, N_global; + realtype sum, prodi, *xd, *wd, gsum; + MPI_Comm comm; + + sum = ZERO; + xd = wd = NULL; + + N = NV_LOCLENGTH_P(x); + N_global = NV_GLOBLENGTH_P(x); + xd = NV_DATA_P(x); + wd = NV_DATA_P(w); + comm = NV_COMM_P(x); + + for (i = 0; i < N; i++) { + prodi = xd[i]*wd[i]; + sum += SQR(prodi); + } + + gsum = VAllReduce_Parallel(sum, 1, comm); + + return(RSqrt(gsum/N_global)); +} + +realtype N_VWrmsNormMask_Parallel(N_Vector x, N_Vector w, N_Vector id) +{ + long int i, N, N_global; + realtype sum, prodi, *xd, *wd, *idd, gsum; + MPI_Comm comm; + + sum = ZERO; + xd = wd = idd = NULL; + + N = NV_LOCLENGTH_P(x); + N_global = NV_GLOBLENGTH_P(x); + xd = NV_DATA_P(x); + wd = NV_DATA_P(w); + idd = NV_DATA_P(id); + comm = NV_COMM_P(x); + + for (i = 0; i < N; i++) { + if (idd[i] > ZERO) { + prodi = xd[i]*wd[i]; + sum += SQR(prodi); + } + } + + gsum = VAllReduce_Parallel(sum, 1, comm); + + return(RSqrt(gsum/N_global)); +} + +realtype N_VMin_Parallel(N_Vector x) +{ + long int i, N; + realtype min, *xd, gmin; + MPI_Comm comm; + + xd = NULL; + + N = NV_LOCLENGTH_P(x); + comm = NV_COMM_P(x); + + min = BIG_REAL; + + if (N > 0) { + + xd = NV_DATA_P(x); + + min = xd[0]; + + for (i = 1; i < N; i++) { + if (xd[i] < min) min = xd[i]; + } + + } + + gmin = VAllReduce_Parallel(min, 3, comm); + + return(gmin); +} + +realtype N_VWL2Norm_Parallel(N_Vector x, N_Vector w) +{ + long int i, N; + realtype sum, prodi, *xd, *wd, gsum; + MPI_Comm comm; + + sum = ZERO; + xd = wd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + wd = NV_DATA_P(w); + comm = NV_COMM_P(x); + + for (i = 0; i < N; i++) { + prodi = xd[i]*wd[i]; + sum += SQR(prodi); + } + + gsum = VAllReduce_Parallel(sum, 1, comm); + + return(RSqrt(gsum)); +} + +realtype N_VL1Norm_Parallel(N_Vector x) +{ + long int i, N; + realtype sum, gsum, *xd; + MPI_Comm comm; + + sum = ZERO; + xd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + comm = NV_COMM_P(x); + + for (i = 0; i= c) ? ONE : ZERO; + } + + return; +} + +booleantype N_VInvTest_Parallel(N_Vector x, N_Vector z) +{ + long int i, N; + realtype *xd, *zd, val, gval; + MPI_Comm comm; + + xd = zd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + zd = NV_DATA_P(z); + comm = NV_COMM_P(x); + + val = ONE; + for (i = 0; i < N; i++) { + if (xd[i] == ZERO) + val = ZERO; + else + zd[i] = ONE/xd[i]; + } + + gval = VAllReduce_Parallel(val, 3, comm); + + if (gval == ZERO) + return(FALSE); + else + return(TRUE); +} + +booleantype N_VConstrMask_Parallel(N_Vector c, N_Vector x, N_Vector m) +{ + long int i, N; + realtype temp; + realtype *cd, *xd, *md; + MPI_Comm comm; + + cd = xd = md = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + cd = NV_DATA_P(c); + md = NV_DATA_P(m); + comm = NV_COMM_P(x); + + temp = ONE; + + for (i = 0; i < N; i++) { + md[i] = ZERO; + if (cd[i] == ZERO) continue; + if (cd[i] > ONEPT5 || cd[i] < -ONEPT5) { + if (xd[i]*cd[i] <= ZERO) { temp = ZERO; md[i] = ONE; } + continue; + } + if (cd[i] > HALF || cd[i] < -HALF) { + if (xd[i]*cd[i] < ZERO ) { temp = ZERO; md[i] = ONE; } + } + } + + temp = VAllReduce_Parallel(temp, 3, comm); + + if (temp == ONE) return(TRUE); + else return(FALSE); +} + +realtype N_VMinQuotient_Parallel(N_Vector num, N_Vector denom) +{ + booleantype notEvenOnce; + long int i, N; + realtype *nd, *dd, min; + MPI_Comm comm; + + nd = dd = NULL; + + N = NV_LOCLENGTH_P(num); + nd = NV_DATA_P(num); + dd = NV_DATA_P(denom); + comm = NV_COMM_P(num); + + notEvenOnce = TRUE; + min = BIG_REAL; + + for (i = 0; i < N; i++) { + if (dd[i] == ZERO) continue; + else { + if (!notEvenOnce) min = MIN(min, nd[i]/dd[i]); + else { + min = nd[i]/dd[i]; + notEvenOnce = FALSE; + } + } + } + + return(VAllReduce_Parallel(min, 3, comm)); +} + +/* + * ----------------------------------------------------------------- + * private functions + * ----------------------------------------------------------------- + */ + +static realtype VAllReduce_Parallel(realtype d, int op, MPI_Comm comm) +{ + /* + * This function does a global reduction. The operation is + * sum if op = 1, + * max if op = 2, + * min if op = 3. + * The operation is over all processors in the communicator + */ + + realtype out; + + switch (op) { + case 1: MPI_Allreduce(&d, &out, 1, PVEC_REAL_MPI_TYPE, MPI_SUM, comm); + break; + + case 2: MPI_Allreduce(&d, &out, 1, PVEC_REAL_MPI_TYPE, MPI_MAX, comm); + break; + + case 3: MPI_Allreduce(&d, &out, 1, PVEC_REAL_MPI_TYPE, MPI_MIN, comm); + break; + + default: break; + } + + return(out); +} + +static void VCopy_Parallel(N_Vector x, N_Vector z) +{ + long int i, N; + realtype *xd, *zd; + + xd = zd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + zd = NV_DATA_P(z); + + for (i = 0; i < N; i++) + zd[i] = xd[i]; + + return; +} + +static void VSum_Parallel(N_Vector x, N_Vector y, N_Vector z) +{ + long int i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + yd = NV_DATA_P(y); + zd = NV_DATA_P(z); + + for (i = 0; i < N; i++) + zd[i] = xd[i]+yd[i]; + + return; +} + +static void VDiff_Parallel(N_Vector x, N_Vector y, N_Vector z) +{ + long int i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + yd = NV_DATA_P(y); + zd = NV_DATA_P(z); + + for (i = 0; i < N; i++) + zd[i] = xd[i]-yd[i]; + + return; +} + +static void VNeg_Parallel(N_Vector x, N_Vector z) +{ + long int i, N; + realtype *xd, *zd; + + xd = zd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + zd = NV_DATA_P(z); + + for (i = 0; i < N; i++) + zd[i] = -xd[i]; + + return; +} + +static void VScaleSum_Parallel(realtype c, N_Vector x, N_Vector y, N_Vector z) +{ + long int i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + yd = NV_DATA_P(y); + zd = NV_DATA_P(z); + + for (i = 0; i < N; i++) + zd[i] = c*(xd[i]+yd[i]); + + return; +} + +static void VScaleDiff_Parallel(realtype c, N_Vector x, N_Vector y, N_Vector z) +{ + long int i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + yd = NV_DATA_P(y); + zd = NV_DATA_P(z); + + for (i = 0; i < N; i++) + zd[i] = c*(xd[i]-yd[i]); + + return; +} + +static void VLin1_Parallel(realtype a, N_Vector x, N_Vector y, N_Vector z) +{ + long int i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + yd = NV_DATA_P(y); + zd = NV_DATA_P(z); + + for (i = 0; i < N; i++) + zd[i] = (a*xd[i])+yd[i]; + + return; +} + +static void VLin2_Parallel(realtype a, N_Vector x, N_Vector y, N_Vector z) +{ + long int i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + yd = NV_DATA_P(y); + zd = NV_DATA_P(z); + + for (i = 0; i < N; i++) + zd[i] = (a*xd[i])-yd[i]; + + return; +} + +static void Vaxpy_Parallel(realtype a, N_Vector x, N_Vector y) +{ + long int i, N; + realtype *xd, *yd; + + xd = yd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + yd = NV_DATA_P(y); + + if (a == ONE) { + for (i = 0; i < N; i++) + yd[i] += xd[i]; + return; + } + + if (a == -ONE) { + for (i = 0; i < N; i++) + yd[i] -= xd[i]; + return; + } + + for (i = 0; i < N; i++) + yd[i] += a*xd[i]; + + return; +} + +static void VScaleBy_Parallel(realtype a, N_Vector x) +{ + long int i, N; + realtype *xd; + + xd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + + for (i = 0; i < N; i++) + xd[i] *= a; + + return; +} diff --git a/odemex/Parser/CVode/cv_src/src/nvec_ser/CMakeLists.txt b/odemex/Parser/CVode/cv_src/src/nvec_ser/CMakeLists.txt new file mode 100644 index 0000000..9c97be5 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/nvec_ser/CMakeLists.txt @@ -0,0 +1,82 @@ +# --------------------------------------------------------------- +# $Revision: 1.3 $ +# $Date: 2009/02/17 02:58:48 $ +# --------------------------------------------------------------- +# Programmer: Radu Serban @ LLNL +# --------------------------------------------------------------- +# Copyright (c) 2007, The Regents of the University of California. +# Produced at the Lawrence Livermore National Laboratory. +# All rights reserved. +# For details, see the LICENSE file. +# --------------------------------------------------------------- +# CMakeLists.txt file for the serial NVECTOR library + +INSTALL(CODE "MESSAGE(\"\nInstall NVECTOR_SERIAL\n\")") + +# Add variable nvecserial_SOURCES with the sources for the NVECSERIAL lib +SET(nvecserial_SOURCES nvector_serial.c) + +# Add variable shared_SOURCES with the common SUNDIALS sources which will +# also be included in the NVECSERIAL library +SET(shared_SOURCES sundials_math.c) +ADD_PREFIX(${sundials_SOURCE_DIR}/src/sundials/ shared_SOURCES) + +# Add variable nvecserial_HEADERS with the exported NVECSERIAL header files +SET(nvecserial_HEADERS nvector_serial.h) +ADD_PREFIX(${sundials_SOURCE_DIR}/include/nvector/ nvecserial_HEADERS) + +# Add source directory to include directories +INCLUDE_DIRECTORIES(.) + +# Define C preprocessor flag -DBUILD_SUNDIALS_LIBRARY +ADD_DEFINITIONS(-DBUILD_SUNDIALS_LIBRARY) + +# Rules for building and installing the static library: +# - Add the build target for the NVECSERIAL library +# - Set the library name and make sure it is not deleted +# - Install the NVECSERIAL library +IF(BUILD_STATIC_LIBS) + ADD_LIBRARY(sundials_nvecserial_static STATIC ${nvecserial_SOURCES} ${shared_SOURCES}) + SET_TARGET_PROPERTIES(sundials_nvecserial_static + PROPERTIES OUTPUT_NAME sundials_nvecserial CLEAN_DIRECT_OUTPUT 1) + INSTALL(TARGETS sundials_nvecserial_static DESTINATION lib) +ENDIF(BUILD_STATIC_LIBS) + +# Rules for building and installing the shared library: +# - Add the build target for the NVECSERIAL library +# - Set the library name and make sure it is not deleted +# - Set VERSION and SOVERSION for shared libraries +# - Install the NVECSERIAL library +IF(BUILD_SHARED_LIBS) + ADD_LIBRARY(sundials_nvecserial_shared SHARED ${nvecserial_SOURCES} ${shared_SOURCES}) + SET_TARGET_PROPERTIES(sundials_nvecserial_shared + PROPERTIES OUTPUT_NAME sundials_nvecserial CLEAN_DIRECT_OUTPUT 1) + SET_TARGET_PROPERTIES(sundials_nvecserial_shared + PROPERTIES VERSION ${nveclib_VERSION} SOVERSION ${nveclib_SOVERSION}) + INSTALL(TARGETS sundials_nvecserial_shared DESTINATION lib) +ENDIF(BUILD_SHARED_LIBS) + +# Install the NVECSERIAL header files +INSTALL(FILES ${nvecserial_HEADERS} DESTINATION include/nvector) + +# If FCMIX is enabled, build and install the FNVECSERIAL library +IF(FCMIX_ENABLE AND F77_FOUND) + SET(fnvecserial_SOURCES fnvector_serial.c) + IF(BUILD_STATIC_LIBS) + ADD_LIBRARY(sundials_fnvecserial_static STATIC ${fnvecserial_SOURCES}) + SET_TARGET_PROPERTIES(sundials_fnvecserial_static + PROPERTIES OUTPUT_NAME sundials_fnvecserial CLEAN_DIRECT_OUTPUT 1) + INSTALL(TARGETS sundials_fnvecserial_static DESTINATION lib) + ENDIF(BUILD_STATIC_LIBS) + IF(BUILD_SHARED_LIBS) + ADD_LIBRARY(sundials_fnvecserial_shared ${fnvecserial_SOURCES}) + SET_TARGET_PROPERTIES(sundials_fnvecserial_shared + PROPERTIES OUTPUT_NAME sundials_fnvecserial CLEAN_DIRECT_OUTPUT 1) + SET_TARGET_PROPERTIES(sundials_fnvecserial_shared + PROPERTIES VERSION ${nveclib_VERSION} SOVERSION ${nveclib_SOVERSION}) + INSTALL(TARGETS sundials_fnvecserial_shared DESTINATION lib) + ENDIF(BUILD_SHARED_LIBS) +ENDIF(FCMIX_ENABLE AND F77_FOUND) + +# +MESSAGE(STATUS "Added NVECTOR_SERIAL module") diff --git a/odemex/Parser/CVode/cv_src/src/nvec_ser/Makefile.in b/odemex/Parser/CVode/cv_src/src/nvec_ser/Makefile.in new file mode 100644 index 0000000..fe8a6dc --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/nvec_ser/Makefile.in @@ -0,0 +1,125 @@ +# ----------------------------------------------------------------- +# $Revision: 1.8 $ +# $Date: 2007/01/29 17:36:28 $ +# ----------------------------------------------------------------- +# Programmer(s): Radu Serban and Aaron Collier @ LLNL +# ----------------------------------------------------------------- +# Copyright (c) 2002, The Regents of the University of California. +# Produced at the Lawrence Livermore National Laboratory. +# All rights reserved. +# For details, see the LICENSE file. +# ----------------------------------------------------------------- +# Makefile for serial NVECTOR module +# +# @configure_input@ +# ----------------------------------------------------------------- + +SHELL = @SHELL@ + +@SET_MAKE@ + +srcdir = @srcdir@ +builddir = @builddir@ +abs_builddir = @abs_builddir@ +top_builddir = @top_builddir@ +prefix = @prefix@ +exec_prefix = @exec_prefix@ +includedir = @includedir@ +libdir = @libdir@ + +INSTALL = @INSTALL@ +INSTALL_LIB = @INSTALL_PROGRAM@ +INSTALL_HEADER = @INSTALL_DATA@ + +LIBTOOL = @LIBTOOL@ +LIBTOOL_DEPS = @LIBTOOL_DEPS@ + +CPP = @CPP@ +CPPFLAGS = @CPPFLAGS@ +CC = @CC@ +CFLAGS = @CFLAGS@ +LDFLAGS = @LDFLAGS@ +LIBS = @LIBS@ + +FCMIX_ENABLED = @FCMIX_ENABLED@ + +top_srcdir = $(srcdir)/../.. + +INCLUDES = -I$(top_srcdir)/include -I$(top_builddir)/include + +LIB_REVISION = 0:2:0 + +NVECSER_LIB = libsundials_nvecserial.la +NVECSER_LIB_FILES = nvector_serial.lo + +FNVECSER_LIB = libsundials_fnvecserial.la +FNVECSER_LIB_FILES = fnvector_serial.lo + +SHARED_LIB_FILES = $(top_builddir)/src/sundials/sundials_math.lo + +mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs +rminstalldirs = $(SHELL) $(top_srcdir)/config/rminstalldirs + +all: $(NVECSER_LIB) $(FNVECSER_LIB) + +$(NVECSER_LIB): shared $(NVECSER_LIB_FILES) + $(LIBTOOL) --mode=link $(CC) $(CFLAGS) -o $(NVECSER_LIB) $(NVECSER_LIB_FILES) $(SHARED_LIB_FILES) -rpath $(libdir) $(LDFLAGS) $(LIBS) -version-info $(LIB_REVISION) + +$(FNVECSER_LIB): $(FNVECSER_LIB_FILES) + @if test "X${FCMIX_ENABLED}" = "Xyes"; then \ + echo "${LIBTOOL} --mode=link ${CC} ${CFLAGS} -o ${FNVECSER_LIB} ${FNVECSER_LIB_FILES} ${SHARED_LIB_FILES} -rpath ${libdir} $(LDFLAGS) ${LIBS} -version-info ${LIB_REVISION}" ; \ + ${LIBTOOL} --mode=link ${CC} ${CFLAGS} -o ${FNVECSER_LIB} ${FNVECSER_LIB_FILES} ${SHARED_LIB_FILES} -rpath ${libdir} $(LDFLAGS) ${LIBS} -version-info ${LIB_REVISION} ; \ + fi + +install: $(NVECSER_LIB) $(FNVECSER_LIB) + $(mkinstalldirs) $(includedir)/nvector + $(mkinstalldirs) $(libdir) + $(LIBTOOL) --mode=install $(INSTALL_LIB) $(NVECSER_LIB) $(libdir) + $(INSTALL_HEADER) $(top_srcdir)/include/nvector/nvector_serial.h $(includedir)/nvector/ + @if test "X${FCMIX_ENABLED}" = "Xyes"; then \ + echo "${LIBTOOL} --mode=install ${INSTALL_LIB} ${FNVECSER_LIB} ${libdir}" ; \ + ${LIBTOOL} --mode=install ${INSTALL_LIB} ${FNVECSER_LIB} ${libdir} ; \ + fi + +uninstall: + $(LIBTOOL) --mode=uninstall rm -f $(libdir)/$(NVECSER_LIB) + @if test "X${FCMIX_ENABLED}" = "Xyes"; then \ + echo "${LIBTOOL} --mode=uninstall rm -f ${libdir}/${FNVECSER_LIB}" ; \ + ${LIBTOOL} --mode=uninstall rm -f ${libdir}/${FNVECSER_LIB} ; \ + fi + rm -f $(includedir)/nvector/nvector_serial.h + $(rminstalldirs) ${includedir}/nvector + +shared: + @cd ${top_builddir}/src/sundials ; \ + ${MAKE} ; \ + cd ${abs_builddir} + +clean: + $(LIBTOOL) --mode=clean rm -f $(NVECSER_LIB) + rm -f $(NVECSER_LIB_FILES) + rm -f nvector_serial.o + @if test "X${FCMIX_ENABLED}" = "Xyes"; then \ + echo "${LIBTOOL} --mode=clean rm -f ${FNVECSER_LIB}" ; \ + ${LIBTOOL} --mode=clean rm -f ${FNVECSER_LIB} ; \ + echo "rm -f ${FNVECSER_LIB_FILES}" ; \ + rm -f ${FNVECSER_LIB_FILES} ; \ + echo "rm -f fnvector_serial.o" ; \ + rm -f fnvector_serial.o ; \ + fi + +distclean: clean + rm -f Makefile + +nvector_serial.lo: $(srcdir)/nvector_serial.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/nvector_serial.c +fnvector_serial.lo: $(srcdir)/fnvector_serial.c + @if test "X${FCMIX_ENABLED}" = "Xyes"; then \ + echo "${LIBTOOL} --mode=compile ${CC} ${CPPFLAGS} $(INCLUDES) ${CFLAGS} -c ${srcdir}/fnvector_serial.c" ; \ + ${LIBTOOL} --mode=compile ${CC} ${CPPFLAGS} $(INCLUDES) ${CFLAGS} -c ${srcdir}/fnvector_serial.c ; \ + fi + +libtool: $(top_builddir)/$(LIBTOOL_DEPS) + @cd ${top_builddir} ; \ + ${SHELL} ./config.status --recheck ; \ + cd ${abs_builddir} diff --git a/odemex/Parser/CVode/cv_src/src/nvec_ser/README b/odemex/Parser/CVode/cv_src/src/nvec_ser/README new file mode 100644 index 0000000..03b7ee5 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/nvec_ser/README @@ -0,0 +1,131 @@ + NVECTOR_SERIAL + Release 2.4.0, January 2008 + +Serial implementation of the NVECTOR module for SUNDIALS. + +NVECTOR_SERIAL defines the content field of N_Vector to be a structure +containing the length of the vector, a pointer to the beginning of a +contiguous data array, and a boolean flag indicating ownership of the +data array. + +NVECTOR_SERIAL defines five macros to provide access to the content of +a serial N_Vector, several constructors for variables of type N_Vector, +a constructor for an array of variables of type N_Vector, and destructors +for N_Vector and N_Vector array. + +NVECTOR_SERIAL provides implementations for all vector operations defined +by the generic NVECTOR module in the table of operations. + + +A. Documentation +---------------- + +The serial NVECTOR implementation is fully described in the user documentation +for any of the SUNDIALS solvers [1-5]. A PDF file for the user guide for a +particular solver is available in the solver's subdirectory under doc/. + + +B. Installation +--------------- + +For basic installation instructions see /sundials/INSTALL_NOTES. +For complete installation instructions see any of the user guides. + + +C. References +------------- + +[1] A. C. Hindmarsh and R. Serban, "User Documentation for CVODE v2.4.0," + LLLNL technical report UCRL-MA-208108, November 2004. + +[2] A. C. Hindmarsh and R. Serban, "User Documentation for CVODES v2.4.0," + LLNL technical report UCRL-MA-208111, November 2004. + +[3] A. C. Hindmarsh and R. Serban, "User Documentation for IDA v2.4.0," + LLNL technical report UCRL-MA-208112, November 2004. + +[4] R. Serban and C. Petra, "User Documentation for IDAS v1.0.0," + LLNL technical report UCRL-SM-234051, August 2007. + +[5] A. M. Collier, A. C. Hindmarsh, R. Serban,and C. S. Woodward, "User + Documentation for KINSOL v2.4.0," LLNL technical report UCRL-MA-208116, + November 2004. + + +D. Releases +----------- + +v. 2.4.0 - Jan. 2008 +v. 2.3.0 - Nov. 2006 +v. 2.2.0 - Mar. 2006 +v. 2.1.1 - May. 2005 +v. 2.1.0 - Apr. 2005 +v. 2.0.2 - Mar. 2005 +v. 2.0.1 - Jan. 2005 +v. 2.0 - Dec. 2004 +v. 1.0 - Jul. 2002 (first SUNDIALS release) + + +E. Revision History +------------------- + +v. 2.3.0 (Nov. 2006) ---> v. 2.4.0 (Jan. 2008) +--------------------------------------------------------- + +- none + + +v. 2.2.0 (Mar. 2006) ---> v. 2.3.0 (Nov. 2006) +---------------------------------------------- + +- Changes related to the build system + - reorganized source tree. Header files in ${srcdir}/include/nvector; + sources in ${srcdir}/src/nvec_ser + - exported header files in ${includedir}/sundials + + +v. 2.1.1 (May. 2005) ---> v. 2.2.0 (Mar. 2006) +---------------------------------------------- + +- none + +v. 2.1.0 (Apr. 2005) ---> v. 2.1.1 (May. 2005) +---------------------------------------------- + +- Changes to data structures + - added N_VCloneEmpty to global vector operations table + +v. 2.0.2 (Mar. 2005) ---> v. 2.1.0 (Apr. 2005) +---------------------------------------------- + +- none + +v. 2.0.1 (Jan. 2005) ---> v. 2.0.2 (Mar. 2005) +---------------------------------------------- + +- Changes related to the build system + - fixed autoconf-related bug to allow configuration with the PGI Fortran compiler + - modified to use customized detection of the Fortran name mangling scheme + (autoconf's AC_F77_WRAPPERS routine is problematic on some platforms) + - added --with-mpi-flags as a configure option to allow user to specify + MPI-specific flags + - updated Makefiles for Fortran examples to avoid C++ compiler errors (now use + CC and MPICC to link) + +v. 2.0 (Dec. 2004) ---> v. 2.0.1 (Jan. 2005) +-------------------------------------------- + +- Changes related to the build system + - changed order of compiler directives in header files to avoid compilation + errors when using a C++ compiler. + +v. 1.0 (Jul. 2002) ---> v. 2.0 (Dec. 2004) +------------------------------------------ + +- Revised to correspond to new generic NVECTOR module + (see sundials/shared/README). +- Extended the list of user-callable functions provided by NVECTOR_SERIAL + outside the table of vector operations. +- Revised the F/C interface to use underscore flags for name mapping + and to use precision flag from configure. +- Revised F/C routine NVECTOR names for uniformity. diff --git a/odemex/Parser/CVode/cv_src/src/nvec_ser/fnvector_serial.c b/odemex/Parser/CVode/cv_src/src/nvec_ser/fnvector_serial.c new file mode 100644 index 0000000..8f83c80 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/nvec_ser/fnvector_serial.c @@ -0,0 +1,147 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.1 $ + * $Date: 2006/07/05 15:32:37 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This file (companion of nvector_serial.h) contains the + * implementation needed for the Fortran initialization of serial + * vector operations. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "fnvector_serial.h" + +/* Define global vector variables */ + +N_Vector F2C_CVODE_vec; +N_Vector F2C_CVODE_vecQ; +N_Vector *F2C_CVODE_vecS; +N_Vector F2C_CVODE_vecB; +N_Vector F2C_CVODE_vecQB; + +N_Vector F2C_IDA_vec; +N_Vector F2C_IDA_vecQ; +N_Vector *F2C_IDA_vecS; +N_Vector F2C_IDA_vecB; +N_Vector F2C_IDA_vecQB; + +N_Vector F2C_KINSOL_vec; + +/* Fortran callable interfaces */ + +void FNV_INITS(int *code, long int *N, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + F2C_CVODE_vec = NULL; + F2C_CVODE_vec = N_VNewEmpty_Serial(*N); + if (F2C_CVODE_vec == NULL) *ier = -1; + break; + case FCMIX_IDA: + F2C_IDA_vec = NULL; + F2C_IDA_vec = N_VNewEmpty_Serial(*N); + if (F2C_IDA_vec == NULL) *ier = -1; + break; + case FCMIX_KINSOL: + F2C_KINSOL_vec = NULL; + F2C_KINSOL_vec = N_VNewEmpty_Serial(*N); + if (F2C_KINSOL_vec == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + +void FNV_INITS_Q(int *code, long int *Nq, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + F2C_CVODE_vecQ = NULL; + F2C_CVODE_vecQ = N_VNewEmpty_Serial(*Nq); + if (F2C_CVODE_vecQ == NULL) *ier = -1; + break; + case FCMIX_IDA: + F2C_IDA_vecQ = NULL; + F2C_IDA_vecQ = N_VNewEmpty_Serial(*Nq); + if (F2C_IDA_vecQ == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + +void FNV_INITS_B(int *code, long int *NB, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + F2C_CVODE_vecB = NULL; + F2C_CVODE_vecB = N_VNewEmpty_Serial(*NB); + if (F2C_CVODE_vecB == NULL) *ier = -1; + break; + case FCMIX_IDA: + F2C_IDA_vecB = NULL; + F2C_IDA_vecB = N_VNewEmpty_Serial(*NB); + if (F2C_IDA_vecB == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + +void FNV_INITS_QB(int *code, long int *NqB, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + F2C_CVODE_vecQB = NULL; + F2C_CVODE_vecQB = N_VNewEmpty_Serial(*NqB); + if (F2C_CVODE_vecQB == NULL) *ier = -1; + break; + case FCMIX_IDA: + F2C_IDA_vecQB = NULL; + F2C_IDA_vecQB = N_VNewEmpty_Serial(*NqB); + if (F2C_IDA_vecQB == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + +void FNV_INITS_S(int *code, int *Ns, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + F2C_CVODE_vecS = NULL; + F2C_CVODE_vecS = (N_Vector *) N_VCloneVectorArrayEmpty_Serial(*Ns, F2C_CVODE_vec); + if (F2C_CVODE_vecS == NULL) *ier = -1; + break; + case FCMIX_IDA: + F2C_IDA_vecS = NULL; + F2C_IDA_vecS = (N_Vector *) N_VCloneVectorArrayEmpty_Serial(*Ns, F2C_IDA_vec); + if (F2C_IDA_vecS == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + + diff --git a/odemex/Parser/CVode/cv_src/src/nvec_ser/fnvector_serial.h b/odemex/Parser/CVode/cv_src/src/nvec_ser/fnvector_serial.h new file mode 100644 index 0000000..2642337 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/nvec_ser/fnvector_serial.h @@ -0,0 +1,84 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.3 $ + * $Date: 2006/11/29 00:05:09 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This file (companion of nvector_serial.h) contains the + * definitions needed for the initialization of serial + * vector operations in Fortran. + * ----------------------------------------------------------------- + */ + +#ifndef _FNVECTOR_SERIAL_H +#define _FNVECTOR_SERIAL_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +#if defined(F77_FUNC) + +#define FNV_INITS F77_FUNC(fnvinits, FNVINITS) +#define FNV_INITS_Q F77_FUNC_(fnvinits_q, FNVINITS_Q) +#define FNV_INITS_S F77_FUNC_(fnvinits_s, FNVINITS_S) +#define FNV_INITS_B F77_FUNC_(fnvinits_b, FNVINITS_B) +#define FNV_INITS_QB F77_FUNC_(fnvinits_qb, FNVINITS_QB) + +#else + +#define FNV_INITS fnvinits_ +#define FNV_INITS_Q fnvinits_q_ +#define FNV_INITS_S fnvinits_s_ +#define FNV_INITS_B fnvinits_b_ +#define FNV_INITS_QB fnvinits_qb_ + +#endif + +/* Declarations of global variables */ + +extern N_Vector F2C_CVODE_vec; +extern N_Vector F2C_CVODE_vecQ; +extern N_Vector *F2C_CVODE_vecS; +extern N_Vector F2C_CVODE_vecB; +extern N_Vector F2C_CVODE_vecQB; + +extern N_Vector F2C_IDA_vec; +extern N_Vector F2C_IDA_vecQ; +extern N_Vector *F2C_IDA_vecS; +extern N_Vector F2C_IDA_vecB; +extern N_Vector F2C_IDA_vecQB; + +extern N_Vector F2C_KINSOL_vec; + +/* + * Prototypes of exported functions + * + * FNV_INITS - initializes serial vector operations for main problem + * FNV_INITS_Q - initializes serial vector operations for quadratures + * FNV_INITS_S - initializes serial vector operations for sensitivities + * FNV_INITS_B - initializes serial vector operations for adjoint problem + * FNV_INITS_QB - initializes serial vector operations for adjoint quadratures + * + */ + +void FNV_INITS(int *code, long int *neq, int *ier); +void FNV_INITS_Q(int *code, long int *Nq, int *ier); +void FNV_INITS_S(int *code, int *Ns, int *ier); +void FNV_INITS_B(int *code, long int *NB, int *ier); +void FNV_INITS_QB(int *code, long int *NqB, int *ier); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/cv_src/src/nvec_ser/nvector_serial.c b/odemex/Parser/CVode/cv_src/src/nvec_ser/nvector_serial.c new file mode 100644 index 0000000..c890253 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/nvec_ser/nvector_serial.c @@ -0,0 +1,1034 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.1 $ + * $Date: 2006/07/05 15:32:37 $ + * ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, Radu Serban, + * and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for a serial implementation + * of the NVECTOR package. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include +#include + +#define ZERO RCONST(0.0) +#define HALF RCONST(0.5) +#define ONE RCONST(1.0) +#define ONEPT5 RCONST(1.5) + +/* Private function prototypes */ +/* z=x */ +static void VCopy_Serial(N_Vector x, N_Vector z); +/* z=x+y */ +static void VSum_Serial(N_Vector x, N_Vector y, N_Vector z); +/* z=x-y */ +static void VDiff_Serial(N_Vector x, N_Vector y, N_Vector z); +/* z=-x */ +static void VNeg_Serial(N_Vector x, N_Vector z); +/* z=c(x+y) */ +static void VScaleSum_Serial(realtype c, N_Vector x, N_Vector y, N_Vector z); +/* z=c(x-y) */ +static void VScaleDiff_Serial(realtype c, N_Vector x, N_Vector y, N_Vector z); +/* z=ax+y */ +static void VLin1_Serial(realtype a, N_Vector x, N_Vector y, N_Vector z); +/* z=ax-y */ +static void VLin2_Serial(realtype a, N_Vector x, N_Vector y, N_Vector z); +/* y <- ax+y */ +static void Vaxpy_Serial(realtype a, N_Vector x, N_Vector y); +/* x <- ax */ +static void VScaleBy_Serial(realtype a, N_Vector x); + +/* + * ----------------------------------------------------------------- + * exported functions + * ----------------------------------------------------------------- + */ + +/* ---------------------------------------------------------------------------- + * Function to create a new empty serial vector + */ + +N_Vector N_VNewEmpty_Serial(long int length) +{ + N_Vector v; + N_Vector_Ops ops; + N_VectorContent_Serial content; + + /* Create vector */ + v = NULL; + v = (N_Vector) malloc(sizeof *v); + if (v == NULL) return(NULL); + + /* Create vector operation structure */ + ops = NULL; + ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); + if (ops == NULL) { free(v); return(NULL); } + + ops->nvclone = N_VClone_Serial; + ops->nvcloneempty = N_VCloneEmpty_Serial; + ops->nvdestroy = N_VDestroy_Serial; + ops->nvspace = N_VSpace_Serial; + ops->nvgetarraypointer = N_VGetArrayPointer_Serial; + ops->nvsetarraypointer = N_VSetArrayPointer_Serial; + ops->nvlinearsum = N_VLinearSum_Serial; + ops->nvconst = N_VConst_Serial; + ops->nvprod = N_VProd_Serial; + ops->nvdiv = N_VDiv_Serial; + ops->nvscale = N_VScale_Serial; + ops->nvabs = N_VAbs_Serial; + ops->nvinv = N_VInv_Serial; + ops->nvaddconst = N_VAddConst_Serial; + ops->nvdotprod = N_VDotProd_Serial; + ops->nvmaxnorm = N_VMaxNorm_Serial; + ops->nvwrmsnormmask = N_VWrmsNormMask_Serial; + ops->nvwrmsnorm = N_VWrmsNorm_Serial; + ops->nvmin = N_VMin_Serial; + ops->nvwl2norm = N_VWL2Norm_Serial; + ops->nvl1norm = N_VL1Norm_Serial; + ops->nvcompare = N_VCompare_Serial; + ops->nvinvtest = N_VInvTest_Serial; + ops->nvconstrmask = N_VConstrMask_Serial; + ops->nvminquotient = N_VMinQuotient_Serial; + + /* Create content */ + content = NULL; + content = (N_VectorContent_Serial) malloc(sizeof(struct _N_VectorContent_Serial)); + if (content == NULL) { free(ops); free(v); return(NULL); } + + content->length = length; + content->own_data = FALSE; + content->data = NULL; + + /* Attach content and ops */ + v->content = content; + v->ops = ops; + + return(v); +} + +/* ---------------------------------------------------------------------------- + * Function to create a new serial vector + */ + +N_Vector N_VNew_Serial(long int length) +{ + N_Vector v; + realtype *data; + + v = NULL; + v = N_VNewEmpty_Serial(length); + if (v == NULL) return(NULL); + + /* Create data */ + if (length > 0) { + + /* Allocate memory */ + data = NULL; + data = (realtype *) malloc(length * sizeof(realtype)); + if(data == NULL) { N_VDestroy_Serial(v); return(NULL); } + + /* Attach data */ + NV_OWN_DATA_S(v) = TRUE; + NV_DATA_S(v) = data; + + } + + return(v); +} + +/* ---------------------------------------------------------------------------- + * Function to create a serial N_Vector with user data component + */ + +N_Vector N_VMake_Serial(long int length, realtype *v_data) +{ + N_Vector v; + + v = NULL; + v = N_VNewEmpty_Serial(length); + if (v == NULL) return(NULL); + + if (length > 0) { + /* Attach data */ + NV_OWN_DATA_S(v) = FALSE; + NV_DATA_S(v) = v_data; + } + + return(v); +} + +/* ---------------------------------------------------------------------------- + * Function to create an array of new serial vectors. + */ + +N_Vector *N_VCloneVectorArray_Serial(int count, N_Vector w) +{ + N_Vector *vs; + int j; + + if (count <= 0) return(NULL); + + vs = NULL; + vs = (N_Vector *) malloc(count * sizeof(N_Vector)); + if(vs == NULL) return(NULL); + + for (j = 0; j < count; j++) { + vs[j] = NULL; + vs[j] = N_VClone_Serial(w); + if (vs[j] == NULL) { + N_VDestroyVectorArray_Serial(vs, j-1); + return(NULL); + } + } + + return(vs); +} + +/* ---------------------------------------------------------------------------- + * Function to create an array of new serial vectors with NULL data array. + */ + +N_Vector *N_VCloneVectorArrayEmpty_Serial(int count, N_Vector w) +{ + N_Vector *vs; + int j; + + if (count <= 0) return(NULL); + + vs = NULL; + vs = (N_Vector *) malloc(count * sizeof(N_Vector)); + if(vs == NULL) return(NULL); + + for (j = 0; j < count; j++) { + vs[j] = NULL; + vs[j] = N_VCloneEmpty_Serial(w); + if (vs[j] == NULL) { + N_VDestroyVectorArray_Serial(vs, j-1); + return(NULL); + } + } + + return(vs); +} + +/* ---------------------------------------------------------------------------- + * Function to free an array created with N_VCloneVectorArray_Serial + */ + +void N_VDestroyVectorArray_Serial(N_Vector *vs, int count) +{ + int j; + + for (j = 0; j < count; j++) N_VDestroy_Serial(vs[j]); + + free(vs); vs = NULL; + + return; +} + +/* ---------------------------------------------------------------------------- + * Function to print the a serial vector + */ + +void N_VPrint_Serial(N_Vector x) +{ + long int i, N; + realtype *xd; + + xd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + + for (i = 0; i < N; i++) { +#if defined(SUNDIALS_EXTENDED_PRECISION) + printf("%11.8Lg\n", xd[i]); +#elif defined(SUNDIALS_DOUBLE_PRECISION) + printf("%11.8lg\n", xd[i]); +#else + printf("%11.8g\n", xd[i]); +#endif + } + printf("\n"); + + return; +} + +/* + * ----------------------------------------------------------------- + * implementation of vector operations + * ----------------------------------------------------------------- + */ + +N_Vector N_VCloneEmpty_Serial(N_Vector w) +{ + N_Vector v; + N_Vector_Ops ops; + N_VectorContent_Serial content; + + if (w == NULL) return(NULL); + + /* Create vector */ + v = NULL; + v = (N_Vector) malloc(sizeof *v); + if (v == NULL) return(NULL); + + /* Create vector operation structure */ + ops = NULL; + ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); + if (ops == NULL) { free(v); return(NULL); } + + ops->nvclone = w->ops->nvclone; + ops->nvcloneempty = w->ops->nvcloneempty; + ops->nvdestroy = w->ops->nvdestroy; + ops->nvspace = w->ops->nvspace; + ops->nvgetarraypointer = w->ops->nvgetarraypointer; + ops->nvsetarraypointer = w->ops->nvsetarraypointer; + ops->nvlinearsum = w->ops->nvlinearsum; + ops->nvconst = w->ops->nvconst; + ops->nvprod = w->ops->nvprod; + ops->nvdiv = w->ops->nvdiv; + ops->nvscale = w->ops->nvscale; + ops->nvabs = w->ops->nvabs; + ops->nvinv = w->ops->nvinv; + ops->nvaddconst = w->ops->nvaddconst; + ops->nvdotprod = w->ops->nvdotprod; + ops->nvmaxnorm = w->ops->nvmaxnorm; + ops->nvwrmsnormmask = w->ops->nvwrmsnormmask; + ops->nvwrmsnorm = w->ops->nvwrmsnorm; + ops->nvmin = w->ops->nvmin; + ops->nvwl2norm = w->ops->nvwl2norm; + ops->nvl1norm = w->ops->nvl1norm; + ops->nvcompare = w->ops->nvcompare; + ops->nvinvtest = w->ops->nvinvtest; + ops->nvconstrmask = w->ops->nvconstrmask; + ops->nvminquotient = w->ops->nvminquotient; + + /* Create content */ + content = NULL; + content = (N_VectorContent_Serial) malloc(sizeof(struct _N_VectorContent_Serial)); + if (content == NULL) { free(ops); free(v); return(NULL); } + + content->length = NV_LENGTH_S(w); + content->own_data = FALSE; + content->data = NULL; + + /* Attach content and ops */ + v->content = content; + v->ops = ops; + + return(v); +} + +N_Vector N_VClone_Serial(N_Vector w) +{ + N_Vector v; + realtype *data; + long int length; + + v = NULL; + v = N_VCloneEmpty_Serial(w); + if (v == NULL) return(NULL); + + length = NV_LENGTH_S(w); + + /* Create data */ + if (length > 0) { + + /* Allocate memory */ + data = NULL; + data = (realtype *) malloc(length * sizeof(realtype)); + if(data == NULL) { N_VDestroy_Serial(v); return(NULL); } + + /* Attach data */ + NV_OWN_DATA_S(v) = TRUE; + NV_DATA_S(v) = data; + + } + + return(v); +} + +void N_VDestroy_Serial(N_Vector v) +{ + if (NV_OWN_DATA_S(v) == TRUE) { + free(NV_DATA_S(v)); + NV_DATA_S(v) = NULL; + } + free(v->content); v->content = NULL; + free(v->ops); v->ops = NULL; + free(v); v = NULL; + + return; +} + +void N_VSpace_Serial(N_Vector v, long int *lrw, long int *liw) +{ + *lrw = NV_LENGTH_S(v); + *liw = 1; + + return; +} + +realtype *N_VGetArrayPointer_Serial(N_Vector v) +{ + return((realtype *) NV_DATA_S(v)); +} + +void N_VSetArrayPointer_Serial(realtype *v_data, N_Vector v) +{ + if (NV_LENGTH_S(v) > 0) NV_DATA_S(v) = v_data; + + return; +} + +void N_VLinearSum_Serial(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z) +{ + long int i, N; + realtype c, *xd, *yd, *zd; + N_Vector v1, v2; + booleantype test; + + xd = yd = zd = NULL; + + if ((b == ONE) && (z == y)) { /* BLAS usage: axpy y <- ax+y */ + Vaxpy_Serial(a,x,y); + return; + } + + if ((a == ONE) && (z == x)) { /* BLAS usage: axpy x <- by+x */ + Vaxpy_Serial(b,y,x); + return; + } + + /* Case: a == b == 1.0 */ + + if ((a == ONE) && (b == ONE)) { + VSum_Serial(x, y, z); + return; + } + + /* Cases: (1) a == 1.0, b = -1.0, (2) a == -1.0, b == 1.0 */ + + if ((test = ((a == ONE) && (b == -ONE))) || ((a == -ONE) && (b == ONE))) { + v1 = test ? y : x; + v2 = test ? x : y; + VDiff_Serial(v2, v1, z); + return; + } + + /* Cases: (1) a == 1.0, b == other or 0.0, (2) a == other or 0.0, b == 1.0 */ + /* if a or b is 0.0, then user should have called N_VScale */ + + if ((test = (a == ONE)) || (b == ONE)) { + c = test ? b : a; + v1 = test ? y : x; + v2 = test ? x : y; + VLin1_Serial(c, v1, v2, z); + return; + } + + /* Cases: (1) a == -1.0, b != 1.0, (2) a != 1.0, b == -1.0 */ + + if ((test = (a == -ONE)) || (b == -ONE)) { + c = test ? b : a; + v1 = test ? y : x; + v2 = test ? x : y; + VLin2_Serial(c, v1, v2, z); + return; + } + + /* Case: a == b */ + /* catches case both a and b are 0.0 - user should have called N_VConst */ + + if (a == b) { + VScaleSum_Serial(a, x, y, z); + return; + } + + /* Case: a == -b */ + + if (a == -b) { + VScaleDiff_Serial(a, x, y, z); + return; + } + + /* Do all cases not handled above: + (1) a == other, b == 0.0 - user should have called N_VScale + (2) a == 0.0, b == other - user should have called N_VScale + (3) a,b == other, a !=b, a != -b */ + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + yd = NV_DATA_S(y); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) + zd[i] = (a*xd[i])+(b*yd[i]); + + return; +} + +void N_VConst_Serial(realtype c, N_Vector z) +{ + long int i, N; + realtype *zd; + + zd = NULL; + + N = NV_LENGTH_S(z); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) zd[i] = c; + + return; +} + +void N_VProd_Serial(N_Vector x, N_Vector y, N_Vector z) +{ + long int i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + yd = NV_DATA_S(y); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) + zd[i] = xd[i]*yd[i]; + + return; +} + +void N_VDiv_Serial(N_Vector x, N_Vector y, N_Vector z) +{ + long int i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + yd = NV_DATA_S(y); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) + zd[i] = xd[i]/yd[i]; + + return; +} + +void N_VScale_Serial(realtype c, N_Vector x, N_Vector z) +{ + long int i, N; + realtype *xd, *zd; + + xd = zd = NULL; + + if (z == x) { /* BLAS usage: scale x <- cx */ + VScaleBy_Serial(c, x); + return; + } + + if (c == ONE) { + VCopy_Serial(x, z); + } else if (c == -ONE) { + VNeg_Serial(x, z); + } else { + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + zd = NV_DATA_S(z); + for (i = 0; i < N; i++) + zd[i] = c*xd[i]; + } + + return; +} + +void N_VAbs_Serial(N_Vector x, N_Vector z) +{ + long int i, N; + realtype *xd, *zd; + + xd = zd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) + zd[i] = ABS(xd[i]); + + return; +} + +void N_VInv_Serial(N_Vector x, N_Vector z) +{ + long int i, N; + realtype *xd, *zd; + + xd = zd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) + zd[i] = ONE/xd[i]; + + return; +} + +void N_VAddConst_Serial(N_Vector x, realtype b, N_Vector z) +{ + long int i, N; + realtype *xd, *zd; + + xd = zd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) + zd[i] = xd[i]+b; + + return; +} + +realtype N_VDotProd_Serial(N_Vector x, N_Vector y) +{ + long int i, N; + realtype sum, *xd, *yd; + + sum = ZERO; + xd = yd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + yd = NV_DATA_S(y); + + for (i = 0; i < N; i++) + sum += xd[i]*yd[i]; + + return(sum); +} + +realtype N_VMaxNorm_Serial(N_Vector x) +{ + long int i, N; + realtype max, *xd; + + max = ZERO; + xd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + + for (i = 0; i < N; i++) { + if (ABS(xd[i]) > max) max = ABS(xd[i]); + } + + return(max); +} + +realtype N_VWrmsNorm_Serial(N_Vector x, N_Vector w) +{ + long int i, N; + realtype sum, prodi, *xd, *wd; + + sum = ZERO; + xd = wd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + wd = NV_DATA_S(w); + + for (i = 0; i < N; i++) { + prodi = xd[i]*wd[i]; + sum += SQR(prodi); + } + + return(RSqrt(sum/N)); +} + +realtype N_VWrmsNormMask_Serial(N_Vector x, N_Vector w, N_Vector id) +{ + long int i, N; + realtype sum, prodi, *xd, *wd, *idd; + + sum = ZERO; + xd = wd = idd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + wd = NV_DATA_S(w); + idd = NV_DATA_S(id); + + for (i = 0; i < N; i++) { + if (idd[i] > ZERO) { + prodi = xd[i]*wd[i]; + sum += SQR(prodi); + } + } + + return(RSqrt(sum / N)); +} + +realtype N_VMin_Serial(N_Vector x) +{ + long int i, N; + realtype min, *xd; + + xd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + + min = xd[0]; + + for (i = 1; i < N; i++) { + if (xd[i] < min) min = xd[i]; + } + + return(min); +} + +realtype N_VWL2Norm_Serial(N_Vector x, N_Vector w) +{ + long int i, N; + realtype sum, prodi, *xd, *wd; + + sum = ZERO; + xd = wd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + wd = NV_DATA_S(w); + + for (i = 0; i < N; i++) { + prodi = xd[i]*wd[i]; + sum += SQR(prodi); + } + + return(RSqrt(sum)); +} + +realtype N_VL1Norm_Serial(N_Vector x) +{ + long int i, N; + realtype sum, *xd; + + sum = ZERO; + xd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + + for (i = 0; i= c) ? ONE : ZERO; + } + + return; +} + +booleantype N_VInvTest_Serial(N_Vector x, N_Vector z) +{ + long int i, N; + realtype *xd, *zd; + + xd = zd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) { + if (xd[i] == ZERO) return(FALSE); + zd[i] = ONE/xd[i]; + } + + return(TRUE); +} + +booleantype N_VConstrMask_Serial(N_Vector c, N_Vector x, N_Vector m) +{ + long int i, N; + booleantype test; + realtype *cd, *xd, *md; + + cd = xd = md = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + cd = NV_DATA_S(c); + md = NV_DATA_S(m); + + test = TRUE; + + for (i = 0; i < N; i++) { + md[i] = ZERO; + if (cd[i] == ZERO) continue; + if (cd[i] > ONEPT5 || cd[i] < -ONEPT5) { + if ( xd[i]*cd[i] <= ZERO) { test = FALSE; md[i] = ONE; } + continue; + } + if ( cd[i] > HALF || cd[i] < -HALF) { + if (xd[i]*cd[i] < ZERO ) { test = FALSE; md[i] = ONE; } + } + } + + return(test); +} + +realtype N_VMinQuotient_Serial(N_Vector num, N_Vector denom) +{ + booleantype notEvenOnce; + long int i, N; + realtype *nd, *dd, min; + + nd = dd = NULL; + + N = NV_LENGTH_S(num); + nd = NV_DATA_S(num); + dd = NV_DATA_S(denom); + + notEvenOnce = TRUE; + min = BIG_REAL; + + for (i = 0; i < N; i++) { + if (dd[i] == ZERO) continue; + else { + if (!notEvenOnce) min = MIN(min, nd[i]/dd[i]); + else { + min = nd[i]/dd[i]; + notEvenOnce = FALSE; + } + } + } + + return(min); +} + +/* + * ----------------------------------------------------------------- + * private functions + * ----------------------------------------------------------------- + */ + +static void VCopy_Serial(N_Vector x, N_Vector z) +{ + long int i, N; + realtype *xd, *zd; + + xd = zd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) + zd[i] = xd[i]; + + return; +} + +static void VSum_Serial(N_Vector x, N_Vector y, N_Vector z) +{ + long int i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + yd = NV_DATA_S(y); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) + zd[i] = xd[i]+yd[i]; + + return; +} + +static void VDiff_Serial(N_Vector x, N_Vector y, N_Vector z) +{ + long int i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + yd = NV_DATA_S(y); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) + zd[i] = xd[i]-yd[i]; + + return; +} + +static void VNeg_Serial(N_Vector x, N_Vector z) +{ + long int i, N; + realtype *xd, *zd; + + xd = zd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) + zd[i] = -xd[i]; + + return; +} + +static void VScaleSum_Serial(realtype c, N_Vector x, N_Vector y, N_Vector z) +{ + long int i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + yd = NV_DATA_S(y); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) + zd[i] = c*(xd[i]+yd[i]); + + return; +} + +static void VScaleDiff_Serial(realtype c, N_Vector x, N_Vector y, N_Vector z) +{ + long int i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + yd = NV_DATA_S(y); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) + zd[i] = c*(xd[i]-yd[i]); + + return; +} + +static void VLin1_Serial(realtype a, N_Vector x, N_Vector y, N_Vector z) +{ + long int i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + yd = NV_DATA_S(y); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) + zd[i] = (a*xd[i])+yd[i]; + + return; +} + +static void VLin2_Serial(realtype a, N_Vector x, N_Vector y, N_Vector z) +{ + long int i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + yd = NV_DATA_S(y); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) + zd[i] = (a*xd[i])-yd[i]; + + return; +} + +static void Vaxpy_Serial(realtype a, N_Vector x, N_Vector y) +{ + long int i, N; + realtype *xd, *yd; + + xd = yd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + yd = NV_DATA_S(y); + + if (a == ONE) { + for (i = 0; i < N; i++) + yd[i] += xd[i]; + return; + } + + if (a == -ONE) { + for (i = 0; i < N; i++) + yd[i] -= xd[i]; + return; + } + + for (i = 0; i < N; i++) + yd[i] += a*xd[i]; + + return; +} + +static void VScaleBy_Serial(realtype a, N_Vector x) +{ + long int i, N; + realtype *xd; + + xd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + + for (i = 0; i < N; i++) + xd[i] *= a; + + return; +} diff --git a/odemex/Parser/CVode/cv_src/src/sundials/CMakeLists.txt b/odemex/Parser/CVode/cv_src/src/sundials/CMakeLists.txt new file mode 100644 index 0000000..459dcdf --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/sundials/CMakeLists.txt @@ -0,0 +1,45 @@ +# --------------------------------------------------------------- +# $Revision: 1.4 $ +# $Date: 2009/02/17 02:52:53 $ +# --------------------------------------------------------------- +# Programmer: Radu Serban @ LLNL +# --------------------------------------------------------------- +# Copyright (c) 2007, The Regents of the University of California. +# Produced at the Lawrence Livermore National Laboratory. +# All rights reserved. +# For details, see the LICENSE file. +# --------------------------------------------------------------- +# CMakeLists.txt file for the generic SUNDIALS modules + +# From here we only install the generic SUNDIALS headers. +# The implementations themselves are incorporated in the individual SUNDIALS solver libraries. + +INSTALL(CODE "MESSAGE(\"\nInstall shared components\n\")") + +# Add variable sundials_HEADERS with the exported SUNDIALS header files +SET(sundials_HEADERS + sundials_band.h + sundials_dense.h + sundials_direct.h + sundials_iterative.h + sundials_math.h + sundials_nvector.h + sundials_fnvector.h + sundials_spbcgs.h + sundials_spgmr.h + sundials_sptfqmr.h + sundials_types.h + ) + +# Add prefix with complete path to the SUNDIALS header files +ADD_PREFIX(${sundials_SOURCE_DIR}/include/sundials/ sundials_HEADERS) + +# Install the SUNDIALS header files +INSTALL(FILES ${sundials_HEADERS} DESTINATION include/sundials) + +# If Blas/Lapack support was enabled, install the Lapack interface headers +IF(LAPACK_FOUND) + SET(sundials_BL_HEADERS sundials_lapack.h) + ADD_PREFIX(${sundials_SOURCE_DIR}/include/sundials/ sundials_BL_HEADERS) + INSTALL(FILES ${sundials_BL_HEADERS} DESTINATION include/sundials) +ENDIF(LAPACK_FOUND) diff --git a/odemex/Parser/CVode/cv_src/src/sundials/Makefile.in b/odemex/Parser/CVode/cv_src/src/sundials/Makefile.in new file mode 100644 index 0000000..f750ba1 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/sundials/Makefile.in @@ -0,0 +1,137 @@ +# ----------------------------------------------------------------- +# $Revision: 1.12 $ +# $Date: 2009/02/17 02:52:53 $ +# ----------------------------------------------------------------- +# Programmer(s): Radu Serban and Aaron Collier @ LLNL +# ----------------------------------------------------------------- +# Copyright (c) 2002, The Regents of the University of California. +# Produced at the Lawrence Livermore National Laboratory. +# All rights reserved. +# For details, see the LICENSE file. +# ----------------------------------------------------------------- +# Makefile for SHARED module +# +# @configure_input@ +# ----------------------------------------------------------------- + +SHELL = @SHELL@ + +srcdir = @srcdir@ +builddir = @builddir@ +abs_builddir = @abs_builddir@ +top_builddir = @top_builddir@ +prefix = @prefix@ +exec_prefix = @exec_prefix@ +includedir = @includedir@ +libdir = @libdir@ +bindir = @bindir@ + +INSTALL = @INSTALL@ +INSTALL_PROG = @INSTALL_PROGRAM@ +INSTALL_HEADER = @INSTALL_DATA@ + +LIBTOOL = @LIBTOOL@ +LIBTOOL_DEPS = @LIBTOOL_DEPS@ + +CPP = @CPP@ +CPPFLAGS = @CPPFLAGS@ +CC = @CC@ +CFLAGS = @CFLAGS@ +LDFLAGS = @LDFLAGS@ +LIBS = @LIBS@ + +LAPACK_ENABLED = @LAPACK_ENABLED@ + +top_srcdir = $(srcdir)/../.. + +INCLUDES = -I$(top_srcdir)/include -I$(top_builddir)/include + +SHARED_SRC_FILES = sundials_direct.c sundials_band.c sundials_dense.c sundials_iterative.c sundials_math.c sundials_nvector.c sundials_spgmr.c sundials_spbcgs.c sundials_sptfqmr.c + +SHARED_OBJ_FILES = $(SHARED_SRC_FILES:.c=.o) + +SHARED_LIB_FILES = $(SHARED_SRC_FILES:.c=.lo) + +mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs +rminstalldirs = $(SHELL) $(top_srcdir)/config/rminstalldirs + +# ---------------------------------------------------------------------------------------------------------------------- + + +all: + @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ + make lib_with_bl; \ + else \ + make lib_without_bl; \ + fi + +lib_without_bl: $(SHARED_LIB_FILES) + +lib_with_bl: $(SHARED_LIB_FILES) + +install: + $(mkinstalldirs) $(includedir)/sundials + $(INSTALL_HEADER) $(top_srcdir)/include/sundials/sundials_direct.h $(includedir)/sundials/ + $(INSTALL_HEADER) $(top_srcdir)/include/sundials/sundials_band.h $(includedir)/sundials/ + $(INSTALL_HEADER) $(top_srcdir)/include/sundials/sundials_dense.h $(includedir)/sundials/ + $(INSTALL_HEADER) $(top_srcdir)/include/sundials/sundials_iterative.h $(includedir)/sundials/ + $(INSTALL_HEADER) $(top_srcdir)/include/sundials/sundials_spgmr.h $(includedir)/sundials/ + $(INSTALL_HEADER) $(top_srcdir)/include/sundials/sundials_spbcgs.h $(includedir)/sundials/ + $(INSTALL_HEADER) $(top_srcdir)/include/sundials/sundials_sptfqmr.h $(includedir)/sundials/ + $(INSTALL_HEADER) $(top_srcdir)/include/sundials/sundials_math.h $(includedir)/sundials/ + $(INSTALL_HEADER) $(top_srcdir)/include/sundials/sundials_types.h $(includedir)/sundials/ + $(INSTALL_HEADER) $(top_srcdir)/include/sundials/sundials_nvector.h $(includedir)/sundials/ + $(INSTALL_HEADER) $(top_srcdir)/include/sundials/sundials_fnvector.h $(includedir)/sundials/ + $(INSTALL_HEADER) $(top_builddir)/include/sundials/sundials_config.h $(includedir)/sundials/ + @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ + $(INSTALL_HEADER) $(top_srcdir)/include/sundials/sundials_lapack.h $(includedir)/sundials/ ; \ + fi + +uninstall: + rm -f $(includedir)/sundials/sundials_direct.h + rm -f $(includedir)/sundials/sundials_band.h + rm -f $(includedir)/sundials/sundials_dense.h + rm -f $(includedir)/sundials/sundials_lapack.h + rm -f $(includedir)/sundials/sundials_iterative.h + rm -f $(includedir)/sundials/sundials_spgmr.h + rm -f $(includedir)/sundials/sundials_spbcgs.h + rm -f $(includedir)/sundials/sundials_sptfqmr.h + rm -f $(includedir)/sundials/sundials_math.h + rm -f $(includedir)/sundials/sundials_types.h + rm -f $(includedir)/sundials/sundials_nvector.h + rm -f $(includedir)/sundials/sundials_fnvector.h + rm -f $(includedir)/sundials/sundials_config.h + $(rminstalldirs) $(includedir)/sundials + +clean: + rm -f $(SHARED_LIB_FILES) + rm -f $(SHARED_OBJ_FILES) + rm -rf .libs + +distclean: clean + rm -f $(top_builddir)/include/sundials/sundials_config.h + rm -f Makefile + +sundials_direct.lo: $(srcdir)/sundials_direct.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/sundials_direct.c +sundials_band.lo: $(srcdir)/sundials_band.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/sundials_band.c +sundials_dense.lo: $(srcdir)/sundials_dense.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/sundials_dense.c +sundials_iterative.lo: $(srcdir)/sundials_iterative.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/sundials_iterative.c +sundials_spgmr.lo: $(srcdir)/sundials_spgmr.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/sundials_spgmr.c +sundials_spbcgs.lo: $(srcdir)/sundials_spbcgs.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/sundials_spbcgs.c +sundials_sptfqmr.lo: $(srcdir)/sundials_sptfqmr.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/sundials_sptfqmr.c +sundials_math.lo: $(srcdir)/sundials_math.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/sundials_math.c +sundials_nvector.lo: $(srcdir)/sundials_nvector.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/sundials_nvector.c + +libtool: $(top_builddir)/$(LIBTOOL_DEPS) + @cd ${top_builddir} ; \ + ${SHELL} ./config.status --recheck ; \ + cd ${abs_builddir} diff --git a/odemex/Parser/CVode/cv_src/src/sundials/README b/odemex/Parser/CVode/cv_src/src/sundials/README new file mode 100644 index 0000000..d73e577 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/sundials/README @@ -0,0 +1,201 @@ + SUNDIALS + Shared Module + Release 2.4.0, January 2008 + + +The family of solvers referred to as SUNDIALS consists of solvers +CVODE (ODE), CVODES (ODE with sensitivity analysis capabilities), +IDA (DAE), IDAS (DAE with sensitivity analysis capabilities), and +KINSOL (for nonlinear algebraic systems). + +The various solvers of this family share many subordinate modules contained +in this module: +- generic NVECTOR module +- generic linear solver modules (band, dense, lapack, spgmr, bcg, tfqmr) +- definitions of SUNDIALS types (realtype, booleantype) +- common math functions (RpowerI, RPowerR, RSqrt, RAbs,...) + + +A. Documentation +---------------- +All shared submodules are fully described in the user documentation for any of +the SUNDIALS solvers [1-5]. A PDF file for the user guide for a particular solver +is available in the solver's subdirectory under doc/. + + +B. Installation +--------------- + +For basic installation instructions see the file /sundials/INSTALL_NOTES. +For complete installation instructions see any of the user guides. + + +C. References +------------- + +[1] A. C. Hindmarsh and R. Serban, "User Documentation for CVODE v2.4.0," + LLLNL technical report UCRL-MA-208108, November 2004. + +[2] A. C. Hindmarsh and R. Serban, "User Documentation for CVODES v2.4.0," + LLNL technical report UCRL-MA-208111, November 2004. + +[3] A. C. Hindmarsh and R. Serban, "User Documentation for IDA v2.4.0," + LLNL technical report UCRL-MA-208112, November 2004. + +[4] R. Serban and C. Petra, "User Documentation for IDAS v1.0.0," + LLNL technical report UCRL-SM-234051, August 2007. + +[5] A. M. Collier, A. C. Hindmarsh, R. Serban,and C. S. Woodward, "User + Documentation for KINSOL v2.4.0," LLNL technical report UCRL-MA-208116, + November 2004. + + +D. Releases +----------- + +v. 2.4.0 - Jan. 2008 +v. 2.3.0 - Nov. 2006 +v. 2.2.0 - Mar. 2006 +v. 2.1.1 - May. 2005 +v. 2.1.0 - Apr. 2005 +v. 2.0.2 - Mar. 2005 +v. 2.0.1 - Jan. 2005 +v. 2.0 - Dec. 2004 +v. 1.0 - Jul. 2002 (first SUNDIALS release) +v. 0.0 - Mar. 2002 + + +E. Revision History +------------------- + +v. 2.3.0 (Nov. 2006) ---> v. 2.4.0 (Jan. 2008) +--------------------------------------------------------- + +- New features + - added a new generic linear solver module based on Blas + Lapack + for both dense and banded matrices. + +- Changes to user interface + - common functionality for all direct linear solvers (dense, band, and + the new Lapack solver) has been collected into the DLS (Direct Linear + Solver) module, implemented in the files sundials_direct.h and + sundials_direct.c (similar to the SPILS module for the iterative linear + solvers). + - in order to include the new Lapack-based linear solver, all dimensions + for the above linear solvers (problem sizes, bandwidths,... including + the underlying matrix data types) are now of type 'int' (and not 'long int'). + + +v. 2.2.0 (Mar. 2006) ---> v. 2.3.0 (Nov. 2006) +---------------------------------------------- + +- Changes to the user interface + - modified sundials_dense and sundials_smalldense to work with + rectangular m by n matrices (m <= n). + +- Changes related to the build system + - reorganized source tree + - exported header files are installed in solver-specific subdirectories + of ${includedir} + - sundialsTB is distributed only as part of the SUNDIALS tarball + +v. 2.1.1 (May 2005) ---> v. 2.2.0 (Mar. 2006) +---------------------------------------------- + +- New features + - added SPBCG (scaled preconditioned Bi-CGStab) linear solver module + - added SPTFQMR (scaled preconditioned TFQMR) linear solver module + +- Changes related to the build system + - updated configure script and Makefiles for Fortran examples to avoid C++ + compiler errors (now use CC and MPICC to link only if necessary) + - SUNDIALS shared header files are installed under a 'sundials' subdirectory + of the install include directory + - the shared object files are now linked into each SUNDIALS library rather + than into a separate libsundials_shared library + +- Changes to the user interface + - added prefix 'sundials_' to all shared header files + +v. 2.1.0 (Apr. 2005) ---> v. 2.1.1 (May.2005) +---------------------------------------------- + +- Changes to data structures + - added N_VCloneEmpty to global vector operations table + +v. 2.0.2 (Mar. 2005) ---> v. 2.1.0 (Apr. 2005) +---------------------------------------------- + +- none + +v. 2.0.1 (Jan. 2005) ---> v. 2.0.2 (Mar. 2005) +---------------------------------------------- + +- Changes related to the build system + - fixed autoconf-related bug to allow configuration with the PGI Fortran compiler + - modified to use customized detection of the Fortran name mangling scheme + (autoconf's AC_F77_WRAPPERS routine is problematic on some platforms) + - added --with-mpi-flags as a configure option to allow user to specify + MPI-specific flags + - updated Makefiles for Fortran examples to avoid C++ compiler errors (now use + CC and MPICC to link) + +v. 2.0 (Dec. 2004) ---> v. 2.0.1 (Jan. 2005) +-------------------------------------------- + +- Changes related to the build system + - changed order of compiler directives in header files to avoid compilation + errors when using a C++ compiler. + +v. 1.0 (Jul. 2002) ---> v. 2.0 (Dec. 2004) +------------------------------------------ + +- Changes to the generic NVECTOR module + - removed machEnv, redefined table of vector operations (now contained + in the N_Vector structure itself). + - all SUNDIALS functions create new N_Vector variables through cloning, using + an N_Vector passed by the user as a template. + - a particular NVECTOR implementation is supposed to provide user-callable + constructor and destructor functions. + - removed from structure of vector operations the following functions: + N_VNew, N_VNew_S, N_VFree, N_VFree_S, N_VMake, N_VDispose, N_VGetData, + N_VSetData, N_VConstrProdPos, and N_VOneMask. + - added in structure of vector operations the following functions: + N_VClone, N_VDestroy, N_VSpace, N_VGetArrayPointer, N_VSetArrayPointer, + and N_VWrmsNormMask. + - Note that nvec_ser and nvec_par are now separate modules outside the + shared SUNDIALS module. + +- Changes to the generic linear solvers + - in SPGMR, added a dummy N_Vector argument to be used as a template + for cloning. + - in SPGMR, removed N (problem dimension) from argument list of SpgmrMalloc. + - iterative.{c,h} replace iterativ.{c,h} + - modified constant names in iterative.h (preconditioner types are prefixed + with 'PREC_'). + - changed numerical values for MODIFIED_GS (from 0 to 1) and CLASSICAL_GS + (from 1 to 2). + +- Changes to sundialsmath submodule + - replaced internal routine for estimation of unit roundoff with definition + of unit roundoff from float.h + - modified functions to call appropriate math routines given the precision + level specified by the user. + +- Changes to sundialstypes submodule + - removed type 'integertype'. + - added definitions for 'BIG_REAL', 'SMALL_REAL', and 'UNIT_ROUNDOFF' using + values from float.h based on the precision. + - changed definition of macro RCONST to depend on precision. + +v 0.0 (Mar. 2002) ---> v. 1.0 (Jul. 2002) +----------------------------------------- + +20020321 Defined and implemented generic NVECTOR module, and separate serial/ + parallel NVECTOR modules, including serial/parallel F/C interfaces. + Modified dense and band backsolve routines to take real* type for + RHS and solution vector. +20020329 Named the DenseMat, BandMat, and SpgmrMemRec structures. +20020626 Changed type names to realtype, integertype, booleantype. + Renamed llnltypes and llnlmath files. + diff --git a/odemex/Parser/CVode/cv_src/src/sundials/sundials_band.c b/odemex/Parser/CVode/cv_src/src/sundials/sundials_band.c new file mode 100644 index 0000000..fa4eea7 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/sundials/sundials_band.c @@ -0,0 +1,235 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.6 $ + * $Date: 2009/02/17 02:42:29 $ + * ----------------------------------------------------------------- + * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for a generic BAND linear + * solver package. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include +#include + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + +#define ROW(i,j,smu) (i-j+smu) + +/* + * ----------------------------------------------------- + * Functions working on DlsMat + * ----------------------------------------------------- + */ + +int BandGBTRF(DlsMat A, int *p) +{ + return(bandGBTRF(A->cols, A->M, A->mu, A->ml, A->s_mu, p)); +} + +void BandGBTRS(DlsMat A, int *p, realtype *b) +{ + bandGBTRS(A->cols, A->M, A->s_mu, A->ml, p, b); +} + +void BandCopy(DlsMat A, DlsMat B, int copymu, int copyml) +{ + bandCopy(A->cols, B->cols, A->M, A->s_mu, B->s_mu, copymu, copyml); +} + +void BandScale(realtype c, DlsMat A) +{ + bandScale(c, A->cols, A->M, A->mu, A->ml, A->s_mu); +} + +/* + * ----------------------------------------------------- + * Functions working on realtype** + * ----------------------------------------------------- + */ + +int bandGBTRF(realtype **a, int n, int mu, int ml, int smu, int *p) +{ + int c, r, num_rows; + int i, j, k, l, storage_l, storage_k, last_col_k, last_row_k; + realtype *a_c, *col_k, *diag_k, *sub_diag_k, *col_j, *kptr, *jptr; + realtype max, temp, mult, a_kj; + booleantype swap; + + /* zero out the first smu - mu rows of the rectangular array a */ + + num_rows = smu - mu; + if (num_rows > 0) { + for (c=0; c < n; c++) { + a_c = a[c]; + for (r=0; r < num_rows; r++) { + a_c[r] = ZERO; + } + } + } + + /* k = elimination step number */ + + for (k=0; k < n-1; k++, p++) { + + col_k = a[k]; + diag_k = col_k + smu; + sub_diag_k = diag_k + 1; + last_row_k = MIN(n-1,k+ml); + + /* find l = pivot row number */ + + l=k; + max = ABS(*diag_k); + for (i=k+1, kptr=sub_diag_k; i <= last_row_k; i++, kptr++) { + if (ABS(*kptr) > max) { + l=i; + max = ABS(*kptr); + } + } + storage_l = ROW(l, k, smu); + *p = l; + + /* check for zero pivot element */ + + if (col_k[storage_l] == ZERO) return(k+1); + + /* swap a(l,k) and a(k,k) if necessary */ + + if ( (swap = (l != k) )) { + temp = col_k[storage_l]; + col_k[storage_l] = *diag_k; + *diag_k = temp; + } + + /* Scale the elements below the diagonal in */ + /* column k by -1.0 / a(k,k). After the above swap, */ + /* a(k,k) holds the pivot element. This scaling */ + /* stores the pivot row multipliers -a(i,k)/a(k,k) */ + /* in a(i,k), i=k+1, ..., MIN(n-1,k+ml). */ + + mult = -ONE / (*diag_k); + for (i=k+1, kptr = sub_diag_k; i <= last_row_k; i++, kptr++) + (*kptr) *= mult; + + /* row_i = row_i - [a(i,k)/a(k,k)] row_k, i=k+1, ..., MIN(n-1,k+ml) */ + /* row k is the pivot row after swapping with row l. */ + /* The computation is done one column at a time, */ + /* column j=k+1, ..., MIN(k+smu,n-1). */ + + last_col_k = MIN(k+smu,n-1); + for (j=k+1; j <= last_col_k; j++) { + + col_j = a[j]; + storage_l = ROW(l,j,smu); + storage_k = ROW(k,j,smu); + a_kj = col_j[storage_l]; + + /* Swap the elements a(k,j) and a(k,l) if l!=k. */ + + if (swap) { + col_j[storage_l] = col_j[storage_k]; + col_j[storage_k] = a_kj; + } + + /* a(i,j) = a(i,j) - [a(i,k)/a(k,k)]*a(k,j) */ + /* a_kj = a(k,j), *kptr = - a(i,k)/a(k,k), *jptr = a(i,j) */ + + if (a_kj != ZERO) { + for (i=k+1, kptr=sub_diag_k, jptr=col_j+ROW(k+1,j,smu); + i <= last_row_k; + i++, kptr++, jptr++) + (*jptr) += a_kj * (*kptr); + } + } + } + + /* set the last pivot row to be n-1 and check for a zero pivot */ + + *p = n-1; + if (a[n-1][smu] == ZERO) return(n); + + /* return 0 to indicate success */ + + return(0); +} + +void bandGBTRS(realtype **a, int n, int smu, int ml, int *p, realtype *b) +{ + int k, l, i, first_row_k, last_row_k; + realtype mult, *diag_k; + + /* Solve Ly = Pb, store solution y in b */ + + for (k=0; k < n-1; k++) { + l = p[k]; + mult = b[l]; + if (l != k) { + b[l] = b[k]; + b[k] = mult; + } + diag_k = a[k]+smu; + last_row_k = MIN(n-1,k+ml); + for (i=k+1; i <= last_row_k; i++) + b[i] += mult * diag_k[i-k]; + } + + /* Solve Ux = y, store solution x in b */ + + for (k=n-1; k >= 0; k--) { + diag_k = a[k]+smu; + first_row_k = MAX(0,k-smu); + b[k] /= (*diag_k); + mult = -b[k]; + for (i=first_row_k; i <= k-1; i++) + b[i] += mult*diag_k[i-k]; + } +} + +void bandCopy(realtype **a, realtype **b, int n, int a_smu, int b_smu, + int copymu, int copyml) +{ + int i, j, copySize; + realtype *a_col_j, *b_col_j; + + copySize = copymu + copyml + 1; + + for (j=0; j < n; j++) { + a_col_j = a[j]+a_smu-copymu; + b_col_j = b[j]+b_smu-copymu; + for (i=0; i < copySize; i++) + b_col_j[i] = a_col_j[i]; + } +} + +void bandScale(realtype c, realtype **a, int n, int mu, int ml, int smu) +{ + int i, j, colSize; + realtype *col_j; + + colSize = mu + ml + 1; + + for(j=0; j < n; j++) { + col_j = a[j]+smu-mu; + for (i=0; i < colSize; i++) + col_j[i] *= c; + } +} + +void bandAddIdentity(realtype **a, int n, int smu) +{ + int j; + + for(j=0; j < n; j++) + a[j][smu] += ONE; +} diff --git a/odemex/Parser/CVode/cv_src/src/sundials/sundials_dense.c b/odemex/Parser/CVode/cv_src/src/sundials/sundials_dense.c new file mode 100644 index 0000000..104e070 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/sundials/sundials_dense.c @@ -0,0 +1,373 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.6 $ + * $Date: 2009/02/17 02:42:29 $ + * ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and + * Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for a generic package of dense + * matrix operations. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include +#include + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) +#define TWO RCONST(2.0) + +/* + * ----------------------------------------------------- + * Functions working on DlsMat + * ----------------------------------------------------- + */ + +int DenseGETRF(DlsMat A, int *p) +{ + return(denseGETRF(A->cols, A->M, A->N, p)); +} + +void DenseGETRS(DlsMat A, int *p, realtype *b) +{ + denseGETRS(A->cols, A->N, p, b); +} + +int DensePOTRF(DlsMat A) +{ + return(densePOTRF(A->cols, A->M)); +} + +void DensePOTRS(DlsMat A, realtype *b) +{ + densePOTRS(A->cols, A->M, b); +} + +int DenseGEQRF(DlsMat A, realtype *beta, realtype *wrk) +{ + return(denseGEQRF(A->cols, A->M, A->N, beta, wrk)); +} + +int DenseORMQR(DlsMat A, realtype *beta, realtype *vn, realtype *vm, realtype *wrk) +{ + return(denseORMQR(A->cols, A->M, A->N, beta, vn, vm, wrk)); +} + +void DenseCopy(DlsMat A, DlsMat B) +{ + denseCopy(A->cols, B->cols, A->M, A->N); +} + +void DenseScale(realtype c, DlsMat A) +{ + denseScale(c, A->cols, A->M, A->N); +} + +int denseGETRF(realtype **a, int m, int n, int *p) +{ + int i, j, k, l; + realtype *col_j, *col_k; + realtype temp, mult, a_kj; + + /* k-th elimination step number */ + for (k=0; k < n; k++) { + + col_k = a[k]; + + /* find l = pivot row number */ + l=k; + for (i=k+1; i < m; i++) + if (ABS(col_k[i]) > ABS(col_k[l])) l=i; + p[k] = l; + + /* check for zero pivot element */ + if (col_k[l] == ZERO) return(k+1); + + /* swap a(k,1:n) and a(l,1:n) if necessary */ + if ( l!= k ) { + for (i=0; i 0; k--) { + col_k = a[k]; + b[k] /= col_k[k]; + for (i=0; i0) { + for(i=j; i=0; i--) { + col_i = a[i]; + for (j=i+1; j= n) + * using Householder reflections. + * + * On exit, the elements on and above the diagonal of A contain the n by n + * upper triangular matrix R; the elements below the diagonal, with the array beta, + * represent the orthogonal matrix Q as a product of elementary reflectors . + * + * v (of length m) must be provided as workspace. + * + */ + +int denseGEQRF(realtype **a, int m, int n, realtype *beta, realtype *v) +{ + realtype ajj, s, mu, v1, v1_2; + realtype *col_j, *col_k; + int i, j, k; + + /* For each column...*/ + for(j=0; j= n. + * + * v (of length m) must be provided as workspace. + */ +int denseORMQR(realtype **a, int m, int n, realtype *beta, + realtype *vn, realtype *vm, realtype *v) +{ + realtype *col_j, s; + int i, j; + + /* Initialize vm */ + for(i=0; i=0; j--) { + + col_j = a[j]; + + v[0] = ONE; + s = vm[j]; + for(i=1; i +#include + +#include +#include + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + +DlsMat NewDenseMat(int M, int N) +{ + DlsMat A; + int j; + + if ( (M <= 0) || (N <= 0) ) return(NULL); + + A = NULL; + A = (DlsMat) malloc(sizeof *A); + if (A==NULL) return (NULL); + + A->data = (realtype *) malloc(M * N * sizeof(realtype)); + if (A->data == NULL) { + free(A); A = NULL; + return(NULL); + } + A->cols = (realtype **) malloc(N * sizeof(realtype *)); + if (A->cols == NULL) { + free(A->data); A->data = NULL; + free(A); A = NULL; + return(NULL); + } + + for (j=0; j < N; j++) A->cols[j] = A->data + j * M; + + A->M = M; + A->N = N; + A->ldim = M; + A->ldata = M*N; + + A->type = SUNDIALS_DENSE; + + return(A); +} + +realtype **newDenseMat(int m, int n) +{ + int j; + realtype **a; + + if ( (n <= 0) || (m <= 0) ) return(NULL); + + a = NULL; + a = (realtype **) malloc(n * sizeof(realtype *)); + if (a == NULL) return(NULL); + + a[0] = NULL; + a[0] = (realtype *) malloc(m * n * sizeof(realtype)); + if (a[0] == NULL) { + free(a); a = NULL; + return(NULL); + } + + for (j=1; j < n; j++) a[j] = a[0] + j * m; + + return(a); +} + + +DlsMat NewBandMat(int N, int mu, int ml, int smu) +{ + DlsMat A; + int j, colSize; + + if (N <= 0) return(NULL); + + A = NULL; + A = (DlsMat) malloc(sizeof *A); + if (A == NULL) return (NULL); + + colSize = smu + ml + 1; + A->data = NULL; + A->data = (realtype *) malloc(N * colSize * sizeof(realtype)); + if (A->data == NULL) { + free(A); A = NULL; + return(NULL); + } + + A->cols = NULL; + A->cols = (realtype **) malloc(N * sizeof(realtype *)); + if (A->cols == NULL) { + free(A->data); + free(A); A = NULL; + return(NULL); + } + + for (j=0; j < N; j++) A->cols[j] = A->data + j * colSize; + + A->M = N; + A->N = N; + A->mu = mu; + A->ml = ml; + A->s_mu = smu; + A->ldim = colSize; + A->ldata = N * colSize; + + A->type = SUNDIALS_BAND; + + return(A); +} + +realtype **newBandMat(int n, int smu, int ml) +{ + realtype **a; + int j, colSize; + + if (n <= 0) return(NULL); + + a = NULL; + a = (realtype **) malloc(n * sizeof(realtype *)); + if (a == NULL) return(NULL); + + colSize = smu + ml + 1; + a[0] = NULL; + a[0] = (realtype *) malloc(n * colSize * sizeof(realtype)); + if (a[0] == NULL) { + free(a); a = NULL; + return(NULL); + } + + for (j=1; j < n; j++) a[j] = a[0] + j * colSize; + + return(a); +} + +void DestroyMat(DlsMat A) +{ + free(A->data); A->data = NULL; + free(A->cols); + free(A); A = NULL; +} + +void destroyMat(realtype **a) +{ + free(a[0]); a[0] = NULL; + free(a); a = NULL; +} + +int *NewIntArray(int N) +{ + int *vec; + + if (N <= 0) return(NULL); + + vec = NULL; + vec = (int *) malloc(N * sizeof(int)); + + return(vec); +} + +int *newIntArray(int n) +{ + int *v; + + if (n <= 0) return(NULL); + + v = NULL; + v = (int *) malloc(n * sizeof(int)); + + return(v); +} + +realtype *NewRealArray(int N) +{ + realtype *vec; + + if (N <= 0) return(NULL); + + vec = NULL; + vec = (realtype *) malloc(N * sizeof(realtype)); + + return(vec); +} + +realtype *newRealArray(int m) +{ + realtype *v; + + if (m <= 0) return(NULL); + + v = NULL; + v = (realtype *) malloc(m * sizeof(realtype)); + + return(v); +} + +void DestroyArray(void *V) +{ + free(V); + V = NULL; +} + +void destroyArray(void *v) +{ + free(v); + v = NULL; +} + + +void AddIdentity(DlsMat A) +{ + int i; + + switch (A->type) { + + case SUNDIALS_DENSE: + for (i=0; iN; i++) A->cols[i][i] += ONE; + break; + + case SUNDIALS_BAND: + for (i=0; iM; i++) A->cols[i][A->s_mu] += ONE; + break; + + } + +} + + +void SetToZero(DlsMat A) +{ + int i, j, colSize; + realtype *col_j; + + switch (A->type) { + + case SUNDIALS_DENSE: + + for (j=0; jN; j++) { + col_j = A->cols[j]; + for (i=0; iM; i++) + col_j[i] = ZERO; + } + + break; + + case SUNDIALS_BAND: + + colSize = A->mu + A->ml + 1; + for (j=0; jM; j++) { + col_j = A->cols[j] + A->s_mu - A->mu; + for (i=0; itype) { + + case SUNDIALS_DENSE: + + printf("\n"); + for (i=0; i < A->M; i++) { + for (j=0; j < A->N; j++) { +#if defined(SUNDIALS_EXTENDED_PRECISION) + printf("%12Lg ", DENSE_ELEM(A,i,j)); +#elif defined(SUNDIALS_DOUBLE_PRECISION) + printf("%12lg ", DENSE_ELEM(A,i,j)); +#else + printf("%12g ", DENSE_ELEM(A,i,j)); +#endif + } + printf("\n"); + } + printf("\n"); + + break; + + case SUNDIALS_BAND: + + a = A->cols; + printf("\n"); + for (i=0; i < A->N; i++) { + start = MAX(0,i-A->ml); + finish = MIN(A->N-1,i+A->mu); + for (j=0; j < start; j++) printf("%12s ",""); + for (j=start; j <= finish; j++) { +#if defined(SUNDIALS_EXTENDED_PRECISION) + printf("%12Lg ", a[j][i-j+A->s_mu]); +#elif defined(SUNDIALS_DOUBLE_PRECISION) + printf("%12lg ", a[j][i-j+A->s_mu]); +#else + printf("%12g ", a[j][i-j+A->s_mu]); +#endif + } + printf("\n"); + } + printf("\n"); + + break; + + } + +} + + diff --git a/odemex/Parser/CVode/cv_src/src/sundials/sundials_iterative.c b/odemex/Parser/CVode/cv_src/src/sundials/sundials_iterative.c new file mode 100644 index 0000000..41ccc17 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/sundials/sundials_iterative.c @@ -0,0 +1,288 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.1 $ + * $Date: 2006/07/05 15:32:38 $ + * ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and + * Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for the iterative.h header + * file. It contains the implementation of functions that may be + * useful for many different iterative solvers of A x = b. + * ----------------------------------------------------------------- + */ + +#include + +#include +#include + +#define FACTOR RCONST(1000.0) +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + +/* + * ----------------------------------------------------------------- + * Function : ModifiedGS + * ----------------------------------------------------------------- + * This implementation of ModifiedGS is a slight modification of a + * previous modified Gram-Schmidt routine (called mgs) written by + * Milo Dorr. + * ----------------------------------------------------------------- + */ + +int ModifiedGS(N_Vector *v, realtype **h, int k, int p, + realtype *new_vk_norm) +{ + int i, k_minus_1, i0; + realtype new_norm_2, new_product, vk_norm, temp; + + vk_norm = RSqrt(N_VDotProd(v[k],v[k])); + k_minus_1 = k - 1; + i0 = MAX(k-p, 0); + + /* Perform modified Gram-Schmidt */ + + for (i=i0; i < k; i++) { + h[i][k_minus_1] = N_VDotProd(v[i], v[k]); + N_VLinearSum(ONE, v[k], -h[i][k_minus_1], v[i], v[k]); + } + + /* Compute the norm of the new vector at v[k] */ + + *new_vk_norm = RSqrt(N_VDotProd(v[k], v[k])); + + /* If the norm of the new vector at v[k] is less than + FACTOR (== 1000) times unit roundoff times the norm of the + input vector v[k], then the vector will be reorthogonalized + in order to ensure that nonorthogonality is not being masked + by a very small vector length. */ + + temp = FACTOR * vk_norm; + if ((temp + (*new_vk_norm)) != temp) return(0); + + new_norm_2 = ZERO; + + for (i=i0; i < k; i++) { + new_product = N_VDotProd(v[i], v[k]); + temp = FACTOR * h[i][k_minus_1]; + if ((temp + new_product) == temp) continue; + h[i][k_minus_1] += new_product; + N_VLinearSum(ONE, v[k],-new_product, v[i], v[k]); + new_norm_2 += SQR(new_product); + } + + if (new_norm_2 != ZERO) { + new_product = SQR(*new_vk_norm) - new_norm_2; + *new_vk_norm = (new_product > ZERO) ? RSqrt(new_product) : ZERO; + } + + return(0); +} + +/* + * ----------------------------------------------------------------- + * Function : ClassicalGS + * ----------------------------------------------------------------- + * This implementation of ClassicalGS was contributed by Homer Walker + * and Peter Brown. + * ----------------------------------------------------------------- + */ + +int ClassicalGS(N_Vector *v, realtype **h, int k, int p, + realtype *new_vk_norm, N_Vector temp, realtype *s) +{ + int i, k_minus_1, i0; + realtype vk_norm; + + k_minus_1 = k - 1; + + /* Perform Classical Gram-Schmidt */ + + vk_norm = RSqrt(N_VDotProd(v[k], v[k])); + + i0 = MAX(k-p, 0); + for (i=i0; i < k; i++) { + h[i][k_minus_1] = N_VDotProd(v[i], v[k]); + } + + for (i=i0; i < k; i++) { + N_VLinearSum(ONE, v[k], -h[i][k_minus_1], v[i], v[k]); + } + + /* Compute the norm of the new vector at v[k] */ + + *new_vk_norm = RSqrt(N_VDotProd(v[k], v[k])); + + /* Reorthogonalize if necessary */ + + if ((FACTOR * (*new_vk_norm)) < vk_norm) { + + for (i=i0; i < k; i++) { + s[i] = N_VDotProd(v[i], v[k]); + } + + if (i0 < k) { + N_VScale(s[i0], v[i0], temp); + h[i0][k_minus_1] += s[i0]; + } + for (i=i0+1; i < k; i++) { + N_VLinearSum(s[i], v[i], ONE, temp, temp); + h[i][k_minus_1] += s[i]; + } + N_VLinearSum(ONE, v[k], -ONE, temp, v[k]); + + *new_vk_norm = RSqrt(N_VDotProd(v[k],v[k])); + } + + return(0); +} + +/* + * ----------------------------------------------------------------- + * Function : QRfact + * ----------------------------------------------------------------- + * This implementation of QRfact is a slight modification of a + * previous routine (called qrfact) written by Milo Dorr. + * ----------------------------------------------------------------- + */ + +int QRfact(int n, realtype **h, realtype *q, int job) +{ + realtype c, s, temp1, temp2, temp3; + int i, j, k, q_ptr, n_minus_1, code=0; + + switch (job) { + case 0: + + /* Compute a new factorization of H */ + + code = 0; + for (k=0; k < n; k++) { + + /* Multiply column k by the previous k-1 Givens rotations */ + + for (j=0; j < k-1; j++) { + i = 2*j; + temp1 = h[j][k]; + temp2 = h[j+1][k]; + c = q[i]; + s = q[i+1]; + h[j][k] = c*temp1 - s*temp2; + h[j+1][k] = s*temp1 + c*temp2; + } + + /* Compute the Givens rotation components c and s */ + + q_ptr = 2*k; + temp1 = h[k][k]; + temp2 = h[k+1][k]; + if( temp2 == ZERO) { + c = ONE; + s = ZERO; + } else if (ABS(temp2) >= ABS(temp1)) { + temp3 = temp1/temp2; + s = -ONE/RSqrt(ONE+SQR(temp3)); + c = -s*temp3; + } else { + temp3 = temp2/temp1; + c = ONE/RSqrt(ONE+SQR(temp3)); + s = -c*temp3; + } + q[q_ptr] = c; + q[q_ptr+1] = s; + if( (h[k][k] = c*temp1 - s*temp2) == ZERO) code = k+1; + } + break; + + default: + + /* Update the factored H to which a new column has been added */ + + n_minus_1 = n - 1; + code = 0; + + /* Multiply the new column by the previous n-1 Givens rotations */ + + for (k=0; k < n_minus_1; k++) { + i = 2*k; + temp1 = h[k][n_minus_1]; + temp2 = h[k+1][n_minus_1]; + c = q[i]; + s = q[i+1]; + h[k][n_minus_1] = c*temp1 - s*temp2; + h[k+1][n_minus_1] = s*temp1 + c*temp2; + } + + /* Compute new Givens rotation and multiply it times the last two + entries in the new column of H. Note that the second entry of + this product will be 0, so it is not necessary to compute it. */ + + temp1 = h[n_minus_1][n_minus_1]; + temp2 = h[n][n_minus_1]; + if (temp2 == ZERO) { + c = ONE; + s = ZERO; + } else if (ABS(temp2) >= ABS(temp1)) { + temp3 = temp1/temp2; + s = -ONE/RSqrt(ONE+SQR(temp3)); + c = -s*temp3; + } else { + temp3 = temp2/temp1; + c = ONE/RSqrt(ONE+SQR(temp3)); + s = -c*temp3; + } + q_ptr = 2*n_minus_1; + q[q_ptr] = c; + q[q_ptr+1] = s; + if ((h[n_minus_1][n_minus_1] = c*temp1 - s*temp2) == ZERO) + code = n; + } + + return (code); +} + +/* + * ----------------------------------------------------------------- + * Function : QRsol + * ----------------------------------------------------------------- + * This implementation of QRsol is a slight modification of a + * previous routine (called qrsol) written by Milo Dorr. + * ----------------------------------------------------------------- + */ + +int QRsol(int n, realtype **h, realtype *q, realtype *b) +{ + realtype c, s, temp1, temp2; + int i, k, q_ptr, code=0; + + /* Compute Q*b */ + + for (k=0; k < n; k++) { + q_ptr = 2*k; + c = q[q_ptr]; + s = q[q_ptr+1]; + temp1 = b[k]; + temp2 = b[k+1]; + b[k] = c*temp1 - s*temp2; + b[k+1] = s*temp1 + c*temp2; + } + + /* Solve R*x = Q*b */ + + for (k=n-1; k >= 0; k--) { + if (h[k][k] == ZERO) { + code = k + 1; + break; + } + b[k] /= h[k][k]; + for (i=0; i < k; i++) b[i] -= b[k]*h[i][k]; + } + + return (code); +} diff --git a/odemex/Parser/CVode/cv_src/src/sundials/sundials_math.c b/odemex/Parser/CVode/cv_src/src/sundials/sundials_math.c new file mode 100644 index 0000000..8bc9d59 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/sundials/sundials_math.c @@ -0,0 +1,94 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.1 $ + * $Date: 2006/07/05 15:32:38 $ + * ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and + * Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for a simple C-language math + * library. + * ----------------------------------------------------------------- + */ + +#include +#include +#include + +#include + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + +realtype RPowerI(realtype base, int exponent) +{ + int i, expt; + realtype prod; + + prod = ONE; + expt = abs(exponent); + for(i = 1; i <= expt; i++) prod *= base; + if (exponent < 0) prod = ONE/prod; + return(prod); +} + +realtype RPowerR(realtype base, realtype exponent) +{ + if (base <= ZERO) return(ZERO); + +#if defined(SUNDIALS_USE_GENERIC_MATH) + return((realtype) pow((double) base, (double) exponent)); +#elif defined(SUNDIALS_DOUBLE_PRECISION) + return(pow(base, exponent)); +#elif defined(SUNDIALS_SINGLE_PRECISION) + return(powf(base, exponent)); +#elif defined(SUNDIALS_EXTENDED_PRECISION) + return(powl(base, exponent)); +#endif +} + +realtype RSqrt(realtype x) +{ + if (x <= ZERO) return(ZERO); + +#if defined(SUNDIALS_USE_GENERIC_MATH) + return((realtype) sqrt((double) x)); +#elif defined(SUNDIALS_DOUBLE_PRECISION) + return(sqrt(x)); +#elif defined(SUNDIALS_SINGLE_PRECISION) + return(sqrtf(x)); +#elif defined(SUNDIALS_EXTENDED_PRECISION) + return(sqrtl(x)); +#endif +} + +realtype RAbs(realtype x) +{ +#if defined(SUNDIALS_USE_GENERIC_MATH) + return((realtype) fabs((double) x)); +#elif defined(SUNDIALS_DOUBLE_PRECISION) + return(fabs(x)); +#elif defined(SUNDIALS_SINGLE_PRECISION) + return(fabsf(x)); +#elif defined(SUNDIALS_EXTENDED_PRECISION) + return(fabsl(x)); +#endif +} + +realtype RExp(realtype x) +{ +#if defined(SUNDIALS_USE_GENERIC_MATH) + return((realtype) exp((double) x)); +#elif defined(SUNDIALS_DOUBLE_PRECISION) + return(exp(x)); +#elif defined(SUNDIALS_SINGLE_PRECISION) + return(expf(x)); +#elif defined(SUNDIALS_EXTENDED_PRECISION) + return(expl(x)); +#endif +} diff --git a/odemex/Parser/CVode/cv_src/src/sundials/sundials_nvector.c b/odemex/Parser/CVode/cv_src/src/sundials/sundials_nvector.c new file mode 100644 index 0000000..e8e1b83 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/sundials/sundials_nvector.c @@ -0,0 +1,233 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.3 $ + * $Date: 2007/04/06 20:33:30 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for a generic NVECTOR package. + * It contains the implementation of the N_Vector operations listed + * in nvector.h. + * ----------------------------------------------------------------- + */ + +#include + +#include + +/* + * ----------------------------------------------------------------- + * Functions in the 'ops' structure + * ----------------------------------------------------------------- + */ + +N_Vector N_VClone(N_Vector w) +{ + N_Vector v = NULL; + v = w->ops->nvclone(w); + return(v); +} + +N_Vector N_VCloneEmpty(N_Vector w) +{ + N_Vector v = NULL; + v = w->ops->nvcloneempty(w); + return(v); +} + +void N_VDestroy(N_Vector v) +{ + if (v==NULL) return; + v->ops->nvdestroy(v); + return; +} + +void N_VSpace(N_Vector v, long int *lrw, long int *liw) +{ + v->ops->nvspace(v, lrw, liw); + return; +} + +realtype *N_VGetArrayPointer(N_Vector v) +{ + return((realtype *) v->ops->nvgetarraypointer(v)); +} + +void N_VSetArrayPointer(realtype *v_data, N_Vector v) +{ + v->ops->nvsetarraypointer(v_data, v); + return; +} + +void N_VLinearSum(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z) +{ + z->ops->nvlinearsum(a, x, b, y, z); + return; +} + +void N_VConst(realtype c, N_Vector z) +{ + z->ops->nvconst(c, z); + return; +} + +void N_VProd(N_Vector x, N_Vector y, N_Vector z) +{ + z->ops->nvprod(x, y, z); + return; +} + +void N_VDiv(N_Vector x, N_Vector y, N_Vector z) +{ + z->ops->nvdiv(x, y, z); + return; +} + +void N_VScale(realtype c, N_Vector x, N_Vector z) +{ + z->ops->nvscale(c, x, z); + return; +} + +void N_VAbs(N_Vector x, N_Vector z) +{ + z->ops->nvabs(x, z); + return; +} + +void N_VInv(N_Vector x, N_Vector z) +{ + z->ops->nvinv(x, z); + return; +} + +void N_VAddConst(N_Vector x, realtype b, N_Vector z) +{ + z->ops->nvaddconst(x, b, z); + return; +} + +realtype N_VDotProd(N_Vector x, N_Vector y) +{ + return((realtype) y->ops->nvdotprod(x, y)); +} + +realtype N_VMaxNorm(N_Vector x) +{ + return((realtype) x->ops->nvmaxnorm(x)); +} + +realtype N_VWrmsNorm(N_Vector x, N_Vector w) +{ + return((realtype) x->ops->nvwrmsnorm(x, w)); +} + +realtype N_VWrmsNormMask(N_Vector x, N_Vector w, N_Vector id) +{ + return((realtype) x->ops->nvwrmsnormmask(x, w, id)); +} + +realtype N_VMin(N_Vector x) +{ + return((realtype) x->ops->nvmin(x)); +} + +realtype N_VWL2Norm(N_Vector x, N_Vector w) +{ + return((realtype) x->ops->nvwl2norm(x, w)); +} + +realtype N_VL1Norm(N_Vector x) +{ + return((realtype) x->ops->nvl1norm(x)); +} + +void N_VCompare(realtype c, N_Vector x, N_Vector z) +{ + z->ops->nvcompare(c, x, z); + return; +} + +booleantype N_VInvTest(N_Vector x, N_Vector z) +{ + return((booleantype) z->ops->nvinvtest(x, z)); +} + +booleantype N_VConstrMask(N_Vector c, N_Vector x, N_Vector m) +{ + return((booleantype) x->ops->nvconstrmask(c, x, m)); +} + +realtype N_VMinQuotient(N_Vector num, N_Vector denom) +{ + return((realtype) num->ops->nvminquotient(num, denom)); +} + +/* + * ----------------------------------------------------------------- + * Additional functions exported by the generic NVECTOR: + * N_VCloneEmptyVectorArray + * N_VCloneVectorArray + * N_VDestroyVectorArray + * ----------------------------------------------------------------- + */ + +N_Vector *N_VCloneEmptyVectorArray(int count, N_Vector w) +{ + N_Vector *vs = NULL; + int j; + + if (count <= 0) return(NULL); + + vs = (N_Vector *) malloc(count * sizeof(N_Vector)); + if(vs == NULL) return(NULL); + + for (j = 0; j < count; j++) { + vs[j] = N_VCloneEmpty(w); + if (vs[j] == NULL) { + N_VDestroyVectorArray(vs, j-1); + return(NULL); + } + } + + return(vs); +} + +N_Vector *N_VCloneVectorArray(int count, N_Vector w) +{ + N_Vector *vs = NULL; + int j; + + if (count <= 0) return(NULL); + + vs = (N_Vector *) malloc(count * sizeof(N_Vector)); + if(vs == NULL) return(NULL); + + for (j = 0; j < count; j++) { + vs[j] = N_VClone(w); + if (vs[j] == NULL) { + N_VDestroyVectorArray(vs, j-1); + return(NULL); + } + } + + return(vs); +} + +void N_VDestroyVectorArray(N_Vector *vs, int count) +{ + int j; + + if (vs==NULL) return; + + for (j = 0; j < count; j++) N_VDestroy(vs[j]); + + free(vs); vs = NULL; + + return; +} diff --git a/odemex/Parser/CVode/cv_src/src/sundials/sundials_spbcgs.c b/odemex/Parser/CVode/cv_src/src/sundials/sundials_spbcgs.c new file mode 100644 index 0000000..b73bf26 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/sundials/sundials_spbcgs.c @@ -0,0 +1,379 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2007/04/06 20:33:30 $ + * ----------------------------------------------------------------- + * Programmer(s): Peter Brown and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2004, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for the scaled, preconditioned + * Bi-CGSTAB (SPBCG) iterative linear solver. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include +#include + +/* + * ----------------------------------------------------------------- + * private constants + * ----------------------------------------------------------------- + */ + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + +/* + * ----------------------------------------------------------------- + * Function : SpbcgMalloc + * ----------------------------------------------------------------- + */ + +SpbcgMem SpbcgMalloc(int l_max, N_Vector vec_tmpl) +{ + SpbcgMem mem; + N_Vector r_star, r, p, q, u, Ap, vtemp; + + /* Check the input parameters */ + + if (l_max <= 0) return(NULL); + + /* Get arrays to hold temporary vectors */ + + r_star = N_VClone(vec_tmpl); + if (r_star == NULL) { + return(NULL); + } + + r = N_VClone(vec_tmpl); + if (r == NULL) { + N_VDestroy(r_star); + return(NULL); + } + + p = N_VClone(vec_tmpl); + if (p == NULL) { + N_VDestroy(r_star); + N_VDestroy(r); + return(NULL); + } + + q = N_VClone(vec_tmpl); + if (q == NULL) { + N_VDestroy(r_star); + N_VDestroy(r); + N_VDestroy(p); + return(NULL); + } + + u = N_VClone(vec_tmpl); + if (u == NULL) { + N_VDestroy(r_star); + N_VDestroy(r); + N_VDestroy(p); + N_VDestroy(q); + return(NULL); + } + + Ap = N_VClone(vec_tmpl); + if (Ap == NULL) { + N_VDestroy(r_star); + N_VDestroy(r); + N_VDestroy(p); + N_VDestroy(q); + N_VDestroy(u); + return(NULL); + } + + vtemp = N_VClone(vec_tmpl); + if (vtemp == NULL) { + N_VDestroy(r_star); + N_VDestroy(r); + N_VDestroy(p); + N_VDestroy(q); + N_VDestroy(u); + N_VDestroy(Ap); + return(NULL); + } + + /* Get memory for an SpbcgMemRec containing SPBCG matrices and vectors */ + + mem = NULL; + mem = (SpbcgMem) malloc(sizeof(SpbcgMemRec)); + if (mem == NULL) { + N_VDestroy(r_star); + N_VDestroy(r); + N_VDestroy(p); + N_VDestroy(q); + N_VDestroy(u); + N_VDestroy(Ap); + N_VDestroy(vtemp); + return(NULL); + } + + /* Set the fields of mem */ + + mem->l_max = l_max; + mem->r_star = r_star; + mem->r = r; + mem->p = p; + mem->q = q; + mem->u = u; + mem->Ap = Ap; + mem->vtemp = vtemp; + + /* Return the pointer to SPBCG memory */ + + return(mem); +} + +/* + * ----------------------------------------------------------------- + * Function : SpbcgSolve + * ----------------------------------------------------------------- + */ + +int SpbcgSolve(SpbcgMem mem, void *A_data, N_Vector x, N_Vector b, + int pretype, realtype delta, void *P_data, N_Vector sx, + N_Vector sb, ATimesFn atimes, PSolveFn psolve, + realtype *res_norm, int *nli, int *nps) +{ + realtype alpha, beta, omega, omega_denom, beta_num, beta_denom, r_norm, rho; + N_Vector r_star, r, p, q, u, Ap, vtemp; + booleantype preOnLeft, preOnRight, scale_x, scale_b, converged; + int l, l_max, ier; + + if (mem == NULL) return(SPBCG_MEM_NULL); + + /* Make local copies of mem variables */ + + l_max = mem->l_max; + r_star = mem->r_star; + r = mem->r; + p = mem->p; + q = mem->q; + u = mem->u; + Ap = mem->Ap; + vtemp = mem->vtemp; + + *nli = *nps = 0; /* Initialize counters */ + converged = FALSE; /* Initialize converged flag */ + + if ((pretype != PREC_LEFT) && (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) pretype = PREC_NONE; + + preOnLeft = ((pretype == PREC_BOTH) || (pretype == PREC_LEFT)); + preOnRight = ((pretype == PREC_BOTH) || (pretype == PREC_RIGHT)); + + scale_x = (sx != NULL); + scale_b = (sb != NULL); + + /* Set r_star to initial (unscaled) residual r_0 = b - A*x_0 */ + + if (N_VDotProd(x, x) == ZERO) N_VScale(ONE, b, r_star); + else { + ier = atimes(A_data, x, r_star); + if (ier != 0) + return((ier < 0) ? SPBCG_ATIMES_FAIL_UNREC : SPBCG_ATIMES_FAIL_REC); + N_VLinearSum(ONE, b, -ONE, r_star, r_star); + } + + /* Apply left preconditioner and b-scaling to r_star = r_0 */ + + if (preOnLeft) { + ier = psolve(P_data, r_star, r, PREC_LEFT); + (*nps)++; + if (ier != 0) return((ier < 0) ? SPBCG_PSOLVE_FAIL_UNREC : SPBCG_PSOLVE_FAIL_REC); + } + else N_VScale(ONE, r_star, r); + + if (scale_b) N_VProd(sb, r, r_star); + else N_VScale(ONE, r, r_star); + + /* Initialize beta_denom to the dot product of r0 with r0 */ + + beta_denom = N_VDotProd(r_star, r_star); + + /* Set r_norm to L2 norm of r_star = sb P1_inv r_0, and + return if small */ + + *res_norm = r_norm = rho = RSqrt(beta_denom); + if (r_norm <= delta) return(SPBCG_SUCCESS); + + /* Copy r_star to r and p */ + + N_VScale(ONE, r_star, r); + N_VScale(ONE, r_star, p); + + /* Begin main iteration loop */ + + for(l = 0; l < l_max; l++) { + + (*nli)++; + + /* Generate Ap = A-tilde p, where A-tilde = sb P1_inv A P2_inv sx_inv */ + + /* Apply x-scaling: vtemp = sx_inv p */ + + if (scale_x) N_VDiv(p, sx, vtemp); + else N_VScale(ONE, p, vtemp); + + /* Apply right preconditioner: vtemp = P2_inv sx_inv p */ + + if (preOnRight) { + N_VScale(ONE, vtemp, Ap); + ier = psolve(P_data, Ap, vtemp, PREC_RIGHT); + (*nps)++; + if (ier != 0) return((ier < 0) ? SPBCG_PSOLVE_FAIL_UNREC : SPBCG_PSOLVE_FAIL_REC); + } + + /* Apply A: Ap = A P2_inv sx_inv p */ + + ier = atimes(A_data, vtemp, Ap ); + if (ier != 0) + return((ier < 0) ? SPBCG_ATIMES_FAIL_UNREC : SPBCG_ATIMES_FAIL_REC); + + /* Apply left preconditioner: vtemp = P1_inv A P2_inv sx_inv p */ + + if (preOnLeft) { + ier = psolve(P_data, Ap, vtemp, PREC_LEFT); + (*nps)++; + if (ier != 0) return((ier < 0) ? SPBCG_PSOLVE_FAIL_UNREC : SPBCG_PSOLVE_FAIL_REC); + } + else N_VScale(ONE, Ap, vtemp); + + /* Apply b-scaling: Ap = sb P1_inv A P2_inv sx_inv p */ + + if (scale_b) N_VProd(sb, vtemp, Ap); + else N_VScale(ONE, vtemp, Ap); + + + /* Calculate alpha = / */ + + alpha = ((N_VDotProd(r, r_star) / N_VDotProd(Ap, r_star))); + + /* Update q = r - alpha*Ap = r - alpha*(sb P1_inv A P2_inv sx_inv p) */ + + N_VLinearSum(ONE, r, -alpha, Ap, q); + + /* Generate u = A-tilde q */ + + /* Apply x-scaling: vtemp = sx_inv q */ + + if (scale_x) N_VDiv(q, sx, vtemp); + else N_VScale(ONE, q, vtemp); + + /* Apply right preconditioner: vtemp = P2_inv sx_inv q */ + + if (preOnRight) { + N_VScale(ONE, vtemp, u); + ier = psolve(P_data, u, vtemp, PREC_RIGHT); + (*nps)++; + if (ier != 0) return((ier < 0) ? SPBCG_PSOLVE_FAIL_UNREC : SPBCG_PSOLVE_FAIL_REC); + } + + /* Apply A: u = A P2_inv sx_inv u */ + + ier = atimes(A_data, vtemp, u ); + if (ier != 0) + return((ier < 0) ? SPBCG_ATIMES_FAIL_UNREC : SPBCG_ATIMES_FAIL_REC); + + /* Apply left preconditioner: vtemp = P1_inv A P2_inv sx_inv p */ + + if (preOnLeft) { + ier = psolve(P_data, u, vtemp, PREC_LEFT); + (*nps)++; + if (ier != 0) return((ier < 0) ? SPBCG_PSOLVE_FAIL_UNREC : SPBCG_PSOLVE_FAIL_REC); + } + else N_VScale(ONE, u, vtemp); + + /* Apply b-scaling: u = sb P1_inv A P2_inv sx_inv u */ + + if (scale_b) N_VProd(sb, vtemp, u); + else N_VScale(ONE, vtemp, u); + + + /* Calculate omega = / */ + + omega_denom = N_VDotProd(u, u); + if (omega_denom == ZERO) omega_denom = ONE; + omega = (N_VDotProd(u, q) / omega_denom); + + /* Update x = x + alpha*p + omega*q */ + + N_VLinearSum(alpha, p, omega, q, vtemp); + N_VLinearSum(ONE, x, ONE, vtemp, x); + + /* Update the residual r = q - omega*u */ + + N_VLinearSum(ONE, q, -omega, u, r); + + /* Set rho = norm(r) and check convergence */ + + *res_norm = rho = RSqrt(N_VDotProd(r, r)); + if (rho <= delta) { + converged = TRUE; + break; + } + + /* Not yet converged, continue iteration */ + /* Update beta = / * alpha / omega */ + + beta_num = N_VDotProd(r, r_star); + beta = ((beta_num / beta_denom) * (alpha / omega)); + beta_denom = beta_num; + + /* Update p = r + beta*(p - omega*Ap) */ + + N_VLinearSum(ONE, p, -omega, Ap, vtemp); + N_VLinearSum(ONE, r, beta, vtemp, p); + + } + + /* Main loop finished */ + + if ((converged == TRUE) || (rho < r_norm)) { + + /* Apply the x-scaling and right preconditioner: x = P2_inv sx_inv x */ + + if (scale_x) N_VDiv(x, sx, x); + if (preOnRight) { + ier = psolve(P_data, x, vtemp, PREC_RIGHT); + (*nps)++; + if (ier != 0) return((ier < 0) ? SPBCG_PSOLVE_FAIL_UNREC : SPBCG_PSOLVE_FAIL_REC); + N_VScale(ONE, vtemp, x); + } + + if (converged == TRUE) return(SPBCG_SUCCESS); + else return(SPBCG_RES_REDUCED); + } + else return(SPBCG_CONV_FAIL); +} + +/* + * ----------------------------------------------------------------- + * Function : SpbcgFree + * ----------------------------------------------------------------- + */ + +void SpbcgFree(SpbcgMem mem) +{ + + if (mem == NULL) return; + + N_VDestroy(mem->r_star); + N_VDestroy(mem->r); + N_VDestroy(mem->p); + N_VDestroy(mem->q); + N_VDestroy(mem->u); + N_VDestroy(mem->Ap); + N_VDestroy(mem->vtemp); + + free(mem); mem = NULL; +} diff --git a/odemex/Parser/CVode/cv_src/src/sundials/sundials_spgmr.c b/odemex/Parser/CVode/cv_src/src/sundials/sundials_spgmr.c new file mode 100644 index 0000000..7efd187 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/sundials/sundials_spgmr.c @@ -0,0 +1,458 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2007/04/06 20:33:30 $ + * ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and + * Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for the scaled preconditioned + * GMRES (SPGMR) iterative linear solver. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include +#include + +/* + * ----------------------------------------------------------------- + * private constants + * ----------------------------------------------------------------- + */ + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + +/* + * ----------------------------------------------------------------- + * Function : SpgmrMalloc + * ----------------------------------------------------------------- + */ + +SpgmrMem SpgmrMalloc(int l_max, N_Vector vec_tmpl) +{ + SpgmrMem mem; + N_Vector *V, xcor, vtemp; + realtype **Hes, *givens, *yg; + int k, i; + + /* Check the input parameters. */ + + if (l_max <= 0) return(NULL); + + /* Get memory for the Krylov basis vectors V[0], ..., V[l_max]. */ + + V = N_VCloneVectorArray(l_max+1, vec_tmpl); + if (V == NULL) return(NULL); + + /* Get memory for the Hessenberg matrix Hes. */ + + Hes = NULL; + Hes = (realtype **) malloc((l_max+1)*sizeof(realtype *)); + if (Hes == NULL) { + N_VDestroyVectorArray(V, l_max+1); + return(NULL); + } + + for (k = 0; k <= l_max; k++) { + Hes[k] = NULL; + Hes[k] = (realtype *) malloc(l_max*sizeof(realtype)); + if (Hes[k] == NULL) { + for (i = 0; i < k; i++) {free(Hes[i]); Hes[i] = NULL;} + free(Hes); Hes = NULL; + N_VDestroyVectorArray(V, l_max+1); + return(NULL); + } + } + + /* Get memory for Givens rotation components. */ + + givens = NULL; + givens = (realtype *) malloc(2*l_max*sizeof(realtype)); + if (givens == NULL) { + for (i = 0; i <= l_max; i++) {free(Hes[i]); Hes[i] = NULL;} + free(Hes); Hes = NULL; + N_VDestroyVectorArray(V, l_max+1); + return(NULL); + } + + /* Get memory to hold the correction to z_tilde. */ + + xcor = N_VClone(vec_tmpl); + if (xcor == NULL) { + free(givens); givens = NULL; + for (i = 0; i <= l_max; i++) {free(Hes[i]); Hes[i] = NULL;} + free(Hes); Hes = NULL; + N_VDestroyVectorArray(V, l_max+1); + return(NULL); + } + + /* Get memory to hold SPGMR y and g vectors. */ + + yg = NULL; + yg = (realtype *) malloc((l_max+1)*sizeof(realtype)); + if (yg == NULL) { + N_VDestroy(xcor); + free(givens); givens = NULL; + for (i = 0; i <= l_max; i++) {free(Hes[i]); Hes[i] = NULL;} + free(Hes); Hes = NULL; + N_VDestroyVectorArray(V, l_max+1); + return(NULL); + } + + /* Get an array to hold a temporary vector. */ + + vtemp = N_VClone(vec_tmpl); + if (vtemp == NULL) { + free(yg); yg = NULL; + N_VDestroy(xcor); + free(givens); givens = NULL; + for (i = 0; i <= l_max; i++) {free(Hes[i]); Hes[i] = NULL;} + free(Hes); Hes = NULL; + N_VDestroyVectorArray(V, l_max+1); + return(NULL); + } + + /* Get memory for an SpgmrMemRec containing SPGMR matrices and vectors. */ + + mem = NULL; + mem = (SpgmrMem) malloc(sizeof(SpgmrMemRec)); + if (mem == NULL) { + N_VDestroy(vtemp); + free(yg); yg = NULL; + N_VDestroy(xcor); + free(givens); givens = NULL; + for (i = 0; i <= l_max; i++) {free(Hes[i]); Hes[i] = NULL;} + free(Hes); Hes = NULL; + N_VDestroyVectorArray(V, l_max+1); + return(NULL); + } + + /* Set the fields of mem. */ + + mem->l_max = l_max; + mem->V = V; + mem->Hes = Hes; + mem->givens = givens; + mem->xcor = xcor; + mem->yg = yg; + mem->vtemp = vtemp; + + /* Return the pointer to SPGMR memory. */ + + return(mem); +} + +/* + * ----------------------------------------------------------------- + * Function : SpgmrSolve + * ----------------------------------------------------------------- + */ + +int SpgmrSolve(SpgmrMem mem, void *A_data, N_Vector x, N_Vector b, + int pretype, int gstype, realtype delta, int max_restarts, + void *P_data, N_Vector s1, N_Vector s2, ATimesFn atimes, + PSolveFn psolve, realtype *res_norm, int *nli, int *nps) +{ + N_Vector *V, xcor, vtemp; + realtype **Hes, *givens, *yg; + realtype beta, rotation_product, r_norm, s_product, rho; + booleantype preOnLeft, preOnRight, scale2, scale1, converged; + int i, j, k, l, l_plus_1, l_max, krydim, ier, ntries; + + if (mem == NULL) return(SPGMR_MEM_NULL); + + /* Initialize some variables */ + + l_plus_1 = 0; + krydim = 0; + + /* Make local copies of mem variables. */ + + l_max = mem->l_max; + V = mem->V; + Hes = mem->Hes; + givens = mem->givens; + xcor = mem->xcor; + yg = mem->yg; + vtemp = mem->vtemp; + + *nli = *nps = 0; /* Initialize counters */ + converged = FALSE; /* Initialize converged flag */ + + if (max_restarts < 0) max_restarts = 0; + + if ((pretype != PREC_LEFT) && (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) + pretype = PREC_NONE; + + preOnLeft = ((pretype == PREC_LEFT) || (pretype == PREC_BOTH)); + preOnRight = ((pretype == PREC_RIGHT) || (pretype == PREC_BOTH)); + scale1 = (s1 != NULL); + scale2 = (s2 != NULL); + + /* Set vtemp and V[0] to initial (unscaled) residual r_0 = b - A*x_0. */ + + if (N_VDotProd(x, x) == ZERO) { + N_VScale(ONE, b, vtemp); + } else { + ier = atimes(A_data, x, vtemp); + if (ier != 0) + return((ier < 0) ? SPGMR_ATIMES_FAIL_UNREC : SPGMR_ATIMES_FAIL_REC); + N_VLinearSum(ONE, b, -ONE, vtemp, vtemp); + } + N_VScale(ONE, vtemp, V[0]); + + /* Apply left preconditioner and left scaling to V[0] = r_0. */ + + if (preOnLeft) { + ier = psolve(P_data, V[0], vtemp, PREC_LEFT); + (*nps)++; + if (ier != 0) + return((ier < 0) ? SPGMR_PSOLVE_FAIL_UNREC : SPGMR_PSOLVE_FAIL_REC); + } else { + N_VScale(ONE, V[0], vtemp); + } + + if (scale1) { + N_VProd(s1, vtemp, V[0]); + } else { + N_VScale(ONE, vtemp, V[0]); + } + + /* Set r_norm = beta to L2 norm of V[0] = s1 P1_inv r_0, and + return if small. */ + + *res_norm = r_norm = beta = RSqrt(N_VDotProd(V[0], V[0])); + if (r_norm <= delta) + return(SPGMR_SUCCESS); + + /* Initialize rho to avoid compiler warning message */ + + rho = beta; + + /* Set xcor = 0. */ + + N_VConst(ZERO, xcor); + + + /* Begin outer iterations: up to (max_restarts + 1) attempts. */ + + for (ntries = 0; ntries <= max_restarts; ntries++) { + + /* Initialize the Hessenberg matrix Hes and Givens rotation + product. Normalize the initial vector V[0]. */ + + for (i = 0; i <= l_max; i++) + for (j = 0; j < l_max; j++) + Hes[i][j] = ZERO; + + rotation_product = ONE; + + N_VScale(ONE/r_norm, V[0], V[0]); + + /* Inner loop: generate Krylov sequence and Arnoldi basis. */ + + for (l = 0; l < l_max; l++) { + + (*nli)++; + + krydim = l_plus_1 = l + 1; + + /* Generate A-tilde V[l], where A-tilde = s1 P1_inv A P2_inv s2_inv. */ + + /* Apply right scaling: vtemp = s2_inv V[l]. */ + + if (scale2) N_VDiv(V[l], s2, vtemp); + else N_VScale(ONE, V[l], vtemp); + + /* Apply right preconditioner: vtemp = P2_inv s2_inv V[l]. */ + + if (preOnRight) { + N_VScale(ONE, vtemp, V[l_plus_1]); + ier = psolve(P_data, V[l_plus_1], vtemp, PREC_RIGHT); + (*nps)++; + if (ier != 0) + return((ier < 0) ? SPGMR_PSOLVE_FAIL_UNREC : SPGMR_PSOLVE_FAIL_REC); + } + + /* Apply A: V[l+1] = A P2_inv s2_inv V[l]. */ + + ier = atimes(A_data, vtemp, V[l_plus_1] ); + if (ier != 0) + return((ier < 0) ? SPGMR_ATIMES_FAIL_UNREC : SPGMR_ATIMES_FAIL_REC); + + /* Apply left preconditioning: vtemp = P1_inv A P2_inv s2_inv V[l]. */ + + if (preOnLeft) { + ier = psolve(P_data, V[l_plus_1], vtemp, PREC_LEFT); + (*nps)++; + if (ier != 0) + return((ier < 0) ? SPGMR_PSOLVE_FAIL_UNREC : SPGMR_PSOLVE_FAIL_REC); + } else { + N_VScale(ONE, V[l_plus_1], vtemp); + } + + /* Apply left scaling: V[l+1] = s1 P1_inv A P2_inv s2_inv V[l]. */ + + if (scale1) { + N_VProd(s1, vtemp, V[l_plus_1]); + } else { + N_VScale(ONE, vtemp, V[l_plus_1]); + } + + /* Orthogonalize V[l+1] against previous V[i]: V[l+1] = w_tilde. */ + + if (gstype == CLASSICAL_GS) { + if (ClassicalGS(V, Hes, l_plus_1, l_max, &(Hes[l_plus_1][l]), + vtemp, yg) != 0) + return(SPGMR_GS_FAIL); + } else { + if (ModifiedGS(V, Hes, l_plus_1, l_max, &(Hes[l_plus_1][l])) != 0) + return(SPGMR_GS_FAIL); + } + + /* Update the QR factorization of Hes. */ + + if(QRfact(krydim, Hes, givens, l) != 0 ) + return(SPGMR_QRFACT_FAIL); + + /* Update residual norm estimate; break if convergence test passes. */ + + rotation_product *= givens[2*l+1]; + *res_norm = rho = ABS(rotation_product*r_norm); + + if (rho <= delta) { converged = TRUE; break; } + + /* Normalize V[l+1] with norm value from the Gram-Schmidt routine. */ + + N_VScale(ONE/Hes[l_plus_1][l], V[l_plus_1], V[l_plus_1]); + } + + /* Inner loop is done. Compute the new correction vector xcor. */ + + /* Construct g, then solve for y. */ + + yg[0] = r_norm; + for (i = 1; i <= krydim; i++) yg[i]=ZERO; + if (QRsol(krydim, Hes, givens, yg) != 0) + return(SPGMR_QRSOL_FAIL); + + /* Add correction vector V_l y to xcor. */ + + for (k = 0; k < krydim; k++) + N_VLinearSum(yg[k], V[k], ONE, xcor, xcor); + + /* If converged, construct the final solution vector x and return. */ + + if (converged) { + + /* Apply right scaling and right precond.: vtemp = P2_inv s2_inv xcor. */ + + if (scale2) N_VDiv(xcor, s2, xcor); + if (preOnRight) { + ier = psolve(P_data, xcor, vtemp, PREC_RIGHT); + (*nps)++; + if (ier != 0) + return((ier < 0) ? SPGMR_PSOLVE_FAIL_UNREC : SPGMR_PSOLVE_FAIL_REC); + } else { + N_VScale(ONE, xcor, vtemp); + } + + /* Add vtemp to initial x to get final solution x, and return */ + + N_VLinearSum(ONE, x, ONE, vtemp, x); + + return(SPGMR_SUCCESS); + } + + /* Not yet converged; if allowed, prepare for restart. */ + + if (ntries == max_restarts) break; + + /* Construct last column of Q in yg. */ + + s_product = ONE; + for (i = krydim; i > 0; i--) { + yg[i] = s_product*givens[2*i-2]; + s_product *= givens[2*i-1]; + } + yg[0] = s_product; + + /* Scale r_norm and yg. */ + r_norm *= s_product; + for (i = 0; i <= krydim; i++) + yg[i] *= r_norm; + r_norm = ABS(r_norm); + + /* Multiply yg by V_(krydim+1) to get last residual vector; restart. */ + N_VScale(yg[0], V[0], V[0]); + for (k = 1; k <= krydim; k++) + N_VLinearSum(yg[k], V[k], ONE, V[0], V[0]); + + } + + /* Failed to converge, even after allowed restarts. + If the residual norm was reduced below its initial value, compute + and return x anyway. Otherwise return failure flag. */ + + if (rho < beta) { + + /* Apply right scaling and right precond.: vtemp = P2_inv s2_inv xcor. */ + + if (scale2) N_VDiv(xcor, s2, xcor); + if (preOnRight) { + ier = psolve(P_data, xcor, vtemp, PREC_RIGHT); + (*nps)++; + if (ier != 0) + return((ier < 0) ? SPGMR_PSOLVE_FAIL_UNREC : SPGMR_PSOLVE_FAIL_REC); + } else { + N_VScale(ONE, xcor, vtemp); + } + + /* Add vtemp to initial x to get final solution x, and return. */ + + N_VLinearSum(ONE, x, ONE, vtemp, x); + + return(SPGMR_RES_REDUCED); + } + + return(SPGMR_CONV_FAIL); +} + +/* + * ----------------------------------------------------------------- + * Function : SpgmrFree + * ----------------------------------------------------------------- + */ + +void SpgmrFree(SpgmrMem mem) +{ + int i, l_max; + realtype **Hes, *givens, *yg; + + if (mem == NULL) return; + + l_max = mem->l_max; + Hes = mem->Hes; + givens = mem->givens; + yg = mem->yg; + + for (i = 0; i <= l_max; i++) {free(Hes[i]); Hes[i] = NULL;} + free(Hes); Hes = NULL; + free(mem->givens); givens = NULL; + free(mem->yg); yg = NULL; + + N_VDestroyVectorArray(mem->V, l_max+1); + N_VDestroy(mem->xcor); + N_VDestroy(mem->vtemp); + + free(mem); mem = NULL; +} diff --git a/odemex/Parser/CVode/cv_src/src/sundials/sundials_sptfqmr.c b/odemex/Parser/CVode/cv_src/src/sundials/sundials_sptfqmr.c new file mode 100644 index 0000000..626ca00 --- /dev/null +++ b/odemex/Parser/CVode/cv_src/src/sundials/sundials_sptfqmr.c @@ -0,0 +1,516 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2007/04/06 20:33:30 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for the scaled preconditioned + * Transpose-Free Quasi-Minimal Residual (SPTFQMR) linear solver. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include +#include + +/* + * ----------------------------------------------------------------- + * private constants + * ----------------------------------------------------------------- + */ + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + +/* + * ----------------------------------------------------------------- + * Function : SptfqmrMalloc + * ----------------------------------------------------------------- + */ + +SptfqmrMem SptfqmrMalloc(int l_max, N_Vector vec_tmpl) +{ + SptfqmrMem mem; + N_Vector *r; + N_Vector q, d, v, p, u; + N_Vector r_star, vtemp1, vtemp2, vtemp3; + + /* Check the input parameters */ + if ((l_max <= 0) || (vec_tmpl == NULL)) return(NULL); + + /* Allocate space for vectors */ + + r_star = N_VClone(vec_tmpl); + if (r_star == NULL) return(NULL); + + q = N_VClone(vec_tmpl); + if (q == NULL) { + N_VDestroy(r_star); + return(NULL); + } + + d = N_VClone(vec_tmpl); + if (d == NULL) { + N_VDestroy(r_star); + N_VDestroy(q); + return(NULL); + } + + v = N_VClone(vec_tmpl); + if (v == NULL) { + N_VDestroy(r_star); + N_VDestroy(q); + N_VDestroy(d); + return(NULL); + } + + p = N_VClone(vec_tmpl); + if (p == NULL) { + N_VDestroy(r_star); + N_VDestroy(q); + N_VDestroy(d); + N_VDestroy(v); + return(NULL); + } + + r = N_VCloneVectorArray(2, vec_tmpl); + if (r == NULL) { + N_VDestroy(r_star); + N_VDestroy(q); + N_VDestroy(d); + N_VDestroy(v); + N_VDestroy(p); + return(NULL); + } + + u = N_VClone(vec_tmpl); + if (u == NULL) { + N_VDestroy(r_star); + N_VDestroy(q); + N_VDestroy(d); + N_VDestroy(v); + N_VDestroy(p); + N_VDestroyVectorArray(r, 2); + return(NULL); + } + + vtemp1 = N_VClone(vec_tmpl); + if (vtemp1 == NULL) { + N_VDestroy(r_star); + N_VDestroy(q); + N_VDestroy(d); + N_VDestroy(v); + N_VDestroy(p); + N_VDestroyVectorArray(r, 2); + N_VDestroy(u); + return(NULL); + } + + vtemp2 = N_VClone(vec_tmpl); + if (vtemp2 == NULL) { + N_VDestroy(r_star); + N_VDestroy(q); + N_VDestroy(d); + N_VDestroy(v); + N_VDestroy(p); + N_VDestroyVectorArray(r, 2); + N_VDestroy(u); + N_VDestroy(vtemp1); + return(NULL); + } + + vtemp3 = N_VClone(vec_tmpl); + if (vtemp3 == NULL) { + N_VDestroy(r_star); + N_VDestroy(q); + N_VDestroy(d); + N_VDestroy(v); + N_VDestroy(p); + N_VDestroyVectorArray(r, 2); + N_VDestroy(u); + N_VDestroy(vtemp1); + N_VDestroy(vtemp2); + return(NULL); + } + + /* Allocate memory for SptfqmrMemRec */ + mem = NULL; + mem = (SptfqmrMem) malloc(sizeof(SptfqmrMemRec)); + if (mem == NULL) { + N_VDestroy(r_star); + N_VDestroy(q); + N_VDestroy(d); + N_VDestroy(v); + N_VDestroy(p); + N_VDestroyVectorArray(r, 2); + N_VDestroy(u); + N_VDestroy(vtemp1); + N_VDestroy(vtemp2); + N_VDestroy(vtemp3); + return(NULL); + } + + /* Intialize SptfqmrMemRec data structure */ + mem->l_max = l_max; + mem->r_star = r_star; + mem->q = q; + mem->d = d; + mem->v = v; + mem->p = p; + mem->r = r; + mem->u = u; + mem->vtemp1 = vtemp1; + mem->vtemp2 = vtemp2; + mem->vtemp3 = vtemp3; + + /* Return pointer to SPTFQMR memory block */ + return(mem); +} + +#define l_max (mem->l_max) +#define r_star (mem->r_star) +#define q_ (mem->q) +#define d_ (mem->d) +#define v_ (mem->v) +#define p_ (mem->p) +#define r_ (mem->r) +#define u_ (mem->u) +#define vtemp1 (mem->vtemp1) +#define vtemp2 (mem->vtemp2) +#define vtemp3 (mem->vtemp3) + +/* + * ----------------------------------------------------------------- + * Function : SptfqmrSolve + * ----------------------------------------------------------------- + */ + +int SptfqmrSolve(SptfqmrMem mem, void *A_data, N_Vector x, N_Vector b, + int pretype, realtype delta, void *P_data, N_Vector sx, + N_Vector sb, ATimesFn atimes, PSolveFn psolve, + realtype *res_norm, int *nli, int *nps) +{ + realtype alpha, tau, eta, beta, c, sigma, v_bar, omega; + realtype rho[2]; + realtype r_init_norm, r_curr_norm; + realtype temp_val; + booleantype preOnLeft, preOnRight, scale_x, scale_b, converged; + booleantype b_ok; + int n, m, ier; + + /* Exit immediately if memory pointer is NULL */ + if (mem == NULL) return(SPTFQMR_MEM_NULL); + + temp_val = r_curr_norm = -ONE; /* Initialize to avoid compiler warnings */ + + *nli = *nps = 0; /* Initialize counters */ + converged = FALSE; /* Initialize convergence flag */ + b_ok = FALSE; + + if ((pretype != PREC_LEFT) && + (pretype != PREC_RIGHT) && + (pretype != PREC_BOTH)) pretype = PREC_NONE; + + preOnLeft = ((pretype == PREC_BOTH) || (pretype == PREC_LEFT)); + preOnRight = ((pretype == PREC_BOTH) || (pretype == PREC_RIGHT)); + + scale_x = (sx != NULL); + scale_b = (sb != NULL); + + /* Set r_star to initial (unscaled) residual r_star = r_0 = b - A*x_0 */ + /* NOTE: if x == 0 then just set residual to b and continue */ + if (N_VDotProd(x, x) == ZERO) N_VScale(ONE, b, r_star); + else { + ier = atimes(A_data, x, r_star); + if (ier != 0) + return((ier < 0) ? SPTFQMR_ATIMES_FAIL_UNREC : SPTFQMR_ATIMES_FAIL_REC); + N_VLinearSum(ONE, b, -ONE, r_star, r_star); + } + + /* Apply left preconditioner and b-scaling to r_star (or really just r_0) */ + if (preOnLeft) { + ier = psolve(P_data, r_star, vtemp1, PREC_LEFT); + (*nps)++; + if (ier != 0) + return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); + } + else N_VScale(ONE, r_star, vtemp1); + if (scale_b) N_VProd(sb, vtemp1, r_star); + else N_VScale(ONE, vtemp1, r_star); + + /* Initialize rho[0] */ + /* NOTE: initialized here to reduce number of computations - avoid need + to compute r_star^T*r_star twice, and avoid needlessly squaring + values */ + rho[0] = N_VDotProd(r_star, r_star); + + /* Compute norm of initial residual (r_0) to see if we really need + to do anything */ + *res_norm = r_init_norm = RSqrt(rho[0]); + if (r_init_norm <= delta) return(SPTFQMR_SUCCESS); + + /* Set v_ = A*r_0 (preconditioned and scaled) */ + if (scale_x) N_VDiv(r_star, sx, vtemp1); + else N_VScale(ONE, r_star, vtemp1); + if (preOnRight) { + N_VScale(ONE, vtemp1, v_); + ier = psolve(P_data, v_, vtemp1, PREC_RIGHT); + (*nps)++; + if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); + } + ier = atimes(A_data, vtemp1, v_); + if (ier != 0) + return((ier < 0) ? SPTFQMR_ATIMES_FAIL_UNREC : SPTFQMR_ATIMES_FAIL_REC); + if (preOnLeft) { + ier = psolve(P_data, v_, vtemp1, PREC_LEFT); + (*nps)++; + if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); + } + else N_VScale(ONE, v_, vtemp1); + if (scale_b) N_VProd(sb, vtemp1, v_); + else N_VScale(ONE, vtemp1, v_); + + /* Initialize remaining variables */ + N_VScale(ONE, r_star, r_[0]); + N_VScale(ONE, r_star, u_); + N_VScale(ONE, r_star, p_); + N_VConst(ZERO, d_); + + tau = r_init_norm; + v_bar = eta = ZERO; + + /* START outer loop */ + for (n = 0; n < l_max; ++n) { + + /* Increment linear iteration counter */ + (*nli)++; + + /* sigma = r_star^T*v_ */ + sigma = N_VDotProd(r_star, v_); + + /* alpha = rho[0]/sigma */ + alpha = rho[0]/sigma; + + /* q_ = u_-alpha*v_ */ + N_VLinearSum(ONE, u_, -alpha, v_, q_); + + /* r_[1] = r_[0]-alpha*A*(u_+q_) */ + N_VLinearSum(ONE, u_, ONE, q_, r_[1]); + if (scale_x) N_VDiv(r_[1], sx, r_[1]); + if (preOnRight) { + N_VScale(ONE, r_[1], vtemp1); + ier = psolve(P_data, vtemp1, r_[1], PREC_RIGHT); + (*nps)++; + if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); + } + ier = atimes(A_data, r_[1], vtemp1); + if (ier != 0) + return((ier < 0) ? SPTFQMR_ATIMES_FAIL_UNREC : SPTFQMR_ATIMES_FAIL_REC); + if (preOnLeft) { + ier = psolve(P_data, vtemp1, r_[1], PREC_LEFT); + (*nps)++; + if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); + } + else N_VScale(ONE, vtemp1, r_[1]); + if (scale_b) N_VProd(sb, r_[1], vtemp1); + else N_VScale(ONE, r_[1], vtemp1); + N_VLinearSum(ONE, r_[0], -alpha, vtemp1, r_[1]); + + /* START inner loop */ + for (m = 0; m < 2; ++m) { + + /* d_ = [*]+(v_bar^2*eta/alpha)*d_ */ + /* NOTES: + * (1) [*] = u_ if m == 0, and q_ if m == 1 + * (2) using temp_val reduces the number of required computations + * if the inner loop is executed twice + */ + if (m == 0) { + temp_val = RSqrt(N_VDotProd(r_[1], r_[1])); + omega = RSqrt(RSqrt(N_VDotProd(r_[0], r_[0]))*temp_val); + N_VLinearSum(ONE, u_, SQR(v_bar)*eta/alpha, d_, d_); + } + else { + omega = temp_val; + N_VLinearSum(ONE, q_, SQR(v_bar)*eta/alpha, d_, d_); + } + + /* v_bar = omega/tau */ + v_bar = omega/tau; + + /* c = (1+v_bar^2)^(-1/2) */ + c = ONE / RSqrt(ONE+SQR(v_bar)); + + /* tau = tau*v_bar*c */ + tau = tau*v_bar*c; + + /* eta = c^2*alpha */ + eta = SQR(c)*alpha; + + /* x = x+eta*d_ */ + N_VLinearSum(ONE, x, eta, d_, x); + + /* Check for convergence... */ + /* NOTE: just use approximation to norm of residual, if possible */ + *res_norm = r_curr_norm = tau*RSqrt(m+1); + + /* Exit inner loop if iteration has converged based upon approximation + to norm of current residual */ + if (r_curr_norm <= delta) { + converged = TRUE; + break; + } + + /* Decide if actual norm of residual vector should be computed */ + /* NOTES: + * (1) if r_curr_norm > delta, then check if actual residual norm + * is OK (recall we first compute an approximation) + * (2) if r_curr_norm >= r_init_norm and m == 1 and n == l_max, then + * compute actual residual norm to see if the iteration can be + * saved + * (3) the scaled and preconditioned right-hand side of the given + * linear system (denoted by b) is only computed once, and the + * result is stored in vtemp3 so it can be reused - reduces the + * number of psovles if using left preconditioning + */ + if ((r_curr_norm > delta) || + (r_curr_norm >= r_init_norm && m == 1 && n == l_max)) { + + /* Compute norm of residual ||b-A*x||_2 (preconditioned and scaled) */ + if (scale_x) N_VDiv(x, sx, vtemp1); + else N_VScale(ONE, x, vtemp1); + if (preOnRight) { + ier = psolve(P_data, vtemp1, vtemp2, PREC_RIGHT); + (*nps)++; + if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_UNREC); + N_VScale(ONE, vtemp2, vtemp1); + } + ier = atimes(A_data, vtemp1, vtemp2); + if (ier != 0) + return((ier < 0) ? SPTFQMR_ATIMES_FAIL_UNREC : SPTFQMR_ATIMES_FAIL_REC); + if (preOnLeft) { + ier = psolve(P_data, vtemp2, vtemp1, PREC_LEFT); + (*nps)++; + if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); + } + else N_VScale(ONE, vtemp2, vtemp1); + if (scale_b) N_VProd(sb, vtemp1, vtemp2); + else N_VScale(ONE, vtemp1, vtemp2); + /* Only precondition and scale b once (result saved for reuse) */ + if (!b_ok) { + b_ok = TRUE; + if (preOnLeft) { + ier = psolve(P_data, b, vtemp3, PREC_LEFT); + (*nps)++; + if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); + } + else N_VScale(ONE, b, vtemp3); + if (scale_b) N_VProd(sb, vtemp3, vtemp3); + } + N_VLinearSum(ONE, vtemp3, -ONE, vtemp2, vtemp1); + *res_norm = r_curr_norm = RSqrt(N_VDotProd(vtemp1, vtemp1)); + + /* Exit inner loop if inequality condition is satisfied + (meaning exit if we have converged) */ + if (r_curr_norm <= delta) { + converged = TRUE; + break; + } + + } + + } /* END inner loop */ + + /* If converged, then exit outer loop as well */ + if (converged == TRUE) break; + + /* rho[1] = r_star^T*r_[1] */ + rho[1] = N_VDotProd(r_star, r_[1]); + + /* beta = rho[1]/rho[0] */ + beta = rho[1]/rho[0]; + + /* u_ = r_[1]+beta*q_ */ + N_VLinearSum(ONE, r_[1], beta, q_, u_); + + /* p_ = u_+beta*(q_+beta*p_) */ + N_VLinearSum(beta, q_, SQR(beta), p_, p_); + N_VLinearSum(ONE, u_, ONE, p_, p_); + + /* v_ = A*p_ */ + if (scale_x) N_VDiv(p_, sx, vtemp1); + else N_VScale(ONE, p_, vtemp1); + if (preOnRight) { + N_VScale(ONE, vtemp1, v_); + ier = psolve(P_data, v_, vtemp1, PREC_RIGHT); + (*nps)++; + if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); + } + ier = atimes(A_data, vtemp1, v_); + if (ier != 0) + return((ier < 0) ? SPTFQMR_ATIMES_FAIL_UNREC : SPTFQMR_ATIMES_FAIL_REC); + if (preOnLeft) { + ier = psolve(P_data, v_, vtemp1, PREC_LEFT); + (*nps)++; + if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); + } + else N_VScale(ONE, v_, vtemp1); + if (scale_b) N_VProd(sb, vtemp1, v_); + else N_VScale(ONE, vtemp1, v_); + + /* Shift variable values */ + /* NOTE: reduces storage requirements */ + N_VScale(ONE, r_[1], r_[0]); + rho[0] = rho[1]; + + } /* END outer loop */ + + /* Determine return value */ + /* If iteration converged or residual was reduced, then return current iterate (x) */ + if ((converged == TRUE) || (r_curr_norm < r_init_norm)) { + if (scale_x) N_VDiv(x, sx, x); + if (preOnRight) { + ier = psolve(P_data, x, vtemp1, PREC_RIGHT); + (*nps)++; + if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_UNREC); + N_VScale(ONE, vtemp1, x); + } + if (converged == TRUE) return(SPTFQMR_SUCCESS); + else return(SPTFQMR_RES_REDUCED); + } + /* Otherwise, return error code */ + else return(SPTFQMR_CONV_FAIL); +} + +/* + * ----------------------------------------------------------------- + * Function : SptfqmrFree + * ----------------------------------------------------------------- + */ + +void SptfqmrFree(SptfqmrMem mem) +{ + + if (mem == NULL) return; + + N_VDestroy(r_star); + N_VDestroy(q_); + N_VDestroy(d_); + N_VDestroy(v_); + N_VDestroy(p_); + N_VDestroyVectorArray(r_, 2); + N_VDestroy(u_); + N_VDestroy(vtemp1); + N_VDestroy(vtemp2); + N_VDestroy(vtemp3); + + free(mem); mem = NULL; +} diff --git a/odemex/Parser/CVode/ida_src/include/ida.h b/odemex/Parser/CVode/ida_src/include/ida.h new file mode 100644 index 0000000..ae1f335 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/ida.h @@ -0,0 +1,944 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.12 $ + * $Date: 2007/11/26 16:19:58 $ + * ----------------------------------------------------------------- + * Programmer(s): Allan G. Taylor, Alan C. Hindmarsh, Radu Serban, + * and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California + * Produced at the Lawrence Livermore National Laboratory + * All rights reserved + * For details, see the LICENSE file + * ----------------------------------------------------------------- + * This is the header (include) file for the main IDA solver. + * ----------------------------------------------------------------- + * + * IDA is used to solve numerically the initial value problem + * for the differential algebraic equation (DAE) system + * F(t,y,y') = 0, + * given initial conditions + * y(t0) = y0, y'(t0) = yp0. + * Here y and F are vectors of length N. + * + * ----------------------------------------------------------------- + */ + +#ifndef _IDA_H +#define _IDA_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +#include + +/* + * ================================================================= + * I D A C O N S T A N T S + * ================================================================= + */ + +/* + * ---------------------------------------------------------------- + * Inputs to IDAInit, IDAReInit, IDACalcIC, and IDASolve. + * ---------------------------------------------------------------- + */ + +/* itask */ +#define IDA_NORMAL 1 +#define IDA_ONE_STEP 2 + +/* icopt */ +#define IDA_YA_YDP_INIT 1 +#define IDA_Y_INIT 2 + +/* + * ---------------------------------------- + * IDA return flags + * ---------------------------------------- + */ + +#define IDA_SUCCESS 0 +#define IDA_TSTOP_RETURN 1 +#define IDA_ROOT_RETURN 2 + +#define IDA_WARNING 99 + +#define IDA_MEM_NULL -1 +#define IDA_ILL_INPUT -2 +#define IDA_NO_MALLOC -3 +#define IDA_TOO_MUCH_WORK -4 +#define IDA_TOO_MUCH_ACC -5 +#define IDA_ERR_FAIL -6 +#define IDA_CONV_FAIL -7 +#define IDA_LINIT_FAIL -8 +#define IDA_LSETUP_FAIL -9 +#define IDA_LSOLVE_FAIL -10 +#define IDA_RES_FAIL -11 +#define IDA_CONSTR_FAIL -12 +#define IDA_REP_RES_ERR -13 + +#define IDA_MEM_FAIL -14 + +#define IDA_BAD_T -15 + +#define IDA_BAD_EWT -16 +#define IDA_FIRST_RES_FAIL -17 +#define IDA_LINESEARCH_FAIL -18 +#define IDA_NO_RECOVERY -19 + +#define IDA_RTFUNC_FAIL -20 + +/* + * ---------------------------------------------------------------- + * Type : IDAResFn + * ---------------------------------------------------------------- + * The F function which defines the DAE system F(t,y,y')=0 + * must have type IDAResFn. + * Symbols are as follows: + * t <-> t y <-> yy + * y' <-> yp F <-> rr + * A IDAResFn takes as input the independent variable value t, + * the dependent variable vector yy, and the derivative (with + * respect to t) of the yy vector, yp. It stores the result of + * F(t,y,y') in the vector rr. The yy, yp, and rr arguments are of + * type N_Vector. The user_data parameter is the pointer user_data + * passed by the user to the IDASetRdata routine. This user-supplied + * pointer is passed to the user's res function every time it is called, + * to provide access in res to user data. + * + * A IDAResFn res should return a value of 0 if successful, a positive + * value if a recoverable error occured (e.g. yy has an illegal value), + * or a negative value if a nonrecoverable error occured. In the latter + * case, the program halts. If a recoverable error occured, the integrator + * will attempt to correct and retry. + * ---------------------------------------------------------------- + */ + +typedef int (*IDAResFn)(realtype tt, N_Vector yy, N_Vector yp, + N_Vector rr, void *user_data); + +/* + * ----------------------------------------------------------------- + * Type : IDARootFn + * ----------------------------------------------------------------- + * A function g, which defines a set of functions g_i(t,y,y') whose + * roots are sought during the integration, must have type IDARootFn. + * The function g takes as input the independent variable value t, + * the dependent variable vector y, and its t-derivative yp (= y'). + * It stores the nrtfn values g_i(t,y,y') in the realtype array gout. + * (Allocation of memory for gout is handled within IDA.) + * The user_data parameter is the same as that passed by the user + * to the IDASetRdata routine. This user-supplied pointer is + * passed to the user's g function every time it is called. + * + * An IDARootFn should return 0 if successful or a non-zero value + * if an error occured (in which case the integration will be halted). + * ----------------------------------------------------------------- + */ + +typedef int (*IDARootFn)(realtype t, N_Vector y, N_Vector yp, + realtype *gout, void *user_data); + +/* + * ----------------------------------------------------------------- + * Type : IDAEwtFn + * ----------------------------------------------------------------- + * A function e, which sets the error weight vector ewt, must have + * type IDAEwtFn. + * The function e takes as input the current dependent variable y. + * It must set the vector of error weights used in the WRMS norm: + * + * ||y||_WRMS = sqrt [ 1/N * sum ( ewt_i * y_i)^2 ] + * + * Typically, the vector ewt has components: + * + * ewt_i = 1 / (reltol * |y_i| + abstol_i) + * + * The user_data parameter is the same as that passed by the user + * to the IDASetRdata routine. This user-supplied pointer is + * passed to the user's e function every time it is called. + * An IDAEwtFn e must return 0 if the error weight vector has been + * successfuly set and a non-zero value otherwise. + * ----------------------------------------------------------------- + */ + +typedef int (*IDAEwtFn)(N_Vector y, N_Vector ewt, void *user_data); + +/* + * ----------------------------------------------------------------- + * Type : IDAErrHandlerFn + * ----------------------------------------------------------------- + * A function eh, which handles error messages, must have type + * IDAErrHandlerFn. + * The function eh takes as input the error code, the name of the + * module reporting the error, the error message, and a pointer to + * user data, the same as that passed to IDASetRdata. + * + * All error codes are negative, except IDA_WARNING which indicates + * a warning (the solver continues). + * + * An IDAErrHandlerFn has no return value. + * ----------------------------------------------------------------- + */ + +typedef void (*IDAErrHandlerFn)(int error_code, + const char *module, const char *function, + char *msg, void *user_data); + +/* + * ================================================================ + * U S E R - C A L L A B L E R O U T I N E S + * ================================================================ + */ + +/* + * ---------------------------------------------------------------- + * Function : IDACreate + * ---------------------------------------------------------------- + * IDACreate creates an internal memory block for a problem to + * be solved by IDA. + * + * If successful, IDACreate returns a pointer to initialized + * problem memory. This pointer should be passed to IDAInit. + * If an initialization error occurs, IDACreate prints an error + * message to standard err and returns NULL. + * + * ---------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void *IDACreate(void); + +/* + * ---------------------------------------------------------------- + * Integrator optional input specification functions + * ---------------------------------------------------------------- + * The following functions can be called to set optional inputs + * to values other than the defaults given below: + * + * | + * Function | Optional input / [ default value ] + * | + * ---------------------------------------------------------------- + * | + * IDASetErrHandlerFn | user-provided ErrHandler function. + * | [internal] + * | + * IDASetErrFile | the file pointer for an error file + * | where all IDA warning and error + * | messages will be written if the default + * | internal error handling function is used. + * | This parameter can be stdout (standard + * | output), stderr (standard error), or a + * | file pointer (corresponding to a user + * | error file opened for writing) returned + * | by fopen. + * | If not called, then all messages will + * | be written to the standard error stream. + * | [stderr] + * | + * IDASetUserData | a pointer to user data that will be + * | passed to the user's res function every + * | time a user-supplied function is called. + * | [NULL] + * | + * IDASetMaxOrd | maximum lmm order to be used by the + * | solver. + * | [5] + * | + * IDASetMaxNumSteps | maximum number of internal steps to be + * | taken by the solver in its attempt to + * | reach tout. + * | [500] + * | + * IDASetInitStep | initial step size. + * | [estimated by IDA] + * | + * IDASetMaxStep | maximum absolute value of step size + * | allowed. + * | [infinity] + * | + * IDASetStopTime | the independent variable value past + * | which the solution is not to proceed. + * | [infinity] + * | + * IDASetNonlinConvCoef | Newton convergence test constant + * | for use during integration. + * | [0.33] + * | + * IDASetMaxErrTestFails| Maximum number of error test failures + * | in attempting one step. + * | [10] + * | + * IDASetMaxNonlinIters | Maximum number of nonlinear solver + * | iterations at one solution. + * | [4] + * | + * IDASetMaxConvFails | Maximum number of allowable conv. + * | failures in attempting one step. + * | [10] + * | + * IDASetSuppressAlg | flag to indicate whether or not to + * | suppress algebraic variables in the + * | local error tests: + * | FALSE = do not suppress; + * | TRUE = do suppress; + * | [FALSE] + * | NOTE: if suppressed algebraic variables + * | is selected, the nvector 'id' must be + * | supplied for identification of those + * | algebraic components (see IDASetId). + * | + * IDASetId | an N_Vector, which states a given + * | element to be either algebraic or + * | differential. + * | A value of 1.0 indicates a differential + * | variable while a 0.0 indicates an + * | algebraic variable. 'id' is required + * | if optional input SUPPRESSALG is set, + * | or if IDACalcIC is to be called with + * | icopt = IDA_YA_YDP_INIT. + * | + * IDASetConstraints | an N_Vector defining inequality + * | constraints for each component of the + * | solution vector y. If a given element + * | of this vector has values +2 or -2, + * | then the corresponding component of y + * | will be constrained to be > 0.0 or + * | <0.0, respectively, while if it is +1 + * | or -1, the y component is constrained + * | to be >= 0.0 or <= 0.0, respectively. + * | If a component of constraints is 0.0, + * | then no constraint is imposed on the + * | corresponding component of y. + * | The presence of a non-NULL constraints + * | vector that is not 0.0 (ZERO) in all + * | components will cause constraint + * | checking to be performed. + * | + * ----------------------------------------------------------------- + * | + * IDASetRootDirection | Specifies the direction of zero + * | crossings to be monitored + * | [both directions] + * | + * IDASetNoInactiveRootWarn | disable warning about possible + * | g==0 at beginning of integration + * | + * ----------------------------------------------------------------- + * Return flag: + * IDA_SUCCESS if successful + * IDA_MEM_NULL if the ida memory is NULL + * IDA_ILL_INPUT if an argument has an illegal value + * + * ---------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDASetErrHandlerFn(void *ida_mem, IDAErrHandlerFn ehfun, void *eh_data); +SUNDIALS_EXPORT int IDASetErrFile(void *ida_mem, FILE *errfp); +SUNDIALS_EXPORT int IDASetUserData(void *ida_mem, void *user_data); +SUNDIALS_EXPORT int IDASetMaxOrd(void *ida_mem, int maxord); +SUNDIALS_EXPORT int IDASetMaxNumSteps(void *ida_mem, long int mxsteps); +SUNDIALS_EXPORT int IDASetInitStep(void *ida_mem, realtype hin); +SUNDIALS_EXPORT int IDASetMaxStep(void *ida_mem, realtype hmax); +SUNDIALS_EXPORT int IDASetStopTime(void *ida_mem, realtype tstop); +SUNDIALS_EXPORT int IDASetNonlinConvCoef(void *ida_mem, realtype epcon); +SUNDIALS_EXPORT int IDASetMaxErrTestFails(void *ida_mem, int maxnef); +SUNDIALS_EXPORT int IDASetMaxNonlinIters(void *ida_mem, int maxcor); +SUNDIALS_EXPORT int IDASetMaxConvFails(void *ida_mem, int maxncf); +SUNDIALS_EXPORT int IDASetSuppressAlg(void *ida_mem, booleantype suppressalg); +SUNDIALS_EXPORT int IDASetId(void *ida_mem, N_Vector id); +SUNDIALS_EXPORT int IDASetConstraints(void *ida_mem, N_Vector constraints); + +SUNDIALS_EXPORT int IDASetRootDirection(void *ida_mem, int *rootdir); +SUNDIALS_EXPORT int IDASetNoInactiveRootWarn(void *ida_mem); + +/* + * ---------------------------------------------------------------- + * Function : IDAInit + * ---------------------------------------------------------------- + * IDAInit allocates and initializes memory for a problem to + * to be solved by IDA. + * + * res is the residual function F in F(t,y,y') = 0. + * + * t0 is the initial value of t, the independent variable. + * + * yy0 is the initial condition vector y(t0). + * + * yp0 is the initial condition vector y'(t0) + * + * IDA_SUCCESS if successful + * IDA_MEM_NULL if the ida memory was NULL + * IDA_MEM_FAIL if a memory allocation failed + * IDA_ILL_INPUT f an argument has an illegal value. + * + * ---------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDAInit(void *ida_mem, IDAResFn res, + realtype t0, N_Vector yy0, N_Vector yp0); + +/* + * ---------------------------------------------------------------- + * Function : IDAReInit + * ---------------------------------------------------------------- + * IDAReInit re-initializes IDA for the solution of a problem, + * where a prior call to IDAInit has been made. + * IDAReInit performs the same input checking and initializations + * that IDAInit does. + * But it does no memory allocation, assuming that the existing + * internal memory is sufficient for the new problem. + * + * The use of IDAReInit requires that the maximum method order, + * maxord, is no larger for the new problem than for the problem + * specified in the last call to IDAInit. This condition is + * automatically fulfilled if the default value for maxord is + * specified. + * + * Following the call to IDAReInit, a call to the linear solver + * specification routine is necessary if a different linear solver + * is chosen, but may not be otherwise. If the same linear solver + * is chosen, and there are no changes in its input parameters, + * then no call to that routine is needed. + * + * The first argument to IDAReInit is: + * + * ida_mem = pointer to IDA memory returned by IDACreate. + * + * All the remaining arguments to IDAReInit have names and + * meanings identical to those of IDAInit. + * + * The return value of IDAReInit is equal to SUCCESS = 0 if there + * were no errors; otherwise it is a negative int equal to: + * IDA_MEM_NULL indicating ida_mem was NULL, or + * IDA_NO_MALLOC indicating that ida_mem was not allocated. + * IDA_ILL_INPUT indicating an input argument was illegal + * (including an attempt to increase maxord). + * In case of an error return, an error message is also printed. + * ---------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDAReInit(void *ida_mem, + realtype t0, N_Vector yy0, N_Vector yp0); + +/* + * ----------------------------------------------------------------- + * Functions : IDASStolerances + * IDASVtolerances + * IDAWFtolerances + * ----------------------------------------------------------------- + * + * These functions specify the integration tolerances. One of them + * MUST be called before the first call to IDA. + * + * IDASStolerances specifies scalar relative and absolute tolerances. + * IDASVtolerances specifies scalar relative tolerance and a vector + * absolute tolerance (a potentially different absolute tolerance + * for each vector component). + * IDAWFtolerances specifies a user-provides function (of type IDAEwtFn) + * which will be called to set the error weight vector. + * + * The tolerances reltol and abstol define a vector of error weights, + * ewt, with components + * ewt[i] = 1/(reltol*abs(y[i]) + abstol) (in the SS case), or + * ewt[i] = 1/(reltol*abs(y[i]) + abstol[i]) (in the SV case). + * This vector is used in all error and convergence tests, which + * use a weighted RMS norm on all error-like vectors v: + * WRMSnorm(v) = sqrt( (1/N) sum(i=1..N) (v[i]*ewt[i])^2 ), + * where N is the problem dimension. + * + * The return value of these functions is equal to IDA_SUCCESS = 0 if + * there were no errors; otherwise it is a negative int equal to: + * IDa_MEM_NULL indicating ida_mem was NULL (i.e., + * IDACreate has not been called). + * IDA_NO_MALLOC indicating that ida_mem has not been + * allocated (i.e., IDAInit has not been + * called). + * IDA_ILL_INPUT indicating an input argument was illegal + * (e.g. a negative tolerance) + * In case of an error return, an error message is also printed. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDASStolerances(void *ida_mem, realtype reltol, realtype abstol); +SUNDIALS_EXPORT int IDASVtolerances(void *ida_mem, realtype reltol, N_Vector abstol); +SUNDIALS_EXPORT int IDAWFtolerances(void *ida_mem, IDAEwtFn efun); + +/* ---------------------------------------------------------------- + * Initial Conditions optional input specification functions + * ---------------------------------------------------------------- + * The following functions can be called to set optional inputs + * to control the initial conditions calculations. + * + * | + * Function | Optional input / [ default value ] + * | + * -------------------------------------------------------------- + * | + * IDASetNonlinConvCoefIC | positive coeficient in the Newton + * | convergence test. This test uses a + * | weighted RMS norm (with weights + * | defined by the tolerances, as in + * | IDASolve). For new initial value + * | vectors y and y' to be accepted, the + * | norm of J-inverse F(t0,y,y') is + * | required to be less than epiccon, + * | where J is the system Jacobian. + * | [0.01 * 0.33] + * | + * IDASetMaxNumStepsIC | maximum number of values of h allowed + * | when icopt = IDA_YA_YDP_INIT, where + * | h appears in the system Jacobian, + * | J = dF/dy + (1/h)dF/dy'. + * | [5] + * | + * IDASetMaxNumJacsIC | maximum number of values of the + * | approximate Jacobian or preconditioner + * | allowed, when the Newton iterations + * | appear to be slowly converging. + * | [4] + * | + * IDASetMaxNumItersIC | maximum number of Newton iterations + * | allowed in any one attempt to solve + * | the IC problem. + * | [10] + * | + * IDASetLineSearchOffIC | a boolean flag to turn off the + * | linesearch algorithm. + * | [FALSE] + * | + * IDASetStepToleranceIC | positive lower bound on the norm of + * | a Newton step. + * | [(unit roundoff)^(2/3) + * + * ---------------------------------------------------------------- + * Return flag: + * IDA_SUCCESS if successful + * IDA_MEM_NULL if the ida memory is NULL + * IDA_ILL_INPUT if an argument has an illegal value + * + * ---------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDASetNonlinConvCoefIC(void *ida_mem, realtype epiccon); +SUNDIALS_EXPORT int IDASetMaxNumStepsIC(void *ida_mem, int maxnh); +SUNDIALS_EXPORT int IDASetMaxNumJacsIC(void *ida_mem, int maxnj); +SUNDIALS_EXPORT int IDASetMaxNumItersIC(void *ida_mem, int maxnit); +SUNDIALS_EXPORT int IDASetLineSearchOffIC(void *ida_mem, booleantype lsoff); +SUNDIALS_EXPORT int IDASetStepToleranceIC(void *ida_mem, realtype steptol); + +/* + * ----------------------------------------------------------------- + * Function : IDARootInit + * ----------------------------------------------------------------- + * IDARootInit initializes a rootfinding problem to be solved + * during the integration of the DAE system. It must be called + * after IDACreate, and before IDASolve. The arguments are: + * + * ida_mem = pointer to IDA memory returned by IDACreate. + * + * nrtfn = number of functions g_i, an int >= 0. + * + * g = name of user-supplied function, of type IDARootFn, + * defining the functions g_i whose roots are sought. + * + * If a new problem is to be solved with a call to IDAReInit, + * where the new problem has no root functions but the prior one + * did, then call IDARootInit with nrtfn = 0. + * + * The return value of IDARootInit is IDA_SUCCESS = 0 if there were + * no errors; otherwise it is a negative int equal to: + * IDA_MEM_NULL indicating ida_mem was NULL, or + * IDA_MEM_FAIL indicating a memory allocation failed. + * (including an attempt to increase maxord). + * IDA_ILL_INPUT indicating nrtfn > 0 but g = NULL. + * In case of an error return, an error message is also printed. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDARootInit(void *ida_mem, int nrtfn, IDARootFn g); + +/* + * ---------------------------------------------------------------- + * Function : IDACalcIC + * ---------------------------------------------------------------- + * IDACalcIC calculates corrected initial conditions for the DAE + * system for a class of index-one problems of semi-implicit form. + * It uses Newton iteration combined with a Linesearch algorithm. + * Calling IDACalcIC is optional. It is only necessary when the + * initial conditions do not solve the given system. I.e., if + * y0 and yp0 are known to satisfy F(t0, y0, yp0) = 0, then + * a call to IDACalcIC is NOT necessary (for index-one problems). + * + * A call to IDACalcIC must be preceded by a successful call to + * IDAInit or IDAReInit for the given DAE problem, and by a + * successful call to the linear system solver specification + * routine. + * + * The call to IDACalcIC should precede the call(s) to IDASolve + * for the given problem. + * + * The arguments to IDACalcIC are as follows: + * + * ida_mem is the pointer to IDA memory returned by IDACreate. + * + * icopt is the option of IDACalcIC to be used. + * icopt = IDA_YA_YDP_INIT directs IDACalcIC to compute + * the algebraic components of y and differential + * components of y', given the differential + * components of y. This option requires that the + * N_Vector id was set through a call to IDASetId + * specifying the differential and algebraic + * components. + * icopt = IDA_Y_INIT directs IDACalcIC to compute all + * components of y, given y'. id is not required. + * + * tout1 is the first value of t at which a soluton will be + * requested (from IDASolve). (This is needed here to + * determine the direction of integration and rough scale + * in the independent variable t.) + * + * + * IDACalcIC returns an int flag. Its symbolic values and their + * meanings are as follows. (The numerical return values are set + * above in this file.) All unsuccessful returns give a negative + * return value. If IFACalcIC failed, y0 and yp0 contain + * (possibly) altered values, computed during the attempt. + * + * IDA_SUCCESS IDACalcIC was successful. The corrected + * initial value vectors were stored internally. + * + * IDA_MEM_NULL The argument ida_mem was NULL. + * + * IDA_ILL_INPUT One of the input arguments was illegal. + * See printed message. + * + * IDA_LINIT_FAIL The linear solver's init routine failed. + * + * IDA_BAD_EWT Some component of the error weight vector + * is zero (illegal), either for the input + * value of y0 or a corrected value. + * + * IDA_RES_FAIL The user's residual routine returned + * a non-recoverable error flag. + * + * IDA_FIRST_RES_FAIL The user's residual routine returned + * a recoverable error flag on the first call, + * but IDACalcIC was unable to recover. + * + * IDA_LSETUP_FAIL The linear solver's setup routine had a + * non-recoverable error. + * + * IDA_LSOLVE_FAIL The linear solver's solve routine had a + * non-recoverable error. + * + * IDA_NO_RECOVERY The user's residual routine, or the linear + * solver's setup or solve routine had a + * recoverable error, but IDACalcIC was + * unable to recover. + * + * IDA_CONSTR_FAIL IDACalcIC was unable to find a solution + * satisfying the inequality constraints. + * + * IDA_LINESEARCH_FAIL The Linesearch algorithm failed to find a + * solution with a step larger than steptol + * in weighted RMS norm. + * + * IDA_CONV_FAIL IDACalcIC failed to get convergence of the + * Newton iterations. + * + * ---------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDACalcIC(void *ida_mem, int icopt, realtype tout1); + +/* + * ---------------------------------------------------------------- + * Function : IDASolve + * ---------------------------------------------------------------- + * IDASolve integrates the DAE over an interval in t, the + * independent variable. If itask is IDA_NORMAL, then the solver + * integrates from its current internal t value to a point at or + * beyond tout, then interpolates to t = tout and returns y(tret) + * in the user-allocated vector yret. In general, tret = tout. + * If itask is IDA_ONE_STEP, then the solver takes one internal + * step of the independent variable and returns in yret the value + * of y at the new internal independent variable value. In this + * case, tout is used only during the first call to IDASolve to + * determine the direction of integration and the rough scale of + * the problem. If tstop is enabled (through a call to IDASetStopTime), + * then IDASolve returns the solution at tstop. Once the integrator + * returns at a tstop time, any future testing for tstop is disabled + * (and can be reenabled only though a new call to IDASetStopTime). + * The time reached by the solver is placed in (*tret). The + * user is responsible for allocating the memory for this value. + * + * ida_mem is the pointer (void) to IDA memory returned by + * IDACreate. + * + * tout is the next independent variable value at which a + * computed solution is desired. + * + * tret is a pointer to a real location. IDASolve sets (*tret) + * to the actual t value reached, corresponding to the + * solution vector yret. In IDA_NORMAL mode, with no + * errors and no roots found, (*tret) = tout. + * + * yret is the computed solution vector. With no errors, + * yret = y(tret). + * + * ypret is the derivative of the computed solution at t = tret. + * + * Note: yret and ypret may be the same N_Vectors as y0 and yp0 + * in the call to IDAInit or IDAReInit. + * + * itask is IDA_NORMAL or IDA_ONE_STEP. These two modes are described above. + * + * + * The return values for IDASolve are described below. + * (The numerical return values are defined above in this file.) + * All unsuccessful returns give a negative return value. + * + * IDA_SUCCESS + * IDASolve succeeded and no roots were found. + * + * IDA_ROOT_RETURN: IDASolve succeeded, and found one or more roots. + * If nrtfn > 1, call IDAGetRootInfo to see which g_i were found + * to have a root at (*tret). + * + * IDA_TSTOP_RETURN: + * IDASolve returns computed results for the independent variable + * value tstop. That is, tstop was reached. + * + * IDA_MEM_NULL: + * The IDA_mem argument was NULL. + * + * IDA_ILL_INPUT: + * One of the inputs to IDASolve is illegal. This includes the + * situation when a component of the error weight vectors + * becomes < 0 during internal stepping. It also includes the + * situation where a root of one of the root functions was found + * both at t0 and very near t0. The ILL_INPUT flag + * will also be returned if the linear solver function IDA--- + * (called by the user after calling IDACreate) failed to set one + * of the linear solver-related fields in ida_mem or if the linear + * solver's init routine failed. In any case, the user should see + * the printed error message for more details. + * + * IDA_TOO_MUCH_WORK: + * The solver took mxstep internal steps but could not reach tout. + * The default value for mxstep is MXSTEP_DEFAULT = 500. + * + * IDA_TOO_MUCH_ACC: + * The solver could not satisfy the accuracy demanded by the user + * for some internal step. + * + * IDA_ERR_FAIL: + * Error test failures occurred too many times (=MXETF = 10) during + * one internal step. + * + * IDA_CONV_FAIL: + * Convergence test failures occurred too many times (= MXNCF = 10) + * during one internal step. + * + * IDA_LSETUP_FAIL: + * The linear solver's setup routine failed + * in an unrecoverable manner. + * + * IDA_LSOLVE_FAIL: + * The linear solver's solve routine failed + * in an unrecoverable manner. + * + * IDA_CONSTR_FAIL: + * The inequality constraints were violated, + * and the solver was unable to recover. + * + * IDA_REP_RES_ERR: + * The user's residual function repeatedly returned a recoverable + * error flag, but the solver was unable to recover. + * + * IDA_RES_FAIL: + * The user's residual function returned a nonrecoverable error + * flag. + * + * ---------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDASolve(void *ida_mem, realtype tout, realtype *tret, + N_Vector yret, N_Vector ypret, int itask); + +/* + * ---------------------------------------------------------------- + * Function: IDAGetSolution + * ---------------------------------------------------------------- + * + * This routine evaluates y(t) and y'(t) as the value and + * derivative of the interpolating polynomial at the independent + * variable t, and stores the results in the vectors yret and + * ypret. It uses the current independent variable value, tn, + * and the method order last used, kused. This function is + * called by IDASolve with t = tout, t = tn, or t = tstop. + * + * If kused = 0 (no step has been taken), or if t = tn, then the + * order used here is taken to be 1, giving yret = phi[0], + * ypret = phi[1]/psi[0]. + * + * The return values are: + * IDA_SUCCESS: succeess. + * IDA_BAD_T: t is not in the interval [tn-hu,tn]. + * IDA_MEM_NULL: The ida_mem argument was NULL. + * + * ---------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDAGetSolution(void *ida_mem, realtype t, + N_Vector yret, N_Vector ypret); + +/* ---------------------------------------------------------------- + * Integrator optional output extraction functions + * ---------------------------------------------------------------- + * + * The following functions can be called to get optional outputs + * and statistics related to the main integrator. + * ---------------------------------------------------------------- + * + * IDAGetWorkSpace returns the IDA real and integer workspace sizes + * IDAGetNumSteps returns the cumulative number of internal + * steps taken by the solver + * IDAGetNumRhsEvals returns the number of calls to the user's + * res function + * IDAGetNumLinSolvSetups returns the number of calls made to + * the linear solver's setup routine + * IDAGetNumErrTestFails returns the number of local error test + * failures that have occured + * IDAGetNumBacktrackOps returns the number of backtrack + * operations done in the linesearch algorithm in IDACalcIC + * IDAGetConsistentIC returns the consistent initial conditions + * computed by IDACalcIC + * IDAGetLastOrder returns the order used during the last + * internal step + * IDAGetCurentOrder returns the order to be used on the next + * internal step + * IDAGetActualInitStep returns the actual initial step size + * used by IDA + * IDAGetLAstStep returns the step size for the last internal + * step (if from IDASolve), or the last value of the + * artificial step size h (if from IDACalcIC) + * IDAGetCurrentStep returns the step size to be attempted on the + * next internal step + * IDAGetCurrentTime returns the current internal time reached + * by the solver + * IDAGetTolScaleFactor returns a suggested factor by which the + * user's tolerances should be scaled when too much + * accuracy has been requested for some internal step + * IDAGetErrWeights returns the current state error weight vector. + * The user must allocate space for eweight. + * IDAGetEstLocalErrors returns the estimated local errors. The user + * must allocate space for the vector ele. + * IDAGetNumGEvals returns the number of calls to the user's + * g function (for rootfinding) + * IDAGetRootInfo returns the indices for which g_i was found to + * have a root. The user must allocate space for rootsfound. + * For i = 0 ... nrtfn-1, rootsfound[i] = 1 if g_i has a root, + * and rootsfound[i]= 0 if not. + * + * IDAGet* return values: + * IDA_SUCCESS if succesful + * IDA_MEM_NULL if the ida memory was NULL + * IDA_ILL_INPUT if some input is illegal + * + * ---------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDAGetWorkSpace(void *ida_mem, long int *lenrw, long int *leniw); +SUNDIALS_EXPORT int IDAGetNumSteps(void *ida_mem, long int *nsteps); +SUNDIALS_EXPORT int IDAGetNumResEvals(void *ida_mem, long int *nrevals); +SUNDIALS_EXPORT int IDAGetNumLinSolvSetups(void *ida_mem, long int *nlinsetups); +SUNDIALS_EXPORT int IDAGetNumErrTestFails(void *ida_mem, long int *netfails); +SUNDIALS_EXPORT int IDAGetNumBacktrackOps(void *ida_mem, long int *nbacktr); +SUNDIALS_EXPORT int IDAGetConsistentIC(void *ida_mem, N_Vector yy0_mod, N_Vector yp0_mod); +SUNDIALS_EXPORT int IDAGetLastOrder(void *ida_mem, int *klast); +SUNDIALS_EXPORT int IDAGetCurrentOrder(void *ida_mem, int *kcur); +SUNDIALS_EXPORT int IDAGetActualInitStep(void *ida_mem, realtype *hinused); +SUNDIALS_EXPORT int IDAGetLastStep(void *ida_mem, realtype *hlast); +SUNDIALS_EXPORT int IDAGetCurrentStep(void *ida_mem, realtype *hcur); +SUNDIALS_EXPORT int IDAGetCurrentTime(void *ida_mem, realtype *tcur); +SUNDIALS_EXPORT int IDAGetTolScaleFactor(void *ida_mem, realtype *tolsfact); +SUNDIALS_EXPORT int IDAGetErrWeights(void *ida_mem, N_Vector eweight); +SUNDIALS_EXPORT int IDAGetEstLocalErrors(void *ida_mem, N_Vector ele); +SUNDIALS_EXPORT int IDAGetNumGEvals(void *ida_mem, long int *ngevals); +SUNDIALS_EXPORT int IDAGetRootInfo(void *ida_mem, int *rootsfound); + +/* + * ---------------------------------------------------------------- + * As a convenience, the following function provides the + * optional outputs in a group. + * ---------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDAGetIntegratorStats(void *ida_mem, long int *nsteps, + long int *nrevals, long int *nlinsetups, + long int *netfails, int *qlast, int *qcur, + realtype *hinused, realtype *hlast, realtype *hcur, + realtype *tcur); + +/* + * ---------------------------------------------------------------- + * Nonlinear solver optional output extraction functions + * ---------------------------------------------------------------- + * + * The following functions can be called to get optional outputs + * and statistics related to the nonlinear solver. + * -------------------------------------------------------------- + * + * IDAGetNumNonlinSolvIters returns the number of nonlinear + * solver iterations performed. + * IDAGetNumNonlinSolvConvFails returns the number of nonlinear + * convergence failures. + * + * ---------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDAGetNumNonlinSolvIters(void *ida_mem, long int *nniters); +SUNDIALS_EXPORT int IDAGetNumNonlinSolvConvFails(void *ida_mem, long int *nncfails); + +/* + * ---------------------------------------------------------------- + * As a convenience, the following function provides the + * nonlinear solver optional outputs in a group. + * ---------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDAGetNonlinSolvStats(void *ida_mem, long int *nniters, + long int *nncfails); + +/* + * ----------------------------------------------------------------- + * The following function returns the name of the constant + * associated with an IDA return flag + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT char *IDAGetReturnFlagName(int flag); + +/* + * ---------------------------------------------------------------- + * Function : IDAFree + * ---------------------------------------------------------------- + * IDAFree frees the problem memory IDA_mem allocated by + * IDAInit. Its only argument is the pointer idamem + * returned by IDAInit. + * ---------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void IDAFree(void **ida_mem); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/ida/ida.h b/odemex/Parser/CVode/ida_src/include/ida/ida.h new file mode 100644 index 0000000..ae1f335 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/ida/ida.h @@ -0,0 +1,944 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.12 $ + * $Date: 2007/11/26 16:19:58 $ + * ----------------------------------------------------------------- + * Programmer(s): Allan G. Taylor, Alan C. Hindmarsh, Radu Serban, + * and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California + * Produced at the Lawrence Livermore National Laboratory + * All rights reserved + * For details, see the LICENSE file + * ----------------------------------------------------------------- + * This is the header (include) file for the main IDA solver. + * ----------------------------------------------------------------- + * + * IDA is used to solve numerically the initial value problem + * for the differential algebraic equation (DAE) system + * F(t,y,y') = 0, + * given initial conditions + * y(t0) = y0, y'(t0) = yp0. + * Here y and F are vectors of length N. + * + * ----------------------------------------------------------------- + */ + +#ifndef _IDA_H +#define _IDA_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +#include + +/* + * ================================================================= + * I D A C O N S T A N T S + * ================================================================= + */ + +/* + * ---------------------------------------------------------------- + * Inputs to IDAInit, IDAReInit, IDACalcIC, and IDASolve. + * ---------------------------------------------------------------- + */ + +/* itask */ +#define IDA_NORMAL 1 +#define IDA_ONE_STEP 2 + +/* icopt */ +#define IDA_YA_YDP_INIT 1 +#define IDA_Y_INIT 2 + +/* + * ---------------------------------------- + * IDA return flags + * ---------------------------------------- + */ + +#define IDA_SUCCESS 0 +#define IDA_TSTOP_RETURN 1 +#define IDA_ROOT_RETURN 2 + +#define IDA_WARNING 99 + +#define IDA_MEM_NULL -1 +#define IDA_ILL_INPUT -2 +#define IDA_NO_MALLOC -3 +#define IDA_TOO_MUCH_WORK -4 +#define IDA_TOO_MUCH_ACC -5 +#define IDA_ERR_FAIL -6 +#define IDA_CONV_FAIL -7 +#define IDA_LINIT_FAIL -8 +#define IDA_LSETUP_FAIL -9 +#define IDA_LSOLVE_FAIL -10 +#define IDA_RES_FAIL -11 +#define IDA_CONSTR_FAIL -12 +#define IDA_REP_RES_ERR -13 + +#define IDA_MEM_FAIL -14 + +#define IDA_BAD_T -15 + +#define IDA_BAD_EWT -16 +#define IDA_FIRST_RES_FAIL -17 +#define IDA_LINESEARCH_FAIL -18 +#define IDA_NO_RECOVERY -19 + +#define IDA_RTFUNC_FAIL -20 + +/* + * ---------------------------------------------------------------- + * Type : IDAResFn + * ---------------------------------------------------------------- + * The F function which defines the DAE system F(t,y,y')=0 + * must have type IDAResFn. + * Symbols are as follows: + * t <-> t y <-> yy + * y' <-> yp F <-> rr + * A IDAResFn takes as input the independent variable value t, + * the dependent variable vector yy, and the derivative (with + * respect to t) of the yy vector, yp. It stores the result of + * F(t,y,y') in the vector rr. The yy, yp, and rr arguments are of + * type N_Vector. The user_data parameter is the pointer user_data + * passed by the user to the IDASetRdata routine. This user-supplied + * pointer is passed to the user's res function every time it is called, + * to provide access in res to user data. + * + * A IDAResFn res should return a value of 0 if successful, a positive + * value if a recoverable error occured (e.g. yy has an illegal value), + * or a negative value if a nonrecoverable error occured. In the latter + * case, the program halts. If a recoverable error occured, the integrator + * will attempt to correct and retry. + * ---------------------------------------------------------------- + */ + +typedef int (*IDAResFn)(realtype tt, N_Vector yy, N_Vector yp, + N_Vector rr, void *user_data); + +/* + * ----------------------------------------------------------------- + * Type : IDARootFn + * ----------------------------------------------------------------- + * A function g, which defines a set of functions g_i(t,y,y') whose + * roots are sought during the integration, must have type IDARootFn. + * The function g takes as input the independent variable value t, + * the dependent variable vector y, and its t-derivative yp (= y'). + * It stores the nrtfn values g_i(t,y,y') in the realtype array gout. + * (Allocation of memory for gout is handled within IDA.) + * The user_data parameter is the same as that passed by the user + * to the IDASetRdata routine. This user-supplied pointer is + * passed to the user's g function every time it is called. + * + * An IDARootFn should return 0 if successful or a non-zero value + * if an error occured (in which case the integration will be halted). + * ----------------------------------------------------------------- + */ + +typedef int (*IDARootFn)(realtype t, N_Vector y, N_Vector yp, + realtype *gout, void *user_data); + +/* + * ----------------------------------------------------------------- + * Type : IDAEwtFn + * ----------------------------------------------------------------- + * A function e, which sets the error weight vector ewt, must have + * type IDAEwtFn. + * The function e takes as input the current dependent variable y. + * It must set the vector of error weights used in the WRMS norm: + * + * ||y||_WRMS = sqrt [ 1/N * sum ( ewt_i * y_i)^2 ] + * + * Typically, the vector ewt has components: + * + * ewt_i = 1 / (reltol * |y_i| + abstol_i) + * + * The user_data parameter is the same as that passed by the user + * to the IDASetRdata routine. This user-supplied pointer is + * passed to the user's e function every time it is called. + * An IDAEwtFn e must return 0 if the error weight vector has been + * successfuly set and a non-zero value otherwise. + * ----------------------------------------------------------------- + */ + +typedef int (*IDAEwtFn)(N_Vector y, N_Vector ewt, void *user_data); + +/* + * ----------------------------------------------------------------- + * Type : IDAErrHandlerFn + * ----------------------------------------------------------------- + * A function eh, which handles error messages, must have type + * IDAErrHandlerFn. + * The function eh takes as input the error code, the name of the + * module reporting the error, the error message, and a pointer to + * user data, the same as that passed to IDASetRdata. + * + * All error codes are negative, except IDA_WARNING which indicates + * a warning (the solver continues). + * + * An IDAErrHandlerFn has no return value. + * ----------------------------------------------------------------- + */ + +typedef void (*IDAErrHandlerFn)(int error_code, + const char *module, const char *function, + char *msg, void *user_data); + +/* + * ================================================================ + * U S E R - C A L L A B L E R O U T I N E S + * ================================================================ + */ + +/* + * ---------------------------------------------------------------- + * Function : IDACreate + * ---------------------------------------------------------------- + * IDACreate creates an internal memory block for a problem to + * be solved by IDA. + * + * If successful, IDACreate returns a pointer to initialized + * problem memory. This pointer should be passed to IDAInit. + * If an initialization error occurs, IDACreate prints an error + * message to standard err and returns NULL. + * + * ---------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void *IDACreate(void); + +/* + * ---------------------------------------------------------------- + * Integrator optional input specification functions + * ---------------------------------------------------------------- + * The following functions can be called to set optional inputs + * to values other than the defaults given below: + * + * | + * Function | Optional input / [ default value ] + * | + * ---------------------------------------------------------------- + * | + * IDASetErrHandlerFn | user-provided ErrHandler function. + * | [internal] + * | + * IDASetErrFile | the file pointer for an error file + * | where all IDA warning and error + * | messages will be written if the default + * | internal error handling function is used. + * | This parameter can be stdout (standard + * | output), stderr (standard error), or a + * | file pointer (corresponding to a user + * | error file opened for writing) returned + * | by fopen. + * | If not called, then all messages will + * | be written to the standard error stream. + * | [stderr] + * | + * IDASetUserData | a pointer to user data that will be + * | passed to the user's res function every + * | time a user-supplied function is called. + * | [NULL] + * | + * IDASetMaxOrd | maximum lmm order to be used by the + * | solver. + * | [5] + * | + * IDASetMaxNumSteps | maximum number of internal steps to be + * | taken by the solver in its attempt to + * | reach tout. + * | [500] + * | + * IDASetInitStep | initial step size. + * | [estimated by IDA] + * | + * IDASetMaxStep | maximum absolute value of step size + * | allowed. + * | [infinity] + * | + * IDASetStopTime | the independent variable value past + * | which the solution is not to proceed. + * | [infinity] + * | + * IDASetNonlinConvCoef | Newton convergence test constant + * | for use during integration. + * | [0.33] + * | + * IDASetMaxErrTestFails| Maximum number of error test failures + * | in attempting one step. + * | [10] + * | + * IDASetMaxNonlinIters | Maximum number of nonlinear solver + * | iterations at one solution. + * | [4] + * | + * IDASetMaxConvFails | Maximum number of allowable conv. + * | failures in attempting one step. + * | [10] + * | + * IDASetSuppressAlg | flag to indicate whether or not to + * | suppress algebraic variables in the + * | local error tests: + * | FALSE = do not suppress; + * | TRUE = do suppress; + * | [FALSE] + * | NOTE: if suppressed algebraic variables + * | is selected, the nvector 'id' must be + * | supplied for identification of those + * | algebraic components (see IDASetId). + * | + * IDASetId | an N_Vector, which states a given + * | element to be either algebraic or + * | differential. + * | A value of 1.0 indicates a differential + * | variable while a 0.0 indicates an + * | algebraic variable. 'id' is required + * | if optional input SUPPRESSALG is set, + * | or if IDACalcIC is to be called with + * | icopt = IDA_YA_YDP_INIT. + * | + * IDASetConstraints | an N_Vector defining inequality + * | constraints for each component of the + * | solution vector y. If a given element + * | of this vector has values +2 or -2, + * | then the corresponding component of y + * | will be constrained to be > 0.0 or + * | <0.0, respectively, while if it is +1 + * | or -1, the y component is constrained + * | to be >= 0.0 or <= 0.0, respectively. + * | If a component of constraints is 0.0, + * | then no constraint is imposed on the + * | corresponding component of y. + * | The presence of a non-NULL constraints + * | vector that is not 0.0 (ZERO) in all + * | components will cause constraint + * | checking to be performed. + * | + * ----------------------------------------------------------------- + * | + * IDASetRootDirection | Specifies the direction of zero + * | crossings to be monitored + * | [both directions] + * | + * IDASetNoInactiveRootWarn | disable warning about possible + * | g==0 at beginning of integration + * | + * ----------------------------------------------------------------- + * Return flag: + * IDA_SUCCESS if successful + * IDA_MEM_NULL if the ida memory is NULL + * IDA_ILL_INPUT if an argument has an illegal value + * + * ---------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDASetErrHandlerFn(void *ida_mem, IDAErrHandlerFn ehfun, void *eh_data); +SUNDIALS_EXPORT int IDASetErrFile(void *ida_mem, FILE *errfp); +SUNDIALS_EXPORT int IDASetUserData(void *ida_mem, void *user_data); +SUNDIALS_EXPORT int IDASetMaxOrd(void *ida_mem, int maxord); +SUNDIALS_EXPORT int IDASetMaxNumSteps(void *ida_mem, long int mxsteps); +SUNDIALS_EXPORT int IDASetInitStep(void *ida_mem, realtype hin); +SUNDIALS_EXPORT int IDASetMaxStep(void *ida_mem, realtype hmax); +SUNDIALS_EXPORT int IDASetStopTime(void *ida_mem, realtype tstop); +SUNDIALS_EXPORT int IDASetNonlinConvCoef(void *ida_mem, realtype epcon); +SUNDIALS_EXPORT int IDASetMaxErrTestFails(void *ida_mem, int maxnef); +SUNDIALS_EXPORT int IDASetMaxNonlinIters(void *ida_mem, int maxcor); +SUNDIALS_EXPORT int IDASetMaxConvFails(void *ida_mem, int maxncf); +SUNDIALS_EXPORT int IDASetSuppressAlg(void *ida_mem, booleantype suppressalg); +SUNDIALS_EXPORT int IDASetId(void *ida_mem, N_Vector id); +SUNDIALS_EXPORT int IDASetConstraints(void *ida_mem, N_Vector constraints); + +SUNDIALS_EXPORT int IDASetRootDirection(void *ida_mem, int *rootdir); +SUNDIALS_EXPORT int IDASetNoInactiveRootWarn(void *ida_mem); + +/* + * ---------------------------------------------------------------- + * Function : IDAInit + * ---------------------------------------------------------------- + * IDAInit allocates and initializes memory for a problem to + * to be solved by IDA. + * + * res is the residual function F in F(t,y,y') = 0. + * + * t0 is the initial value of t, the independent variable. + * + * yy0 is the initial condition vector y(t0). + * + * yp0 is the initial condition vector y'(t0) + * + * IDA_SUCCESS if successful + * IDA_MEM_NULL if the ida memory was NULL + * IDA_MEM_FAIL if a memory allocation failed + * IDA_ILL_INPUT f an argument has an illegal value. + * + * ---------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDAInit(void *ida_mem, IDAResFn res, + realtype t0, N_Vector yy0, N_Vector yp0); + +/* + * ---------------------------------------------------------------- + * Function : IDAReInit + * ---------------------------------------------------------------- + * IDAReInit re-initializes IDA for the solution of a problem, + * where a prior call to IDAInit has been made. + * IDAReInit performs the same input checking and initializations + * that IDAInit does. + * But it does no memory allocation, assuming that the existing + * internal memory is sufficient for the new problem. + * + * The use of IDAReInit requires that the maximum method order, + * maxord, is no larger for the new problem than for the problem + * specified in the last call to IDAInit. This condition is + * automatically fulfilled if the default value for maxord is + * specified. + * + * Following the call to IDAReInit, a call to the linear solver + * specification routine is necessary if a different linear solver + * is chosen, but may not be otherwise. If the same linear solver + * is chosen, and there are no changes in its input parameters, + * then no call to that routine is needed. + * + * The first argument to IDAReInit is: + * + * ida_mem = pointer to IDA memory returned by IDACreate. + * + * All the remaining arguments to IDAReInit have names and + * meanings identical to those of IDAInit. + * + * The return value of IDAReInit is equal to SUCCESS = 0 if there + * were no errors; otherwise it is a negative int equal to: + * IDA_MEM_NULL indicating ida_mem was NULL, or + * IDA_NO_MALLOC indicating that ida_mem was not allocated. + * IDA_ILL_INPUT indicating an input argument was illegal + * (including an attempt to increase maxord). + * In case of an error return, an error message is also printed. + * ---------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDAReInit(void *ida_mem, + realtype t0, N_Vector yy0, N_Vector yp0); + +/* + * ----------------------------------------------------------------- + * Functions : IDASStolerances + * IDASVtolerances + * IDAWFtolerances + * ----------------------------------------------------------------- + * + * These functions specify the integration tolerances. One of them + * MUST be called before the first call to IDA. + * + * IDASStolerances specifies scalar relative and absolute tolerances. + * IDASVtolerances specifies scalar relative tolerance and a vector + * absolute tolerance (a potentially different absolute tolerance + * for each vector component). + * IDAWFtolerances specifies a user-provides function (of type IDAEwtFn) + * which will be called to set the error weight vector. + * + * The tolerances reltol and abstol define a vector of error weights, + * ewt, with components + * ewt[i] = 1/(reltol*abs(y[i]) + abstol) (in the SS case), or + * ewt[i] = 1/(reltol*abs(y[i]) + abstol[i]) (in the SV case). + * This vector is used in all error and convergence tests, which + * use a weighted RMS norm on all error-like vectors v: + * WRMSnorm(v) = sqrt( (1/N) sum(i=1..N) (v[i]*ewt[i])^2 ), + * where N is the problem dimension. + * + * The return value of these functions is equal to IDA_SUCCESS = 0 if + * there were no errors; otherwise it is a negative int equal to: + * IDa_MEM_NULL indicating ida_mem was NULL (i.e., + * IDACreate has not been called). + * IDA_NO_MALLOC indicating that ida_mem has not been + * allocated (i.e., IDAInit has not been + * called). + * IDA_ILL_INPUT indicating an input argument was illegal + * (e.g. a negative tolerance) + * In case of an error return, an error message is also printed. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDASStolerances(void *ida_mem, realtype reltol, realtype abstol); +SUNDIALS_EXPORT int IDASVtolerances(void *ida_mem, realtype reltol, N_Vector abstol); +SUNDIALS_EXPORT int IDAWFtolerances(void *ida_mem, IDAEwtFn efun); + +/* ---------------------------------------------------------------- + * Initial Conditions optional input specification functions + * ---------------------------------------------------------------- + * The following functions can be called to set optional inputs + * to control the initial conditions calculations. + * + * | + * Function | Optional input / [ default value ] + * | + * -------------------------------------------------------------- + * | + * IDASetNonlinConvCoefIC | positive coeficient in the Newton + * | convergence test. This test uses a + * | weighted RMS norm (with weights + * | defined by the tolerances, as in + * | IDASolve). For new initial value + * | vectors y and y' to be accepted, the + * | norm of J-inverse F(t0,y,y') is + * | required to be less than epiccon, + * | where J is the system Jacobian. + * | [0.01 * 0.33] + * | + * IDASetMaxNumStepsIC | maximum number of values of h allowed + * | when icopt = IDA_YA_YDP_INIT, where + * | h appears in the system Jacobian, + * | J = dF/dy + (1/h)dF/dy'. + * | [5] + * | + * IDASetMaxNumJacsIC | maximum number of values of the + * | approximate Jacobian or preconditioner + * | allowed, when the Newton iterations + * | appear to be slowly converging. + * | [4] + * | + * IDASetMaxNumItersIC | maximum number of Newton iterations + * | allowed in any one attempt to solve + * | the IC problem. + * | [10] + * | + * IDASetLineSearchOffIC | a boolean flag to turn off the + * | linesearch algorithm. + * | [FALSE] + * | + * IDASetStepToleranceIC | positive lower bound on the norm of + * | a Newton step. + * | [(unit roundoff)^(2/3) + * + * ---------------------------------------------------------------- + * Return flag: + * IDA_SUCCESS if successful + * IDA_MEM_NULL if the ida memory is NULL + * IDA_ILL_INPUT if an argument has an illegal value + * + * ---------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDASetNonlinConvCoefIC(void *ida_mem, realtype epiccon); +SUNDIALS_EXPORT int IDASetMaxNumStepsIC(void *ida_mem, int maxnh); +SUNDIALS_EXPORT int IDASetMaxNumJacsIC(void *ida_mem, int maxnj); +SUNDIALS_EXPORT int IDASetMaxNumItersIC(void *ida_mem, int maxnit); +SUNDIALS_EXPORT int IDASetLineSearchOffIC(void *ida_mem, booleantype lsoff); +SUNDIALS_EXPORT int IDASetStepToleranceIC(void *ida_mem, realtype steptol); + +/* + * ----------------------------------------------------------------- + * Function : IDARootInit + * ----------------------------------------------------------------- + * IDARootInit initializes a rootfinding problem to be solved + * during the integration of the DAE system. It must be called + * after IDACreate, and before IDASolve. The arguments are: + * + * ida_mem = pointer to IDA memory returned by IDACreate. + * + * nrtfn = number of functions g_i, an int >= 0. + * + * g = name of user-supplied function, of type IDARootFn, + * defining the functions g_i whose roots are sought. + * + * If a new problem is to be solved with a call to IDAReInit, + * where the new problem has no root functions but the prior one + * did, then call IDARootInit with nrtfn = 0. + * + * The return value of IDARootInit is IDA_SUCCESS = 0 if there were + * no errors; otherwise it is a negative int equal to: + * IDA_MEM_NULL indicating ida_mem was NULL, or + * IDA_MEM_FAIL indicating a memory allocation failed. + * (including an attempt to increase maxord). + * IDA_ILL_INPUT indicating nrtfn > 0 but g = NULL. + * In case of an error return, an error message is also printed. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDARootInit(void *ida_mem, int nrtfn, IDARootFn g); + +/* + * ---------------------------------------------------------------- + * Function : IDACalcIC + * ---------------------------------------------------------------- + * IDACalcIC calculates corrected initial conditions for the DAE + * system for a class of index-one problems of semi-implicit form. + * It uses Newton iteration combined with a Linesearch algorithm. + * Calling IDACalcIC is optional. It is only necessary when the + * initial conditions do not solve the given system. I.e., if + * y0 and yp0 are known to satisfy F(t0, y0, yp0) = 0, then + * a call to IDACalcIC is NOT necessary (for index-one problems). + * + * A call to IDACalcIC must be preceded by a successful call to + * IDAInit or IDAReInit for the given DAE problem, and by a + * successful call to the linear system solver specification + * routine. + * + * The call to IDACalcIC should precede the call(s) to IDASolve + * for the given problem. + * + * The arguments to IDACalcIC are as follows: + * + * ida_mem is the pointer to IDA memory returned by IDACreate. + * + * icopt is the option of IDACalcIC to be used. + * icopt = IDA_YA_YDP_INIT directs IDACalcIC to compute + * the algebraic components of y and differential + * components of y', given the differential + * components of y. This option requires that the + * N_Vector id was set through a call to IDASetId + * specifying the differential and algebraic + * components. + * icopt = IDA_Y_INIT directs IDACalcIC to compute all + * components of y, given y'. id is not required. + * + * tout1 is the first value of t at which a soluton will be + * requested (from IDASolve). (This is needed here to + * determine the direction of integration and rough scale + * in the independent variable t.) + * + * + * IDACalcIC returns an int flag. Its symbolic values and their + * meanings are as follows. (The numerical return values are set + * above in this file.) All unsuccessful returns give a negative + * return value. If IFACalcIC failed, y0 and yp0 contain + * (possibly) altered values, computed during the attempt. + * + * IDA_SUCCESS IDACalcIC was successful. The corrected + * initial value vectors were stored internally. + * + * IDA_MEM_NULL The argument ida_mem was NULL. + * + * IDA_ILL_INPUT One of the input arguments was illegal. + * See printed message. + * + * IDA_LINIT_FAIL The linear solver's init routine failed. + * + * IDA_BAD_EWT Some component of the error weight vector + * is zero (illegal), either for the input + * value of y0 or a corrected value. + * + * IDA_RES_FAIL The user's residual routine returned + * a non-recoverable error flag. + * + * IDA_FIRST_RES_FAIL The user's residual routine returned + * a recoverable error flag on the first call, + * but IDACalcIC was unable to recover. + * + * IDA_LSETUP_FAIL The linear solver's setup routine had a + * non-recoverable error. + * + * IDA_LSOLVE_FAIL The linear solver's solve routine had a + * non-recoverable error. + * + * IDA_NO_RECOVERY The user's residual routine, or the linear + * solver's setup or solve routine had a + * recoverable error, but IDACalcIC was + * unable to recover. + * + * IDA_CONSTR_FAIL IDACalcIC was unable to find a solution + * satisfying the inequality constraints. + * + * IDA_LINESEARCH_FAIL The Linesearch algorithm failed to find a + * solution with a step larger than steptol + * in weighted RMS norm. + * + * IDA_CONV_FAIL IDACalcIC failed to get convergence of the + * Newton iterations. + * + * ---------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDACalcIC(void *ida_mem, int icopt, realtype tout1); + +/* + * ---------------------------------------------------------------- + * Function : IDASolve + * ---------------------------------------------------------------- + * IDASolve integrates the DAE over an interval in t, the + * independent variable. If itask is IDA_NORMAL, then the solver + * integrates from its current internal t value to a point at or + * beyond tout, then interpolates to t = tout and returns y(tret) + * in the user-allocated vector yret. In general, tret = tout. + * If itask is IDA_ONE_STEP, then the solver takes one internal + * step of the independent variable and returns in yret the value + * of y at the new internal independent variable value. In this + * case, tout is used only during the first call to IDASolve to + * determine the direction of integration and the rough scale of + * the problem. If tstop is enabled (through a call to IDASetStopTime), + * then IDASolve returns the solution at tstop. Once the integrator + * returns at a tstop time, any future testing for tstop is disabled + * (and can be reenabled only though a new call to IDASetStopTime). + * The time reached by the solver is placed in (*tret). The + * user is responsible for allocating the memory for this value. + * + * ida_mem is the pointer (void) to IDA memory returned by + * IDACreate. + * + * tout is the next independent variable value at which a + * computed solution is desired. + * + * tret is a pointer to a real location. IDASolve sets (*tret) + * to the actual t value reached, corresponding to the + * solution vector yret. In IDA_NORMAL mode, with no + * errors and no roots found, (*tret) = tout. + * + * yret is the computed solution vector. With no errors, + * yret = y(tret). + * + * ypret is the derivative of the computed solution at t = tret. + * + * Note: yret and ypret may be the same N_Vectors as y0 and yp0 + * in the call to IDAInit or IDAReInit. + * + * itask is IDA_NORMAL or IDA_ONE_STEP. These two modes are described above. + * + * + * The return values for IDASolve are described below. + * (The numerical return values are defined above in this file.) + * All unsuccessful returns give a negative return value. + * + * IDA_SUCCESS + * IDASolve succeeded and no roots were found. + * + * IDA_ROOT_RETURN: IDASolve succeeded, and found one or more roots. + * If nrtfn > 1, call IDAGetRootInfo to see which g_i were found + * to have a root at (*tret). + * + * IDA_TSTOP_RETURN: + * IDASolve returns computed results for the independent variable + * value tstop. That is, tstop was reached. + * + * IDA_MEM_NULL: + * The IDA_mem argument was NULL. + * + * IDA_ILL_INPUT: + * One of the inputs to IDASolve is illegal. This includes the + * situation when a component of the error weight vectors + * becomes < 0 during internal stepping. It also includes the + * situation where a root of one of the root functions was found + * both at t0 and very near t0. The ILL_INPUT flag + * will also be returned if the linear solver function IDA--- + * (called by the user after calling IDACreate) failed to set one + * of the linear solver-related fields in ida_mem or if the linear + * solver's init routine failed. In any case, the user should see + * the printed error message for more details. + * + * IDA_TOO_MUCH_WORK: + * The solver took mxstep internal steps but could not reach tout. + * The default value for mxstep is MXSTEP_DEFAULT = 500. + * + * IDA_TOO_MUCH_ACC: + * The solver could not satisfy the accuracy demanded by the user + * for some internal step. + * + * IDA_ERR_FAIL: + * Error test failures occurred too many times (=MXETF = 10) during + * one internal step. + * + * IDA_CONV_FAIL: + * Convergence test failures occurred too many times (= MXNCF = 10) + * during one internal step. + * + * IDA_LSETUP_FAIL: + * The linear solver's setup routine failed + * in an unrecoverable manner. + * + * IDA_LSOLVE_FAIL: + * The linear solver's solve routine failed + * in an unrecoverable manner. + * + * IDA_CONSTR_FAIL: + * The inequality constraints were violated, + * and the solver was unable to recover. + * + * IDA_REP_RES_ERR: + * The user's residual function repeatedly returned a recoverable + * error flag, but the solver was unable to recover. + * + * IDA_RES_FAIL: + * The user's residual function returned a nonrecoverable error + * flag. + * + * ---------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDASolve(void *ida_mem, realtype tout, realtype *tret, + N_Vector yret, N_Vector ypret, int itask); + +/* + * ---------------------------------------------------------------- + * Function: IDAGetSolution + * ---------------------------------------------------------------- + * + * This routine evaluates y(t) and y'(t) as the value and + * derivative of the interpolating polynomial at the independent + * variable t, and stores the results in the vectors yret and + * ypret. It uses the current independent variable value, tn, + * and the method order last used, kused. This function is + * called by IDASolve with t = tout, t = tn, or t = tstop. + * + * If kused = 0 (no step has been taken), or if t = tn, then the + * order used here is taken to be 1, giving yret = phi[0], + * ypret = phi[1]/psi[0]. + * + * The return values are: + * IDA_SUCCESS: succeess. + * IDA_BAD_T: t is not in the interval [tn-hu,tn]. + * IDA_MEM_NULL: The ida_mem argument was NULL. + * + * ---------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDAGetSolution(void *ida_mem, realtype t, + N_Vector yret, N_Vector ypret); + +/* ---------------------------------------------------------------- + * Integrator optional output extraction functions + * ---------------------------------------------------------------- + * + * The following functions can be called to get optional outputs + * and statistics related to the main integrator. + * ---------------------------------------------------------------- + * + * IDAGetWorkSpace returns the IDA real and integer workspace sizes + * IDAGetNumSteps returns the cumulative number of internal + * steps taken by the solver + * IDAGetNumRhsEvals returns the number of calls to the user's + * res function + * IDAGetNumLinSolvSetups returns the number of calls made to + * the linear solver's setup routine + * IDAGetNumErrTestFails returns the number of local error test + * failures that have occured + * IDAGetNumBacktrackOps returns the number of backtrack + * operations done in the linesearch algorithm in IDACalcIC + * IDAGetConsistentIC returns the consistent initial conditions + * computed by IDACalcIC + * IDAGetLastOrder returns the order used during the last + * internal step + * IDAGetCurentOrder returns the order to be used on the next + * internal step + * IDAGetActualInitStep returns the actual initial step size + * used by IDA + * IDAGetLAstStep returns the step size for the last internal + * step (if from IDASolve), or the last value of the + * artificial step size h (if from IDACalcIC) + * IDAGetCurrentStep returns the step size to be attempted on the + * next internal step + * IDAGetCurrentTime returns the current internal time reached + * by the solver + * IDAGetTolScaleFactor returns a suggested factor by which the + * user's tolerances should be scaled when too much + * accuracy has been requested for some internal step + * IDAGetErrWeights returns the current state error weight vector. + * The user must allocate space for eweight. + * IDAGetEstLocalErrors returns the estimated local errors. The user + * must allocate space for the vector ele. + * IDAGetNumGEvals returns the number of calls to the user's + * g function (for rootfinding) + * IDAGetRootInfo returns the indices for which g_i was found to + * have a root. The user must allocate space for rootsfound. + * For i = 0 ... nrtfn-1, rootsfound[i] = 1 if g_i has a root, + * and rootsfound[i]= 0 if not. + * + * IDAGet* return values: + * IDA_SUCCESS if succesful + * IDA_MEM_NULL if the ida memory was NULL + * IDA_ILL_INPUT if some input is illegal + * + * ---------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDAGetWorkSpace(void *ida_mem, long int *lenrw, long int *leniw); +SUNDIALS_EXPORT int IDAGetNumSteps(void *ida_mem, long int *nsteps); +SUNDIALS_EXPORT int IDAGetNumResEvals(void *ida_mem, long int *nrevals); +SUNDIALS_EXPORT int IDAGetNumLinSolvSetups(void *ida_mem, long int *nlinsetups); +SUNDIALS_EXPORT int IDAGetNumErrTestFails(void *ida_mem, long int *netfails); +SUNDIALS_EXPORT int IDAGetNumBacktrackOps(void *ida_mem, long int *nbacktr); +SUNDIALS_EXPORT int IDAGetConsistentIC(void *ida_mem, N_Vector yy0_mod, N_Vector yp0_mod); +SUNDIALS_EXPORT int IDAGetLastOrder(void *ida_mem, int *klast); +SUNDIALS_EXPORT int IDAGetCurrentOrder(void *ida_mem, int *kcur); +SUNDIALS_EXPORT int IDAGetActualInitStep(void *ida_mem, realtype *hinused); +SUNDIALS_EXPORT int IDAGetLastStep(void *ida_mem, realtype *hlast); +SUNDIALS_EXPORT int IDAGetCurrentStep(void *ida_mem, realtype *hcur); +SUNDIALS_EXPORT int IDAGetCurrentTime(void *ida_mem, realtype *tcur); +SUNDIALS_EXPORT int IDAGetTolScaleFactor(void *ida_mem, realtype *tolsfact); +SUNDIALS_EXPORT int IDAGetErrWeights(void *ida_mem, N_Vector eweight); +SUNDIALS_EXPORT int IDAGetEstLocalErrors(void *ida_mem, N_Vector ele); +SUNDIALS_EXPORT int IDAGetNumGEvals(void *ida_mem, long int *ngevals); +SUNDIALS_EXPORT int IDAGetRootInfo(void *ida_mem, int *rootsfound); + +/* + * ---------------------------------------------------------------- + * As a convenience, the following function provides the + * optional outputs in a group. + * ---------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDAGetIntegratorStats(void *ida_mem, long int *nsteps, + long int *nrevals, long int *nlinsetups, + long int *netfails, int *qlast, int *qcur, + realtype *hinused, realtype *hlast, realtype *hcur, + realtype *tcur); + +/* + * ---------------------------------------------------------------- + * Nonlinear solver optional output extraction functions + * ---------------------------------------------------------------- + * + * The following functions can be called to get optional outputs + * and statistics related to the nonlinear solver. + * -------------------------------------------------------------- + * + * IDAGetNumNonlinSolvIters returns the number of nonlinear + * solver iterations performed. + * IDAGetNumNonlinSolvConvFails returns the number of nonlinear + * convergence failures. + * + * ---------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDAGetNumNonlinSolvIters(void *ida_mem, long int *nniters); +SUNDIALS_EXPORT int IDAGetNumNonlinSolvConvFails(void *ida_mem, long int *nncfails); + +/* + * ---------------------------------------------------------------- + * As a convenience, the following function provides the + * nonlinear solver optional outputs in a group. + * ---------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDAGetNonlinSolvStats(void *ida_mem, long int *nniters, + long int *nncfails); + +/* + * ----------------------------------------------------------------- + * The following function returns the name of the constant + * associated with an IDA return flag + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT char *IDAGetReturnFlagName(int flag); + +/* + * ---------------------------------------------------------------- + * Function : IDAFree + * ---------------------------------------------------------------- + * IDAFree frees the problem memory IDA_mem allocated by + * IDAInit. Its only argument is the pointer idamem + * returned by IDAInit. + * ---------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void IDAFree(void **ida_mem); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/ida/ida_band.h b/odemex/Parser/CVode/ida_src/include/ida/ida_band.h new file mode 100644 index 0000000..acdcd9b --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/ida/ida_band.h @@ -0,0 +1,59 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.5 $ + * $Date: 2008/04/18 19:42:37 $ + * ----------------------------------------------------------------- + * Programmer(s): Alan C. Hindmarsh, and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the IDABAND linear solver module. + * ----------------------------------------------------------------- + */ + +#ifndef _IDABAND_H +#define _IDABAND_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ----------------------------------------------------------------- + * Function : IDABand + * ----------------------------------------------------------------- + * A call to the IDABand function links the main integrator + * with the IDABAND linear solver module. + * + * ida_mem is the pointer to the integrator memory returned by + * IDACreate. + * + * mupper is the upper bandwidth of the banded Jacobian matrix. + * + * mlower is the lower bandwidth of the banded Jacobian matrix. + * + * The return values of IDABand are: + * IDADLS_SUCCESS = 0 if successful + * IDADLS_LMEM_FAIL = -1 if there was a memory allocation failure + * IDADLS_ILL_INPUT = -2 if the input was illegal or NVECTOR bad. + * + * NOTE: The band linear solver assumes a serial implementation + * of the NVECTOR package. Therefore, IDABand will first + * test for a compatible N_Vector internal representation + * by checking that the N_VGetArrayPointer function exists. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDABand(void *ida_mem, int Neq, int mupper, int mlower); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/ida/ida_bbdpre.h b/odemex/Parser/CVode/ida_src/include/ida/ida_bbdpre.h new file mode 100644 index 0000000..24d2956 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/ida/ida_bbdpre.h @@ -0,0 +1,275 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.7 $ + * $Date: 2007/11/26 16:19:59 $ + * ----------------------------------------------------------------- + * Programmer(s): Alan C. Hindmarsh, Radu Serban and + * Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the IDABBDPRE module, for a + * band-block-diagonal preconditioner, i.e. a block-diagonal + * matrix with banded blocks, for use with IDA and + * IDASPGMR/IDASPBCG/IDASPTFQMR. + * + * Summary: + * + * These routines provide a preconditioner matrix that is + * block-diagonal with banded blocks. The blocking corresponds + * to the distribution of the dependent variable vector y among + * the processors. Each preconditioner block is generated from + * the Jacobian of the local part (on the current processor) of a + * given function G(t,y,y') approximating F(t,y,y'). The blocks + * are generated by a difference quotient scheme on each processor + * independently. This scheme utilizes an assumed banded structure + * with given half-bandwidths, mudq and mldq. However, the banded + * Jacobian block kept by the scheme has half-bandwiths mukeep and + * mlkeep, which may be smaller. + * + * The user's calling program should have the following form: + * + * #include + * #include + * ... + * y0 = N_VNew_Parallel(...); + * yp0 = N_VNew_Parallel(...); + * ... + * ida_mem = IDACreate(...); + * ier = IDAInit(...); + * ... + * flag = IDASptfqmr(ida_mem, maxl); + * -or- + * flag = IDASpgmr(ida_mem, maxl); + * -or- + * flag = IDASpbcg(ida_mem, maxl); + * ... + * flag = IDABBDPrecInit(ida_mem, Nlocal, mudq, mldq, + * mukeep, mlkeep, dq_rel_yy, Gres, Gcomm); + * ... + * ier = IDASolve(...); + * ... + * IDAFree(&ida_mem); + * + * N_VDestroy(y0); + * N_VDestroy(yp0); + * + * The user-supplied routines required are: + * + * res is the function F(t,y,y') defining the DAE system to + * be solved: F(t,y,y') = 0. + * + * Gres is the function defining a local approximation + * G(t,y,y') to F, for the purposes of the preconditioner. + * + * Gcomm is the function performing communication needed + * for Glocal. + * + * Notes: + * + * 1) This header file is included by the user for the definition + * of the IBBDPrecData type and for needed function prototypes. + * + * 2) The IDABBDPrecInit call includes half-bandwidths mudq and + * mldq to be used in the approximate Jacobian. They need + * not be the true half-bandwidths of the Jacobian of the + * local block of G, when smaller values may provide a greater + * efficiency. Similarly, mukeep and mlkeep, specifying the + * bandwidth kept for the approximate Jacobian, need not be + * the true half-bandwidths. Also, mukeep, mlkeep, mudq, and + * mldq need not be the same on every processor. + * + * 3) The actual name of the user's res function is passed to + * IDAInit, and the names of the user's Gres and Gcomm + * functions are passed to IDABBDPrecInit. + * + * 4) The pointer to the user-defined data block user_data, which + * is set through IDASetUserData is also available to the user + * in glocal and gcomm. + * + * 5) Optional outputs specific to this module are available by + * way of routines listed below. These include work space sizes + * and the cumulative number of glocal calls. The costs + * associated with this module also include nsetups banded LU + * factorizations, nsetups gcomm calls, and nps banded + * backsolve calls, where nsetups and nps are integrator + * optional outputs. + * ----------------------------------------------------------------- + */ + +#ifndef _IDABBDPRE_H +#define _IDABBDPRE_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ----------------------------------------------------------------- + * Type : IDABBDLocalFn + * ----------------------------------------------------------------- + * The user must supply a function G(t,y,y') which approximates + * the function F for the system F(t,y,y') = 0, and which is + * computed locally (without interprocess communication). + * (The case where G is mathematically identical to F is allowed.) + * The implementation of this function must have type IDABBDLocalFn. + * + * This function takes as input the independent variable value tt, + * the current solution vector yy, the current solution + * derivative vector yp, and a pointer to the user-defined data + * block user_data. It is to compute the local part of G(t,y,y') + * and store it in the vector gval. (Providing memory for yy and + * gval is handled within this preconditioner module.) It is + * expected that this routine will save communicated data in work + * space defined by the user, and made available to the + * preconditioner function for the problem. The user_data + * parameter is the same as that passed by the user to the + * IDASetRdata routine. + * + * An IDABBDLocalFn Gres is to return an int, defined in the same + * way as for the residual function: 0 (success), +1 or -1 (fail). + * ----------------------------------------------------------------- + */ + +typedef int (*IDABBDLocalFn)(int Nlocal, realtype tt, + N_Vector yy, N_Vector yp, N_Vector gval, + void *user_data); + +/* + * ----------------------------------------------------------------- + * Type : IDABBDCommFn + * ----------------------------------------------------------------- + * The user may supply a function of type IDABBDCommFn which + * performs all interprocess communication necessary to + * evaluate the approximate system function described above. + * + * This function takes as input the solution vectors yy and yp, + * and a pointer to the user-defined data block user_data. The + * user_data parameter is the same as that passed by the user to + * the IDASetUserData routine. + * + * The IDABBDCommFn Gcomm is expected to save communicated data in + * space defined with the structure *user_data. + * + * A IDABBDCommFn Gcomm returns an int value equal to 0 (success), + * > 0 (recoverable error), or < 0 (unrecoverable error). + * + * Each call to the IDABBDCommFn is preceded by a call to the system + * function res with the same vectors yy and yp. Thus the + * IDABBDCommFn gcomm can omit any communications done by res if + * relevant to the evaluation of the local function glocal. + * A NULL communication function can be passed to IDABBDPrecInit + * if all necessary communication was done by res. + * ----------------------------------------------------------------- + */ + +typedef int (*IDABBDCommFn)(int Nlocal, realtype tt, + N_Vector yy, N_Vector yp, + void *user_data); + +/* + * ----------------------------------------------------------------- + * Function : IDABBDPrecInit + * ----------------------------------------------------------------- + * IDABBDPrecInit allocates and initializes the BBD preconditioner. + * + * The parameters of IDABBDPrecInit are as follows: + * + * ida_mem is a pointer to the memory blockreturned by IDACreate. + * + * Nlocal is the length of the local block of the vectors yy etc. + * on the current processor. + * + * mudq, mldq are the upper and lower half-bandwidths to be used + * in the computation of the local Jacobian blocks. + * + * mukeep, mlkeep are the upper and lower half-bandwidths to be + * used in saving the Jacobian elements in the local + * block of the preconditioner matrix PP. + * + * dq_rel_yy is an optional input. It is the relative increment + * to be used in the difference quotient routine for + * Jacobian calculation in the preconditioner. The + * default is sqrt(unit roundoff), and specified by + * passing dq_rel_yy = 0. + * + * Gres is the name of the user-supplied function G(t,y,y') + * that approximates F and whose local Jacobian blocks + * are to form the preconditioner. + * + * Gcomm is the name of the user-defined function that performs + * necessary interprocess communication for the + * execution of glocal. + * + * The return value of IDABBDPrecInit is one of: + * IDASPILS_SUCCESS if no errors occurred + * IDASPILS_MEM_NULL if the integrator memory is NULL + * IDASPILS_LMEM_NULL if the linear solver memory is NULL + * IDASPILS_ILL_INPUT if an input has an illegal value + * IDASPILS_MEM_FAIL if a memory allocation request failed + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDABBDPrecInit(void *ida_mem, int Nlocal, + int mudq, int mldq, + int mukeep, int mlkeep, + realtype dq_rel_yy, + IDABBDLocalFn Gres, IDABBDCommFn Gcomm); + +/* + * ----------------------------------------------------------------- + * Function : IDABBDPrecReInit + * ----------------------------------------------------------------- + * IDABBDPrecReInit reinitializes the IDABBDPRE module when + * solving a sequence of problems of the same size with + * IDASPGMR/IDABBDPRE, IDASPBCG/IDABBDPRE, or IDASPTFQMR/IDABBDPRE + * provided there is no change in Nlocal, mukeep, or mlkeep. After + * solving one problem, and after calling IDAReInit to reinitialize + * the integrator for a subsequent problem, call IDABBDPrecReInit. + * + * All arguments have the same names and meanings as those + * of IDABBDPrecInit. + * + * The return value of IDABBDPrecReInit is one of: + * IDASPILS_SUCCESS if no errors occurred + * IDASPILS_MEM_NULL if the integrator memory is NULL + * IDASPILS_LMEM_NULL if the linear solver memory is NULL + * IDASPILS_PMEM_NULL if the preconditioner memory is NULL + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDABBDPrecReInit(void *ida_mem, + int mudq, int mldq, + realtype dq_rel_yy); + +/* + * ----------------------------------------------------------------- + * Optional outputs for IDABBDPRE + * ----------------------------------------------------------------- + * IDABBDPrecGetWorkSpace returns the real and integer work space + * for IDABBDPRE. + * IDABBDPrecGetNumGfnEvals returns the number of calls to the + * user Gres function. + * + * The return value of IDABBDPrecGet* is one of: + * IDASPILS_SUCCESS if no errors occurred + * IDASPILS_MEM_NULL if the integrator memory is NULL + * IDASPILS_LMEM_NULL if the linear solver memory is NULL + * IDASPILS_PMEM_NULL if the preconditioner memory is NULL + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDABBDPrecGetWorkSpace(void *ida_mem, + long int *lenrwBBDP, long int *leniwBBDP); +SUNDIALS_EXPORT int IDABBDPrecGetNumGfnEvals(void *ida_mem, long int *ngevalsBBDP); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/ida/ida_dense.h b/odemex/Parser/CVode/ida_src/include/ida/ida_dense.h new file mode 100644 index 0000000..92139a2 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/ida/ida_dense.h @@ -0,0 +1,58 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.5 $ + * $Date: 2008/04/18 19:42:37 $ + * ----------------------------------------------------------------- + * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the IDADENSE linear solver module. + * ----------------------------------------------------------------- + */ + +#ifndef _IDADENSE_H +#define _IDADENSE_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ----------------------------------------------------------------- + * Function : IDADense + * ----------------------------------------------------------------- + * A call to the IDADense function links the main integrator + * with the IDADENSE linear solver module. + * + * ida_mem is the pointer to integrator memory returned by + * IDACreate. + * + * Neq is the problem size + * + * IDADense returns: + * IDADLS_SUCCESS = 0 if successful + * IDADLS_LMEM_FAIL = -1 if there was a memory allocation failure + * IDADLS_ILL_INPUT = -2 if NVECTOR found incompatible + * + * NOTE: The dense linear solver assumes a serial implementation + * of the NVECTOR package. Therefore, IDADense will first + * test for a compatible N_Vector internal representation + * by checking that the functions N_VGetArrayPointer and + * N_VSetArrayPointer exist. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDADense(void *ida_mem, int Neq); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/ida/ida_direct.h b/odemex/Parser/CVode/ida_src/include/ida/ida_direct.h new file mode 100644 index 0000000..55ec153 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/ida/ida_direct.h @@ -0,0 +1,300 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.6 $ + * $Date: 2008/04/18 19:42:37 $ + * ----------------------------------------------------------------- + * Programmer: Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2006, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * Common header file for the direct linear solvers in IDA. + * ----------------------------------------------------------------- + */ + +#ifndef _IDADLS_H +#define _IDADLS_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ================================================================= + * I D A D I R E C T C O N S T A N T S + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * IDADLS return values + * ----------------------------------------------------------------- + */ + +#define IDADLS_SUCCESS 0 +#define IDADLS_MEM_NULL -1 +#define IDADLS_LMEM_NULL -2 +#define IDADLS_ILL_INPUT -3 +#define IDADLS_MEM_FAIL -4 + +/* Additional last_flag values */ + +#define IDADLS_JACFUNC_UNRECVR -5 +#define IDADLS_JACFUNC_RECVR -6 + +/* + * ================================================================= + * F U N C T I O N T Y P E S + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Types : IDADlsDenseJacFn + * ----------------------------------------------------------------- + * + * A dense Jacobian approximation function djac must be of type + * IDADlsDenseJacFn. + * Its parameters are: + * + * N is the problem size, and length of all vector arguments. + * + * t is the current value of the independent variable t. + * + * y is the current value of the dependent variable vector, + * namely the predicted value of y(t). + * + * yp is the current value of the derivative vector y', + * namely the predicted value of y'(t). + * + * f is the residual vector F(tt,yy,yp). + * + * c_j is the scalar in the system Jacobian, proportional to + * the inverse of the step size h. + * + * user_data is a pointer to user Jacobian data - the same as the + * user_data parameter passed to IDASetRdata. + * + * Jac is the dense matrix (of type DlsMat) to be loaded by + * an IDADlsDenseJacFn routine with an approximation to the + * system Jacobian matrix + * J = dF/dy' + gamma*dF/dy + * at the given point (t,y,y'), where the ODE system is + * given by F(t,y,y') = 0. + * Note that Jac is NOT preset to zero! + * + * tmp1, tmp2, tmp3 are pointers to memory allocated for + * N_Vectors which can be used by an IDADlsDenseJacFn routine + * as temporary storage or work space. + * + * A IDADlsDenseJacFn should return + * 0 if successful, + * a positive int if a recoverable error occurred, or + * a negative int if a nonrecoverable error occurred. + * In the case of a recoverable error return, the integrator will + * attempt to recover by reducing the stepsize (which changes cj). + * + * ----------------------------------------------------------------- + * + * NOTE: The following are two efficient ways to load a dense Jac: + * (1) (with macros - no explicit data structure references) + * for (j=0; j < Neq; j++) { + * col_j = LAPACK_DENSE_COL(Jac,j); + * for (i=0; i < Neq; i++) { + * generate J_ij = the (i,j)th Jacobian element + * col_j[i] = J_ij; + * } + * } + * (2) (without macros - explicit data structure references) + * for (j=0; j < Neq; j++) { + * col_j = (Jac->data)[j]; + * for (i=0; i < Neq; i++) { + * generate J_ij = the (i,j)th Jacobian element + * col_j[i] = J_ij; + * } + * } + * A third way, using the LAPACK_DENSE_ELEM(A,i,j) macro, is much less + * efficient in general. It is only appropriate for use in small + * problems in which efficiency of access is NOT a major concern. + * + * NOTE: If the user's Jacobian routine needs other quantities, + * they are accessible as follows: hcur (the current stepsize) + * and ewt (the error weight vector) are accessible through + * IDAGetCurrentStep and IDAGetErrWeights, respectively + * (see ida.h). The unit roundoff is available as + * UNIT_ROUNDOFF defined in sundials_types.h. + * + * ----------------------------------------------------------------- + */ + + +typedef int (*IDADlsDenseJacFn)(int N, realtype t, realtype c_j, + N_Vector y, N_Vector yp, N_Vector r, + DlsMat Jac, void *user_data, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); + +/* + * ----------------------------------------------------------------- + * Types : IDADlsBandJacFn + * ----------------------------------------------------------------- + * A banded Jacobian approximation function bjac must have the + * prototype given below. Its parameters are: + * + * Neq is the problem size, and length of all vector arguments. + * + * mupper is the upper bandwidth of the banded Jacobian matrix. + * + * mlower is the lower bandwidth of the banded Jacobian matrix. + * + * tt is the current value of the independent variable t. + * + * yy is the current value of the dependent variable vector, + * namely the predicted value of y(t). + * + * yp is the current value of the derivative vector y', + * namely the predicted value of y'(t). + * + * rr is the residual vector F(tt,yy,yp). + * + * c_j is the scalar in the system Jacobian, proportional to 1/hh. + * + * user_data is a pointer to user Jacobian data - the same as the + * user_data parameter passed to IDASetRdata. + * + * Jac is the band matrix (of type BandMat) to be loaded by + * an IDADlsBandJacFn routine with an approximation to the + * system Jacobian matrix + * J = dF/dy + cj*dF/dy' + * at the given point (t,y,y'), where the DAE system is + * given by F(t,y,y') = 0. Jac is preset to zero, so only + * the nonzero elements need to be loaded. See note below. + * + * tmp1, tmp2, tmp3 are pointers to memory allocated for + * N_Vectors which can be used by an IDADlsBandJacFn routine + * as temporary storage or work space. + * + * An IDADlsBandJacFn function should return + * 0 if successful, + * a positive int if a recoverable error occurred, or + * a negative int if a nonrecoverable error occurred. + * In the case of a recoverable error return, the integrator will + * attempt to recover by reducing the stepsize (which changes cj). + * + * ----------------------------------------------------------------- + * + * NOTE: The following are two efficient ways to load Jac: + * + * (1) (with macros - no explicit data structure references) + * for (j=0; j < Neq; j++) { + * col_j = BAND_COL(Jac,j); + * for (i=j-mupper; i <= j+mlower; i++) { + * generate J_ij = the (i,j)th Jacobian element + * BAND_COL_ELEM(col_j,i,j) = J_ij; + * } + * } + * + * (2) (with BAND_COL macro, but without BAND_COL_ELEM macro) + * for (j=0; j < Neq; j++) { + * col_j = BAND_COL(Jac,j); + * for (k=-mupper; k <= mlower; k++) { + * generate J_ij = the (i,j)th Jacobian element, i=j+k + * col_j[k] = J_ij; + * } + * } + * + * A third way, using the BAND_ELEM(A,i,j) macro, is much less + * efficient in general. It is only appropriate for use in small + * problems in which efficiency of access is NOT a major concern. + * + * NOTE: If the user's Jacobian routine needs other quantities, + * they are accessible as follows: hcur (the current stepsize) + * and ewt (the error weight vector) are accessible through + * IDAGetCurrentStep and IDAGetErrWeights, respectively (see + * ida.h). The unit roundoff is available as + * UNIT_ROUNDOFF defined in sundials_types.h + * + * ----------------------------------------------------------------- + */ + +typedef int (*IDADlsBandJacFn)(int N, int mupper, int mlower, + realtype t, realtype c_j, + N_Vector y, N_Vector yp, N_Vector r, + DlsMat Jac, void *user_data, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); + +/* + * ================================================================= + * E X P O R T E D F U N C T I O N S + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Optional inputs to the IDADLS linear solver + * ----------------------------------------------------------------- + * IDADlsSetDenseJacFn specifies the dense Jacobian approximation + * routine to be used for a direct dense linear solver. + * + * IDADlsSetBandJacFn specifies the band Jacobian approximation + * routine to be used for a direct band linear solver. + * + * By default, a difference quotient approximation, supplied with + * the solver is used. + * + * The return value is one of: + * IDADLS_SUCCESS if successful + * IDADLS_MEM_NULL if the IDA memory was NULL + * IDADLS_LMEM_NULL if the linear solver memory was NULL + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDADlsSetDenseJacFn(void *ida_mem, IDADlsDenseJacFn jac); +SUNDIALS_EXPORT int IDADlsSetBandJacFn(void *ida_mem, IDADlsBandJacFn jac); + +/* + * ----------------------------------------------------------------- + * Optional outputs from the IDADLS linear solver + * ----------------------------------------------------------------- + * + * IDADlsGetWorkSpace returns the real and integer workspace used + * by the direct linear solver. + * IDADlsGetNumJacEvals returns the number of calls made to the + * Jacobian evaluation routine jac. + * IDADlsGetNumResEvals returns the number of calls to the user + * f routine due to finite difference Jacobian + * evaluation. + * IDADlsGetLastFlag returns the last error flag set by any of + * the IDADLS interface functions. + * + * The return value of IDADlsGet* is one of: + * IDADLS_SUCCESS if successful + * IDADLS_MEM_NULL if the IDA memory was NULL + * IDADLS_LMEM_NULL if the linear solver memory was NULL + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDADlsGetWorkSpace(void *ida_mem, long int *lenrwLS, long int *leniwLS); +SUNDIALS_EXPORT int IDADlsGetNumJacEvals(void *ida_mem, long int *njevals); +SUNDIALS_EXPORT int IDADlsGetNumResEvals(void *ida_mem, long int *nfevalsLS); +SUNDIALS_EXPORT int IDADlsGetLastFlag(void *ida_mem, int *flag); + +/* + * ----------------------------------------------------------------- + * The following function returns the name of the constant + * associated with a IDADLS return flag + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT char *IDADlsGetReturnFlagName(int flag); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/ida/ida_lapack.h b/odemex/Parser/CVode/ida_src/include/ida/ida_lapack.h new file mode 100644 index 0000000..a50ed5c --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/ida/ida_lapack.h @@ -0,0 +1,80 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.4 $ + * $Date: 2008/04/18 19:42:37 $ + * ----------------------------------------------------------------- + * Programmer: Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2006, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * Header file for the IDA dense linear solver IDALAPACK. + * ----------------------------------------------------------------- + */ + +#ifndef _IDALAPACK_H +#define _IDALAPACK_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ----------------------------------------------------------------- + * Function : IDALapackDense + * ----------------------------------------------------------------- + * A call to the IDALapackDense function links the main integrator + * with the IDALAPACK linear solver using dense Jacobians. + * + * ida_mem is the pointer to the integrator memory returned by + * IDACreate. + * + * N is the size of the ODE system. + * + * The return value of IDALapackDense is one of: + * IDADLS_SUCCESS if successful + * IDADLS_MEM_NULL if the IDA memory was NULL + * IDADLS_MEM_FAIL if there was a memory allocation failure + * IDADLS_ILL_INPUT if a required vector operation is missing + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDALapackDense(void *ida_mem, int N); + +/* + * ----------------------------------------------------------------- + * Function : IDALapackBand + * ----------------------------------------------------------------- + * A call to the IDALapackBand function links the main integrator + * with the IDALAPACK linear solver using banded Jacobians. + * + * ida_mem is the pointer to the integrator memory returned by + * IDACreate. + * + * N is the size of the ODE system. + * + * mupper is the upper bandwidth of the band Jacobian approximation. + * + * mlower is the lower bandwidth of the band Jacobian approximation. + * + * The return value of IDALapackBand is one of: + * IDADLS_SUCCESS if successful + * IDADLS_MEM_NULL if the IDA memory was NULL + * IDADLS_MEM_FAIL if there was a memory allocation failure + * IDADLS_ILL_INPUT if a required vector operation is missing + * or if a bandwidth has an illegal value. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDALapackBand(void *ida_mem, int N, int mupper, int mlower); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/ida/ida_spbcgs.h b/odemex/Parser/CVode/ida_src/include/ida/ida_spbcgs.h new file mode 100644 index 0000000..f733a11 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/ida/ida_spbcgs.h @@ -0,0 +1,59 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2006/11/29 00:05:06 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2004, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the public header file for the IDA scaled preconditioned + * Bi-CGSTAB linear solver module, IDASPBCG. + * ----------------------------------------------------------------- + */ + +#ifndef _IDASPBCG_H +#define _IDASPBCG_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ----------------------------------------------------------------- + * Function : IDASpbcg + * ----------------------------------------------------------------- + * A call to the IDASpbcg function links the main integrator with + * the IDASPBCG linear solver module. Its parameters are as + * follows: + * + * IDA_mem is the pointer to memory block returned by IDACreate. + * + * maxl is the maximum Krylov subspace dimension, an + * optional input. Pass 0 to use the default value. + * Otherwise pass a positive integer. + * + * The return values of IDASpbcg are: + * IDASPILS_SUCCESS if successful + * IDASPILS_MEM_NULL if the ida memory was NULL + * IDASPILS_MEM_FAIL if there was a memory allocation failure + * IDASPILS_ILL_INPUT if there was illegal input. + * The above constants are defined in ida_spils.h + * + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDASpbcg(void *ida_mem, int maxl); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/ida/ida_spgmr.h b/odemex/Parser/CVode/ida_src/include/ida/ida_spgmr.h new file mode 100644 index 0000000..3604028 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/ida/ida_spgmr.h @@ -0,0 +1,60 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2006/11/29 00:05:06 $ + * ----------------------------------------------------------------- + * Programmers: Alan C. Hindmarsh and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California + * Produced at the Lawrence Livermore National Laboratory + * All rights reserved + * For details, see the LICENSE file + * ----------------------------------------------------------------- + * This is the header file for the IDA Scaled Preconditioned GMRES + * linear solver module, IDASPGMR. + * ----------------------------------------------------------------- + */ + +#ifndef _IDASPGMR_H +#define _IDASPGMR_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ----------------------------------------------------------------- + * + * Function : IDASpgmr + * ----------------------------------------------------------------- + * A call to the IDASpgmr function links the main integrator with + * the IDASPGMR linear solver module. Its parameters are as + * follows: + * + * IDA_mem is the pointer to memory block returned by IDACreate. + * + * maxl is the maximum Krylov subspace dimension, an + * optional input. Pass 0 to use the default value, + * MIN(Neq, 5). Otherwise pass a positive integer. + * + * The return values of IDASpgmr are: + * IDASPILS_SUCCESS if successful + * IDASPILS_MEM_NULL if the ida memory was NULL + * IDASPILS_MEM_FAIL if there was a memory allocation failure + * IDASPILS_ILL_INPUT if there was illegal input. + * The above constants are defined in ida_spils.h + * + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDASpgmr(void *ida_mem, int maxl); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/ida/ida_spils.h b/odemex/Parser/CVode/ida_src/include/ida/ida_spils.h new file mode 100644 index 0000000..9bb641d --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/ida/ida_spils.h @@ -0,0 +1,321 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.8 $ + * $Date: 2007/11/26 16:19:59 $ + * ----------------------------------------------------------------- + * Programmers: Alan Hindmarsh, Radu Serban and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California + * Produced at the Lawrence Livermore National Laboratory + * All rights reserved + * For details, see the LICENSE file + * ----------------------------------------------------------------- + * This is the common header file for the Scaled and Preconditioned + * Iterative Linear Solvers in IDA. + * ----------------------------------------------------------------- + */ + +#ifndef _IDASPILS_H +#define _IDASPILS_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ----------------------------------------------------------------- + * IDASPILS return values + * ----------------------------------------------------------------- + */ + +#define IDASPILS_SUCCESS 0 +#define IDASPILS_MEM_NULL -1 +#define IDASPILS_LMEM_NULL -2 +#define IDASPILS_ILL_INPUT -3 +#define IDASPILS_MEM_FAIL -4 +#define IDASPILS_PMEM_NULL -5 + +/* + * ----------------------------------------------------------------- + * Type : IDASpilsPrecSetupFn + * ----------------------------------------------------------------- + * The optional user-supplied functions PrecSetup and PrecSolve + * together must define the left preconditoner matrix P + * approximating the system Jacobian matrix + * J = dF/dy + c_j*dF/dy' + * (where the DAE system is F(t,y,y') = 0), and solve the linear + * systems P z = r. PrecSetup is to do any necessary setup + * operations, and PrecSolve is to compute the solution of + * P z = r. + * + * The preconditioner setup function PrecSetup is to evaluate and + * preprocess any Jacobian-related data needed by the + * preconditioner solve function PrecSolve. This might include + * forming a crude approximate Jacobian, and performing an LU + * factorization on it. This function will not be called in + * advance of every call to PrecSolve, but instead will be called + * only as often as necessary to achieve convergence within the + * Newton iteration. If the PrecSolve function needs no + * preparation, the PrecSetup function can be NULL. + * + * Each call to the PrecSetup function is preceded by a call to + * the system function res with the same (t,y,y') arguments. + * Thus the PrecSetup function can use any auxiliary data that is + * computed and saved by the res function and made accessible + * to PrecSetup. + * + * A preconditioner setup function PrecSetup must have the + * prototype given below. Its parameters are as follows: + * + * tt is the current value of the independent variable t. + * + * yy is the current value of the dependent variable vector, + * namely the predicted value of y(t). + * + * yp is the current value of the derivative vector y', + * namely the predicted value of y'(t). + * + * rr is the current value of the residual vector F(t,y,y'). + * + * c_j is the scalar in the system Jacobian, proportional to 1/hh. + * + * user_data is a pointer to user data, the same as the user_data + * parameter passed to IDASetUserData. + * + * tmp1, tmp2, tmp3 are pointers to vectors of type N_Vector + * which can be used by an IDASpilsPrecSetupFn routine + * as temporary storage or work space. + * + * NOTE: If the user's preconditioner needs other quantities, + * they are accessible as follows: hcur (the current stepsize) + * and ewt (the error weight vector) are accessible through + * IDAGetCurrentStep and IDAGetErrWeights, respectively (see + * ida.h). The unit roundoff is available as + * UNIT_ROUNDOFF defined in sundials_types.h + * + * The IDASpilsPrecSetupFn should return + * 0 if successful, + * a positive int if a recoverable error occurred, or + * a negative int if a nonrecoverable error occurred. + * In the case of a recoverable error return, the integrator will + * attempt to recover by reducing the stepsize (which changes cj). + * ----------------------------------------------------------------- + */ + +typedef int (*IDASpilsPrecSetupFn)(realtype tt, + N_Vector yy, N_Vector yp, N_Vector rr, + realtype c_j, void *user_data, + N_Vector tmp1, N_Vector tmp2, + N_Vector tmp3); + +/* + * ----------------------------------------------------------------- + * Type : IDASpilsPrecSolveFn + * ----------------------------------------------------------------- + * The optional user-supplied function PrecSolve must compute a + * solution to the linear system P z = r, where P is the left + * preconditioner defined by the user. If no preconditioning + * is desired, pass NULL for PrecSolve to IDASp*. + * + * A preconditioner solve function PrecSolve must have the + * prototype given below. Its parameters are as follows: + * + * tt is the current value of the independent variable t. + * + * yy is the current value of the dependent variable vector y. + * + * yp is the current value of the derivative vector y'. + * + * rr is the current value of the residual vector F(t,y,y'). + * + * rvec is the input right-hand side vector r. + * + * zvec is the computed solution vector z. + * + * c_j is the scalar in the system Jacobian, proportional to 1/hh. + * + * delta is an input tolerance for use by PrecSolve if it uses an + * iterative method in its solution. In that case, the + * the residual vector r - P z of the system should be + * made less than delta in weighted L2 norm, i.e., + * sqrt [ Sum (Res[i]*ewt[i])^2 ] < delta . + * Note: the error weight vector ewt can be obtained + * through a call to the routine IDAGetErrWeights. + * + * user_data is a pointer to user data, the same as the user_data + * parameter passed to IDASetUserData. + * + * tmp is an N_Vector which can be used by the PrecSolve + * routine as temporary storage or work space. + * + * The IDASpilsPrecSolveFn should return + * 0 if successful, + * a positive int if a recoverable error occurred, or + * a negative int if a nonrecoverable error occurred. + * Following a recoverable error, the integrator will attempt to + * recover by updating the preconditioner and/or reducing the + * stepsize. + * ----------------------------------------------------------------- + */ + +typedef int (*IDASpilsPrecSolveFn)(realtype tt, + N_Vector yy, N_Vector yp, N_Vector rr, + N_Vector rvec, N_Vector zvec, + realtype c_j, realtype delta, void *user_data, + N_Vector tmp); + +/* + * ----------------------------------------------------------------- + * Type : IDASpilsJacTimesVecFn + * ----------------------------------------------------------------- + * The user-supplied function jtimes is to generate the product + * J*v for given v, where J is the Jacobian matrix + * J = dF/dy + c_j*dF/dy' + * or an approximation to it, and v is a given vector. + * It should return 0 if successful and a nonzero int otherwise. + * + * A function jtimes must have the prototype given below. Its + * parameters are as follows: + * + * tt is the current value of the independent variable. + * + * yy is the current value of the dependent variable vector, + * namely the predicted value of y(t). + * + * yp is the current value of the derivative vector y', + * namely the predicted value of y'(t). + * + * rr is the current value of the residual vector F(t,y,y'). + * + * v is the N_Vector to be multiplied by J. + * + * Jv is the output N_Vector containing J*v. + * + * c_j is the scalar in the system Jacobian, proportional + * to 1/hh. + * + * user_data is a pointer to user data, the same as the + * pointer passed to IDASetUserData. + * + * tmp1, tmp2 are two N_Vectors which can be used by Jtimes for + * work space. + * ----------------------------------------------------------------- + */ + +typedef int (*IDASpilsJacTimesVecFn)(realtype tt, + N_Vector yy, N_Vector yp, N_Vector rr, + N_Vector v, N_Vector Jv, + realtype c_j, void *user_data, + N_Vector tmp1, N_Vector tmp2); + + +/* + * ----------------------------------------------------------------- + * Optional inputs to the IDASPILS linear solver + * ----------------------------------------------------------------- + * + * IDASpilsSetPreconditioner specifies the PrecSetup and PrecSolve + * functions. + * Default is NULL for both arguments. + * IDASpilsSetJacTimesVecFn specifies the jtimes function. + * Default is to use an internal finite difference + * approximation routine. + * IDASpilsSetGSType specifies the type of Gram-Schmidt + * orthogonalization to be used. This must be one of + * the two enumeration constants MODIFIED_GS or + * CLASSICAL_GS defined in iterativ.h. These correspond + * to using modified Gram-Schmidt and classical + * Gram-Schmidt, respectively. + * Default value is MODIFIED_GS. + * Only for IDASPGMR. + * IDASpilsSetMaxRestarts specifies the maximum number of restarts + * to be used in the GMRES algorithm. maxrs must be a + * non-negative integer. Pass 0 to specify no restarts. + * Default is 5. + * Only for IDASPGMR. + * IDASpbcgSetMaxl specifies the maximum Krylov subspace size. + * Default is 5. + * Only for IDASPBCG and IDASPTFQMR. + * IDASpilsSetEpsLin specifies the factor in the linear iteration + * convergence test constant. + * Default is 0.05 + * IDASpilsSetIncrementFactor specifies a factor in the increments + * to yy used in the difference quotient approximations + * to matrix-vector products Jv. + * Default is 1.0 + * + * The return value of IDASpilsSet* is one of: + * IDASPILS_SUCCESS if successful + * IDASPILS_MEM_NULL if the ida memory was NULL + * IDASPILS_LMEM_NULL if the linear solver memory was NULL + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDASpilsSetPreconditioner(void *ida_mem, + IDASpilsPrecSetupFn pset, + IDASpilsPrecSolveFn psolve); +SUNDIALS_EXPORT int IDASpilsSetJacTimesVecFn(void *ida_mem, + IDASpilsJacTimesVecFn jtv); + +SUNDIALS_EXPORT int IDASpilsSetGSType(void *ida_mem, int gstype); +SUNDIALS_EXPORT int IDASpilsSetMaxRestarts(void *ida_mem, int maxrs); +SUNDIALS_EXPORT int IDASpilsSetMaxl(void *ida_mem, int maxl); +SUNDIALS_EXPORT int IDASpilsSetEpsLin(void *ida_mem, realtype eplifac); +SUNDIALS_EXPORT int IDASpilsSetIncrementFactor(void *ida_mem, realtype dqincfac); + +/* + * ----------------------------------------------------------------- + * Optional outputs from the IDASPILS linear solver + *---------------------------------------------------------------- + * + * IDASpilsGetWorkSpace returns the real and integer workspace used + * by IDASPILS. + * IDASpilsGetNumPrecEvals returns the number of preconditioner + * evaluations, i.e. the number of calls made to PrecSetup + * with jok==FALSE. + * IDASpilsGetNumPrecSolves returns the number of calls made to + * PrecSolve. + * IDASpilsGetNumLinIters returns the number of linear iterations. + * IDASpilsGetNumConvFails returns the number of linear + * convergence failures. + * IDASpilsGetNumJtimesEvals returns the number of calls to jtimes + * IDASpilsGetNumResEvals returns the number of calls to the user + * res routine due to finite difference Jacobian times vector + * evaluation. + * IDASpilsGetLastFlag returns the last error flag set by any of + * the IDASPILS interface functions. + * + * The return value of IDASpilsGet* is one of: + * IDASPILS_SUCCESS if successful + * IDASPILS_MEM_NULL if the ida memory was NULL + * IDASPILS_LMEM_NULL if the linear solver memory was NULL + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDASpilsGetWorkSpace(void *ida_mem, long int *lenrwLS, long int *leniwLS); +SUNDIALS_EXPORT int IDASpilsGetNumPrecEvals(void *ida_mem, long int *npevals); +SUNDIALS_EXPORT int IDASpilsGetNumPrecSolves(void *ida_mem, long int *npsolves); +SUNDIALS_EXPORT int IDASpilsGetNumLinIters(void *ida_mem, long int *nliters); +SUNDIALS_EXPORT int IDASpilsGetNumConvFails(void *ida_mem, long int *nlcfails); +SUNDIALS_EXPORT int IDASpilsGetNumJtimesEvals(void *ida_mem, long int *njvevals); +SUNDIALS_EXPORT int IDASpilsGetNumResEvals(void *ida_mem, long int *nrevalsLS); +SUNDIALS_EXPORT int IDASpilsGetLastFlag(void *ida_mem, int *flag); + +/* + * ----------------------------------------------------------------- + * The following function returns the name of the constant + * associated with an IDASPILS return flag + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT char *IDASpilsGetReturnFlagName(int flag); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/ida/ida_sptfqmr.h b/odemex/Parser/CVode/ida_src/include/ida/ida_sptfqmr.h new file mode 100644 index 0000000..a7a32b5 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/ida/ida_sptfqmr.h @@ -0,0 +1,59 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2006/11/29 00:05:07 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the public header file for the IDA scaled preconditioned + * TFQMR linear solver module, IDASPTFQMR. + * ----------------------------------------------------------------- + */ + +#ifndef _IDASPTFQMR_H +#define _IDASPTFQMR_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ----------------------------------------------------------------- + * Function : IDASptfqmr + * ----------------------------------------------------------------- + * A call to the IDASptfqmr function links the main integrator with + * the IDASPTFQMR linear solver module. Its parameters are as + * follows: + * + * IDA_mem is the pointer to memory block returned by IDACreate. + * + * maxl is the maximum Krylov subspace dimension, an + * optional input. Pass 0 to use the default value. + * Otherwise pass a positive integer. + * + * The return values of IDASptfqmr are: + * IDASPILS_SUCCESS if successful + * IDASPILS_MEM_NULL if the ida memory was NULL + * IDASPILS_MEM_FAIL if there was a memory allocation failure + * IDASPILS_ILL_INPUT if there was illegal input. + * The above constants are defined in ida_spils.h + * + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDASptfqmr(void *ida_mem, int maxl); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/ida_band.h b/odemex/Parser/CVode/ida_src/include/ida_band.h new file mode 100644 index 0000000..acdcd9b --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/ida_band.h @@ -0,0 +1,59 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.5 $ + * $Date: 2008/04/18 19:42:37 $ + * ----------------------------------------------------------------- + * Programmer(s): Alan C. Hindmarsh, and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the IDABAND linear solver module. + * ----------------------------------------------------------------- + */ + +#ifndef _IDABAND_H +#define _IDABAND_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ----------------------------------------------------------------- + * Function : IDABand + * ----------------------------------------------------------------- + * A call to the IDABand function links the main integrator + * with the IDABAND linear solver module. + * + * ida_mem is the pointer to the integrator memory returned by + * IDACreate. + * + * mupper is the upper bandwidth of the banded Jacobian matrix. + * + * mlower is the lower bandwidth of the banded Jacobian matrix. + * + * The return values of IDABand are: + * IDADLS_SUCCESS = 0 if successful + * IDADLS_LMEM_FAIL = -1 if there was a memory allocation failure + * IDADLS_ILL_INPUT = -2 if the input was illegal or NVECTOR bad. + * + * NOTE: The band linear solver assumes a serial implementation + * of the NVECTOR package. Therefore, IDABand will first + * test for a compatible N_Vector internal representation + * by checking that the N_VGetArrayPointer function exists. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDABand(void *ida_mem, int Neq, int mupper, int mlower); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/ida_bbdpre.h b/odemex/Parser/CVode/ida_src/include/ida_bbdpre.h new file mode 100644 index 0000000..24d2956 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/ida_bbdpre.h @@ -0,0 +1,275 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.7 $ + * $Date: 2007/11/26 16:19:59 $ + * ----------------------------------------------------------------- + * Programmer(s): Alan C. Hindmarsh, Radu Serban and + * Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the IDABBDPRE module, for a + * band-block-diagonal preconditioner, i.e. a block-diagonal + * matrix with banded blocks, for use with IDA and + * IDASPGMR/IDASPBCG/IDASPTFQMR. + * + * Summary: + * + * These routines provide a preconditioner matrix that is + * block-diagonal with banded blocks. The blocking corresponds + * to the distribution of the dependent variable vector y among + * the processors. Each preconditioner block is generated from + * the Jacobian of the local part (on the current processor) of a + * given function G(t,y,y') approximating F(t,y,y'). The blocks + * are generated by a difference quotient scheme on each processor + * independently. This scheme utilizes an assumed banded structure + * with given half-bandwidths, mudq and mldq. However, the banded + * Jacobian block kept by the scheme has half-bandwiths mukeep and + * mlkeep, which may be smaller. + * + * The user's calling program should have the following form: + * + * #include + * #include + * ... + * y0 = N_VNew_Parallel(...); + * yp0 = N_VNew_Parallel(...); + * ... + * ida_mem = IDACreate(...); + * ier = IDAInit(...); + * ... + * flag = IDASptfqmr(ida_mem, maxl); + * -or- + * flag = IDASpgmr(ida_mem, maxl); + * -or- + * flag = IDASpbcg(ida_mem, maxl); + * ... + * flag = IDABBDPrecInit(ida_mem, Nlocal, mudq, mldq, + * mukeep, mlkeep, dq_rel_yy, Gres, Gcomm); + * ... + * ier = IDASolve(...); + * ... + * IDAFree(&ida_mem); + * + * N_VDestroy(y0); + * N_VDestroy(yp0); + * + * The user-supplied routines required are: + * + * res is the function F(t,y,y') defining the DAE system to + * be solved: F(t,y,y') = 0. + * + * Gres is the function defining a local approximation + * G(t,y,y') to F, for the purposes of the preconditioner. + * + * Gcomm is the function performing communication needed + * for Glocal. + * + * Notes: + * + * 1) This header file is included by the user for the definition + * of the IBBDPrecData type and for needed function prototypes. + * + * 2) The IDABBDPrecInit call includes half-bandwidths mudq and + * mldq to be used in the approximate Jacobian. They need + * not be the true half-bandwidths of the Jacobian of the + * local block of G, when smaller values may provide a greater + * efficiency. Similarly, mukeep and mlkeep, specifying the + * bandwidth kept for the approximate Jacobian, need not be + * the true half-bandwidths. Also, mukeep, mlkeep, mudq, and + * mldq need not be the same on every processor. + * + * 3) The actual name of the user's res function is passed to + * IDAInit, and the names of the user's Gres and Gcomm + * functions are passed to IDABBDPrecInit. + * + * 4) The pointer to the user-defined data block user_data, which + * is set through IDASetUserData is also available to the user + * in glocal and gcomm. + * + * 5) Optional outputs specific to this module are available by + * way of routines listed below. These include work space sizes + * and the cumulative number of glocal calls. The costs + * associated with this module also include nsetups banded LU + * factorizations, nsetups gcomm calls, and nps banded + * backsolve calls, where nsetups and nps are integrator + * optional outputs. + * ----------------------------------------------------------------- + */ + +#ifndef _IDABBDPRE_H +#define _IDABBDPRE_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ----------------------------------------------------------------- + * Type : IDABBDLocalFn + * ----------------------------------------------------------------- + * The user must supply a function G(t,y,y') which approximates + * the function F for the system F(t,y,y') = 0, and which is + * computed locally (without interprocess communication). + * (The case where G is mathematically identical to F is allowed.) + * The implementation of this function must have type IDABBDLocalFn. + * + * This function takes as input the independent variable value tt, + * the current solution vector yy, the current solution + * derivative vector yp, and a pointer to the user-defined data + * block user_data. It is to compute the local part of G(t,y,y') + * and store it in the vector gval. (Providing memory for yy and + * gval is handled within this preconditioner module.) It is + * expected that this routine will save communicated data in work + * space defined by the user, and made available to the + * preconditioner function for the problem. The user_data + * parameter is the same as that passed by the user to the + * IDASetRdata routine. + * + * An IDABBDLocalFn Gres is to return an int, defined in the same + * way as for the residual function: 0 (success), +1 or -1 (fail). + * ----------------------------------------------------------------- + */ + +typedef int (*IDABBDLocalFn)(int Nlocal, realtype tt, + N_Vector yy, N_Vector yp, N_Vector gval, + void *user_data); + +/* + * ----------------------------------------------------------------- + * Type : IDABBDCommFn + * ----------------------------------------------------------------- + * The user may supply a function of type IDABBDCommFn which + * performs all interprocess communication necessary to + * evaluate the approximate system function described above. + * + * This function takes as input the solution vectors yy and yp, + * and a pointer to the user-defined data block user_data. The + * user_data parameter is the same as that passed by the user to + * the IDASetUserData routine. + * + * The IDABBDCommFn Gcomm is expected to save communicated data in + * space defined with the structure *user_data. + * + * A IDABBDCommFn Gcomm returns an int value equal to 0 (success), + * > 0 (recoverable error), or < 0 (unrecoverable error). + * + * Each call to the IDABBDCommFn is preceded by a call to the system + * function res with the same vectors yy and yp. Thus the + * IDABBDCommFn gcomm can omit any communications done by res if + * relevant to the evaluation of the local function glocal. + * A NULL communication function can be passed to IDABBDPrecInit + * if all necessary communication was done by res. + * ----------------------------------------------------------------- + */ + +typedef int (*IDABBDCommFn)(int Nlocal, realtype tt, + N_Vector yy, N_Vector yp, + void *user_data); + +/* + * ----------------------------------------------------------------- + * Function : IDABBDPrecInit + * ----------------------------------------------------------------- + * IDABBDPrecInit allocates and initializes the BBD preconditioner. + * + * The parameters of IDABBDPrecInit are as follows: + * + * ida_mem is a pointer to the memory blockreturned by IDACreate. + * + * Nlocal is the length of the local block of the vectors yy etc. + * on the current processor. + * + * mudq, mldq are the upper and lower half-bandwidths to be used + * in the computation of the local Jacobian blocks. + * + * mukeep, mlkeep are the upper and lower half-bandwidths to be + * used in saving the Jacobian elements in the local + * block of the preconditioner matrix PP. + * + * dq_rel_yy is an optional input. It is the relative increment + * to be used in the difference quotient routine for + * Jacobian calculation in the preconditioner. The + * default is sqrt(unit roundoff), and specified by + * passing dq_rel_yy = 0. + * + * Gres is the name of the user-supplied function G(t,y,y') + * that approximates F and whose local Jacobian blocks + * are to form the preconditioner. + * + * Gcomm is the name of the user-defined function that performs + * necessary interprocess communication for the + * execution of glocal. + * + * The return value of IDABBDPrecInit is one of: + * IDASPILS_SUCCESS if no errors occurred + * IDASPILS_MEM_NULL if the integrator memory is NULL + * IDASPILS_LMEM_NULL if the linear solver memory is NULL + * IDASPILS_ILL_INPUT if an input has an illegal value + * IDASPILS_MEM_FAIL if a memory allocation request failed + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDABBDPrecInit(void *ida_mem, int Nlocal, + int mudq, int mldq, + int mukeep, int mlkeep, + realtype dq_rel_yy, + IDABBDLocalFn Gres, IDABBDCommFn Gcomm); + +/* + * ----------------------------------------------------------------- + * Function : IDABBDPrecReInit + * ----------------------------------------------------------------- + * IDABBDPrecReInit reinitializes the IDABBDPRE module when + * solving a sequence of problems of the same size with + * IDASPGMR/IDABBDPRE, IDASPBCG/IDABBDPRE, or IDASPTFQMR/IDABBDPRE + * provided there is no change in Nlocal, mukeep, or mlkeep. After + * solving one problem, and after calling IDAReInit to reinitialize + * the integrator for a subsequent problem, call IDABBDPrecReInit. + * + * All arguments have the same names and meanings as those + * of IDABBDPrecInit. + * + * The return value of IDABBDPrecReInit is one of: + * IDASPILS_SUCCESS if no errors occurred + * IDASPILS_MEM_NULL if the integrator memory is NULL + * IDASPILS_LMEM_NULL if the linear solver memory is NULL + * IDASPILS_PMEM_NULL if the preconditioner memory is NULL + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDABBDPrecReInit(void *ida_mem, + int mudq, int mldq, + realtype dq_rel_yy); + +/* + * ----------------------------------------------------------------- + * Optional outputs for IDABBDPRE + * ----------------------------------------------------------------- + * IDABBDPrecGetWorkSpace returns the real and integer work space + * for IDABBDPRE. + * IDABBDPrecGetNumGfnEvals returns the number of calls to the + * user Gres function. + * + * The return value of IDABBDPrecGet* is one of: + * IDASPILS_SUCCESS if no errors occurred + * IDASPILS_MEM_NULL if the integrator memory is NULL + * IDASPILS_LMEM_NULL if the linear solver memory is NULL + * IDASPILS_PMEM_NULL if the preconditioner memory is NULL + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDABBDPrecGetWorkSpace(void *ida_mem, + long int *lenrwBBDP, long int *leniwBBDP); +SUNDIALS_EXPORT int IDABBDPrecGetNumGfnEvals(void *ida_mem, long int *ngevalsBBDP); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/ida_dense.h b/odemex/Parser/CVode/ida_src/include/ida_dense.h new file mode 100644 index 0000000..92139a2 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/ida_dense.h @@ -0,0 +1,58 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.5 $ + * $Date: 2008/04/18 19:42:37 $ + * ----------------------------------------------------------------- + * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the IDADENSE linear solver module. + * ----------------------------------------------------------------- + */ + +#ifndef _IDADENSE_H +#define _IDADENSE_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ----------------------------------------------------------------- + * Function : IDADense + * ----------------------------------------------------------------- + * A call to the IDADense function links the main integrator + * with the IDADENSE linear solver module. + * + * ida_mem is the pointer to integrator memory returned by + * IDACreate. + * + * Neq is the problem size + * + * IDADense returns: + * IDADLS_SUCCESS = 0 if successful + * IDADLS_LMEM_FAIL = -1 if there was a memory allocation failure + * IDADLS_ILL_INPUT = -2 if NVECTOR found incompatible + * + * NOTE: The dense linear solver assumes a serial implementation + * of the NVECTOR package. Therefore, IDADense will first + * test for a compatible N_Vector internal representation + * by checking that the functions N_VGetArrayPointer and + * N_VSetArrayPointer exist. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDADense(void *ida_mem, int Neq); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/ida_direct.h b/odemex/Parser/CVode/ida_src/include/ida_direct.h new file mode 100644 index 0000000..55ec153 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/ida_direct.h @@ -0,0 +1,300 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.6 $ + * $Date: 2008/04/18 19:42:37 $ + * ----------------------------------------------------------------- + * Programmer: Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2006, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * Common header file for the direct linear solvers in IDA. + * ----------------------------------------------------------------- + */ + +#ifndef _IDADLS_H +#define _IDADLS_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ================================================================= + * I D A D I R E C T C O N S T A N T S + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * IDADLS return values + * ----------------------------------------------------------------- + */ + +#define IDADLS_SUCCESS 0 +#define IDADLS_MEM_NULL -1 +#define IDADLS_LMEM_NULL -2 +#define IDADLS_ILL_INPUT -3 +#define IDADLS_MEM_FAIL -4 + +/* Additional last_flag values */ + +#define IDADLS_JACFUNC_UNRECVR -5 +#define IDADLS_JACFUNC_RECVR -6 + +/* + * ================================================================= + * F U N C T I O N T Y P E S + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Types : IDADlsDenseJacFn + * ----------------------------------------------------------------- + * + * A dense Jacobian approximation function djac must be of type + * IDADlsDenseJacFn. + * Its parameters are: + * + * N is the problem size, and length of all vector arguments. + * + * t is the current value of the independent variable t. + * + * y is the current value of the dependent variable vector, + * namely the predicted value of y(t). + * + * yp is the current value of the derivative vector y', + * namely the predicted value of y'(t). + * + * f is the residual vector F(tt,yy,yp). + * + * c_j is the scalar in the system Jacobian, proportional to + * the inverse of the step size h. + * + * user_data is a pointer to user Jacobian data - the same as the + * user_data parameter passed to IDASetRdata. + * + * Jac is the dense matrix (of type DlsMat) to be loaded by + * an IDADlsDenseJacFn routine with an approximation to the + * system Jacobian matrix + * J = dF/dy' + gamma*dF/dy + * at the given point (t,y,y'), where the ODE system is + * given by F(t,y,y') = 0. + * Note that Jac is NOT preset to zero! + * + * tmp1, tmp2, tmp3 are pointers to memory allocated for + * N_Vectors which can be used by an IDADlsDenseJacFn routine + * as temporary storage or work space. + * + * A IDADlsDenseJacFn should return + * 0 if successful, + * a positive int if a recoverable error occurred, or + * a negative int if a nonrecoverable error occurred. + * In the case of a recoverable error return, the integrator will + * attempt to recover by reducing the stepsize (which changes cj). + * + * ----------------------------------------------------------------- + * + * NOTE: The following are two efficient ways to load a dense Jac: + * (1) (with macros - no explicit data structure references) + * for (j=0; j < Neq; j++) { + * col_j = LAPACK_DENSE_COL(Jac,j); + * for (i=0; i < Neq; i++) { + * generate J_ij = the (i,j)th Jacobian element + * col_j[i] = J_ij; + * } + * } + * (2) (without macros - explicit data structure references) + * for (j=0; j < Neq; j++) { + * col_j = (Jac->data)[j]; + * for (i=0; i < Neq; i++) { + * generate J_ij = the (i,j)th Jacobian element + * col_j[i] = J_ij; + * } + * } + * A third way, using the LAPACK_DENSE_ELEM(A,i,j) macro, is much less + * efficient in general. It is only appropriate for use in small + * problems in which efficiency of access is NOT a major concern. + * + * NOTE: If the user's Jacobian routine needs other quantities, + * they are accessible as follows: hcur (the current stepsize) + * and ewt (the error weight vector) are accessible through + * IDAGetCurrentStep and IDAGetErrWeights, respectively + * (see ida.h). The unit roundoff is available as + * UNIT_ROUNDOFF defined in sundials_types.h. + * + * ----------------------------------------------------------------- + */ + + +typedef int (*IDADlsDenseJacFn)(int N, realtype t, realtype c_j, + N_Vector y, N_Vector yp, N_Vector r, + DlsMat Jac, void *user_data, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); + +/* + * ----------------------------------------------------------------- + * Types : IDADlsBandJacFn + * ----------------------------------------------------------------- + * A banded Jacobian approximation function bjac must have the + * prototype given below. Its parameters are: + * + * Neq is the problem size, and length of all vector arguments. + * + * mupper is the upper bandwidth of the banded Jacobian matrix. + * + * mlower is the lower bandwidth of the banded Jacobian matrix. + * + * tt is the current value of the independent variable t. + * + * yy is the current value of the dependent variable vector, + * namely the predicted value of y(t). + * + * yp is the current value of the derivative vector y', + * namely the predicted value of y'(t). + * + * rr is the residual vector F(tt,yy,yp). + * + * c_j is the scalar in the system Jacobian, proportional to 1/hh. + * + * user_data is a pointer to user Jacobian data - the same as the + * user_data parameter passed to IDASetRdata. + * + * Jac is the band matrix (of type BandMat) to be loaded by + * an IDADlsBandJacFn routine with an approximation to the + * system Jacobian matrix + * J = dF/dy + cj*dF/dy' + * at the given point (t,y,y'), where the DAE system is + * given by F(t,y,y') = 0. Jac is preset to zero, so only + * the nonzero elements need to be loaded. See note below. + * + * tmp1, tmp2, tmp3 are pointers to memory allocated for + * N_Vectors which can be used by an IDADlsBandJacFn routine + * as temporary storage or work space. + * + * An IDADlsBandJacFn function should return + * 0 if successful, + * a positive int if a recoverable error occurred, or + * a negative int if a nonrecoverable error occurred. + * In the case of a recoverable error return, the integrator will + * attempt to recover by reducing the stepsize (which changes cj). + * + * ----------------------------------------------------------------- + * + * NOTE: The following are two efficient ways to load Jac: + * + * (1) (with macros - no explicit data structure references) + * for (j=0; j < Neq; j++) { + * col_j = BAND_COL(Jac,j); + * for (i=j-mupper; i <= j+mlower; i++) { + * generate J_ij = the (i,j)th Jacobian element + * BAND_COL_ELEM(col_j,i,j) = J_ij; + * } + * } + * + * (2) (with BAND_COL macro, but without BAND_COL_ELEM macro) + * for (j=0; j < Neq; j++) { + * col_j = BAND_COL(Jac,j); + * for (k=-mupper; k <= mlower; k++) { + * generate J_ij = the (i,j)th Jacobian element, i=j+k + * col_j[k] = J_ij; + * } + * } + * + * A third way, using the BAND_ELEM(A,i,j) macro, is much less + * efficient in general. It is only appropriate for use in small + * problems in which efficiency of access is NOT a major concern. + * + * NOTE: If the user's Jacobian routine needs other quantities, + * they are accessible as follows: hcur (the current stepsize) + * and ewt (the error weight vector) are accessible through + * IDAGetCurrentStep and IDAGetErrWeights, respectively (see + * ida.h). The unit roundoff is available as + * UNIT_ROUNDOFF defined in sundials_types.h + * + * ----------------------------------------------------------------- + */ + +typedef int (*IDADlsBandJacFn)(int N, int mupper, int mlower, + realtype t, realtype c_j, + N_Vector y, N_Vector yp, N_Vector r, + DlsMat Jac, void *user_data, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); + +/* + * ================================================================= + * E X P O R T E D F U N C T I O N S + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Optional inputs to the IDADLS linear solver + * ----------------------------------------------------------------- + * IDADlsSetDenseJacFn specifies the dense Jacobian approximation + * routine to be used for a direct dense linear solver. + * + * IDADlsSetBandJacFn specifies the band Jacobian approximation + * routine to be used for a direct band linear solver. + * + * By default, a difference quotient approximation, supplied with + * the solver is used. + * + * The return value is one of: + * IDADLS_SUCCESS if successful + * IDADLS_MEM_NULL if the IDA memory was NULL + * IDADLS_LMEM_NULL if the linear solver memory was NULL + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDADlsSetDenseJacFn(void *ida_mem, IDADlsDenseJacFn jac); +SUNDIALS_EXPORT int IDADlsSetBandJacFn(void *ida_mem, IDADlsBandJacFn jac); + +/* + * ----------------------------------------------------------------- + * Optional outputs from the IDADLS linear solver + * ----------------------------------------------------------------- + * + * IDADlsGetWorkSpace returns the real and integer workspace used + * by the direct linear solver. + * IDADlsGetNumJacEvals returns the number of calls made to the + * Jacobian evaluation routine jac. + * IDADlsGetNumResEvals returns the number of calls to the user + * f routine due to finite difference Jacobian + * evaluation. + * IDADlsGetLastFlag returns the last error flag set by any of + * the IDADLS interface functions. + * + * The return value of IDADlsGet* is one of: + * IDADLS_SUCCESS if successful + * IDADLS_MEM_NULL if the IDA memory was NULL + * IDADLS_LMEM_NULL if the linear solver memory was NULL + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDADlsGetWorkSpace(void *ida_mem, long int *lenrwLS, long int *leniwLS); +SUNDIALS_EXPORT int IDADlsGetNumJacEvals(void *ida_mem, long int *njevals); +SUNDIALS_EXPORT int IDADlsGetNumResEvals(void *ida_mem, long int *nfevalsLS); +SUNDIALS_EXPORT int IDADlsGetLastFlag(void *ida_mem, int *flag); + +/* + * ----------------------------------------------------------------- + * The following function returns the name of the constant + * associated with a IDADLS return flag + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT char *IDADlsGetReturnFlagName(int flag); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/ida_lapack.h b/odemex/Parser/CVode/ida_src/include/ida_lapack.h new file mode 100644 index 0000000..a50ed5c --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/ida_lapack.h @@ -0,0 +1,80 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.4 $ + * $Date: 2008/04/18 19:42:37 $ + * ----------------------------------------------------------------- + * Programmer: Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2006, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * Header file for the IDA dense linear solver IDALAPACK. + * ----------------------------------------------------------------- + */ + +#ifndef _IDALAPACK_H +#define _IDALAPACK_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ----------------------------------------------------------------- + * Function : IDALapackDense + * ----------------------------------------------------------------- + * A call to the IDALapackDense function links the main integrator + * with the IDALAPACK linear solver using dense Jacobians. + * + * ida_mem is the pointer to the integrator memory returned by + * IDACreate. + * + * N is the size of the ODE system. + * + * The return value of IDALapackDense is one of: + * IDADLS_SUCCESS if successful + * IDADLS_MEM_NULL if the IDA memory was NULL + * IDADLS_MEM_FAIL if there was a memory allocation failure + * IDADLS_ILL_INPUT if a required vector operation is missing + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDALapackDense(void *ida_mem, int N); + +/* + * ----------------------------------------------------------------- + * Function : IDALapackBand + * ----------------------------------------------------------------- + * A call to the IDALapackBand function links the main integrator + * with the IDALAPACK linear solver using banded Jacobians. + * + * ida_mem is the pointer to the integrator memory returned by + * IDACreate. + * + * N is the size of the ODE system. + * + * mupper is the upper bandwidth of the band Jacobian approximation. + * + * mlower is the lower bandwidth of the band Jacobian approximation. + * + * The return value of IDALapackBand is one of: + * IDADLS_SUCCESS if successful + * IDADLS_MEM_NULL if the IDA memory was NULL + * IDADLS_MEM_FAIL if there was a memory allocation failure + * IDADLS_ILL_INPUT if a required vector operation is missing + * or if a bandwidth has an illegal value. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDALapackBand(void *ida_mem, int N, int mupper, int mlower); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/ida_spbcgs.h b/odemex/Parser/CVode/ida_src/include/ida_spbcgs.h new file mode 100644 index 0000000..f733a11 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/ida_spbcgs.h @@ -0,0 +1,59 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2006/11/29 00:05:06 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2004, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the public header file for the IDA scaled preconditioned + * Bi-CGSTAB linear solver module, IDASPBCG. + * ----------------------------------------------------------------- + */ + +#ifndef _IDASPBCG_H +#define _IDASPBCG_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ----------------------------------------------------------------- + * Function : IDASpbcg + * ----------------------------------------------------------------- + * A call to the IDASpbcg function links the main integrator with + * the IDASPBCG linear solver module. Its parameters are as + * follows: + * + * IDA_mem is the pointer to memory block returned by IDACreate. + * + * maxl is the maximum Krylov subspace dimension, an + * optional input. Pass 0 to use the default value. + * Otherwise pass a positive integer. + * + * The return values of IDASpbcg are: + * IDASPILS_SUCCESS if successful + * IDASPILS_MEM_NULL if the ida memory was NULL + * IDASPILS_MEM_FAIL if there was a memory allocation failure + * IDASPILS_ILL_INPUT if there was illegal input. + * The above constants are defined in ida_spils.h + * + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDASpbcg(void *ida_mem, int maxl); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/ida_spgmr.h b/odemex/Parser/CVode/ida_src/include/ida_spgmr.h new file mode 100644 index 0000000..3604028 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/ida_spgmr.h @@ -0,0 +1,60 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2006/11/29 00:05:06 $ + * ----------------------------------------------------------------- + * Programmers: Alan C. Hindmarsh and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California + * Produced at the Lawrence Livermore National Laboratory + * All rights reserved + * For details, see the LICENSE file + * ----------------------------------------------------------------- + * This is the header file for the IDA Scaled Preconditioned GMRES + * linear solver module, IDASPGMR. + * ----------------------------------------------------------------- + */ + +#ifndef _IDASPGMR_H +#define _IDASPGMR_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ----------------------------------------------------------------- + * + * Function : IDASpgmr + * ----------------------------------------------------------------- + * A call to the IDASpgmr function links the main integrator with + * the IDASPGMR linear solver module. Its parameters are as + * follows: + * + * IDA_mem is the pointer to memory block returned by IDACreate. + * + * maxl is the maximum Krylov subspace dimension, an + * optional input. Pass 0 to use the default value, + * MIN(Neq, 5). Otherwise pass a positive integer. + * + * The return values of IDASpgmr are: + * IDASPILS_SUCCESS if successful + * IDASPILS_MEM_NULL if the ida memory was NULL + * IDASPILS_MEM_FAIL if there was a memory allocation failure + * IDASPILS_ILL_INPUT if there was illegal input. + * The above constants are defined in ida_spils.h + * + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDASpgmr(void *ida_mem, int maxl); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/ida_spils.h b/odemex/Parser/CVode/ida_src/include/ida_spils.h new file mode 100644 index 0000000..9bb641d --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/ida_spils.h @@ -0,0 +1,321 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.8 $ + * $Date: 2007/11/26 16:19:59 $ + * ----------------------------------------------------------------- + * Programmers: Alan Hindmarsh, Radu Serban and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California + * Produced at the Lawrence Livermore National Laboratory + * All rights reserved + * For details, see the LICENSE file + * ----------------------------------------------------------------- + * This is the common header file for the Scaled and Preconditioned + * Iterative Linear Solvers in IDA. + * ----------------------------------------------------------------- + */ + +#ifndef _IDASPILS_H +#define _IDASPILS_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ----------------------------------------------------------------- + * IDASPILS return values + * ----------------------------------------------------------------- + */ + +#define IDASPILS_SUCCESS 0 +#define IDASPILS_MEM_NULL -1 +#define IDASPILS_LMEM_NULL -2 +#define IDASPILS_ILL_INPUT -3 +#define IDASPILS_MEM_FAIL -4 +#define IDASPILS_PMEM_NULL -5 + +/* + * ----------------------------------------------------------------- + * Type : IDASpilsPrecSetupFn + * ----------------------------------------------------------------- + * The optional user-supplied functions PrecSetup and PrecSolve + * together must define the left preconditoner matrix P + * approximating the system Jacobian matrix + * J = dF/dy + c_j*dF/dy' + * (where the DAE system is F(t,y,y') = 0), and solve the linear + * systems P z = r. PrecSetup is to do any necessary setup + * operations, and PrecSolve is to compute the solution of + * P z = r. + * + * The preconditioner setup function PrecSetup is to evaluate and + * preprocess any Jacobian-related data needed by the + * preconditioner solve function PrecSolve. This might include + * forming a crude approximate Jacobian, and performing an LU + * factorization on it. This function will not be called in + * advance of every call to PrecSolve, but instead will be called + * only as often as necessary to achieve convergence within the + * Newton iteration. If the PrecSolve function needs no + * preparation, the PrecSetup function can be NULL. + * + * Each call to the PrecSetup function is preceded by a call to + * the system function res with the same (t,y,y') arguments. + * Thus the PrecSetup function can use any auxiliary data that is + * computed and saved by the res function and made accessible + * to PrecSetup. + * + * A preconditioner setup function PrecSetup must have the + * prototype given below. Its parameters are as follows: + * + * tt is the current value of the independent variable t. + * + * yy is the current value of the dependent variable vector, + * namely the predicted value of y(t). + * + * yp is the current value of the derivative vector y', + * namely the predicted value of y'(t). + * + * rr is the current value of the residual vector F(t,y,y'). + * + * c_j is the scalar in the system Jacobian, proportional to 1/hh. + * + * user_data is a pointer to user data, the same as the user_data + * parameter passed to IDASetUserData. + * + * tmp1, tmp2, tmp3 are pointers to vectors of type N_Vector + * which can be used by an IDASpilsPrecSetupFn routine + * as temporary storage or work space. + * + * NOTE: If the user's preconditioner needs other quantities, + * they are accessible as follows: hcur (the current stepsize) + * and ewt (the error weight vector) are accessible through + * IDAGetCurrentStep and IDAGetErrWeights, respectively (see + * ida.h). The unit roundoff is available as + * UNIT_ROUNDOFF defined in sundials_types.h + * + * The IDASpilsPrecSetupFn should return + * 0 if successful, + * a positive int if a recoverable error occurred, or + * a negative int if a nonrecoverable error occurred. + * In the case of a recoverable error return, the integrator will + * attempt to recover by reducing the stepsize (which changes cj). + * ----------------------------------------------------------------- + */ + +typedef int (*IDASpilsPrecSetupFn)(realtype tt, + N_Vector yy, N_Vector yp, N_Vector rr, + realtype c_j, void *user_data, + N_Vector tmp1, N_Vector tmp2, + N_Vector tmp3); + +/* + * ----------------------------------------------------------------- + * Type : IDASpilsPrecSolveFn + * ----------------------------------------------------------------- + * The optional user-supplied function PrecSolve must compute a + * solution to the linear system P z = r, where P is the left + * preconditioner defined by the user. If no preconditioning + * is desired, pass NULL for PrecSolve to IDASp*. + * + * A preconditioner solve function PrecSolve must have the + * prototype given below. Its parameters are as follows: + * + * tt is the current value of the independent variable t. + * + * yy is the current value of the dependent variable vector y. + * + * yp is the current value of the derivative vector y'. + * + * rr is the current value of the residual vector F(t,y,y'). + * + * rvec is the input right-hand side vector r. + * + * zvec is the computed solution vector z. + * + * c_j is the scalar in the system Jacobian, proportional to 1/hh. + * + * delta is an input tolerance for use by PrecSolve if it uses an + * iterative method in its solution. In that case, the + * the residual vector r - P z of the system should be + * made less than delta in weighted L2 norm, i.e., + * sqrt [ Sum (Res[i]*ewt[i])^2 ] < delta . + * Note: the error weight vector ewt can be obtained + * through a call to the routine IDAGetErrWeights. + * + * user_data is a pointer to user data, the same as the user_data + * parameter passed to IDASetUserData. + * + * tmp is an N_Vector which can be used by the PrecSolve + * routine as temporary storage or work space. + * + * The IDASpilsPrecSolveFn should return + * 0 if successful, + * a positive int if a recoverable error occurred, or + * a negative int if a nonrecoverable error occurred. + * Following a recoverable error, the integrator will attempt to + * recover by updating the preconditioner and/or reducing the + * stepsize. + * ----------------------------------------------------------------- + */ + +typedef int (*IDASpilsPrecSolveFn)(realtype tt, + N_Vector yy, N_Vector yp, N_Vector rr, + N_Vector rvec, N_Vector zvec, + realtype c_j, realtype delta, void *user_data, + N_Vector tmp); + +/* + * ----------------------------------------------------------------- + * Type : IDASpilsJacTimesVecFn + * ----------------------------------------------------------------- + * The user-supplied function jtimes is to generate the product + * J*v for given v, where J is the Jacobian matrix + * J = dF/dy + c_j*dF/dy' + * or an approximation to it, and v is a given vector. + * It should return 0 if successful and a nonzero int otherwise. + * + * A function jtimes must have the prototype given below. Its + * parameters are as follows: + * + * tt is the current value of the independent variable. + * + * yy is the current value of the dependent variable vector, + * namely the predicted value of y(t). + * + * yp is the current value of the derivative vector y', + * namely the predicted value of y'(t). + * + * rr is the current value of the residual vector F(t,y,y'). + * + * v is the N_Vector to be multiplied by J. + * + * Jv is the output N_Vector containing J*v. + * + * c_j is the scalar in the system Jacobian, proportional + * to 1/hh. + * + * user_data is a pointer to user data, the same as the + * pointer passed to IDASetUserData. + * + * tmp1, tmp2 are two N_Vectors which can be used by Jtimes for + * work space. + * ----------------------------------------------------------------- + */ + +typedef int (*IDASpilsJacTimesVecFn)(realtype tt, + N_Vector yy, N_Vector yp, N_Vector rr, + N_Vector v, N_Vector Jv, + realtype c_j, void *user_data, + N_Vector tmp1, N_Vector tmp2); + + +/* + * ----------------------------------------------------------------- + * Optional inputs to the IDASPILS linear solver + * ----------------------------------------------------------------- + * + * IDASpilsSetPreconditioner specifies the PrecSetup and PrecSolve + * functions. + * Default is NULL for both arguments. + * IDASpilsSetJacTimesVecFn specifies the jtimes function. + * Default is to use an internal finite difference + * approximation routine. + * IDASpilsSetGSType specifies the type of Gram-Schmidt + * orthogonalization to be used. This must be one of + * the two enumeration constants MODIFIED_GS or + * CLASSICAL_GS defined in iterativ.h. These correspond + * to using modified Gram-Schmidt and classical + * Gram-Schmidt, respectively. + * Default value is MODIFIED_GS. + * Only for IDASPGMR. + * IDASpilsSetMaxRestarts specifies the maximum number of restarts + * to be used in the GMRES algorithm. maxrs must be a + * non-negative integer. Pass 0 to specify no restarts. + * Default is 5. + * Only for IDASPGMR. + * IDASpbcgSetMaxl specifies the maximum Krylov subspace size. + * Default is 5. + * Only for IDASPBCG and IDASPTFQMR. + * IDASpilsSetEpsLin specifies the factor in the linear iteration + * convergence test constant. + * Default is 0.05 + * IDASpilsSetIncrementFactor specifies a factor in the increments + * to yy used in the difference quotient approximations + * to matrix-vector products Jv. + * Default is 1.0 + * + * The return value of IDASpilsSet* is one of: + * IDASPILS_SUCCESS if successful + * IDASPILS_MEM_NULL if the ida memory was NULL + * IDASPILS_LMEM_NULL if the linear solver memory was NULL + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDASpilsSetPreconditioner(void *ida_mem, + IDASpilsPrecSetupFn pset, + IDASpilsPrecSolveFn psolve); +SUNDIALS_EXPORT int IDASpilsSetJacTimesVecFn(void *ida_mem, + IDASpilsJacTimesVecFn jtv); + +SUNDIALS_EXPORT int IDASpilsSetGSType(void *ida_mem, int gstype); +SUNDIALS_EXPORT int IDASpilsSetMaxRestarts(void *ida_mem, int maxrs); +SUNDIALS_EXPORT int IDASpilsSetMaxl(void *ida_mem, int maxl); +SUNDIALS_EXPORT int IDASpilsSetEpsLin(void *ida_mem, realtype eplifac); +SUNDIALS_EXPORT int IDASpilsSetIncrementFactor(void *ida_mem, realtype dqincfac); + +/* + * ----------------------------------------------------------------- + * Optional outputs from the IDASPILS linear solver + *---------------------------------------------------------------- + * + * IDASpilsGetWorkSpace returns the real and integer workspace used + * by IDASPILS. + * IDASpilsGetNumPrecEvals returns the number of preconditioner + * evaluations, i.e. the number of calls made to PrecSetup + * with jok==FALSE. + * IDASpilsGetNumPrecSolves returns the number of calls made to + * PrecSolve. + * IDASpilsGetNumLinIters returns the number of linear iterations. + * IDASpilsGetNumConvFails returns the number of linear + * convergence failures. + * IDASpilsGetNumJtimesEvals returns the number of calls to jtimes + * IDASpilsGetNumResEvals returns the number of calls to the user + * res routine due to finite difference Jacobian times vector + * evaluation. + * IDASpilsGetLastFlag returns the last error flag set by any of + * the IDASPILS interface functions. + * + * The return value of IDASpilsGet* is one of: + * IDASPILS_SUCCESS if successful + * IDASPILS_MEM_NULL if the ida memory was NULL + * IDASPILS_LMEM_NULL if the linear solver memory was NULL + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDASpilsGetWorkSpace(void *ida_mem, long int *lenrwLS, long int *leniwLS); +SUNDIALS_EXPORT int IDASpilsGetNumPrecEvals(void *ida_mem, long int *npevals); +SUNDIALS_EXPORT int IDASpilsGetNumPrecSolves(void *ida_mem, long int *npsolves); +SUNDIALS_EXPORT int IDASpilsGetNumLinIters(void *ida_mem, long int *nliters); +SUNDIALS_EXPORT int IDASpilsGetNumConvFails(void *ida_mem, long int *nlcfails); +SUNDIALS_EXPORT int IDASpilsGetNumJtimesEvals(void *ida_mem, long int *njvevals); +SUNDIALS_EXPORT int IDASpilsGetNumResEvals(void *ida_mem, long int *nrevalsLS); +SUNDIALS_EXPORT int IDASpilsGetLastFlag(void *ida_mem, int *flag); + +/* + * ----------------------------------------------------------------- + * The following function returns the name of the constant + * associated with an IDASPILS return flag + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT char *IDASpilsGetReturnFlagName(int flag); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/ida_sptfqmr.h b/odemex/Parser/CVode/ida_src/include/ida_sptfqmr.h new file mode 100644 index 0000000..a7a32b5 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/ida_sptfqmr.h @@ -0,0 +1,59 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2006/11/29 00:05:07 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the public header file for the IDA scaled preconditioned + * TFQMR linear solver module, IDASPTFQMR. + * ----------------------------------------------------------------- + */ + +#ifndef _IDASPTFQMR_H +#define _IDASPTFQMR_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ----------------------------------------------------------------- + * Function : IDASptfqmr + * ----------------------------------------------------------------- + * A call to the IDASptfqmr function links the main integrator with + * the IDASPTFQMR linear solver module. Its parameters are as + * follows: + * + * IDA_mem is the pointer to memory block returned by IDACreate. + * + * maxl is the maximum Krylov subspace dimension, an + * optional input. Pass 0 to use the default value. + * Otherwise pass a positive integer. + * + * The return values of IDASptfqmr are: + * IDASPILS_SUCCESS if successful + * IDASPILS_MEM_NULL if the ida memory was NULL + * IDASPILS_MEM_FAIL if there was a memory allocation failure + * IDASPILS_ILL_INPUT if there was illegal input. + * The above constants are defined in ida_spils.h + * + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int IDASptfqmr(void *ida_mem, int maxl); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/nvector/nvector_parallel.h b/odemex/Parser/CVode/ida_src/include/nvector/nvector_parallel.h new file mode 100644 index 0000000..f8a006c --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/nvector/nvector_parallel.h @@ -0,0 +1,314 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2006/11/29 00:05:07 $ + * ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, Radu Serban, + * and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the main header file for the MPI-enabled implementation + * of the NVECTOR module. + * + * Part I contains declarations specific to the parallel + * implementation of the supplied NVECTOR module. + * + * Part II defines accessor macros that allow the user to efficiently + * use the type N_Vector without making explicit references to the + * underlying data structure. + * + * Part III contains the prototype for the constructor + * N_VNew_Parallel as well as implementation-specific prototypes + * for various useful vector operations. + * + * Notes: + * + * - The definition of the generic N_Vector structure can be + * found in the header file sundials_nvector.h. + * + * - The definition of the type realtype can be found in the + * header file sundials_types.h, and it may be changed (at the + * configuration stage) according to the user's needs. + * The sundials_types.h file also contains the definition + * for the type booleantype. + * + * - N_Vector arguments to arithmetic vector operations need not + * be distinct. For example, the following call: + * + * N_VLinearSum_Parallel(a,x,b,y,y); + * + * (which stores the result of the operation a*x+b*y in y) + * is legal. + * ----------------------------------------------------------------- + */ + +#ifndef _NVECTOR_PARALLEL_H +#define _NVECTOR_PARALLEL_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +#include + + +/* + * ----------------------------------------------------------------- + * PART I: PARALLEL implementation of N_Vector + * ----------------------------------------------------------------- + */ + +/* define MPI data types */ + +#if defined(SUNDIALS_SINGLE_PRECISION) + +#define PVEC_REAL_MPI_TYPE MPI_FLOAT + +#elif defined(SUNDIALS_DOUBLE_PRECISION) + +#define PVEC_REAL_MPI_TYPE MPI_DOUBLE + +#elif defined(SUNDIALS_EXTENDED_PRECISION) + +#define PVEC_REAL_MPI_TYPE MPI_LONG_DOUBLE + +#endif + +#define PVEC_INTEGER_MPI_TYPE MPI_LONG + +/* parallel implementation of the N_Vector 'content' structure + contains the global and local lengths of the vector, a pointer + to an array of 'realtype components', the MPI communicator, + and a flag indicating ownership of the data */ + +struct _N_VectorContent_Parallel { + long int local_length; /* local vector length */ + long int global_length; /* global vector length */ + booleantype own_data; /* ownership of data */ + realtype *data; /* local data array */ + MPI_Comm comm; /* pointer to MPI communicator */ +}; + +typedef struct _N_VectorContent_Parallel *N_VectorContent_Parallel; + +/* + * ----------------------------------------------------------------- + * PART II: macros NV_CONTENT_P, NV_DATA_P, NV_OWN_DATA_P, + * NV_LOCLENGTH_P, NV_GLOBLENGTH_P,NV_COMM_P, and NV_Ith_P + * ----------------------------------------------------------------- + * In the descriptions below, the following user declarations + * are assumed: + * + * N_Vector v; + * long int v_len, s_len, i; + * + * (1) NV_CONTENT_P + * + * This routines gives access to the contents of the parallel + * vector N_Vector. + * + * The assignment v_cont = NV_CONTENT_P(v) sets v_cont to be + * a pointer to the parallel N_Vector content structure. + * + * (2) NV_DATA_P, NV_OWN_DATA_P, NV_LOCLENGTH_P, NV_GLOBLENGTH_P, + * and NV_COMM_P + * + * These routines give access to the individual parts of + * the content structure of a parallel N_Vector. + * + * The assignment v_data = NV_DATA_P(v) sets v_data to be + * a pointer to the first component of the local data for + * the vector v. The assignment NV_DATA_P(v) = data_v sets + * the component array of v to be data_V by storing the + * pointer data_v. + * + * The assignment v_llen = NV_LOCLENGTH_P(v) sets v_llen to + * be the length of the local part of the vector v. The call + * NV_LOCLENGTH_P(v) = llen_v sets the local length + * of v to be llen_v. + * + * The assignment v_glen = NV_GLOBLENGTH_P(v) sets v_glen to + * be the global length of the vector v. The call + * NV_GLOBLENGTH_P(v) = glen_v sets the global length of v to + * be glen_v. + * + * The assignment v_comm = NV_COMM_P(v) sets v_comm to be the + * MPI communicator of the vector v. The assignment + * NV_COMM_C(v) = comm_v sets the MPI communicator of v to be + * comm_v. + * + * (3) NV_Ith_P + * + * In the following description, the components of the + * local part of an N_Vector are numbered 0..n-1, where n + * is the local length of (the local part of) v. + * + * The assignment r = NV_Ith_P(v,i) sets r to be the value + * of the ith component of the local part of the vector v. + * The assignment NV_Ith_P(v,i) = r sets the value of the + * ith local component of v to be r. + * + * Note: When looping over the components of an N_Vector v, it is + * more efficient to first obtain the component array via + * v_data = NV_DATA_P(v) and then access v_data[i] within the + * loop than it is to use NV_Ith_P(v,i) within the loop. + * ----------------------------------------------------------------- + */ + +#define NV_CONTENT_P(v) ( (N_VectorContent_Parallel)(v->content) ) + +#define NV_LOCLENGTH_P(v) ( NV_CONTENT_P(v)->local_length ) + +#define NV_GLOBLENGTH_P(v) ( NV_CONTENT_P(v)->global_length ) + +#define NV_OWN_DATA_P(v) ( NV_CONTENT_P(v)->own_data ) + +#define NV_DATA_P(v) ( NV_CONTENT_P(v)->data ) + +#define NV_COMM_P(v) ( NV_CONTENT_P(v)->comm ) + +#define NV_Ith_P(v,i) ( NV_DATA_P(v)[i] ) + +/* + * ----------------------------------------------------------------- + * PART III: functions exported by nvector_parallel + * + * CONSTRUCTORS: + * N_VNew_Parallel + * N_VNewEmpty_Parallel + * N_VMake_Parallel + * N_VCloneVectorArray_Parallel + * N_VCloneVectorArrayEmpty_Parallel + * DESTRUCTORS: + * N_VDestroy_Parallel + * N_VDestroyVectorArray_Parallel + * OTHER: + * N_VPrint_Parallel + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * Function : N_VNew_Parallel + * ----------------------------------------------------------------- + * This function creates and allocates memory for a parallel vector. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector N_VNew_Parallel(MPI_Comm comm, + long int local_length, + long int global_length); + +/* + * ----------------------------------------------------------------- + * Function : N_VNewEmpty_Parallel + * ----------------------------------------------------------------- + * This function creates a new parallel N_Vector with an empty + * (NULL) data array. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector N_VNewEmpty_Parallel(MPI_Comm comm, + long int local_length, + long int global_length); + +/* + * ----------------------------------------------------------------- + * Function : N_VMake_Parallel + * ----------------------------------------------------------------- + * This function creates and allocates memory for a parallel vector + * with a user-supplied data array. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector N_VMake_Parallel(MPI_Comm comm, + long int local_length, + long int global_length, + realtype *v_data); + +/* + * ----------------------------------------------------------------- + * Function : N_VCloneVectorArray_Parallel + * ----------------------------------------------------------------- + * This function creates an array of 'count' PARALLEL vectors by + * cloning a given vector w. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector *N_VCloneVectorArray_Parallel(int count, N_Vector w); + +/* + * ----------------------------------------------------------------- + * Function : N_VCloneVectorArrayEmpty_Parallel + * ----------------------------------------------------------------- + * This function creates an array of 'count' PARALLEL vectors each + * with an empty (NULL) data array by cloning w. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector *N_VCloneVectorArrayEmpty_Parallel(int count, N_Vector w); + +/* + * ----------------------------------------------------------------- + * Function : N_VDestroyVectorArray_Parallel + * ----------------------------------------------------------------- + * This function frees an array of N_Vector created with + * N_VCloneVectorArray_Parallel or N_VCloneVectorArrayEmpty_Parallel. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void N_VDestroyVectorArray_Parallel(N_Vector *vs, int count); + +/* + * ----------------------------------------------------------------- + * Function : N_VPrint_Parallel + * ----------------------------------------------------------------- + * This function prints the content of a parallel vector to stdout. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void N_VPrint_Parallel(N_Vector v); + +/* + * ----------------------------------------------------------------- + * parallel implementations of the vector operations + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector N_VCloneEmpty_Parallel(N_Vector w); +SUNDIALS_EXPORT N_Vector N_VClone_Parallel(N_Vector w); +SUNDIALS_EXPORT void N_VDestroy_Parallel(N_Vector v); +SUNDIALS_EXPORT void N_VSpace_Parallel(N_Vector v, long int *lrw, long int *liw); +SUNDIALS_EXPORT realtype *N_VGetArrayPointer_Parallel(N_Vector v); +SUNDIALS_EXPORT void N_VSetArrayPointer_Parallel(realtype *v_data, N_Vector v); +SUNDIALS_EXPORT void N_VLinearSum_Parallel(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VConst_Parallel(realtype c, N_Vector z); +SUNDIALS_EXPORT void N_VProd_Parallel(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VDiv_Parallel(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VScale_Parallel(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAbs_Parallel(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VInv_Parallel(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAddConst_Parallel(N_Vector x, realtype b, N_Vector z); +SUNDIALS_EXPORT realtype N_VDotProd_Parallel(N_Vector x, N_Vector y); +SUNDIALS_EXPORT realtype N_VMaxNorm_Parallel(N_Vector x); +SUNDIALS_EXPORT realtype N_VWrmsNorm_Parallel(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VWrmsNormMask_Parallel(N_Vector x, N_Vector w, N_Vector id); +SUNDIALS_EXPORT realtype N_VMin_Parallel(N_Vector x); +SUNDIALS_EXPORT realtype N_VWL2Norm_Parallel(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VL1Norm_Parallel(N_Vector x); +SUNDIALS_EXPORT void N_VCompare_Parallel(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VInvTest_Parallel(N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VConstrMask_Parallel(N_Vector c, N_Vector x, N_Vector m); +SUNDIALS_EXPORT realtype N_VMinQuotient_Parallel(N_Vector num, N_Vector denom); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/nvector/nvector_serial.h b/odemex/Parser/CVode/ida_src/include/nvector/nvector_serial.h new file mode 100644 index 0000000..4301a68 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/nvector/nvector_serial.h @@ -0,0 +1,265 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2006/11/29 00:05:07 $ + * ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, Radu Serban, + * and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the serial implementation of the + * NVECTOR module. + * + * Part I contains declarations specific to the serial + * implementation of the supplied NVECTOR module. + * + * Part II defines accessor macros that allow the user to + * efficiently use the type N_Vector without making explicit + * references to the underlying data structure. + * + * Part III contains the prototype for the constructor N_VNew_Serial + * as well as implementation-specific prototypes for various useful + * vector operations. + * + * Notes: + * + * - The definition of the generic N_Vector structure can be found + * in the header file sundials_nvector.h. + * + * - The definition of the type 'realtype' can be found in the + * header file sundials_types.h, and it may be changed (at the + * configuration stage) according to the user's needs. + * The sundials_types.h file also contains the definition + * for the type 'booleantype'. + * + * - N_Vector arguments to arithmetic vector operations need not + * be distinct. For example, the following call: + * + * N_VLinearSum_Serial(a,x,b,y,y); + * + * (which stores the result of the operation a*x+b*y in y) + * is legal. + * ----------------------------------------------------------------- + */ + +#ifndef _NVECTOR_SERIAL_H +#define _NVECTOR_SERIAL_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ----------------------------------------------------------------- + * PART I: SERIAL implementation of N_Vector + * ----------------------------------------------------------------- + */ + +/* serial implementation of the N_Vector 'content' structure + contains the length of the vector, a pointer to an array + of 'realtype' components, and a flag indicating ownership of + the data */ + +struct _N_VectorContent_Serial { + long int length; + booleantype own_data; + realtype *data; +}; + +typedef struct _N_VectorContent_Serial *N_VectorContent_Serial; + +/* + * ----------------------------------------------------------------- + * PART II: macros NV_CONTENT_S, NV_DATA_S, NV_OWN_DATA_S, + * NV_LENGTH_S, and NV_Ith_S + * ----------------------------------------------------------------- + * In the descriptions below, the following user declarations + * are assumed: + * + * N_Vector v; + * long int i; + * + * (1) NV_CONTENT_S + * + * This routines gives access to the contents of the serial + * vector N_Vector. + * + * The assignment v_cont = NV_CONTENT_S(v) sets v_cont to be + * a pointer to the serial N_Vector content structure. + * + * (2) NV_DATA_S NV_OWN_DATA_S and NV_LENGTH_S + * + * These routines give access to the individual parts of + * the content structure of a serial N_Vector. + * + * The assignment v_data = NV_DATA_S(v) sets v_data to be + * a pointer to the first component of v. The assignment + * NV_DATA_S(v) = data_V sets the component array of v to + * be data_v by storing the pointer data_v. + * + * The assignment v_len = NV_LENGTH_S(v) sets v_len to be + * the length of v. The call NV_LENGTH_S(v) = len_v sets + * the length of v to be len_v. + * + * (3) NV_Ith_S + * + * In the following description, the components of an + * N_Vector are numbered 0..n-1, where n is the length of v. + * + * The assignment r = NV_Ith_S(v,i) sets r to be the value of + * the ith component of v. The assignment NV_Ith_S(v,i) = r + * sets the value of the ith component of v to be r. + * + * Note: When looping over the components of an N_Vector v, it is + * more efficient to first obtain the component array via + * v_data = NV_DATA_S(v) and then access v_data[i] within the + * loop than it is to use NV_Ith_S(v,i) within the loop. + * ----------------------------------------------------------------- + */ + +#define NV_CONTENT_S(v) ( (N_VectorContent_Serial)(v->content) ) + +#define NV_LENGTH_S(v) ( NV_CONTENT_S(v)->length ) + +#define NV_OWN_DATA_S(v) ( NV_CONTENT_S(v)->own_data ) + +#define NV_DATA_S(v) ( NV_CONTENT_S(v)->data ) + +#define NV_Ith_S(v,i) ( NV_DATA_S(v)[i] ) + +/* + * ----------------------------------------------------------------- + * PART III: functions exported by nvector_serial + * + * CONSTRUCTORS: + * N_VNew_Serial + * N_VNewEmpty_Serial + * N_VMake_Serial + * N_VCloneVectorArray_Serial + * N_VCloneVectorArrayEmpty_Serial + * DESTRUCTORS: + * N_VDestroy_Serial + * N_VDestroyVectorArray_Serial + * OTHER: + * N_VPrint_Serial + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * Function : N_VNew_Serial + * ----------------------------------------------------------------- + * This function creates and allocates memory for a serial vector. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector N_VNew_Serial(long int vec_length); + +/* + * ----------------------------------------------------------------- + * Function : N_VNewEmpty_Serial + * ----------------------------------------------------------------- + * This function creates a new serial N_Vector with an empty (NULL) + * data array. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector N_VNewEmpty_Serial(long int vec_length); + +/* + * ----------------------------------------------------------------- + * Function : N_VMake_Serial + * ----------------------------------------------------------------- + * This function creates and allocates memory for a serial vector + * with a user-supplied data array. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector N_VMake_Serial(long int vec_length, realtype *v_data); + +/* + * ----------------------------------------------------------------- + * Function : N_VCloneVectorArray_Serial + * ----------------------------------------------------------------- + * This function creates an array of 'count' SERIAL vectors by + * cloning a given vector w. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector *N_VCloneVectorArray_Serial(int count, N_Vector w); + +/* + * ----------------------------------------------------------------- + * Function : N_VCloneVectorArrayEmpty_Serial + * ----------------------------------------------------------------- + * This function creates an array of 'count' SERIAL vectors each + * with an empty (NULL) data array by cloning w. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector *N_VCloneVectorArrayEmpty_Serial(int count, N_Vector w); + +/* + * ----------------------------------------------------------------- + * Function : N_VDestroyVectorArray_Serial + * ----------------------------------------------------------------- + * This function frees an array of SERIAL vectors created with + * N_VCloneVectorArray_Serial or N_VCloneVectorArrayEmpty_Serial. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void N_VDestroyVectorArray_Serial(N_Vector *vs, int count); + +/* + * ----------------------------------------------------------------- + * Function : N_VPrint_Serial + * ----------------------------------------------------------------- + * This function prints the content of a serial vector to stdout. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void N_VPrint_Serial(N_Vector v); + +/* + * ----------------------------------------------------------------- + * serial implementations of various useful vector operations + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector N_VCloneEmpty_Serial(N_Vector w); +SUNDIALS_EXPORT N_Vector N_VClone_Serial(N_Vector w); +SUNDIALS_EXPORT void N_VDestroy_Serial(N_Vector v); +SUNDIALS_EXPORT void N_VSpace_Serial(N_Vector v, long int *lrw, long int *liw); +SUNDIALS_EXPORT realtype *N_VGetArrayPointer_Serial(N_Vector v); +SUNDIALS_EXPORT void N_VSetArrayPointer_Serial(realtype *v_data, N_Vector v); +SUNDIALS_EXPORT void N_VLinearSum_Serial(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VConst_Serial(realtype c, N_Vector z); +SUNDIALS_EXPORT void N_VProd_Serial(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VDiv_Serial(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VScale_Serial(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAbs_Serial(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VInv_Serial(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAddConst_Serial(N_Vector x, realtype b, N_Vector z); +SUNDIALS_EXPORT realtype N_VDotProd_Serial(N_Vector x, N_Vector y); +SUNDIALS_EXPORT realtype N_VMaxNorm_Serial(N_Vector x); +SUNDIALS_EXPORT realtype N_VWrmsNorm_Serial(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VWrmsNormMask_Serial(N_Vector x, N_Vector w, N_Vector id); +SUNDIALS_EXPORT realtype N_VMin_Serial(N_Vector x); +SUNDIALS_EXPORT realtype N_VWL2Norm_Serial(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VL1Norm_Serial(N_Vector x); +SUNDIALS_EXPORT void N_VCompare_Serial(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VInvTest_Serial(N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VConstrMask_Serial(N_Vector c, N_Vector x, N_Vector m); +SUNDIALS_EXPORT realtype N_VMinQuotient_Serial(N_Vector num, N_Vector denom); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/sundials/sundials_band.h b/odemex/Parser/CVode/ida_src/include/sundials/sundials_band.h new file mode 100644 index 0000000..95ee54c --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/sundials/sundials_band.h @@ -0,0 +1,153 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.5 $ + * $Date: 2009/02/17 02:39:26 $ + * ----------------------------------------------------------------- + * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for a generic BAND linear solver + * package, based on the DlsMat type defined in sundials_direct.h. + * + * There are two sets of band solver routines listed in + * this file: one set uses type DlsMat defined below and the + * other set uses the type realtype ** for band matrix arguments. + * Routines that work with the type DlsMat begin with "Band". + * Routines that work with realtype ** begin with "band" + * ----------------------------------------------------------------- + */ + +#ifndef _SUNDIALS_BAND_H +#define _SUNDIALS_BAND_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ----------------------------------------------------------------- + * Function : BandGBTRF + * ----------------------------------------------------------------- + * Usage : ier = BandGBTRF(A, p); + * if (ier != 0) ... A is singular + * ----------------------------------------------------------------- + * BandGBTRF performs the LU factorization of the N by N band + * matrix A. This is done using standard Gaussian elimination + * with partial pivoting. + * + * A successful LU factorization leaves the "matrix" A and the + * pivot array p with the following information: + * + * (1) p[k] contains the row number of the pivot element chosen + * at the beginning of elimination step k, k=0, 1, ..., N-1. + * + * (2) If the unique LU factorization of A is given by PA = LU, + * where P is a permutation matrix, L is a lower triangular + * matrix with all 1's on the diagonal, and U is an upper + * triangular matrix, then the upper triangular part of A + * (including its diagonal) contains U and the strictly lower + * triangular part of A contains the multipliers, I-L. + * + * BandGBTRF returns 0 if successful. Otherwise it encountered + * a zero diagonal element during the factorization. In this case + * it returns the column index (numbered from one) at which + * it encountered the zero. + * + * Important Note: A must be allocated to accommodate the increase + * in upper bandwidth that occurs during factorization. If + * mathematically, A is a band matrix with upper bandwidth mu and + * lower bandwidth ml, then the upper triangular factor U can + * have upper bandwidth as big as smu = MIN(n-1,mu+ml). The lower + * triangular factor L has lower bandwidth ml. Allocate A with + * call A = BandAllocMat(N,mu,ml,smu), where mu, ml, and smu are + * as defined above. The user does not have to zero the "extra" + * storage allocated for the purpose of factorization. This will + * handled by the BandGBTRF routine. + * + * BandGBTRF is only a wrapper around bandGBTRF. All work is done + * in bandGBTRF works directly on the data in the DlsMat A (i.e., + * the field cols). + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int BandGBTRF(DlsMat A, int *p); +SUNDIALS_EXPORT int bandGBTRF(realtype **a, int n, int mu, int ml, int smu, int *p); + +/* + * ----------------------------------------------------------------- + * Function : BandGBTRS + * ----------------------------------------------------------------- + * Usage : BandGBTRS(A, p, b); + * ----------------------------------------------------------------- + * BandGBTRS solves the N-dimensional system A x = b using + * the LU factorization in A and the pivot information in p + * computed in BandGBTRF. The solution x is returned in b. This + * routine cannot fail if the corresponding call to BandGBTRF + * did not fail. + * + * BandGBTRS is only a wrapper around bandGBTRS which does all the + * work directly on the data in the DlsMat A (i.e., the field cols). + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void BandGBTRS(DlsMat A, int *p, realtype *b); +SUNDIALS_EXPORT void bandGBTRS(realtype **a, int n, int smu, int ml, int *p, realtype *b); + +/* + * ----------------------------------------------------------------- + * Function : BandCopy + * ----------------------------------------------------------------- + * Usage : BandCopy(A, B, copymu, copyml); + * ----------------------------------------------------------------- + * BandCopy copies the submatrix with upper and lower bandwidths + * copymu, copyml of the N by N band matrix A into the N by N + * band matrix B. + * + * BandCopy is a wrapper around bandCopy which accesses the data + * in the DlsMat A and B (i.e. the fields cols) + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void BandCopy(DlsMat A, DlsMat B, int copymu, int copyml); +SUNDIALS_EXPORT void bandCopy(realtype **a, realtype **b, int n, int a_smu, int b_smu, + int copymu, int copyml); + +/* + * ----------------------------------------------------------------- + * Function: BandScale + * ----------------------------------------------------------------- + * Usage : BandScale(c, A); + * ----------------------------------------------------------------- + * A(i,j) <- c*A(i,j), j-(A->mu) <= i <= j+(A->ml). + * + * BandScale is a wrapper around bandScale which performs the actual + * scaling by accessing the data in the DlsMat A (i.e. the field + * cols). + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void BandScale(realtype c, DlsMat A); +SUNDIALS_EXPORT void bandScale(realtype c, realtype **a, int n, int mu, int ml, int smu); + +/* + * ----------------------------------------------------------------- + * Function: bandAddIdentity + * ----------------------------------------------------------------- + * bandAddIdentity adds the identity matrix to the n-by-n matrix + * stored in the realtype** arrays. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void bandAddIdentity(realtype **a, int n, int smu); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/sundials/sundials_config.h b/odemex/Parser/CVode/ida_src/include/sundials/sundials_config.h new file mode 100644 index 0000000..3ba4096 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/sundials/sundials_config.h @@ -0,0 +1,80 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.4 $ + * $Date: 2007/12/19 20:34:00 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + *------------------------------------------------------------------ + * SUNDIALS configuration header file + *------------------------------------------------------------------ + */ + +#include "winDefine.h" + +/* Define SUNDIALS version number */ +#define SUNDIALS_PACKAGE_VERSION "2.4.0" + +/* FCMIX: Define Fortran name-mangling macro for C identifiers. + * Depending on the inferred scheme, one of the following six + * macros will be defined: + * #define SUNDIALS_F77_FUNC(name,NAME) name + * #define SUNDIALS_F77_FUNC(name,NAME) name ## _ + * #define SUNDIALS_F77_FUNC(name,NAME) name ## __ + * #define SUNDIALS_F77_FUNC(name,NAME) NAME + * #define SUNDIALS_F77_FUNC(name,NAME) NAME ## _ + * #define SUNDIALS_F77_FUNC(name,NAME) NAME ## __ + */ + + +/* FCMIX: Define Fortran name-mangling macro for C identifiers + * which contain underscores. + */ + + +/* Define precision of SUNDIALS data type 'realtype' + * Depending on the precision level, one of the following + * three macros will be defined: + * #define SUNDIALS_SINGLE_PRECISION 1 + * #define SUNDIALS_DOUBLE_PRECISION 1 + * #define SUNDIALS_EXTENDED_PRECISION 1 + */ +#define SUNDIALS_DOUBLE_PRECISION 1 + +/* Use generic math functions + * If it was decided that generic math functions can be used, then + * #define SUNDIALS_USE_GENERIC_MATH 1 + * otherwise + * #define SUNDIALS_USE_GENERIC_MATH 0 + */ + + +/* Blas/Lapack available + * If working libraries for Blas/lapack support were found, then + * #define SUNDIALS_BLAS_LAPACK 1 + * otherwise + * #define SUNDIALS_BLAS_LAPACK 0 + */ +#define SUNDIALS_BLAS_LAPACK 1 + +/* FNVECTOR: Allow user to specify different MPI communicator + * If it was found that the MPI implementation supports MPI_Comm_f2c, then + * #define SUNDIALS_MPI_COMM_F2C 1 + * otherwise + * #define SUNDIALS_MPI_COMM_F2C 0 + */ + + +/* Mark SUNDIALS API functions for export/import + * When building shared SUNDIALS libraries under Windows, use + * #define SUNDIALS_EXPORT __declspec(dllexport) + * When linking to shared SUNDIALS libraries under Windows, use + * #define SUNDIALS_EXPORT __declspec(dllimport) + * In all other cases (other platforms or static libraries under + * Windows), the SUNDIALS_EXPORT macro is empty + */ +#define SUNDIALS_EXPORT diff --git a/odemex/Parser/CVode/ida_src/include/sundials/sundials_config.in b/odemex/Parser/CVode/ida_src/include/sundials/sundials_config.in new file mode 100644 index 0000000..f43aeae --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/sundials/sundials_config.in @@ -0,0 +1,78 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.4 $ + * $Date: 2007/12/19 20:34:00 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + *------------------------------------------------------------------ + * SUNDIALS configuration header file + *------------------------------------------------------------------ + */ + +/* Define SUNDIALS version number */ +#define SUNDIALS_PACKAGE_VERSION "@PACKAGE_VERSION@" + +/* FCMIX: Define Fortran name-mangling macro for C identifiers. + * Depending on the inferred scheme, one of the following six + * macros will be defined: + * #define SUNDIALS_F77_FUNC(name,NAME) name + * #define SUNDIALS_F77_FUNC(name,NAME) name ## _ + * #define SUNDIALS_F77_FUNC(name,NAME) name ## __ + * #define SUNDIALS_F77_FUNC(name,NAME) NAME + * #define SUNDIALS_F77_FUNC(name,NAME) NAME ## _ + * #define SUNDIALS_F77_FUNC(name,NAME) NAME ## __ + */ +@F77_MANGLE_MACRO1@ + +/* FCMIX: Define Fortran name-mangling macro for C identifiers + * which contain underscores. + */ +@F77_MANGLE_MACRO2@ + +/* Define precision of SUNDIALS data type 'realtype' + * Depending on the precision level, one of the following + * three macros will be defined: + * #define SUNDIALS_SINGLE_PRECISION 1 + * #define SUNDIALS_DOUBLE_PRECISION 1 + * #define SUNDIALS_EXTENDED_PRECISION 1 + */ +@PRECISION_LEVEL@ + +/* Use generic math functions + * If it was decided that generic math functions can be used, then + * #define SUNDIALS_USE_GENERIC_MATH 1 + * otherwise + * #define SUNDIALS_USE_GENERIC_MATH 0 + */ +@GENERIC_MATH_LIB@ + +/* Blas/Lapack available + * If working libraries for Blas/lapack support were found, then + * #define SUNDIALS_BLAS_LAPACK 1 + * otherwise + * #define SUNDIALS_BLAS_LAPACK 0 + */ +@BLAS_LAPACK_MACRO@ + +/* FNVECTOR: Allow user to specify different MPI communicator + * If it was found that the MPI implementation supports MPI_Comm_f2c, then + * #define SUNDIALS_MPI_COMM_F2C 1 + * otherwise + * #define SUNDIALS_MPI_COMM_F2C 0 + */ +@F77_MPI_COMM_F2C@ + +/* Mark SUNDIALS API functions for export/import + * When building shared SUNDIALS libraries under Windows, use + * #define SUNDIALS_EXPORT __declspec(dllexport) + * When linking to shared SUNDIALS libraries under Windows, use + * #define SUNDIALS_EXPORT __declspec(dllimport) + * In all other cases (other platforms or static libraries under + * Windows), the SUNDIALS_EXPORT macro is empty + */ +@SUNDIALS_EXPORT@ diff --git a/odemex/Parser/CVode/ida_src/include/sundials/sundials_dense.h b/odemex/Parser/CVode/ida_src/include/sundials/sundials_dense.h new file mode 100644 index 0000000..a3b1431 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/sundials/sundials_dense.h @@ -0,0 +1,187 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.7 $ + * $Date: 2009/02/17 02:39:26 $ + * ----------------------------------------------------------------- + * Programmer: Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2006, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for a generic package of DENSE matrix + * operations, based on the DlsMat type defined in sundials_direct.h. + * + * There are two sets of dense solver routines listed in + * this file: one set uses type DlsMat defined below and the + * other set uses the type realtype ** for dense matrix arguments. + * Routines that work with the type DlsMat begin with "Dense". + * Routines that work with realtype** begin with "dense". + * ----------------------------------------------------------------- + */ + +#ifndef _SUNDIALS_DENSE_H +#define _SUNDIALS_DENSE_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ----------------------------------------------------------------- + * Functions: DenseGETRF and DenseGETRS + * ----------------------------------------------------------------- + * DenseGETRF performs the LU factorization of the M by N dense + * matrix A. This is done using standard Gaussian elimination + * with partial (row) pivoting. Note that this applies only + * to matrices with M >= N and full column rank. + * + * A successful LU factorization leaves the matrix A and the + * pivot array p with the following information: + * + * (1) p[k] contains the row number of the pivot element chosen + * at the beginning of elimination step k, k=0, 1, ..., N-1. + * + * (2) If the unique LU factorization of A is given by PA = LU, + * where P is a permutation matrix, L is a lower trapezoidal + * matrix with all 1's on the diagonal, and U is an upper + * triangular matrix, then the upper triangular part of A + * (including its diagonal) contains U and the strictly lower + * trapezoidal part of A contains the multipliers, I-L. + * + * For square matrices (M=N), L is unit lower triangular. + * + * DenseGETRF returns 0 if successful. Otherwise it encountered + * a zero diagonal element during the factorization. In this case + * it returns the column index (numbered from one) at which + * it encountered the zero. + * + * DenseGETRS solves the N-dimensional system A x = b using + * the LU factorization in A and the pivot information in p + * computed in DenseGETRF. The solution x is returned in b. This + * routine cannot fail if the corresponding call to DenseGETRF + * did not fail. + * DenseGETRS does NOT check for a square matrix! + * + * ----------------------------------------------------------------- + * DenseGETRF and DenseGETRS are simply wrappers around denseGETRF + * and denseGETRS, respectively, which perform all the work by + * directly accessing the data in the DlsMat A (i.e. the field cols) + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int DenseGETRF(DlsMat A, int *p); +SUNDIALS_EXPORT void DenseGETRS(DlsMat A, int *p, realtype *b); + +SUNDIALS_EXPORT int denseGETRF(realtype **a, int m, int n, int *p); +SUNDIALS_EXPORT void denseGETRS(realtype **a, int n, int *p, realtype *b); + +/* + * ----------------------------------------------------------------- + * Functions : DensePOTRF and DensePOTRS + * ----------------------------------------------------------------- + * DensePOTRF computes the Cholesky factorization of a real symmetric + * positive definite matrix A. + * ----------------------------------------------------------------- + * DensePOTRS solves a system of linear equations A*X = B with a + * symmetric positive definite matrix A using the Cholesky factorization + * A = L*L**T computed by DensePOTRF. + * + * ----------------------------------------------------------------- + * DensePOTRF and DensePOTRS are simply wrappers around densePOTRF + * and densePOTRS, respectively, which perform all the work by + * directly accessing the data in the DlsMat A (i.e. the field cols) + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int DensePOTRF(DlsMat A); +SUNDIALS_EXPORT void DensePOTRS(DlsMat A, realtype *b); + +SUNDIALS_EXPORT int densePOTRF(realtype **a, int m); +SUNDIALS_EXPORT void densePOTRS(realtype **a, int m, realtype *b); + +/* + * ----------------------------------------------------------------- + * Functions : DenseGEQRF and DenseORMQR + * ----------------------------------------------------------------- + * DenseGEQRF computes a QR factorization of a real M-by-N matrix A: + * A = Q * R (with M>= N). + * + * DenseGEQRF requires a temporary work vector wrk of length M. + * ----------------------------------------------------------------- + * DenseORMQR computes the product w = Q * v where Q is a real + * orthogonal matrix defined as the product of k elementary reflectors + * + * Q = H(1) H(2) . . . H(k) + * + * as returned by DenseGEQRF. Q is an M-by-N matrix, v is a vector + * of length N and w is a vector of length M (with M>=N). + * + * DenseORMQR requires a temporary work vector wrk of length M. + * + * ----------------------------------------------------------------- + * DenseGEQRF and DenseORMQR are simply wrappers around denseGEQRF + * and denseORMQR, respectively, which perform all the work by + * directly accessing the data in the DlsMat A (i.e. the field cols) + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int DenseGEQRF(DlsMat A, realtype *beta, realtype *wrk); +SUNDIALS_EXPORT int DenseORMQR(DlsMat A, realtype *beta, realtype *vn, realtype *vm, + realtype *wrk); + +SUNDIALS_EXPORT int denseGEQRF(realtype **a, int m, int n, realtype *beta, realtype *v); +SUNDIALS_EXPORT int denseORMQR(realtype **a, int m, int n, realtype *beta, + realtype *v, realtype *w, realtype *wrk); + +/* + * ----------------------------------------------------------------- + * Function : DenseCopy + * ----------------------------------------------------------------- + * DenseCopy copies the contents of the M-by-N matrix A into the + * M-by-N matrix B. + * + * DenseCopy is a wrapper around denseCopy which accesses the data + * in the DlsMat A and B (i.e. the fields cols) + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void DenseCopy(DlsMat A, DlsMat B); +SUNDIALS_EXPORT void denseCopy(realtype **a, realtype **b, int m, int n); + +/* + * ----------------------------------------------------------------- + * Function: DenseScale + * ----------------------------------------------------------------- + * DenseScale scales the elements of the M-by-N matrix A by the + * constant c and stores the result back in A. + * + * DenseScale is a wrapper around denseScale which performs the actual + * scaling by accessing the data in the DlsMat A (i.e. the field + * cols). + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void DenseScale(realtype c, DlsMat A); +SUNDIALS_EXPORT void denseScale(realtype c, realtype **a, int m, int n); + + +/* + * ----------------------------------------------------------------- + * Function: denseAddIdentity + * ----------------------------------------------------------------- + * denseAddIdentity adds the identity matrix to the n-by-n matrix + * stored in the realtype** arrays. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void denseAddIdentity(realtype **a, int n); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/sundials/sundials_direct.h b/odemex/Parser/CVode/ida_src/include/sundials/sundials_direct.h new file mode 100644 index 0000000..f3d823b --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/sundials/sundials_direct.h @@ -0,0 +1,323 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.3 $ + * $Date: 2009/02/17 02:39:26 $ + * ----------------------------------------------------------------- + * Programmer: Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2006, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This header file contains definitions and declarations for use by + * generic direct linear solvers for Ax = b. It defines types for + * dense and banded matrices and corresponding accessor macros. + * ----------------------------------------------------------------- + */ + +#ifndef _SUNDIALS_DIRECT_H +#define _SUNDIALS_DIRECT_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ================================================================= + * C O N S T A N T S + * ================================================================= + */ + +/* + * SUNDIALS_DENSE: dense matrix + * SUNDIALS_BAND: banded matrix + */ + +#define SUNDIALS_DENSE 1 +#define SUNDIALS_BAND 2 + +/* + * ================================================================== + * Type definitions + * ================================================================== + */ + +/* + * ----------------------------------------------------------------- + * Type : DlsMat + * ----------------------------------------------------------------- + * The type DlsMat is defined to be a pointer to a structure + * with various sizes, a data field, and an array of pointers to + * the columns which defines a dense or band matrix for use in + * direct linear solvers. The M and N fields indicates the number + * of rows and columns, respectively. The data field is a one + * dimensional array used for component storage. The cols field + * stores the pointers in data for the beginning of each column. + * ----------------------------------------------------------------- + * For DENSE matrices, the relevant fields in DlsMat are: + * type = SUNDIALS_DENSE + * M - number of rows + * N - number of columns + * ldim - leading dimension (ldim >= M) + * data - pointer to a contiguous block of realtype variables + * ldata - length of the data array =ldim*N + * cols - array of pointers. cols[j] points to the first element + * of the j-th column of the matrix in the array data. + * + * The elements of a dense matrix are stored columnwise (i.e columns + * are stored one on top of the other in memory). + * If A is of type DlsMat, then the (i,j)th element of A (with + * 0 <= i < M and 0 <= j < N) is given by (A->data)[j*n+i]. + * + * The DENSE_COL and DENSE_ELEM macros below allow a user to access + * efficiently individual matrix elements without writing out explicit + * data structure references and without knowing too much about the + * underlying element storage. The only storage assumption needed is + * that elements are stored columnwise and that a pointer to the + * jth column of elements can be obtained via the DENSE_COL macro. + * ----------------------------------------------------------------- + * For BAND matrices, the relevant fields in DlsMat are: + * type = SUNDIALS_BAND + * M - number of rows + * N - number of columns + * mu - upper bandwidth, 0 <= mu <= min(M,N) + * ml - lower bandwidth, 0 <= ml <= min(M,N) + * s_mu - storage upper bandwidth, mu <= s_mu <= N-1. + * The dgbtrf routine writes the LU factors into the storage + * for A. The upper triangular factor U, however, may have + * an upper bandwidth as big as MIN(N-1,mu+ml) because of + * partial pivoting. The s_mu field holds the upper + * bandwidth allocated for A. + * ldim - leading dimension (ldim >= s_mu) + * data - pointer to a contiguous block of realtype variables + * ldata - length of the data array =ldim*(s_mu+ml+1) + * cols - array of pointers. cols[j] points to the first element + * of the j-th column of the matrix in the array data. + * + * The BAND_COL, BAND_COL_ELEM, and BAND_ELEM macros below allow a + * user to access individual matrix elements without writing out + * explicit data structure references and without knowing too much + * about the underlying element storage. The only storage assumption + * needed is that elements are stored columnwise and that a pointer + * into the jth column of elements can be obtained via the BAND_COL + * macro. The BAND_COL_ELEM macro selects an element from a column + * which has already been isolated via BAND_COL. The macro + * BAND_COL_ELEM allows the user to avoid the translation + * from the matrix location (i,j) to the index in the array returned + * by BAND_COL at which the (i,j)th element is stored. + * ----------------------------------------------------------------- + */ + +typedef struct _DlsMat { + int type; + int M; + int N; + int ldim; + int mu; + int ml; + int s_mu; + realtype *data; + int ldata; + realtype **cols; +} *DlsMat; + +/* + * ================================================================== + * Data accessor macros + * ================================================================== + */ + +/* + * ----------------------------------------------------------------- + * DENSE_COL and DENSE_ELEM + * ----------------------------------------------------------------- + * + * DENSE_COL(A,j) references the jth column of the M-by-N dense + * matrix A, 0 <= j < N. The type of the expression DENSE_COL(A,j) + * is (realtype *). After the assignment in the usage above, col_j + * may be treated as an array indexed from 0 to M-1. The (i,j)-th + * element of A is thus referenced by col_j[i]. + * + * DENSE_ELEM(A,i,j) references the (i,j)th element of the dense + * M-by-N matrix A, 0 <= i < M ; 0 <= j < N. + * + * ----------------------------------------------------------------- + */ + +#define DENSE_COL(A,j) ((A->cols)[j]) +#define DENSE_ELEM(A,i,j) ((A->cols)[j][i]) + +/* + * ----------------------------------------------------------------- + * BAND_COL, BAND_COL_ELEM, and BAND_ELEM + * ----------------------------------------------------------------- + * + * BAND_COL(A,j) references the diagonal element of the jth column + * of the N by N band matrix A, 0 <= j <= N-1. The type of the + * expression BAND_COL(A,j) is realtype *. The pointer returned by + * the call BAND_COL(A,j) can be treated as an array which is + * indexed from -(A->mu) to (A->ml). + * + * BAND_COL_ELEM references the (i,j)th entry of the band matrix A + * when used in conjunction with BAND_COL. The index (i,j) should + * satisfy j-(A->mu) <= i <= j+(A->ml). + * + * BAND_ELEM(A,i,j) references the (i,j)th element of the M-by-N + * band matrix A, where 0 <= i,j <= N-1. The location (i,j) should + * further satisfy j-(A->mu) <= i <= j+(A->ml). + * + * ----------------------------------------------------------------- + */ + +#define BAND_COL(A,j) (((A->cols)[j])+(A->s_mu)) +#define BAND_COL_ELEM(col_j,i,j) (col_j[(i)-(j)]) +#define BAND_ELEM(A,i,j) ((A->cols)[j][(i)-(j)+(A->s_mu)]) + +/* + * ================================================================== + * Exported function prototypes (functions working on dlsMat) + * ================================================================== + */ + +/* + * ----------------------------------------------------------------- + * Function: NewDenseMat + * ----------------------------------------------------------------- + * NewDenseMat allocates memory for an M-by-N dense matrix and + * returns the storage allocated (type DlsMat). NewDenseMat + * returns NULL if the request for matrix storage cannot be + * satisfied. See the above documentation for the type DlsMat + * for matrix storage details. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT DlsMat NewDenseMat(int M, int N); + +/* + * ----------------------------------------------------------------- + * Function: NewBandMat + * ----------------------------------------------------------------- + * NewBandMat allocates memory for an M-by-N band matrix + * with upper bandwidth mu, lower bandwidth ml, and storage upper + * bandwidth smu. Pass smu as follows depending on whether A will + * be LU factored: + * + * (1) Pass smu = mu if A will not be factored. + * + * (2) Pass smu = MIN(N-1,mu+ml) if A will be factored. + * + * NewBandMat returns the storage allocated (type DlsMat) or + * NULL if the request for matrix storage cannot be satisfied. + * See the documentation for the type DlsMat for matrix storage + * details. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT DlsMat NewBandMat(int N, int mu, int ml, int smu); + +/* + * ----------------------------------------------------------------- + * Functions: DestroyMat + * ----------------------------------------------------------------- + * DestroyMat frees the memory allocated by NewDenseMat or NewBandMat + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void DestroyMat(DlsMat A); + +/* + * ----------------------------------------------------------------- + * Function: NewIntArray + * ----------------------------------------------------------------- + * NewIntArray allocates memory an array of N integers and returns + * the pointer to the memory it allocates. If the request for + * memory storage cannot be satisfied, it returns NULL. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int *NewIntArray(int N); + +/* + * ----------------------------------------------------------------- + * Function: NewRealArray + * ----------------------------------------------------------------- + * NewRealArray allocates memory an array of N realtype and returns + * the pointer to the memory it allocates. If the request for + * memory storage cannot be satisfied, it returns NULL. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT realtype *NewRealArray(int N); + +/* + * ----------------------------------------------------------------- + * Function: DestroyArray + * ----------------------------------------------------------------- + * DestroyArray frees memory allocated by NewIntArray or by + * NewRealArray. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void DestroyArray(void *p); + +/* + * ----------------------------------------------------------------- + * Function : AddIdentity + * ----------------------------------------------------------------- + * AddIdentity adds 1.0 to the main diagonal (A_ii, i=1,2,...,N-1) of + * the M-by-N matrix A (M>= N) and stores the result back in A. + * AddIdentity is typically used with square matrices. + * AddIdentity does not check for M >= N and therefore a segmentation + * fault will occur if M < N! + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void AddIdentity(DlsMat A); + +/* + * ----------------------------------------------------------------- + * Function : SetToZero + * ----------------------------------------------------------------- + * SetToZero sets all the elements of the M-by-N matrix A to 0.0. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void SetToZero(DlsMat A); + +/* + * ----------------------------------------------------------------- + * Functions: PrintMat + * ----------------------------------------------------------------- + * This function prints the M-by-N (dense or band) matrix A to + * standard output as it would normally appear on paper. + * It is intended as debugging tools with small values of M and N. + * The elements are printed using the %g/%lg/%Lg option. + * A blank line is printed before and after the matrix. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void PrintMat(DlsMat A); + + +/* + * ================================================================== + * Exported function prototypes (functions working on realtype**) + * ================================================================== + */ + +SUNDIALS_EXPORT realtype **newDenseMat(int m, int n); +SUNDIALS_EXPORT realtype **newBandMat(int n, int smu, int ml); +SUNDIALS_EXPORT void destroyMat(realtype **a); +SUNDIALS_EXPORT int *newIntArray(int n); +SUNDIALS_EXPORT realtype *newRealArray(int m); +SUNDIALS_EXPORT void destroyArray(void *v); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/sundials/sundials_fnvector.h b/odemex/Parser/CVode/ida_src/include/sundials/sundials_fnvector.h new file mode 100644 index 0000000..bbc9a95 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/sundials/sundials_fnvector.h @@ -0,0 +1,41 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.1 $ + * $Date: 2006/07/05 15:27:52 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This file (companion of nvector.h) contains definitions + * needed for the initialization of vector operations in Fortran. + * ----------------------------------------------------------------- + */ + + +#ifndef _FNVECTOR_H +#define _FNVECTOR_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#ifndef _SUNDIALS_CONFIG_H +#define _SUNDIALS_CONFIG_H +#include +#endif + +/* SUNDIALS solver IDs */ + +#define FCMIX_CVODE 1 +#define FCMIX_IDA 2 +#define FCMIX_KINSOL 3 + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/sundials/sundials_iterative.h b/odemex/Parser/CVode/ida_src/include/sundials/sundials_iterative.h new file mode 100644 index 0000000..5e7e4bf --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/sundials/sundials_iterative.h @@ -0,0 +1,242 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2006/11/29 00:05:07 $ + * ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen and Alan C. Hindmarsh @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This header file contains declarations intended for use by + * generic iterative solvers of Ax = b. The enumeration gives + * symbolic names for the type of preconditioning to be used. + * The function type declarations give the prototypes for the + * functions to be called within an iterative linear solver, that + * are responsible for + * multiplying A by a given vector v (ATimesFn), and + * solving the preconditioner equation Pz = r (PSolveFn). + * ----------------------------------------------------------------- + */ + +#ifndef _ITERATIVE_H +#define _ITERATIVE_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + + +/* + * ----------------------------------------------------------------- + * enum : types of preconditioning + * ----------------------------------------------------------------- + * PREC_NONE : The iterative linear solver should not use + * preconditioning. + * + * PREC_LEFT : The iterative linear solver uses preconditioning on + * the left only. + * + * PREC_RIGHT : The iterative linear solver uses preconditioning on + * the right only. + * + * PREC_BOTH : The iterative linear solver uses preconditioning on + * both the left and the right. + * ----------------------------------------------------------------- + */ + +enum { PREC_NONE, PREC_LEFT, PREC_RIGHT, PREC_BOTH }; + +/* + * ----------------------------------------------------------------- + * enum : types of Gram-Schmidt routines + * ----------------------------------------------------------------- + * MODIFIED_GS : The iterative solver uses the modified + * Gram-Schmidt routine ModifiedGS listed in this + * file. + * + * CLASSICAL_GS : The iterative solver uses the classical + * Gram-Schmidt routine ClassicalGS listed in this + * file. + * ----------------------------------------------------------------- + */ + +enum { MODIFIED_GS = 1, CLASSICAL_GS = 2 }; + +/* + * ----------------------------------------------------------------- + * Type: ATimesFn + * ----------------------------------------------------------------- + * An ATimesFn multiplies Av and stores the result in z. The + * caller is responsible for allocating memory for the z vector. + * The parameter A_data is a pointer to any information about A + * which the function needs in order to do its job. The vector v + * is unchanged. An ATimesFn returns 0 if successful and a + * non-zero value if unsuccessful. + * ----------------------------------------------------------------- + */ + +typedef int (*ATimesFn)(void *A_data, N_Vector v, N_Vector z); + +/* + * ----------------------------------------------------------------- + * Type: PSolveFn + * ----------------------------------------------------------------- + * A PSolveFn solves the preconditioner equation Pz = r for the + * vector z. The caller is responsible for allocating memory for + * the z vector. The parameter P_data is a pointer to any + * information about P which the function needs in order to do + * its job. The parameter lr is input, and indicates whether P + * is to be taken as the left preconditioner or the right + * preconditioner: lr = 1 for left and lr = 2 for right. + * If preconditioning is on one side only, lr can be ignored. + * The vector r is unchanged. + * A PSolveFn returns 0 if successful and a non-zero value if + * unsuccessful. On a failure, a negative return value indicates + * an unrecoverable condition, while a positive value indicates + * a recoverable one, in which the calling routine may reattempt + * the solution after updating preconditioner data. + * ----------------------------------------------------------------- + */ + +typedef int (*PSolveFn)(void *P_data, N_Vector r, N_Vector z, int lr); + +/* + * ----------------------------------------------------------------- + * Function: ModifiedGS + * ----------------------------------------------------------------- + * ModifiedGS performs a modified Gram-Schmidt orthogonalization + * of the N_Vector v[k] against the p unit N_Vectors at + * v[k-1], v[k-2], ..., v[k-p]. + * + * v is an array of (k+1) N_Vectors v[i], i=0, 1, ..., k. + * v[k-1], v[k-2], ..., v[k-p] are assumed to have L2-norm + * equal to 1. + * + * h is the output k by k Hessenberg matrix of inner products. + * This matrix must be allocated row-wise so that the (i,j)th + * entry is h[i][j]. The inner products (v[i],v[k]), + * i=i0, i0+1, ..., k-1, are stored at h[i][k-1]. Here + * i0=MAX(0,k-p). + * + * k is the index of the vector in the v array that needs to be + * orthogonalized against previous vectors in the v array. + * + * p is the number of previous vectors in the v array against + * which v[k] is to be orthogonalized. + * + * new_vk_norm is a pointer to memory allocated by the caller to + * hold the Euclidean norm of the orthogonalized vector v[k]. + * + * If (k-p) < 0, then ModifiedGS uses p=k. The orthogonalized + * v[k] is NOT normalized and is stored over the old v[k]. Once + * the orthogonalization has been performed, the Euclidean norm + * of v[k] is stored in (*new_vk_norm). + * + * ModifiedGS returns 0 to indicate success. It cannot fail. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int ModifiedGS(N_Vector *v, realtype **h, int k, int p, + realtype *new_vk_norm); + +/* + * ----------------------------------------------------------------- + * Function: ClassicalGS + * ----------------------------------------------------------------- + * ClassicalGS performs a classical Gram-Schmidt + * orthogonalization of the N_Vector v[k] against the p unit + * N_Vectors at v[k-1], v[k-2], ..., v[k-p]. The parameters v, h, + * k, p, and new_vk_norm are as described in the documentation + * for ModifiedGS. + * + * temp is an N_Vector which can be used as workspace by the + * ClassicalGS routine. + * + * s is a length k array of realtype which can be used as + * workspace by the ClassicalGS routine. + * + * ClassicalGS returns 0 to indicate success. It cannot fail. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int ClassicalGS(N_Vector *v, realtype **h, int k, int p, + realtype *new_vk_norm, N_Vector temp, realtype *s); + +/* + * ----------------------------------------------------------------- + * Function: QRfact + * ----------------------------------------------------------------- + * QRfact performs a QR factorization of the Hessenberg matrix H. + * + * n is the problem size; the matrix H is (n+1) by n. + * + * h is the (n+1) by n Hessenberg matrix H to be factored. It is + * stored row-wise. + * + * q is an array of length 2*n containing the Givens rotations + * computed by this function. A Givens rotation has the form: + * | c -s | + * | s c |. + * The components of the Givens rotations are stored in q as + * (c, s, c, s, ..., c, s). + * + * job is a control flag. If job==0, then a new QR factorization + * is performed. If job!=0, then it is assumed that the first + * n-1 columns of h have already been factored and only the last + * column needs to be updated. + * + * QRfact returns 0 if successful. If a zero is encountered on + * the diagonal of the triangular factor R, then QRfact returns + * the equation number of the zero entry, where the equations are + * numbered from 1, not 0. If QRsol is subsequently called in + * this situation, it will return an error because it could not + * divide by the zero diagonal entry. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int QRfact(int n, realtype **h, realtype *q, int job); + +/* + * ----------------------------------------------------------------- + * Function: QRsol + * ----------------------------------------------------------------- + * QRsol solves the linear least squares problem + * + * min (b - H*x, b - H*x), x in R^n, + * + * where H is a Hessenberg matrix, and b is in R^(n+1). + * It uses the QR factors of H computed by QRfact. + * + * n is the problem size; the matrix H is (n+1) by n. + * + * h is a matrix (computed by QRfact) containing the upper + * triangular factor R of the original Hessenberg matrix H. + * + * q is an array of length 2*n (computed by QRfact) containing + * the Givens rotations used to factor H. + * + * b is the (n+1)-vector appearing in the least squares problem + * above. + * + * On return, b contains the solution x of the least squares + * problem, if QRsol was successful. + * + * QRsol returns a 0 if successful. Otherwise, a zero was + * encountered on the diagonal of the triangular factor R. + * In this case, QRsol returns the equation number (numbered + * from 1, not 0) of the zero entry. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int QRsol(int n, realtype **h, realtype *q, realtype *b); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/sundials/sundials_lapack.h b/odemex/Parser/CVode/ida_src/include/sundials/sundials_lapack.h new file mode 100644 index 0000000..4af89df --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/sundials/sundials_lapack.h @@ -0,0 +1,126 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.6 $ + * $Date: 2009/02/17 02:39:26 $ + * ----------------------------------------------------------------- + * Programmer: Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2006, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for a generic package of direct matrix + * operations for use with BLAS/LAPACK. + * ----------------------------------------------------------------- + */ + +#ifndef _SUNDIALS_LAPACK_H +#define _SUNDIALS_LAPACK_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* + * ================================================================== + * Blas and Lapack functions + * ================================================================== + */ + +#if defined(SUNDIALS_F77_FUNC) + +#define dcopy_f77 SUNDIALS_F77_FUNC(dcopy, DCOPY) +#define dscal_f77 SUNDIALS_F77_FUNC(dscal, DSCAL) +#define dgemv_f77 SUNDIALS_F77_FUNC(dgemv, DGEMV) +#define dtrsv_f77 SUNDIALS_F77_FUNC(dtrsv, DTRSV) +#define dsyrk_f77 SUNDIALS_F77_FUNC(dsyrk, DSKYR) + +#define dgbtrf_f77 SUNDIALS_F77_FUNC(dgbtrf, DGBTRF) +#define dgbtrs_f77 SUNDIALS_F77_FUNC(dgbtrs, DGBTRS) +#define dgetrf_f77 SUNDIALS_F77_FUNC(dgetrf, DGETRF) +#define dgetrs_f77 SUNDIALS_F77_FUNC(dgetrs, DGETRS) +#define dgeqp3_f77 SUNDIALS_F77_FUNC(dgeqp3, DGEQP3) +#define dgeqrf_f77 SUNDIALS_F77_FUNC(dgeqrf, DGEQRF) +#define dormqr_f77 SUNDIALS_F77_FUNC(dormqr, DORMQR) +#define dpotrf_f77 SUNDIALS_F77_FUNC(dpotrf, DPOTRF) +#define dpotrs_f77 SUNDIALS_F77_FUNC(dpotrs, DPOTRS) + +#else + +#define dcopy_f77 dcopy_ +#define dscal_f77 dscal_ +#define dgemv_f77 dgemv_ +#define dtrsv_f77 dtrsv_ +#define dsyrk_f77 dsyrk_ + +#define dgbtrf_f77 dgbtrf_ +#define dgbtrs_f77 dgbtrs_ +#define dgeqp3_f77 dgeqp3_ +#define dgeqrf_f77 dgeqrf_ +#define dgetrf_f77 dgetrf_ +#define dgetrs_f77 dgetrs_ +#define dormqr_f77 dormqr_ +#define dpotrf_f77 dpotrf_ +#define dpotrs_f77 dpotrs_ + +#endif + +/* Level-1 BLAS */ + +extern void dcopy_f77(int *n, const double *x, const int *inc_x, double *y, const int *inc_y); +extern void dscal_f77(int *n, const double *alpha, double *x, const int *inc_x); + +/* Level-2 BLAS */ + +extern void dgemv_f77(const char *trans, int *m, int *n, const double *alpha, const double *a, + int *lda, const double *x, int *inc_x, const double *beta, double *y, int *inc_y, + int len_trans); + +extern void dtrsv_f77(const char *uplo, const char *trans, const char *diag, const int *n, + const double *a, const int *lda, double *x, const int *inc_x, + int len_uplo, int len_trans, int len_diag); + +/* Level-3 BLAS */ + +extern void dsyrk_f77(const char *uplo, const char *trans, const int *n, const int *k, + const double *alpha, const double *a, const int *lda, const double *beta, + const double *c, const int *ldc, int len_uplo, int len_trans); + +/* LAPACK */ + +extern void dgbtrf_f77(const int *m, const int *n, const int *kl, const int *ku, + double *ab, int *ldab, int *ipiv, int *info); + +extern void dgbtrs_f77(const char *trans, const int *n, const int *kl, const int *ku, const int *nrhs, + double *ab, const int *ldab, int *ipiv, double *b, const int *ldb, + int *info, int len_trans); + + +extern void dgeqp3_f77(const int *m, const int *n, double *a, const int *lda, int *jpvt, double *tau, + double *work, const int *lwork, int *info); + +extern void dgeqrf_f77(const int *m, const int *n, double *a, const int *lda, double *tau, double *work, + const int *lwork, int *info); + +extern void dgetrf_f77(const int *m, const int *n, double *a, int *lda, int *ipiv, int *info); + +extern void dgetrs_f77(const char *trans, const int *n, const int *nrhs, double *a, const int *lda, + int *ipiv, double *b, const int *ldb, int *info, int len_trans); + + +extern void dormqr_f77(const char *side, const char *trans, const int *m, const int *n, const int *k, + double *a, const int *lda, double *tau, double *c, const int *ldc, + double *work, const int *lwork, int *info, int len_side, int len_trans); + +extern void dpotrf_f77(const char *uplo, const int *n, double *a, int *lda, int *info, int len_uplo); + +extern void dpotrs_f77(const char *uplo, const int *n, const int *nrhs, double *a, const int *lda, + double *b, const int *ldb, int * info, int len_uplo); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/sundials/sundials_math.h b/odemex/Parser/CVode/ida_src/include/sundials/sundials_math.h new file mode 100644 index 0000000..99de085 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/sundials/sundials_math.h @@ -0,0 +1,139 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2006/11/29 00:05:07 $ + * ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and + * Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for a simple C-language math library. The + * routines listed here work with the type realtype as defined in + * the header file sundials_types.h. + * ----------------------------------------------------------------- + */ + +#ifndef _SUNDIALSMATH_H +#define _SUNDIALSMATH_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ----------------------------------------------------------------- + * Macros : MIN and MAX + * ----------------------------------------------------------------- + * MIN(A,B) returns the minimum of A and B + * + * MAX(A,B) returns the maximum of A and B + * + * SQR(A) returns A^2 + * ----------------------------------------------------------------- + */ + +#ifndef MIN +#define MIN(A, B) ((A) < (B) ? (A) : (B)) +#endif + +#ifndef MAX +#define MAX(A, B) ((A) > (B) ? (A) : (B)) +#endif + +#ifndef SQR +#define SQR(A) ((A)*(A)) +#endif + +#ifndef ABS +#define ABS RAbs +#endif + +#ifndef SQRT +#define SQRT RSqrt +#endif + +#ifndef EXP +#define EXP RExp +#endif + +/* + * ----------------------------------------------------------------- + * Function : RPowerI + * ----------------------------------------------------------------- + * Usage : int exponent; + * realtype base, ans; + * ans = RPowerI(base,exponent); + * ----------------------------------------------------------------- + * RPowerI returns the value of base^exponent, where base is of type + * realtype and exponent is of type int. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT realtype RPowerI(realtype base, int exponent); + +/* + * ----------------------------------------------------------------- + * Function : RPowerR + * ----------------------------------------------------------------- + * Usage : realtype base, exponent, ans; + * ans = RPowerR(base,exponent); + * ----------------------------------------------------------------- + * RPowerR returns the value of base^exponent, where both base and + * exponent are of type realtype. If base < ZERO, then RPowerR + * returns ZERO. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT realtype RPowerR(realtype base, realtype exponent); + +/* + * ----------------------------------------------------------------- + * Function : RSqrt + * ----------------------------------------------------------------- + * Usage : realtype sqrt_x; + * sqrt_x = RSqrt(x); + * ----------------------------------------------------------------- + * RSqrt(x) returns the square root of x. If x < ZERO, then RSqrt + * returns ZERO. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT realtype RSqrt(realtype x); + +/* + * ----------------------------------------------------------------- + * Function : RAbs (a.k.a. ABS) + * ----------------------------------------------------------------- + * Usage : realtype abs_x; + * abs_x = RAbs(x); + * ----------------------------------------------------------------- + * RAbs(x) returns the absolute value of x. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT realtype RAbs(realtype x); + +/* + * ----------------------------------------------------------------- + * Function : RExp (a.k.a. EXP) + * ----------------------------------------------------------------- + * Usage : realtype exp_x; + * exp_x = RExp(x); + * ----------------------------------------------------------------- + * RExp(x) returns e^x (base-e exponential function). + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT realtype RExp(realtype x); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/sundials/sundials_nvector.h b/odemex/Parser/CVode/ida_src/include/sundials/sundials_nvector.h new file mode 100644 index 0000000..6142b32 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/sundials/sundials_nvector.h @@ -0,0 +1,373 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2006/11/29 00:05:07 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for a generic NVECTOR package. + * It defines the N_Vector structure (_generic_N_Vector) which + * contains the following fields: + * - an implementation-dependent 'content' field which contains + * the description and actual data of the vector + * - an 'ops' filed which contains a structure listing operations + * acting on such vectors + * + * Part I of this file contains type declarations for the + * _generic_N_Vector and _generic_N_Vector_Ops structures, as well + * as references to pointers to such structures (N_Vector). + * + * Part II of this file contains the prototypes for the vector + * functions which operate on N_Vector. + * + * At a minimum, a particular implementation of an NVECTOR must + * do the following: + * - specify the 'content' field of N_Vector, + * - implement the operations on those N_Vectors, + * - provide a constructor routine for new vectors + * + * Additionally, an NVECTOR implementation may provide the following: + * - macros to access the underlying N_Vector data + * - a constructor for an array of N_Vectors + * - a constructor for an empty N_Vector (i.e., a new N_Vector with + * a NULL data pointer). + * - a routine to print the content of an N_Vector + * ----------------------------------------------------------------- + */ + +#ifndef _NVECTOR_H +#define _NVECTOR_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ----------------------------------------------------------------- + * Generic definition of N_Vector + * ----------------------------------------------------------------- + */ + +/* Forward reference for pointer to N_Vector_Ops object */ +typedef struct _generic_N_Vector_Ops *N_Vector_Ops; + +/* Forward reference for pointer to N_Vector object */ +typedef struct _generic_N_Vector *N_Vector; + +/* Define array of N_Vectors */ +typedef N_Vector *N_Vector_S; + +/* Structure containing function pointers to vector operations */ +struct _generic_N_Vector_Ops { + N_Vector (*nvclone)(N_Vector); + N_Vector (*nvcloneempty)(N_Vector); + void (*nvdestroy)(N_Vector); + void (*nvspace)(N_Vector, long int *, long int *); + realtype* (*nvgetarraypointer)(N_Vector); + void (*nvsetarraypointer)(realtype *, N_Vector); + void (*nvlinearsum)(realtype, N_Vector, realtype, N_Vector, N_Vector); + void (*nvconst)(realtype, N_Vector); + void (*nvprod)(N_Vector, N_Vector, N_Vector); + void (*nvdiv)(N_Vector, N_Vector, N_Vector); + void (*nvscale)(realtype, N_Vector, N_Vector); + void (*nvabs)(N_Vector, N_Vector); + void (*nvinv)(N_Vector, N_Vector); + void (*nvaddconst)(N_Vector, realtype, N_Vector); + realtype (*nvdotprod)(N_Vector, N_Vector); + realtype (*nvmaxnorm)(N_Vector); + realtype (*nvwrmsnorm)(N_Vector, N_Vector); + realtype (*nvwrmsnormmask)(N_Vector, N_Vector, N_Vector); + realtype (*nvmin)(N_Vector); + realtype (*nvwl2norm)(N_Vector, N_Vector); + realtype (*nvl1norm)(N_Vector); + void (*nvcompare)(realtype, N_Vector, N_Vector); + booleantype (*nvinvtest)(N_Vector, N_Vector); + booleantype (*nvconstrmask)(N_Vector, N_Vector, N_Vector); + realtype (*nvminquotient)(N_Vector, N_Vector); +}; + +/* + * ----------------------------------------------------------------- + * A vector is a structure with an implementation-dependent + * 'content' field, and a pointer to a structure of vector + * operations corresponding to that implementation. + * ----------------------------------------------------------------- + */ + +struct _generic_N_Vector { + void *content; + struct _generic_N_Vector_Ops *ops; +}; + +/* + * ----------------------------------------------------------------- + * Functions exported by NVECTOR module + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * N_VClone + * Creates a new vector of the same type as an existing vector. + * It does not copy the vector, but rather allocates storage for + * the new vector. + * + * N_VCloneEmpty + * Creates a new vector of the same type as an existing vector, + * but does not allocate storage. + * + * N_VDestroy + * Destroys a vector created with N_VClone. + * + * N_VSpace + * Returns space requirements for one N_Vector (type 'realtype' in + * lrw and type 'long int' in liw). + * + * N_VGetArrayPointer + * Returns a pointer to the data component of the given N_Vector. + * NOTE: This function assumes that the internal data is stored + * as a contiguous 'realtype' array. This routine is only used in + * the solver-specific interfaces to the dense and banded linear + * solvers, as well as the interfaces to the banded preconditioners + * distributed with SUNDIALS. + * + * N_VSetArrayPointer + * Overwrites the data field in the given N_Vector with a user-supplied + * array of type 'realtype'. + * NOTE: This function assumes that the internal data is stored + * as a contiguous 'realtype' array. This routine is only used in + * the interfaces to the dense linear solver. + * + * N_VLinearSum + * Performs the operation z = a*x + b*y + * + * N_VConst + * Performs the operation z[i] = c for i = 0, 1, ..., N-1 + * + * N_VProd + * Performs the operation z[i] = x[i]*y[i] for i = 0, 1, ..., N-1 + * + * N_VDiv + * Performs the operation z[i] = x[i]/y[i] for i = 0, 1, ..., N-1 + * + * N_VScale + * Performs the operation z = c*x + * + * N_VAbs + * Performs the operation z[i] = |x[i]| for i = 0, 1, ..., N-1 + * + * N_VInv + * Performs the operation z[i] = 1/x[i] for i = 0, 1, ..., N-1 + * This routine does not check for division by 0. It should be + * called only with an N_Vector x which is guaranteed to have + * all non-zero components. + * + * N_VAddConst + * Performs the operation z[i] = x[i] + b for i = 0, 1, ..., N-1 + * + * N_VDotProd + * Returns the dot product of two vectors: + * sum (i = 0 to N-1) {x[i]*y[i]} + * + * N_VMaxNorm + * Returns the maximum norm of x: + * max (i = 0 to N-1) ABS(x[i]) + * + * N_VWrmsNorm + * Returns the weighted root mean square norm of x with weight + * vector w: + * sqrt [(sum (i = 0 to N-1) {(x[i]*w[i])^2})/N] + * + * N_VWrmsNormMask + * Returns the weighted root mean square norm of x with weight + * vector w, masked by the elements of id: + * sqrt [(sum (i = 0 to N-1) {(x[i]*w[i]*msk[i])^2})/N] + * where msk[i] = 1.0 if id[i] > 0 and + * msk[i] = 0.0 if id[i] < 0 + * + * N_VMin + * Returns the smallest element of x: + * min (i = 0 to N-1) x[i] + * + * N_VWL2Norm + * Returns the weighted Euclidean L2 norm of x with weight + * vector w: + * sqrt [(sum (i = 0 to N-1) {(x[i]*w[i])^2})] + * + * N_VL1Norm + * Returns the L1 norm of x: + * sum (i = 0 to N-1) {ABS(x[i])} + * + * N_VCompare + * Performs the operation + * z[i] = 1.0 if ABS(x[i]) >= c i = 0, 1, ..., N-1 + * 0.0 otherwise + * + * N_VInvTest + * Performs the operation z[i] = 1/x[i] with a test for + * x[i] == 0.0 before inverting x[i]. + * This routine returns TRUE if all components of x are non-zero + * (successful inversion) and returns FALSE otherwise. + * + * N_VConstrMask + * Performs the operation : + * m[i] = 1.0 if constraint test fails for x[i] + * m[i] = 0.0 if constraint test passes for x[i] + * where the constraint tests are as follows: + * If c[i] = +2.0, then x[i] must be > 0.0. + * If c[i] = +1.0, then x[i] must be >= 0.0. + * If c[i] = -1.0, then x[i] must be <= 0.0. + * If c[i] = -2.0, then x[i] must be < 0.0. + * This routine returns a boolean FALSE if any element failed + * the constraint test, TRUE if all passed. It also sets a + * mask vector m, with elements equal to 1.0 where the + * corresponding constraint test failed, and equal to 0.0 + * where the constraint test passed. + * This routine is specialized in that it is used only for + * constraint checking. + * + * N_VMinQuotient + * Performs the operation : + * minq = min ( num[i]/denom[i]) over all i such that + * denom[i] != 0. + * This routine returns the minimum of the quotients obtained + * by term-wise dividing num[i] by denom[i]. A zero element + * in denom will be skipped. If no such quotients are found, + * then the large value BIG_REAL is returned. + * + * ----------------------------------------------------------------- + * + * The following table lists the vector functions used by + * different modules in SUNDIALS. The symbols in the table + * have the following meaning: + * S - called by the solver; + * D - called by the dense linear solver module + * B - called by the band linear solver module + * Di - called by the diagonal linear solver module + * I - called by the iterative linear solver module + * BP - called by the band preconditioner module + * BBDP - called by the band-block diagonal preconditioner module + * F - called by the Fortran-to-C interface + * + * ------------------------------------------------ + * MODULES + * NVECTOR ------------------------------------------------ + * FUNCTIONS CVODE/CVODES IDA KINSOL + * ----------------------------------------------------------------- + * N_VClone S Di I S I BBDP S I BBDP + * ----------------------------------------------------------------- + * N_VCloneEmpty F F F + * ----------------------------------------------------------------- + * N_VDestroy S Di I S I BBDP S I BBDP + * ----------------------------------------------------------------- + * N_VSpace S S S + * ----------------------------------------------------------------- + * N_VGetArrayPointer D B BP BBDP F D B BBDP BBDP F + * ----------------------------------------------------------------- + * N_VSetArrayPointer D F D F + * ----------------------------------------------------------------- + * N_VLinearSum S D Di I S D I S I + * ----------------------------------------------------------------- + * N_VConst S I S I I + * ----------------------------------------------------------------- + * N_VProd S Di I S I S I + * ----------------------------------------------------------------- + * N_VDiv S Di I S I S I + * ----------------------------------------------------------------- + * N_VScale S D B Di I BP BBDP S D B I BBDP S I BBDP + * ----------------------------------------------------------------- + * N_VAbs S S S + * ----------------------------------------------------------------- + * N_VInv S Di S S + * ----------------------------------------------------------------- + * N_VAddConst S Di S + * ----------------------------------------------------------------- + * N_VDotProd I I I + * ----------------------------------------------------------------- + * N_VMaxNorm S S S + * ----------------------------------------------------------------- + * N_VWrmsNorm S D B I BP BBDP S + * ----------------------------------------------------------------- + * N_VWrmsNormMask S + * ----------------------------------------------------------------- + * N_VMin S S S + * ----------------------------------------------------------------- + * N_VWL2Norm S I + * ----------------------------------------------------------------- + * N_VL1Norm I + * ----------------------------------------------------------------- + * N_VCompare Di S + * ----------------------------------------------------------------- + * N_VInvTest Di + * ----------------------------------------------------------------- + * N_VConstrMask S S + * ----------------------------------------------------------------- + * N_VMinQuotient S S + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector N_VClone(N_Vector w); +SUNDIALS_EXPORT N_Vector N_VCloneEmpty(N_Vector w); +SUNDIALS_EXPORT void N_VDestroy(N_Vector v); +SUNDIALS_EXPORT void N_VSpace(N_Vector v, long int *lrw, long int *liw); +SUNDIALS_EXPORT realtype *N_VGetArrayPointer(N_Vector v); +SUNDIALS_EXPORT void N_VSetArrayPointer(realtype *v_data, N_Vector v); +SUNDIALS_EXPORT void N_VLinearSum(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VConst(realtype c, N_Vector z); +SUNDIALS_EXPORT void N_VProd(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VDiv(N_Vector x, N_Vector y, N_Vector z); +SUNDIALS_EXPORT void N_VScale(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAbs(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VInv(N_Vector x, N_Vector z); +SUNDIALS_EXPORT void N_VAddConst(N_Vector x, realtype b, N_Vector z); +SUNDIALS_EXPORT realtype N_VDotProd(N_Vector x, N_Vector y); +SUNDIALS_EXPORT realtype N_VMaxNorm(N_Vector x); +SUNDIALS_EXPORT realtype N_VWrmsNorm(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VWrmsNormMask(N_Vector x, N_Vector w, N_Vector id); +SUNDIALS_EXPORT realtype N_VMin(N_Vector x); +SUNDIALS_EXPORT realtype N_VWL2Norm(N_Vector x, N_Vector w); +SUNDIALS_EXPORT realtype N_VL1Norm(N_Vector x); +SUNDIALS_EXPORT void N_VCompare(realtype c, N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VInvTest(N_Vector x, N_Vector z); +SUNDIALS_EXPORT booleantype N_VConstrMask(N_Vector c, N_Vector x, N_Vector m); +SUNDIALS_EXPORT realtype N_VMinQuotient(N_Vector num, N_Vector denom); + +/* + * ----------------------------------------------------------------- + * Additional functions exported by NVECTOR module + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * N_VCloneEmptyVectorArray + * Creates (by cloning 'w') an array of 'count' empty N_Vectors + * + * N_VCloneVectorArray + * Creates (by cloning 'w') an array of 'count' N_Vectors + * + * N_VDestroyVectorArray + * Frees memory for an array of 'count' N_Vectors that was + * created by a call to N_VCloneVectorArray + * + * These functions are used by the SPGMR iterative linear solver + * module and by the CVODES and IDAS solvers. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT N_Vector *N_VCloneEmptyVectorArray(int count, N_Vector w); +SUNDIALS_EXPORT N_Vector *N_VCloneVectorArray(int count, N_Vector w); +SUNDIALS_EXPORT void N_VDestroyVectorArray(N_Vector *vs, int count); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/sundials/sundials_spbcgs.h b/odemex/Parser/CVode/ida_src/include/sundials/sundials_spbcgs.h new file mode 100644 index 0000000..d569d1d --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/sundials/sundials_spbcgs.h @@ -0,0 +1,199 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2006/11/29 00:05:07 $ + * ----------------------------------------------------------------- + * Programmer(s): Peter Brown and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2004, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the implementation of the scaled, + * preconditioned Bi-CGSTAB (SPBCG) iterative linear solver. + * ----------------------------------------------------------------- + */ + +#ifndef _SPBCG_H +#define _SPBCG_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ----------------------------------------------------------------- + * Types: struct SpbcgMemRec and struct *SpbcgMem + * ----------------------------------------------------------------- + * A variable declaration of type struct *SpbcgMem denotes a pointer + * to a data structure of type struct SpbcgMemRec. The SpbcgMemRec + * structure contains numerous fields that must be accessed by the + * SPBCG linear solver module. + * + * l_max maximum Krylov subspace dimension that SpbcgSolve will + * be permitted to use + * + * r vector (type N_Vector) which holds the scaled, preconditioned + * linear system residual + * + * r_star vector (type N_Vector) which holds the initial scaled, + * preconditioned linear system residual + * + * p, q, u and Ap vectors (type N_Vector) used for workspace by + * the SPBCG algorithm + * + * vtemp scratch vector (type N_Vector) used as temporary vector + * storage + * ----------------------------------------------------------------- + */ + +typedef struct { + + int l_max; + + N_Vector r_star; + N_Vector r; + N_Vector p; + N_Vector q; + N_Vector u; + N_Vector Ap; + N_Vector vtemp; + +} SpbcgMemRec, *SpbcgMem; + +/* + * ----------------------------------------------------------------- + * Function : SpbcgMalloc + * ----------------------------------------------------------------- + * SpbcgMalloc allocates additional memory needed by the SPBCG + * linear solver module. + * + * l_max maximum Krylov subspace dimension that SpbcgSolve will + * be permitted to use + * + * vec_tmpl implementation-specific template vector (type N_Vector) + * (created using either N_VNew_Serial or N_VNew_Parallel) + * + * If successful, SpbcgMalloc returns a non-NULL memory pointer. If + * an error occurs, then a NULL pointer is returned. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT SpbcgMem SpbcgMalloc(int l_max, N_Vector vec_tmpl); + +/* + * ----------------------------------------------------------------- + * Function : SpbcgSolve + * ----------------------------------------------------------------- + * SpbcgSolve solves the linear system Ax = b by means of a scaled + * preconditioned Bi-CGSTAB (SPBCG) iterative method. + * + * mem pointer to an internal memory block allocated during a + * prior call to SpbcgMalloc + * + * A_data pointer to a data structure containing information + * about the coefficient matrix A (passed to user-supplied + * function referenced by atimes (function pointer)) + * + * x vector (type N_Vector) containing initial guess x_0 upon + * entry, but which upon return contains an approximate solution + * of the linear system Ax = b (solution only valid if return + * value is either SPBCG_SUCCESS or SPBCG_RES_REDUCED) + * + * b vector (type N_Vector) set to the right-hand side vector b + * of the linear system (undisturbed by function) + * + * pretype variable (type int) indicating the type of + * preconditioning to be used (see sundials_iterative.h) + * + * delta tolerance on the L2 norm of the scaled, preconditioned + * residual (if return value == SPBCG_SUCCESS, then + * ||sb*P1_inv*(b-Ax)||_L2 <= delta) + * + * P_data pointer to a data structure containing preconditioner + * information (passed to user-supplied function referenced + * by psolve (function pointer)) + * + * sx vector (type N_Vector) containing positive scaling factors + * for x (pass sx == NULL if scaling NOT required) + * + * sb vector (type N_Vector) containing positive scaling factors + * for b (pass sb == NULL if scaling NOT required) + * + * atimes user-supplied routine responsible for computing the + * matrix-vector product Ax (see sundials_iterative.h) + * + * psolve user-supplied routine responsible for solving the + * preconditioned linear system Pz = r (ignored if + * pretype == PREC_NONE) (see sundials_iterative.h) + * + * res_norm pointer (type realtype*) to the L2 norm of the + * scaled, preconditioned residual (if return value + * is either SPBCG_SUCCESS or SPBCG_RES_REDUCED, then + * *res_norm = ||sb*P1_inv*(b-Ax)||_L2, where x is + * the computed approximate solution, sb is the diagonal + * scaling matrix for the right-hand side b, and P1_inv + * is the inverse of the left-preconditioner matrix) + * + * nli pointer (type int*) to the total number of linear + * iterations performed + * + * nps pointer (type int*) to the total number of calls made + * to the psolve routine + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int SpbcgSolve(SpbcgMem mem, void *A_data, N_Vector x, N_Vector b, + int pretype, realtype delta, void *P_data, N_Vector sx, + N_Vector sb, ATimesFn atimes, PSolveFn psolve, + realtype *res_norm, int *nli, int *nps); + +/* Return values for SpbcgSolve */ + +#define SPBCG_SUCCESS 0 /* SPBCG algorithm converged */ +#define SPBCG_RES_REDUCED 1 /* SPBCG did NOT converge, but the + residual was reduced */ +#define SPBCG_CONV_FAIL 2 /* SPBCG algorithm failed to converge */ +#define SPBCG_PSOLVE_FAIL_REC 3 /* psolve failed recoverably */ +#define SPBCG_ATIMES_FAIL_REC 4 /* atimes failed recoverably */ +#define SPBCG_PSET_FAIL_REC 5 /* pset faild recoverably */ + +#define SPBCG_MEM_NULL -1 /* mem argument is NULL */ +#define SPBCG_ATIMES_FAIL_UNREC -2 /* atimes returned failure flag */ +#define SPBCG_PSOLVE_FAIL_UNREC -3 /* psolve failed unrecoverably */ +#define SPBCG_PSET_FAIL_UNREC -4 /* pset failed unrecoverably */ + +/* + * ----------------------------------------------------------------- + * Function : SpbcgFree + * ----------------------------------------------------------------- + * SpbcgFree frees the memory allocated by a call to SpbcgMalloc. + * It is illegal to use the pointer mem after a call to SpbcgFree. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void SpbcgFree(SpbcgMem mem); + +/* + * ----------------------------------------------------------------- + * Macro : SPBCG_VTEMP + * ----------------------------------------------------------------- + * This macro provides access to the vector r in the + * memory block of the SPBCG module. The argument mem is the + * memory pointer returned by SpbcgMalloc, of type SpbcgMem, + * and the macro value is of type N_Vector. + * + * Note: Only used by IDA (r contains P_inverse F if nli_inc == 0). + * ----------------------------------------------------------------- + */ + +#define SPBCG_VTEMP(mem) (mem->r) + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/sundials/sundials_spgmr.h b/odemex/Parser/CVode/ida_src/include/sundials/sundials_spgmr.h new file mode 100644 index 0000000..c557acd --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/sundials/sundials_spgmr.h @@ -0,0 +1,296 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2006/11/29 00:05:07 $ + * ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and + * Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the implementation of SPGMR Krylov + * iterative linear solver. The SPGMR algorithm is based on the + * Scaled Preconditioned GMRES (Generalized Minimal Residual) + * method. + * + * The SPGMR algorithm solves a linear system A x = b. + * Preconditioning is allowed on the left, right, or both. + * Scaling is allowed on both sides, and restarts are also allowed. + * We denote the preconditioner and scaling matrices as follows: + * P1 = left preconditioner + * P2 = right preconditioner + * S1 = diagonal matrix of scale factors for P1-inverse b + * S2 = diagonal matrix of scale factors for P2 x + * The matrices A, P1, and P2 are not required explicitly; only + * routines that provide A, P1-inverse, and P2-inverse as + * operators are required. + * + * In this notation, SPGMR applies the underlying GMRES method to + * the equivalent transformed system + * Abar xbar = bbar , where + * Abar = S1 (P1-inverse) A (P2-inverse) (S2-inverse) , + * bbar = S1 (P1-inverse) b , and xbar = S2 P2 x . + * + * The scaling matrices must be chosen so that vectors S1 + * P1-inverse b and S2 P2 x have dimensionless components. + * If preconditioning is done on the left only (P2 = I), by a + * matrix P, then S2 must be a scaling for x, while S1 is a + * scaling for P-inverse b, and so may also be taken as a scaling + * for x. Similarly, if preconditioning is done on the right only + * (P1 = I, P2 = P), then S1 must be a scaling for b, while S2 is + * a scaling for P x, and may also be taken as a scaling for b. + * + * The stopping test for the SPGMR iterations is on the L2 norm of + * the scaled preconditioned residual: + * || bbar - Abar xbar ||_2 < delta + * with an input test constant delta. + * + * The usage of this SPGMR solver involves supplying two routines + * and making three calls. The user-supplied routines are + * atimes (A_data, x, y) to compute y = A x, given x, + * and + * psolve (P_data, x, y, lr) + * to solve P1 x = y or P2 x = y for x, given y. + * The three user calls are: + * mem = SpgmrMalloc(lmax, vec_tmpl); + * to initialize memory, + * flag = SpgmrSolve(mem,A_data,x,b,..., + * P_data,s1,s2,atimes,psolve,...); + * to solve the system, and + * SpgmrFree(mem); + * to free the memory created by SpgmrMalloc. + * Complete details for specifying atimes and psolve and for the + * usage calls are given in the paragraphs below and in iterative.h. + * ----------------------------------------------------------------- + */ + +#ifndef _SPGMR_H +#define _SPGMR_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ----------------------------------------------------------------- + * Types: SpgmrMemRec, SpgmrMem + * ----------------------------------------------------------------- + * SpgmrMem is a pointer to an SpgmrMemRec which contains + * the memory needed by SpgmrSolve. The SpgmrMalloc routine + * returns a pointer of type SpgmrMem which should then be passed + * in subsequent calls to SpgmrSolve. The SpgmrFree routine frees + * the memory allocated by SpgmrMalloc. + * + * l_max is the maximum Krylov dimension that SpgmrSolve will be + * permitted to use. + * + * V is the array of Krylov basis vectors v_1, ..., v_(l_max+1), + * stored in V[0], ..., V[l_max], where l_max is the second + * parameter to SpgmrMalloc. Each v_i is a vector of type + * N_Vector. + * + * Hes is the (l_max+1) x l_max Hessenberg matrix. It is stored + * row-wise so that the (i,j)th element is given by Hes[i][j]. + * + * givens is a length 2*l_max array which represents the + * Givens rotation matrices that arise in the algorithm. The + * Givens rotation matrices F_0, F_1, ..., F_j, where F_i is + * + * 1 + * 1 + * c_i -s_i <--- row i + * s_i c_i + * 1 + * 1 + * + * are represented in the givens vector as + * givens[0]=c_0, givens[1]=s_0, givens[2]=c_1, givens[3]=s_1, + * ..., givens[2j]=c_j, givens[2j+1]=s_j. + * + * xcor is a vector (type N_Vector) which holds the scaled, + * preconditioned correction to the initial guess. + * + * yg is a length (l_max+1) array of realtype used to hold "short" + * vectors (e.g. y and g). + * + * vtemp is a vector (type N_Vector) used as temporary vector + * storage during calculations. + * ----------------------------------------------------------------- + */ + +typedef struct _SpgmrMemRec { + + int l_max; + + N_Vector *V; + realtype **Hes; + realtype *givens; + N_Vector xcor; + realtype *yg; + N_Vector vtemp; + +} SpgmrMemRec, *SpgmrMem; + +/* + * ----------------------------------------------------------------- + * Function : SpgmrMalloc + * ----------------------------------------------------------------- + * SpgmrMalloc allocates the memory used by SpgmrSolve. It + * returns a pointer of type SpgmrMem which the user of the + * SPGMR package should pass to SpgmrSolve. The parameter l_max + * is the maximum Krylov dimension that SpgmrSolve will be + * permitted to use. The parameter vec_tmpl is a pointer to an + * N_Vector used as a template to create new vectors by duplication. + * This routine returns NULL if there is a memory request failure. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT SpgmrMem SpgmrMalloc(int l_max, N_Vector vec_tmpl); + +/* + * ----------------------------------------------------------------- + * Function : SpgmrSolve + * ----------------------------------------------------------------- + * SpgmrSolve solves the linear system Ax = b using the SPGMR + * method. The return values are given by the symbolic constants + * below. The first SpgmrSolve parameter is a pointer to memory + * allocated by a prior call to SpgmrMalloc. + * + * mem is the pointer returned by SpgmrMalloc to the structure + * containing the memory needed by SpgmrSolve. + * + * A_data is a pointer to information about the coefficient + * matrix A. This pointer is passed to the user-supplied function + * atimes. + * + * x is the initial guess x_0 upon entry and the solution + * N_Vector upon exit with return value SPGMR_SUCCESS or + * SPGMR_RES_REDUCED. For all other return values, the output x + * is undefined. + * + * b is the right hand side N_Vector. It is undisturbed by this + * function. + * + * pretype is the type of preconditioning to be used. Its + * legal possible values are enumerated in iterativ.h. These + * values are PREC_NONE=0, PREC_LEFT=1, PREC_RIGHT=2, and + * PREC_BOTH=3. + * + * gstype is the type of Gram-Schmidt orthogonalization to be + * used. Its legal values are enumerated in iterativ.h. These + * values are MODIFIED_GS=0 and CLASSICAL_GS=1. + * + * delta is the tolerance on the L2 norm of the scaled, + * preconditioned residual. On return with value SPGMR_SUCCESS, + * this residual satisfies || s1 P1_inv (b - Ax) ||_2 <= delta. + * + * max_restarts is the maximum number of times the algorithm is + * allowed to restart. + * + * P_data is a pointer to preconditioner information. This + * pointer is passed to the user-supplied function psolve. + * + * s1 is an N_Vector of positive scale factors for P1-inv b, where + * P1 is the left preconditioner. (Not tested for positivity.) + * Pass NULL if no scaling on P1-inv b is required. + * + * s2 is an N_Vector of positive scale factors for P2 x, where + * P2 is the right preconditioner. (Not tested for positivity.) + * Pass NULL if no scaling on P2 x is required. + * + * atimes is the user-supplied function which performs the + * operation of multiplying A by a given vector. Its description + * is given in iterative.h. + * + * psolve is the user-supplied function which solves a + * preconditioner system Pz = r, where P is P1 or P2. Its full + * description is given in iterativ.h. The psolve function will + * not be called if pretype is NONE; in that case, the user + * should pass NULL for psolve. + * + * res_norm is a pointer to the L2 norm of the scaled, + * preconditioned residual. On return with value SPGMR_SUCCESS or + * SPGMR_RES_REDUCED, (*res_norm) contains the value + * || s1 P1_inv (b - Ax) ||_2 for the computed solution x. + * For all other return values, (*res_norm) is undefined. The + * caller is responsible for allocating the memory (*res_norm) + * to be filled in by SpgmrSolve. + * + * nli is a pointer to the number of linear iterations done in + * the execution of SpgmrSolve. The caller is responsible for + * allocating the memory (*nli) to be filled in by SpgmrSolve. + * + * nps is a pointer to the number of calls made to psolve during + * the execution of SpgmrSolve. The caller is responsible for + * allocating the memory (*nps) to be filled in by SpgmrSolve. + * + * Note: Repeated calls can be made to SpgmrSolve with varying + * input arguments. If, however, the problem size N or the + * maximum Krylov dimension l_max changes, then a call to + * SpgmrMalloc must be made to obtain new memory for SpgmrSolve + * to use. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int SpgmrSolve(SpgmrMem mem, void *A_data, N_Vector x, N_Vector b, + int pretype, int gstype, realtype delta, + int max_restarts, void *P_data, N_Vector s1, + N_Vector s2, ATimesFn atimes, PSolveFn psolve, + realtype *res_norm, int *nli, int *nps); + + +/* Return values for SpgmrSolve */ + +#define SPGMR_SUCCESS 0 /* Converged */ +#define SPGMR_RES_REDUCED 1 /* Did not converge, but reduced + norm of residual */ +#define SPGMR_CONV_FAIL 2 /* Failed to converge */ +#define SPGMR_QRFACT_FAIL 3 /* QRfact found singular matrix */ +#define SPGMR_PSOLVE_FAIL_REC 4 /* psolve failed recoverably */ +#define SPGMR_ATIMES_FAIL_REC 5 /* atimes failed recoverably */ +#define SPGMR_PSET_FAIL_REC 6 /* pset faild recoverably */ + +#define SPGMR_MEM_NULL -1 /* mem argument is NULL */ +#define SPGMR_ATIMES_FAIL_UNREC -2 /* atimes returned failure flag */ +#define SPGMR_PSOLVE_FAIL_UNREC -3 /* psolve failed unrecoverably */ +#define SPGMR_GS_FAIL -4 /* Gram-Schmidt routine faiuled */ +#define SPGMR_QRSOL_FAIL -5 /* QRsol found singular R */ +#define SPGMR_PSET_FAIL_UNREC -6 /* pset failed unrecoverably */ + +/* + * ----------------------------------------------------------------- + * Function : SpgmrFree + * ----------------------------------------------------------------- + * SpgmrMalloc frees the memory allocated by SpgmrMalloc. It is + * illegal to use the pointer mem after a call to SpgmrFree. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void SpgmrFree(SpgmrMem mem); + +/* + * ----------------------------------------------------------------- + * Macro: SPGMR_VTEMP + * ----------------------------------------------------------------- + * This macro provides access to the work vector vtemp in the + * memory block of the SPGMR module. The argument mem is the + * memory pointer returned by SpgmrMalloc, of type SpgmrMem, + * and the macro value is of type N_Vector. + * On a return from SpgmrSolve with *nli = 0, this vector + * contains the scaled preconditioned initial residual, + * s1 * P1_inverse * (b - A x_0). + * ----------------------------------------------------------------- + */ + +#define SPGMR_VTEMP(mem) (mem->vtemp) + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/sundials/sundials_sptfqmr.h b/odemex/Parser/CVode/ida_src/include/sundials/sundials_sptfqmr.h new file mode 100644 index 0000000..2ba5c37 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/sundials/sundials_sptfqmr.h @@ -0,0 +1,254 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2006/11/29 00:05:07 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for the implementation of the scaled + * preconditioned Transpose-Free Quasi-Minimal Residual (SPTFQMR) + * linear solver. + * + * The SPTFQMR algorithm solves a linear system of the form Ax = b. + * Preconditioning is allowed on the left (PREC_LEFT), right + * (PREC_RIGHT), or both (PREC_BOTH). Scaling is allowed on both + * sides. We denote the preconditioner and scaling matrices as + * follows: + * P1 = left preconditioner + * P2 = right preconditioner + * S1 = diagonal matrix of scale factors for P1-inverse b + * S2 = diagonal matrix of scale factors for P2 x + * The matrices A, P1, and P2 are not required explicitly; only + * routines that provide A, P1-inverse, and P2-inverse as operators + * are required. + * + * In this notation, SPTFQMR applies the underlying TFQMR method to + * the equivalent transformed system: + * Abar xbar = bbar, where + * Abar = S1 (P1-inverse) A (P2-inverse) (S2-inverse), + * bbar = S1 (P1-inverse) b, and + * xbar = S2 P2 x. + * + * The scaling matrices must be chosen so that vectors + * S1 P1-inverse b and S2 P2 x have dimensionless components. If + * preconditioning is done on the left only (P2 = I), by a matrix P, + * then S2 must be a scaling for x, while S1 is a scaling for + * P-inverse b, and so may also be taken as a scaling for x. + * Similarly, if preconditioning is done on the right only (P1 = I, + * P2 = P), then S1 must be a scaling for b, while S2 is a scaling + * for P x, and may also be taken as a scaling for b. + * + * The stopping test for the SPTFQMR iterations is on the L2-norm of + * the scaled preconditioned residual: + * || bbar - Abar xbar ||_2 < delta + * with an input test constant delta. + * + * The usage of this SPTFQMR solver involves supplying two routines + * and making three calls. The user-supplied routines are: + * atimes(A_data, x, y) to compute y = A x, given x, + * and + * psolve(P_data, x, y, lr) to solve P1 x = y or P2 x = y for x, + * given y. + * The three user calls are: + * mem = SptfqmrMalloc(lmax, vec_tmpl); + * to initialize memory + * flag = SptfqmrSolve(mem, A_data, x, b, pretype, delta, P_data, + * sx, sb, atimes, psolve, res_norm, nli, nps); + * to solve the system, and + * SptfqmrFree(mem); + * to free the memory allocated by SptfqmrMalloc(). + * Complete details for specifying atimes() and psolve() and for the + * usage calls are given in the paragraphs below and in the header + * file sundials_iterative.h. + * ----------------------------------------------------------------- + */ + +#ifndef _SPTFQMR_H +#define _SPTFQMR_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +/* + * ----------------------------------------------------------------- + * Types: struct SptfqmrMemRec and struct *SptfqmrMem + * ----------------------------------------------------------------- + * A variable declaration of type struct *SptfqmrMem denotes a pointer + * to a data structure of type struct SptfqmrMemRec. The SptfqmrMemRec + * structure contains numerous fields that must be accessed by the + * SPTFQMR linear solver module. + * + * l_max maximum Krylov subspace dimension that SptfqmrSolve will + * be permitted to use + * + * r_star vector (type N_Vector) which holds the initial scaled, + * preconditioned linear system residual + * + * q/d/v/p/u/r vectors (type N_Vector) used for workspace by + * the SPTFQMR algorithm + * + * vtemp1/vtemp2/vtemp3 scratch vectors (type N_Vector) used as + * temporary storage + * ----------------------------------------------------------------- + */ + +typedef struct { + + int l_max; + + N_Vector r_star; + N_Vector q; + N_Vector d; + N_Vector v; + N_Vector p; + N_Vector *r; + N_Vector u; + N_Vector vtemp1; + N_Vector vtemp2; + N_Vector vtemp3; + +} SptfqmrMemRec, *SptfqmrMem; + +/* + * ----------------------------------------------------------------- + * Function : SptfqmrMalloc + * ----------------------------------------------------------------- + * SptfqmrMalloc allocates additional memory needed by the SPTFQMR + * linear solver module. + * + * l_max maximum Krylov subspace dimension that SptfqmrSolve will + * be permitted to use + * + * vec_tmpl implementation-specific template vector (type N_Vector) + * (created using either N_VNew_Serial or N_VNew_Parallel) + * + * If successful, SptfqmrMalloc returns a non-NULL memory pointer. If + * an error occurs, then a NULL pointer is returned. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT SptfqmrMem SptfqmrMalloc(int l_max, N_Vector vec_tmpl); + +/* + * ----------------------------------------------------------------- + * Function : SptfqmrSolve + * ----------------------------------------------------------------- + * SptfqmrSolve solves the linear system Ax = b by means of a scaled + * preconditioned Transpose-Free Quasi-Minimal Residual (SPTFQMR) + * method. + * + * mem pointer to an internal memory block allocated during a + * prior call to SptfqmrMalloc + * + * A_data pointer to a data structure containing information + * about the coefficient matrix A (passed to user-supplied + * function referenced by atimes (function pointer)) + * + * x vector (type N_Vector) containing initial guess x_0 upon + * entry, but which upon return contains an approximate solution + * of the linear system Ax = b (solution only valid if return + * value is either SPTFQMR_SUCCESS or SPTFQMR_RES_REDUCED) + * + * b vector (type N_Vector) set to the right-hand side vector b + * of the linear system (undisturbed by function) + * + * pretype variable (type int) indicating the type of + * preconditioning to be used (see sundials_iterative.h) + * + * delta tolerance on the L2 norm of the scaled, preconditioned + * residual (if return value == SPTFQMR_SUCCESS, then + * ||sb*P1_inv*(b-Ax)||_L2 <= delta) + * + * P_data pointer to a data structure containing preconditioner + * information (passed to user-supplied function referenced + * by psolve (function pointer)) + * + * sx vector (type N_Vector) containing positive scaling factors + * for x (pass sx == NULL if scaling NOT required) + * + * sb vector (type N_Vector) containing positive scaling factors + * for b (pass sb == NULL if scaling NOT required) + * + * atimes user-supplied routine responsible for computing the + * matrix-vector product Ax (see sundials_iterative.h) + * + * psolve user-supplied routine responsible for solving the + * preconditioned linear system Pz = r (ignored if + * pretype == PREC_NONE) (see sundials_iterative.h) + * + * res_norm pointer (type realtype*) to the L2 norm of the + * scaled, preconditioned residual (if return value + * is either SPTFQMR_SUCCESS or SPTFQMR_RES_REDUCED, then + * *res_norm = ||sb*P1_inv*(b-Ax)||_L2, where x is + * the computed approximate solution, sb is the diagonal + * scaling matrix for the right-hand side b, and P1_inv + * is the inverse of the left-preconditioner matrix) + * + * nli pointer (type int*) to the total number of linear + * iterations performed + * + * nps pointer (type int*) to the total number of calls made + * to the psolve routine + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT int SptfqmrSolve(SptfqmrMem mem, void *A_data, N_Vector x, N_Vector b, + int pretype, realtype delta, void *P_data, N_Vector sx, + N_Vector sb, ATimesFn atimes, PSolveFn psolve, + realtype *res_norm, int *nli, int *nps); + +/* Return values for SptfqmrSolve */ + +#define SPTFQMR_SUCCESS 0 /* SPTFQMR algorithm converged */ +#define SPTFQMR_RES_REDUCED 1 /* SPTFQMR did NOT converge, but the + residual was reduced */ +#define SPTFQMR_CONV_FAIL 2 /* SPTFQMR algorithm failed to converge */ +#define SPTFQMR_PSOLVE_FAIL_REC 3 /* psolve failed recoverably */ +#define SPTFQMR_ATIMES_FAIL_REC 4 /* atimes failed recoverably */ +#define SPTFQMR_PSET_FAIL_REC 5 /* pset faild recoverably */ + +#define SPTFQMR_MEM_NULL -1 /* mem argument is NULL */ +#define SPTFQMR_ATIMES_FAIL_UNREC -2 /* atimes returned failure flag */ +#define SPTFQMR_PSOLVE_FAIL_UNREC -3 /* psolve failed unrecoverably */ +#define SPTFQMR_PSET_FAIL_UNREC -4 /* pset failed unrecoverably */ + +/* + * ----------------------------------------------------------------- + * Function : SptfqmrFree + * ----------------------------------------------------------------- + * SptfqmrFree frees the memory allocated by a call to SptfqmrMalloc. + * It is illegal to use the pointer mem after a call to SptfqmrFree. + * ----------------------------------------------------------------- + */ + +SUNDIALS_EXPORT void SptfqmrFree(SptfqmrMem mem); + +/* + * ----------------------------------------------------------------- + * Macro : SPTFQMR_VTEMP + * ----------------------------------------------------------------- + * This macro provides access to the work vector vtemp1 in the + * memory block of the SPTFQMR module. The argument mem is the + * memory pointer returned by SptfqmrMalloc, of type SptfqmrMem, + * and the macro value is of type N_Vector. + * + * Note: Only used by IDA (vtemp1 contains P_inverse F if + * nli_inc == 0). + * ----------------------------------------------------------------- + */ + +#define SPTFQMR_VTEMP(mem) (mem->vtemp1) + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/sundials/sundials_types.h b/odemex/Parser/CVode/ida_src/include/sundials/sundials_types.h new file mode 100644 index 0000000..953f6e0 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/sundials/sundials_types.h @@ -0,0 +1,122 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2006/11/29 00:05:07 $ + * ----------------------------------------------------------------- + * Programmer(s): Scott Cohen, Alan Hindmarsh, Radu Serban, and + * Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + *------------------------------------------------------------------ + * This header file exports two types: realtype and booleantype, + * as well as the constants TRUE and FALSE. + * + * Users should include the header file sundials_types.h in every + * program file and use the exported name realtype instead of + * float, double or long double. + * + * The constants SUNDIALS_SINGLE_PRECISION, SUNDIALS_DOUBLE_PRECISION + * and SUNDIALS_LONG_DOUBLE_PRECISION indicate the underlying data + * type of realtype. It is set at the configuration stage. + * + * The legal types for realtype are float, double and long double. + * + * The macro RCONST gives the user a convenient way to define + * real-valued constants. To use the constant 1.0, for example, + * the user should write the following: + * + * #define ONE RCONST(1.0) + * + * If realtype is defined as a double, then RCONST(1.0) expands + * to 1.0. If realtype is defined as a float, then RCONST(1.0) + * expands to 1.0F. If realtype is defined as a long double, + * then RCONST(1.0) expands to 1.0L. There is never a need to + * explicitly cast 1.0 to (realtype). + *------------------------------------------------------------------ + */ + +#ifndef _SUNDIALSTYPES_H +#define _SUNDIALSTYPES_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#ifndef _SUNDIALS_CONFIG_H +#define _SUNDIALS_CONFIG_H +#include +#endif + +#include + +/* + *------------------------------------------------------------------ + * Type realtype + * Macro RCONST + * Constants BIG_REAL, SMALL_REAL, and UNIT_ROUNDOFF + *------------------------------------------------------------------ + */ + +#if defined(SUNDIALS_SINGLE_PRECISION) + +typedef float realtype; +# define RCONST(x) x##F +# define BIG_REAL FLT_MAX +# define SMALL_REAL FLT_MIN +# define UNIT_ROUNDOFF FLT_EPSILON + +#elif defined(SUNDIALS_DOUBLE_PRECISION) + +typedef double realtype; +# define RCONST(x) x +# define BIG_REAL DBL_MAX +# define SMALL_REAL DBL_MIN +# define UNIT_ROUNDOFF DBL_EPSILON + +#elif defined(SUNDIALS_EXTENDED_PRECISION) + +typedef long double realtype; +# define RCONST(x) x##L +# define BIG_REAL LDBL_MAX +# define SMALL_REAL LDBL_MIN +# define UNIT_ROUNDOFF LDBL_EPSILON + +#endif + +/* + *------------------------------------------------------------------ + * Type : booleantype + *------------------------------------------------------------------ + * Constants : FALSE and TRUE + *------------------------------------------------------------------ + * ANSI C does not have a built-in boolean data type. Below is the + * definition for a new type called booleantype. The advantage of + * using the name booleantype (instead of int) is an increase in + * code readability. It also allows the programmer to make a + * distinction between int and boolean data. Variables of type + * booleantype are intended to have only the two values FALSE and + * TRUE which are defined below to be equal to 0 and 1, + * respectively. + *------------------------------------------------------------------ + */ + +#ifndef booleantype +#define booleantype int +#endif + +#ifndef FALSE +#define FALSE 0 +#endif + +#ifndef TRUE +#define TRUE 1 +#endif + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/include/sundials/winDefine.h b/odemex/Parser/CVode/ida_src/include/sundials/winDefine.h new file mode 100644 index 0000000..dcd0e20 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/include/sundials/winDefine.h @@ -0,0 +1,44 @@ +// +// Joep Vanlier, 2011 +// +// Licensing: +// Copyright (C) 2009-2011 Joep Vanlier. All rights +// reserved. +// +// Contact:joep.vanlier@gmail.com +// +// This file is part of the puaMAT. +// +// puaMAT is free software: you can redistribute it +// and/or modify it under the terms of the GNU General +// Public License as published by the Free Software +// Foundation, either version 3 of the License, or (at +// your option) any later version. +// +// puaMAT is distributed in the hope that it will be +// useful, but WITHOUT ANY WARRANTY; without even the +// implied warranty of MERCHANTABILITY or FITNESS FOR A +// PARTICULAR PURPOSE. See the GNU General Public +// License for more details. +// +// You should have received a copy of the GNU General +// Public License along with puaMAT. If not, see +// http://www.gnu.org/licenses/ +// + + + #define dcopy_ dcopy + #define dscal_ dscal + #define dgemv_ dgemv + #define dtrsv_ dtrsv + #define dgetrf_ dgetrf + #define dgetrs_ dgetrs + #define dgbtrs_ dgbtrs + #define dgbtrf_ dgbtrf + #define dsyrk_ dsyrk + #define dgeqp3_ dgeqp3 + #define dormqr_ dormqr + #define dpotrf_ dpotrf_ + #define dgeqrf_ dgeqrf + #define dpotrs_ dpotrs + diff --git a/odemex/Parser/CVode/ida_src/src/ida/CMakeLists.txt b/odemex/Parser/CVode/ida_src/src/ida/CMakeLists.txt new file mode 100644 index 0000000..438ee2d --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/CMakeLists.txt @@ -0,0 +1,125 @@ +# --------------------------------------------------------------- +# $Revision: 1.4 $ +# $Date: 2009/02/17 02:58:48 $ +# --------------------------------------------------------------- +# Programmer: Radu Serban @ LLNL +# --------------------------------------------------------------- +# Copyright (c) 2007, The Regents of the University of California. +# Produced at the Lawrence Livermore National Laboratory. +# All rights reserved. +# For details, see the LICENSE file. +# --------------------------------------------------------------- +# CMakeLists.txt file for the IDA library + +INSTALL(CODE "MESSAGE(\"\nInstall IDA\n\")") + +# Add variable ida_SOURCES with the sources for the IDA library +SET(ida_SOURCES + ida.c + ida_io.c + ida_ic.c + ida_direct.c + ida_band.c + ida_dense.c + ida_spils.c + ida_spbcgs.c + ida_spgmr.c + ida_sptfqmr.c + ida_bbdpre.c + ) + +# Add variable shared_SOURCES with the common SUNDIALS sources which will +# also be included in the IDA library +SET(shared_SOURCES + sundials_nvector.c + sundials_math.c + sundials_direct.c + sundials_band.c + sundials_dense.c + sundials_iterative.c + sundials_spbcgs.c + sundials_spgmr.c + sundials_sptfqmr.c + ) + +# Add prefix with complete path to the common SUNDIALS sources +ADD_PREFIX(${sundials_SOURCE_DIR}/src/sundials/ shared_SOURCES) + +# Add variable ida_HEADERS with the exported IDA header files +SET(ida_HEADERS + ida_band.h + ida_bbdpre.h + ida_dense.h + ida_direct.h + ida.h + ida_spbcgs.h + ida_spgmr.h + ida_spils.h + ida_sptfqmr.h + ) + +# Add prefix with complete path to the IDA header files +ADD_PREFIX(${sundials_SOURCE_DIR}/include/ida/ ida_HEADERS) + +# If Blas/Lapack support was enabled, set-up additional file lists +IF(LAPACK_FOUND) + SET(ida_BL_SOURCES ida_lapack.c) + SET(ida_BL_HEADERS ida_lapack.h) + ADD_PREFIX(${sundials_SOURCE_DIR}/include/ida/ ida_BL_HEADERS) +ELSE(LAPACK_FOUND) + SET(ida_BL_SOURCES "") + SET(ida_BL_HEADERS "") +ENDIF(LAPACK_FOUND) + +# Add source directories to include directories for access to +# implementation only header files. +INCLUDE_DIRECTORIES(.) +INCLUDE_DIRECTORIES(../sundials) + +# Define C preprocessor flag -DBUILD_SUNDIALS_LIBRARY +ADD_DEFINITIONS(-DBUILD_SUNDIALS_LIBRARY) + +# Build the static library +IF(BUILD_STATIC_LIBS) + + # Add the build target for the static IDA library + ADD_LIBRARY(sundials_ida_static STATIC + ${ida_SOURCES} ${ida_BL_SOURCES} ${shared_SOURCES}) + + # Set the library name and make sure it is not deleted + SET_TARGET_PROPERTIES(sundials_ida_static + PROPERTIES OUTPUT_NAME sundials_ida CLEAN_DIRECT_OUTPUT 1) + + # Install the IDA library + INSTALL(TARGETS sundials_ida_static DESTINATION lib) + +ENDIF(BUILD_STATIC_LIBS) + +# Build the shared library +IF(BUILD_SHARED_LIBS) + + # Add the build target for the IDA library + ADD_LIBRARY(sundials_ida_shared SHARED + ${ida_SOURCES} ${ida_BL_SOURCES} ${shared_SOURCES}) + + # Set the library name and make sure it is not deleted + SET_TARGET_PROPERTIES(sundials_ida_shared + PROPERTIES OUTPUT_NAME sundials_ida CLEAN_DIRECT_OUTPUT 1) + + # Set VERSION and SOVERSION for shared libraries + SET_TARGET_PROPERTIES(sundials_ida_shared + PROPERTIES VERSION ${idalib_VERSION} SOVERSION ${idalib_SOVERSION}) + + # Install the IDA library + INSTALL(TARGETS sundials_ida_shared DESTINATION lib) + +ENDIF(BUILD_SHARED_LIBS) + +# Install the IDA header files +INSTALL(FILES ${ida_HEADERS} ${ida_BL_HEADERS} DESTINATION include/ida) + +# Install the IDA implementation header file +INSTALL(FILES ida_impl.h DESTINATION include/ida) + +# +MESSAGE(STATUS "Added IDA module") diff --git a/odemex/Parser/CVode/ida_src/src/ida/LICENSE b/odemex/Parser/CVode/ida_src/src/ida/LICENSE new file mode 100644 index 0000000..d50d177 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/LICENSE @@ -0,0 +1,59 @@ +Copyright (c) 2002, The Regents of the University of California. +Produced at the Lawrence Livermore National Laboratory. +Written by Alan Hindmarsh, Allan Taylor, Radu Serban. +UCRL-CODE-155952 +All rights reserved. + +This file is part of IDA. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the disclaimer below. + +2. Redistributions in binary form must reproduce the above copyright +notice, this list of conditions and the disclaimer (as noted below) +in the documentation and/or other materials provided with the +distribution. + +3. Neither the name of the UC/LLNL nor the names of its contributors +may be used to endorse or promote products derived from this software +without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS +FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE +REGENTS OF THE UNIVERSITY OF CALIFORNIA, THE U.S. DEPARTMENT OF ENERGY +OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +Additional BSD Notice +--------------------- +1. This notice is required to be provided under our contract with +the U.S. Department of Energy (DOE). This work was produced at the +University of California, Lawrence Livermore National Laboratory +under Contract No. W-7405-ENG-48 with the DOE. + +2. Neither the United States Government nor the University of +California nor any of their employees, makes any warranty, express +or implied, or assumes any liability or responsibility for the +accuracy, completeness, or usefulness of any information, apparatus, +product, or process disclosed, or represents that its use would not +infringe privately-owned rights. + +3. Also, reference herein to any specific commercial products, +process, or services by trade name, trademark, manufacturer or +otherwise does not necessarily constitute or imply its endorsement, +recommendation, or favoring by the United States Government or the +University of California. The views and opinions of authors expressed +herein do not necessarily state or reflect those of the United States +Government or the University of California, and shall not be used for +advertising or product endorsement purposes. diff --git a/odemex/Parser/CVode/ida_src/src/ida/Makefile.in b/odemex/Parser/CVode/ida_src/src/ida/Makefile.in new file mode 100644 index 0000000..8c83d7a --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/Makefile.in @@ -0,0 +1,169 @@ +# ----------------------------------------------------------------- +# $Revision: 1.12 $ +# $Date: 2009/03/25 23:10:50 $ +# ----------------------------------------------------------------- +# Programmer(s): Radu Serban and Aaron Collier @ LLNL +# ----------------------------------------------------------------- +# Copyright (c) 2002, The Regents of the University of California. +# Produced at the Lawrence Livermore National Laboratory. +# All rights reserved. +# For details, see the LICENSE file. +# ----------------------------------------------------------------- +# Makefile for IDA module +# +# @configure_input@ +# ----------------------------------------------------------------- + +SHELL = @SHELL@ + +@SET_MAKE@ + +srcdir = @srcdir@ +builddir = @builddir@ +abs_builddir = @abs_builddir@ +top_builddir = @top_builddir@ +prefix = @prefix@ +exec_prefix = @exec_prefix@ +includedir = @includedir@ +libdir = @libdir@ + +INSTALL = @INSTALL@ +INSTALL_LIB = @INSTALL_PROGRAM@ +INSTALL_HEADER = @INSTALL_DATA@ + +LIBTOOL = @LIBTOOL@ +LIBTOOL_DEPS = @LIBTOOL_DEPS@ + +CPP = @CPP@ +CPPFLAGS = @CPPFLAGS@ +CC = @CC@ +CFLAGS = @CFLAGS@ +LDFLAGS = @LDFLAGS@ +LIBS = @LIBS@ + +LAPACK_ENABLED = @LAPACK_ENABLED@ + +top_srcdir = $(srcdir)/../.. + +INCLUDES = -I$(top_srcdir)/include -I$(top_builddir)/include + +LIB_REVISION = 2:0:0 + +IDA_LIB = libsundials_ida.la + +IDA_SRC_FILES = ida.c ida_ic.c ida_io.c ida_direct.c ida_dense.c ida_band.c ida_spils.c ida_spbcgs.c ida_spgmr.c ida_sptfqmr.c ida_bbdpre.c +IDA_BL_SRC_FILES = ida_lapack.c + +IDA_OBJ_FILES = $(IDA_SRC_FILES:.c=.o) +IDA_BL_OBJ_FILES = $(IDA_BL_SRC_FILES:.c=.o) + +IDA_LIB_FILES = $(IDA_SRC_FILES:.c=.lo) +IDA_BL_LIB_FILES = $(IDA_BL_SRC_FILES:.c=.lo) + +SHARED_LIB_FILES = $(top_builddir)/src/sundials/sundials_band.lo \ + $(top_builddir)/src/sundials/sundials_dense.lo \ + $(top_builddir)/src/sundials/sundials_direct.lo \ + $(top_builddir)/src/sundials/sundials_iterative.lo \ + $(top_builddir)/src/sundials/sundials_spgmr.lo \ + $(top_builddir)/src/sundials/sundials_spbcgs.lo \ + $(top_builddir)/src/sundials/sundials_sptfqmr.lo \ + $(top_builddir)/src/sundials/sundials_math.lo \ + $(top_builddir)/src/sundials/sundials_nvector.lo + +mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs +rminstalldirs = $(SHELL) $(top_srcdir)/config/rminstalldirs + +# ---------------------------------------------------------------------------------------------------------------------- + +all: $(IDA_LIB) + +$(IDA_LIB): shared $(IDA_LIB_FILES) + @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ + make lib_with_bl; \ + else \ + make lib_without_bl; \ + fi + +lib_without_bl: shared $(IDA_LIB_FILES) + $(LIBTOOL) --mode=link $(CC) $(CFLAGS) -o $(IDA_LIB) $(IDA_LIB_FILES) $(SHARED_LIB_FILES) -rpath $(libdir) $(LDFLAGS) $(LIBS) -version-info $(LIB_REVISION) + +lib_with_bl: shared $(IDA_LIB_FILES) $(IDA_BL_LIB_FILES) + $(LIBTOOL) --mode=link $(CC) $(CFLAGS) -o $(IDA_LIB) $(IDA_LIB_FILES) $(IDA_BL_LIB_FILES) $(SHARED_LIB_FILES) -rpath $(libdir) $(LDFLAGS) $(LIBS) -version-info $(LIB_REVISION) + +install: $(IDA_LIB) + $(mkinstalldirs) $(includedir)/ida + $(mkinstalldirs) $(libdir) + $(LIBTOOL) --mode=install $(INSTALL_LIB) $(IDA_LIB) $(libdir) + $(INSTALL_HEADER) $(top_srcdir)/include/ida/ida.h $(includedir)/ida/ + $(INSTALL_HEADER) $(top_srcdir)/include/ida/ida_direct.h $(includedir)/ida/ + $(INSTALL_HEADER) $(top_srcdir)/include/ida/ida_dense.h $(includedir)/ida/ + $(INSTALL_HEADER) $(top_srcdir)/include/ida/ida_band.h $(includedir)/ida/ + $(INSTALL_HEADER) $(top_srcdir)/include/ida/ida_spbcgs.h $(includedir)/ida/ + $(INSTALL_HEADER) $(top_srcdir)/include/ida/ida_spgmr.h $(includedir)/ida/ + $(INSTALL_HEADER) $(top_srcdir)/include/ida/ida_sptfqmr.h $(includedir)/ida/ + $(INSTALL_HEADER) $(top_srcdir)/include/ida/ida_bbdpre.h $(includedir)/ida/ + $(INSTALL_HEADER) $(top_srcdir)/include/ida/ida_spils.h $(includedir)/ida/ + $(INSTALL_HEADER) $(top_srcdir)/src/ida/ida_impl.h $(includedir)/ida/ + @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ + $(INSTALL_HEADER) $(top_srcdir)/include/ida/ida_lapack.h $(includedir)/ida/ ; \ + fi + +uninstall: + $(LIBTOOL) --mode=uninstall rm -f $(libdir)/$(IDA_LIB) + rm -f $(includedir)/ida/ida.h + rm -f $(includedir)/ida/ida_direct.h + rm -f $(includedir)/ida/ida_dense.h + rm -f $(includedir)/ida/ida_band.h + rm -f $(includedir)/ida/ida_lapack.h + rm -f $(includedir)/ida/ida_spbcgs.h + rm -f $(includedir)/ida/ida_spgmr.h + rm -f $(includedir)/ida/ida_sptfqmr.h + rm -f $(includedir)/ida/ida_bbdpre.h + rm -f $(includedir)/ida/ida_spils.h + rm -f $(includedir)/ida/ida_impl.h + $(rminstalldirs) ${includedir}/ida + +shared: + @cd ${top_builddir}/src/sundials ; \ + ${MAKE} ; \ + cd ${abs_builddir} + +clean: + $(LIBTOOL) --mode=clean rm -f $(IDA_LIB) + rm -f $(IDA_LIB_FILES) + rm -f $(IDA_BL_LIB_FILES) + rm -f $(IDA_OBJ_FILES) + rm -f $(IDA_BL_OBJ_FILES) + +distclean: clean + rm -f Makefile + +ida.lo: $(srcdir)/ida.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/ida.c +ida_ic.lo: $(srcdir)/ida_ic.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/ida_ic.c +ida_io.lo: $(srcdir)/ida_io.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/ida_io.c +ida_direct.lo: $(srcdir)/ida_direct.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/ida_direct.c +ida_dense.lo: $(srcdir)/ida_dense.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/ida_dense.c +ida_band.lo: $(srcdir)/ida_band.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/ida_band.c +ida_lapack.lo: $(srcdir)/ida_lapack.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/ida_lapack.c +ida_spils.lo: $(srcdir)/ida_spils.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/ida_spils.c +ida_spbcgs.lo: $(srcdir)/ida_spbcgs.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/ida_spbcgs.c +ida_spgmr.lo: $(srcdir)/ida_spgmr.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/ida_spgmr.c +ida_sptfqmr.lo: $(srcdir)/ida_sptfqmr.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/ida_sptfqmr.c +ida_bbdpre.lo: $(srcdir)/ida_bbdpre.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/ida_bbdpre.c + +libtool: $(top_builddir)/$(LIBTOOL_DEPS) + @cd ${top_builddir} ; \ + ${SHELL} ./config.status --recheck ; \ + cd ${abs_builddir} diff --git a/odemex/Parser/CVode/ida_src/src/ida/README b/odemex/Parser/CVode/ida_src/src/ida/README new file mode 100644 index 0000000..cbe1d4d --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/README @@ -0,0 +1,364 @@ + IDA + Release 2.6.0, January 2008 + Alan C. Hindmarsh and Radu Serban + Center for Applied Scientific Computing, LLNL + + +IDA is a package for the solution of differential-algebraic equation +(DAE) systems. It is written in C, but derived from the package DASPK +[4,5], which is written in FORTRAN. + +IDA can be used both on serial and parallel (MPI) computers. The main +difference is in the NVECTOR module of vector kernels. The desired +version is obtained when compiling the example files by linking the +appropriate library of NVECTOR kernels. In the parallel version, +communication between processors is done with the MPI (Message Passage +Interface) system. + +When used with the serial NVECTOR module, IDA provides both direct +(dense and band) linear solvers and preconditioned Krylov (iterative) +linear solvers. Three different iterative solvers are available: scaled +preconditioned GMRES (SPGMR), scaled preconditioned BiCGStab (SPBCG), and +scaled preconditioned TFQMR (SPTFQMR). When IDA is used with the parallel +NVECTOR module, only the Krylov linear solvers are available. For the +latter case, in addition to the basic solver, the IDA package also contains +a preconditioner module called IDABBDPRE, which provides a band-block-diagonal +preconditioner. + +IDA is part of a software family called SUNDIALS: SUite of Nonlinear and +DIfferential/ALgebraic equation Solvers [3]. This suite consists of CVODE, +CVODES, IDA, IDAS, and KINSOL. The directory structure of the package supplied +reflects this family relationship. + +For use with Fortran applications, a set of Fortran/C interface routines, +called FIDA, is also supplied. These are written in C, but assume that +the user calling program and all user-supplied routines are in Fortran. + +Several examples problem programs are included, covering both serial +and parallel cases, both small and large problem sizes, and both +linear and nonlinear problems. + +The notes below provide the location of documentation, directions for the +installation of the IDA package, and relevant references. Following that +is a brief history of revisions to the package. + + +A. Documentation +---------------- + +/sundials/doc/ida/ contains PDF files for the IDA User Guide [1] (ida_guide.pdf) +and the IDA Examples [2] (ida_examples.pdf) documents. + + +B. Installation +--------------- + +For basic installation instructions see the file /sundials/INSTALL_NOTES. +For complete installation instructions see the "IDA Installation Procedure" +chapter in the IDA User Guide. + + +C. References +------------- + +[1] A. C. Hindmarsh, R. Serban, and A. Collier, "User Documentation for IDA v2.4.0," + LLNL technical report UCRL-SM-208112, November 2004. + +[2] A. C. Hindmarsh, R. Serban, and A. Collier, "Example Programs for IDA v2.4.0," + LLNL technical report UCRL-SM-208113, November 2004. + +[3] A. C. Hindmarsh, P. N. Brown, K. E. Grant, S. L. Lee, R. Serban, + D. E. Shumaker, and C. S. Woodward, "SUNDIALS, Suite of Nonlinear and + Differential/Algebraic Equation Solvers," ACM Trans. Math. Softw., + 31(3), pp. 363-396, 2005. + +[4] P. N. Brown, A. C. Hindmarsh, and L. R. Petzold, Using Krylov Methods + in the Solution of Large-Scale Differential-Algebraic Systems, + SIAM J. Sci. Comp., 15 (1994), pp. 1467-1488. + +[5] P. N. Brown, A. C. Hindmarsh, and L. R. Petzold, Consistent Initial + Condition Calculation for Differential-Algebraic Systems, + SIAM J. Sci. Comp., 19 (1998), pp. 1495-1512. + + +D. Releases +----------- + +v. 2.6.0 - Jan. 2008 +v. 2.5.0 - Nov. 2006 +v. 2.4.0 - Mar. 2006 +v. 2.3.0 - Apr. 2005 +v. 2.2.2 - Mar. 2005 +v. 2.2.1 - Jan. 2005 +v. 2.2.0 - Dec. 2004 +v. 2.0 - Jul. 2002 (first SUNDIALS release) +v. 1.0 - Feb. 1999 (date written) + + +E. Revision History +------------------- + +v. 2.5.0 (Nov. 2006) ---> v. 2.6.0 (Jan. 2008) +--------------------------------------------------------- + +- New features + - added a new linear solver module based on Blas + Lapack for + both dense and banded matrices. + - added optional input to specify which direction of zero-crossing + is to be monitored while performing root-finding. The root information + array iroots (returned by IDAGetRootInfo) also encodes the + direction of zero-crossing. + +- Bug fixes + - in the rootfinding algorithm, fixed a bug resulting in unnecessary + evaluations of the root functions after reinitialization of the + solver right after a return at a root. + +- Changes to user interface + - renamed all **Malloc functions to **Init + - tolerances are now specified through separate functions instead of + the initialization functions IDAInit (former IDAMalloc) and + IDAReInit. Depending on the tolerance type, one of 3 functions + must be called before the first call to IDASolve. + - removed function inputs from argument lists of all re-initialization + functions. + - all user-supplied functions now receive the same pointer to user data + (instead of having different ones for the system evaluation, Jacobian + information functions, etc.) + - removed IDA_NORMAL_TSTOP and IDA_ONE_STEP_TSTOP named constants for the + itask argument to IDASolve. A tstop value is now both set and activated + through IDASetStopTime. Once tstop is reached it is also deactivated. + A new value can be then spcified by calling again IDASetStopTime. + - common functionality for all direct linear solvers (dense, band, and + the new Lapack solver) has been collected into the DLS (Direct Linear + Solver) module, similar to the SPILS module for the iterative linear + solvers. All optional input and output functions for these linear + solver now have the prefix 'IDADls'. In addition, in order to include + the new Lapack-based linear solver, all dimensions for these linear + solvers (problem sizes, bandwidths, etc) are now of type 'int' + (instead of 'long int'). + - the initialization function for the preconditioner module IDABBDPRE + was renamed IDABBDInit (from IDABBDAlloc) and it does not return + a pointer to preconditioner memory anymore. Instead, all preconditioner + module-related functions are now called with the main solver memory + pointer as their first argument. When using the IDABBDPRE module, + there is no need to use special functions to attach one of the SPILS + linear solvers (instead use one of IDASpgmr, IDASpbcg, or IDASptfqmr). + Moreover, there is no need to call a memory deallocation function for + the preconditioner module. + - changes corresponding to the above were made to the FCMIX interface. + +v. 2.4.0 (Mar. 2006) ---> v. 2.5.0 (Oct. 2006) +--------------------------------------------------------- + +- Bug fixes + - fixed wrong logic in final stopping tests: now we check if + tout was reached before checking if tstop was reached. + - added a roundoff factor when testing whether tn was just returned + (in root finding) to prevent an unnecessary return. + - fixed perturbation factor "underflow" issue in IDADenseDQJac and + IDABandDQJac routines which are used to compute a difference quotient + approximation to the system Jacobian (see IDA_P1). + +- Changes related to the build system + - reorganized source tree: header files in ${srcdir}/include/ida, + source files in ${srcdir}/src/ida, fcmix source files in + ${srcdir}/src/ida/fcmix, examples in ${srcdir}/examples/ida + - exported header files are installed unde ${includedir}/ida + +- Changes to user interface + - all included header files use relative paths from ${includedir} + - modified prototype and implementation of IDACalcIC (removed + arguments t0, yy0, yp0). IDACalcIC will always correct the + initial conditions passed through IDAMalloc (or IDAReInit) + which were stored in the Nordsieck history array + - added optional output IDAGetConsistentIC function (which can + only be called before any IDASolve calls) to obtain the corrected + initial conditions. + +v. 2.3.0 (Apr. 2005) ---> v. 2.4.0 (Mar. 2006) +--------------------------------------------------------- + +- New features + - added IDASPBCG interface module to allow IDA to interface with the + shared SPBCG (scaled preconditioned Bi-CGSTAB) linear solver module. + - added IDASPTFQMR interface module to allow IDA to interface with the + shared SPTFQMR (scaled preconditioned TFQMR) linear solver module. + - added support for SPBCG and SPTFQMR to the IDABBDPRE preconditioner module. + - added FIDA (Fortran interface to IDA). + - added rootfinding feature in IDA; modified irobx example problem. + - added support for interpreting failures in user-supplied functions. + +- Changes to user-callable functions + - changed argument of IDAFree and IDABBDPrecFree to be the address + of the respective memory block pointer, so that its NULL value is + propagated back to the calling function. + - added IDASPBCG module which defines appropriate IDSpbcg* functions to + allow IDA to interface with the shared SPBCG linear solver module. + - added IDABBDSpbcg function to IDABBDPRE module to support SPBCG linear + solver module. + - changed function type names (not the actual definition) to accomodate + all the Scaled Preconditioned Iterative Linear Solvers now available: + IDASpgmrJactimesVecFn -> IDASpilsJacTimesVecFn + IDASpgmrPrecSetupFn -> IDASpilsPrecSetupFn + IDASpgmrPrecSolveFn -> IDASpilsPrecSolveFn + - changed some names for IDABBDPRE function outputs + - added option for user-supplied error handler function. + - added IDAGetEstLocalErrors() to return estimated local errors. + - renamed all exported header files (except for ida.h, all header files + have the prefix 'ida_') + - changed naming scheme for IDA examples + +- Changes related to the build system + - the main IDA header file (ida.h) is still exported to the install include + directory. However, all other IDA header files are exported into an 'ida' + subdirectory of the install include directory. + - the IDA library now contains all shared object files (there is no separate + libsundials_shared library anymore) + +v. 2.2.2 (Mar. 2005) ---> v. 2.3.0 (Apr. 2005) +---------------------------------------------- + +- New features + - added option for user-provided error weight computation function + (of type IDAEwtFn specified through IDASetEwtFn). + +- Changes to user interface + - IDA now stores tolerances through values rather than references + (to resolve potential scoping issues). + - IDA now stores the constraints and id vectors (if defined) through + values ratherthan references. + - IDA now passes information back to the user through values rather + than references (error weights) + - IDAMalloc, IDAReInit, IDASetTolerances: added option itol=IDA_WF + to indicate user-supplied function for computing the error weights; + reltol is now declared as realtype. Note that it is now illegal to call + IDASetTolerances before IDAMalloc. It is now legal to deallocate + the absolute tolerance N_Vector right after its use. + - IDAGetErrorWeights: the user is now responsible for allocating space + for the N_Vector in which error weights will be copied. + - IDACalcIC takes as additional arguments (t0,y0,yp0). As a consequence, + it can be called at any time to correct a pair (y,y'). + - Passing a value of 0 for the maximum step size or for maxsteps results + in the solver using the corresponding default value (infinity, and 500, + respectively) + - Several optional input functions were combined into a single one + (IDADenseSetJacFn and IDADenseSetJacData, IDABandSetJacFn and IDABandSetJacData, + IDASpgmrSetPrecSolveFn and IDASpgmrSetPrecSetFn and IDASpgmrSetPrecData, + IDASpgmrSetJacTimesVecFn and IDASpgmrSetJacData). + +v. 2.2.1 (Jan. 2005) ---> v. 2.2.2 (Mar. 2005) +---------------------------------------------- + +- Bug fixes + - changed implicit type conversion to explicit in check_flag() routine in + examples to avoid C++ compiler errors + +- Changes to documentation + - added section with numerical values of all input and output solver constants + - added more detailed notes on the type of absolute tolerances + - fixed several typos and removed reference to inexistent function IDASetMinStep + - added description of --with-mpi-flags option + +- Changes related to the build system + - fixed autoconf-related bug to allow configuration with the PGI Fortran compiler + - modified to use customized detection of the Fortran name mangling scheme + (autoconf's AC_F77_WRAPPERS routine is problematic on some platforms) + - added --with-mpi-flags as a configure option to allow user to specify + MPI-specific flags + - updated Makefiles for Fortran examples to avoid C++ compiler errors (now use + CC and MPICC to link) + + +v. 2.2.0 (Dec. 2004) ---> v. 2.2.1 (Jan. 2005) +---------------------------------------------- + +- Changes related to the build system + - changed order of compiler directives in header files to avoid compilation + errors when using a C++ compiler. + +- Changes to documentation + - fixed various mistakes and typos in the user guide and example program + documents. + +v. 2.0 (Jul. 2002) ---> v. 2.2.0 (Dec. 2004) +-------------------------------------------- + +- New features + - added option to disable all error messages. + +- Bug fixes + - in the solution of the nonlinear system, the correction for small constraint + violation is to ee, not y. + - besides delaying the order increase until the 2nd step, we now also delay + doubling the step size, to avoid using information from times before t0. + +- Changes related to the NVECTOR module + (see also the file sundials/shared/README) + - removed machEnv, redefined table of vector operations (now contained + in the N_Vector structure itself). + - all IDA functions create new N_Vector variables through cloning, using + an N_Vector passed by the user as a template. + +- Changes to type names and IDA constants + - removed type 'integertype'; instead use int or long int, as appropriate. + - restructured the list of return values from the various IDA functions. + - changed all IDA constants (inputs and return values) to have the + prefix 'IDA_' (e.g. IDA_SUCCESS). + - renamed various function types to have the prefix 'IDA' (e.g. IDAResFn). + +- Changes to optional input/ouput + - added IDASet* and IDAGet* functions for optional inputs/outputs, + replacing the arrays iopt and ropt. + - added new optional inputs (e.g. maximum number of Newton iterations, + maximum number of convergence failures, etc). + - added new function IDAGetSolution for dense output. + - the value of the last return flag from any function within a linear + solver module can be obtained as an optional output (e.g. IDADenseGetLastFlag). + +- Changes to user-callable functions + - added new function IDACreate which initializes the IDA solver + object and returns a pointer to the IDA memory block. + - removed N (problem size) from all functions except the initialization + functions for the direct linear solvers (IDADense and IDABand). + - shortened argument lists of most IDA functions (the arguments that + were dropped can now be specified through IDASet* functions). + - removed reinitialization functions for band/dense/SPGMR linear + solvers (same functionality can be obtained using IDA*Set* functions). + - in IDABBDPRE, added a new function, IDABBDSpgmr to initialize the + SPGMR linear solver with the BBD preconditioner. + - function names changed in IDABBDPRE for uniformity. + +- Changes to user-supplied functions + - removed N (probem dimension) from argument lists. + - shortened argument lists for user dense/band/SPGMR Jacobian routines. + - in IDASPGMR, shortened argument lists for user preconditioner functions. + - in IDABBDPRE, added Nlocal, the local vector size, as an argument to + IDABBDLocalFn and IDABBDCommFn. + +v. 1.0 (Feb. 1999) ---> v. 2.0 (Jul. 2002) +------------------------------------------ + +YYYYMMDD + +19990212 DATE WRITTEN; initial internal release (incomplete). +19990514 IDABBDPRE preconditioner module added. +19990720 Initial condition calculation routines (IDACalcIC) added. +19991208 In IDABBDPRE, user routine argument lists changed. +19991217 Generic SPGMR module revised to correct scalings. +20000316 In parallel NVECTOR, comm arg. to PVecInitMPI is non-NULL. +20000808 Fixed bug in N_VMin. In IDACalcIC: added calculation of system + index in CALC_YA_YDP_INIT case, added scaling of fnorm when index = 0. +20010110 Fixed two bugs in IDACalcIC and subordinate routines: + (1) Set hh in IDACalcIC independent of icopt, for lsetup. + (2) Set ypnew = yp0 in IDALineSrch in CALC_Y_INIT case. + Corrected #define ncfl0 line in idaspgmr.c. +20011015 Fixed bug in IDAInterp (tn test). + Fixed minor bugs in error messages (missing arguments etc.) +20011220 Default type 'integer' changed to 'long int' in llnltyps.h. +20020313 Modified to work with new NVECTOR abstraction. +20020626 Renamed types real, integer, boole as realtype, integertype, + and booleantype, and renamed related constants. Renamed files + llnlmath.*, llnltypes.h as sundialsmath.*, sundialstypes.h. +20020703 Added reinitialization routines for IDA, for each linear + solver module, and for IDABBDPRE. diff --git a/odemex/Parser/CVode/ida_src/src/ida/fcmix/CMakeLists.txt b/odemex/Parser/CVode/ida_src/src/ida/fcmix/CMakeLists.txt new file mode 100644 index 0000000..d1a4ae5 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/fcmix/CMakeLists.txt @@ -0,0 +1,43 @@ +# CMakeLists.txt file for the FIDA library + +# Add variable fida_SOURCES with the sources for the FIDA library +SET(fida_SOURCES + fidaband.c + fidabbd.c + fida.c + fidadense.c + fidaewt.c + fidajtimes.c + fidapreco.c + fidaroot.c + ) + +IF(LAPACK_FOUND) + SET(fida_BL_SOURCES fidalapack.c fidalapdense.c fidalapband.c) +ELSE(LAPACK_FOUND) + SET(fida_BL_SOURCES "") +ENDIF(LAPACK_FOUND) + +# Add source directories to include directories for access to +# implementation only header files (both for fida and ida) +INCLUDE_DIRECTORIES(.) +INCLUDE_DIRECTORIES(..) + +# Define C preprocessor flag -DBUILD_SUNDIALS_LIBRARY +ADD_DEFINITIONS(-DBUILD_SUNDIALS_LIBRARY) + +# Only build STATIC libraries (we cannot build shared libraries +# for the FCMIX interfaces due to unresolved symbol errors +# coming from inexistent user-provided functions) + +# Add the build target for the FIDA library +ADD_LIBRARY(sundials_fida_static STATIC ${fida_SOURCES} ${fida_BL_SOURCES}) + +# Set the library name and make sure it is not deleted +SET_TARGET_PROPERTIES(sundials_fida_static + PROPERTIES OUTPUT_NAME sundials_fida CLEAN_DIRECT_OUTPUT 1) + +# Install the FIDA library +INSTALL(TARGETS sundials_fida_static DESTINATION lib) +# +MESSAGE(STATUS "Added IDA FCMIX module") diff --git a/odemex/Parser/CVode/ida_src/src/ida/fcmix/Makefile.in b/odemex/Parser/CVode/ida_src/src/ida/fcmix/Makefile.in new file mode 100644 index 0000000..58a5e8d --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/fcmix/Makefile.in @@ -0,0 +1,123 @@ +# ----------------------------------------------------------------- +# $Revision: 1.8 $ +# $Date: 2009/03/25 23:10:50 $ +# ----------------------------------------------------------------- +# Programmer(s): Aaron Collier @ LLNL +# ----------------------------------------------------------------- +# Copyright (c) 2005, The Regents of the University of California. +# Produced at the Lawrence Livermore National Laboratory. +# All rights reserved. +# For details, see the LICENSE file. +# ----------------------------------------------------------------- +# Makefile for FIDA module +# +# @configure_input@ +# ----------------------------------------------------------------- + +SHELL = @SHELL@ + +srcdir = @srcdir@ +builddir = @builddir@ +abs_builddir = @abs_builddir@ +top_builddir = @top_builddir@ +prefix = @prefix@ +exec_prefix = @exec_prefix@ +includedir = @includedir@ +libdir = @libdir@ + +INSTALL = @INSTALL@ +INSTALL_LIB = @INSTALL_PROGRAM@ +INSTALL_HEADER = @INSTALL_DATA@ + +LIBTOOL = @LIBTOOL@ +LIBTOOL_DEPS = @LIBTOOL_DEPS@ + +CPP = @CPP@ +CPPFLAGS = @CPPFLAGS@ +CC = @CC@ +CFLAGS = @CFLAGS@ +LDFLAGS = @LDFLAGS@ +LIBS = @LIBS@ + +LAPACK_ENABLED = @LAPACK_ENABLED@ + +top_srcdir = $(srcdir)/../../.. + +INCLUDES = -I$(top_srcdir)/include -I$(top_srcdir)/src/ida -I$(top_builddir)/include + +LIB_REVISION = 1:0:0 + +FIDA_LIB = libsundials_fida.la + +FIDA_SRC_FILES = fida.c fidaband.c fidadense.c fidajtimes.c fidapreco.c fidaewt.c fidaroot.c fidabbd.c +FIDA_BL_SRC_FILES = fidalapack.c fidalapdense.c fidalapband.c + +FIDA_OBJ_FILES = $(FIDA_SRC_FILES:.c=.o) +FIDA_BL_OBJ_FILES = $(FIDA_BL_SRC_FILES:.c=.o) + +FIDA_LIB_FILES = $(FIDA_SRC_FILES:.c=.lo) +FIDA_BL_LIB_FILES = $(FIDA_BL_SRC_FILES:.c=.lo) + +mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs + +# ---------------------------------------------------------------------------------------------------------------------- + +all: $(FIDA_LIB) + +$(FIDA_LIB): $(FIDA_LIB_FILES) + @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ + make lib_with_bl; \ + else \ + make lib_without_bl; \ + fi + +lib_without_bl: $(FIDA_LIB_FILES) + $(LIBTOOL) --mode=link $(CC) $(CFLAGS) -o $(FIDA_LIB) $(FIDA_LIB_FILES) -rpath $(libdir) $(LDFLAGS) $(LIBS) -static -version-info $(LIB_REVISION) + +lib_with_bl: $(FIDA_LIB_FILES) $(FIDA_BL_LIB_FILES) + $(LIBTOOL) --mode=link $(CC) $(CFLAGS) -o $(FIDA_LIB) $(FIDA_LIB_FILES) $(FIDA_BL_LIB_FILES) -rpath $(libdir) $(LDFLAGS) $(LIBS) -static -version-info $(LIB_REVISION) + +install: $(FIDA_LIB) + $(mkinstalldirs) $(libdir) + $(LIBTOOL) --mode=install $(INSTALL_LIB) $(FIDA_LIB) $(libdir) + +uninstall: + $(LIBTOOL) --mode=uninstall rm -f $(libdir)/$(FIDA_LIB) + +clean: + $(LIBTOOL) --mode=clean rm -f $(FIDA_LIB) + rm -f $(FIDA_LIB_FILES) + rm -f $(FIDA_BL_LIB_FILES) + rm -f $(FIDA_OBJ_FILES) + rm -f $(FIDA_BL_OBJ_FILES) + +distclean: clean + rm -f Makefile + +fida.lo: $(srcdir)/fida.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fida.c +fidaewt.lo: $(srcdir)/fidaewt.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fidaewt.c +fidaband.lo: $(srcdir)/fidaband.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fidaband.c +fidadense.lo: $(srcdir)/fidadense.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fidadense.c +fidalapack.lo: $(srcdir)/fidalapack.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fidalapack.c +fidalapband.lo: $(srcdir)/fidalapband.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fidalapband.c +fidalapdense.lo: $(srcdir)/fidalapdense.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fidalapdense.c +fidajtimes.lo: $(srcdir)/fidajtimes.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fidajtimes.c +fidapreco.lo: $(srcdir)/fidapreco.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fidapreco.c +fidabbd.lo: $(srcdir)/fidabbd.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fidabbd.c +fidaroot.lo: $(srcdir)/fidaroot.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fidaroot.c + +libtool: $(top_builddir)/$(LIBTOOL_DEPS) + @cd ${top_builddir} ; \ + ${SHELL} ./config.status --recheck ; \ + cd ${abs_builddir} diff --git a/odemex/Parser/CVode/ida_src/src/ida/fcmix/fida.c b/odemex/Parser/CVode/ida_src/src/ida/fcmix/fida.c new file mode 100644 index 0000000..6ba06e6 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/fcmix/fida.c @@ -0,0 +1,751 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.9 $ + * $Date: 2008/03/18 14:49:29 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for the Fortran interface to + * the IDA package. See fida.h for usage. + * NOTE: Some routines are necessarily stored elsewhere to avoid + * linking problems. + * ----------------------------------------------------------------- + */ + +#include +#include +#include + +#include "fida.h" /* function names, prototypes, global variables */ +#include "ida_impl.h" /* definition of IDAMem type */ + +#include /* prototypes for IDABAND interface routines */ +#include /* prototypes for IDADENSE interface routines */ +#include /* prototypes for IDASPTFQMR interface routines */ +#include /* prototypes for IDASPBCG interface routines */ +#include /* prototypes for IDASPGMR interface routines */ + +/*************************************************/ + +/* Definitions for global variables shared amongst various routines */ + +N_Vector F2C_IDA_ypvec, F2C_IDA_ewtvec; + +void *IDA_idamem; +long int *IDA_iout; +realtype *IDA_rout; +int IDA_ls; +int IDA_nrtfn; + +/*************************************************/ + +/* private constant(s) */ +#define ZERO RCONST(0.0) + +/*************************************************/ + +/* Prototype of user-supplied Fortran routine (IDAResFn) */ + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + extern void FIDA_RESFUN(realtype*, /* T */ + realtype*, /* Y */ + realtype*, /* YP */ + realtype*, /* R */ + long int*, /* IPAR */ + realtype*, /* RPAR */ + int*); /* IER */ + +#ifdef __cplusplus +} +#endif + +/*************************************************/ + +void FIDA_MALLOC(realtype *t0, realtype *yy0, realtype *yp0, + int *iatol, realtype *rtol, realtype *atol, + long int *iout, realtype *rout, + long int *ipar, realtype *rpar, + int *ier) +{ + N_Vector Vatol; + FIDAUserData IDA_userdata; + + *ier = 0; + + /* Check for required vector operations */ + if ((F2C_IDA_vec->ops->nvgetarraypointer == NULL) || + (F2C_IDA_vec->ops->nvsetarraypointer == NULL)) { + *ier = -1; + printf("A required vector operation is not implemented.\n\n"); + return; + } + + /* Initialize all pointers to NULL */ + IDA_idamem = NULL; + Vatol = NULL; + F2C_IDA_ypvec = F2C_IDA_ewtvec = NULL; + + /* Create IDA object */ + IDA_idamem = IDACreate(); + if (IDA_idamem == NULL) { + *ier = -1; + return; + } + + /* Set and attach user data */ + IDA_userdata = NULL; + IDA_userdata = (FIDAUserData) malloc(sizeof *IDA_userdata); + if (IDA_userdata == NULL) { + *ier = -1; + return; + } + IDA_userdata->rpar = rpar; + IDA_userdata->ipar = ipar; + + *ier = IDASetUserData(IDA_idamem, IDA_userdata); + if(*ier != IDA_SUCCESS) { + free(IDA_userdata); IDA_userdata = NULL; + *ier = -1; + return; + } + + /* Attach user's yy0 to F2C_IDA_vec */ + N_VSetArrayPointer(yy0, F2C_IDA_vec); + + /* Create F2C_IDA_ypvec and attach user's yp0 to it */ + F2C_IDA_ypvec = NULL; + F2C_IDA_ypvec = N_VCloneEmpty(F2C_IDA_vec); + if (F2C_IDA_ypvec == NULL) { + free(IDA_userdata); IDA_userdata = NULL; + *ier = -1; + } + N_VSetArrayPointer(yp0, F2C_IDA_ypvec); + + /* Call IDAInit */ + *ier = IDAInit(IDA_idamem, FIDAresfn, *t0, F2C_IDA_vec, F2C_IDA_ypvec); + + /* Reset data pointers */ + N_VSetArrayPointer(NULL, F2C_IDA_vec); + N_VSetArrayPointer(NULL, F2C_IDA_ypvec); + + /* On failure, clean-up and exit */ + if (*ier != IDA_SUCCESS) { + N_VDestroy(F2C_IDA_ypvec); + free(IDA_userdata); IDA_userdata = NULL; + *ier = -1; + return; + } + + /* Set tolerances */ + switch (*iatol) { + case 1: + *ier = IDASStolerances(IDA_idamem, *rtol, *atol); + break; + case 2: + Vatol = NULL; + Vatol= N_VCloneEmpty(F2C_IDA_vec); + if (Vatol == NULL) { + free(IDA_userdata); IDA_userdata = NULL; + *ier = -1; + return; + } + N_VSetArrayPointer(atol, Vatol); + *ier = IDASVtolerances(IDA_idamem, *rtol, Vatol); + N_VDestroy(Vatol); + break; + } + + /* On failure, clean-up and exit */ + if (*ier != IDA_SUCCESS) { + free(IDA_userdata); IDA_userdata = NULL; + *ier = -1; + return; + } + + /* Grab optional output arrays and store them in global variables */ + IDA_iout = iout; + IDA_rout = rout; + + /* Store the unit roundoff in rout for user access */ + IDA_rout[5] = UNIT_ROUNDOFF; + + /* Set F2C_IDA_ewtvec on NULL */ + F2C_IDA_ewtvec = NULL; + + return; +} + +/*************************************************/ + +void FIDA_REINIT(realtype *t0, realtype *yy0, realtype *yp0, + int *iatol, realtype *rtol, realtype *atol, + int *ier) +{ + N_Vector Vatol; + + *ier = 0; + + /* Initialize all pointers to NULL */ + Vatol = NULL; + + /* Attach user's yy0 to F2C_IDA_vec */ + N_VSetArrayPointer(yy0, F2C_IDA_vec); + + /* Attach user's yp0 to F2C_IDA_ypvec */ + N_VSetArrayPointer(yp0, F2C_IDA_ypvec); + + /* Call IDAReInit */ + *ier = IDAReInit(IDA_idamem, *t0, F2C_IDA_vec, F2C_IDA_ypvec); + + /* Reset data pointers */ + N_VSetArrayPointer(NULL, F2C_IDA_vec); + N_VSetArrayPointer(NULL, F2C_IDA_ypvec); + + /* On failure, exit */ + if (*ier != IDA_SUCCESS) { + *ier = -1; + return; + } + + /* Set tolerances */ + switch (*iatol) { + case 1: + *ier = IDASStolerances(IDA_idamem, *rtol, *atol); + break; + case 2: + Vatol = NULL; + Vatol= N_VCloneEmpty(F2C_IDA_vec); + if (Vatol == NULL) { + *ier = -1; + return; + } + N_VSetArrayPointer(atol, Vatol); + *ier = IDASVtolerances(IDA_idamem, *rtol, Vatol); + N_VDestroy(Vatol); + break; + } + + /* On failure, exit */ + if (*ier != IDA_SUCCESS) { + *ier = -1; + return; + } + + return; +} + +/*************************************************/ + +void FIDA_SETIIN(char key_name[], long int *ival, int *ier, int key_len) +{ + if (!strncmp(key_name,"MAX_ORD", (size_t)key_len)) + *ier = IDASetMaxOrd(IDA_idamem, (int) *ival); + else if (!strncmp(key_name,"MAX_NSTEPS", (size_t)key_len)) + *ier = IDASetMaxNumSteps(IDA_idamem, (int) *ival); + else if (!strncmp(key_name,"MAX_ERRFAIL", (size_t)key_len)) + *ier = IDASetMaxErrTestFails(IDA_idamem, (int) *ival); + else if (!strncmp(key_name,"MAX_NITERS", (size_t)key_len)) + *ier = IDASetMaxNonlinIters(IDA_idamem, (int) *ival); + else if (!strncmp(key_name,"MAX_CONVFAIL", (size_t)key_len)) + *ier = IDASetMaxConvFails(IDA_idamem, (int) *ival); + else if (!strncmp(key_name,"SUPPRESS_ALG", (size_t)key_len)) + *ier = IDASetSuppressAlg(IDA_idamem, (int) *ival); + else if (!strncmp(key_name,"MAX_NSTEPS_IC", (size_t)key_len)) + *ier = IDASetMaxNumStepsIC(IDA_idamem, (int) *ival); + else if (!strncmp(key_name,"MAX_NITERS_IC", (size_t)key_len)) + *ier = IDASetMaxNumItersIC(IDA_idamem, (int) *ival); + else if (!strncmp(key_name,"MAX_NJE_IC", (size_t)key_len)) + *ier = IDASetMaxNumJacsIC(IDA_idamem, (int) *ival); + else if (!strncmp(key_name,"LS_OFF_IC", (size_t)key_len)) + *ier = IDASetLineSearchOffIC(IDA_idamem, (int) *ival); + else { + *ier = -99; + printf("FIDASETIIN: Unrecognized key.\n\n"); + } + +} + +/***************************************************************************/ + +void FIDA_SETRIN(char key_name[], realtype *rval, int *ier, int key_len) +{ + + if (!strncmp(key_name,"INIT_STEP", (size_t)key_len)) + *ier = IDASetInitStep(IDA_idamem, *rval); + else if (!strncmp(key_name,"MAX_STEP", (size_t)key_len)) + *ier = IDASetMaxStep(IDA_idamem, *rval); + else if (!strncmp(key_name,"STOP_TIME", (size_t)key_len)) + *ier = IDASetStopTime(IDA_idamem, *rval); + else if (!strncmp(key_name,"NLCONV_COEF", (size_t)key_len)) + *ier = IDASetNonlinConvCoef(IDA_idamem, *rval); + else if (!strncmp(key_name,"NLCONV_COEF_IC", (size_t)key_len)) + *ier = IDASetNonlinConvCoefIC(IDA_idamem, *rval); + else if (!strncmp(key_name,"STEP_TOL_IC", (size_t)key_len)) + *ier = IDASetStepToleranceIC(IDA_idamem, *rval); + else { + *ier = -99; + printf("FIDASETRIN: Unrecognized key.\n\n"); + } + +} + +/*************************************************/ + +void FIDA_SETVIN(char key_name[], realtype *vval, int *ier, int key_len) +{ + N_Vector Vec; + + *ier = 0; + + if (!strncmp(key_name,"ID_VEC", (size_t)key_len)) { + Vec = NULL; + Vec = N_VCloneEmpty(F2C_IDA_vec); + if (Vec == NULL) { + *ier = -1; + return; + } + N_VSetArrayPointer(vval, Vec); + IDASetId(IDA_idamem, Vec); + N_VDestroy(Vec); + } else if (!strncmp(key_name,"CONSTR_VEC", (size_t)key_len)) { + Vec = NULL; + Vec = N_VCloneEmpty(F2C_IDA_vec); + if (Vec == NULL) { + *ier = -1; + return; + } + N_VSetArrayPointer(vval, Vec); + IDASetConstraints(IDA_idamem, Vec); + N_VDestroy(Vec); + } else { + *ier = -99; + printf("FIDASETVIN: Unrecognized key.\n\n"); + } + +} + +/*************************************************/ + +void FIDA_TOLREINIT(int *iatol, realtype *rtol, realtype *atol, int *ier) +{ + int itol; + N_Vector Vatol=NULL; + + *ier = 0; + + itol = -1; + if (*iatol == 1) { + *ier = IDASStolerances(IDA_idamem, *rtol, *atol); + } else { + Vatol = NULL; + Vatol = N_VCloneEmpty(F2C_IDA_vec); + if (Vatol == NULL) { + *ier = -1; + return; + } + N_VSetArrayPointer(atol, Vatol); + *ier = IDASVtolerances(IDA_idamem, *rtol, Vatol); + N_VDestroy(Vatol); + } + + return; +} + +/*************************************************/ + +void FIDA_CALCIC(int *icopt, realtype *tout1, int *ier) +{ + *ier = 0; + *ier = IDACalcIC(IDA_idamem, *icopt, *tout1); + return; +} + +/*************************************************/ + +void FIDA_SPTFQMR(int *maxl, realtype *eplifac, realtype *dqincfac, int *ier) +{ + + *ier = 0; + + *ier = IDASptfqmr(IDA_idamem, *maxl); + if (*ier != IDASPILS_SUCCESS) return; + + if (*eplifac != ZERO) { + *ier = IDASpilsSetEpsLin(IDA_idamem, *eplifac); + if (*ier != IDASPILS_SUCCESS) return; + } + + if (*dqincfac != ZERO) { + *ier = IDASpilsSetIncrementFactor(IDA_idamem, *dqincfac); + if (*ier != IDASPILS_SUCCESS) return; + } + + IDA_ls = IDA_LS_SPTFQMR; + + return; +} + +/*************************************************/ + +void FIDA_SPBCG(int *maxl, realtype *eplifac, realtype *dqincfac, int *ier) +{ + + *ier = 0; + + *ier = IDASpbcg(IDA_idamem, *maxl); + if (*ier != IDASPILS_SUCCESS) return; + + if (*eplifac != ZERO) { + *ier = IDASpilsSetEpsLin(IDA_idamem, *eplifac); + if (*ier != IDASPILS_SUCCESS) return; + } + + if (*dqincfac != ZERO) { + *ier = IDASpilsSetIncrementFactor(IDA_idamem, *dqincfac); + if (*ier != IDASPILS_SUCCESS) return; + } + + IDA_ls = IDA_LS_SPBCG; + + return; +} + +/*************************************************/ + +void FIDA_SPGMR(int *maxl, int *gstype, int *maxrs, + realtype *eplifac, realtype *dqincfac, int *ier) +{ + + *ier = 0; + + *ier = IDASpgmr(IDA_idamem, *maxl); + if (*ier != IDASPILS_SUCCESS) return; + + if (*gstype != 0) { + *ier = IDASpilsSetGSType(IDA_idamem, *gstype); + if (*ier != IDASPILS_SUCCESS) return; + } + + if (*maxrs != 0) { + *ier = IDASpilsSetMaxRestarts(IDA_idamem, *maxrs); + if (*ier != IDASPILS_SUCCESS) return; + } + + if (*eplifac != ZERO) { + *ier = IDASpilsSetEpsLin(IDA_idamem, *eplifac); + if (*ier != IDASPILS_SUCCESS) return; + } + + if (*dqincfac != ZERO) { + *ier = IDASpilsSetIncrementFactor(IDA_idamem, *dqincfac); + if (*ier != IDASPILS_SUCCESS) return; + } + + IDA_ls = IDA_LS_SPGMR; + + return; +} + +/*************************************************/ + +void FIDA_DENSE(int *neq, int *ier) +{ + + *ier = 0; + + *ier = IDADense(IDA_idamem, *neq); + + IDA_ls = IDA_LS_DENSE; + + return; +} + +/*************************************************/ + +void FIDA_BAND(int *neq, int *mupper, int *mlower, int *ier) +{ + + *ier = 0; + + *ier = IDABand(IDA_idamem, *neq, *mupper, *mlower); + + IDA_ls = IDA_LS_BAND; + + return; +} + +/*************************************************/ + +void FIDA_SPTFQMRREINIT(int *maxl, realtype *eplifac, realtype *dqincfac, int *ier) +{ + + *ier = 0; + + if (*maxl > 0) { + *ier = IDASpilsSetMaxl(IDA_idamem, *maxl); + if (*ier != IDASPILS_SUCCESS) return; + } + + if (*eplifac != ZERO) { + *ier = IDASpilsSetEpsLin(IDA_idamem, *eplifac); + if (*ier != IDASPILS_SUCCESS) return; + } + + if (*dqincfac != ZERO) { + *ier = IDASpilsSetIncrementFactor(IDA_idamem, *dqincfac); + if (*ier != IDASPILS_SUCCESS) return; + } + + IDA_ls = IDA_LS_SPTFQMR; + + return; +} + +/*************************************************/ + +void FIDA_SPBCGREINIT(int *maxl, realtype *eplifac, realtype *dqincfac, int *ier) +{ + + *ier = 0; + + if (*maxl > 0) { + *ier = IDASpilsSetMaxl(IDA_idamem, *maxl); + if (*ier != IDASPILS_SUCCESS) return; + } + + if (*eplifac != ZERO) { + *ier = IDASpilsSetEpsLin(IDA_idamem, *eplifac); + if (*ier != IDASPILS_SUCCESS) return; + } + + if (*dqincfac != ZERO) { + *ier = IDASpilsSetIncrementFactor(IDA_idamem, *dqincfac); + if (*ier != IDASPILS_SUCCESS) return; + } + + IDA_ls = IDA_LS_SPBCG; + + return; +} + +/*************************************************/ + +void FIDA_SPGMRREINIT(int *gstype, int *maxrs, realtype *eplifac, + realtype *dqincfac, int *ier) +{ + + *ier = 0; + + if (*gstype != 0) { + *ier = IDASpilsSetGSType(IDA_idamem, *gstype); + if (*ier != IDASPILS_SUCCESS) return; + } + + if (*maxrs != 0) { + *ier = IDASpilsSetMaxRestarts(IDA_idamem, *maxrs); + if (*ier != IDASPILS_SUCCESS) return; + } + + if (*eplifac != ZERO) { + *ier = IDASpilsSetEpsLin(IDA_idamem, *eplifac); + if (*ier != IDASPILS_SUCCESS) return; + } + + if (*dqincfac != ZERO) { + *ier = IDASpilsSetIncrementFactor(IDA_idamem, *dqincfac); + if (*ier != IDASPILS_SUCCESS) return; + } + + IDA_ls = IDA_LS_SPGMR; + + return; +} + +/*************************************************/ + +void FIDA_SOLVE(realtype *tout, realtype *tret, realtype *yret, + realtype *ypret, int *itask, int *ier) +{ + + *ier = 0; + + /* Attach user data to vectors */ + N_VSetArrayPointer(yret, F2C_IDA_vec); + N_VSetArrayPointer(ypret, F2C_IDA_ypvec); + + *ier = IDASolve(IDA_idamem, *tout, tret, F2C_IDA_vec, F2C_IDA_ypvec, *itask); + + /* Reset data pointers */ + N_VSetArrayPointer(NULL, F2C_IDA_vec); + N_VSetArrayPointer(NULL, F2C_IDA_ypvec); + + /* Set optional outputs */ + + IDAGetWorkSpace(IDA_idamem, + &IDA_iout[0], /* LENRW */ + &IDA_iout[1]); /* LENIW */ + + IDAGetIntegratorStats(IDA_idamem, + &IDA_iout[2], /* NST */ + &IDA_iout[3], /* NRE */ + &IDA_iout[7], /* NSETUPS */ + &IDA_iout[4], /* NETF */ + (int *) &IDA_iout[8], /* KLAST */ + (int *) &IDA_iout[9], /* KCUR */ + &IDA_rout[0], /* HINUSED */ + &IDA_rout[1], /* HLAST */ + &IDA_rout[2], /* HCUR */ + &IDA_rout[3]); /* TCUR */ + IDAGetNonlinSolvStats(IDA_idamem, + &IDA_iout[6], /* NNI */ + &IDA_iout[5]); /* NCFN */ + IDAGetNumBacktrackOps(IDA_idamem, + &IDA_iout[10]); /* NBCKTRK */ + IDAGetTolScaleFactor(IDA_idamem, + &IDA_rout[4]); /* TOLSFAC */ + + /* Root finding is on */ + if (IDA_nrtfn != 0) + IDAGetNumGEvals(IDA_idamem, &IDA_iout[11]); /* NGE */ + + switch(IDA_ls) { + case IDA_LS_DENSE: + case IDA_LS_BAND: + case IDA_LS_LAPACKDENSE: + case IDA_LS_LAPACKBAND: + IDADlsGetWorkSpace(IDA_idamem, &IDA_iout[12], &IDA_iout[13]); /* LENRWLS, LENIWLS */ + IDADlsGetLastFlag(IDA_idamem, (int *) &IDA_iout[14]); /* LSTF */ + IDADlsGetNumResEvals(IDA_idamem, &IDA_iout[15]); /* NRE */ + IDADlsGetNumJacEvals(IDA_idamem, &IDA_iout[16]); /* NJE */ + break; + case IDA_LS_SPGMR: + case IDA_LS_SPBCG: + case IDA_LS_SPTFQMR: + IDASpilsGetWorkSpace(IDA_idamem, &IDA_iout[12], &IDA_iout[13]); /* LENRWLS, LENIWLS */ + IDASpilsGetLastFlag(IDA_idamem, (int *) &IDA_iout[14]); /* LSTF */ + IDASpilsGetNumResEvals(IDA_idamem, &IDA_iout[15]); /* NRE */ + IDASpilsGetNumJtimesEvals(IDA_idamem, &IDA_iout[16]); /* NJE */ + IDASpilsGetNumPrecEvals(IDA_idamem, &IDA_iout[17]); /* NPE */ + IDASpilsGetNumPrecSolves(IDA_idamem, &IDA_iout[18]); /* NPS */ + IDASpilsGetNumLinIters(IDA_idamem, &IDA_iout[19]); /* NLI */ + IDASpilsGetNumConvFails(IDA_idamem, &IDA_iout[20]); /* NCFL */ + break; + } + + + return; +} + +/*************************************************/ + +void FIDA_GETSOL(realtype *t, realtype *yret, realtype *ypret, int *ier) +{ + /* Attach user data to vectors */ + N_VSetArrayPointer(yret, F2C_IDA_vec); + N_VSetArrayPointer(ypret, F2C_IDA_ypvec); + + *ier = 0; + *ier = IDAGetSolution(IDA_idamem, *t, F2C_IDA_vec, F2C_IDA_ypvec); + + /* Reset data pointers */ + N_VSetArrayPointer(NULL, F2C_IDA_vec); + N_VSetArrayPointer(NULL, F2C_IDA_ypvec); + + return; +} + +/*************************************************/ + +void FIDA_GETERRWEIGHTS(realtype *eweight, int *ier) +{ + /* Attach user data to vector */ + N_VSetArrayPointer(eweight, F2C_IDA_vec); + + *ier = 0; + *ier = IDAGetErrWeights(IDA_idamem, F2C_IDA_vec); + + /* Reset data pointer */ + N_VSetArrayPointer(NULL, F2C_IDA_vec); + + return; +} + +/*************************************************/ + +void FIDA_GETESTLOCALERR(realtype *ele, int *ier) +{ + /* Attach user data to vector */ + N_VSetArrayPointer(ele, F2C_IDA_vec); + + *ier = 0; + *ier = IDAGetEstLocalErrors(IDA_idamem, F2C_IDA_vec); + + /* Reset data pointers */ + N_VSetArrayPointer(NULL, F2C_IDA_vec); + + return; +} + +/*************************************************/ + +void FIDA_FREE(void) +{ + IDAMem ida_mem; + + ida_mem = (IDAMem) IDA_idamem; + + free(ida_mem->ida_user_data); ida_mem->ida_user_data = NULL; + + IDAFree(&IDA_idamem); + + /* Free F2C_IDA_vec */ + N_VSetArrayPointer(NULL, F2C_IDA_vec); + N_VDestroy(F2C_IDA_vec); + + /* Free F2C_IDA_ypvec */ + N_VSetArrayPointer(NULL, F2C_IDA_ypvec); + N_VDestroy(F2C_IDA_ypvec); + + /* Free F2C_IDA_ewtvec */ + if (F2C_IDA_ewtvec != NULL) + N_VDestroy(F2C_IDA_ewtvec); + + return; +} + +/*************************************************/ + +int FIDAresfn(realtype t, N_Vector yy, N_Vector yp, + N_Vector rr, void *user_data) +{ + int ier; + realtype *yy_data, *yp_data, *rr_data; + FIDAUserData IDA_userdata; + + /* NOTE: The user-supplied routine should set ier to an + appropriate value, but we preset the value to zero + (meaning SUCCESS) so the user need only reset the + value if an error occurred */ + ier = 0; + + /* Get pointers to vector data */ + yy_data = N_VGetArrayPointer(yy); + yp_data = N_VGetArrayPointer(yp); + rr_data = N_VGetArrayPointer(rr); + + IDA_userdata = (FIDAUserData) user_data; + + /* Call user-supplied routine */ + FIDA_RESFUN(&t, yy_data, yp_data, rr_data, + IDA_userdata->ipar, IDA_userdata->rpar, &ier); + + return(ier); +} diff --git a/odemex/Parser/CVode/ida_src/src/ida/fcmix/fida.h b/odemex/Parser/CVode/ida_src/src/ida/fcmix/fida.h new file mode 100644 index 0000000..79bc372 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/fcmix/fida.h @@ -0,0 +1,716 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.8 $ + * $Date: 2007/12/12 18:13:22 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file for FIDA, the Fortran interface to + * the IDA package. + * ----------------------------------------------------------------- + */ + +/* + * ============================================================================= + * + * FIDA Interface Package + * + * The FIDA Interface Package is a package of C functions which support + * the use of the IDA solver, for the solution of DAE systems, in a + * mixed Fortran/C setting. While IDA is written in C, it is assumed + * here that the user's calling program and user-supplied problem-defining + * routines are written in Fortran. This package provides the necessary + * interface to IDA for both the serial and the parallel NVECTOR + * implementations. + * + * The user-callable functions, with the corresponding IDA functions, + * are as follows: + * + * FNVINITS* and FNVINITP* interface to N_VNew_Serial and + * N_VNew_Parallel, respectively + * + * FIDAMALLOC interfaces to IDACreate and IDAInit + * + * FIDAREINIT interfaces to IDAReInit + * + * FIDASETIIN, FIDASETRIN, FIDASETVIN interface to IDASet* + * + * FIDATOLREINIT interfaces to IDASetTolerances + * + * FIDACALCIC interfaces to IDACalcIC + * + * FIDAEWTSET interfaces to IDAWFtolerances + * + * FIDADENSE interfaces to IDADense + * FIDADENSESETJAC interfaces to IDADenseSetJacFn + * + * FIDABAND interfaces to IDABand + * FIDABANDSETJAC interfaces to IDABandSetJacFn + * + * FIDASPTFQMR/FIDASPTFQMRREINIT interface to IDASptfqmr and IDASptfqmrSet* + * FIDASPBCG/FIDASPBCGREINIT interface to IDASpbcg and IDASpbcgSet* + * FIDASPGMR/FIDASPGMRREINIT interface to IDASpgmr and IDASpgmrSet* + * FIDASPILSSETJAC interfaces to IDASpilsSetJacFn + * FIDASPILSSETPREC interfaces to IDASpilsSetPreconditioner + * + * FIDASOLVE interfaces to IDASolve, IDAGet*, and IDA*Get* + * + * FIDAGETSOL interfaces to IDAGetSolution + * + * FIDAGETERRWEIGHTS interfaces to IDAGetErrWeights + * + * FIDAGETESTLOCALERR interfaces to IDAGetEstLocalErrors + * + * FIDAFREE interfaces to IDAFree + * + * The user-supplied functions, each listed with the corresponding interface + * function which calls it (and its type within IDA), are as follows: + * FIDARESFUN is called by the interface function FIDAresfn of type IDAResFn + * FIDADJAC is called by the interface fn. FIDADenseJac of type IDADenseJacFn + * FIDABJAC is called by the interface fn. FIDABandJac of type IDABandJacFn + * FIDAPSOL is called by the interface fn. FIDAPSol of type IDASpilsPrecSolveFn + * FIDAPSET is called by the interface fn. FIDAPSet of type IDASpilsPrecSetupFn + * FIDAJTIMES is called by interface fn. FIDAJtimes of type IDASpilsJacTimesVecFn + * FIDAEWT is called by interface fn. FIDAEwtSet of type IDAEwtFn + * In contrast to the case of direct use of IDA, the names of all user-supplied + * routines here are fixed, in order to maximize portability for the resulting + * mixed-language program. + * + * Important note on portability: + * In this package, the names of the interface functions, and the names of + * the Fortran user routines called by them, appear as dummy names + * which are mapped to actual values by a series of definitions in the + * header file fida.h. + * + * ============================================================================= + * + * Usage of the FIDA Interface Package + * + * The usage of FIDA requires calls to a few different interface + * functions, depending on the method options selected, and one or more + * user-supplied routines which define the problem to be solved. These + * function calls and user routines are summarized separately below. + * + * Some details are omitted, and the user is referred to the user documents + * on IDA for more complete documentation. Information on the + * arguments of any given user-callable interface routine, or of a given + * user-supplied function called by an interface function, can be found in + * the documentation on the corresponding function in the IDA package. + * + * The number labels on the instructions below end with s for instructions + * that apply to the serial version of IDA only, and end with p for + * those that apply to the parallel version only. + * + * ----------------------------------------------------------------------------- + * + * (1) User-supplied residual routine: FIDARESFUN + * The user must in all cases supply the following Fortran routine + * SUBROUTINE FIDARESFUN(T, Y, YP, R, IPAR, RPAR, IER) + * DIMENSION Y(*), YP(*), R(*), IPAR(*), RPAR(*) + * It must set the R array to F(t,y,y'), the residual of the DAE + * system, as a function of T = t, the array Y = y, and the array YP = y'. + * Here Y, YP and R are distributed vectors. + * IPAR and RPAR are arrays of integer and real user data, respectively, + * as passed to FIDAMALLOC. + * + * (2s) Optional user-supplied dense Jacobian approximation routine: FIDADJAC + * As an option when using the DENSE linear solver, the user may supply a + * routine that computes a dense approximation of the system Jacobian + * J = df/dy. If supplied, it must have the following form: + * SUBROUTINE FIDADJAC(NEQ, T, Y, YP, R, DJAC, CJ, EWT, H, + * 1 IPAR, RPAR, WK1, WK2, WK3, IER) + * DIMENSION Y(*), YP(*), R(*), EWT(*), DJAC(NEQ,*), + * 1 IPAR(*), RPAR(*), WK1(*), WK2(*), WK3(*) + * This routine must compute the Jacobian and store it columnwise in DJAC. + * IPAR and RPAR are user (integer and real) arrays passed to FIDAMALLOC. + * + * (3s) Optional user-supplied band Jacobian approximation routine: FIDABJAC + * As an option when using the BAND linear solver, the user may supply a + * routine that computes a band approximation of the system Jacobian + * J = df/dy. If supplied, it must have the following form: + * SUBROUTINE FIDABJAC(NEQ, MU, ML, MDIM, T, Y, YP, R, CJ, + * 1 BJAC, EWT, H, IPAR, RPAR, WK1, WK2, WK3, IER) + * DIMENSION Y(*), YP(*), R(*), EWT(*), BJAC(MDIM,*), + * 1 IPAR(*), RPAR(*), WK1(*), WK2(*), WK3(*) + * This routine must load the MDIM by N array BJAC with the Jacobian matrix at the + * current (t,y,y') in band form. Store in BJAC(k,j) the Jacobian element J(i,j) + * with k = i - j + MU + 1 (k = 1 ... ML+MU+1) and j = 1 ... N. + * IPAR and RPAR are user (integer and real) arrays passed to FIDAMALLOC. + * + * (4) Optional user-supplied Jacobian-vector product routine: FIDAJTIMES + * As an option when using the SPGMR/SPBCG/SPTFQMR linear solver, the user may + * supply a routine that computes the product of the system Jacobian J = df/dy + * and a given vector v. If supplied, it must have the following form: + * SUBROUTINE FIDAJTIMES(T, Y, YP, R, V, FJV, CJ, EWT, H, + * 1 IPAR, RPAR, WK1, WK2, IER) + * DIMENSION V(*), FJV(*), Y(*), YP(*), R(*), EWT(*), + * 1 IPAR(*), RPAR(*), WK1(*), WK2(*) + * This routine must compute the product vector Jv, where the vector v is stored + * in V, and store the product in FJV. On return, set IER = 0 if FIDAJTIMES was + * successful, and nonzero otherwise. + * IPAR and RPAR are user (integer and real) arrays passed to FIDAMALLOC. + * + * (5) Optional user-supplied error weight vector routine: FIDAEWT + * As an option to providing the relative and absolute tolerances, the user + * may supply a routine that computes the weights used in the WRMS norms. + * If supplied, it must have the following form: + * SUBROUTINE FIDAEWT(Y, EWT, IPAR, RPAR, IER) + * DIMENSION Y(*), EWT(*) + * It must store the error weights in EWT, given the current solution vector Y. + * On return, set IER = 0 if successful, and nonzero otherwise. + * IPAR and RPAR are user (integer and real) arrays passed to FIDAMALLOC. + * + * ----------------------------------------------------------------------------- + * + * (6) Initialization: FNVINITS / FNVINITP , FIDAMALLOC, FIDAREINIT, + * FIDATOLREINIT, and FIDACALCIC + * + * (6.1s) To initialize the serial machine environment, the user must make + * the following call: + * CALL FNVINITS(KEY, NEQ, IER) + * The arguments are: + * KEY = 2 for IDA + * NEQ = size of vectors + * IER = return completion flag. Values are 0 = success, -1 = failure. + * + * (6.1p) To initialize the parallel machine environment, the user must make + * one of the following calls: + * CALL FNVINITP(KEY, NLOCAL, NGLOBAL, IER) + * -or- + * CALL FNVINITP(COMM, KEY, NLOCAL, NGLOBAL, IER) + * The arguments are: + * COMM = MPI communicator (e.g., MPI_COMM_WORLD) + * KEY = 2 for IDA + * NLOCAL = local size of vectors on this processor + * NGLOBAL = the system size, and the global size of vectors (the sum + * of all values of NLOCAL) + * IER = return completion flag. Values are 0 = success, -1 = failure. + * NOTE: The COMM argument passed to the FNVINITP routine is only supported if + * the MPI implementation used to build SUNDIALS includes the MPI_Comm_f2c + * function from the MPI-2 specification. To check if the function is supported + * look for the line "#define SUNDIALS_MPI_COMM_F2C 1" in the sundials_config.h + * header file. + * + * (6.2) To set various problem and solution parameters and allocate + * internal memory, make the following call: + * CALL FIDAMALLOC(T0, Y0, YP0, IATOL, RTOL, ATOL, + * 1 IOUT, ROUT, IPAR, RPAR, IER) + * The arguments are: + * T0 = initial value of t + * Y0 = array of initial conditions, y(t0) + * YP0 = value of y'(t0) + * IATOL = type for absolute tolerance ATOL: 1 = scalar, 2 = array. + * If IATOL = 3, then the user must supply a routine FIDAEWT to compute + * the error weight vector. + * RTOL = relative tolerance (scalar) + * ATOL = absolute tolerance (scalar or array) + * IOUT = array of length at least 21 for integer optional outputs + * (declare as INTEGER*4 or INTEGER*8 according to C type long int) + * ROUT = array of length at least 6 for real optional outputs + * IPAR = array with user integer data + * (declare as INTEGER*4 or INTEGER*8 according to C type long int) + * RPAR = array with user real data + * IER = return completion flag. Values are 0 = SUCCESS, and -1 = failure. + * See printed message for details in case of failure. + * + * The user data arrays IPAR and RPAR are passed unmodified to all subsequent + * calls to user-provided routines. Modifications to either array inside a + * user-provided routine will be propagated. Using these two arrays, the user + * can dispense with Common blocks to pass data betwen user-provided routines. + * + * The optional outputs are: + * LENRW = IOUT( 1) -> IDAGetWorkSpace + * LENIW = IOUT( 2) -> IDAGetWorkSpace + * NST = IOUT( 3) -> IDAGetNumSteps + * NRE = IOUT( 4) -> IDAGetNumResEvals + * NETF = IOUT( 5) -> IDAGetNumErrTestFails + * NCFN = IOUT( 6) -> IDAGetNumNonlinSolvConvFails + * NNI = IOUT( 7) -> IDAGetNumNonlinSolvIters + * NSETUPS = IOUT( 8) -> IDAGetNumLinSolvSetups + * KLAST = IOUT( 9) -> IDAGetLastOrder + * KCUR = IOUT(10) -> IDAGetCurrentOrder + * NBCKTRK = IOUT(11) -> IDAGetNumBacktrackOps + * NGE = IOUT(12) -> IDAGetNumGEvals + * + * HINUSED = ROUT( 1) -> IDAGetActualInitStep + * HLAST = ROUT( 2) -> IDAGetLastStep + * HCUR = ROUT( 3) -> IDAGetCurrentStep + * TCUR = ROUT( 4) -> IDAGetCurrentTime + * TOLSFAC = ROUT( 5) -> IDAGetTolScaleFactor + * UNITRND = ROUT( 6) -> UNIT_ROUNDOFF + * + * + * If the user program includes the FIDAEWT routine for the evaluation of the + * error weights, the following call must be made + * CALL FIDAEWTSET(FLAG, IER) + * with FLAG = 1 to specify that FIDAEWT is provided. + * The return flag IER is 0 if successful, and nonzero otherwise. + * + * (6.3) To set various integer optional inputs, make the folowing call: + * CALL FIDASETIIN(KEY, VALUE, IER) + * to set the optional input specified by the character key KEY to the + * integer value VAL. + * KEY is one of the following: MAX_ORD, MAX_NSTEPS, MAX_ERRFAIL, MAX_NITERS, + * MAX_CONVFAIL, SUPPRESS_ALG, MAX_NSTEPS_IC, MAX_NITERS_IC, MAX_NJE_IC, LS_OFF_IC. + * + * To set various real optional inputs, make the folowing call: + * CALL FIDASETRIN(KEY, VALUE, IER) + * to set the optional input specified by the character key KEY to the + * real value VAL. + * KEY is one of the following: INIT_STEP, MAX_STEP, MIIN_STEP, STOP_TIME, + * NLCONV_COEF. + * + * To set the vector of variable IDs or the vector of constraints, make + * the following call: + * CALL FIDASETVIN(KEY, ARRAY, IER) + * where ARRAY is an array of reals and KEY is 'ID_VEC' or 'CONSTR_VEC'. + * + * FIDASETIIN, FIDASETRIN, and FIDASETVIN return IER=0 if successful and + * IER<0 if an error occured. + * + * (6.4) To re-initialize the FIDA solver for the solution of a new problem + * of the same size as one already solved, make the following call: + * CALL FIDAREINIT(T0, Y0, YP0, IATOL, RTOL, ATOL, ID, CONSTR, IER) + * The arguments have the same names and meanings as those of FIDAMALLOC. + * FIDAREINIT performs the same initializations as FIDAMALLOC, but does no memory + * allocation for IDA data structures, using instead the existing internal memory + * created by the previous FIDAMALLOC call. The call to specify the linear system + * solution method may or may not be needed. See below. + * + * (6.5) To modify the tolerance parameters, make the following call: + * CALL FIDATOLREINIT(IATOL, RTOL, ATOL, IER) + * The arguments have the same names and meanings as those of FIDAMALLOC. + * FIDATOLREINIT simple calls IDASetTolerances with the given arguments. + * + * (6.6) To compute consistent initial conditions for an index-one DAE system, + * make the following call: + * CALL FIDACALCIC(ICOPT, TOUT, IER) + * The arguments are: + * ICOPT = specifies the option: 1 = IDA_YP_YDP_INIT, 2 = IDA_Y_INIT. + * (See user guide for additional details.) + * TOUT = the first value of t at which a solution will be requested + * (from FIDASOLVE). + * IER = return completion flag. + * + * ----------------------------------------------------------------------------- + * + * (7) Specification of linear system solution method. + * FIDA presently includes four choices for the treatment of these systems, + * and the user of FIDA must call a routine with a specific name to make the + * desired choice. + * + * (7.1s) DENSE treatment of the linear system. + * The user must make the call + * CALL FIDADENSE(NEQ, IER) + * The arguments are: + * NEQ = size of vectors + * IER = error return flag: 0 = success , negative value = an error occured + * + * If the user program includes the FIDADJAC routine for the evaluation of the + * dense approximation to the Jacobian, the following call must be made + * CALL FIDADENSESETJAC(FLAG, IER) + * with FLAG = 1 to specify that FIDADJAC is provided. (FLAG = 0 specifies + * using the internal finite differences approximation to the Jacobian.) + * The return flag IER is 0 if successful, and nonzero otherwise. + * + * Optional outputs specific to the DENSE case are: + * LENRWLS = IOUT(13) -> IDADenseGetWorkSpace + * LENIWLS = IOUT(14) -> IDADenseGetWorkSpace + * LSTF = IOUT(15) -> IDADenseGetLastFlag + * NRELS = IOUT(16) -> IDADenseGetNumResEvals + * NJE = IOUT(17) -> IDADenseGetNumJacEvals + * + * (7.2s) BAND treatment of the linear system + * The user must make the call + * CALL FIDABAND(NEQ, MU, ML, IER) + * The arguments are: + * NEQ = size of vectors + * MU = upper bandwidth + * ML = lower bandwidth + * IER = error return flag: 0 = success , negative value = an error occured + * + * If the user program includes the FIDABJAC routine for the evaluation of the + * band approximation to the Jacobian, the following call must be made + * CALL FIDABANDSETJAC (FLAG, IER) + * with FLAG = 1 to specify that FIDABJAC is provided. (FLAG = 0 specifies + * using the internal finite differences approximation to the Jacobian.) + * The return flag IER is 0 if successful, and nonzero otherwise. + * + * Optional outputs specific to the BAND case are: + * LENRWLS = IOUT(13) -> IDABandGetWorkSpace + * LENIWLS = IOUT(14) -> IDABandGetWorkSpace + * LSTF = IOUT(15) -> IDABandGetLastFlag + * NRELS = IOUT(16) -> IDABandGetNumResEvals + * NJE = IOUT(17) -> IDABandGetNumJacEvals + * + * (7.3) SPGMR treatment of the linear systems. + * For the Scaled Preconditioned GMRES solution of the linear systems, + * the user must make the following call: + * CALL FIDASPGMR(MAXL, IGSTYPE, MAXRS, EPLIFAC, DQINCFAC, IER) + * The arguments are: + * MAXL = maximum Krylov subspace dimension; 0 indicates default. + * IGSTYPE = specifies the type of Gram-Schmidt orthogonalization to be used: + * 1 = MODIFIED_GS, 2 = CLASSICAL_GS + * EPLIFAC = factor in the linear iteration convergence test constant + * DQINCFAC = factor in the increments to y used in the difference quotient + * approximations to the matrix-vector products Jv + * IER = error return flag: 0 = success; negative value = an error occured + * + * Optional outputs specific to the SPGMR case are: + * LENRWLS = IOUT(13) -> IDASpgmrGetWorkSpace + * LENIWLS = IOUT(14) -> IDASpgmrGetWorkSpace + * LSTF = IOUT(15) -> IDASpgmrGetLastFlag + * NRELS = IOUT(16) -> IDASpgmrGetResEvals + * NJE = IOUT(17) -> IDASpgmrGetJtimesEvals + * NPE = IOUT(18) -> IDASpgmrGetPrecEvals + * NPS = IOUT(19) -> IDASpgmrGetPrecSolves + * NLI = IOUT(20) -> IDASpgmrGetLinIters + * NLCF = IOUT(21) -> IDASpgmrGetConvFails + * + * If a sequence of problems of the same size is being solved using the + * SPGMR linear solver, then following the call to FIDAREINIT, a call to the + * FIDASPGMRREINIT routine is needed if any of IGSTYPE, MAXRS, EPLIFAC, or + * DQINCFAC is being changed. In that case, call FIDASPGMRREINIT as follows: + * CALL FIDASPGMRREINIT (IGSTYPE, MAXRS, EPLIFAC, DQINCFAC, IER) + * The arguments have the same meanings as for FIDASPGMR. If MAXL is being + * changed, then call FIDASPGMR instead. + * + * (7.4) SPBCG treatment of the linear systems. + * For the Scaled Preconditioned Bi-CGSTAB solution of the linear systems, + * the user must make the following call: + * CALL FIDASPBCG(MAXL, EPLIFAC, DQINCFAC, IER) + * The arguments are: + * MAXL = maximum Krylov subspace dimension; 0 indicates default. + * EPLIFAC = factor in the linear iteration convergence test constant + * DQINCFAC = factor in the increments to y used in the difference quotient + * approximations to matrix-vector products Jv + * IER = error return flag: 0 = success; negative value = an error occured + * + * Optional outputs specific to the SPBCG case are: + * LENRWLS = IOUT(13) -> IDASpbcgGetWorkSpace + * LENIWLS = IOUT(14) -> IDASpbcgGetWorkSpace + * LSTF = IOUT(15) -> IDASpbcgGetLastFlag + * NRELS = IOUT(16) -> IDASpbcgGetResEvals + * NJE = IOUT(17) -> IDASpbcgGetJtimesEvals + * NPE = IOUT(18) -> IDASpbcgGetPrecEvals + * NPS = IOUT(19) -> IDASpbcgGetPrecSolves + * NLI = IOUT(20) -> IDASpbcgGetLinIters + * NLCF = IOUT(21) -> IDASpbcgGetConvFails + * + * If a sequence of problems of the same size is being solved using the + * SPBCG linear solver, then following the call to FIDAREINIT, a call to the + * FIDASPBCGREINIT routine is needed if MAXL, EPLIFAC, or DQINCFAC is + * being changed. In that case, call FIDASPBCGREINIT as follows: + * CALL FIDASPBCGREINIT(MAXL, EPLIFAC, DQINCFAC, IER) + * The arguments have the same meanings as for FIDASPBCG. + * + * (7.5) SPTFQMR treatment of the linear systems. + * For the Scaled Preconditioned TFQMR solution of the linear systems, + * the user must make the following call: + * CALL FIDASPTFQMR(MAXL, EPLIFAC, DQINCFAC, IER) + * The arguments are: + * MAXL = maximum Krylov subspace dimension; 0 indicates default. + * EPLIFAC = factor in the linear iteration convergence test constant + * DQINCFAC = factor in the increments to y used in the difference quotient + * approximations to matrix-vector products Jv + * IER = error return flag: 0 = success; negative value = an error occured + * + * Optional outputs specific to the SPTFQMR case are: + * LENRWLS = IOUT(13) -> IDASptfqmrGetWorkSpace + * LENIWLS = IOUT(14) -> IDASptfqmrGetWorkSpace + * LSTF = IOUT(15) -> IDASptfqmrGetLastFlag + * NRELS = IOUT(16) -> IDASptfqmrGetResEvals + * NJE = IOUT(17) -> IDASptfqmrGetJtimesEvals + * NPE = IOUT(18) -> IDASptfqmrGetPrecEvals + * NPS = IOUT(19) -> IDASptfqmrGetPrecSolves + * NLI = IOUT(20) -> IDASptfqmrGetLinIters + * NLCF = IOUT(21) -> IDASptfqmrGetConvFails + * + * If a sequence of problems of the same size is being solved using the + * SPTFQMR linear solver, then following the call to FIDAREINIT, a call to the + * FIDASPTFQMRREINIT routine is needed if MAXL, EPLIFAC, or DQINCFAC is + * being changed. In that case, call FIDASPTFQMRREINIT as follows: + * CALL FIDASPTFQMRREINIT (MAXL, EPLIFAC, DQINCFAC, IER) + * The arguments have the same meanings as for FIDASPTFQMR. + * + * (7.6) Using user-provided functions for the iterative linear solvers + * + * If the user program includes the FIDAJTIMES routine for the evaluation of the + * Jacobian vector product, the following call must be made + * CALL FIDASPILSSETJAC (FLAG, IER) + * with FLAG = 1 to specify that FIDAJTIMES is provided. (FLAG = 0 specifies + * using and internal finite difference approximation to this product.) + * The return flag IER is 0 if successful, and nonzero otherwise. + * + * Usage of the user-supplied routines FIDAPSOL and FIDAPSET for solution of the + * preconditioner linear system requires the following call: + * CALL FIDASPILSSETPREC(FLAG, IER) + * with FLAG = 1. The return flag IER is 0 if successful, nonzero otherwise. + * The user-supplied routine FIDAPSOL must have the form: + * SUBROUTINE FIDAPSOL(T, Y, YP, R, RV, ZV, CJ, DELTA, EWT, + * 1 IPAR, RPAR, WRK, IER) + * DIMENSION Y(*), YP(*), R(*), RV(*), ZV(*), + * 1 IPAR(*), RPAR(*), EWT(*), WRK(*) + * This routine must solve the preconditioner linear system Pz = r, where r = RV + * is input, and store the solution z in ZV. + * + * The user-supplied routine FIDAPSET must be of the form: + * SUBROUTINE FIDAPSET(T, Y, YP, R, CJ, EWT, H, IPAR, RPAR, + * 1 WK1, WK2, WK3, IER) + * DIMENSION Y(*), YP(*), R(*), EWT(*), IPAR(*), RPAR(*), + * 1 WK1(*), WK2(*), WK3(*) + * This routine must perform any evaluation of Jacobian-related data and + * preprocessing needed for the solution of the preconditioner linear systems + * by FIDAPSOL. On return, set IER = 0 if FIDAPSET was successful, set IER + * positive if a recoverable error occurred, and set IER negative if a + * non-recoverable error occurred. + * IPAR and RPAR are user (integer and real) arrays passed to FIDAMALLOC. + * + * ----------------------------------------------------------------------------- + * + * (8) The solver: FIDASOLVE + * To solve the DAE system, make the following call: + * CALL FIDASOLVE(TOUT, TRET, Y, YP, ITASK, IER) + * The arguments are: + * TOUT = next value of t at which a solution is desired (input) + * TRET = value of t reached by the solver on output + * Y = array containing the computed solution on output + * YP = array containing current value of y' + * ITASK = task indicator: 1 = normal mode (overshoot TOUT and interpolate) + * 2 = one-step mode (return after each internal step taken) + * 3 = normal tstop mode (like 1, but integration never proceeds past + * TSTOP, which must be specified through a call to FIDASETRIN + * using the key 'STOP_TIME' + * 4 = one step tstop (like 2, but integration never goes past TSTOP) + * IER = completion flag: 0 = success, 1 = tstop return, 2 = root return, + * values -1 ... -10 are various failure modes (see IDA manual). + * The current values of the optional outputs are available in IOUT and ROUT. + * + * ----------------------------------------------------------------------------- + * + * (9) Getting current solution: FIDAGETSOL + * To obtain interpolated values of y and y' for any value of t in the last + * internal step taken by IDA, make the following call: + * CALL FIDAGETSOL(T, YRET, YPRET, IER) + * The arguments are: + * T = value of t at which solution is desired, in [TCUR-HU,TCUR]. + * Y = array containing interpolated y + * YP = array containing the derivative of the computed solution, y'(tret) + * IER = return flag: = 0 for success, < 0 for illegal argument. + * + * ----------------------------------------------------------------------------- + * + * (10) Memory freeing: FIDAFREE + * To the free the internal memory created by the calls to FIDAMALLOC and + * FNVINITS or FNVINITP, depending on the version (serial/parallel), make + * the following call: + * CALL FIDAFREE + * + * ============================================================================= + */ + +#ifndef _FIDA_H +#define _FIDA_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include /* definition of type IDAResFn */ +#include /* definition of type DlsMat */ +#include /* definition of type N_Vector */ +#include /* definition of type realtype */ + +#if defined(SUNDIALS_F77_FUNC) + +#define FIDA_MALLOC SUNDIALS_F77_FUNC(fidamalloc, FIDAMALLOC) +#define FIDA_REINIT SUNDIALS_F77_FUNC(fidareinit, FIDAREINIT) +#define FIDA_SETIIN SUNDIALS_F77_FUNC(fidasetiin, FIDASETIIN) +#define FIDA_SETRIN SUNDIALS_F77_FUNC(fidasetrin, FIDASETRIN) +#define FIDA_SETVIN SUNDIALS_F77_FUNC(fidasetvin, FIDASETVIN) +#define FIDA_TOLREINIT SUNDIALS_F77_FUNC(fidatolreinit, FIDATOLREINIT) +#define FIDA_SOLVE SUNDIALS_F77_FUNC(fidasolve, FIDASOLVE) +#define FIDA_FREE SUNDIALS_F77_FUNC(fidafree, FIDAFREE) +#define FIDA_CALCIC SUNDIALS_F77_FUNC(fidacalcic, FIDACALCIC) +#define FIDA_BAND SUNDIALS_F77_FUNC(fidaband, FIDABAND) +#define FIDA_BANDSETJAC SUNDIALS_F77_FUNC(fidabandsetjac, FIDABANDSETJAC) +#define FIDA_DENSE SUNDIALS_F77_FUNC(fidadense, FIDADENSE) +#define FIDA_DENSESETJAC SUNDIALS_F77_FUNC(fidadensesetjac, FIDADENSESETJAC) +#define FIDA_LAPACKBAND SUNDIALS_F77_FUNC(fidalapackband, FIDALAPACKBAND) +#define FIDA_LAPACKBANDSETJAC SUNDIALS_F77_FUNC(fidalapackbandsetjac, FIDALAPACKBANDSETJAC) +#define FIDA_LAPACKDENSE SUNDIALS_F77_FUNC(fidalapackdense, FIDALAPACKDENSE) +#define FIDA_LAPACKDENSESETJAC SUNDIALS_F77_FUNC(fidalapackdensesetjac, FIDALAPACKDENSESETJAC) +#define FIDA_SPTFQMR SUNDIALS_F77_FUNC(fidasptfqmr, FIDASPTFQMR) +#define FIDA_SPBCG SUNDIALS_F77_FUNC(fidaspbcg, FIDASPBCG) +#define FIDA_SPGMR SUNDIALS_F77_FUNC(fidaspgmr, FIDASPGMR) +#define FIDA_SPTFQMRREINIT SUNDIALS_F77_FUNC(fidasptfqmrreinit, FIDASPTFQMRREINIT) +#define FIDA_SPBCGREINIT SUNDIALS_F77_FUNC(fidaspbcgreinit, FIDASPBCGREINIT) +#define FIDA_SPGMRREINIT SUNDIALS_F77_FUNC(fidaspgmrreinit, FIDASPGMRREINIT) +#define FIDA_SPILSSETJAC SUNDIALS_F77_FUNC(fidaspilssetjac, FIDASPILSSETJAC) +#define FIDA_SPILSSETPREC SUNDIALS_F77_FUNC(fidaspilssetprec, FIDASPILSSETPREC) +#define FIDA_RESFUN SUNDIALS_F77_FUNC(fidaresfun, FIDARESFUN) +#define FIDA_DJAC SUNDIALS_F77_FUNC(fidadjac, FIDADJAC) +#define FIDA_BJAC SUNDIALS_F77_FUNC(fidabjac, FIDABJAC) +#define FIDA_PSET SUNDIALS_F77_FUNC(fidapset, FIDAPSET) +#define FIDA_PSOL SUNDIALS_F77_FUNC(fidapsol, FIDAPSOL) +#define FIDA_JTIMES SUNDIALS_F77_FUNC(fidajtimes, FIDAJTIMES) +#define FIDA_EWT SUNDIALS_F77_FUNC(fidaewt, FIDAEWT) +#define FIDA_GETSOL SUNDIALS_F77_FUNC(fidagetsol, FIDAGETSOL) +#define FIDA_GETERRWEIGHTS SUNDIALS_F77_FUNC(fidageterrweights, FIDAGETERRWEIGHTS) +#define FIDA_GETESTLOCALERR SUNDIALS_F77_FUNC(fidagetestlocalerr, FIDAGETESTLOCALERR) + +#else + +#define FIDA_MALLOC fidamalloc_ +#define FIDA_REINIT fidareinit_ +#define FIDA_SETIIN fidasetiin_ +#define FIDA_SETRIN fidasetrin_ +#define FIDA_SETVIN fidasetvin_ +#define FIDA_TOLREINIT fidatolreinit_ +#define FIDA_SOLVE fidasolve_ +#define FIDA_FREE fidafree_ +#define FIDA_CALCIC fidacalcic_ +#define FIDA_BAND fidaband_ +#define FIDA_BANDSETJAC fidabandsetjac_ +#define FIDA_DENSE fidadense_ +#define FIDA_DENSESETJAC fidadensesetjac_ +#define FIDA_LAPACKBAND fidalapackband_ +#define FIDA_LAPACKBANDSETJAC fidalapackbandsetjac_ +#define FIDA_LAPACKDENSE fidalapackdense_ +#define FIDA_LAPACKDENSESETJAC fidalapackdensesetjac_ +#define FIDA_SPTFQMR fidasptfqmr_ +#define FIDA_SPBCG fidaspbcg_ +#define FIDA_SPGMR fidaspgmr_ +#define FIDA_SPTFQMRREINIT fidasptfqmrreinit_ +#define FIDA_SPBCGREINIT fidaspbcgreinit_ +#define FIDA_SPGMRREINIT fidaspgmrreinit_ +#define FIDA_SPILSSETJAC fidaspilssetjac_ +#define FIDA_SPILSSETPREC fidaspilssetprec_ +#define FIDA_RESFUN fidaresfun_ +#define FIDA_DJAC fidadjac_ +#define FIDA_BJAC fidabjac_ +#define FIDA_PSET fidapset_ +#define FIDA_PSOL fidapsol_ +#define FIDA_JTIMES fidajtimes_ +#define FIDA_EWT fidaewt_ +#define FIDA_GETSOL fidagetsol_ +#define FIDA_GETERRWEIGHTS fidageterrweights_ +#define FIDA_GETESTLOCALERR fidagetestlocalerr_ + +#endif + +/* Type for user data */ + +typedef struct { + realtype *rpar; + long int *ipar; +} *FIDAUserData; + +/* Prototypes of exported functions */ + +void FIDA_MALLOC(realtype *t0, realtype *yy0, realtype *yp0, + int *iatol, realtype *rtol, realtype *atol, + long int *iout, realtype *rout, + long int *ipar, realtype *rpar, + int *ier); +void FIDA_REINIT(realtype *t0, realtype *yy0, realtype *yp0, + int *iatol, realtype *rtol, realtype *atol, + int *ier); + +void FIDA_SETIIN(char key_name[], long int *ival, int *ier, int key_len); + +void FIDA_SETRIN(char key_name[], realtype *rval, int *ier, int key_len); + +void FIDA_SETVIN(char key_name[], realtype *vval, int *ier, int key_len); + +void FIDA_TOLREINIT(int *iatol, realtype *rtol, realtype *atol, int *ier); +void FIDA_CALCIC(int *icopt, realtype *tout1, int *ier); + +void FIDA_DENSE(int *neq, int *ier); +void FIDA_DENSESETJAC(int *flag, int *ier); +void FIDA_BAND(int *neq, int *mupper, int *mlower, int *ier); +void FIDA_BANDSETJAC(int *flag, int *ier); + +void FIDA_LAPACKDENSE(int *neq, int *ier); +void FIDA_LAPACKDENSESETJAC(int *flag, int *ier); +void FIDA_LAPACKBAND(int *neq, int *mupper, int *mlower, int *ier); +void FIDA_LAPACKBANDSETJAC(int *flag, int *ier); + +void FIDA_SPTFQMR(int *maxl, realtype *eplifac, realtype *dqincfac, int *ier); +void FIDA_SPBCG(int *maxl, realtype *eplifac, realtype *dqincfac, int *ier); +void FIDA_SPGMR(int *maxl, int *gstype, int *maxrs, realtype *eplifac, + realtype *dqincfac, int *ier); +void FIDA_SPTFQMRREINIT(int *maxl, realtype *eplifac, realtype *dqincfac, int *ier); +void FIDA_SPBCGREINIT(int *maxl, realtype *eplifac, realtype *dqincfac, int *ier); +void FIDA_SPGMRREINIT(int *gstype, int *maxrs, realtype *eplifac, + realtype *dqincfac, int *ier); +void FIDA_SPILSSETJAC(int *flag, int *ier); +void FIDA_SPILSSETPREC(int *flag, int *ier); + +void FIDA_SOLVE(realtype *tout, realtype *tret, realtype *yret, + realtype *ypret, int *itask, int *ier); +void FIDA_FREE(void); +void FIDA_EWTSET(int *flag, int *ier); +void FIDA_GETSOL(realtype *t, realtype *yret, realtype *ypret, int *ier); +void FIDA_GETERRWEIGHTS(realtype *eweight, int *ier); +void FIDA_GETESTLOCALERR(realtype *ele, int *ier); + +/* Prototypes: Functions Called by the IDA Solver */ + +int FIDAresfn(realtype t, N_Vector yy, N_Vector yp, N_Vector rr, void *user_data); + +int FIDADenseJac(int N, realtype t, realtype c_j, + N_Vector yy, N_Vector yp, N_Vector rr, + DlsMat Jac, void *user_data, + N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); + +int FIDABandJac(int N, int mupper, int mlower, + realtype t, realtype c_j, + N_Vector yy, N_Vector yp, N_Vector rr, + DlsMat Jac, void *user_data, + N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); + +int FIDAJtimes(realtype t, N_Vector yy, N_Vector yp, N_Vector rr, + N_Vector v, N_Vector Jv, + realtype c_j, void *user_data, + N_Vector vtemp1, N_Vector vtemp2); + +int FIDAPSet(realtype t, N_Vector yy, N_Vector yp, N_Vector rr, + realtype c_j, void *user_data, + N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); + +int FIDAPSol(realtype t, N_Vector yy, N_Vector yp, N_Vector rr, + N_Vector rvec, N_Vector zvec, + realtype c_j, realtype delta, void *user_data, + N_Vector vtemp1); + +int FIDAEwtSet(N_Vector yy, N_Vector ewt, void *user_data); + +/* Declarations for global variables shared amongst various routines */ + +extern N_Vector F2C_IDA_vec; /* defined in FNVECTOR module */ + +extern N_Vector F2C_IDA_ypvec; /* defined in fida.c */ +extern N_Vector F2C_IDA_ewtvec; /* defined in fida.c */ +extern void *IDA_idamem; /* defined in fida.c */ +extern long int *IDA_iout; /* defined in fida.c */ +extern realtype *IDA_rout; /* defined in fida.c */ +extern int IDA_ls; /* defined in fida.c */ +extern int IDA_nrtfn; /* defined in fida.c */ + +/* Linear solver IDs */ + +enum { IDA_LS_DENSE = 1, IDA_LS_BAND = 2, + IDA_LS_LAPACKDENSE = 3, IDA_LS_LAPACKBAND = 4, + IDA_LS_SPGMR = 5, IDA_LS_SPBCG = 6, IDA_LS_SPTFQMR = 7 }; + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidaband.c b/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidaband.c new file mode 100644 index 0000000..06190c8 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidaband.c @@ -0,0 +1,117 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.5 $ + * $Date: 2007/04/30 19:29:00 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * Fortran/C interface routines for IDA/IDABAND, for the case of + * a user-supplied Jacobian approximation routine. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "fida.h" /* function names, prototypes, global vars.*/ +#include "ida_impl.h" /* definition of IDAMem type */ + +#include + +/*************************************************/ + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + extern void FIDA_BJAC(int*, int*, int*, int*, + realtype*, realtype*, realtype*, realtype*, + realtype*, realtype*, realtype*, realtype*, + long int*, realtype*, + realtype*, realtype*, realtype*, int*); + +#ifdef __cplusplus +} +#endif + +/*************************************************/ + +void FIDA_BANDSETJAC(int *flag, int *ier) +{ + *ier = 0; + + if (*flag == 0) { + + *ier = IDADlsSetBandJacFn(IDA_idamem, NULL); + + } else { + + if (F2C_IDA_ewtvec == NULL) { + F2C_IDA_ewtvec = N_VClone(F2C_IDA_vec); + if (F2C_IDA_ewtvec == NULL) { + *ier = -1; + return; + } + } + + *ier = IDADlsSetBandJacFn(IDA_idamem, FIDABandJac); + + } + + return; +} + +/*************************************************/ + +int FIDABandJac(int N, int mupper, int mlower, + realtype t, realtype c_j, + N_Vector yy, N_Vector yp, N_Vector rr, + DlsMat J, void *user_data, + N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) +{ + realtype *yy_data, *yp_data, *rr_data, *jacdata, *ewtdata, *v1data, *v2data, *v3data; + realtype h; + int eband; + int ier; + FIDAUserData IDA_userdata; + + /* Initialize all pointers to NULL */ + yy_data = yp_data = rr_data = jacdata = ewtdata = NULL; + v1data = v2data = v3data = NULL; + + /* NOTE: The user-supplied routine should set ier to an + appropriate value, but we preset the value to zero + (meaning SUCCESS) so the user need only reset the + value if an error occurred */ + ier = 0; + + IDAGetErrWeights(IDA_idamem, F2C_IDA_ewtvec); + IDAGetLastStep(IDA_idamem, &h); + + /* Get pointers to vector data */ + yy_data = N_VGetArrayPointer(yy); + yp_data = N_VGetArrayPointer(yp); + rr_data = N_VGetArrayPointer(rr); + ewtdata = N_VGetArrayPointer(F2C_IDA_ewtvec); + v1data = N_VGetArrayPointer(vtemp1); + v2data = N_VGetArrayPointer(vtemp2); + v3data = N_VGetArrayPointer(vtemp3); + + eband = (J->s_mu) + mlower + 1; + jacdata = BAND_COL(J,0) - mupper; + + IDA_userdata = (FIDAUserData) user_data; + + /* Call user-supplied routine */ + FIDA_BJAC(&N, &mupper, &mlower, &eband, &t, yy_data, yp_data, rr_data, + &c_j, jacdata, ewtdata, &h, + IDA_userdata->ipar, IDA_userdata->rpar, + v1data, v2data, v3data, &ier); + + return(ier); +} diff --git a/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidabbd.c b/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidabbd.c new file mode 100644 index 0000000..fae7722 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidabbd.c @@ -0,0 +1,150 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.5 $ + * $Date: 2007/04/30 19:29:00 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This module contains the routines necessary to interface with the + * IDABBDPRE module and user-supplied Fortran routines. + * The routines here call the generically named routines and provide + * a standard interface to the C code of the IDABBDPRE package. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "fida.h" /* function names, prototypes, global variables */ +#include "fidabbd.h" /* prototypes of interfaces to IDABBD */ + +#include /* prototypes of IDABBDPRE functions and macros */ +#include /* prototypes of IDASPGMR interface routines */ +#include /* prototypes of IDASPBCG interface routines */ +#include /* prototypes of IDASPTFQMR interface routines */ + +/*************************************************/ + +/* private constant(s) */ + +#define ZERO RCONST(0.0) + +/*************************************************/ + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + extern void FIDA_GLOCFN(int*, + realtype*, realtype*, realtype*, realtype*, + long int*, realtype*, + int*); + extern void FIDA_COMMFN(int*, + realtype*, realtype*, realtype*, + long int*, realtype*, + int*); + +#ifdef __cplusplus +} +#endif + +/*************************************************/ + +void FIDA_BBDINIT(int *Nloc, int *mudq, int *mldq, + int *mu, int *ml, realtype *dqrely, int *ier) +{ + *ier = IDABBDPrecInit(IDA_idamem, *Nloc, *mudq, *mldq, *mu, *ml, + *dqrely, (IDABBDLocalFn) FIDAgloc, (IDABBDCommFn) FIDAcfn); + + return; +} + +/*************************************************/ + +void FIDA_BBDREINIT(int *Nloc, int *mudq, int *mldq, + realtype *dqrely, int *ier) +{ + *ier = 0; + + *ier = IDABBDPrecReInit(IDA_idamem, *mudq, *mldq, *dqrely); + + return; +} + +/*************************************************/ + +int FIDAgloc(int Nloc, realtype t, N_Vector yy, N_Vector yp, + N_Vector gval, void *user_data) +{ + realtype *yy_data, *yp_data, *gval_data; + int ier; + FIDAUserData IDA_userdata; + + /* Initialize all pointers to NULL */ + yy_data = yp_data = gval_data = NULL; + + /* NOTE: The user-supplied routine should set ier to an + appropriate value, but we preset the value to zero + (meaning SUCCESS) so the user need only reset the + value if an error occurred */ + ier = 0; + + /* Get pointers to vector data */ + yy_data = N_VGetArrayPointer(yy); + yp_data = N_VGetArrayPointer(yp); + gval_data = N_VGetArrayPointer(gval); + + IDA_userdata = (FIDAUserData) user_data; + + /* Call user-supplied routine */ + FIDA_GLOCFN(&Nloc, &t, yy_data, yp_data, gval_data, + IDA_userdata->ipar, IDA_userdata->rpar, &ier); + + return(ier); +} + +/*************************************************/ + +int FIDAcfn(int Nloc, realtype t, N_Vector yy, N_Vector yp, + void *user_data) +{ + realtype *yy_data, *yp_data; + int ier; + FIDAUserData IDA_userdata; + + /* Initialize all pointers to NULL */ + yy_data = yp_data = NULL; + + /* NOTE: The user-supplied routine should set ier to an + appropriate value, but we preset the value to zero + (meaning SUCCESS) so the user need only reset the + value if an error occurred */ + ier = 0; + + /* Get pointers to vector data */ + yy_data = N_VGetArrayPointer(yy); + yp_data = N_VGetArrayPointer(yp); + + IDA_userdata = (FIDAUserData) user_data; + + /* Call user-supplied routine */ + FIDA_COMMFN(&Nloc, &t, yy_data, yp_data, + IDA_userdata->ipar, IDA_userdata->rpar, &ier); + + return(ier); +} + +/*************************************************/ + +void FIDA_BBDOPT(long int *lenrwbbd, long int *leniwbbd, long int *ngebbd) +{ + IDABBDPrecGetWorkSpace(IDA_idamem, lenrwbbd, leniwbbd); + IDABBDPrecGetNumGfnEvals(IDA_idamem, ngebbd); + + return; +} diff --git a/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidabbd.h b/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidabbd.h new file mode 100644 index 0000000..770024f --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidabbd.h @@ -0,0 +1,333 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.7 $ + * $Date: 2008/04/16 21:18:22 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the Fortran interface include file for the BBD + * preconditioner (IDABBDPRE) + * ----------------------------------------------------------------- + */ + +/* + * ============================================================================== + * + * FIDABBD Interface Package + * + * The FIDABBD Interface Package is a package of C functions which, + * together with the FIDA Interface Package, support the use of the + * IDA solver (parallel MPI version) with the IDABBDPRE preconditioner module, + * for the solution of DAE systems in a mixed Fortran/C setting. The + * combination of IDA and IDABBDPRE solves DAE systems with the SPGMR + * (scaled preconditioned GMRES), SPBCG (scaled preconditioned Bi-CGSTAB), or + * SPTFQMR (scaled preconditioned TFQMR) method for the linear systems that arise, + * and with a preconditioner that is block-diagonal with banded blocks. While + * IDA and IDABBDPRE are written in C, it is assumed here that the user's + * calling program and user-supplied problem-defining routines are written in + * Fortran. + * + * The user-callable functions in this package, with the corresponding + * IDA and IDABBDPRE functions, are as follows: + * FIDABBDININT interfaces to IDABBDPrecInit + * FIDABBDSPGMR interfaces to IDABBDSpgmr and IDASpilsSet* + * FIDABBDSPBCG interfaces to IDABBDSpbcg and IDASpilsSet* + * FIDABBDSPTFQMR interfaces to IDABBDSptfqmr and IDASpilsSet* + * FIDABBDREINIT interfaces to IDABBDPrecReInit + * FIDABBDOPT accesses optional outputs + * FIDABBDFREE interfaces to IDABBDPrecFree + * + * In addition to the Fortran residual function FIDARESFUN, the + * user-supplied functions used by this package, are listed below, + * each with the corresponding interface function which calls it (and its + * type within IDABBDPRE or IDA): + * FIDAGLOCFN is called by the interface function FIDAgloc of type IDABBDLocalFn + * FIDACOMMFN is called by the interface function FIDAcfn of type IDABBDCommFn + * FIDAJTIMES (optional) is called by the interface function FIDAJtimes of + * type IDASpilsJacTimesVecFn + * (The names of all user-supplied routines here are fixed, in order to + * maximize portability for the resulting mixed-language program.) + * + * Important note on portability: + * In this package, the names of the interface functions, and the names of + * the Fortran user routines called by them, appear as dummy names + * which are mapped to actual values by a series of definitions in the + * header file fidabbd.h. + * + * ============================================================================== + * + * Usage of the FIDA/FIDABBD Interface Packages + * + * The usage of the combined interface packages FIDA and FIDABBD requires + * calls to several interface functions, and a few different user-supplied + * routines which define the problem to be solved and indirectly define + * the preconditioner. These function calls and user routines are + * summarized separately below. + * + * Some details are omitted, and the user is referred to the IDA user document + * for more complete information. + * + * (1) User-supplied residual routine: FIDARESFUN + * The user must in all cases supply the following Fortran routine + * SUBROUTINE FIDARESFUN(T, Y, YP, R, IPAR, RPAR, IER) + * DIMENSION Y(*), YP(*), R(*), IPAR(*), RPAR(*) + * It must set the R array to F(t,y,y'), the residual of the DAE + * system, as a function of T = t, the array Y = y, and the array YP = y'. + * Here Y, YP and R are distributed vectors. + * + * (2) User-supplied routines to define preconditoner: FIDAGLOCFN and FIDACOMMFN + * + * The routines in the IDABBDPRE module provide a preconditioner matrix + * for IDA that is block-diagonal with banded blocks. The blocking + * corresponds to the distribution of the dependent variable vectors y and y' + * among the processes. Each preconditioner block is generated from the + * Jacobian of the local part (associated with the current process) of a given + * function G(t,y,y') approximating F(t,y,y'). The blocks are generated by a + * difference quotient scheme independently by each process, utilizing + * an assumed banded structure with given half-bandwidths. A separate + * pair of half-bandwidths defines the band matrix retained. + * + * (2.1) Local approximate function FIDAGLOCFN. + * The user must supply a subroutine of the form + * SUBROUTINE FIDAGLOCFN(NLOC, T, YLOC, YPLOC, GLOC, IPAR, RPAR, IER) + * DIMENSION YLOC(*), YPLOC(*), GLOC(*), IPAR(*), RPAR(*) + * to compute the function G(t,y,y') which approximates the residual + * function F(t,y,y'). This function is to be computed locally, i.e., without + * interprocess communication. (The case where G is mathematically + * identical to F is allowed.) It takes as input the local vector length + * NLOC, the independent variable value T = t, and the local realtype + * dependent variable arrays YLOC and YPLOC. It is to compute the local part + * of G(t,y,y') and store this in the realtype array GLOC. + * + * (2.2) Communication function FIDACOMMF. + * The user must also supply a subroutine of the form + * SUBROUTINE FIDACOMMFN(NLOC, T, YLOC, YPLOC, IPAR, RPAR, IER) + * DIMENSION YLOC(*), YPLOC(*), IPAR(*), RPAR(*) + * which is to perform all interprocess communication necessary to + * evaluate the approximate residual function G described above. + * This function takes as input the local vector length NLOC, the + * independent variable value T = t, and the local real dependent + * variable arrays YLOC and YPLOC. It is expected to save communicated + * data in work space defined by the user, and made available to FIDAGLOCFN. + * Each call to the FIDACOMMFN is preceded by a call to FIDARESFUN with + * the same (t,y,y') arguments. Thus FIDACOMMFN can omit any + * communications done by FIDARESFUN if relevant to the evaluation of G. + * + * (3) Optional user-supplied Jacobian-vector product routine: FIDAJTIMES + * As an option when using the SPGMR/SPBCG/SPTFQMR linear solver, the user may + * supply a routine that computes the product of the system Jacobian J = df/dy + * and a given vector v. If supplied, it must have the following form: + * SUBROUTINE FIDAJTIMES(T, Y, YP, R, V, FJV, CJ, EWT, H, + * 1 IPAR, RPAR, WK1, WK2, IER) + * DIMENSION V(*), FJV(*), Y(*), YP(*), R(*), EWT(*), + * 1 , IPAR(*), RPAR(*), WK1(*), WK2(*) + * This routine must compute the product vector Jv, where the vector v is stored + * in V, and store the product in FJV. On return, set IER = 0 if FIDAJTIMES was + * successful, and nonzero otherwise. + * + * (4) Initialization: FNVINITP, FIDAMALLOC, FIDABBDINIT. + * + * (4.1) To initialize the parallel machine environment, the user must make + * one of the following calls: + * CALL FNVINITP (KEY, NLOCAL, NGLOBAL, IER) + * -or- + * CALL FNVINITP (COMM, KEY, NLOCAL, NGLOBAL, IER) + * The arguments are: + * COMM = MPI communicator (e.g., MPI_COMM_WORLD) + * KEY = 3 for IDA + * NLOCAL = local size of vectors on this processor + * NGLOBAL = the system size, and the global size of vectors (the sum + * of all values of NLOCAL) + * IER = return completion flag. Values are 0 = success, -1 = failure. + * NOTE: The COMM argument passed to the FNVINITP routine is only supported if + * the MPI implementation used to build SUNDIALS includes the MPI_Comm_f2c + * function from the MPI-2 specification. To check if the function is supported + * look for the line "#define SUNDIALS_MPI_COMM_F2C 1" in the sundials_config.h + * header file. + * + * (4.2) To set various problem and solution parameters and allocate + * internal memory, make the following call: + * CALL FIDAMALLOC(T0, Y0, YP0, IATOL, RTOL, ATOL, ID, CONSTR, + * 1 IOUT, ROUT, IPAR, RPAR, IER) + * The arguments are: + * T0 = initial value of t + * Y0 = array of initial conditions, y(t0) + * YP0 = value of y'(t0) + * IATOL = type for absolute tolerance ATOL: 1 = scalar, 2 = array. + * If IATOL = 3, then the user must supply a routine FIDAEWT to compute + * the error weight vector. + * RTOL = relative tolerance (scalar) + * ATOL = absolute tolerance (scalar or array) + * IOUT = array of length at least 21 for integer optional inputs and outputs + * (declare as INTEGER*4 or INTEGER*8 according to C type long int) + * ROUT = array of length 6 for real optional inputs and outputs + * + * The optional outputs are: + * + * LENRW = IOUT( 1) -> IDAGetWorkSpace + * LENIW = IOUT( 2) -> IDAGetWorkSpace + * NST = IOUT( 3) -> IDAGetNumSteps + * NRE = IOUT( 4) -> IDAGetNumResEvals + * NETF = IOUT( 5) -> IDAGetNumErrTestFails + * NCFN = IOUT( 6) -> IDAGetNumNonlinSolvConvFails + * NNI = IOUT( 7) -> IDAGetNumNonlinSolvIters + * NSETUPS = IOUT( 8) -> IDAGetNumLinSolvSetups + * KLAST = IOUT( 9) -> IDAGetLastOrder + * KCUR = IOUT(10) -> IDAGetCurrentOrder + * NBCKTRK = IOUT(11) -> IDAGetNumBacktrackOps + * NGE = IOUT(12) -> IDAGetNumGEvals + * + * HINUSED = ROUT( 1) -> IDAGetActualInitStep + * HLAST = ROUT( 2) -> IDAGetLastStep + * HCUR = ROUT( 3) -> IDAGetCurrentStep + * TCUR = ROUT( 4) -> IDAGetCurrentTime + * TOLSFAC = ROUT( 5) -> IDAGetTolScaleFactor + * UNITRND = ROUT( 6) -> UNIT_ROUNDOFF + * + * IPAR = array with user integer data + * (declare as INTEGER*4 or INTEGER*8 according to C type long int) + * RPAR = array with user real data + * IER = return completion flag. Values are 0 = SUCCESS, and -1 = failure. + * See printed message for details in case of failure. + * + * If the user program includes the FIDAEWT routine for the evaluation of the + * error weights, the following call must be made + * CALL FIDAEWTSET (FLAG, IER) + * with FLAG = 1 to specify that FIDAEWT is provided. + * The return flag IER is 0 if successful, and nonzero otherwise. + * + * (4.3) Attach one of the 3 SPILS linear solvers. Make one of the + * following calls (see fida.h) for more details. + * CALL FIDASPGMR(MAXL, IGSTYPE, MAXRS, EPLIFAC, DQINCFAC, IER) + * CALL FIDASPBCG(MAXL, EPLIFAC, DQINCFAC, IER) + * CALL FIDASPTFQMR(MAXL, EPLIFAC, DQINCFAC, IER) + * + * (4.4) To allocate memory and initialize data associated with the IDABBDPRE + * preconditioner, make the following call: + * CALL FIDABBDINIT(NLOCAL, MUDQ, MLDQ, MU, ML, DQRELY, IER) + * The arguments are: + * NLOCAL = local size of vectors + * MUDQ,MLDQ = upper and lower half-bandwidths to be used in the computation + * of the local Jacobian blocks by difference quotients. + * These may be smaller than the true half-bandwidths of the + * Jacobian of the local block of g, when smaller values may + * provide greater efficiency. + * MU, ML = upper and lower half-bandwidths of the band matrix that + * is retained as an approximation of the local Jacobian block. + * These may be smaller than MUDQ and MLDQ. + * DQRELY = relative increment factor in y for difference quotients + * (optional). 0.0 indicates the default, sqrt(UNIT_ROUNDOFF). + * IER = return completion flag: IER=0: success, IER<0: an error occured + * + * (4.5) To specify whether the linear solver should use the supplied FIDAJTIMES or the + * internal finite difference approximation, make the call + * CALL FIDASPILSSETJAC(FLAG, IER) + * where FLAG=0 for finite differences approxaimtion or + * FLAG=1 to use the supplied routine FIDAJTIMES + * + * (5) Re-initialization: FIDAREINIT, FIDABBDREINIT + * If a sequence of problems of the same size is being solved using the SPGMR or + * SPBCG linear solver in combination with the IDABBDPRE preconditioner, then the + * IDA package can be reinitialized for the second and subsequent problems + * so as to avoid further memory allocation. First, in place of the call + * to FIDAMALLOC, make the following call: + * CALL FIDAREINIT(T0, Y0, YP0, IATOL, RTOL, ATOL, ID, CONSTR, IER) + * The arguments have the same names and meanings as those of FIDAMALLOC. + * FIDAREINIT performs the same initializations as FIDAMALLOC, but does no + * memory allocation for IDA data structures, using instead the existing + * internal memory created by the previous FIDAMALLOC call. Following the call + * to FIDAREINIT, a call to FIDABBDINIT may or may not be needed. If the input + * arguments are the same, no FIDABBDINIT call is needed. If there is a change + * in input arguments other than MU, ML or MAXL, then the user program should call + * FIDABBDREINIT. The arguments of the FIDABBDREINIT routine have the + * same names and meanings as FIDABBDINIT. Finally, if the value of MU, ML, or + * MAXL is being changed, then a call to FIDABBDINIT must be made. + * + * (6) The solver: FIDASOLVE + * To solve the DAE system, make the following call: + * CALL FIDASOLVE (TOUT, TRET, Y, YP, ITASK, IER) + * The arguments are: + * TOUT = next value of t at which a solution is desired (input) + * TRET = value of t reached by the solver on output + * Y = array containing the computed solution on output + * YP = array containing current value of y' + * ITASK = task indicator: 1 = normal mode (overshoot TOUT and interpolate) + * 2 = one-step mode (return after each internal step taken) + * 3 = normal tstop mode (like 1, but integration never proceeds past + * TSTOP, which must be specified through a call to FIDASETRIN + * using the key 'STOP_TIME' + * 4 = one step tstop (like 2, but integration never goes past TSTOP) + * IER = completion flag: 0 = success, 1 = tstop return, 2 = root return, + * values -1 ... -10 are various failure modes (see IDA manual). + * The current values of the optional outputs are available in IOUT and ROUT. + * + * (7) Optional outputs: FIDABBDOPT + * Optional outputs specific to the SPGMR/SPBCG/SPTFQMR solver are available + * in IOUT(13)...IOUT(21) + * + * To obtain the optional outputs associated with the IDABBDPRE module, make + * the following call: + * CALL FIDABBDOPT (LENRWBBD, LENIWBBD, NGEBBD) + * The arguments returned are: + * LENRWBBD = length of real preconditioner work space, in realtype words. + * This size is local to the current process. + * LENIWBBD = length of integer preconditioner work space, in integer words. + * This size is local to the current process. + * NGEBBD = number of G(t,y,y') evaluations (calls to FIDAGLOCFN) so far. + * + * (8) Memory freeing: FIDAFREE + * To the free the internal memory created by the calls to FNVINITP and + * FIDAMALLOC, make the following call: + * CALL FIDAFREE + * + * ============================================================================== + */ + +#ifndef _FIDABBD_H +#define _FIDABBD_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +#if defined(F77_FUNC) + +#define FIDA_BBDINIT F77_FUNC(fidabbdinit, FIDABBDINIT) +#define FIDA_BBDREINIT F77_FUNC(fidabbdreinit, FIDABBDREINIT) +#define FIDA_BBDOPT F77_FUNC(fidabbdopt, FIDABBDOPT) +#define FIDA_GLOCFN F77_FUNC(fidaglocfn, FIDAGLOCFN) +#define FIDA_COMMFN F77_FUNC(fidacommfn, FIDACOMMFN) + +#else + +#define FIDA_BBDINIT fidabbdinit_ +#define FIDA_BBDREINIT fidabbdreinit_ +#define FIDA_BBDOPT fidabbdopt_ +#define FIDA_GLOCFN fidaglocfn_ +#define FIDA_COMMFN fidacommfn_ + +#endif + +/* Prototypes of exported functions */ + +void FIDA_BBDINIT(int *Nloc, int *mudq, int *mldq, int *mu, int *ml, realtype *dqrely, int *ier); +void FIDA_BBDOPT(long int *lenrwbbd, long int *leniwbbd, long int *ngebbd); + +/* Prototypes: Functions Called by the IDABBD Module */ + +int FIDAgloc(int Nloc, realtype t, N_Vector yy, N_Vector yp, N_Vector gval, void *user_data); +int FIDAcfn(int Nloc, realtype t, N_Vector yy, N_Vector yp, void *user_data); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidadense.c b/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidadense.c new file mode 100644 index 0000000..3c401b6 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidadense.c @@ -0,0 +1,115 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.5 $ + * $Date: 2007/04/30 19:29:00 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * Fortran/C interface routines for IDA/IDADENSE, for the case + * of a user-supplied Jacobian approximation routine. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "fida.h" /* actual function names, prototypes and global vars.*/ +#include "ida_impl.h" /* definition of IDAMem type */ + +#include + +/*************************************************/ + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + extern void FIDA_DJAC(int*, + realtype*, realtype*, realtype*, realtype*, + realtype*, + realtype*, realtype*, realtype*, + long int*, realtype*, + realtype*, realtype*, realtype*, + int*); + +#ifdef __cplusplus +} +#endif + +/*************************************************/ + +void FIDA_DENSESETJAC(int *flag, int *ier) +{ + *ier = 0; + + if (*flag == 0) { + + *ier = IDADlsSetDenseJacFn(IDA_idamem, NULL); + + } else { + + if (F2C_IDA_ewtvec == NULL) { + F2C_IDA_ewtvec = N_VClone(F2C_IDA_vec); + if (F2C_IDA_ewtvec == NULL) { + *ier = -1; + return; + } + } + + *ier = IDADlsSetDenseJacFn(IDA_idamem, FIDADenseJac); + } + + return; +} + +/*************************************************/ + +int FIDADenseJac(int N, realtype t, realtype c_j, + N_Vector yy, N_Vector yp, N_Vector rr, + DlsMat Jac, void *user_data, + N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) +{ + realtype *yy_data, *yp_data, *rr_data, *jacdata, *ewtdata, *v1data, *v2data, *v3data; + realtype h; + int ier; + FIDAUserData IDA_userdata; + + /* Initialize all pointers to NULL */ + yy_data = yp_data = rr_data = jacdata = ewtdata = NULL; + v1data = v2data = v3data = NULL; + + /* NOTE: The user-supplied routine should set ier to an + appropriate value, but we preset the value to zero + (meaning SUCCESS) so the user need only reset the + value if an error occurred */ + ier = 0; + + IDAGetErrWeights(IDA_idamem, F2C_IDA_ewtvec); + IDAGetLastStep(IDA_idamem, &h); + + /* Get pointers to vector data */ + yy_data = N_VGetArrayPointer(yy); + yp_data = N_VGetArrayPointer(yp); + rr_data = N_VGetArrayPointer(rr); + ewtdata = N_VGetArrayPointer(F2C_IDA_ewtvec); + v1data = N_VGetArrayPointer(vtemp1); + v2data = N_VGetArrayPointer(vtemp2); + v3data = N_VGetArrayPointer(vtemp3); + + jacdata = DENSE_COL(Jac,0); + + IDA_userdata = (FIDAUserData) user_data; + + /* Call user-supplied routine*/ + FIDA_DJAC(&N, &t, yy_data, yp_data, rr_data, jacdata, + &c_j, ewtdata, &h, + IDA_userdata->ipar, IDA_userdata->rpar, + v1data, v2data, v3data, &ier); + + return(ier); +} diff --git a/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidaewt.c b/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidaewt.c new file mode 100644 index 0000000..53ecf9c --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidaewt.c @@ -0,0 +1,87 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.3 $ + * $Date: 2007/04/30 19:29:00 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * Fortran/C interface routines for IDA, for the case of a + * user-supplied error weight calculation routine. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "fida.h" /* actual function names, prototypes and global vars.*/ +#include "ida_impl.h" /* definition of IDAMem type */ + +/*************************************************/ + +/* Prototype of user-supplied Fortran routine */ + +#ifdef __cplusplus /* wrapper to enable C++ usage (IDAEwtFn) */ +extern "C" { +#endif + + extern void FIDA_EWT(realtype*, realtype*, /* Y, EWT */ + long int*, realtype*, /* IPAR, RPAR */ + int*); /* IER */ + +#ifdef __cplusplus +} +#endif + +/*************************************************/ + +/* + * User-callable function to interface to IDASetEwtFn. + */ + +void FIDA_EWTSET(int *flag, int *ier) +{ + *ier = 0; + + if (*flag != 0) { + *ier = IDAWFtolerances(IDA_idamem, FIDAEwtSet); + } + + return; +} + +/*************************************************/ + +/* + * C function to interface between IDA and a Fortran subroutine FIDAVEWT. + */ + +int FIDAEwtSet(N_Vector y, N_Vector ewt, void *user_data) +{ + int ier; + realtype *y_data, *ewt_data; + FIDAUserData IDA_userdata; + + /* Initialize all pointers to NULL */ + y_data = ewt_data = NULL; + + /* NOTE: The user-supplied routine should set ier to an + appropriate value, but we preset the value to zero + (meaning SUCCESS) so the user need only reset the + value if an error occurred */ + ier = 0; + + y_data = N_VGetArrayPointer(y); + ewt_data = N_VGetArrayPointer(ewt); + + IDA_userdata = (FIDAUserData) user_data; + + /* Call user-supplied routine */ + FIDA_EWT(y_data, ewt_data, IDA_userdata->ipar, IDA_userdata->rpar, &ier); + + return(ier); +} diff --git a/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidajtimes.c b/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidajtimes.c new file mode 100644 index 0000000..cbd1adb --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidajtimes.c @@ -0,0 +1,116 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.3 $ + * $Date: 2007/04/30 19:29:00 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * The C function FIDAJtimes is to interface between the + * IDASPILS modules and the user-supplied Jacobian-vector + * product routine FIDAJTIMES. Note the use of the generic name + * FIDA_JTIMES below. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "fida.h" /* actual fn. names, prototypes and global vars.*/ +#include "ida_impl.h" /* definition of IDAMem type */ + +#include + +/*************************************************/ + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + extern void FIDA_JTIMES(realtype*, realtype*, realtype*, /* T, Y, YP */ + realtype*, realtype*, realtype*, /* R, V, FJV */ + realtype*, realtype*, realtype*, /* CJ, EWT, H */ + long int*, realtype*, /* IPAR, RPAR */ + realtype*, realtype*, /* WK1, WK2 */ + int*); /* IER */ + +#ifdef __cplusplus +} +#endif + +/*************************************************/ + +void FIDA_SPILSSETJAC(int *flag, int *ier) +{ + *ier = 0; + + if (*flag == 0) { + + *ier = IDASpilsSetJacTimesVecFn(IDA_idamem, NULL); + + } else { + + if (F2C_IDA_ewtvec == NULL) { + F2C_IDA_ewtvec = N_VClone(F2C_IDA_vec); + if (F2C_IDA_ewtvec == NULL) { + *ier = -1; + return; + } + } + + *ier = IDASpilsSetJacTimesVecFn(IDA_idamem, FIDAJtimes); + + } + + return; +} + +/*************************************************/ + +int FIDAJtimes(realtype t, N_Vector yy, N_Vector yp, N_Vector rr, + N_Vector v, N_Vector Jv, + realtype c_j, void *user_data, + N_Vector vtemp1, N_Vector vtemp2) +{ + realtype *yy_data, *yp_data, *rr_data, *vdata, *Jvdata, *ewtdata; + realtype *v1data, *v2data; + realtype h; + FIDAUserData IDA_userdata; + int ier; + + /* Initialize all pointers to NULL */ + yy_data = yp_data = rr_data = vdata = Jvdata = ewtdata = NULL; + + /* NOTE: The user-supplied routine should set ier to an + appropriate value, but we preset the value to zero + (meaning SUCCESS) so the user need only reset the + value if an error occurred */ + ier = 0; + + IDAGetErrWeights(IDA_idamem, F2C_IDA_ewtvec); + IDAGetLastStep(IDA_idamem, &h); + + /* Get pointers to vector data */ + yy_data = N_VGetArrayPointer(yy); + yp_data = N_VGetArrayPointer(yp); + rr_data = N_VGetArrayPointer(rr); + ewtdata = N_VGetArrayPointer(F2C_IDA_ewtvec); + vdata = N_VGetArrayPointer(v); + Jvdata = N_VGetArrayPointer(Jv); + v1data = N_VGetArrayPointer(vtemp1); + v2data = N_VGetArrayPointer(vtemp2); + + IDA_userdata = (FIDAUserData) user_data; + + /* Call user-supplied routine */ + FIDA_JTIMES(&t, yy_data, yp_data, rr_data, vdata, Jvdata, + &c_j, ewtdata, &h, + IDA_userdata->ipar, IDA_userdata->rpar, + v1data, v2data, &ier); + + return(ier); +} diff --git a/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidalapack.c b/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidalapack.c new file mode 100644 index 0000000..0ba0dfa --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidalapack.c @@ -0,0 +1,53 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.1 $ + * $Date: 2006/11/22 00:12:50 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * Fortran/C interface routines for IDA/IDALAPACK. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "fida.h" /* actual function names, prototypes and global vars.*/ +#include "ida_impl.h" /* definition of IDAMem type */ + +#include + +/*************************************************/ + +void FIDA_LAPACKDENSE(int *neq, int *ier) +{ + + *ier = 0; + + *ier = IDALapackDense(IDA_idamem, *neq); + + IDA_ls = IDA_LS_LAPACKDENSE; + + return; +} + +/*************************************************/ + +void FIDA_LAPACKBAND(int *neq, int *mupper, int *mlower, int *ier) +{ + + *ier = 0; + + *ier = IDALapackBand(IDA_idamem, *neq, *mupper, *mlower); + + IDA_ls = IDA_LS_LAPACKBAND; + + return; +} + +/*************************************************/ diff --git a/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidalapband.c b/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidalapband.c new file mode 100644 index 0000000..0601cc2 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidalapband.c @@ -0,0 +1,112 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.5 $ + * $Date: 2007/08/21 23:32:13 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * Fortran/C interface routines for IDA/IDALAPACK, for the case of + * a user-supplied Jacobian approximation routine. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "fida.h" /* function names, prototypes, global vars.*/ +#include "ida_impl.h" /* definition of IDAMem type */ + +#include + +/*************************************************/ + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + extern void FIDA_BJAC(int*, int*, int*, int*, + realtype*, realtype*, realtype*, realtype*, + realtype*, realtype*, realtype*, realtype*, + long int*, realtype*, + realtype*, realtype*, realtype*, int*); + +#ifdef __cplusplus +} +#endif + +/*************************************************/ + +void FIDA_BANDSETJAC(int *flag, int *ier) +{ + *ier = 0; + + if (*flag == 0) { + *ier = IDADlsSetBandJacFn(IDA_idamem, NULL); + } else { + if (F2C_IDA_ewtvec == NULL) { + F2C_IDA_ewtvec = N_VClone(F2C_IDA_vec); + if (F2C_IDA_ewtvec == NULL) { + *ier = -1; + return; + } + } + *ier = IDADlsSetBandJacFn(IDA_idamem, FIDABandJac); + } + + return; +} + +/*************************************************/ + +int FIDALapackBandJac(int N, int mupper, int mlower, + realtype t, realtype c_j, + N_Vector yy, N_Vector yp, N_Vector rr, + DlsMat J, void *user_data, + N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) +{ + realtype *yy_data, *yp_data, *rr_data, *jacdata, *ewtdata, *v1data, *v2data, *v3data; + realtype h; + int eband; + int ier; + FIDAUserData IDA_userdata; + + /* Initialize all pointers to NULL */ + yy_data = yp_data = rr_data = jacdata = ewtdata = NULL; + v1data = v2data = v3data = NULL; + + /* NOTE: The user-supplied routine should set ier to an + appropriate value, but we preset the value to zero + (meaning SUCCESS) so the user need only reset the + value if an error occurred */ + ier = 0; + + IDAGetErrWeights(IDA_idamem, F2C_IDA_ewtvec); + IDAGetLastStep(IDA_idamem, &h); + + /* Get pointers to vector data */ + yy_data = N_VGetArrayPointer(yy); + yp_data = N_VGetArrayPointer(yp); + rr_data = N_VGetArrayPointer(rr); + ewtdata = N_VGetArrayPointer(F2C_IDA_ewtvec); + v1data = N_VGetArrayPointer(vtemp1); + v2data = N_VGetArrayPointer(vtemp2); + v3data = N_VGetArrayPointer(vtemp3); + + eband = (J->s_mu) + mlower + 1; + jacdata = BAND_COL(J,0) - mupper; + + IDA_userdata = (FIDAUserData) user_data; + + /* Call user-supplied routine */ + FIDA_BJAC(&N, &mupper, &mlower, &eband, &t, yy_data, yp_data, rr_data, + &c_j, jacdata, ewtdata, &h, + IDA_userdata->ipar, IDA_userdata->rpar, + v1data, v2data, v3data, &ier); + + return(ier); +} diff --git a/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidalapdense.c b/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidalapdense.c new file mode 100644 index 0000000..93b1021 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidalapdense.c @@ -0,0 +1,111 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.5 $ + * $Date: 2007/08/21 23:32:13 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * Fortran/C interface routines for IDA/IDALAPACK, for the case + * of a user-supplied Jacobian approximation routine. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "fida.h" /* actual function names, prototypes and global vars.*/ +#include "ida_impl.h" /* definition of IDAMem type */ + +#include + +/*************************************************/ + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + extern void FIDA_DJAC(int*, + realtype*, realtype*, realtype*, realtype*, + realtype*, + realtype*, realtype*, realtype*, + long int*, realtype*, + realtype*, realtype*, realtype*, + int*); + +#ifdef __cplusplus +} +#endif + +/*************************************************/ + +void FIDA_LAPACKDENSESETJAC(int *flag, int *ier) +{ + *ier = 0; + + if (*flag == 0) { + *ier = IDADlsSetDenseJacFn(IDA_idamem, NULL); + } else { + if (F2C_IDA_ewtvec == NULL) { + F2C_IDA_ewtvec = N_VClone(F2C_IDA_vec); + if (F2C_IDA_ewtvec == NULL) { + *ier = -1; + return; + } + } + *ier = IDADlsSetDenseJacFn(IDA_idamem, FIDADenseJac); + } + + return; +} + +/*************************************************/ + +int FIDALapackDenseJac(int N, realtype t, realtype c_j, + N_Vector yy, N_Vector yp, N_Vector rr, + DlsMat Jac, void *user_data, + N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) +{ + realtype *yy_data, *yp_data, *rr_data, *jacdata, *ewtdata, *v1data, *v2data, *v3data; + realtype h; + int ier; + FIDAUserData IDA_userdata; + + /* Initialize all pointers to NULL */ + yy_data = yp_data = rr_data = jacdata = ewtdata = NULL; + v1data = v2data = v3data = NULL; + + /* NOTE: The user-supplied routine should set ier to an + appropriate value, but we preset the value to zero + (meaning SUCCESS) so the user need only reset the + value if an error occurred */ + ier = 0; + + IDAGetErrWeights(IDA_idamem, F2C_IDA_ewtvec); + IDAGetLastStep(IDA_idamem, &h); + + /* Get pointers to vector data */ + yy_data = N_VGetArrayPointer(yy); + yp_data = N_VGetArrayPointer(yp); + rr_data = N_VGetArrayPointer(rr); + ewtdata = N_VGetArrayPointer(F2C_IDA_ewtvec); + v1data = N_VGetArrayPointer(vtemp1); + v2data = N_VGetArrayPointer(vtemp2); + v3data = N_VGetArrayPointer(vtemp3); + + jacdata = DENSE_COL(Jac,0); + + IDA_userdata = (FIDAUserData) user_data; + + /* Call user-supplied routine*/ + FIDA_DJAC(&N, &t, yy_data, yp_data, rr_data, jacdata, + &c_j, ewtdata, &h, + IDA_userdata->ipar, IDA_userdata->rpar, + v1data, v2data, v3data, &ier); + + return(ier); +} diff --git a/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidapreco.c b/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidapreco.c new file mode 100644 index 0000000..9b01417 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidapreco.c @@ -0,0 +1,159 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.3 $ + * $Date: 2007/04/30 19:29:00 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * The C function FIDAPSet is to interface between the IDASPILS + * modules and the user-supplied preconditioner setup routine FIDAPSET. + * Note the use of the generic name FIDA_PSET below. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "fida.h" /* actual fn. names, prototypes and global vars.*/ +#include "ida_impl.h" /* definition of IDAMem type */ + +#include + +/*************************************************/ + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + extern void FIDA_PSET(realtype*, realtype*, realtype*, realtype*, + realtype*, realtype*, realtype*, + long int*, realtype*, + realtype*, realtype*, realtype*, + int*); + + extern void FIDA_PSOL(realtype*, realtype*, realtype*, realtype*, + realtype*, realtype*, realtype*, realtype*, + realtype*, + long int*, realtype*, + realtype*, int*); + +#ifdef __cplusplus +} +#endif + +/*************************************************/ + +void FIDA_SPILSSETPREC(int *flag, int *ier) +{ + *ier = 0; + + if (*flag == 0) { + + *ier = IDASpilsSetPreconditioner(IDA_idamem, NULL, NULL); + + } else { + + if (F2C_IDA_ewtvec == NULL) { + F2C_IDA_ewtvec = N_VClone(F2C_IDA_vec); + if (F2C_IDA_ewtvec == NULL) { + *ier = -1; + return; + } + } + + *ier = IDASpilsSetPreconditioner(IDA_idamem, (IDASpilsPrecSetupFn) FIDAPSet, + (IDASpilsPrecSolveFn) FIDAPSol); + } + + return; +} + +/*************************************************/ + +int FIDAPSet(realtype t, N_Vector yy, N_Vector yp, N_Vector rr, + realtype c_j, void *user_data, + N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) +{ + realtype *yy_data, *yp_data, *rr_data, *ewtdata, *v1data, *v2data, *v3data; + realtype h; + int ier; + FIDAUserData IDA_userdata; + + /* Initialize all pointers to NULL */ + yy_data = yp_data = rr_data = ewtdata = NULL; + v1data = v2data = v3data = NULL; + + /* NOTE: The user-supplied routine should set ier to an + appropriate value, but we preset the value to zero + (meaning SUCCESS) so the user need only reset the + value if an error occurred */ + ier = 0; + + IDAGetErrWeights(IDA_idamem, F2C_IDA_ewtvec); + IDAGetLastStep(IDA_idamem, &h); + + /* Get pointers to vector data */ + yy_data = N_VGetArrayPointer(yy); + yp_data = N_VGetArrayPointer(yp); + rr_data = N_VGetArrayPointer(rr); + ewtdata = N_VGetArrayPointer(F2C_IDA_ewtvec); + v1data = N_VGetArrayPointer(vtemp1); + v2data = N_VGetArrayPointer(vtemp2); + v3data = N_VGetArrayPointer(vtemp3); + + IDA_userdata = (FIDAUserData) user_data; + + /* Call user-supplied routine */ + FIDA_PSET(&t, yy_data, yp_data, rr_data, &c_j, ewtdata, &h, + IDA_userdata->ipar, IDA_userdata->rpar, + v1data, v2data, v3data, &ier); + + return(ier); +} + +/*************************************************/ + +int FIDAPSol(realtype t, N_Vector yy, N_Vector yp, N_Vector rr, + N_Vector rvec, N_Vector zvec, + realtype c_j, realtype delta, void *user_data, + N_Vector vtemp1) +{ + realtype *yy_data, *yp_data, *rr_data, *ewtdata, *rdata, *zdata, *v1data; + int ier; + FIDAUserData IDA_userdata; + + /* Initialize all pointers to NULL */ + yy_data = yp_data = rr_data = ewtdata = user_data = zdata = v1data = NULL; + + /* NOTE: The user-supplied routine should set ier to an + appropriate value, but we preset the value to zero + (meaning SUCCESS) so the user need only reset the + value if an error occurred */ + ier = 0; + + IDAGetErrWeights(IDA_idamem, F2C_IDA_ewtvec); + + /* Get pointers to vector data */ + yy_data = N_VGetArrayPointer(yy); + yp_data = N_VGetArrayPointer(yp); + rr_data = N_VGetArrayPointer(rr); + ewtdata = N_VGetArrayPointer(F2C_IDA_ewtvec); + rdata = N_VGetArrayPointer(rvec); + zdata = N_VGetArrayPointer(zvec); + v1data = N_VGetArrayPointer(vtemp1); + + IDA_userdata = (FIDAUserData) user_data; + + /* Call user-supplied routine */ + FIDA_PSOL(&t, yy_data, yp_data, rr_data, rdata, zdata, + &c_j, &delta, ewtdata, + IDA_userdata->ipar, IDA_userdata->rpar, + v1data, &ier); + + return(ier); +} diff --git a/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidaroot.c b/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidaroot.c new file mode 100644 index 0000000..0548dbb --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidaroot.c @@ -0,0 +1,88 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.3 $ + * $Date: 2007/04/30 19:29:00 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier and Alan C. Hindmarsh @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * The FIDAROOT module contains the routines necessary to use + * the rootfinding feature of the IDA module and to interface + * with the user-supplied Fortran subroutine. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "fida.h" /* actual function names, prototypes and global vars.*/ +#include "fidaroot.h" /* prototypes of interfaces to IDA */ +#include "ida_impl.h" /* definition of IDAMeme type */ + +/***************************************************************************/ + +/* Prototype of the Fortran routine */ + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + extern void FIDA_ROOTFN(realtype*, /* T */ + realtype*, /* Y */ + realtype*, /* YP */ + realtype*, /* G */ + long int*, /* IPAR */ + realtype*, /* RPAR */ + int*); /* IER */ +#ifdef __cplusplus +} +#endif + +/***************************************************************************/ + +void FIDA_ROOTINIT(int *nrtfn, int *ier) +{ + *ier = IDARootInit(IDA_idamem, *nrtfn, (IDARootFn) FIDArootfunc); + IDA_nrtfn = *nrtfn; + + return; +} + +/***************************************************************************/ + +void FIDA_ROOTINFO(int *nrtfn, int *info, int *ier) +{ + *ier = IDAGetRootInfo(IDA_idamem, info); + return; +} + +/***************************************************************************/ + +void FIDA_ROOTFREE(void) +{ + IDARootInit(IDA_idamem, 0, NULL); + + return; +} + +/***************************************************************************/ + +int FIDArootfunc(realtype t, N_Vector y, N_Vector yp, realtype *gout, + void *user_data) +{ + int ier; + realtype *ydata, *ypdata; + FIDAUserData IDA_userdata; + + ydata = N_VGetArrayPointer(y); + ypdata = N_VGetArrayPointer(yp); + + IDA_userdata = (FIDAUserData) user_data; + + FIDA_ROOTFN(&t, ydata, ypdata, gout, IDA_userdata->ipar, IDA_userdata->rpar, &ier); + + return(ier); +} diff --git a/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidaroot.h b/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidaroot.h new file mode 100644 index 0000000..210de4c --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/fcmix/fidaroot.h @@ -0,0 +1,142 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.4 $ + * $Date: 2007/04/30 19:29:00 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier and Alan C. Hindmarsh @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the Fortran interface include file for the rootfinding + * feature of IDA. + * ----------------------------------------------------------------- + */ + +/* + * ============================================================================== + * + * FIDAROOT Interface Package + * + * The FIDAROOT interface package allows programs written in FORTRAN to + * use the rootfinding feature of the IDA solver module. + * + * The user-callable functions constituting the FIDAROOT package are the + * following: FIDAROOTINIT, FIDAROOTINFO, and FIDAROOTFREE. The corresponding + * IDA subroutine called by each interface function is given below. + * + * ------------------ --------------------- + * | FIDAROOT routine | | IDA function called | + * ------------------ --------------------- + * FIDAROOTINIT -> IDARootInit + * FIDAROOTINFO -> IDAGetRootInfo + * FIDAROOTFREE -> IDARootInit + * + * FIDAROOTFN is a user-supplied subroutine defining the functions whose + * roots are sought. + * + * ============================================================================== + * + * Usage of the FIDAROOT Interface Package + * + * 1. In order to use the rootfinding feature of the IDA package the user must + * define the following subroutine: + * + * SUBROUTINE FIDAROOTFN (T, Y, YP, G, IPAR, RPAR, IER) + * DIMENSION Y(*), YP(*), G(*) + * + * The arguments are: + * T = independent variable value t [input] + * Y = dependent variable vector y [input] + * YP = dependent variable derivative vector y' [input] + * G = function values g(t,y,y') [output] + * IPAR, RPAR = user (integer and real) data [input/output] + * IER = return flag (set on 0 if successful, non-zero if an error occurred) + * + * 2. After calling FIDAMALLOC but prior to calling FIDASOLVE, the user must + * allocate and initialize memory for the FIDAROOT module by making the + * following call: + * + * CALL FIDAROOTINIT (NRTFN, IER) + * + * The arguments are: + * NRTFN = total number of root functions [input] + * IER = return completion flag (0 = success, -1 = IDA memory NULL and + * -14 = memory allocation error) [output] + * + * 3. After calling FIDA, to see whether a root was found, test the FIDA + * return flag IER. The value IER = 2 means one or more roots were found. + * + * 4. If a root was found, and if NRTFN > 1, then to determine which root + * functions G(*) were found to have a root, make the following call: + * CALL FIDAROOTINFO (NRTFN, INFO, IER) + * The arguments are: + * NRTFN = total number of root functions [input] + * INFO = integer array of length NRTFN, with values 0 or 1 [output] + * For i = 1,...,NRTFN, G(i) was found to have a root if INFO(i) = 1. + * IER = completion flag (0 = success, negative = failure) + * + * 5. The total number of calls made to the root function (FIDAROOTFN), + * NGE, can be obtained from IOUT(12). + * + * If the FIDA/IDA memory block is reinitialized to solve a different + * problem via a call to FIDAREINIT, then the counter variable NGE is cleared + * (reset to zero). + * + * 6. To free the memory resources allocated by a prior call to FIDAROOTINIT, + * make the following call: + * CALL FIDAROOTFREE + * See the IDA documentation for additional information. + * + * ============================================================================== + */ + +#ifndef _FIDAROOT_H +#define _FIDAROOT_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* header files */ + +#include /* definition of type N_Vector */ +#include /* definition of SUNDIALS type realtype */ + +/* Definitions of interface function names */ + +#if defined(F77_FUNC) + +#define FIDA_ROOTINIT F77_FUNC(fidarootinit, FIDAROOTINIT) +#define FIDA_ROOTINFO F77_FUNC(fidarootinfo, FIDAROOTINFO) +#define FIDA_ROOTFREE F77_FUNC(fidarootfree, FIDAROOTFREE) +#define FIDA_ROOTFN F77_FUNC(fidarootfn, FIDAROOTFN) + +#else + +#define FIDA_ROOTINIT fidarootinit_ +#define FIDA_ROOTINFO fidarootinfo_ +#define FIDA_ROOTFREE fidarootfree_ +#define FIDA_ROOTFN fidarootfn_ + +#endif + +/* Prototypes of exported function */ + +void FIDA_ROOTINIT(int *nrtfn, int *ier); +void FIDA_ROOTINFO(int *nrtfn, int *info, int *ier); +void FIDA_ROOTFREE(void); + +/* Prototype of function called by IDA module */ + +int FIDArootfunc(realtype t, N_Vector y, N_Vector yp, realtype *gout, + void *user_data); + +#ifdef __cplusplus +} +#endif + + +#endif diff --git a/odemex/Parser/CVode/ida_src/src/ida/ida.c b/odemex/Parser/CVode/ida_src/src/ida/ida.c new file mode 100644 index 0000000..62f03ff --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/ida.c @@ -0,0 +1,3339 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.22 $ + * $Date: 2009/05/06 22:12:11 $ + * ----------------------------------------------------------------- + * Programmer(s): Alan Hindmarsh, Radu Serban and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for the main IDA solver. + * It is independent of the linear solver in use. + * ----------------------------------------------------------------- + * + * EXPORTED FUNCTIONS + * ------------------ + * Creation, allocation and re-initialization functions + * IDACreate + * IDAInit + * IDAReInit + * IDARootInit + * Main solver function + * IDASolve + * Interpolated output and extraction functions + * IDAGetSolution + * Deallocation functions + * IDAFree + * + * PRIVATE FUNCTIONS + * ----------------- + * IDACheckNvector + * Memory allocation/deallocation + * IDAAllocVectors + * IDAFreeVectors + * Initial setup + * IDAInitialSetup + * IDAEwtSet + * IDAEwtSetSS + * IDAEwtSetSV + * Stopping tests + * IDAStopTest1 + * IDAStopTest2 + * Error handler + * IDAHandleFailure + * Main IDAStep function + * IDAStep + * IDASetCoeffs + * Nonlinear solver functions + * IDANls + * IDAPredict + * IDANewtonIter + * Error test + * IDATestError + * IDARestore + * Handler for convergence and/or error test failures + * IDAHandleNFlag + * IDAReset + * Function called after a successful step + * IDACompleteStep + * Norm functions + * IDAWrmsNorm + * Functions for rootfinding + * IDARcheck1 + * IDARcheck2 + * IDARcheck3 + * IDARootfind + * IDA Error message handling functions + * IDAProcessError + * IDAErrHandler + * ----------------------------------------------------------------- + */ + +/* + * ================================================================= + * IMPORTED HEADER FILES + * ================================================================= + */ + +#include +#include +#include +#include + +#include "ida_impl.h" +#include + +/* + * ================================================================= + * MACRO DEFINITIONS + * ================================================================= + */ + +/* Macro: loop */ +#define loop for(;;) + +/* + * ================================================================= + * IDAS PRIVATE CONSTANTS + * ================================================================= + */ + +#define ZERO RCONST(0.0) /* real 0.0 */ +#define HALF RCONST(0.5) /* real 0.5 */ +#define QUARTER RCONST(0.25) /* real 0.25 */ +#define TWOTHIRDS RCONST(0.667) /* real 2/3 */ +#define ONE RCONST(1.0) /* real 1.0 */ +#define ONEPT5 RCONST(1.5) /* real 1.5 */ +#define TWO RCONST(2.0) /* real 2.0 */ +#define FOUR RCONST(4.0) /* real 4.0 */ +#define FIVE RCONST(5.0) /* real 5.0 */ +#define TEN RCONST(10.0) /* real 10.0 */ +#define TWELVE RCONST(12.0) /* real 12.0 */ +#define TWENTY RCONST(20.0) /* real 20.0 */ +#define HUNDRED RCONST(100.0) /* real 100.0 */ +#define PT9 RCONST(0.9) /* real 0.9 */ +#define PT99 RCONST(0.99) /* real 0.99 */ +#define PT1 RCONST(0.1) /* real 0.1 */ +#define PT01 RCONST(0.01) /* real 0.01 */ +#define PT001 RCONST(0.001) /* real 0.001 */ +#define PT0001 RCONST(0.0001) /* real 0.0001 */ + +/* + * ================================================================= + * IDAS ROUTINE-SPECIFIC CONSTANTS + * ================================================================= + */ + +/* + * Control constants for lower-level functions used by IDASolve + * ------------------------------------------------------------ + */ + +/* IDAStep control constants */ + +#define PREDICT_AGAIN 20 + +/* Return values for lower level routines used by IDASolve */ + +#define IDA_RES_RECVR +1 +#define IDA_LSETUP_RECVR +2 +#define IDA_LSOLVE_RECVR +3 + +#define IDA_NCONV_RECVR +4 +#define IDA_CONSTR_RECVR +5 +#define CONTINUE_STEPS +99 + +/* IDACompleteStep constants */ + +#define UNSET -1 +#define LOWER +1 +#define RAISE +2 +#define MAINTAIN +3 + +/* IDATestError constants */ + +#define ERROR_TEST_FAIL +7 + +/* + * Control constants for lower-level rootfinding functions + * ------------------------------------------------------- + */ + +#define RTFOUND +1 +#define CLOSERT +3 + +/* + * Control constants for tolerances + * -------------------------------- + */ + +#define IDA_NN 0 +#define IDA_SS 1 +#define IDA_SV 2 +#define IDA_WF 3 + +/* + * Algorithmic constants + * --------------------- + */ + +#define MXNCF 10 /* max number of convergence failures allowed */ +#define MXNEF 10 /* max number of error test failures allowed */ +#define MAXNH 5 /* max. number of h tries in IC calc. */ +#define MAXNJ 4 /* max. number of J tries in IC calc. */ +#define MAXNI 10 /* max. Newton iterations in IC calc. */ +#define EPCON RCONST(0.33) /* Newton convergence test constant */ + +/* IDANewtonIter constants */ + +#define MAXIT 4 +#define RATEMAX RCONST(0.9) +#define XRATE RCONST(0.25) + +/* + * ================================================================= + * PRIVATE FUNCTION PROTOTYPES + * ================================================================= + */ + +static booleantype IDACheckNvector(N_Vector tmpl); + +/* Memory allocation/deallocation */ + +static booleantype IDAAllocVectors(IDAMem IDA_mem, N_Vector tmpl); +static void IDAFreeVectors(IDAMem IDA_mem); + +/* Initial setup */ + +int IDAInitialSetup(IDAMem IDA_mem); +static int IDAEwtSetSS(IDAMem IDA_mem, N_Vector ycur, N_Vector weight); +static int IDAEwtSetSV(IDAMem IDA_mem, N_Vector ycur, N_Vector weight); + +/* Main IDAStep function */ + +static int IDAStep(IDAMem IDA_mem); + +/* Function called at beginning of step */ + +static void IDASetCoeffs(IDAMem IDA_mem, realtype *ck); + +/* Nonlinear solver functions */ + +static void IDAPredict(IDAMem IDA_mem); +static int IDANls(IDAMem IDA_mem); +static int IDANewtonIter(IDAMem IDA_mem); + +/* Error test */ + +static int IDATestError(IDAMem IDA_mem, realtype ck, + realtype *err_k, realtype *err_km1); + +/* Handling of convergence and/or error test failures */ + +static void IDARestore(IDAMem IDA_mem, realtype saved_t); +static int IDAHandleNFlag(IDAMem IDA_mem, int nflag, realtype err_k, realtype err_km1, + long int *ncfnPtr, int *ncfPtr, long int *netfPtr, int *nefPtr); +static void IDAReset(IDAMem IDA_mem); + +/* Function called after a successful step */ + +static void IDACompleteStep(IDAMem IDA_mem, realtype err_k, realtype err_km1); + +/* Stopping tests and failure handling */ + +static int IDAStopTest1(IDAMem IDA_mem, realtype tout,realtype *tret, + N_Vector yret, N_Vector ypret, int itask); +static int IDAStopTest2(IDAMem IDA_mem, realtype tout, realtype *tret, + N_Vector yret, N_Vector ypret, int itask); +static int IDAHandleFailure(IDAMem IDA_mem, int sflag); + +/* Functions for rootfinding */ + +static int IDARcheck1(IDAMem IDA_mem); +static int IDARcheck2(IDAMem IDA_mem); +static int IDARcheck3(IDAMem IDA_mem); +static int IDARootfind(IDAMem IDA_mem); + +/* Norm functions */ + +realtype IDAWrmsNorm(IDAMem IDA_mem, N_Vector x, N_Vector w, booleantype mask); + +/* + * ================================================================= + * EXPORTED FUNCTIONS IMPLEMENTATION + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Creation, allocation and re-initialization functions + * ----------------------------------------------------------------- + */ + +/* + * IDACreate + * + * IDACreate creates an internal memory block for a problem to + * be solved by IDA. + * If successful, IDACreate returns a pointer to the problem memory. + * This pointer should be passed to IDAInit. + * If an initialization error occurs, IDACreate prints an error + * message to standard err and returns NULL. + */ + +void *IDACreate(void) +{ + IDAMem IDA_mem; + + IDA_mem = NULL; + IDA_mem = (IDAMem) malloc(sizeof(struct IDAMemRec)); + if (IDA_mem == NULL) { + IDAProcessError(NULL, 0, "IDA", "IDACreate", MSG_MEM_FAIL); + return (NULL); + } + + /* Set unit roundoff in IDA_mem */ + IDA_mem->ida_uround = UNIT_ROUNDOFF; + + /* Set default values for integrator optional inputs */ + IDA_mem->ida_res = NULL; + IDA_mem->ida_user_data = NULL; + IDA_mem->ida_itol = IDA_NN; + IDA_mem->ida_user_efun = FALSE; + IDA_mem->ida_efun = NULL; + IDA_mem->ida_edata = NULL; + IDA_mem->ida_ehfun = IDAErrHandler; + IDA_mem->ida_eh_data = IDA_mem; + IDA_mem->ida_errfp = stderr; + IDA_mem->ida_maxord = MAXORD_DEFAULT; + IDA_mem->ida_mxstep = MXSTEP_DEFAULT; + IDA_mem->ida_hmax_inv = HMAX_INV_DEFAULT; + IDA_mem->ida_hin = ZERO; + IDA_mem->ida_epcon = EPCON; + IDA_mem->ida_maxnef = MXNEF; + IDA_mem->ida_maxncf = MXNCF; + IDA_mem->ida_maxcor = MAXIT; + IDA_mem->ida_suppressalg = FALSE; + IDA_mem->ida_id = NULL; + IDA_mem->ida_constraints = NULL; + IDA_mem->ida_constraintsSet = FALSE; + IDA_mem->ida_tstopset = FALSE; + + /* set the saved value maxord_alloc */ + IDA_mem->ida_maxord_alloc = MAXORD_DEFAULT; + + /* Set default values for IC optional inputs */ + IDA_mem->ida_epiccon = PT01 * EPCON; + IDA_mem->ida_maxnh = MAXNH; + IDA_mem->ida_maxnj = MAXNJ; + IDA_mem->ida_maxnit = MAXNI; + IDA_mem->ida_lsoff = FALSE; + IDA_mem->ida_steptol = RPowerR(IDA_mem->ida_uround, TWOTHIRDS); + + /* Initialize lrw and liw */ + IDA_mem->ida_lrw = 25 + 5*MXORDP1; + IDA_mem->ida_liw = 38; + + /* No mallocs have been done yet */ + IDA_mem->ida_VatolMallocDone = FALSE; + IDA_mem->ida_constraintsMallocDone = FALSE; + IDA_mem->ida_idMallocDone = FALSE; + IDA_mem->ida_MallocDone = FALSE; + + /* Return pointer to IDA memory block */ + return((void *)IDA_mem); +} + +/*-----------------------------------------------------------------*/ + +#define lrw (IDA_mem->ida_lrw) +#define liw (IDA_mem->ida_liw) + +/*-----------------------------------------------------------------*/ + +/*-----------------------------------------------------------------*/ +/* Added by Joep Vanlier */ + +int IDASetMaxTime( void *ida_mem, double maxTime ) +{ + IDAMem IDA_mem; + + if (ida_mem == NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAInit", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + IDA_mem->tMax = maxTime; +} + +/*-----------------------------------------------------------------*/ + +/*-----------------------------------------------------------------*/ + +/* + * IDAInit + * + * IDAInit allocates and initializes memory for a problem. All + * problem specification inputs are checked for errors. If any + * error occurs during initialization, it is reported to the + * error handler function. + */ + +int IDAInit(void *ida_mem, IDAResFn res, + realtype t0, N_Vector yy0, N_Vector yp0) +{ + IDAMem IDA_mem; + booleantype nvectorOK, allocOK; + long int lrw1, liw1; + + /* Check ida_mem */ + + if (ida_mem == NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAInit", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + /* Set max integration time Joep Vanlier */ + + IDA_mem->tMax = DBL_MAX; + + /* Check for legal input parameters */ + + if (yy0 == NULL) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInit", MSG_Y0_NULL); + return(IDA_ILL_INPUT); + } + + if (yp0 == NULL) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInit", MSG_YP0_NULL); + return(IDA_ILL_INPUT); + } + + if (res == NULL) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInit", MSG_RES_NULL); + return(IDA_ILL_INPUT); + } + + /* Test if all required vector operations are implemented */ + + nvectorOK = IDACheckNvector(yy0); + if (!nvectorOK) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInit", MSG_BAD_NVECTOR); + return(IDA_ILL_INPUT); + } + + /* Set space requirements for one N_Vector */ + + if (yy0->ops->nvspace != NULL) { + N_VSpace(yy0, &lrw1, &liw1); + } else { + lrw1 = 0; + liw1 = 0; + } + IDA_mem->ida_lrw1 = lrw1; + IDA_mem->ida_liw1 = liw1; + + /* Allocate the vectors (using yy0 as a template) */ + + allocOK = IDAAllocVectors(IDA_mem, yy0); + if (!allocOK) { + IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDA", "IDAInit", MSG_MEM_FAIL); + return(IDA_MEM_FAIL); + } + + /* All error checking is complete at this point */ + + /* Copy the input parameters into IDA memory block */ + + IDA_mem->ida_res = res; + IDA_mem->ida_tn = t0; + + /* Set the linear solver addresses to NULL */ + + IDA_mem->ida_linit = NULL; + IDA_mem->ida_lsetup = NULL; + IDA_mem->ida_lsolve = NULL; + IDA_mem->ida_lperf = NULL; + IDA_mem->ida_lfree = NULL; + IDA_mem->ida_lmem = NULL; + + /* Initialize the phi array */ + + N_VScale(ONE, yy0, IDA_mem->ida_phi[0]); + N_VScale(ONE, yp0, IDA_mem->ida_phi[1]); + + /* Initialize all the counters and other optional output values */ + + IDA_mem->ida_nst = 0; + IDA_mem->ida_nre = 0; + IDA_mem->ida_ncfn = 0; + IDA_mem->ida_netf = 0; + IDA_mem->ida_nni = 0; + IDA_mem->ida_nsetups = 0; + + IDA_mem->ida_kused = 0; + IDA_mem->ida_hused = ZERO; + IDA_mem->ida_tolsf = ONE; + + IDA_mem->ida_nge = 0; + + IDA_mem->ida_irfnd = 0; + + /* Initialize root-finding variables */ + + IDA_mem->ida_glo = NULL; + IDA_mem->ida_ghi = NULL; + IDA_mem->ida_grout = NULL; + IDA_mem->ida_iroots = NULL; + IDA_mem->ida_rootdir = NULL; + IDA_mem->ida_gfun = NULL; + IDA_mem->ida_nrtfn = 0; + IDA_mem->ida_gactive = NULL; + IDA_mem->ida_mxgnull = 1; + + /* Initial setup not done yet */ + + IDA_mem->ida_SetupDone = FALSE; + + /* Problem memory has been successfully allocated */ + + IDA_mem->ida_MallocDone = TRUE; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +#define lrw1 (IDA_mem->ida_lrw1) +#define liw1 (IDA_mem->ida_liw1) + +/*-----------------------------------------------------------------*/ + +/* + * IDAReInit + * + * IDAReInit re-initializes IDA's memory for a problem, assuming + * it has already beeen allocated in a prior IDAInit call. + * All problem specification inputs are checked for errors. + * The problem size Neq is assumed to be unchaged since the call + * to IDAInit, and the maximum order maxord must not be larger. + * If any error occurs during reinitialization, it is reported to + * the error handler function. + * The return value is IDA_SUCCESS = 0 if no errors occurred, or + * a negative value otherwise. + */ + +int IDAReInit(void *ida_mem, + realtype t0, N_Vector yy0, N_Vector yp0) +{ + IDAMem IDA_mem; + + /* Check for legal input parameters */ + + if (ida_mem == NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAReInit", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + /* Check if problem was malloc'ed */ + + if (IDA_mem->ida_MallocDone == FALSE) { + IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDA", "IDAReInit", MSG_NO_MALLOC); + return(IDA_NO_MALLOC); + } + + /* Check for legal input parameters */ + + if (yy0 == NULL) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAReInit", MSG_Y0_NULL); + return(IDA_ILL_INPUT); + } + + if (yp0 == NULL) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAReInit", MSG_YP0_NULL); + return(IDA_ILL_INPUT); + } + + /* Copy the input parameters into IDA memory block */ + + IDA_mem->ida_tn = t0; + + /* Initialize the phi array */ + + N_VScale(ONE, yy0, IDA_mem->ida_phi[0]); + N_VScale(ONE, yp0, IDA_mem->ida_phi[1]); + + /* Initialize all the counters and other optional output values */ + + IDA_mem->ida_nst = 0; + IDA_mem->ida_nre = 0; + IDA_mem->ida_ncfn = 0; + IDA_mem->ida_netf = 0; + IDA_mem->ida_nni = 0; + IDA_mem->ida_nsetups = 0; + + IDA_mem->ida_kused = 0; + IDA_mem->ida_hused = ZERO; + IDA_mem->ida_tolsf = ONE; + + IDA_mem->ida_nge = 0; + + IDA_mem->ida_irfnd = 0; + + /* Initial setup not done yet */ + + IDA_mem->ida_SetupDone = FALSE; + + /* Problem has been successfully re-initialized */ + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +/* + * IDASStolerances + * IDASVtolerances + * IDAWFtolerances + * + * These functions specify the integration tolerances. One of them + * MUST be called before the first call to IDA. + * + * IDASStolerances specifies scalar relative and absolute tolerances. + * IDASVtolerances specifies scalar relative tolerance and a vector + * absolute tolerance (a potentially different absolute tolerance + * for each vector component). + * IDAWFtolerances specifies a user-provides function (of type IDAEwtFn) + * which will be called to set the error weight vector. + */ + +int IDASStolerances(void *ida_mem, realtype reltol, realtype abstol) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASStolerances", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + if (IDA_mem->ida_MallocDone == FALSE) { + IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDA", "IDASStolerances", MSG_NO_MALLOC); + return(IDA_NO_MALLOC); + } + + /* Check inputs */ + + if (reltol < ZERO) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASStolerances", MSG_BAD_RTOL); + return(IDA_ILL_INPUT); + } + + if (abstol < ZERO) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASStolerances", MSG_BAD_ATOL); + return(IDA_ILL_INPUT); + } + + /* Copy tolerances into memory */ + + IDA_mem->ida_rtol = reltol; + IDA_mem->ida_Satol = abstol; + + IDA_mem->ida_itol = IDA_SS; + + IDA_mem->ida_user_efun = FALSE; + IDA_mem->ida_efun = IDAEwtSet; + IDA_mem->ida_edata = NULL; /* will be set to ida_mem in InitialSetup; */ + + return(IDA_SUCCESS); +} + + +int IDASVtolerances(void *ida_mem, realtype reltol, N_Vector abstol) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASVtolerances", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + if (IDA_mem->ida_MallocDone == FALSE) { + IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDA", "IDASVtolerances", MSG_NO_MALLOC); + return(IDA_NO_MALLOC); + } + + /* Check inputs */ + + if (reltol < ZERO) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASVtolerances", MSG_BAD_RTOL); + return(IDA_ILL_INPUT); + } + + if (N_VMin(abstol) < ZERO) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASVtolerances", MSG_BAD_ATOL); + return(IDA_ILL_INPUT); + } + + /* Copy tolerances into memory */ + + if ( !(IDA_mem->ida_VatolMallocDone) ) { + IDA_mem->ida_Vatol = N_VClone(IDA_mem->ida_ewt); + lrw += lrw1; + liw += liw1; + IDA_mem->ida_VatolMallocDone = TRUE; + } + + IDA_mem->ida_rtol = reltol; + N_VScale(ONE, abstol, IDA_mem->ida_Vatol); + + IDA_mem->ida_itol = IDA_SV; + + IDA_mem->ida_user_efun = FALSE; + IDA_mem->ida_efun = IDAEwtSet; + IDA_mem->ida_edata = NULL; /* will be set to ida_mem in InitialSetup; */ + + return(IDA_SUCCESS); +} + + +int IDAWFtolerances(void *ida_mem, IDAEwtFn efun) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAWFtolerances", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + if (IDA_mem->ida_MallocDone == FALSE) { + IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDA", "IDAWFtolerances", MSG_NO_MALLOC); + return(IDA_NO_MALLOC); + } + + IDA_mem->ida_itol = IDA_WF; + + IDA_mem->ida_user_efun = TRUE; + IDA_mem->ida_efun = efun; + IDA_mem->ida_edata = NULL; /* will be set to user_data in InitialSetup */ + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +#define gfun (IDA_mem->ida_gfun) +#define glo (IDA_mem->ida_glo) +#define ghi (IDA_mem->ida_ghi) +#define grout (IDA_mem->ida_grout) +#define iroots (IDA_mem->ida_iroots) +#define rootdir (IDA_mem->ida_rootdir) +#define gactive (IDA_mem->ida_gactive) + +/*-----------------------------------------------------------------*/ + +/* + * IDARootInit + * + * IDARootInit initializes a rootfinding problem to be solved + * during the integration of the DAE system. It loads the root + * function pointer and the number of root functions, and allocates + * workspace memory. The return value is IDA_SUCCESS = 0 if no + * errors occurred, or a negative value otherwise. + */ + +int IDARootInit(void *ida_mem, int nrtfn, IDARootFn g) +{ + IDAMem IDA_mem; + int i, nrt; + + /* Check ida_mem pointer */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDARootInit", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + nrt = (nrtfn < 0) ? 0 : nrtfn; + + /* If rerunning IDARootInit() with a different number of root + functions (changing number of gfun components), then free + currently held memory resources */ + if ((nrt != IDA_mem->ida_nrtfn) && (IDA_mem->ida_nrtfn > 0)) { + + free(glo); glo = NULL; + free(ghi); ghi = NULL; + free(grout); grout = NULL; + free(iroots); iroots = NULL; + free(rootdir); iroots = NULL; + free(gactive); gactive = NULL; + + lrw -= 3 * (IDA_mem->ida_nrtfn); + liw -= 3 * (IDA_mem->ida_nrtfn); + + } + + /* If IDARootInit() was called with nrtfn == 0, then set ida_nrtfn to + zero and ida_gfun to NULL before returning */ + if (nrt == 0) { + IDA_mem->ida_nrtfn = nrt; + gfun = NULL; + return(IDA_SUCCESS); + } + + /* If rerunning IDARootInit() with the same number of root functions + (not changing number of gfun components), then check if the root + function argument has changed */ + /* If g != NULL then return as currently reserved memory resources + will suffice */ + if (nrt == IDA_mem->ida_nrtfn) { + if (g != gfun) { + if (g == NULL) { + free(glo); glo = NULL; + free(ghi); ghi = NULL; + free(grout); grout = NULL; + free(iroots); iroots = NULL; + free(rootdir); iroots = NULL; + free(gactive); gactive = NULL; + + lrw -= 3*nrt; + liw -= 3*nrt; + + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDARootInit", MSG_ROOT_FUNC_NULL); + return(IDA_ILL_INPUT); + } + else { + gfun = g; + return(IDA_SUCCESS); + } + } + else return(IDA_SUCCESS); + } + + /* Set variable values in IDA memory block */ + IDA_mem->ida_nrtfn = nrt; + if (g == NULL) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDARootInit", MSG_ROOT_FUNC_NULL); + return(IDA_ILL_INPUT); + } + else gfun = g; + + /* Allocate necessary memory and return */ + glo = NULL; + glo = (realtype *) malloc(nrt*sizeof(realtype)); + if (glo == NULL) { + IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDA", "IDARootInit", MSG_MEM_FAIL); + return(IDA_MEM_FAIL); + } + + ghi = NULL; + ghi = (realtype *) malloc(nrt*sizeof(realtype)); + if (ghi == NULL) { + free(glo); glo = NULL; + IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDA", "IDARootInit", MSG_MEM_FAIL); + return(IDA_MEM_FAIL); + } + + grout = NULL; + grout = (realtype *) malloc(nrt*sizeof(realtype)); + if (grout == NULL) { + free(glo); glo = NULL; + free(ghi); ghi = NULL; + IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDA", "IDARootInit", MSG_MEM_FAIL); + return(IDA_MEM_FAIL); + } + + iroots = NULL; + iroots = (int *) malloc(nrt*sizeof(int)); + if (iroots == NULL) { + free(glo); glo = NULL; + free(ghi); ghi = NULL; + free(grout); grout = NULL; + IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDA", "IDARootInit", MSG_MEM_FAIL); + return(IDA_MEM_FAIL); + } + + rootdir = NULL; + rootdir = (int *) malloc(nrt*sizeof(int)); + if (rootdir == NULL) { + free(glo); glo = NULL; + free(ghi); ghi = NULL; + free(grout); grout = NULL; + free(iroots); iroots = NULL; + IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDA", "IDARootInit", MSG_MEM_FAIL); + return(IDA_MEM_FAIL); + } + + gactive = NULL; + gactive = (booleantype *) malloc(nrt*sizeof(booleantype)); + if (gactive == NULL) { + free(glo); glo = NULL; + free(ghi); ghi = NULL; + free(grout); grout = NULL; + free(iroots); iroots = NULL; + free(rootdir); rootdir = NULL; + IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDA", "IDARootInit", MSG_MEM_FAIL); + return(IDA_MEM_FAIL); + } + + /* Set default values for rootdir (both directions) */ + for(i=0; iida_res) +#define y0 (IDA_mem->ida_y0) +#define yp0 (IDA_mem->ida_yp0) + +#define itol (IDA_mem->ida_itol) +#define rtol (IDA_mem->ida_rtol) +#define Satol (IDA_mem->ida_Satol) +#define Vatol (IDA_mem->ida_Vatol) +#define efun (IDA_mem->ida_efun) +#define edata (IDA_mem->ida_edata) + +#define user_data (IDA_mem->ida_user_data) +#define maxord (IDA_mem->ida_maxord) +#define mxstep (IDA_mem->ida_mxstep) +#define hin (IDA_mem->ida_hin) +#define hmax_inv (IDA_mem->ida_hmax_inv) +#define tstop (IDA_mem->ida_tstop) +#define tstopset (IDA_mem->ida_tstopset) +#define epcon (IDA_mem->ida_epcon) +#define maxnef (IDA_mem->ida_maxnef) +#define maxncf (IDA_mem->ida_maxncf) +#define maxcor (IDA_mem->ida_maxcor) +#define suppressalg (IDA_mem->ida_suppressalg) +#define id (IDA_mem->ida_id) +#define constraints (IDA_mem->ida_constraints) + +#define epiccon (IDA_mem->ida_epiccon) +#define maxnh (IDA_mem->ida_maxnh) +#define maxnj (IDA_mem->ida_maxnj) +#define maxnit (IDA_mem->ida_maxnit) +#define lsoff (IDA_mem->ida_lsoff) +#define steptol (IDA_mem->ida_steptol) + +#define uround (IDA_mem->ida_uround) +#define phi (IDA_mem->ida_phi) +#define ewt (IDA_mem->ida_ewt) +#define yy (IDA_mem->ida_yy) +#define yp (IDA_mem->ida_yp) +#define delta (IDA_mem->ida_delta) +#define mm (IDA_mem->ida_mm) +#define ee (IDA_mem->ida_ee) +#define savres (IDA_mem->ida_savres) +#define tempv1 (IDA_mem->ida_tempv1) +#define tempv2 (IDA_mem->ida_tempv2) +#define kk (IDA_mem->ida_kk) +#define hh (IDA_mem->ida_hh) +#define h0u (IDA_mem->ida_h0u) +#define tn (IDA_mem->ida_tn) +#define tretlast (IDA_mem->ida_tretlast) +#define cj (IDA_mem->ida_cj) +#define cjold (IDA_mem->ida_cjold) +#define cjratio (IDA_mem->ida_cjratio) +#define cjlast (IDA_mem->ida_cjlast) +#define nbacktr (IDA_mem->ida_nbacktr) +#define nst (IDA_mem->ida_nst) +#define nre (IDA_mem->ida_nre) +#define ncfn (IDA_mem->ida_ncfn) +#define netf (IDA_mem->ida_netf) +#define nni (IDA_mem->ida_nni) +#define nsetups (IDA_mem->ida_nsetups) +#define ns (IDA_mem->ida_ns) +#define linit (IDA_mem->ida_linit) +#define lsetup (IDA_mem->ida_lsetup) +#define lsolve (IDA_mem->ida_lsolve) +#define lperf (IDA_mem->ida_lperf) +#define lfree (IDA_mem->ida_lfree) +#define lmem (IDA_mem->ida_lmem) +#define knew (IDA_mem->ida_knew) +#define kused (IDA_mem->ida_kused) +#define hused (IDA_mem->ida_hused) +#define tolsf (IDA_mem->ida_tolsf) +#define phase (IDA_mem->ida_phase) +#define epsNewt (IDA_mem->ida_epsNewt) +#define toldel (IDA_mem->ida_toldel) +#define ss (IDA_mem->ida_ss) +#define rr (IDA_mem->ida_rr) +#define psi (IDA_mem->ida_psi) +#define alpha (IDA_mem->ida_alpha) +#define beta (IDA_mem->ida_beta) +#define sigma (IDA_mem->ida_sigma) +#define gamma (IDA_mem->ida_gamma) +#define setupNonNull (IDA_mem->ida_setupNonNull) +#define constraintsSet (IDA_mem->ida_constraintsSet) +#define nrtfn (IDA_mem->ida_nrtfn) +#define tlo (IDA_mem->ida_tlo) +#define thi (IDA_mem->ida_thi) +#define toutc (IDA_mem->ida_toutc) +#define trout (IDA_mem->ida_trout) +#define ttol (IDA_mem->ida_ttol) +#define taskc (IDA_mem->ida_taskc) +#define irfnd (IDA_mem->ida_irfnd) +#define nge (IDA_mem->ida_nge) + +/* + * ----------------------------------------------------------------- + * Main solver function + * ----------------------------------------------------------------- + */ + +/* + * IDASolve + * + * This routine is the main driver of the IDA package. + * + * It integrates over an independent variable interval defined by the user, + * by calling IDAStep to take internal independent variable steps. + * + * The first time that IDASolve is called for a successfully initialized + * problem, it computes a tentative initial step size. + * + * IDASolve supports two modes, specified by itask: + * In the IDA_NORMAL mode, the solver steps until it passes tout and then + * interpolates to obtain y(tout) and yp(tout). + * In the IDA_ONE_STEP mode, it takes one internal step and returns. + * + * IDASolve returns integer values corresponding to success and failure as below: + * + * successful returns: + * + * IDA_SUCCESS + * IDA_TSTOP_RETURN + * + * failed returns: + * + * IDA_ILL_INPUT + * IDA_TOO_MUCH_WORK + * IDA_MEM_NULL + * IDA_TOO_MUCH_ACC + * IDA_CONV_FAIL + * IDA_LSETUP_FAIL + * IDA_LSOLVE_FAIL + * IDA_CONSTR_FAIL + * IDA_ERR_FAIL + * IDA_REP_RES_ERR + * IDA_RES_FAIL + */ + +int IDASolve(void *ida_mem, realtype tout, realtype *tret, + N_Vector yret, N_Vector ypret, int itask) +{ + long int nstloc; + int sflag, istate, ier, irfndp, ir; + realtype tdist, troundoff, ypnorm, rh, nrm; + IDAMem IDA_mem; + booleantype inactive_roots; + time_t tStart, tEnd; //Added by Joep Vanlier + + /* Check for legal inputs in all cases. */ + + if (ida_mem == NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASolve", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + /* Check if problem was malloc'ed */ + + if (IDA_mem->ida_MallocDone == FALSE) { + IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDA", "IDASolve", MSG_NO_MALLOC); + return(IDA_NO_MALLOC); + } + + /* Check for legal arguments */ + + if (yret == NULL) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_YRET_NULL); + return(IDA_ILL_INPUT); + } + yy = yret; + + if (ypret == NULL) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_YPRET_NULL); + return(IDA_ILL_INPUT); + } + yp = ypret; + + if (tret == NULL) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_TRET_NULL); + return(IDA_ILL_INPUT); + } + + if ((itask != IDA_NORMAL) && (itask != IDA_ONE_STEP)) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_BAD_ITASK); + return(IDA_ILL_INPUT); + } + + if (itask == IDA_NORMAL) toutc = tout; + taskc = itask; + + if (nst == 0) { /* This is the first call */ + + /* Check inputs to IDA for correctness and consistency */ + + if (IDA_mem->ida_SetupDone == FALSE) { + ier = IDAInitialSetup(IDA_mem); + if (ier != IDA_SUCCESS) return(IDA_ILL_INPUT); + IDA_mem->ida_SetupDone = TRUE; + } + + /* On first call, check for tout - tn too small, set initial hh, + check for approach to tstop, and scale phi[1] by hh. + Also check for zeros of root function g at and near t0. */ + + tdist = ABS(tout - tn); + if (tdist == ZERO) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_TOO_CLOSE); + return(IDA_ILL_INPUT); + } + troundoff = TWO*uround*(ABS(tn) + ABS(tout)); + if (tdist < troundoff) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_TOO_CLOSE); + return(IDA_ILL_INPUT); + } + + hh = hin; + if ( (hh != ZERO) && ((tout-tn)*hh < ZERO) ) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_BAD_HINIT); + return(IDA_ILL_INPUT); + } + + if (hh == ZERO) { + hh = PT001*tdist; + ypnorm = IDAWrmsNorm(IDA_mem, phi[1], ewt, suppressalg); + if (ypnorm > HALF/hh) hh = HALF/ypnorm; + if (tout < tn) hh = -hh; + } + + rh = ABS(hh)*hmax_inv; + if (rh > ONE) hh /= rh; + + if (tstopset) { + if ( (tstop - tn)*hh < ZERO) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_BAD_TSTOP, tstop, tn); + return(IDA_ILL_INPUT); + } + if ( (tn + hh - tstop)*hh > ZERO) + hh = (tstop - tn)*(ONE-FOUR*uround); + } + + h0u = hh; + kk = 0; kused = 0; /* set in case of an error return before a step */ + + /* Check for exact zeros of the root functions at or near t0. */ + if (nrtfn > 0) { + ier = IDARcheck1(IDA_mem); + if (ier == IDA_RTFUNC_FAIL) { + IDAProcessError(IDA_mem, IDA_RTFUNC_FAIL, "IDA", "IDARcheck1", MSG_RTFUNC_FAILED, tn); + return(IDA_RTFUNC_FAIL); + } + } + + N_VScale(hh, phi[1], phi[1]); /* set phi[1] = hh*y' */ + + /* Set the convergence test constants epsNewt and toldel */ + epsNewt = epcon; + toldel = PT0001 * epsNewt; + + } /* end of first-call block. */ + + /* Call lperf function and set nstloc for later performance testing. */ + + if (lperf != NULL) lperf(IDA_mem, 0); + nstloc = 0; + + /* If not the first call, perform all stopping tests. */ + + if (nst > 0) { + + /* First, check for a root in the last step taken, other than the + last root found, if any. If itask = IDA_ONE_STEP and y(tn) was not + returned because of an intervening root, return y(tn) now. */ + + if (nrtfn > 0) { + + irfndp = irfnd; + + ier = IDARcheck2(IDA_mem); + + if (ier == CLOSERT) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDARcheck2", MSG_CLOSE_ROOTS, tlo); + return(IDA_ILL_INPUT); + } else if (ier == IDA_RTFUNC_FAIL) { + IDAProcessError(IDA_mem, IDA_RTFUNC_FAIL, "IDA", "IDARcheck2", MSG_RTFUNC_FAILED, tlo); + return(IDA_RTFUNC_FAIL); + } else if (ier == RTFOUND) { + tretlast = *tret = tlo; + return(IDA_ROOT_RETURN); + } + + /* If tn is distinct from tretlast (within roundoff), + check remaining interval for roots */ + troundoff = HUNDRED*uround*(ABS(tn) + ABS(hh)); + if ( ABS(tn - tretlast) > troundoff ) { + ier = IDARcheck3(IDA_mem); + if (ier == IDA_SUCCESS) { /* no root found */ + irfnd = 0; + if ((irfndp == 1) && (itask == IDA_ONE_STEP)) { + tretlast = *tret = tn; + ier = IDAGetSolution(IDA_mem, tn, yret, ypret); + return(IDA_SUCCESS); + } + } else if (ier == RTFOUND) { /* a new root was found */ + irfnd = 1; + tretlast = *tret = tlo; + return(IDA_ROOT_RETURN); + } else if (ier == IDA_RTFUNC_FAIL) { /* g failed */ + IDAProcessError(IDA_mem, IDA_RTFUNC_FAIL, "IDA", "IDARcheck3", MSG_RTFUNC_FAILED, tlo); + return(IDA_RTFUNC_FAIL); + } + } + + } /* end of root stop check */ + + + /* Now test for all other stop conditions. */ + + istate = IDAStopTest1(IDA_mem, tout, tret, yret, ypret, itask); + if (istate != CONTINUE_STEPS) return(istate); + } + + /* Looping point for internal steps. */ + time( &tStart ); /* Added by J. Vanlier */ + + loop { + + time( &tEnd ); /* Added by J. Vanlier */ + if ( difftime( tEnd, tStart ) > IDA_mem->tMax ) { /* Added by Joep Vanlier */ + fprintf(stderr, "Simulation time exceeded: t=%e", tn ); + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_MAX_STEPS, tn); + istate = IDA_TOO_MUCH_WORK; + tretlast = *tret = tn; + break; + } + + /* Check for too many steps taken. */ + + if ( (mxstep>0) && (nstloc >= mxstep) ) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_MAX_STEPS, tn); + istate = IDA_TOO_MUCH_WORK; + *tret = tretlast = tn; + break; /* Here yy=yret and yp=ypret already have the current solution. */ + } + + /* Call lperf to generate warnings of poor performance. */ + + if (lperf != NULL) lperf(IDA_mem, 1); + + /* Reset and check ewt (if not first call). */ + + if (nst > 0) { + + ier = efun(phi[0], ewt, edata); + + if (ier != 0) { + + if (itol == IDA_WF) + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_EWT_NOW_FAIL, tn); + else + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_EWT_NOW_BAD, tn); + + istate = IDA_ILL_INPUT; + ier = IDAGetSolution(IDA_mem, tn, yret, ypret); + *tret = tretlast = tn; + break; + + } + + } + + /* Check for too much accuracy requested. */ + + nrm = IDAWrmsNorm(IDA_mem, phi[0], ewt, suppressalg); + tolsf = uround * nrm; + if (tolsf > ONE) { + tolsf *= TEN; + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_TOO_MUCH_ACC, tn); + istate = IDA_TOO_MUCH_ACC; + *tret = tretlast = tn; + if (nst > 0) ier = IDAGetSolution(IDA_mem, tn, yret, ypret); + break; + } + + /* Call IDAStep to take a step. */ + + sflag = IDAStep(IDA_mem); + + /* Process all failed-step cases, and exit loop. */ + + if (sflag != IDA_SUCCESS) { + istate = IDAHandleFailure(IDA_mem, sflag); + *tret = tretlast = tn; + ier = IDAGetSolution(IDA_mem, tn, yret, ypret); + break; + } + + nstloc++; + + /* After successful step, check for stop conditions; continue or break. */ + + /* First check for root in the last step taken. */ + + if (nrtfn > 0) { + + ier = IDARcheck3(IDA_mem); + + if (ier == RTFOUND) { /* A new root was found */ + irfnd = 1; + istate = IDA_ROOT_RETURN; + tretlast = *tret = tlo; + break; + } else if (ier == IDA_RTFUNC_FAIL) { /* g failed */ + IDAProcessError(IDA_mem, IDA_RTFUNC_FAIL, "IDA", "IDARcheck3", MSG_RTFUNC_FAILED, tlo); + istate = IDA_RTFUNC_FAIL; + break; + } + + /* If we are at the end of the first step and we still have + * some event functions that are inactive, issue a warning + * as this may indicate a user error in the implementation + * of the root function. */ + + if (nst==1) { + inactive_roots = FALSE; + for (ir=0; irida_mxgnull > 0) && inactive_roots) { + IDAProcessError(IDA_mem, IDA_WARNING, "IDAS", "IDASolve", MSG_INACTIVE_ROOTS); + } + } + + } + + /* Now check all other stop conditions. */ + + istate = IDAStopTest2(IDA_mem, tout, tret, yret, ypret, itask); + if (istate != CONTINUE_STEPS) break; + + } /* End of step loop */ + + return(istate); +} + +/* + * ----------------------------------------------------------------- + * Interpolated output + * ----------------------------------------------------------------- + */ + +/* + * IDAGetSolution + * + * This routine evaluates y(t) and y'(t) as the value and derivative of + * the interpolating polynomial at the independent variable t, and stores + * the results in the vectors yret and ypret. It uses the current + * independent variable value, tn, and the method order last used, kused. + * This function is called by IDASolve with t = tout, t = tn, or t = tstop. + * + * If kused = 0 (no step has been taken), or if t = tn, then the order used + * here is taken to be 1, giving yret = phi[0], ypret = phi[1]/psi[0]. + * + * The return values are: + * IDA_SUCCESS if t is legal, or + * IDA_BAD_T if t is not within the interval of the last step taken. + */ + +int IDAGetSolution(void *ida_mem, realtype t, N_Vector yret, N_Vector ypret) +{ + IDAMem IDA_mem; + realtype tfuzz, tp, delt, c, d, gam; + int j, kord; + + if (ida_mem == NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetSolution", MSG_NO_MEM); + return (IDA_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + /* Check t for legality. Here tn - hused is t_{n-1}. */ + + tfuzz = HUNDRED * uround * (ABS(tn) + ABS(hh)); + if (hh < ZERO) tfuzz = - tfuzz; + tp = tn - hused - tfuzz; + if ((t - tp)*hh < ZERO) { + IDAProcessError(IDA_mem, IDA_BAD_T, "IDA", "IDAGetSolution", MSG_BAD_T, t, tn-hused, tn); + return(IDA_BAD_T); + } + + /* Initialize yret = phi[0], ypret = 0, and kord = (kused or 1). */ + + N_VScale (ONE, phi[0], yret); + N_VConst (ZERO, ypret); + kord = kused; + if (kused == 0) kord = 1; + + /* Accumulate multiples of columns phi[j] into yret and ypret. */ + + delt = t - tn; + c = ONE; d = ZERO; + gam = delt/psi[0]; + for (j=1; j <= kord; j++) { + d = d*gam + c/psi[j-1]; + c = c*gam; + gam = (delt + psi[j-1])/psi[j]; + N_VLinearSum(ONE, yret, c, phi[j], yret); + N_VLinearSum(ONE, ypret, d, phi[j], ypret); + } + return(IDA_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * Deallocation function + * ----------------------------------------------------------------- + */ + +/* + * IDAFree + * + * This routine frees the problem memory allocated by IDAInit + * Such memory includes all the vectors allocated by IDAAllocVectors, + * and the memory lmem for the linear solver (deallocated by a call + * to lfree). + */ + +void IDAFree(void **ida_mem) +{ + IDAMem IDA_mem; + + if (*ida_mem == NULL) return; + + IDA_mem = (IDAMem) (*ida_mem); + + IDAFreeVectors(IDA_mem); + + if (lfree != NULL) lfree(IDA_mem); + + if (nrtfn > 0) { + free(glo); glo = NULL; + free(ghi); ghi = NULL; + free(grout); grout = NULL; + free(iroots); iroots = NULL; + free(rootdir); rootdir = NULL; + free(gactive); gactive = NULL; + } + + free(*ida_mem); + *ida_mem = NULL; +} + +/* + * ================================================================= + * PRIVATE FUNCTIONS + * ================================================================= + */ + +/* + * IDACheckNvector + * + * This routine checks if all required vector operations are present. + * If any of them is missing it returns FALSE. + */ + +static booleantype IDACheckNvector(N_Vector tmpl) +{ + if ((tmpl->ops->nvclone == NULL) || + (tmpl->ops->nvdestroy == NULL) || + (tmpl->ops->nvlinearsum == NULL) || + (tmpl->ops->nvconst == NULL) || + (tmpl->ops->nvprod == NULL) || + (tmpl->ops->nvscale == NULL) || + (tmpl->ops->nvabs == NULL) || + (tmpl->ops->nvinv == NULL) || + (tmpl->ops->nvaddconst == NULL) || + (tmpl->ops->nvwrmsnorm == NULL) || + (tmpl->ops->nvmin == NULL)) + return(FALSE); + else + return(TRUE); +} + +/* + * ----------------------------------------------------------------- + * Memory allocation/deallocation + * ----------------------------------------------------------------- + */ + +/* + * IDAAllocVectors + * + * This routine allocates the IDA vectors ewt, tempv1, tempv2, and + * phi[0], ..., phi[maxord]. + * If all memory allocations are successful, IDAAllocVectors returns + * TRUE. Otherwise all allocated memory is freed and IDAAllocVectors + * returns FALSE. + * This routine also sets the optional outputs lrw and liw, which are + * (respectively) the lengths of the real and integer work spaces + * allocated here. + */ + +static booleantype IDAAllocVectors(IDAMem IDA_mem, N_Vector tmpl) +{ + int i, j, maxcol; + + /* Allocate ewt, ee, delta, tempv1, tempv2 */ + + ewt = N_VClone(tmpl); + if (ewt == NULL) return(FALSE); + + ee = N_VClone(tmpl); + if (ee == NULL) { + N_VDestroy(ewt); + return(FALSE); + } + + delta = N_VClone(tmpl); + if (delta == NULL) { + N_VDestroy(ewt); + N_VDestroy(ee); + return(FALSE); + } + + tempv1 = N_VClone(tmpl); + if (tempv1 == NULL) { + N_VDestroy(ewt); + N_VDestroy(ee); + N_VDestroy(delta); + return(FALSE); + } + + tempv2= N_VClone(tmpl); + if (tempv2 == NULL) { + N_VDestroy(ewt); + N_VDestroy(ee); + N_VDestroy(delta); + N_VDestroy(tempv1); + return(FALSE); + } + + savres = tempv1; + + /* Allocate phi[0] ... phi[maxord]. Make sure phi[2] and phi[3] are + allocated (for use as temporary vectors), regardless of maxord. */ + + maxcol = MAX(maxord,3); + for (j=0; j <= maxcol; j++) { + phi[j] = N_VClone(tmpl); + if (phi[j] == NULL) { + N_VDestroy(ewt); + N_VDestroy(ee); + N_VDestroy(delta); + N_VDestroy(tempv1); + N_VDestroy(tempv2); + for (i=0; i < j; i++) N_VDestroy(phi[i]); + return(FALSE); + } + } + + /* Update solver workspace lengths */ + lrw += (maxcol + 6)*lrw1; + liw += (maxcol + 6)*liw1; + + /* Store the value of maxord used here */ + IDA_mem->ida_maxord_alloc = maxord; + + return(TRUE); +} + +/* + * IDAfreeVectors + * + * This routine frees the IDA vectors allocated for IDA. + */ + +static void IDAFreeVectors(IDAMem IDA_mem) +{ + int j, maxcol; + + N_VDestroy(ewt); + N_VDestroy(ee); + N_VDestroy(delta); + N_VDestroy(tempv1); + N_VDestroy(tempv2); + maxcol = MAX(IDA_mem->ida_maxord_alloc,3); + for(j=0; j <= maxcol; j++) N_VDestroy(phi[j]); + + lrw -= (maxcol + 6)*lrw1; + liw -= (maxcol + 6)*liw1; + + if (IDA_mem->ida_VatolMallocDone) { + N_VDestroy(Vatol); + lrw -= lrw1; + liw -= liw1; + } + + if (IDA_mem->ida_constraintsMallocDone) { + N_VDestroy(constraints); + lrw -= lrw1; + liw -= liw1; + } + + if (IDA_mem->ida_idMallocDone) { + N_VDestroy(id); + lrw -= lrw1; + liw -= liw1; + } + +} + +/* + * ----------------------------------------------------------------- + * Initial setup + * ----------------------------------------------------------------- + */ + +/* + * IDAInitialSetup + * + * This routine is called by IDASolve once at the first step. + * It performs all checks on optional inputs and inputs to + * IDAInit/IDAReInit that could not be done before. + * + * If no merror is encountered, IDAInitialSetup returns IDA_SUCCESS. + * Otherwise, it returns an error flag and reported to the error + * handler function. + */ + +int IDAInitialSetup(IDAMem IDA_mem) +{ + booleantype conOK; + int ier; + + /* Test for more vector operations, depending on options */ + if (suppressalg) + if (id->ops->nvwrmsnormmask == NULL) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInitialSetup", MSG_BAD_NVECTOR); + return(IDA_ILL_INPUT); + } + + /* Test id vector for legality */ + if (suppressalg && (id==NULL)){ + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInitialSetup", MSG_MISSING_ID); + return(IDA_ILL_INPUT); + } + + /* Did the user specify tolerances? */ + if (itol == IDA_NN) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInitialSetup", MSG_NO_TOLS); + return(IDA_ILL_INPUT); + } + + /* Set data for efun */ + if (IDA_mem->ida_user_efun) edata = user_data; + else edata = IDA_mem; + + /* Initial error weight vector */ + ier = efun(phi[0], ewt, edata); + if (ier != 0) { + if (itol == IDA_WF) + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInitialSetup", MSG_FAIL_EWT); + else + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInitialSetup", MSG_BAD_EWT); + return(IDA_ILL_INPUT); + } + + /* Check to see if y0 satisfies constraints. */ + if (constraintsSet) { + conOK = N_VConstrMask(constraints, phi[0], tempv2); + if (!conOK) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInitialSetup", MSG_Y0_FAIL_CONSTR); + return(IDA_ILL_INPUT); + } + } + + /* Check that lsolve exists and call linit function if it exists. */ + if (lsolve == NULL) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInitialSetup", MSG_LSOLVE_NULL); + return(IDA_ILL_INPUT); + } + + if (linit != NULL) { + ier = linit(IDA_mem); + if (ier != 0) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInitialSetup", MSG_LINIT_FAIL); + return(IDA_LINIT_FAIL); + } + } + + return(IDA_SUCCESS); +} + +/* + * IDAEwtSet + * + * This routine is responsible for loading the error weight vector + * ewt, according to itol, as follows: + * (1) ewt[i] = 1 / (rtol * ABS(ycur[i]) + atol), i=0,...,Neq-1 + * if itol = IDA_SS + * (2) ewt[i] = 1 / (rtol * ABS(ycur[i]) + atol[i]), i=0,...,Neq-1 + * if itol = IDA_SV + * + * IDAEwtSet returns 0 if ewt is successfully set as above to a + * positive vector and -1 otherwise. In the latter case, ewt is + * considered undefined. + * + * All the real work is done in the routines IDAEwtSetSS, IDAEwtSetSV. + */ + +int IDAEwtSet(N_Vector ycur, N_Vector weight, void *data) +{ + IDAMem IDA_mem; + int flag = 0; + + /* data points to IDA_mem here */ + + IDA_mem = (IDAMem) data; + + switch(itol) { + case IDA_SS: + flag = IDAEwtSetSS(IDA_mem, ycur, weight); + break; + case IDA_SV: + flag = IDAEwtSetSV(IDA_mem, ycur, weight); + break; + } + return(flag); +} + +/* + * IDAEwtSetSS + * + * This routine sets ewt as decribed above in the case itol=IDA_SS. + * It tests for non-positive components before inverting. IDAEwtSetSS + * returns 0 if ewt is successfully set to a positive vector + * and -1 otherwise. In the latter case, ewt is considered + * undefined. + */ + +static int IDAEwtSetSS(IDAMem IDA_mem, N_Vector ycur, N_Vector weight) +{ + N_VAbs(ycur, tempv1); + N_VScale(rtol, tempv1, tempv1); + N_VAddConst(tempv1, Satol, tempv1); + if (N_VMin(tempv1) <= ZERO) return(-1); + N_VInv(tempv1, weight); + return(0); +} + +/* + * IDAEwtSetSV + * + * This routine sets ewt as decribed above in the case itol=IDA_SV. + * It tests for non-positive components before inverting. IDAEwtSetSV + * returns 0 if ewt is successfully set to a positive vector + * and -1 otherwise. In the latter case, ewt is considered + * undefined. + */ + +static int IDAEwtSetSV(IDAMem IDA_mem, N_Vector ycur, N_Vector weight) +{ + N_VAbs(ycur, tempv1); + N_VLinearSum(rtol, tempv1, ONE, Vatol, tempv1); + if (N_VMin(tempv1) <= ZERO) return(-1); + N_VInv(tempv1, weight); + return(0); +} + +/* + * ----------------------------------------------------------------- + * Stopping tests + * ----------------------------------------------------------------- + */ + +/* + * IDAStopTest1 + * + * This routine tests for stop conditions before taking a step. + * The tests depend on the value of itask. + * The variable tretlast is the previously returned value of tret. + * + * The return values are: + * CONTINUE_STEPS if no stop conditions were found + * IDA_SUCCESS for a normal return to the user + * IDA_TSTOP_RETURN for a tstop-reached return to the user + * IDA_ILL_INPUT for an illegal-input return to the user + * + * In the tstop cases, this routine may adjust the stepsize hh to cause + * the next step to reach tstop exactly. + */ + +static int IDAStopTest1(IDAMem IDA_mem, realtype tout, realtype *tret, + N_Vector yret, N_Vector ypret, int itask) +{ + int ier; + realtype troundoff; + + switch (itask) { + + case IDA_NORMAL: + + if (tstopset) { + /* Test for tn past tstop, tn = tretlast, tn past tout, tn near tstop. */ + if ( (tn - tstop)*hh > ZERO) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_BAD_TSTOP, tstop, tn); + return(IDA_ILL_INPUT); + } + } + + /* Test for tout = tretlast, and for tn past tout. */ + if (tout == tretlast) { + *tret = tretlast = tout; + return(IDA_SUCCESS); + } + if ((tn - tout)*hh >= ZERO) { + ier = IDAGetSolution(IDA_mem, tout, yret, ypret); + if (ier != IDA_SUCCESS) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_BAD_TOUT, tout); + return(IDA_ILL_INPUT); + } + *tret = tretlast = tout; + return(IDA_SUCCESS); + } + + if (tstopset) { + troundoff = HUNDRED*uround*(ABS(tn) + ABS(hh)); + if (ABS(tn - tstop) <= troundoff) { + ier = IDAGetSolution(IDA_mem, tstop, yret, ypret); + if (ier != IDA_SUCCESS) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_BAD_TSTOP, tstop, tn); + return(IDA_ILL_INPUT); + } + *tret = tretlast = tstop; + tstopset = FALSE; + return(IDA_TSTOP_RETURN); + } + if ((tn + hh - tstop)*hh > ZERO) + hh = (tstop - tn)*(ONE-FOUR*uround); + } + + return(CONTINUE_STEPS); + + case IDA_ONE_STEP: + + if (tstopset) { + /* Test for tn past tstop, tn past tretlast, and tn near tstop. */ + if ((tn - tstop)*hh > ZERO) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_BAD_TSTOP, tstop, tn); + return(IDA_ILL_INPUT); + } + } + + /* Test for tn past tretlast. */ + if ((tn - tretlast)*hh > ZERO) { + ier = IDAGetSolution(IDA_mem, tn, yret, ypret); + *tret = tretlast = tn; + return(IDA_SUCCESS); + } + + if (tstopset) { + troundoff = HUNDRED*uround*(ABS(tn) + ABS(hh)); + if (ABS(tn - tstop) <= troundoff) { + ier = IDAGetSolution(IDA_mem, tstop, yret, ypret); + if (ier != IDA_SUCCESS) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_BAD_TSTOP, tstop, tn); + return(IDA_ILL_INPUT); + } + *tret = tretlast = tstop; + tstopset = FALSE; + return(IDA_TSTOP_RETURN); + } + if ((tn + hh - tstop)*hh > ZERO) + hh = (tstop - tn)*(ONE-FOUR*uround); + } + + return(CONTINUE_STEPS); + + } + return(-99); +} + +/* + * IDAStopTest2 + * + * This routine tests for stop conditions after taking a step. + * The tests depend on the value of itask. + * + * The return values are: + * CONTINUE_STEPS if no stop conditions were found + * IDA_SUCCESS for a normal return to the user + * IDA_TSTOP_RETURN for a tstop-reached return to the user + * + * In the two cases with tstop, this routine may reset the stepsize hh + * to cause the next step to reach tstop exactly. + * + * In the two cases with ONE_STEP mode, no interpolation to tn is needed + * because yret and ypret already contain the current y and y' values. + * + * Note: No test is made for an error return from IDAGetSolution here, + * because the same test was made prior to the step. + */ + +static int IDAStopTest2(IDAMem IDA_mem, realtype tout, realtype *tret, + N_Vector yret, N_Vector ypret, int itask) +{ + int ier; + realtype troundoff; + + switch (itask) { + + case IDA_NORMAL: + + /* Test for tn past tout. */ + if ((tn - tout)*hh >= ZERO) { + ier = IDAGetSolution(IDA_mem, tout, yret, ypret); + *tret = tretlast = tout; + return(IDA_SUCCESS); + } + + if (tstopset) { + /* Test for tn at tstop and for tn near tstop */ + troundoff = HUNDRED*uround*(ABS(tn) + ABS(hh)); + if (ABS(tn - tstop) <= troundoff) { + ier = IDAGetSolution(IDA_mem, tstop, yret, ypret); + *tret = tretlast = tstop; + tstopset = FALSE; + return(IDA_TSTOP_RETURN); + } + if ((tn + hh - tstop)*hh > ZERO) + hh = (tstop - tn)*(ONE-FOUR*uround); + } + + return(CONTINUE_STEPS); + + case IDA_ONE_STEP: + + if (tstopset) { + /* Test for tn at tstop and for tn near tstop */ + troundoff = HUNDRED*uround*(ABS(tn) + ABS(hh)); + if (ABS(tn - tstop) <= troundoff) { + ier = IDAGetSolution(IDA_mem, tstop, yret, ypret); + *tret = tretlast = tstop; + tstopset = FALSE; + return(IDA_TSTOP_RETURN); + } + if ((tn + hh - tstop)*hh > ZERO) + hh = (tstop - tn)*(ONE-FOUR*uround); + } + + *tret = tretlast = tn; + return(IDA_SUCCESS); + + } + return -99; +} + +/* + * ----------------------------------------------------------------- + * Error handler + * ----------------------------------------------------------------- + */ + +/* + * IDAHandleFailure + * + * This routine prints error messages for all cases of failure by + * IDAStep. It returns to IDASolve the value that it is to return to + * the user. + */ + +static int IDAHandleFailure(IDAMem IDA_mem, int sflag) +{ + /* Depending on sflag, print error message and return error flag */ + switch (sflag) { + + case IDA_ERR_FAIL: + IDAProcessError(IDA_mem, IDA_ERR_FAIL, "IDA", "IDASolve", MSG_ERR_FAILS, tn, hh); + return(IDA_ERR_FAIL); + + case IDA_CONV_FAIL: + IDAProcessError(IDA_mem, IDA_CONV_FAIL, "IDA", "IDASolve", MSG_CONV_FAILS, tn, hh); + return(IDA_CONV_FAIL); + + case IDA_LSETUP_FAIL: + IDAProcessError(IDA_mem, IDA_LSETUP_FAIL, "IDA", "IDASolve", MSG_SETUP_FAILED, tn); + return(IDA_LSETUP_FAIL); + + case IDA_LSOLVE_FAIL: + IDAProcessError(IDA_mem, IDA_LSOLVE_FAIL, "IDA", "IDASolve", MSG_SOLVE_FAILED, tn); + return(IDA_LSOLVE_FAIL); + + case IDA_REP_RES_ERR: + IDAProcessError(IDA_mem, IDA_REP_RES_ERR, "IDA", "IDASolve", MSG_REP_RES_ERR, tn); + return(IDA_REP_RES_ERR); + + case IDA_RES_FAIL: + IDAProcessError(IDA_mem, IDA_RES_FAIL, "IDA", "IDASolve", MSG_RES_NONRECOV, tn); + return(IDA_RES_FAIL); + + case IDA_CONSTR_FAIL: + IDAProcessError(IDA_mem, IDA_CONSTR_FAIL, "IDA", "IDASolve", MSG_FAILED_CONSTR, tn); + return(IDA_CONSTR_FAIL); + + } + + return -99; +} + +/* + * ----------------------------------------------------------------- + * Main IDAStep function + * ----------------------------------------------------------------- + */ + +/* + * IDAStep + * + * This routine performs one internal IDA step, from tn to tn + hh. + * It calls other routines to do all the work. + * + * It solves a system of differential/algebraic equations of the form + * F(t,y,y') = 0, for one step. In IDA, tt is used for t, + * yy is used for y, and yp is used for y'. The function F is supplied as 'res' + * by the user. + * + * The methods used are modified divided difference, fixed leading + * coefficient forms of backward differentiation formulas. + * The code adjusts the stepsize and order to control the local error per step. + * + * The main operations done here are as follows: + * * initialize various quantities; + * * setting of multistep method coefficients; + * * solution of the nonlinear system for yy at t = tn + hh; + * * deciding on order reduction and testing the local error; + * * attempting to recover from failure in nonlinear solver or error test; + * * resetting stepsize and order for the next step. + * * updating phi and other state data if successful; + * + * On a failure in the nonlinear system solution or error test, the + * step may be reattempted, depending on the nature of the failure. + * + * Variables or arrays (all in the IDAMem structure) used in IDAStep are: + * + * tt -- Independent variable. + * yy -- Solution vector at tt. + * yp -- Derivative of solution vector after successful stelp. + * res -- User-supplied function to evaluate the residual. See the + * description given in file ida.h . + * lsetup -- Routine to prepare for the linear solver call. It may either + * save or recalculate quantities used by lsolve. (Optional) + * lsolve -- Routine to solve a linear system. A prior call to lsetup + * may be required. + * hh -- Appropriate step size for next step. + * ewt -- Vector of weights used in all convergence tests. + * phi -- Array of divided differences used by IDAStep. This array is composed + * of (maxord+1) nvectors (each of size Neq). (maxord+1) is the maximum + * order for the problem, maxord, plus 1. + * + * Return values are: + * IDA_SUCCESS IDA_RES_FAIL LSETUP_ERROR_NONRECVR + * IDA_LSOLVE_FAIL IDA_ERR_FAIL + * IDA_CONSTR_FAIL IDA_CONV_FAIL + * IDA_REP_RES_ERR + */ + +static int IDAStep(IDAMem IDA_mem) +{ + realtype saved_t, ck; + realtype err_k, err_km1; + int ncf, nef; + int nflag, kflag; + + saved_t = tn; + ncf = nef = 0; + + if (nst == ZERO){ + kk = 1; + kused = 0; + hused = ZERO; + psi[0] = hh; + cj = ONE/hh; + phase = 0; + ns = 0; + } + + /* To prevent 'unintialized variable' warnings */ + err_k = ZERO; + err_km1 = ZERO; + + /* Looping point for attempts to take a step */ + + loop { + + /*----------------------- + Set method coefficients + -----------------------*/ + + IDASetCoeffs(IDA_mem, &ck); + + kflag = IDA_SUCCESS; + + /*---------------------------------------------------- + If tn is past tstop (by roundoff), reset it to tstop. + -----------------------------------------------------*/ + + tn = tn + hh; + if (tstopset) { + if ((tn - tstop)*hh > ZERO) tn = tstop; + } + + /*----------------------- + Advance state variables + -----------------------*/ + + /* Nonlinear system solution */ + nflag = IDANls(IDA_mem); + + /* If NLS was successful, perform error test */ + if (nflag == IDA_SUCCESS) + nflag = IDATestError(IDA_mem, ck, &err_k, &err_km1); + + /* Test for convergence or error test failures */ + if (nflag != IDA_SUCCESS) { + + /* restore and decide what to do */ + IDARestore(IDA_mem, saved_t); + kflag = IDAHandleNFlag(IDA_mem, nflag, err_k, err_km1, + &ncfn, &ncf, &netf, &nef); + + /* exit on nonrecoverable failure */ + if (kflag != PREDICT_AGAIN) return(kflag); + + /* recoverable error; predict again */ + if(nst==0) IDAReset(IDA_mem); + continue; + + } + + /* kflag == IDA_SUCCESS */ + break; + + } + + /* Nonlinear system solve and error test were both successful; + update data, and consider change of step and/or order */ + + IDACompleteStep(IDA_mem, err_k, err_km1); + + /* + Rescale ee vector to be the estimated local error + Notes: + (1) altering the value of ee is permissible since + it will be re-initialized to the zero vector by + IDASolve()->IDAStep()->IDANls()->IDANewtonIter() + before it is needed again + (2) the value of ee is only valid if IDAHandleNFlag() + returns either PREDICT_AGAIN or IDA_SUCCESS + */ + + N_VScale(ck, ee, ee); + + return(IDA_SUCCESS); +} + +/* + * IDASetCoeffs + * + * This routine computes the coefficients relevant to the current step. + * The counter ns counts the number of consecutive steps taken at + * constant stepsize h and order k, up to a maximum of k + 2. + * Then the first ns components of beta will be one, and on a step + * with ns = k + 2, the coefficients alpha, etc. need not be reset here. + * Also, IDACompleteStep prohibits an order increase until ns = k + 2. + */ + +static void IDASetCoeffs(IDAMem IDA_mem, realtype *ck) +{ + int i; + realtype temp1, temp2, alpha0, alphas; + + /* Set coefficients for the current stepsize h */ + + if (hh != hused || kk != kused) ns = 0; + ns = MIN(ns+1,kused+2); + if (kk+1 >= ns){ + beta[0] = ONE; + alpha[0] = ONE; + temp1 = hh; + gamma[0] = ZERO; + sigma[0] = ONE; + for(i=1;i<=kk;i++){ + temp2 = psi[i-1]; + psi[i-1] = temp1; + beta[i] = beta[i-1] * psi[i-1] / temp2; + temp1 = temp2 + hh; + alpha[i] = hh / temp1; + sigma[i] = i * sigma[i-1] * alpha[i]; + gamma[i] = gamma[i-1] + alpha[i-1] / hh; + } + psi[kk] = temp1; + } + /* compute alphas, alpha0 */ + alphas = ZERO; + alpha0 = ZERO; + for(i=0;i temp2) callSetup = TRUE;} + {if (cj != cjlast) ss=HUNDRED;} + } + + /* Begin the main loop. This loop is traversed at most twice. + The second pass only occurs when the first pass had a recoverable + failure with old Jacobian data */ + loop{ + + /* Compute predicted values for yy and yp, and compute residual there. */ + IDAPredict(IDA_mem); + + retval = res(tn, yy, yp, delta, user_data); + nre++; + if (retval < 0) return(IDA_RES_FAIL); + if (retval > 0) return(IDA_RES_RECVR); + + /* If indicated, call linear solver setup function and reset parameters. */ + if (callSetup){ + nsetups++; + retval = lsetup(IDA_mem, yy, yp, delta, tempv1, tempv2, tempv3); + cjold = cj; + cjratio = ONE; + ss = TWENTY; + if (retval < 0) return(IDA_LSETUP_FAIL); + if (retval > 0) return(IDA_LSETUP_RECVR); + } + + /* Call the Newton iteration routine. */ + + retval = IDANewtonIter(IDA_mem); + + /* Retry the current step on recoverable failure with old Jacobian data. */ + + tryAgain = (retval>0)&&(setupNonNull) &&(!callSetup); + + if (tryAgain){ + callSetup = TRUE; + continue; + } + else break; + + } /* end of loop */ + + if (retval != IDA_SUCCESS) return(retval); + + /* If otherwise successful, check and enforce inequality constraints. */ + + if (constraintsSet){ /* Check constraints and get mask vector mm, + set where constraints failed */ + constraintsPassed = N_VConstrMask(constraints,yy,mm); + if (constraintsPassed) return(IDA_SUCCESS); + else { + N_VCompare(ONEPT5, constraints, tempv1); + /* a , where a[i] =1. when |c[i]| = 2 , c the vector of constraints */ + N_VProd(tempv1, constraints, tempv1); /* a * c */ + N_VDiv(tempv1, ewt, tempv1); /* a * c * wt */ + N_VLinearSum(ONE, yy, -PT1, tempv1, tempv1);/* y - 0.1 * a * c * wt */ + N_VProd(tempv1, mm, tempv1); /* v = mm*(y-.1*a*c*wt) */ + vnorm = IDAWrmsNorm(IDA_mem, tempv1, ewt, FALSE); /* ||v|| */ + + /* If vector v of constraint corrections is small + in norm, correct and accept this step */ + if (vnorm <= epsNewt){ + N_VLinearSum(ONE, ee, -ONE, tempv1, ee); /* ee <- ee - v */ + return(IDA_SUCCESS); + } + else { + /* Constraints not met -- reduce h by computing rr = h'/h */ + N_VLinearSum(ONE, phi[0], -ONE, yy, tempv1); + N_VProd(mm, tempv1, tempv1); + rr = PT9*N_VMinQuotient(phi[0], tempv1); + rr = MAX(rr,PT1); + return(IDA_CONSTR_RECVR); + } + } + } + return(IDA_SUCCESS); +} + + +/* + * IDAPredict + * + * This routine predicts the new values for vectors yy and yp. + */ + +static void IDAPredict(IDAMem IDA_mem) +{ + int j; + + N_VScale(ONE, phi[0], yy); + N_VConst(ZERO, yp); + + for(j=1; j<=kk; j++) { + N_VLinearSum(ONE, phi[j], ONE, yy, yy); + N_VLinearSum(gamma[j], phi[j], ONE, yp, yp); + } +} + +/* + * IDANewtonIter + * + * This routine performs the Newton iteration. + * It assumes that delta contains the initial residual vector on entry. + * If the iteration succeeds, it returns the value IDA_SUCCESS = 0. + * If not, it returns either: + * a positive value (for a recoverable failure), namely one of: + * IDA_RES_RECVR + * IDA_LSOLVE_RECVR + * IDA_NCONV_RECVR + * or + * a negative value (for a nonrecoverable failure), namely one of: + * IDA_RES_FAIL + * IDA_LSOLVE_FAIL + * + * NOTE: This routine uses N_Vector savres, which is preset to tempv1. + */ + +static int IDANewtonIter(IDAMem IDA_mem) +{ + int mnewt, retval; + realtype delnrm, oldnrm, rate; + + /* Initialize counter mnewt and cumulative correction vector ee. */ + mnewt = 0; + N_VConst(ZERO, ee); + + /* Initialize oldnrm to avoid compiler warning message */ + oldnrm = ZERO; + + /* Looping point for Newton iteration. Break out on any error. */ + loop { + + nni++; + + /* Save a copy of the residual vector in savres. */ + N_VScale(ONE, delta, savres); + + /* Call the lsolve function to get correction vector delta. */ + retval = lsolve(IDA_mem, delta, ewt, yy, yp, savres); + if (retval < 0) return(IDA_LSOLVE_FAIL); + if (retval > 0) return(IDA_LSOLVE_RECVR); + + /* Apply delta to yy, yp, and ee, and get norm(delta). */ + N_VLinearSum(ONE, yy, -ONE, delta, yy); + N_VLinearSum(ONE, ee, -ONE, delta, ee); + N_VLinearSum(ONE, yp, -cj, delta, yp); + delnrm = IDAWrmsNorm(IDA_mem, delta, ewt, FALSE); + + /* Test for convergence, first directly, then with rate estimate. */ + + if (mnewt == 0){ + oldnrm = delnrm; + if (delnrm <= toldel) return(IDA_SUCCESS); + } + else { + rate = RPowerR( delnrm/oldnrm, ONE/mnewt ); + if (rate > RATEMAX) return(IDA_NCONV_RECVR); + ss = rate/(ONE - rate); + } + + if (ss*delnrm <= epsNewt) return(IDA_SUCCESS); + + /* Not yet converged. Increment mnewt and test for max allowed. */ + mnewt++; + if (mnewt >= maxcor) {retval = IDA_NCONV_RECVR; break;} + + /* Call res for new residual and check error flag from res. */ + retval = res(tn, yy, yp, delta, user_data); + nre++; + if (retval < 0) return(IDA_RES_FAIL); + if (retval > 0) return(IDA_RES_RECVR); + + /* Loop for next iteration. */ + + } /* end of Newton iteration loop */ + + /* All error returns exit here. */ + return(retval); + +} + +/* + * ----------------------------------------------------------------- + * Error test + * ----------------------------------------------------------------- + */ + +/* + * IDATestError + * + * This routine estimates errors at orders k, k-1, k-2, decides + * whether or not to suggest an order decrease, and performs + * the local error test. + * + * IDATestError returns either IDA_SUCCESS or ERROR_TEST_FAIL. + */ + +static int IDATestError(IDAMem IDA_mem, realtype ck, + realtype *err_k, realtype *err_km1) +{ + realtype err_km2; /* estimated error at k-2 */ + realtype enorm_k, enorm_km1, enorm_km2; /* error norms */ + realtype terr_k, terr_km1, terr_km2; /* local truncation error norms */ + + /* Compute error for order k. */ + enorm_k = IDAWrmsNorm(IDA_mem, ee, ewt, suppressalg); + *err_k = sigma[kk] * enorm_k; + terr_k = (kk+1) * (*err_k); + + knew = kk; + + if ( kk > 1 ) { + + /* Compute error at order k-1 */ + N_VLinearSum(ONE, phi[kk], ONE, ee, delta); + enorm_km1 = IDAWrmsNorm(IDA_mem, delta, ewt, suppressalg); + *err_km1 = sigma[kk-1] * enorm_km1; + terr_km1 = kk * (*err_km1); + + if ( kk > 2 ) { + + /* Compute error at order k-2 */ + N_VLinearSum(ONE, phi[kk-1], ONE, delta, delta); + enorm_km2 = IDAWrmsNorm(IDA_mem, delta, ewt, suppressalg); + err_km2 = sigma[kk-2] * enorm_km2; + terr_km2 = (kk-1) * err_km2; + + /* Decrease order if errors are reduced */ + if (MAX(terr_km1, terr_km2) <= terr_k) knew = kk - 1; + + } else { + + /* Decrease order to 1 if errors are reduced by at least 1/2 */ + if (terr_km1 <= (HALF * terr_k) ) knew = kk - 1; + + } + + } + + /* Perform error test */ + if (ck * enorm_k > ONE) return(ERROR_TEST_FAIL); + else return(IDA_SUCCESS); +} + +/* + * IDARestore + * + * This routine restores tn, psi, and phi in the event of a failure. + * It changes back phi-star to phi (changed in IDASetCoeffs) + */ + +static void IDARestore(IDAMem IDA_mem, realtype saved_t) +{ + int j; + + tn = saved_t; + + for (j = 1; j <= kk; j++) + psi[j-1] = psi[j] - hh; + + for (j = ns; j <= kk; j++) + N_VScale(ONE/beta[j], phi[j], phi[j]); + +} + +/* + * ----------------------------------------------------------------- + * Handler for convergence and/or error test failures + * ----------------------------------------------------------------- + */ + +/* + * IDAHandleNFlag + * + * This routine handles failures indicated by the input variable nflag. + * Positive values indicate various recoverable failures while negative + * values indicate nonrecoverable failures. This routine adjusts the + * step size for recoverable failures. + * + * Possible nflag values (input): + * + * --convergence failures-- + * IDA_RES_RECVR > 0 + * IDA_LSOLVE_RECVR > 0 + * IDA_CONSTR_RECVR > 0 + * IDA_NCONV_RECVR > 0 + * IDA_RES_FAIL < 0 + * IDA_LSOLVE_FAIL < 0 + * IDA_LSETUP_FAIL < 0 + * + * --error test failure-- + * ERROR_TEST_FAIL > 0 + * + * Possible kflag values (output): + * + * --recoverable-- + * PREDICT_AGAIN + * + * --nonrecoverable-- + * IDA_CONSTR_FAIL + * IDA_REP_RES_ERR + * IDA_ERR_FAIL + * IDA_CONV_FAIL + * IDA_RES_FAIL + * IDA_LSETUP_FAIL + * IDA_LSOLVE_FAIL + */ + +static int IDAHandleNFlag(IDAMem IDA_mem, int nflag, realtype err_k, realtype err_km1, + long int *ncfnPtr, int *ncfPtr, long int *netfPtr, int *nefPtr) +{ + realtype err_knew; + + phase = 1; + + if (nflag != ERROR_TEST_FAIL) { + + /*----------------------- + Nonlinear solver failed + -----------------------*/ + + (*ncfPtr)++; /* local counter for convergence failures */ + (*ncfnPtr)++; /* global counter for convergence failures */ + + if (nflag < 0) { /* nonrecoverable failure */ + + return(nflag); + + } else { /* recoverable failure */ + + /* Reduce step size for a new prediction + Note that if nflag=IDA_CONSTR_RECVR then rr was already set in IDANls */ + if (nflag != IDA_CONSTR_RECVR) rr = QUARTER; + hh *= rr; + + /* Test if there were too many convergence failures */ + if (*ncfPtr < maxncf) return(PREDICT_AGAIN); + else if (nflag == IDA_RES_RECVR) return(IDA_REP_RES_ERR); + else if (nflag == IDA_CONSTR_RECVR) return(IDA_CONSTR_FAIL); + else return(IDA_CONV_FAIL); + } + + } else { + + /*----------------- + Error Test failed + -----------------*/ + + (*nefPtr)++; /* local counter for error test failures */ + (*netfPtr)++; /* global counter for error test failures */ + + if (*nefPtr == 1) { + + /* On first error test failure, keep current order or lower order by one. + Compute new stepsize based on differences of the solution. */ + + err_knew = (kk==knew)? err_k : err_km1; + + kk = knew; + rr = PT9 * RPowerR( TWO * err_knew + PT0001,(-ONE/(kk+1)) ); + rr = MAX(QUARTER, MIN(PT9,rr)); + hh *=rr; + return(PREDICT_AGAIN); + + } else if (*nefPtr == 2) { + + /* On second error test failure, use current order or decrease order by one. + Reduce stepsize by factor of 1/4. */ + + kk = knew; + rr = QUARTER; + hh *= rr; + return(PREDICT_AGAIN); + + } else if (*nefPtr < maxnef) { + + /* On third and subsequent error test failures, set order to 1. + Reduce stepsize by factor of 1/4. */ + kk = 1; + rr = QUARTER; + hh *= rr; + return(PREDICT_AGAIN); + + } else { + + /* Too many error test failures */ + return(IDA_ERR_FAIL); + + } + + } + +} + +/* + * IDAReset + * + * This routine is called only if we need to predict again at the + * very first step. In such a case, reset phi[1] and psi[0]. + */ + +static void IDAReset(IDAMem IDA_mem) +{ + psi[0] = hh; + + N_VScale(rr, phi[1], phi[1]); +} + +/* + * ----------------------------------------------------------------- + * Function called after a successful step + * ----------------------------------------------------------------- + */ + +/* + * IDACompleteStep + * + * This routine completes a successful step. It increments nst, + * saves the stepsize and order used, makes the final selection of + * stepsize and order for the next step, and updates the phi array. + */ + +static void IDACompleteStep(IDAMem IDA_mem, realtype err_k, realtype err_km1) +{ + int j, kdiff, action; + realtype terr_k, terr_km1, terr_kp1; + realtype err_knew, err_kp1; + realtype enorm, tmp, hnew; + + nst++; + kdiff = kk - kused; + kused = kk; + hused = hh; + + if ( (knew == kk-1) || (kk == maxord) ) phase = 1; + + /* For the first few steps, until either a step fails, or the order is + reduced, or the order reaches its maximum, we raise the order and double + the stepsize. During these steps, phase = 0. Thereafter, phase = 1, and + stepsize and order are set by the usual local error algorithm. + + Note that, after the first step, the order is not increased, as not all + of the neccessary information is available yet. */ + + if (phase == 0) { + + if(nst > 1) { + kk++; + hnew = TWO * hh; + if( (tmp = ABS(hnew)*hmax_inv) > ONE ) hnew /= tmp; + hh = hnew; + } + + } else { + + action = UNSET; + + /* Set action = LOWER/MAINTAIN/RAISE to specify order decision */ + + if (knew == kk-1) {action = LOWER; goto takeaction;} + if (kk == maxord) {action = MAINTAIN; goto takeaction;} + if ( (kk+1 >= ns ) || (kdiff == 1)) {action = MAINTAIN; goto takeaction;} + + /* Estimate the error at order k+1, unless already decided to + reduce order, or already using maximum order, or stepsize has not + been constant, or order was just raised. */ + + N_VLinearSum (ONE, ee, -ONE, phi[kk+1], tempv1); + enorm = IDAWrmsNorm(IDA_mem, tempv1, ewt, suppressalg); + err_kp1= enorm/(kk+2); + + /* Choose among orders k-1, k, k+1 using local truncation error norms. */ + + terr_k = (kk+1) * err_k; + terr_kp1 = (kk+2) * err_kp1; + + if (kk == 1) { + if (terr_kp1 >= HALF * terr_k) {action = MAINTAIN; goto takeaction;} + else {action = RAISE; goto takeaction;} + } else { + terr_km1 = kk * err_km1; + if (terr_km1 <= MIN(terr_k, terr_kp1)) {action = LOWER; goto takeaction;} + else if (terr_kp1 >= terr_k) {action = MAINTAIN; goto takeaction;} + else {action = RAISE; goto takeaction;} + } + + takeaction: + + /* Set the estimated error norm and, on change of order, reset kk. */ + if (action == RAISE) { kk++; err_knew = err_kp1; } + else if (action == LOWER) { kk--; err_knew = err_km1; } + else { err_knew = err_k; } + + /* Compute rr = tentative ratio hnew/hh from error norm estimate. + Reduce hh if rr <= 1, double hh if rr >= 2, else leave hh as is. + If hh is reduced, hnew/hh is restricted to be between .5 and .9. */ + + hnew = hh; + rr = RPowerR( (TWO * err_knew + PT0001) , (-ONE/(kk+1) ) ); + + if (rr >= TWO) { + hnew = TWO * hh; + if( (tmp = ABS(hnew)*hmax_inv) > ONE ) hnew /= tmp; + } else if (rr <= ONE ) { + rr = MAX(HALF, MIN(PT9,rr)); + hnew = hh * rr; + } + + hh = hnew; + + } /* end of phase if block */ + + /* Save ee for possible order increase on next step */ + if (kused < maxord) { + N_VScale(ONE, ee, phi[kused+1]); + } + + /* Update phi arrays */ + N_VLinearSum(ONE, ee, ONE, phi[kused], phi[kused]); + for (j= kused-1; j>=0; j--) + N_VLinearSum(ONE, phi[j], ONE, phi[j+1], phi[j]); + +} + +/* + * ----------------------------------------------------------------- + * Norm function + * ----------------------------------------------------------------- + */ + +/* + * IDAWrmsNorm + * + * Returns the WRMS norm of vector x with weights w. + * If mask = TRUE, the weight vector w is masked by id, i.e., + * nrm = N_VWrmsNormMask(x,w,id); + * Otherwise, + * nrm = N_VWrmsNorm(x,w); + * + * mask = FALSE when the call is made from the nonlinear solver. + * mask = suppressalg otherwise. + */ + +realtype IDAWrmsNorm(IDAMem IDA_mem, N_Vector x, N_Vector w, + booleantype mask) +{ + realtype nrm; + + if (mask) nrm = N_VWrmsNormMask(x, w, id); + else nrm = N_VWrmsNorm(x, w); + + return(nrm); +} + +/* + * ----------------------------------------------------------------- + * Functions for rootfinding + * ----------------------------------------------------------------- + */ + +/* + * IDARcheck1 + * + * This routine completes the initialization of rootfinding memory + * information, and checks whether g has a zero both at and very near + * the initial point of the IVP. + * + * This routine returns an int equal to: + * IDA_RTFUNC_FAIL < 0 if the g function failed, or + * IDA_SUCCESS = 0 otherwise. + */ + +static int IDARcheck1(IDAMem IDA_mem) +{ + int i, retval; + realtype smallh, hratio; + booleantype zroot; + + for (i = 0; i < nrtfn; i++) iroots[i] = 0; + tlo = tn; + ttol = (ABS(tn) + ABS(hh))*uround*HUNDRED; + + /* Evaluate g at initial t and check for zero values. */ + retval = gfun (tlo, phi[0], phi[1], glo, user_data); + nge = 1; + if (retval != 0) return(IDA_RTFUNC_FAIL); + + zroot = FALSE; + for (i = 0; i < nrtfn; i++) { + if (ABS(glo[i]) == ZERO) { + zroot = TRUE; + gactive[i] = FALSE; + } + } + if (!zroot) return(IDA_SUCCESS); + + /* Some g_i is zero at t0; look at g at t0+(small increment). */ + hratio = MAX(ttol/ABS(hh), PT1); + smallh = hratio*hh; + tlo += smallh; + N_VLinearSum(ONE, phi[0], smallh, phi[1], yy); + retval = gfun (tlo, yy, phi[1], glo, user_data); + nge++; + if (retval != 0) return(IDA_RTFUNC_FAIL); + + /* We check now only the components of g which were exactly 0.0 at t0 + * to see if we can 'activate' them. */ + + for (i = 0; i < nrtfn; i++) { + if (!gactive[i] && ABS(glo[i]) != ZERO) { + gactive[i] = TRUE; + + } + } + + return(IDA_SUCCESS); +} + +/* + * IDARcheck2 + * + * This routine checks for exact zeros of g at the last root found, + * if the last return was a root. It then checks for a close + * pair of zeros (an error condition), and for a new root at a + * nearby point. The left endpoint (tlo) of the search interval + * is adjusted if necessary to assure that all g_i are nonzero + * there, before returning to do a root search in the interval. + * + * On entry, tlo = tretlast is the last value of tret returned by + * IDASolve. This may be the previous tn, the previous tout value, + * or the last root location. + * + * This routine returns an int equal to: + * IDA_RTFUNC_FAIL (<0) if the g function failed, or + * CLOSERT (>0) if a close pair of zeros was found, or + * RTFOUND (>0) if a new zero of g was found near tlo, or + * IDA_SUCCESS (=0) otherwise. + */ + +static int IDARcheck2(IDAMem IDA_mem) +{ + int i, retval; + realtype smallh, hratio; + booleantype zroot; + + if (irfnd == 0) return(IDA_SUCCESS); + + (void) IDAGetSolution(IDA_mem, tlo, yy, yp); + retval = gfun (tlo, yy, yp, glo, user_data); + nge++; + if (retval != 0) return(IDA_RTFUNC_FAIL); + + zroot = FALSE; + for (i = 0; i < nrtfn; i++) iroots[i] = 0; + for (i = 0; i < nrtfn; i++) { + if (!gactive[i]) continue; + if (ABS(glo[i]) == ZERO) { + zroot = TRUE; + iroots[i] = 1; + } + } + if (!zroot) return(IDA_SUCCESS); + + /* One or more g_i has a zero at tlo. Check g at tlo+smallh. */ + ttol = (ABS(tn) + ABS(hh))*uround*HUNDRED; + smallh = (hh > ZERO) ? ttol : -ttol; + tlo += smallh; + if ( (tlo - tn)*hh >= ZERO) { + hratio = smallh/hh; + N_VLinearSum(ONE, yy, hratio, phi[1], yy); + } else { + (void) IDAGetSolution(IDA_mem, tlo, yy, yp); + } + retval = gfun (tlo, yy, yp, glo, user_data); + nge++; + if (retval != 0) return(IDA_RTFUNC_FAIL); + + zroot = FALSE; + for (i = 0; i < nrtfn; i++) { + if (!gactive[i]) continue; + if (ABS(glo[i]) == ZERO) { + if (iroots[i] == 1) return(CLOSERT); + zroot = TRUE; + iroots[i] = 1; + } + } + if (zroot) return(RTFOUND); + return(IDA_SUCCESS); + +} + +/* + * IDARcheck3 + * + * This routine interfaces to IDARootfind to look for a root of g + * between tlo and either tn or tout, whichever comes first. + * Only roots beyond tlo in the direction of integration are sought. + * + * This routine returns an int equal to: + * IDA_RTFUNC_FAIL (<0) if the g function failed, or + * RTFOUND (>0) if a root of g was found, or + * IDA_SUCCESS (=0) otherwise. + */ + +static int IDARcheck3(IDAMem IDA_mem) +{ + int i, ier, retval; + + /* Set thi = tn or tout, whichever comes first. */ + if (taskc == IDA_ONE_STEP) thi = tn; + if (taskc == IDA_NORMAL) { + thi = ( (toutc - tn)*hh >= ZERO) ? tn : toutc; + } + + /* Get y and y' at thi. */ + (void) IDAGetSolution(IDA_mem, thi, yy, yp); + + + /* Set ghi = g(thi) and call IDARootfind to search (tlo,thi) for roots. */ + retval = gfun (thi, yy, yp, ghi, user_data); + nge++; + if (retval != 0) return(IDA_RTFUNC_FAIL); + + ttol = (ABS(tn) + ABS(hh))*uround*HUNDRED; + ier = IDARootfind(IDA_mem); + if (ier == IDA_RTFUNC_FAIL) return(IDA_RTFUNC_FAIL); + for(i=0; i 0, search for roots of g_i only if + * g_i is increasing; if rootdir[i] < 0, search for + * roots of g_i only if g_i is decreasing; otherwise + * always search for roots of g_i. + * + * gactive = array specifying whether a component of g should + * or should not be monitored. gactive[i] is initially + * set to TRUE for all i=0,...,nrtfn-1, but it may be + * reset to FALSE if at the first step g[i] is 0.0 + * both at the I.C. and at a small perturbation of them. + * gactive[i] is then set back on TRUE only after the + * corresponding g function moves away from 0.0. + * + * nge = cumulative counter for gfun calls. + * + * ttol = a convergence tolerance for trout. Input only. + * When a root at trout is found, it is located only to + * within a tolerance of ttol. Typically, ttol should + * be set to a value on the order of + * 100 * UROUND * max (ABS(tlo), ABS(thi)) + * where UROUND is the unit roundoff of the machine. + * + * tlo, thi = endpoints of the interval in which roots are sought. + * On input, and must be distinct, but tlo - thi may + * be of either sign. The direction of integration is + * assumed to be from tlo to thi. On return, tlo and thi + * are the endpoints of the final relevant interval. + * + * glo, ghi = arrays of length nrtfn containing the vectors g(tlo) + * and g(thi) respectively. Input and output. On input, + * none of the glo[i] should be zero. + * + * trout = root location, if a root was found, or thi if not. + * Output only. If a root was found other than an exact + * zero of g, trout is the endpoint thi of the final + * interval bracketing the root, with size at most ttol. + * + * grout = array of length nrtfn containing g(trout) on return. + * + * iroots = int array of length nrtfn with root information. + * Output only. If a root was found, iroots indicates + * which components g_i have a root at trout. For + * i = 0, ..., nrtfn-1, iroots[i] = 1 if g_i has a root + * and g_i is increasing, iroots[i] = -1 if g_i has a + * root and g_i is decreasing, and iroots[i] = 0 if g_i + * has no roots or g_i varies in the direction opposite + * to that indicated by rootdir[i]. + * + * This routine returns an int equal to: + * IDA_RTFUNC_FAIL (<0) if the g function failed, or + * RTFOUND = 1 if a root of g was found, or + * IDA_SUCCESS = 0 otherwise. + * + */ + +static int IDARootfind(IDAMem IDA_mem) +{ + realtype alph, tmid, gfrac, maxfrac, fracint, fracsub; + int i, retval, imax, side, sideprev; + booleantype zroot, sgnchg; + + imax = 0; + + /* First check for change in sign in ghi or for a zero in ghi. */ + maxfrac = ZERO; + zroot = FALSE; + sgnchg = FALSE; + for (i = 0; i < nrtfn; i++) { + if(!gactive[i]) continue; + if (ABS(ghi[i]) == ZERO) { + if(rootdir[i]*glo[i] <= ZERO) { + zroot = TRUE; + } + } else { + if ( (glo[i]*ghi[i] < ZERO) && (rootdir[i]*glo[i] <= ZERO) ) { + gfrac = ABS(ghi[i]/(ghi[i] - glo[i])); + if (gfrac > maxfrac) { + sgnchg = TRUE; + maxfrac = gfrac; + imax = i; + } + } + } + } + + /* If no sign change was found, reset trout and grout. Then return + IDA_SUCCESS if no zero was found, or set iroots and return RTFOUND. */ + if (!sgnchg) { + trout = thi; + for (i = 0; i < nrtfn; i++) grout[i] = ghi[i]; + if (!zroot) return(IDA_SUCCESS); + for (i = 0; i < nrtfn; i++) { + iroots[i] = 0; + if(!gactive[i]) continue; + if (ABS(ghi[i]) == ZERO) iroots[i] = glo[i] > 0 ? -1:1; + } + return(RTFOUND); + } + + /* Initialize alph to avoid compiler warning */ + alph = ONE; + + /* A sign change was found. Loop to locate nearest root. */ + + side = 0; sideprev = -1; + loop { /* Looping point */ + + /* Set weight alph. + On the first two passes, set alph = 1. Thereafter, reset alph + according to the side (low vs high) of the subinterval in which + the sign change was found in the previous two passes. + If the sides were opposite, set alph = 1. + If the sides were the same, then double alph (if high side), + or halve alph (if low side). + The next guess tmid is the secant method value if alph = 1, but + is closer to tlo if alph < 1, and closer to thi if alph > 1. */ + + if (sideprev == side) { + alph = (side == 2) ? alph*TWO : alph*HALF; + } else { + alph = ONE; + } + + /* Set next root approximation tmid and get g(tmid). + If tmid is too close to tlo or thi, adjust it inward, + by a fractional distance that is between 0.1 and 0.5. */ + tmid = thi - (thi - tlo)*ghi[imax]/(ghi[imax] - alph*glo[imax]); + if (ABS(tmid - tlo) < HALF*ttol) { + fracint = ABS(thi - tlo)/ttol; + fracsub = (fracint > FIVE) ? PT1 : HALF/fracint; + tmid = tlo + fracsub*(thi - tlo); + } + if (ABS(thi - tmid) < HALF*ttol) { + fracint = ABS(thi - tlo)/ttol; + fracsub = (fracint > FIVE) ? PT1 : HALF/fracint; + tmid = thi - fracsub*(thi - tlo); + } + + (void) IDAGetSolution(IDA_mem, tmid, yy, yp); + retval = gfun (tmid, yy, yp, grout, user_data); + nge++; + if (retval != 0) return(IDA_RTFUNC_FAIL); + + /* Check to see in which subinterval g changes sign, and reset imax. + Set side = 1 if sign change is on low side, or 2 if on high side. */ + maxfrac = ZERO; + zroot = FALSE; + sgnchg = FALSE; + sideprev = side; + for (i = 0; i < nrtfn; i++) { + if(!gactive[i]) continue; + if (ABS(grout[i]) == ZERO) { + if(rootdir[i]*glo[i] <= ZERO) { + zroot = TRUE; + } + } else { + if ( (glo[i]*grout[i] < ZERO) && (rootdir[i]*glo[i] <= ZERO) ) { + gfrac = ABS(grout[i]/(grout[i] - glo[i])); + if (gfrac > maxfrac) { + sgnchg = TRUE; + maxfrac = gfrac; + imax = i; + } + } + } + } + if (sgnchg) { + /* Sign change found in (tlo,tmid); replace thi with tmid. */ + thi = tmid; + for (i = 0; i < nrtfn; i++) ghi[i] = grout[i]; + side = 1; + /* Stop at root thi if converged; otherwise loop. */ + if (ABS(thi - tlo) <= ttol) break; + continue; /* Return to looping point. */ + } + + if (zroot) { + /* No sign change in (tlo,tmid), but g = 0 at tmid; return root tmid. */ + thi = tmid; + for (i = 0; i < nrtfn; i++) ghi[i] = grout[i]; + break; + } + + /* No sign change in (tlo,tmid), and no zero at tmid. + Sign change must be in (tmid,thi). Replace tlo with tmid. */ + tlo = tmid; + for (i = 0; i < nrtfn; i++) glo[i] = grout[i]; + side = 2; + /* Stop at root thi if converged; otherwise loop back. */ + if (ABS(thi - tlo) <= ttol) break; + + } /* End of root-search loop */ + + /* Reset trout and grout, set iroots, and return RTFOUND. */ + trout = thi; + for (i = 0; i < nrtfn; i++) { + grout[i] = ghi[i]; + iroots[i] = 0; + if(!gactive[i]) continue; + if ( (ABS(ghi[i]) == ZERO) && (rootdir[i]*glo[i] <= ZERO) ) + iroots[i] = glo[i] > 0 ? -1:1; + if ( (glo[i]*ghi[i] < ZERO) && (rootdir[i]*glo[i] <= ZERO) ) + iroots[i] = glo[i] > 0 ? -1:1; + } + return(RTFOUND); +} + +/* + * ================================================================= + * IDA error message handling functions + * ================================================================= + */ + +/* + * IDAProcessError is a high level error handling function + * - if ida_mem==NULL it prints the error message to stderr + * - otherwise, it sets-up and calls the error hadling function + * pointed to by ida_ehfun + */ + +#define ehfun (IDA_mem->ida_ehfun) +#define eh_data (IDA_mem->ida_eh_data) + +void IDAProcessError(IDAMem IDA_mem, + int error_code, const char *module, const char *fname, + const char *msgfmt, ...) +{ + va_list ap; + char msg[256]; + + /* Initialize the argument pointer variable + (msgfmt is the last required argument to IDAProcessError) */ + + va_start(ap, msgfmt); + + if (IDA_mem == NULL) { /* We write to stderr */ + +#ifndef NO_FPRINTF_OUTPUT + fprintf(stderr, "\n[%s ERROR] %s\n ", module, fname); + fprintf(stderr, msgfmt); + fprintf(stderr, "\n\n"); +#endif + + } else { /* We can call ehfun */ + + /* Compose the message */ + + vsprintf(msg, msgfmt, ap); + + /* Call ehfun */ + + ehfun(error_code, module, fname, msg, eh_data); + + } + + /* Finalize argument processing */ + + va_end(ap); + + return; + +} + +/* IDAErrHandler is the default error handling function. + It sends the error message to the stream pointed to by ida_errfp */ + +#define errfp (IDA_mem->ida_errfp) + +void IDAErrHandler(int error_code, const char *module, + const char *function, char *msg, void *data) +{ + IDAMem IDA_mem; + char err_type[10]; + + /* data points to IDA_mem here */ + + IDA_mem = (IDAMem) data; + + if (error_code == IDA_WARNING) + sprintf(err_type,"WARNING"); + else + sprintf(err_type,"ERROR"); + +#ifndef NO_FPRINTF_OUTPUT + if (errfp!=NULL) { + fprintf(errfp,"\n[%s %s] %s\n",module,err_type,function); + fprintf(errfp," %s\n\n",msg); + } +#endif + + return; +} diff --git a/odemex/Parser/CVode/ida_src/src/ida/ida_band.c b/odemex/Parser/CVode/ida_src/src/ida/ida_band.c new file mode 100644 index 0000000..ad7c735 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/ida_band.c @@ -0,0 +1,320 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.11 $ + * $Date: 2009/02/17 02:42:29 $ + * ----------------------------------------------------------------- + * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for the IDA banded linear + * solver module, IDABAND. This module uses standard banded + * matrix techniques to solve the linear systems generated by the + * (nonlinear) Newton iteration process. The user may either + * supply a banded Jacobian routine or use the routine supplied + * with this module (IDABandDQJac). + * ----------------------------------------------------------------- + */ + +#include +#include +#include + +#include +#include "ida_direct_impl.h" +#include "ida_impl.h" + +#include + +/* Constants */ + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) +#define TWO RCONST(2.0) + +/* IDABAND linit, lsetup, lsolve, and lfree routines */ + +static int IDABandInit(IDAMem IDA_mem); + +static int IDABandSetup(IDAMem IDA_mem, N_Vector yyp, N_Vector ypp, + N_Vector rrp, N_Vector tmp1, + N_Vector tmp2, N_Vector tmp3); + +static int IDABandSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight, + N_Vector ycur, N_Vector ypcur, N_Vector rrcur); + +static int IDABandFree(IDAMem IDA_mem); + +/* Readability Replacements */ + +#define res (IDA_mem->ida_res) +#define tn (IDA_mem->ida_tn) +#define hh (IDA_mem->ida_hh) +#define cj (IDA_mem->ida_cj) +#define cjratio (IDA_mem->ida_cjratio) +#define ewt (IDA_mem->ida_ewt) +#define constraints (IDA_mem->ida_constraints) +#define linit (IDA_mem->ida_linit) +#define lsetup (IDA_mem->ida_lsetup) +#define lsolve (IDA_mem->ida_lsolve) +#define lperf (IDA_mem->ida_lperf) +#define lfree (IDA_mem->ida_lfree) +#define lmem (IDA_mem->ida_lmem) +#define setupNonNull (IDA_mem->ida_setupNonNull) +#define vec_tmpl (IDA_mem->ida_tempv1) + +#define mtype (idadls_mem->d_type) +#define neq (idadls_mem->d_n) +#define ml (idadls_mem->d_ml) +#define mu (idadls_mem->d_mu) +#define jacDQ (idadls_mem->d_jacDQ) +#define bjac (idadls_mem->d_bjac) +#define JJ (idadls_mem->d_J) +#define smu (idadls_mem->d_smu) +#define pivots (idadls_mem->d_pivots) +#define nje (idadls_mem->d_nje) +#define nreDQ (idadls_mem->d_nreDQ) +#define jacdata (idadls_mem->d_J_data) +#define last_flag (idadls_mem->d_last_flag) + +/* + * ----------------------------------------------------------------- + * IDABand + * ----------------------------------------------------------------- + * This routine initializes the memory record and sets various function + * fields specific to the IDABAND linear solver module. + * IDABand first calls the existing lfree routine if this is not NULL. + * Then it sets the ida_linit, ida_lsetup, ida_lsolve, ida_lperf, and + * ida_lfree fields in (*IDA_mem) to be IDABandInit, IDABandSetup, + * IDABandSolve, NULL, and IDABandFree, respectively. + * It allocates memory for a structure of type IDADlsMemRec and sets + * the ida_lmem field in (*IDA_mem) to the address of this structure. + * It sets setupNonNull in (*IDA_mem) to TRUE, sets the d_jacdata field in + * the IDADlsMemRec structure to be the input parameter jdata, and sets + * the d_bjac field to be: + * (1) the input parameter bjac, if bjac != NULL, or + * (2) IDABandDQJac, if bjac == NULL. + * Finally, it allocates memory for JJ and pivots. + * IDABand returns IDADLS_SUCCESS = 0, IDADLS_LMEM_FAIL = -1, + * or IDADLS_ILL_INPUT = -2. + * + * NOTE: The band linear solver assumes a serial implementation + * of the NVECTOR package. Therefore, IDABand will first + * test for a compatible N_Vector internal representation by + * checking that the N_VGetArrayPointer function exists + * ----------------------------------------------------------------- + */ + +int IDABand(void *ida_mem, int Neq, int mupper, int mlower) +{ + IDAMem IDA_mem; + IDADlsMem idadls_mem; + int flag; + + /* Return immediately if ida_mem is NULL. */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDADLS_MEM_NULL, "IDABAND", "IDABand", MSGD_IDAMEM_NULL); + return(IDADLS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + /* Test if the NVECTOR package is compatible with the BAND solver */ + if(vec_tmpl->ops->nvgetarraypointer == NULL) { + IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDABAND", "IDABand", MSGD_BAD_NVECTOR); + return(IDADLS_ILL_INPUT); + } + + /* Test mlower and mupper for legality. */ + if ((mlower < 0) || (mupper < 0) || (mlower >= Neq) || (mupper >= Neq)) { + IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDABAND", "IDABand", MSGD_BAD_SIZES); + return(IDADLS_ILL_INPUT); + } + + if (lfree != NULL) flag = lfree((IDAMem) ida_mem); + + /* Set five main function fields in ida_mem. */ + linit = IDABandInit; + lsetup = IDABandSetup; + lsolve = IDABandSolve; + lperf = NULL; + lfree = IDABandFree; + + /* Get memory for IDADlsMemRec. */ + idadls_mem = NULL; + idadls_mem = (IDADlsMem) malloc(sizeof(struct IDADlsMemRec)); + if (idadls_mem == NULL) { + IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDABAND", "IDABand", MSGD_MEM_FAIL); + return(IDADLS_MEM_FAIL); + } + + /* Set matrix type */ + mtype = SUNDIALS_BAND; + + /* Set default Jacobian routine and Jacobian data */ + jacDQ = TRUE; + bjac = NULL; + jacdata = NULL; + + last_flag = IDADLS_SUCCESS; + + setupNonNull = TRUE; + + /* Store problem size */ + neq = Neq; + + idadls_mem->d_ml = mlower; + idadls_mem->d_mu = mupper; + + /* Set extended upper half-bandwidth for JJ (required for pivoting). */ + smu = MIN(Neq-1, mupper + mlower); + + /* Allocate memory for JJ and pivot array. */ + JJ = NULL; + JJ = NewBandMat(Neq, mupper, mlower, smu); + if (JJ == NULL) { + IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDABAND", "IDABand", MSGD_MEM_FAIL); + free(idadls_mem); idadls_mem = NULL; + return(IDADLS_MEM_FAIL); + } + + pivots = NULL; + pivots = NewIntArray(Neq); + if (pivots == NULL) { + IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDABAND", "IDABand", MSGD_MEM_FAIL); + DestroyMat(JJ); + free(idadls_mem); idadls_mem = NULL; + return(IDADLS_MEM_FAIL); + } + + /* Attach linear solver memory to the integrator memory */ + lmem = idadls_mem; + + return(IDADLS_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * IDABAND interface functions + * ----------------------------------------------------------------- + */ + +/* + This routine does remaining initializations specific to the IDABAND + linear solver module. It returns 0. +*/ + +static int IDABandInit(IDAMem IDA_mem) +{ + IDADlsMem idadls_mem; + + idadls_mem = (IDADlsMem) lmem; + + /* Initialize nje and nreB */ + nje = 0; + nreDQ = 0; + + if (jacDQ) { + bjac = idaDlsBandDQJac; + jacdata = IDA_mem; + } else { + jacdata = IDA_mem->ida_user_data; + } + + last_flag = 0; + return(0); +} + + +/* + This routine does the setup operations for the IDABAND linear + solver module. It calls the Jacobian evaluation routine, + updates counters, and calls the band LU factorization routine. + The return value is either + IDADLS_SUCCESS = 0 if successful, + +1 if the jac routine failed recoverably or the + LU factorization failed, or + -1 if the jac routine failed unrecoverably. +*/ + +static int IDABandSetup(IDAMem IDA_mem, N_Vector yyp, N_Vector ypp, + N_Vector rrp, N_Vector tmp1, N_Vector tmp2, + N_Vector tmp3) +{ + int retval; + long int retfac; + IDADlsMem idadls_mem; + + idadls_mem = (IDADlsMem) lmem; + + /* Increment nje counter. */ + nje++; + + /* Zero out JJ; call Jacobian routine jac; return if it failed. */ + SetToZero(JJ); + retval = bjac(neq, mu, ml, tn, cj, yyp, ypp, rrp, + JJ, jacdata, tmp1, tmp2, tmp3); + if (retval < 0) { + IDAProcessError(IDA_mem, IDADLS_JACFUNC_UNRECVR, "IDABAND", "IDABandSetup", MSGD_JACFUNC_FAILED); + last_flag = IDADLS_JACFUNC_UNRECVR; + return(-1); + } + if (retval > 0) { + last_flag = IDADLS_JACFUNC_RECVR; + return(+1); + } + + /* Do LU factorization of JJ; return success or fail flag. */ + retfac = BandGBTRF(JJ, pivots); + + if (retfac != 0) { + last_flag = retfac; + return(+1); + } + last_flag = IDADLS_SUCCESS; + return(0); +} +/* + This routine handles the solve operation for the IDABAND linear + solver module. It calls the band backsolve routine, scales the + solution vector according to cjratio, then returns IDADLS_SUCCESS = 0. +*/ + +static int IDABandSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight, + N_Vector ycur, N_Vector ypcur, N_Vector rrcur) +{ + IDADlsMem idadls_mem; + realtype *bd; + + idadls_mem = (IDADlsMem) lmem; + + bd = N_VGetArrayPointer(b); + BandGBTRS(JJ, pivots, bd); + + /* Scale the correction to account for change in cj. */ + if (cjratio != ONE) N_VScale(TWO/(ONE + cjratio), b, b); + + last_flag = 0; + return(0); +} + +/* + This routine frees memory specific to the IDABAND linear solver. +*/ + +static int IDABandFree(IDAMem IDA_mem) +{ + IDADlsMem idadls_mem; + + idadls_mem = (IDADlsMem) lmem; + + DestroyMat(JJ); + DestroyArray(pivots); + free(lmem); lmem = NULL; + + return(0); + +} + diff --git a/odemex/Parser/CVode/ida_src/src/ida/ida_bbdpre.c b/odemex/Parser/CVode/ida_src/src/ida/ida_bbdpre.c new file mode 100644 index 0000000..6faeeb2 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/ida_bbdpre.c @@ -0,0 +1,584 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.8 $ + * $Date: 2009/02/17 02:42:29 $ + * ----------------------------------------------------------------- + * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This file contains implementations of routines for a + * band-block-diagonal preconditioner, i.e. a block-diagonal + * matrix with banded blocks, for use with IDA and an IDASPILS + * linear solver. + * + * NOTE: With only one processor in use, a banded matrix results + * rather than a block-diagonal matrix with banded blocks. + * Diagonal blocking occurs at the processor level. + * ----------------------------------------------------------------- + */ + +#include +#include +#include + +#include "ida_impl.h" +#include "ida_spils_impl.h" +#include "ida_bbdpre_impl.h" + +#include +#include +#include + +#include + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) +#define TWO RCONST(2.0) + +/* Prototypes of IDABBDPrecSetup and IDABBDPrecSolve */ + +static int IDABBDPrecSetup(realtype tt, + N_Vector yy, N_Vector yp, N_Vector rr, + realtype c_j, void *prec_data, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); + +static int IDABBDPrecSolve(realtype tt, + N_Vector yy, N_Vector yp, N_Vector rr, + N_Vector rvec, N_Vector zvec, + realtype c_j, realtype delta, void *prec_data, + N_Vector tmp); + +/* Prototype for IDABBDPrecFree */ + +static void IDABBDPrecFree(IDAMem ida_mem); + +/* Prototype for difference quotient Jacobian calculation routine */ + +static int IBBDDQJac(IBBDPrecData pdata, realtype tt, realtype cj, + N_Vector yy, N_Vector yp, N_Vector gref, + N_Vector ytemp, N_Vector yptemp, N_Vector gtemp); + +/* + * ================================================================ + * User-Callable Functions: initialization, reinit and free + * ================================================================ + */ + +/* Readability Replacements */ + +#define uround (IDA_mem->ida_uround) +#define vec_tmpl (IDA_mem->ida_tempv1) + +/* + * ----------------------------------------------------------------- + * User-Callable Functions : malloc, reinit and free + * ----------------------------------------------------------------- + */ + +int IDABBDPrecInit(void *ida_mem, int Nlocal, + int mudq, int mldq, + int mukeep, int mlkeep, + realtype dq_rel_yy, + IDABBDLocalFn Gres, IDABBDCommFn Gcomm) +{ + IDAMem IDA_mem; + IDASpilsMem idaspils_mem; + IBBDPrecData pdata; + N_Vector tempv4; + int muk, mlk, storage_mu; + int flag; + + if (ida_mem == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDABBDPRE", "IDABBDPrecInit", MSGBBD_MEM_NULL); + return(IDASPILS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + /* Test if one of the SPILS linear solvers has been attached */ + if (IDA_mem->ida_lmem == NULL) { + IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDABBDPRE", "IDABBDPrecInit", MSGBBD_LMEM_NULL); + return(IDASPILS_LMEM_NULL); + } + idaspils_mem = (IDASpilsMem) IDA_mem->ida_lmem; + + /* Test if the NVECTOR package is compatible with BLOCK BAND preconditioner */ + if(vec_tmpl->ops->nvgetarraypointer == NULL) { + IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDABBDPRE", "IDABBDPrecInit", MSGBBD_BAD_NVECTOR); + return(IDASPILS_ILL_INPUT); + } + + /* Allocate data memory. */ + pdata = NULL; + pdata = (IBBDPrecData) malloc(sizeof *pdata); + if (pdata == NULL) { + IDAProcessError(IDA_mem, IDASPILS_MEM_FAIL, "IDABBDPRE", "IDABBDPrecInit", MSGBBD_MEM_FAIL); + return(IDASPILS_MEM_FAIL); + } + + /* Set pointers to glocal and gcomm; load half-bandwidths. */ + pdata->ida_mem = IDA_mem; + pdata->glocal = Gres; + pdata->gcomm = Gcomm; + pdata->mudq = MIN(Nlocal-1, MAX(0, mudq)); + pdata->mldq = MIN(Nlocal-1, MAX(0, mldq)); + muk = MIN(Nlocal-1, MAX(0, mukeep)); + mlk = MIN(Nlocal-1, MAX(0, mlkeep)); + pdata->mukeep = muk; + pdata->mlkeep = mlk; + + /* Set extended upper half-bandwidth for PP (required for pivoting). */ + storage_mu = MIN(Nlocal-1, muk+mlk); + + /* Allocate memory for preconditioner matrix. */ + pdata->PP = NULL; + pdata->PP = NewBandMat(Nlocal, muk, mlk, storage_mu); + if (pdata->PP == NULL) { + free(pdata); pdata = NULL; + IDAProcessError(IDA_mem, IDASPILS_MEM_FAIL, "IDABBDPRE", "IDABBDPrecInit", MSGBBD_MEM_FAIL); + return(IDASPILS_MEM_FAIL); + } + + /* Allocate memory for pivots. */ + pdata->pivots = NULL; + pdata->pivots = NewIntArray(Nlocal); + if (pdata->PP == NULL) { + DestroyMat(pdata->PP); + free(pdata); pdata = NULL; + IDAProcessError(IDA_mem, IDASPILS_MEM_FAIL, "IDABBDPRE", "IDABBDPrecInit", MSGBBD_MEM_FAIL); + return(IDASPILS_MEM_FAIL); + } + + /* Allocate tempv4 for use by IBBDDQJac */ + tempv4 = NULL; + tempv4 = N_VClone(vec_tmpl); + if (tempv4 == NULL){ + DestroyMat(pdata->PP); + DestroyArray(pdata->pivots); + free(pdata); pdata = NULL; + IDAProcessError(IDA_mem, IDASPILS_MEM_FAIL, "IDABBDPRE", "IDABBDPrecInit", MSGBBD_MEM_FAIL); + return(IDASPILS_MEM_FAIL); + } + pdata->tempv4 = tempv4; + + /* Set rel_yy based on input value dq_rel_yy (0 implies default). */ + pdata->rel_yy = (dq_rel_yy > ZERO) ? dq_rel_yy : RSqrt(uround); + + /* Store Nlocal to be used in IDABBDPrecSetup */ + pdata->n_local = Nlocal; + + /* Set work space sizes and initialize nge. */ + pdata->rpwsize = Nlocal*(mlk + storage_mu + 1); + pdata->ipwsize = Nlocal; + pdata->nge = 0; + + /* Overwrite the pdata field in the SPILS memory */ + idaspils_mem->s_pdata = pdata; + + /* Attach the pfree function */ + idaspils_mem->s_pfree = IDABBDPrecFree; + + /* Attach preconditioner solve and setup functions */ + flag = IDASpilsSetPreconditioner(ida_mem, IDABBDPrecSetup, IDABBDPrecSolve); + + return(flag); +} + +int IDABBDPrecReInit(void *ida_mem, + int mudq, int mldq, + realtype dq_rel_yy) +{ + IDAMem IDA_mem; + IDASpilsMem idaspils_mem; + IBBDPrecData pdata; + int Nlocal; + + + if (ida_mem == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDABBDPRE", "IDABBDPrecReInit", MSGBBD_MEM_NULL); + return(IDASPILS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + /* Test if one of the SPILS linear solvers has been attached */ + if (IDA_mem->ida_lmem == NULL) { + IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDABBDPRE", "IDABBDPrecReInit", MSGBBD_LMEM_NULL); + return(IDASPILS_LMEM_NULL); + } + idaspils_mem = (IDASpilsMem) IDA_mem->ida_lmem; + + /* Test if the preconditioner data is non-NULL */ + if (idaspils_mem->s_pdata == NULL) { + IDAProcessError(IDA_mem, IDASPILS_PMEM_NULL, "IDABBDPRE", "IDABBDPrecReInit", MSGBBD_PMEM_NULL); + return(IDASPILS_PMEM_NULL); + } + pdata = (IBBDPrecData) idaspils_mem->s_pdata; + + /* Load half-bandwidths. */ + Nlocal = pdata->n_local; + pdata->mudq = MIN(Nlocal-1, MAX(0, mudq)); + pdata->mldq = MIN(Nlocal-1, MAX(0, mldq)); + + /* Set rel_yy based on input value dq_rel_yy (0 implies default). */ + pdata->rel_yy = (dq_rel_yy > ZERO) ? dq_rel_yy : RSqrt(uround); + + /* Re-initialize nge */ + pdata->nge = 0; + + return(IDASPILS_SUCCESS); +} + +int IDABBDPrecGetWorkSpace(void *ida_mem, long int *lenrwBBDP, long int *leniwBBDP) +{ + IDAMem IDA_mem; + IDASpilsMem idaspils_mem; + IBBDPrecData pdata; + + if (ida_mem == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDABBDPRE", "IDABBDPrecGetWorkSpace", MSGBBD_MEM_NULL); + return(IDASPILS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + if (IDA_mem->ida_lmem == NULL) { + IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDABBDPRE", "IDABBDPrecGetWorkSpace", MSGBBD_LMEM_NULL); + return(IDASPILS_LMEM_NULL); + } + idaspils_mem = (IDASpilsMem) IDA_mem->ida_lmem; + + if (idaspils_mem->s_pdata == NULL) { + IDAProcessError(IDA_mem, IDASPILS_PMEM_NULL, "IDABBDPRE", "IDABBDPrecGetWorkSpace", MSGBBD_PMEM_NULL); + return(IDASPILS_PMEM_NULL); + } + pdata = (IBBDPrecData) idaspils_mem->s_pdata; + + *lenrwBBDP = pdata->rpwsize; + *leniwBBDP = pdata->ipwsize; + + return(IDASPILS_SUCCESS); +} + +int IDABBDPrecGetNumGfnEvals(void *ida_mem, long int *ngevalsBBDP) +{ + IDAMem IDA_mem; + IDASpilsMem idaspils_mem; + IBBDPrecData pdata; + + if (ida_mem == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDABBDPRE", "IDABBDPrecGetNumGfnEvals", MSGBBD_MEM_NULL); + return(IDASPILS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + if (IDA_mem->ida_lmem == NULL) { + IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDABBDPRE", "IDABBDPrecGetNumGfnEvals", MSGBBD_LMEM_NULL); + return(IDASPILS_LMEM_NULL); + } + idaspils_mem = (IDASpilsMem) IDA_mem->ida_lmem; + + if (idaspils_mem->s_pdata == NULL) { + IDAProcessError(IDA_mem, IDASPILS_PMEM_NULL, "IDABBDPRE", "IDABBDPrecGetNumGfnEvals", MSGBBD_PMEM_NULL); + return(IDASPILS_PMEM_NULL); + } + pdata = (IBBDPrecData) idaspils_mem->s_pdata; + + *ngevalsBBDP = pdata->nge; + + return(IDASPILS_SUCCESS); +} + + +/* Readability Replacements */ + +#define Nlocal (pdata->n_local) +#define mudq (pdata->mudq) +#define mldq (pdata->mldq) +#define mukeep (pdata->mukeep) +#define mlkeep (pdata->mlkeep) +#define glocal (pdata->glocal) +#define gcomm (pdata->gcomm) +#define pivots (pdata->pivots) +#define PP (pdata->PP) +#define tempv4 (pdata->tempv4) +#define nge (pdata->nge) +#define rel_yy (pdata->rel_yy) + +/* + * ----------------------------------------------------------------- + * Function : IDABBDPrecSetup + * ----------------------------------------------------------------- + * IDABBDPrecSetup generates a band-block-diagonal preconditioner + * matrix, where the local block (on this processor) is a band + * matrix. Each local block is computed by a difference quotient + * scheme via calls to the user-supplied routines glocal, gcomm. + * After generating the block in the band matrix PP, this routine + * does an LU factorization in place in PP. + * + * The IDABBDPrecSetup parameters used here are as follows: + * + * tt is the current value of the independent variable t. + * + * yy is the current value of the dependent variable vector, + * namely the predicted value of y(t). + * + * yp is the current value of the derivative vector y', + * namely the predicted value of y'(t). + * + * c_j is the scalar in the system Jacobian, proportional to 1/hh. + * + * bbd_data is the pointer to BBD memory set by IDABBDInit + * + * tmp1, tmp2, tmp3 are pointers to vectors of type + * N_Vector, used for temporary storage or + * work space. + * + * The arguments Neq, rr, res, uround, and nrePtr are not used. + * + * Return value: + * The value returned by this IDABBDPrecSetup function is a int + * flag indicating whether it was successful. This value is + * 0 if successful, + * > 0 for a recoverable error (step will be retried), or + * < 0 for a nonrecoverable error (step fails). + * ----------------------------------------------------------------- + */ + +static int IDABBDPrecSetup(realtype tt, + N_Vector yy, N_Vector yp, N_Vector rr, + realtype c_j, void *bbd_data, + N_Vector tempv1, N_Vector tempv2, N_Vector tempv3) +{ + int ier, retval; + IBBDPrecData pdata; + IDAMem IDA_mem; + + pdata =(IBBDPrecData) bbd_data; + + IDA_mem = (IDAMem) pdata->ida_mem; + + /* Call IBBDDQJac for a new Jacobian calculation and store in PP. */ + SetToZero(PP); + retval = IBBDDQJac(pdata, tt, c_j, yy, yp, + tempv1, tempv2, tempv3, tempv4); + if (retval < 0) { + IDAProcessError(IDA_mem, -1, "IDABBDPRE", "IDABBDPrecSetup", MSGBBD_FUNC_FAILED); + return(-1); + } + if (retval > 0) { + return(+1); + } + + /* Do LU factorization of preconditioner block in place (in PP). */ + ier = BandGBTRF(PP, pivots); + + /* Return 0 if the LU was complete, or +1 otherwise. */ + if (ier > 0) return(+1); + return(0); +} + +/* + * ----------------------------------------------------------------- + * Function: IDABBDPrecSolve + * ----------------------------------------------------------------- + * The function IDABBDPrecSolve computes a solution to the linear + * system P z = r, where P is the left preconditioner defined by + * the routine IDABBDPrecSetup. + * + * The IDABBDPrecSolve parameters used here are as follows: + * + * rvec is the input right-hand side vector r. + * + * zvec is the computed solution vector z. + * + * bbd_data is the pointer to BBD data set by IDABBDInit. + * + * The arguments tt, yy, yp, rr, c_j, delta, and tmp are NOT used. + * + * IDABBDPrecSolve always returns 0, indicating success. + * ----------------------------------------------------------------- + */ + +static int IDABBDPrecSolve(realtype tt, + N_Vector yy, N_Vector yp, N_Vector rr, + N_Vector rvec, N_Vector zvec, + realtype c_j, realtype delta, void *bbd_data, + N_Vector tmp) +{ + IBBDPrecData pdata; + realtype *zd; + + pdata = (IBBDPrecData) bbd_data; + + /* Copy rvec to zvec, do the backsolve, and return. */ + N_VScale(ONE, rvec, zvec); + + zd = N_VGetArrayPointer(zvec); + + BandGBTRS(PP, pivots, zd); + + return(0); +} + + + +static void IDABBDPrecFree(IDAMem IDA_mem) +{ + IDASpilsMem idaspils_mem; + IBBDPrecData pdata; + + if (IDA_mem->ida_lmem == NULL) return; + idaspils_mem = (IDASpilsMem) IDA_mem->ida_lmem; + + if (idaspils_mem->s_pdata == NULL) return; + pdata = (IBBDPrecData) idaspils_mem->s_pdata; + + DestroyMat(PP); + DestroyArray(pivots); + N_VDestroy(tempv4); + + free(pdata); + pdata = NULL; +} + + +#define ewt (IDA_mem->ida_ewt) +#define user_data (IDA_mem->ida_user_data) +#define hh (IDA_mem->ida_hh) +#define constraints (IDA_mem->ida_constraints) + +/* + * ----------------------------------------------------------------- + * IBBDDQJac + * ----------------------------------------------------------------- + * This routine generates a banded difference quotient approximation + * to the local block of the Jacobian of G(t,y,y'). It assumes that + * a band matrix of type BandMat is stored column-wise, and that + * elements within each column are contiguous. + * + * All matrix elements are generated as difference quotients, by way + * of calls to the user routine glocal. By virtue of the band + * structure, the number of these calls is bandwidth + 1, where + * bandwidth = mldq + mudq + 1. But the band matrix kept has + * bandwidth = mlkeep + mukeep + 1. This routine also assumes that + * the local elements of a vector are stored contiguously. + * + * Return values are: 0 (success), > 0 (recoverable error), + * or < 0 (nonrecoverable error). + * ----------------------------------------------------------------- + */ + +static int IBBDDQJac(IBBDPrecData pdata, realtype tt, realtype cj, + N_Vector yy, N_Vector yp, N_Vector gref, + N_Vector ytemp, N_Vector yptemp, N_Vector gtemp) +{ + IDAMem IDA_mem; + realtype inc, inc_inv; + int retval; + int group, i, j, width, ngroups, i1, i2; + realtype *ydata, *ypdata, *ytempdata, *yptempdata, *grefdata, *gtempdata; + realtype *cnsdata = NULL, *ewtdata; + realtype *col_j, conj, yj, ypj, ewtj; + + IDA_mem = (IDAMem) pdata->ida_mem; + + /* Initialize ytemp and yptemp. */ + + N_VScale(ONE, yy, ytemp); + N_VScale(ONE, yp, yptemp); + + /* Obtain pointers as required to the data array of vectors. */ + + ydata = N_VGetArrayPointer(yy); + ypdata = N_VGetArrayPointer(yp); + gtempdata = N_VGetArrayPointer(gtemp); + ewtdata = N_VGetArrayPointer(ewt); + if (constraints != NULL) + cnsdata = N_VGetArrayPointer(constraints); + ytempdata = N_VGetArrayPointer(ytemp); + yptempdata= N_VGetArrayPointer(yptemp); + grefdata = N_VGetArrayPointer(gref); + + /* Call gcomm and glocal to get base value of G(t,y,y'). */ + + if (gcomm != NULL) { + retval = gcomm(Nlocal, tt, yy, yp, user_data); + if (retval != 0) return(retval); + } + + retval = glocal(Nlocal, tt, yy, yp, gref, user_data); + nge++; + if (retval != 0) return(retval); + + + /* Set bandwidth and number of column groups for band differencing. */ + + width = mldq + mudq + 1; + ngroups = MIN(width, Nlocal); + + /* Loop over groups. */ + for(group = 1; group <= ngroups; group++) { + + /* Loop over the components in this group. */ + for(j = group-1; j < Nlocal; j += width) { + yj = ydata[j]; + ypj = ypdata[j]; + ewtj = ewtdata[j]; + + /* Set increment inc to yj based on rel_yy*abs(yj), with + adjustments using ypj and ewtj if this is small, and a further + adjustment to give it the same sign as hh*ypj. */ + inc = rel_yy*MAX(ABS(yj), MAX( ABS(hh*ypj), ONE/ewtj)); + if (hh*ypj < ZERO) inc = -inc; + inc = (yj + inc) - yj; + + /* Adjust sign(inc) again if yj has an inequality constraint. */ + if (constraints != NULL) { + conj = cnsdata[j]; + if (ABS(conj) == ONE) {if ((yj+inc)*conj < ZERO) inc = -inc;} + else if (ABS(conj) == TWO) {if ((yj+inc)*conj <= ZERO) inc = -inc;} + } + + /* Increment yj and ypj. */ + ytempdata[j] += inc; + yptempdata[j] += cj*inc; + + } + + /* Evaluate G with incremented y and yp arguments. */ + + retval = glocal(Nlocal, tt, ytemp, yptemp, gtemp, user_data); + nge++; + if (retval != 0) return(retval); + + /* Loop over components of the group again; restore ytemp and yptemp. */ + for(j = group-1; j < Nlocal; j += width) { + yj = ytempdata[j] = ydata[j]; + ypj = yptempdata[j] = ypdata[j]; + ewtj = ewtdata[j]; + + /* Set increment inc as before .*/ + inc = rel_yy*MAX(ABS(yj), MAX( ABS(hh*ypj), ONE/ewtj)); + if (hh*ypj < ZERO) inc = -inc; + inc = (yj + inc) - yj; + if (constraints != NULL) { + conj = cnsdata[j]; + if (ABS(conj) == ONE) {if ((yj+inc)*conj < ZERO) inc = -inc;} + else if (ABS(conj) == TWO) {if ((yj+inc)*conj <= ZERO) inc = -inc;} + } + + /* Form difference quotients and load into PP. */ + inc_inv = ONE/inc; + col_j = BAND_COL(PP,j); + i1 = MAX(0, j-mukeep); + i2 = MIN(j+mlkeep, Nlocal-1); + for(i = i1; i <= i2; i++) BAND_COL_ELEM(col_j,i,j) = + inc_inv * (gtempdata[i] - grefdata[i]); + } + } + + return(0); +} + diff --git a/odemex/Parser/CVode/ida_src/src/ida/ida_bbdpre_impl.h b/odemex/Parser/CVode/ida_src/src/ida/ida_bbdpre_impl.h new file mode 100644 index 0000000..11897bf --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/ida_bbdpre_impl.h @@ -0,0 +1,88 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.4 $ + * $Date: 2007/04/30 17:43:09 $ + * ----------------------------------------------------------------- + * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file (private version) for the IDABBDPRE + * module, for a band-block-diagonal preconditioner, i.e. a + * block-diagonal matrix with banded blocks, for use with IDA + * and an IDASPILS linear solver. + * ----------------------------------------------------------------- + */ + +#ifndef _IDABBDPRE_IMPL_H +#define _IDABBDPRE_IMPL_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +/* + * ----------------------------------------------------------------- + * Definition of IBBDPrecData + * ----------------------------------------------------------------- + */ + +typedef struct IBBDPrecDataRec { + + /* passed by user to IDABBDPrecAlloc and used by + IDABBDPrecSetup/IDABBDPrecSolve functions */ + + int mudq, mldq, mukeep, mlkeep; + realtype rel_yy; + IDABBDLocalFn glocal; + IDABBDCommFn gcomm; + + /* allocated for use by IDABBDPrecSetup */ + + N_Vector tempv4; + + /* set by IDABBDPrecon and used by IDABBDPrecSolve */ + + DlsMat PP; + int *pivots; + + /* set by IDABBDPrecAlloc and used by IDABBDPrecSetup */ + + int n_local; + + /* available for optional output */ + + long int rpwsize; + long int ipwsize; + long int nge; + + /* pointer to ida_mem */ + + void *ida_mem; + +} *IBBDPrecData; + +/* + * ----------------------------------------------------------------- + * IDABBDPRE error messages + * ----------------------------------------------------------------- + */ + +#define MSGBBD_MEM_NULL "Integrator memory is NULL." +#define MSGBBD_LMEM_NULL "Linear solver memory is NULL. One of the SPILS linear solvers must be attached." +#define MSGBBD_MEM_FAIL "A memory request failed." +#define MSGBBD_BAD_NVECTOR "A required vector operation is not implemented." +#define MSGBBD_PMEM_NULL "BBD peconditioner memory is NULL. IDABBDPrecInit must be called." +#define MSGBBD_FUNC_FAILED "The Glocal or Gcomm routine failed in an unrecoverable manner." + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/src/ida/ida_dense.c b/odemex/Parser/CVode/ida_src/src/ida/ida_dense.c new file mode 100644 index 0000000..10e5485 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/ida_dense.c @@ -0,0 +1,301 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.11 $ + * $Date: 2009/02/17 02:42:29 $ + * ----------------------------------------------------------------- + * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for the IDADENSE linear solver. + * ----------------------------------------------------------------- + */ + +#include +#include +#include + +#include +#include "ida_direct_impl.h" +#include "ida_impl.h" + +#include + +/* Constants */ + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) +#define TWO RCONST(2.0) + +/* IDADENSE linit, lsetup, lsolve, and lfree routines */ + +static int IDADenseInit(IDAMem IDA_mem); + +static int IDADenseSetup(IDAMem IDA_mem, N_Vector yyp, N_Vector ypp, + N_Vector rrp, N_Vector tmp1, + N_Vector tmp2, N_Vector tmp3); + +static int IDADenseSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight, + N_Vector ycur, N_Vector ypcur, N_Vector rrcur); + +static int IDADenseFree(IDAMem IDA_mem); + +/* Readability Replacements */ + +#define res (IDA_mem->ida_res) +#define tn (IDA_mem->ida_tn) +#define hh (IDA_mem->ida_hh) +#define cj (IDA_mem->ida_cj) +#define cjratio (IDA_mem->ida_cjratio) +#define ewt (IDA_mem->ida_ewt) +#define constraints (IDA_mem->ida_constraints) +#define linit (IDA_mem->ida_linit) +#define lsetup (IDA_mem->ida_lsetup) +#define lsolve (IDA_mem->ida_lsolve) +#define lperf (IDA_mem->ida_lperf) +#define lfree (IDA_mem->ida_lfree) +#define lmem (IDA_mem->ida_lmem) +#define setupNonNull (IDA_mem->ida_setupNonNull) +#define vec_tmpl (IDA_mem->ida_tempv1) + +#define mtype (idadls_mem->d_type) +#define neq (idadls_mem->d_n) +#define jacDQ (idadls_mem->d_jacDQ) +#define djac (idadls_mem->d_djac) +#define JJ (idadls_mem->d_J) +#define pivots (idadls_mem->d_pivots) +#define nje (idadls_mem->d_nje) +#define nreDQ (idadls_mem->d_nreDQ) +#define jacdata (idadls_mem->d_J_data) +#define last_flag (idadls_mem->d_last_flag) + +/* + * ----------------------------------------------------------------- + * IDADense + * ----------------------------------------------------------------- + * This routine initializes the memory record and sets various function + * fields specific to the IDADENSE linear solver module. + * IDADense first calls the existing lfree routine if this is not NULL. + * Then it sets the ida_linit, ida_lsetup, ida_lsolve, ida_lperf, and + * ida_lfree fields in (*IDA_mem) to be IDADenseInit, IDADenseSetup, + * IDADenseSolve, NULL, and IDADenseFree, respectively. + * It allocates memory for a structure of type IDADlsMemRec and sets + * the ida_lmem field in (*IDA_mem) to the address of this structure. + * It sets setupNonNull in (*IDA_mem) to TRUE, sets the d_jdata field + * in the IDADlsMemRec structure to be the input parameter jdata, + * and sets the d_jac field to be: + * (1) the input parameter djac, if djac != NULL, or + * (2) IDADenseDQJac, if djac == NULL. + * Finally, it allocates memory for JJ and pivots. + * The return value is IDADLS_SUCCESS = 0, IDADLS_LMEM_FAIL = -1, + * or IDADLS_ILL_INPUT = -2. + * + * NOTE: The dense linear solver assumes a serial implementation + * of the NVECTOR package. Therefore, IDADense will first + * test for a compatible N_Vector internal + * representation by checking that the functions N_VGetArrayPointer + * and N_VSetArrayPointer exist. + * ----------------------------------------------------------------- + */ + +int IDADense(void *ida_mem, int Neq) +{ + IDAMem IDA_mem; + IDADlsMem idadls_mem; + int flag; + + /* Return immediately if ida_mem is NULL. */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDADLS_MEM_NULL, "IDADENSE", "IDADense", MSGD_IDAMEM_NULL); + return(IDADLS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + /* Test if the NVECTOR package is compatible with the DENSE solver */ + if(vec_tmpl->ops->nvgetarraypointer == NULL || + vec_tmpl->ops->nvsetarraypointer == NULL) { + IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDADENSE", "IDADense", MSGD_BAD_NVECTOR); + return(IDADLS_ILL_INPUT); + } + + if (lfree != NULL) flag = lfree(IDA_mem); + + /* Set five main function fields in IDA_mem. */ + linit = IDADenseInit; + lsetup = IDADenseSetup; + lsolve = IDADenseSolve; + lperf = NULL; + lfree = IDADenseFree; + + /* Get memory for IDADlsMemRec. */ + idadls_mem = NULL; + idadls_mem = (IDADlsMem) malloc(sizeof(struct IDADlsMemRec)); + if (idadls_mem == NULL) { + IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDADENSE", "IDADense", MSGD_MEM_FAIL); + return(IDADLS_MEM_FAIL); + } + + /* Set matrix type */ + mtype = SUNDIALS_DENSE; + + /* Set default Jacobian routine and Jacobian data */ + jacDQ = TRUE; + djac = NULL; + jacdata = NULL; + + last_flag = IDADLS_SUCCESS; + + setupNonNull = TRUE; + + /* Store problem size */ + neq = Neq; + + /* Allocate memory for JJ and pivot array. */ + JJ = NULL; + JJ = NewDenseMat(Neq, Neq); + if (JJ == NULL) { + IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDADENSE", "IDADense", MSGD_MEM_FAIL); + free(idadls_mem); idadls_mem = NULL; + return(IDADLS_MEM_FAIL); + } + + pivots = NULL; + pivots = NewIntArray(Neq); + if (pivots == NULL) { + IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDADENSE", "IDADense", MSGD_MEM_FAIL); + DestroyMat(JJ); + free(idadls_mem); idadls_mem = NULL; + return(IDADLS_MEM_FAIL); + } + + /* Attach linear solver memory to the integrator memory */ + lmem = idadls_mem; + + return(IDADLS_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * IDADENSE interface functions + * ----------------------------------------------------------------- + */ + +/* + This routine does remaining initializations specific to the IDADENSE + linear solver module. It returns 0. +*/ + +static int IDADenseInit(IDAMem IDA_mem) +{ + IDADlsMem idadls_mem; + + idadls_mem = (IDADlsMem) lmem; + + + nje = 0; + nreDQ = 0; + + if (jacDQ) { + djac = idaDlsDenseDQJac; + jacdata = IDA_mem; + } else { + jacdata = IDA_mem->ida_user_data; + } + + last_flag = 0; + return(0); +} + +/* + This routine does the setup operations for the IDADENSE linear + solver module. It calls the Jacobian evaluation routine, + updates counters, and calls the dense LU factorization routine. + The return value is either + IDADLS_SUCCESS = 0 if successful, + +1 if the jac routine failed recoverably or the + LU factorization failed, or + -1 if the jac routine failed unrecoverably. +*/ + +static int IDADenseSetup(IDAMem IDA_mem, N_Vector yyp, N_Vector ypp, + N_Vector rrp, N_Vector tmp1, N_Vector tmp2, + N_Vector tmp3) +{ + int retval; + long int retfac; + IDADlsMem idadls_mem; + + idadls_mem = (IDADlsMem) lmem; + + /* Increment nje counter. */ + nje++; + + /* Zero out JJ; call Jacobian routine jac; return if it failed. */ + SetToZero(JJ); + retval = djac(neq, tn, cj, yyp, ypp, rrp, JJ, jacdata, + tmp1, tmp2, tmp3); + if (retval < 0) { + IDAProcessError(IDA_mem, IDADLS_JACFUNC_UNRECVR, "IDADENSE", "IDADenseSetup", MSGD_JACFUNC_FAILED); + last_flag = IDADLS_JACFUNC_UNRECVR; + return(-1); + } + if (retval > 0) { + last_flag = IDADLS_JACFUNC_RECVR; + return(+1); + } + + /* Do LU factorization of JJ; return success or fail flag. */ + retfac = DenseGETRF(JJ, pivots); + + if (retfac != 0) { + last_flag = retfac; + return(+1); + } + last_flag = IDADLS_SUCCESS; + return(0); +} + +/* + This routine handles the solve operation for the IDADENSE linear + solver module. It calls the dense backsolve routine, scales the + solution vector according to cjratio, then returns IDADLS_SUCCESS = 0. +*/ + +static int IDADenseSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight, + N_Vector ycur, N_Vector ypcur, N_Vector rrcur) +{ + IDADlsMem idadls_mem; + realtype *bd; + + idadls_mem = (IDADlsMem) lmem; + + bd = N_VGetArrayPointer(b); + + DenseGETRS(JJ, pivots, bd); + + /* Scale the correction to account for change in cj. */ + if (cjratio != ONE) N_VScale(TWO/(ONE + cjratio), b, b); + + last_flag = 0; + return(0); +} + +/* + This routine frees memory specific to the IDADENSE linear solver. +*/ + +static int IDADenseFree(IDAMem IDA_mem) +{ + IDADlsMem idadls_mem; + + idadls_mem = (IDADlsMem) lmem; + + DestroyMat(JJ); + DestroyArray(pivots); + free(lmem); lmem = NULL; + + return(0); +} diff --git a/odemex/Parser/CVode/ida_src/src/ida/ida_direct.c b/odemex/Parser/CVode/ida_src/src/ida/ida_direct.c new file mode 100644 index 0000000..d7d1ef6 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/ida_direct.c @@ -0,0 +1,546 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.5 $ + * $Date: 2008/04/18 19:42:41 $ + * ----------------------------------------------------------------- + * Programmer: Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2006, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for an IDADLS linear solver. + * ----------------------------------------------------------------- + */ + +/* + * ================================================================= + * IMPORTED HEADER FILES + * ================================================================= + */ + +#include +#include + +#include "ida_impl.h" +#include "ida_direct_impl.h" +#include + +/* + * ================================================================= + * FUNCTION SPECIFIC CONSTANTS + * ================================================================= + */ + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) +#define TWO RCONST(2.0) + +/* + * ================================================================= + * READIBILITY REPLACEMENTS + * ================================================================= + */ + +#define res (IDA_mem->ida_res) +#define user_data (IDA_mem->ida_user_data) +#define uround (IDA_mem->ida_uround) +#define nst (IDA_mem->ida_nst) +#define tn (IDA_mem->ida_tn) +#define hh (IDA_mem->ida_hh) +#define cj (IDA_mem->ida_cj) +#define cjratio (IDA_mem->ida_cjratio) +#define ewt (IDA_mem->ida_ewt) +#define constraints (IDA_mem->ida_constraints) + +#define linit (IDA_mem->ida_linit) +#define lsetup (IDA_mem->ida_lsetup) +#define lsolve (IDA_mem->ida_lsolve) +#define lfree (IDA_mem->ida_lfree) +#define lperf (IDA_mem->ida_lperf) +#define lmem (IDA_mem->ida_lmem) +#define tempv (IDA_mem->ida_tempv1) +#define setupNonNull (IDA_mem->ida_setupNonNull) + +#define mtype (idadls_mem->d_type) +#define n (idadls_mem->d_n) +#define ml (idadls_mem->d_ml) +#define mu (idadls_mem->d_mu) +#define smu (idadls_mem->d_smu) +#define jacDQ (idadls_mem->d_jacDQ) +#define djac (idadls_mem->d_djac) +#define bjac (idadls_mem->d_bjac) +#define M (idadls_mem->d_J) +#define pivots (idadls_mem->d_pivots) +#define nje (idadls_mem->d_nje) +#define nreDQ (idadls_mem->d_nreDQ) +#define last_flag (idadls_mem->d_last_flag) + +/* + * ================================================================= + * EXPORTED FUNCTIONS FOR IMPLICIT INTEGRATION + * ================================================================= + */ + +/* + * IDADlsSetDenseJacFn specifies the dense Jacobian function. + */ +int IDADlsSetDenseJacFn(void *ida_mem, IDADlsDenseJacFn jac) +{ + IDAMem IDA_mem; + IDADlsMem idadls_mem; + + /* Return immediately if ida_mem is NULL */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDADLS_MEM_NULL, "IDADLS", "IDADlsSetDenseJacFn", MSGD_IDAMEM_NULL); + return(IDADLS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + if (lmem == NULL) { + IDAProcessError(IDA_mem, IDADLS_LMEM_NULL, "IDADLS", "IDADlsSetDenseJacFn", MSGD_LMEM_NULL); + return(IDADLS_LMEM_NULL); + } + idadls_mem = (IDADlsMem) lmem; + + if (jac != NULL) { + jacDQ = FALSE; + djac = jac; + } else { + jacDQ = TRUE; + } + + return(IDADLS_SUCCESS); +} + +/* + * IDADlsSetBandJacFn specifies the band Jacobian function. + */ +int IDADlsSetBandJacFn(void *ida_mem, IDADlsBandJacFn jac) +{ + IDAMem IDA_mem; + IDADlsMem idadls_mem; + + /* Return immediately if ida_mem is NULL */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDADLS_MEM_NULL, "IDADLS", "IDADlsSetBandJacFn", MSGD_IDAMEM_NULL); + return(IDADLS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + if (lmem == NULL) { + IDAProcessError(IDA_mem, IDADLS_LMEM_NULL, "IDADLS", "IDADlsSetBandJacFn", MSGD_LMEM_NULL); + return(IDADLS_LMEM_NULL); + } + idadls_mem = (IDADlsMem) lmem; + + if (jac != NULL) { + jacDQ = FALSE; + bjac = jac; + } else { + jacDQ = TRUE; + } + + return(IDADLS_SUCCESS); +} + +/* + * IDADlsGetWorkSpace returns the length of workspace allocated for the + * IDALAPACK linear solver. + */ +int IDADlsGetWorkSpace(void *ida_mem, long int *lenrwLS, long int *leniwLS) +{ + IDAMem IDA_mem; + IDADlsMem idadls_mem; + + /* Return immediately if ida_mem is NULL */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDADLS_MEM_NULL, "IDADLS", "IDADlsGetWorkSpace", MSGD_IDAMEM_NULL); + return(IDADLS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + if (lmem == NULL) { + IDAProcessError(IDA_mem, IDADLS_LMEM_NULL, "IDADLS", "IDADlsGetWorkSpace", MSGD_LMEM_NULL); + return(IDADLS_LMEM_NULL); + } + idadls_mem = (IDADlsMem) lmem; + + if (mtype == SUNDIALS_DENSE) { + *lenrwLS = n*n; + *leniwLS = n; + } else if (mtype == SUNDIALS_BAND) { + *lenrwLS = n*(smu + ml + 1); + *leniwLS = n; + } + + return(IDADLS_SUCCESS); +} + +/* + * IDADlsGetNumJacEvals returns the number of Jacobian evaluations. + */ +int IDADlsGetNumJacEvals(void *ida_mem, long int *njevals) +{ + IDAMem IDA_mem; + IDADlsMem idadls_mem; + + /* Return immediately if ida_mem is NULL */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDADLS_MEM_NULL, "IDADLS", "IDADlsGetNumJacEvals", MSGD_IDAMEM_NULL); + return(IDADLS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + if (lmem == NULL) { + IDAProcessError(IDA_mem, IDADLS_LMEM_NULL, "IDADLS", "IDADlsGetNumJacEvals", MSGD_LMEM_NULL); + return(IDADLS_LMEM_NULL); + } + idadls_mem = (IDADlsMem) lmem; + + *njevals = nje; + + return(IDADLS_SUCCESS); +} + +/* + * IDADlsGetNumResEvals returns the number of calls to the DAE function + * needed for the DQ Jacobian approximation. + */ +int IDADlsGetNumResEvals(void *ida_mem, long int *nrevalsLS) +{ + IDAMem IDA_mem; + IDADlsMem idadls_mem; + + /* Return immediately if ida_mem is NULL */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDADLS_MEM_NULL, "IDADLS", "IDADlsGetNumFctEvals", MSGD_IDAMEM_NULL); + return(IDADLS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + if (lmem == NULL) { + IDAProcessError(IDA_mem, IDADLS_LMEM_NULL, "IDADLS", "IDADlsGetNumFctEvals", MSGD_LMEM_NULL); + return(IDADLS_LMEM_NULL); + } + idadls_mem = (IDADlsMem) lmem; + + *nrevalsLS = nreDQ; + + return(IDADLS_SUCCESS); +} + +/* + * IDADlsGetReturnFlagName returns the name associated with a IDALAPACK + * return value. + */ +char *IDADlsGetReturnFlagName(int flag) +{ + char *name; + + name = (char *)malloc(30*sizeof(char)); + + switch(flag) { + case IDADLS_SUCCESS: + sprintf(name,"IDADLS_SUCCESS"); + break; + case IDADLS_MEM_NULL: + sprintf(name,"IDADLS_MEM_NULL"); + break; + case IDADLS_LMEM_NULL: + sprintf(name,"IDADLS_LMEM_NULL"); + break; + case IDADLS_ILL_INPUT: + sprintf(name,"IDADLS_ILL_INPUT"); + break; + case IDADLS_MEM_FAIL: + sprintf(name,"IDADLS_MEM_FAIL"); + break; + case IDADLS_JACFUNC_UNRECVR: + sprintf(name,"IDADLS_JACFUNC_UNRECVR"); + break; + case IDADLS_JACFUNC_RECVR: + sprintf(name,"IDADLS_JACFUNC_RECVR"); + break; + default: + sprintf(name,"NONE"); + } + + return(name); +} + +/* + * IDADlsGetLastFlag returns the last flag set in a IDALAPACK function. + */ +int IDADlsGetLastFlag(void *ida_mem, int *flag) +{ + IDAMem IDA_mem; + IDADlsMem idadls_mem; + + /* Return immediately if ida_mem is NULL */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDADLS_MEM_NULL, "IDADLS", "IDADlsGetLastFlag", MSGD_IDAMEM_NULL); + return(IDADLS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + if (lmem == NULL) { + IDAProcessError(IDA_mem, IDADLS_LMEM_NULL, "IDADLS", "IDADlsGetLastFlag", MSGD_LMEM_NULL); + return(IDADLS_LMEM_NULL); + } + idadls_mem = (IDADlsMem) lmem; + + *flag = last_flag; + + return(IDADLS_SUCCESS); +} + +/* + * ================================================================= + * DQ JACOBIAN APPROXIMATIONS + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * idaDlsDenseDQJac + * ----------------------------------------------------------------- + * This routine generates a dense difference quotient approximation to + * the Jacobian F_y + c_j*F_y'. It assumes that a dense matrix of type + * DlsMat is stored column-wise, and that elements within each column + * are contiguous. The address of the jth column of J is obtained via + * the macro LAPACK_DENSE_COL and this pointer is associated with an N_Vector + * using the N_VGetArrayPointer/N_VSetArrayPointer functions. + * Finally, the actual computation of the jth column of the Jacobian is + * done with a call to N_VLinearSum. + * ----------------------------------------------------------------- + */ +int idaDlsDenseDQJac(int N, realtype tt, realtype c_j, + N_Vector yy, N_Vector yp, N_Vector rr, + DlsMat Jac, void *data, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) +{ + realtype inc, inc_inv, yj, ypj, srur, conj; + realtype *tmp2_data, *y_data, *yp_data, *ewt_data, *cns_data = NULL; + N_Vector rtemp, jthCol; + int j; + int retval = 0; + + IDAMem IDA_mem; + IDADlsMem idadls_mem; + + /* data points to IDA_mem */ + IDA_mem = (IDAMem) data; + idadls_mem = (IDADlsMem) lmem; + + /* Save pointer to the array in tmp2 */ + tmp2_data = N_VGetArrayPointer(tmp2); + + /* Rename work vectors for readibility */ + rtemp = tmp1; + jthCol = tmp2; + + /* Obtain pointers to the data for ewt, yy, yp. */ + ewt_data = N_VGetArrayPointer(ewt); + y_data = N_VGetArrayPointer(yy); + yp_data = N_VGetArrayPointer(yp); + if(constraints!=NULL) cns_data = N_VGetArrayPointer(constraints); + + srur = RSqrt(uround); + + for (j=0; j < N; j++) { + + /* Generate the jth col of J(tt,yy,yp) as delta(F)/delta(y_j). */ + + /* Set data address of jthCol, and save y_j and yp_j values. */ + N_VSetArrayPointer(DENSE_COL(Jac,j), jthCol); + yj = y_data[j]; + ypj = yp_data[j]; + + /* Set increment inc to y_j based on sqrt(uround)*abs(y_j), with + adjustments using yp_j and ewt_j if this is small, and a further + adjustment to give it the same sign as hh*yp_j. */ + + inc = MAX( srur * MAX( ABS(yj), ABS(hh*ypj) ) , ONE/ewt_data[j] ); + + if (hh*ypj < ZERO) inc = -inc; + inc = (yj + inc) - yj; + + /* Adjust sign(inc) again if y_j has an inequality constraint. */ + if (constraints != NULL) { + conj = cns_data[j]; + if (ABS(conj) == ONE) {if((yj+inc)*conj < ZERO) inc = -inc;} + else if (ABS(conj) == TWO) {if((yj+inc)*conj <= ZERO) inc = -inc;} + } + + /* Increment y_j and yp_j, call res, and break on error return. */ + y_data[j] += inc; + yp_data[j] += c_j*inc; + + retval = res(tt, yy, yp, rtemp, user_data); + nreDQ++; + if (retval != 0) break; + + /* Construct difference quotient in jthCol */ + inc_inv = ONE/inc; + N_VLinearSum(inc_inv, rtemp, -inc_inv, rr, jthCol); + + DENSE_COL(Jac,j) = N_VGetArrayPointer(jthCol); + + /* reset y_j, yp_j */ + y_data[j] = yj; + yp_data[j] = ypj; + } + + /* Restore original array pointer in tmp2 */ + N_VSetArrayPointer(tmp2_data, tmp2); + + return(retval); + +} + +/* + * ----------------------------------------------------------------- + * idaDlsBandDQJac + * ----------------------------------------------------------------- + * This routine generates a banded difference quotient approximation JJ + * to the DAE system Jacobian J. It assumes that a band matrix of type + * BandMat is stored column-wise, and that elements within each column + * are contiguous. The address of the jth column of JJ is obtained via + * the macros BAND_COL and BAND_COL_ELEM. The columns of the Jacobian are + * constructed using mupper + mlower + 1 calls to the res routine, and + * appropriate differencing. + * The return value is either IDABAND_SUCCESS = 0, or the nonzero value returned + * by the res routine, if any. + */ + +int idaDlsBandDQJac(int N, int mupper, int mlower, + realtype tt, realtype c_j, + N_Vector yy, N_Vector yp, N_Vector rr, + DlsMat Jac, void *data, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) +{ + realtype inc, inc_inv, yj, ypj, srur, conj, ewtj; + realtype *y_data, *yp_data, *ewt_data, *cns_data = NULL; + realtype *ytemp_data, *yptemp_data, *rtemp_data, *r_data, *col_j; + int group; + + N_Vector rtemp, ytemp, yptemp; + int i, j, i1, i2, width, ngroups; + int retval = 0; + + IDAMem IDA_mem; + IDADlsMem idadls_mem; + + /* data points to IDA_mem */ + IDA_mem = (IDAMem) data; + idadls_mem = (IDADlsMem) lmem; + + rtemp = tmp1; /* Rename work vector for use as the perturbed residual. */ + + ytemp = tmp2; /* Rename work vector for use as a temporary for yy. */ + + + yptemp= tmp3; /* Rename work vector for use as a temporary for yp. */ + + /* Obtain pointers to the data for all eight vectors used. */ + + ewt_data = N_VGetArrayPointer(ewt); + r_data = N_VGetArrayPointer(rr); + y_data = N_VGetArrayPointer(yy); + yp_data = N_VGetArrayPointer(yp); + + rtemp_data = N_VGetArrayPointer(rtemp); + ytemp_data = N_VGetArrayPointer(ytemp); + yptemp_data = N_VGetArrayPointer(yptemp); + + if (constraints != NULL) cns_data = N_VGetArrayPointer(constraints); + + /* Initialize ytemp and yptemp. */ + + N_VScale(ONE, yy, ytemp); + N_VScale(ONE, yp, yptemp); + + /* Compute miscellaneous values for the Jacobian computation. */ + + srur = RSqrt(uround); + width = mlower + mupper + 1; + ngroups = MIN(width, N); + + /* Loop over column groups. */ + for (group=1; group <= ngroups; group++) { + + /* Increment all yy[j] and yp[j] for j in this group. */ + + for (j=group-1; j + +/* + * ================================================================= + * I D A D I R E C T I N T E R N A L C O N S T A N T S + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * Types : IDADlsMemRec, IDADlsMem + * ----------------------------------------------------------------- + * IDADlsMem is pointer to a IDADlsMemRec structure. + * ----------------------------------------------------------------- + */ + +typedef struct IDADlsMemRec { + + int d_type; /* Type of Jacobians (DENSE or BAND) */ + + int d_n; /* problem dimension */ + + int d_ml; /* b_ml = lower bandwidth of savedJ */ + int d_mu; /* b_mu = upper bandwidth of savedJ */ + int d_smu; /* upper bandwith of M = MIN(N-1,b_mu+b_ml) */ + + booleantype d_jacDQ; /* TRUE if using internal DQ Jacobian approx. */ + IDADlsDenseJacFn d_djac; /* dense Jacobian routine to be called */ + IDADlsBandJacFn d_bjac; /* band Jacobian routine to be called */ + void *d_J_data; /* J_data is passed to djac or bjac */ + + DlsMat d_J; /* J = dF/dy + cj*dF/dy' */ + int *d_pivots; /* pivots = pivot array for PM = LU */ + + long int d_nje; /* nje = no. of calls to jac */ + + long int d_nreDQ; /* no. of calls to res due to DQ Jacobian approx.*/ + + int d_last_flag; /* last error return flag */ + +} *IDADlsMem; + +/* + * ----------------------------------------------------------------- + * Prototypes of internal functions + * ----------------------------------------------------------------- + */ + +int idaDlsDenseDQJac(int N, realtype tt, realtype c_j, + N_Vector yy, N_Vector yp, N_Vector rr, + DlsMat Jac, void *data, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); + +int idaDlsBandDQJac(int N, int mupper, int mlower, + realtype tt, realtype c_j, + N_Vector yy, N_Vector yp, N_Vector rr, + DlsMat Jac, void *data, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); + +/* + * ================================================================= + * E R R O R M E S S A G E S + * ================================================================= + */ + +#define MSGD_IDAMEM_NULL "Integrator memory is NULL." +#define MSGD_BAD_NVECTOR "A required vector operation is not implemented." +#define MSGD_BAD_SIZES "Illegal bandwidth parameter(s). Must have 0 <= ml, mu <= N-1." +#define MSGD_MEM_FAIL "A memory request failed." +#define MSGD_LMEM_NULL "Linear solver memory is NULL." +#define MSGD_JACFUNC_FAILED "The Jacobian routine failed in an unrecoverable manner." + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/src/ida/ida_ic.c b/odemex/Parser/CVode/ida_src/src/ida/ida_ic.c new file mode 100644 index 0000000..43bafc2 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/ida_ic.c @@ -0,0 +1,728 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.3 $ + * $Date: 2007/04/30 19:29:00 $ + * ----------------------------------------------------------------- + * Programmers: Alan C. Hindmarsh, and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California + * Produced at the Lawrence Livermore National Laboratory + * All rights reserved + * For details, see the LICENSE file + * ----------------------------------------------------------------- + * This is the implementation file for the IC calculation for IDA. + * It is independent of the linear solver in use. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "ida_impl.h" +#include + +/* Macro: loop */ +#define loop for(;;) + +/* + * ================================================================= + * IDA Constants + * ================================================================= + */ + +/* Private Constants */ + +#define ZERO RCONST(0.0) /* real 0.0 */ +#define HALF RCONST(0.5) /* real 0.5 */ +#define ONE RCONST(1.0) /* real 1.0 */ +#define TWO RCONST(2.0) /* real 2.0 */ +#define PT99 RCONST(0.99) /* real 0.99 */ +#define PT1 RCONST(0.1) /* real 0.1 */ +#define PT001 RCONST(0.001) /* real 0.001 */ + +/* IDACalcIC control constants */ + +#define ICRATEMAX RCONST(0.9) /* max. Newton conv. rate */ +#define ALPHALS RCONST(0.0001) /* alpha in linesearch conv. test */ + +/* Return values for lower level routines used by IDACalcIC */ + +#define IC_FAIL_RECOV 1 +#define IC_CONSTR_FAILED 2 +#define IC_LINESRCH_FAILED 3 +#define IC_CONV_FAIL 4 +#define IC_SLOW_CONVRG 5 + +/* + * ================================================================= + * Private Helper Functions Prototypes + * ================================================================= + */ + +extern int IDAInitialSetup(IDAMem IDA_mem); +extern realtype IDAWrmsNorm(IDAMem IDA_mem, N_Vector x, N_Vector w, + booleantype mask); + +static int IDAnlsIC(IDAMem IDA_mem); +static int IDANewtonIC(IDAMem IDA_mem); +static int IDALineSrch(IDAMem IDA_mem, realtype *delnorm, realtype *fnorm); +static int IDAfnorm(IDAMem IDA_mem, realtype *fnorm); +static int IDANewyyp(IDAMem IDA_mem, realtype lambda); +static int IDANewy(IDAMem IDA_mem); +static int IDAICFailFlag(IDAMem IDA_mem, int retval); + +/* + * ================================================================= + * Readibility Constants + * ================================================================= + */ + +#define t0 (IDA_mem->ida_t0) +#define yy0 (IDA_mem->ida_yy0) +#define yp0 (IDA_mem->ida_yp0) + +#define user_data (IDA_mem->ida_user_data) +#define res (IDA_mem->ida_res) +#define efun (IDA_mem->ida_efun) +#define edata (IDA_mem->ida_edata) +#define uround (IDA_mem->ida_uround) +#define phi (IDA_mem->ida_phi) +#define ewt (IDA_mem->ida_ewt) +#define delta (IDA_mem->ida_delta) +#define ee (IDA_mem->ida_ee) +#define savres (IDA_mem->ida_savres) +#define tempv2 (IDA_mem->ida_tempv2) +#define hh (IDA_mem->ida_hh) +#define tn (IDA_mem->ida_tn) +#define cj (IDA_mem->ida_cj) +#define cjratio (IDA_mem->ida_cjratio) +#define nbacktr (IDA_mem->ida_nbacktr) +#define nre (IDA_mem->ida_nre) +#define ncfn (IDA_mem->ida_ncfn) +#define nni (IDA_mem->ida_nni) +#define nsetups (IDA_mem->ida_nsetups) +#define ns (IDA_mem->ida_ns) +#define lsetup (IDA_mem->ida_lsetup) +#define lsolve (IDA_mem->ida_lsolve) +#define hused (IDA_mem->ida_hused) +#define epsNewt (IDA_mem->ida_epsNewt) +#define id (IDA_mem->ida_id) +#define setupNonNull (IDA_mem->ida_setupNonNull) +#define suppressalg (IDA_mem->ida_suppressalg) +#define constraints (IDA_mem->ida_constraints) +#define constraintsSet (IDA_mem->ida_constraintsSet) + +#define epiccon (IDA_mem->ida_epiccon) +#define maxnh (IDA_mem->ida_maxnh) +#define maxnj (IDA_mem->ida_maxnj) +#define maxnit (IDA_mem->ida_maxnit) +#define lsoff (IDA_mem->ida_lsoff) +#define steptol (IDA_mem->ida_steptol) + +/* + * ================================================================= + * EXPORTED FUNCTIONS IMPLEMENTATION + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * IDACalcIC + * ----------------------------------------------------------------- + * IDACalcIC computes consistent initial conditions, given the + * user's initial guess for unknown components of yy0 and/or yp0. + * + * The return value is IDA_SUCCESS = 0 if no error occurred. + * + * The error return values (fully described in ida.h) are: + * IDA_MEM_NULL ida_mem is NULL + * IDA_NO_MALLOC ida_mem was not allocated + * IDA_ILL_INPUT bad value for icopt, tout1, or id + * IDA_LINIT_FAIL the linear solver linit routine failed + * IDA_BAD_EWT zero value of some component of ewt + * IDA_RES_FAIL res had a non-recoverable error + * IDA_FIRST_RES_FAIL res failed recoverably on the first call + * IDA_LSETUP_FAIL lsetup had a non-recoverable error + * IDA_LSOLVE_FAIL lsolve had a non-recoverable error + * IDA_NO_RECOVERY res, lsetup, or lsolve had a recoverable + * error, but IDACalcIC could not recover + * IDA_CONSTR_FAIL the inequality constraints could not be met + * IDA_LINESEARCH_FAIL the linesearch failed (on steptol test) + * IDA_CONV_FAIL the Newton iterations failed to converge + * ----------------------------------------------------------------- + */ + +int IDACalcIC(void *ida_mem, int icopt, realtype tout1) +{ + int ewtsetOK; + int ier, nwt, nh, mxnh, icret, retval=0; + realtype tdist, troundoff, minid, hic, ypnorm; + IDAMem IDA_mem; + + /* Check if IDA memory exists */ + + if(ida_mem == NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDACalcIC", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + /* Check if problem was malloc'ed */ + + if(IDA_mem->ida_MallocDone == FALSE) { + IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDA", "IDACalcIC", MSG_NO_MALLOC); + return(IDA_NO_MALLOC); + } + + /* Check inputs to IDA for correctness and consistency */ + + ier = IDAInitialSetup(IDA_mem); + if(ier != IDA_SUCCESS) return(IDA_ILL_INPUT); + IDA_mem->ida_SetupDone = TRUE; + + /* Check legality of input arguments, and set IDA memory copies. */ + + if(icopt != IDA_YA_YDP_INIT && icopt != IDA_Y_INIT) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDACalcIC", MSG_IC_BAD_ICOPT); + return(IDA_ILL_INPUT); + } + IDA_mem->ida_icopt = icopt; + + if(icopt == IDA_YA_YDP_INIT && (id == NULL)) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDACalcIC", MSG_IC_MISSING_ID); + return(IDA_ILL_INPUT); + } + + tdist = ABS(tout1 - tn); + troundoff = TWO*uround*(ABS(tn) + ABS(tout1)); + if(tdist < troundoff) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDACalcIC", MSG_IC_TOO_CLOSE); + return(IDA_ILL_INPUT); + } + + /* Allocate space and initialize temporary vectors */ + + yy0 = N_VClone(ee); + yp0 = N_VClone(ee); + t0 = tn; + N_VScale(ONE, phi[0], yy0); + N_VScale(ONE, phi[1], yp0); + + /* For use in the IDA_YA_YP_INIT case, set sysindex and tscale. */ + + IDA_mem->ida_sysindex = 1; + IDA_mem->ida_tscale = tdist; + if(icopt == IDA_YA_YDP_INIT) { + minid = N_VMin(id); + if(minid < ZERO) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDACalcIC", MSG_IC_BAD_ID); + return(IDA_ILL_INPUT); + } + if(minid > HALF) IDA_mem->ida_sysindex = 0; + } + + /* Set the test constant in the Newton convergence test */ + + IDA_mem->ida_epsNewt = epiccon; + + /* Initializations: + cjratio = 1 (for use in direct linear solvers); + set nbacktr = 0; */ + + cjratio = ONE; + nbacktr = 0; + + /* Set hic, hh, cj, and mxnh. */ + + hic = PT001*tdist; + ypnorm = IDAWrmsNorm(IDA_mem, yp0, ewt, suppressalg); + if(ypnorm > HALF/hic) hic = HALF/ypnorm; + if(tout1 < tn) hic = -hic; + hh = hic; + if(icopt == IDA_YA_YDP_INIT) { + cj = ONE/hic; + mxnh = maxnh; + } + else { + cj = ZERO; + mxnh = 1; + } + + /* Loop over nwt = number of evaluations of ewt vector. */ + + for(nwt = 1; nwt <= 2; nwt++) { + + /* Loop over nh = number of h values. */ + for(nh = 1; nh <= mxnh; nh++) { + + /* Call the IC nonlinear solver function. */ + retval = IDAnlsIC(IDA_mem); + + /* Cut h and loop on recoverable IDA_YA_YDP_INIT failure; else break. */ + if(retval == IDA_SUCCESS) break; + ncfn++; + if(retval < 0) break; + if(nh == mxnh) break; + /* If looping to try again, reset yy0 and yp0 if not converging. */ + if(retval != IC_SLOW_CONVRG) { + N_VScale(ONE, phi[0], yy0); + N_VScale(ONE, phi[1], yp0); + } + hic *= PT1; + cj = ONE/hic; + hh = hic; + } /* End of nh loop */ + + /* Break on failure; else reset ewt, save yy0, yp0 in phi, and loop. */ + if(retval != IDA_SUCCESS) break; + ewtsetOK = efun(yy0, ewt, edata); + if(ewtsetOK != 0) { + retval = IDA_BAD_EWT; + break; + } + N_VScale(ONE, yy0, phi[0]); + N_VScale(ONE, yp0, phi[1]); + + } /* End of nwt loop */ + + /* Free temporary space */ + + N_VDestroy(yy0); + N_VDestroy(yp0); + + /* Load the optional outputs. */ + + if(icopt == IDA_YA_YDP_INIT) hused = hic; + + /* On any failure, print message and return proper flag. */ + + if(retval != IDA_SUCCESS) { + icret = IDAICFailFlag(IDA_mem, retval); + return(icret); + } + + /* Otherwise return success flag. */ + + return(IDA_SUCCESS); + +} + +/* + * ================================================================= + * PRIVATE FUNCTIONS IMPLEMENTATION + * ================================================================= + */ + +#define icopt (IDA_mem->ida_icopt) +#define sysindex (IDA_mem->ida_sysindex) +#define tscale (IDA_mem->ida_tscale) +#define ynew (IDA_mem->ida_ynew) +#define ypnew (IDA_mem->ida_ypnew) +#define delnew (IDA_mem->ida_delnew) +#define dtemp (IDA_mem->ida_dtemp) + +/* + * ----------------------------------------------------------------- + * IDAnlsIC + * ----------------------------------------------------------------- + * IDAnlsIC solves a nonlinear system for consistent initial + * conditions. It calls IDANewtonIC to do most of the work. + * + * The return value is IDA_SUCCESS = 0 if no error occurred. + * The error return values (positive) considered recoverable are: + * IC_FAIL_RECOV if res, lsetup, or lsolve failed recoverably + * IC_CONSTR_FAILED if the constraints could not be met + * IC_LINESRCH_FAILED if the linesearch failed (on steptol test) + * IC_CONV_FAIL if the Newton iterations failed to converge + * IC_SLOW_CONVRG if the iterations are converging slowly + * (failed the convergence test, but showed + * norm reduction or convergence rate < 1) + * The error return values (negative) considered non-recoverable are: + * IDA_RES_FAIL if res had a non-recoverable error + * IDA_FIRST_RES_FAIL if res failed recoverably on the first call + * IDA_LSETUP_FAIL if lsetup had a non-recoverable error + * IDA_LSOLVE_FAIL if lsolve had a non-recoverable error + * ----------------------------------------------------------------- + */ + +static int IDAnlsIC (IDAMem IDA_mem) +{ + int retval, nj; + N_Vector tv1, tv2, tv3; + + tv1 = ee; + tv2 = tempv2; + tv3 = phi[2]; + + retval = res(t0, yy0, yp0, delta, user_data); + nre++; + if(retval < 0) return(IDA_RES_FAIL); + if(retval > 0) return(IDA_FIRST_RES_FAIL); + + N_VScale(ONE, delta, savres); + + /* Loop over nj = number of linear solve Jacobian setups. */ + + for(nj = 1; nj <= maxnj; nj++) { + + /* If there is a setup routine, call it. */ + if(setupNonNull) { + nsetups++; + retval = lsetup(IDA_mem, yy0, yp0, delta, tv1, tv2, tv3); + if(retval < 0) return(IDA_LSETUP_FAIL); + if(retval > 0) return(IC_FAIL_RECOV); + } + + /* Call the Newton iteration routine, and return if successful. */ + retval = IDANewtonIC(IDA_mem); + if(retval == IDA_SUCCESS) return(IDA_SUCCESS); + + /* If converging slowly and lsetup is nontrivial, retry. */ + if(retval == IC_SLOW_CONVRG && setupNonNull) { + N_VScale(ONE, savres, delta); + continue; + } else { + return(retval); + } + + } /* End of nj loop */ + + /* No convergence after maxnj tries; return with retval=IC_SLOW_CONVRG */ + return(retval); + +} + +/* + * ----------------------------------------------------------------- + * IDANewtonIC + * ----------------------------------------------------------------- + * IDANewtonIC performs the Newton iteration to solve for consistent + * initial conditions. It calls IDALineSrch within each iteration. + * On return, savres contains the current residual vector. + * + * The return value is IDA_SUCCESS = 0 if no error occurred. + * The error return values (positive) considered recoverable are: + * IC_FAIL_RECOV if res or lsolve failed recoverably + * IC_CONSTR_FAILED if the constraints could not be met + * IC_LINESRCH_FAILED if the linesearch failed (on steptol test) + * IC_CONV_FAIL if the Newton iterations failed to converge + * IC_SLOW_CONVRG if the iterations appear to be converging slowly. + * They failed the convergence test, but showed + * an overall norm reduction (by a factor of < 0.1) + * or a convergence rate <= ICRATEMAX). + * The error return values (negative) considered non-recoverable are: + * IDA_RES_FAIL if res had a non-recoverable error + * IDA_LSOLVE_FAIL if lsolve had a non-recoverable error + * ----------------------------------------------------------------- + */ + +static int IDANewtonIC(IDAMem IDA_mem) +{ + int retval, mnewt; + realtype delnorm, fnorm, fnorm0, oldfnrm, rate; + + /* Set pointer for vector delnew */ + delnew = phi[2]; + + /* Call the linear solve function to get the Newton step, delta. */ + retval = lsolve(IDA_mem, delta, ewt, yy0, yp0, savres); + if(retval < 0) return(IDA_LSOLVE_FAIL); + if(retval > 0) return(IC_FAIL_RECOV); + + /* Compute the norm of the step; return now if this is small. */ + fnorm = IDAWrmsNorm(IDA_mem, delta, ewt, FALSE); + if(sysindex == 0) fnorm *= tscale*ABS(cj); + if(fnorm <= epsNewt) return(IDA_SUCCESS); + fnorm0 = fnorm; + + /* Initialize rate to avoid compiler warning message */ + rate = ZERO; + + /* Newton iteration loop */ + + for(mnewt = 0; mnewt < maxnit; mnewt++) { + + nni++; + delnorm = fnorm; + oldfnrm = fnorm; + + /* Call the Linesearch function and return if it failed. */ + retval = IDALineSrch(IDA_mem, &delnorm, &fnorm); + if(retval != IDA_SUCCESS) return(retval); + + /* Set the observed convergence rate and test for convergence. */ + rate = fnorm/oldfnrm; + if(fnorm <= epsNewt) return(IDA_SUCCESS); + + /* If not converged, copy new step vector, and loop. */ + N_VScale(ONE, delnew, delta); + + } /* End of Newton iteration loop */ + + /* Return either IC_SLOW_CONVRG or recoverable fail flag. */ + if(rate <= ICRATEMAX || fnorm < PT1*fnorm0) return(IC_SLOW_CONVRG); + return(IC_CONV_FAIL); + +} + + +/* + * ----------------------------------------------------------------- + * IDALineSrch + * ----------------------------------------------------------------- + * IDALineSrch performs the Linesearch algorithm with the + * calculation of consistent initial conditions. + * + * On entry, yy0 and yp0 are the current values of y and y', the + * Newton step is delta, the current residual vector F is savres, + * delnorm is WRMS-norm(delta), and fnorm is the norm of the vector + * J-inverse F. + * + * On a successful return, yy0, yp0, and savres have been updated, + * delnew contains the current value of J-inverse F, and fnorm is + * WRMS-norm(delnew). + * + * The return value is IDA_SUCCESS = 0 if no error occurred. + * The error return values (positive) considered recoverable are: + * IC_FAIL_RECOV if res or lsolve failed recoverably + * IC_CONSTR_FAILED if the constraints could not be met + * IC_LINESRCH_FAILED if the linesearch failed (on steptol test) + * The error return values (negative) considered non-recoverable are: + * IDA_RES_FAIL if res had a non-recoverable error + * IDA_LSOLVE_FAIL if lsolve had a non-recoverable error + * ----------------------------------------------------------------- + */ + +static int IDALineSrch(IDAMem IDA_mem, realtype *delnorm, realtype *fnorm) +{ + booleantype conOK; + int retval; + realtype f1norm, fnormp, f1normp, ratio, lambda, minlam, slpi; + N_Vector mc; + + /* Initialize work space pointers, f1norm, ratio. + (Use of mc in constraint check does not conflict with ypnew.) */ + mc = ee; + dtemp = phi[3]; + ynew = tempv2; + ypnew = ee; + f1norm = (*fnorm)*(*fnorm)*HALF; + ratio = ONE; + + /* If there are constraints, check and reduce step if necessary. */ + if(constraintsSet) { + + /* Update y and check constraints. */ + IDANewy(IDA_mem); + conOK = N_VConstrMask(constraints, ynew, mc); + + if(!conOK) { + /* Not satisfied. Compute scaled step to satisfy constraints. */ + N_VProd(mc, delta, dtemp); + ratio = PT99*N_VMinQuotient(yy0, dtemp); + (*delnorm) *= ratio; + if((*delnorm) <= steptol) return(IC_CONSTR_FAILED); + N_VScale(ratio, delta, delta); + } + + } /* End of constraints check */ + + slpi = -TWO*f1norm*ratio; + minlam = steptol/(*delnorm); + lambda = ONE; + + /* In IDA_Y_INIT case, set ypnew = yp0 (fixed) for linesearch. */ + if(icopt == IDA_Y_INIT) N_VScale(ONE, yp0, ypnew); + + /* Loop on linesearch variable lambda. */ + + loop { + + /* Get new (y,y') = (ynew,ypnew) and norm of new function value. */ + IDANewyyp(IDA_mem, lambda); + retval = IDAfnorm(IDA_mem, &fnormp); + if(retval != IDA_SUCCESS) return(retval); + + /* If lsoff option is on, break out. */ + if(lsoff) break; + + /* Do alpha-condition test. */ + f1normp = fnormp*fnormp*HALF; + if(f1normp <= f1norm + ALPHALS*slpi*lambda) break; + if(lambda < minlam) return(IC_LINESRCH_FAILED); + lambda /= TWO; + nbacktr++; + + } /* End of breakout linesearch loop */ + + /* Update yy0, yp0, and fnorm, then return. */ + N_VScale(ONE, ynew, yy0); + if(icopt == IDA_YA_YDP_INIT) N_VScale(ONE, ypnew, yp0); + *fnorm = fnormp; + return(IDA_SUCCESS); + +} + +/* + * ----------------------------------------------------------------- + * IDAfnorm + * ----------------------------------------------------------------- + * IDAfnorm computes the norm of the current function value, by + * evaluating the DAE residual function, calling the linear + * system solver, and computing a WRMS-norm. + * + * On return, savres contains the current residual vector F, and + * delnew contains J-inverse F. + * + * The return value is IDA_SUCCESS = 0 if no error occurred, or + * IC_FAIL_RECOV if res or lsolve failed recoverably, or + * IDA_RES_FAIL if res had a non-recoverable error, or + * IDA_LSOLVE_FAIL if lsolve had a non-recoverable error. + * ----------------------------------------------------------------- + */ + +static int IDAfnorm(IDAMem IDA_mem, realtype *fnorm) +{ + + int retval; + + /* Get residual vector F, return if failed, and save F in savres. */ + retval = res(t0, ynew, ypnew, delnew, user_data); + nre++; + if(retval < 0) return(IDA_RES_FAIL); + if(retval > 0) return(IC_FAIL_RECOV); + + N_VScale(ONE, delnew, savres); + + /* Call the linear solve function to get J-inverse F; return if failed. */ + retval = lsolve(IDA_mem, delnew, ewt, ynew, ypnew, savres); + if(retval < 0) return(IDA_LSOLVE_FAIL); + if(retval > 0) return(IC_FAIL_RECOV); + + /* Compute the WRMS-norm; rescale if index = 0. */ + *fnorm = IDAWrmsNorm(IDA_mem, delnew, ewt, FALSE); + if(sysindex == 0) (*fnorm) *= tscale*ABS(cj); + + return(IDA_SUCCESS); + +} + +/* + * ----------------------------------------------------------------- + * IDANewyyp + * ----------------------------------------------------------------- + * IDANewyyp updates the vectors ynew and ypnew from yy0 and yp0, + * using the current step vector lambda*delta, in a manner + * depending on icopt and the input id vector. + * + * The return value is always IDA_SUCCESS = 0. + * ----------------------------------------------------------------- + */ + +static int IDANewyyp(IDAMem IDA_mem, realtype lambda) +{ + + /* IDA_YA_YDP_INIT case: ynew = yy0 - lambda*delta where id_i = 0 + ypnew = yp0 - cj*lambda*delta where id_i = 1. */ + if(icopt == IDA_YA_YDP_INIT) { + N_VProd(id, delta, dtemp); + N_VLinearSum(ONE, yp0, -cj*lambda, dtemp, ypnew); + N_VLinearSum(ONE, delta, -ONE, dtemp, dtemp); + N_VLinearSum(ONE, yy0, -lambda, dtemp, ynew); + return(IDA_SUCCESS); + } + + /* IDA_Y_INIT case: ynew = yy0 - lambda*delta. (ypnew = yp0 preset.) */ + N_VLinearSum(ONE, yy0, -lambda, delta, ynew); + return(IDA_SUCCESS); + +} + +/* + * ----------------------------------------------------------------- + * IDANewy + * ----------------------------------------------------------------- + * IDANewy updates the vector ynew from yy0, + * using the current step vector delta, in a manner + * depending on icopt and the input id vector. + * + * The return value is always IDA_SUCCESS = 0. + * ----------------------------------------------------------------- + */ + +static int IDANewy(IDAMem IDA_mem) +{ + + /* IDA_YA_YDP_INIT case: ynew = yy0 - delta where id_i = 0. */ + if(icopt == IDA_YA_YDP_INIT) { + N_VProd(id, delta, dtemp); + N_VLinearSum(ONE, delta, -ONE, dtemp, dtemp); + N_VLinearSum(ONE, yy0, -ONE, dtemp, ynew); + return(IDA_SUCCESS); + } + + /* IDA_Y_INIT case: ynew = yy0 - delta. */ + N_VLinearSum(ONE, yy0, -ONE, delta, ynew); + return(IDA_SUCCESS); + +} + +/* + * ----------------------------------------------------------------- + * IDAICFailFlag + * ----------------------------------------------------------------- + * IDAICFailFlag prints a message and sets the IDACalcIC return + * value appropriate to the flag retval returned by IDAnlsIC. + * ----------------------------------------------------------------- + */ + +static int IDAICFailFlag(IDAMem IDA_mem, int retval) +{ + + /* Depending on retval, print error message and return error flag. */ + switch(retval) { + + case IDA_RES_FAIL: + IDAProcessError(IDA_mem, IDA_RES_FAIL, "IDA", "IDACalcIC", MSG_IC_RES_NONREC); + return(IDA_RES_FAIL); + + case IDA_FIRST_RES_FAIL: + IDAProcessError(IDA_mem, IDA_FIRST_RES_FAIL, "IDA", "IDACalcIC", MSG_IC_RES_FAIL); + return(IDA_FIRST_RES_FAIL); + + case IDA_LSETUP_FAIL: + IDAProcessError(IDA_mem, IDA_LSETUP_FAIL, "IDA", "IDACalcIC", MSG_IC_SETUP_FAIL); + return(IDA_LSETUP_FAIL); + + case IDA_LSOLVE_FAIL: + IDAProcessError(IDA_mem, IDA_LSOLVE_FAIL, "IDA", "IDACalcIC", MSG_IC_SOLVE_FAIL); + return(IDA_LSOLVE_FAIL); + + case IC_FAIL_RECOV: + IDAProcessError(IDA_mem, IDA_NO_RECOVERY, "IDA", "IDACalcIC", MSG_IC_NO_RECOVERY); + return(IDA_NO_RECOVERY); + + case IC_CONSTR_FAILED: + IDAProcessError(IDA_mem, IDA_CONSTR_FAIL, "IDA", "IDACalcIC", MSG_IC_FAIL_CONSTR); + return(IDA_CONSTR_FAIL); + + case IC_LINESRCH_FAILED: + IDAProcessError(IDA_mem, IDA_LINESEARCH_FAIL, "IDA", "IDACalcIC", MSG_IC_FAILED_LINS); + return(IDA_LINESEARCH_FAIL); + + case IC_CONV_FAIL: + IDAProcessError(IDA_mem, IDA_CONV_FAIL, "IDA", "IDACalcIC", MSG_IC_CONV_FAILED); + return(IDA_CONV_FAIL); + + case IC_SLOW_CONVRG: + IDAProcessError(IDA_mem, IDA_CONV_FAIL, "IDA", "IDACalcIC", MSG_IC_CONV_FAILED); + return(IDA_CONV_FAIL); + + case IDA_BAD_EWT: + IDAProcessError(IDA_mem, IDA_BAD_EWT, "IDA", "IDACalcIC", MSG_IC_BAD_EWT); + return(IDA_BAD_EWT); + + } + return -99; +} + diff --git a/odemex/Parser/CVode/ida_src/src/ida/ida_impl.h b/odemex/Parser/CVode/ida_src/src/ida/ida_impl.h new file mode 100644 index 0000000..497e52b --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/ida_impl.h @@ -0,0 +1,483 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.14 $ + * $Date: 2008/10/15 22:04:21 $ + * ----------------------------------------------------------------- + * Programmer(s): Allan G. Taylor, Alan C. Hindmarsh, Radu Serban, + * and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the header file (private version) for the main IDA solver. + * ----------------------------------------------------------------- + */ + +#ifndef _IDA_IMPL_H +#define _IDA_IMPL_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include + +#include + +/* + * ================================================================= + * M A I N I N T E G R A T O R M E M O R Y B L O C K + * ================================================================= + */ + + +/* Basic IDA constants */ + +#define HMAX_INV_DEFAULT RCONST(0.0) /* hmax_inv default value */ +#define MAXORD_DEFAULT 5 /* maxord default value */ +#define MXORDP1 6 /* max. number of N_Vectors in phi */ +#define MXSTEP_DEFAULT 500 /* mxstep default value */ + +/* + * ---------------------------------------------------------------- + * Types : struct IDAMemRec, IDAMem + * ---------------------------------------------------------------- + * The type IDAMem is type pointer to struct IDAMemRec. This + * structure contains fields to keep track of problem state. + * ---------------------------------------------------------------- + */ + +typedef struct IDAMemRec { + + realtype ida_uround; /* machine unit roundoff */ + + /* Problem Specification Data */ + + IDAResFn ida_res; /* F(t,y(t),y'(t))=0; the function F */ + void *ida_user_data; /* user pointer passed to res */ + + int ida_itol; /* itol = IDA_SS, IDA_SV, IDA_WF, IDA_NN */ + realtype ida_rtol; /* relative tolerance */ + realtype ida_Satol; /* scalar absolute tolerance */ + N_Vector ida_Vatol; /* vector absolute tolerance */ + booleantype ida_user_efun; /* TRUE if user provides efun */ + IDAEwtFn ida_efun; /* function to set ewt */ + void *ida_edata; /* user pointer passed to efun */ + double tMax; /* Maximum integration time, Added by Joep Vanlier */ + + booleantype ida_setupNonNull; /* Does setup do something? */ + booleantype ida_constraintsSet; /* constraints vector present: + do constraints calc */ + booleantype ida_suppressalg; /* true means suppress algebraic vars + in local error tests */ + + /* Divided differences array and associated minor arrays */ + + N_Vector ida_phi[MXORDP1]; /* phi = (maxord+1) arrays of divided differences */ + + realtype ida_psi[MXORDP1]; /* differences in t (sums of recent step sizes) */ + realtype ida_alpha[MXORDP1]; /* ratios of current stepsize to psi values */ + realtype ida_beta[MXORDP1]; /* ratios of current to previous product of psi's */ + realtype ida_sigma[MXORDP1]; /* product successive alpha values and factorial */ + realtype ida_gamma[MXORDP1]; /* sum of reciprocals of psi values */ + + /* N_Vectors */ + + N_Vector ida_ewt; /* error weight vector */ + N_Vector ida_yy; /* work space for y vector (= user's yret) */ + N_Vector ida_yp; /* work space for y' vector (= user's ypret) */ + N_Vector ida_delta; /* residual vector */ + N_Vector ida_id; /* bit vector for diff./algebraic components */ + N_Vector ida_constraints; /* vector of inequality constraint options */ + N_Vector ida_savres; /* saved residual vector (= tempv1) */ + N_Vector ida_ee; /* accumulated corrections to y vector, but + set equal to estimated local errors upon + successful return */ + N_Vector ida_mm; /* mask vector in constraints tests (= tempv2) */ + N_Vector ida_tempv1; /* work space vector */ + N_Vector ida_tempv2; /* work space vector */ + N_Vector ida_ynew; /* work vector for y in IDACalcIC (= tempv2) */ + N_Vector ida_ypnew; /* work vector for yp in IDACalcIC (= ee) */ + N_Vector ida_delnew; /* work vector for delta in IDACalcIC (= phi[2]) */ + N_Vector ida_dtemp; /* work vector in IDACalcIC (= phi[3]) */ + + /* Variables for use by IDACalcIC*/ + + realtype ida_t0; /* initial t */ + N_Vector ida_yy0; /* initial y vector (user-supplied). */ + N_Vector ida_yp0; /* initial y' vector (user-supplied). */ + + int ida_icopt; /* IC calculation user option */ + booleantype ida_lsoff; /* IC calculation linesearch turnoff option */ + int ida_maxnh; /* max. number of h tries in IC calculation */ + int ida_maxnj; /* max. number of J tries in IC calculation */ + int ida_maxnit; /* max. number of Netwon iterations in IC calc. */ + int ida_nbacktr; /* number of IC linesearch backtrack operations */ + int ida_sysindex; /* computed system index (0 or 1) */ + realtype ida_epiccon; /* IC nonlinear convergence test constant */ + realtype ida_steptol; /* minimum Newton step size in IC calculation */ + realtype ida_tscale; /* time scale factor = abs(tout1 - t0) */ + + /* Tstop information */ + + booleantype ida_tstopset; + realtype ida_tstop; + + /* Step Data */ + + int ida_kk; /* current BDF method order */ + int ida_kused; /* method order used on last successful step */ + int ida_knew; /* order for next step from order decrease decision */ + int ida_phase; /* flag to trigger step doubling in first few steps */ + int ida_ns; /* counts steps at fixed stepsize and order */ + + realtype ida_hin; /* initial step */ + realtype ida_h0u; /* actual initial stepsize */ + realtype ida_hh; /* current step size h */ + realtype ida_hused; /* step size used on last successful step */ + realtype ida_rr; /* rr = hnext / hused */ + realtype ida_tn; /* current internal value of t */ + realtype ida_tretlast; /* value of tret previously returned by IDASolve */ + realtype ida_cj; /* current value of scalar (-alphas/hh) in Jacobian */ + realtype ida_cjlast; /* cj value saved from last successful step */ + realtype ida_cjold; /* cj value saved from last call to lsetup */ + realtype ida_cjratio; /* ratio of cj values: cj/cjold */ + realtype ida_ss; /* scalar used in Newton iteration convergence test */ + realtype ida_epsNewt; /* test constant in Newton convergence test */ + realtype ida_epcon; /* coeficient of the Newton covergence test */ + realtype ida_toldel; /* tolerance in direct test on Newton corrections */ + + /* Limits */ + + int ida_maxncf; /* max numer of convergence failures */ + int ida_maxcor; /* max number of Newton corrections */ + int ida_maxnef; /* max number of error test failures */ + + int ida_maxord; /* max value of method order k: */ + int ida_maxord_alloc; /* value of maxord used when allocating memory */ + long int ida_mxstep; /* max number of internal steps for one user call */ + realtype ida_hmax_inv; /* inverse of max. step size hmax (default = 0.0) */ + + /* Counters */ + + long int ida_nst; /* number of internal steps taken */ + long int ida_nre; /* number of function (res) calls */ + long int ida_ncfn; /* number of corrector convergence failures */ + long int ida_netf; /* number of error test failures */ + long int ida_nni; /* number of Newton iterations performed */ + long int ida_nsetups; /* number of lsetup calls */ + + /* Space requirements for IDA */ + + long int ida_lrw1; /* no. of realtype words in 1 N_Vector */ + long int ida_liw1; /* no. of integer words in 1 N_Vector */ + long int ida_lrw; /* number of realtype words in IDA work vectors */ + long int ida_liw; /* no. of integer words in IDA work vectors */ + + realtype ida_tolsf; /* tolerance scale factor (saved value) */ + + /* Error handler function and error ouput file */ + + IDAErrHandlerFn ida_ehfun; /* Error messages are handled by ehfun */ + void *ida_eh_data; /* dats pointer passed to ehfun */ + FILE *ida_errfp; /* IDA error messages are sent to errfp */ + + /* Flags to verify correct calling sequence */ + + booleantype ida_SetupDone; /* set to FALSE by IDAMalloc and IDAReInit + set to TRUE by IDACalcIC or IDASolve */ + + booleantype ida_VatolMallocDone; + booleantype ida_constraintsMallocDone; + booleantype ida_idMallocDone; + + booleantype ida_MallocDone; /* set to FALSE by IDACreate + set to TRUE by IDAMAlloc + tested by IDAReInit and IDASolve */ + + /* Linear Solver Data */ + + /* Linear Solver functions to be called */ + + int (*ida_linit)(struct IDAMemRec *idamem); + + int (*ida_lsetup)(struct IDAMemRec *idamem, N_Vector yyp, + N_Vector ypp, N_Vector resp, + N_Vector tempv1, N_Vector tempv2, N_Vector tempv3); + + int (*ida_lsolve)(struct IDAMemRec *idamem, N_Vector b, N_Vector weight, + N_Vector ycur, N_Vector ypcur, N_Vector rescur); + + int (*ida_lperf)(struct IDAMemRec *idamem, int perftask); + + int (*ida_lfree)(struct IDAMemRec *idamem); + + /* Linear Solver specific memory */ + + void *ida_lmem; + + /* Flag to indicate successful ida_linit call */ + + booleantype ida_linitOK; + + /* Rootfinding Data */ + + IDARootFn ida_gfun; /* Function g for roots sought */ + int ida_nrtfn; /* number of components of g */ + int *ida_iroots; /* array for root information */ + int *ida_rootdir; /* array specifying direction of zero-crossing */ + realtype ida_tlo; /* nearest endpoint of interval in root search */ + realtype ida_thi; /* farthest endpoint of interval in root search */ + realtype ida_trout; /* t return value from rootfinder routine */ + realtype *ida_glo; /* saved array of g values at t = tlo */ + realtype *ida_ghi; /* saved array of g values at t = thi */ + realtype *ida_grout; /* array of g values at t = trout */ + realtype ida_toutc; /* copy of tout (if NORMAL mode) */ + realtype ida_ttol; /* tolerance on root location */ + int ida_taskc; /* copy of parameter itask */ + int ida_irfnd; /* flag showing whether last step had a root */ + long int ida_nge; /* counter for g evaluations */ + booleantype *ida_gactive; /* array with active/inactive event functions */ + int ida_mxgnull; /* number of warning messages about possible g==0 */ + + +} *IDAMem; + +/* + * ================================================================= + * I N T E R F A C E T O L I N E A R S O L V E R S + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * int (*ida_linit)(IDAMem IDA_mem); + * ----------------------------------------------------------------- + * The purpose of ida_linit is to allocate memory for the + * solver-specific fields in the structure *(idamem->ida_lmem) and + * perform any needed initializations of solver-specific memory, + * such as counters/statistics. An (*ida_linit) should return + * 0 if it has successfully initialized the IDA linear solver and + * a non-zero value otherwise. If an error does occur, an appropriate + * message should be sent to the error handler function. + * ---------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * int (*ida_lsetup)(IDAMem IDA_mem, N_Vector yyp, N_Vector ypp, + * N_Vector resp, + * N_Vector tempv1, N_Vector tempv2, N_Vector tempv3); + * ----------------------------------------------------------------- + * The job of ida_lsetup is to prepare the linear solver for + * subsequent calls to ida_lsolve. Its parameters are as follows: + * + * idamem - problem memory pointer of type IDAMem. See the big + * typedef earlier in this file. + * + * + * yyp - the predicted y vector for the current IDA internal + * step. + * + * ypp - the predicted y' vector for the current IDA internal + * step. + * + * resp - F(tn, yyp, ypp). + * + * tempv1, tempv2, tempv3 - temporary N_Vectors provided for use + * by ida_lsetup. + * + * The ida_lsetup routine should return 0 if successful, + * a positive value for a recoverable error, and a negative value + * for an unrecoverable error. + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * int (*ida_lsolve)(IDAMem IDA_mem, N_Vector b, N_Vector weight, + * N_Vector ycur, N_Vector ypcur, N_Vector rescur); + * ----------------------------------------------------------------- + * ida_lsolve must solve the linear equation P x = b, where + * P is some approximation to the system Jacobian + * J = (dF/dy) + cj (dF/dy') + * evaluated at (tn,ycur,ypcur) and the RHS vector b is input. + * The N-vector ycur contains the solver's current approximation + * to y(tn), ypcur contains that for y'(tn), and the vector rescur + * contains the N-vector residual F(tn,ycur,ypcur). + * The solution is to be returned in the vector b. + * + * The ida_lsolve routine should return 0 if successful, + * a positive value for a recoverable error, and a negative value + * for an unrecoverable error. + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * int (*ida_lperf)(IDAMem IDA_mem, int perftask); + * ----------------------------------------------------------------- + * ida_lperf is called two places in IDA where linear solver + * performance data is required by IDA. For perftask = 0, an + * initialization of performance variables is performed, while for + * perftask = 1, the performance is evaluated. + * ----------------------------------------------------------------- + */ + +/* + * ----------------------------------------------------------------- + * int (*ida_lfree)(IDAMem IDA_mem); + * ----------------------------------------------------------------- + * ida_lfree should free up any memory allocated by the linear + * solver. This routine is called once a problem has been + * completed and the linear solver is no longer needed. + * ----------------------------------------------------------------- + */ + +/* + * ================================================================= + * I D A I N T E R N A L F U N C T I O N S + * ================================================================= + */ + +/* Prototype of internal ewtSet function */ + +int IDAEwtSet(N_Vector ycur, N_Vector weight, void *data); + +/* High level error handler */ + +void IDAProcessError(IDAMem IDA_mem, + int error_code, const char *module, const char *fname, + const char *msgfmt, ...); + +/* Prototype of internal errHandler function */ + +void IDAErrHandler(int error_code, const char *module, const char *function, + char *msg, void *data); + +/* + * ================================================================= + * I D A E R R O R M E S S A G E S + * ================================================================= + */ + +#if defined(SUNDIALS_EXTENDED_PRECISION) + +#define MSG_TIME "t = %Lg, " +#define MSG_TIME_H "t = %Lg and h = %Lg, " +#define MSG_TIME_INT "t = %Lg is not between tcur - hu = %Lg and tcur = %Lg." +#define MSG_TIME_TOUT "tout = %Lg" +#define MSG_TIME_TSTOP "tstop = %Lg" + +#elif defined(SUNDIALS_DOUBLE_PRECISION) + +#define MSG_TIME "t = %lg, " +#define MSG_TIME_H "t = %lg and h = %lg, " +#define MSG_TIME_INT "t = %lg is not between tcur - hu = %lg and tcur = %lg." +#define MSG_TIME_TOUT "tout = %lg" +#define MSG_TIME_TSTOP "tstop = %lg" + +#else + +#define MSG_TIME "t = %g, " +#define MSG_TIME_H "t = %g and h = %g, " +#define MSG_TIME_INT "t = %g is not between tcur - hu = %g and tcur = %g." +#define MSG_TIME_TOUT "tout = %g" +#define MSG_TIME_TSTOP "tstop = %g" + +#endif + +/* General errors */ + +#define MSG_MEM_FAIL "A memory request failed." +#define MSG_NO_MEM "ida_mem = NULL illegal." +#define MSG_NO_MALLOC "Attempt to call before IDAMalloc." +#define MSG_BAD_NVECTOR "A required vector operation is not implemented." + +/* Initialization errors */ + +#define MSG_Y0_NULL "y0 = NULL illegal." +#define MSG_YP0_NULL "yp0 = NULL illegal." +#define MSG_BAD_ITOL "Illegal value for itol. The legal values are IDA_SS, IDA_SV, and IDA_WF." +#define MSG_RES_NULL "res = NULL illegal." +#define MSG_BAD_RTOL "reltol < 0 illegal." +#define MSG_ATOL_NULL "abstol = NULL illegal." +#define MSG_BAD_ATOL "Some abstol component < 0.0 illegal." +#define MSG_ROOT_FUNC_NULL "g = NULL illegal." + +#define MSG_MISSING_ID "id = NULL but suppressalg option on." +#define MSG_NO_TOLS "No integration tolerances have been specified." +#define MSG_FAIL_EWT "The user-provide EwtSet function failed." +#define MSG_BAD_EWT "Some initial ewt component = 0.0 illegal." +#define MSG_Y0_FAIL_CONSTR "y0 fails to satisfy constraints." +#define MSG_LSOLVE_NULL "The linear solver's solve routine is NULL." +#define MSG_LINIT_FAIL "The linear solver's init routine failed." + +/* IDACalcIC error messages */ + +#define MSG_IC_BAD_ICOPT "icopt has an illegal value." +#define MSG_IC_MISSING_ID "id = NULL conflicts with icopt." +#define MSG_IC_TOO_CLOSE "tout1 too close to t0 to attempt initial condition calculation." +#define MSG_IC_BAD_ID "id has illegal values." +#define MSG_IC_BAD_EWT "Some initial ewt component = 0.0 illegal." +#define MSG_IC_RES_NONREC "The residual function failed unrecoverably. " +#define MSG_IC_RES_FAIL "The residual function failed at the first call. " +#define MSG_IC_SETUP_FAIL "The linear solver setup failed unrecoverably." +#define MSG_IC_SOLVE_FAIL "The linear solver solve failed unrecoverably." +#define MSG_IC_NO_RECOVERY "The residual routine or the linear setup or solve routine had a recoverable error, but IDACalcIC was unable to recover." +#define MSG_IC_FAIL_CONSTR "Unable to satisfy the inequality constraints." +#define MSG_IC_FAILED_LINS "The linesearch algorithm failed with too small a step." +#define MSG_IC_CONV_FAILED "Newton/Linesearch algorithm failed to converge." + +/* IDASolve error messages */ + +#define MSG_YRET_NULL "yret = NULL illegal." +#define MSG_YPRET_NULL "ypret = NULL illegal." +#define MSG_TRET_NULL "tret = NULL illegal." +#define MSG_BAD_ITASK "itask has an illegal value." +#define MSG_TOO_CLOSE "tout too close to t0 to start integration." +#define MSG_BAD_HINIT "Initial step is not towards tout." +#define MSG_BAD_TSTOP "The value " MSG_TIME_TSTOP " is behind current " MSG_TIME "in the direction of integration." +#define MSG_CLOSE_ROOTS "Root found at and very near " MSG_TIME "." +#define MSG_MAX_STEPS "At " MSG_TIME ", mxstep steps taken before reaching tout." +#define MSG_EWT_NOW_FAIL "At " MSG_TIME "the user-provide EwtSet function failed." +#define MSG_EWT_NOW_BAD "At " MSG_TIME "some ewt component has become <= 0.0." +#define MSG_TOO_MUCH_ACC "At " MSG_TIME "too much accuracy requested." + +#define MSG_BAD_T "Illegal value for t." MSG_TIME_INT +#define MSG_BAD_TOUT "Trouble interpolating at " MSG_TIME_TOUT ". tout too far back in direction of integration." + +#define MSG_ERR_FAILS "At " MSG_TIME_H "the error test failed repeatedly or with |h| = hmin." +#define MSG_CONV_FAILS "At " MSG_TIME_H "the corrector convergence failed repeatedly or with |h| = hmin." +#define MSG_SETUP_FAILED "At " MSG_TIME "the linear solver setup failed unrecoverably." +#define MSG_SOLVE_FAILED "At " MSG_TIME "the linear solver solve failed unrecoverably." +#define MSG_REP_RES_ERR "At " MSG_TIME "repeated recoverable residual errors." +#define MSG_RES_NONRECOV "At " MSG_TIME "the residual function failed unrecoverably." +#define MSG_FAILED_CONSTR "At " MSG_TIME "unable to satisfy inequality constraints." +#define MSG_RTFUNC_FAILED "At " MSG_TIME ", the rootfinding routine failed in an unrecoverable manner." +#define MSG_NO_ROOT "Rootfinding was not initialized." +#define MSG_INACTIVE_ROOTS "At the end of the first step, there are still some root functions identically 0. This warning will not be issued again." + + +/* IDASet* / IDAGet* error messages */ + +#define MSG_NEG_MAXORD "maxord <= 0 illegal." +#define MSG_BAD_MAXORD "Illegal attempt to increase maximum order." +#define MSG_NEG_HMAX "hmax < 0 illegal." +#define MSG_NEG_EPCON "epcon <= 0.0 illegal." +#define MSG_BAD_CONSTR "Illegal values in constraints vector." +#define MSG_BAD_EPICCON "epiccon <= 0.0 illegal." +#define MSG_BAD_MAXNH "maxnh <= 0 illegal." +#define MSG_BAD_MAXNJ "maxnj <= 0 illegal." +#define MSG_BAD_MAXNIT "maxnit <= 0 illegal." +#define MSG_BAD_STEPTOL "steptol <= 0.0 illegal." + +#define MSG_TOO_LATE "IDAGetConsistentIC can only be called before IDASolve." + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/src/ida/ida_io.c b/odemex/Parser/CVode/ida_src/src/ida/ida_io.c new file mode 100644 index 0000000..74a6455 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/ida_io.c @@ -0,0 +1,1152 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.14 $ + * $Date: 2009/02/10 04:15:36 $ + * ----------------------------------------------------------------- + * Programmer(s): Alan Hindmarsh, Radu Serban and + * Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California + * Produced at the Lawrence Livermore National Laboratory + * All rights reserved + * For details, see the LICENSE file + * ----------------------------------------------------------------- + * This is the implementation file for the optional inputs and + * outputs for the IDA solver. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "ida_impl.h" + +#include + +#define ZERO RCONST(0.0) +#define HALF RCONST(0.5) +#define ONE RCONST(1.0) +#define TWOPT5 RCONST(2.5) + +/* + * ================================================================= + * IDA optional input functions + * ================================================================= + */ + +/* + * Readability constants + */ + +#define lrw (IDA_mem->ida_lrw) +#define liw (IDA_mem->ida_liw) +#define lrw1 (IDA_mem->ida_lrw1) +#define liw1 (IDA_mem->ida_liw1) + +int IDASetErrHandlerFn(void *ida_mem, IDAErrHandlerFn ehfun, void *eh_data) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetErrHandlerFn", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + IDA_mem->ida_ehfun = ehfun; + IDA_mem->ida_eh_data = eh_data; + + return(IDA_SUCCESS); +} + + +int IDASetErrFile(void *ida_mem, FILE *errfp) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetErrFile", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + IDA_mem->ida_errfp = errfp; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDASetUserData(void *ida_mem, void *user_data) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetUserData", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + IDA_mem->ida_user_data = user_data; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDASetMaxOrd(void *ida_mem, int maxord) +{ + IDAMem IDA_mem; + int maxord_alloc; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetMaxOrd", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + if (maxord <= 0) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetMaxOrd", MSG_NEG_MAXORD); + return(IDA_ILL_INPUT); + } + + /* Cannot increase maximum order beyond the value that + was used when allocating memory */ + maxord_alloc = IDA_mem->ida_maxord_alloc; + + if (maxord > maxord_alloc) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetMaxOrd", MSG_BAD_MAXORD); + return(IDA_ILL_INPUT); + } + + IDA_mem->ida_maxord = MIN(maxord,MAXORD_DEFAULT); + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDASetMaxNumSteps(void *ida_mem, long int mxsteps) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetMaxNumSteps", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + /* Passing mxsteps=0 sets the default. Passing mxsteps<0 disables the test. */ + + if (mxsteps == 0) + IDA_mem->ida_mxstep = MXSTEP_DEFAULT; + else + IDA_mem->ida_mxstep = mxsteps; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDASetInitStep(void *ida_mem, realtype hin) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetInitStep", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + IDA_mem->ida_hin = hin; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDASetMaxStep(void *ida_mem, realtype hmax) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetMaxStep", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + if (hmax < 0) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetMaxStep", MSG_NEG_HMAX); + return(IDA_ILL_INPUT); + } + + /* Passing 0 sets hmax = infinity */ + if (hmax == ZERO) { + IDA_mem->ida_hmax_inv = HMAX_INV_DEFAULT; + return(IDA_SUCCESS); + } + + IDA_mem->ida_hmax_inv = ONE/hmax; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDASetStopTime(void *ida_mem, realtype tstop) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetStopTime", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + /* If IDASolve was called at least once, test if tstop is legal + * (i.e. if it was not already passed). + * If IDASetStopTime is called before the first call to IDASolve, + * tstop will be checked in IDASolve. */ + if (IDA_mem->ida_nst > 0) { + + if ( (tstop - IDA_mem->ida_tn) * IDA_mem->ida_hh < ZERO ) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetStopTime", MSG_BAD_TSTOP, IDA_mem->ida_tn); + return(IDA_ILL_INPUT); + } + + } + + IDA_mem->ida_tstop = tstop; + IDA_mem->ida_tstopset = TRUE; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDASetNonlinConvCoef(void *ida_mem, realtype epcon) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetNonlinConvCoef", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + if (epcon <= ZERO) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetNonlinConvCoef", MSG_NEG_EPCON); + return(IDA_ILL_INPUT); + } + + IDA_mem->ida_epcon = epcon; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDASetMaxErrTestFails(void *ida_mem, int maxnef) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetMaxErrTestFails", MSG_NO_MEM); + return (IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + IDA_mem->ida_maxnef = maxnef; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDASetMaxConvFails(void *ida_mem, int maxncf) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetMaxConvFails", MSG_NO_MEM); + return (IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + IDA_mem->ida_maxncf = maxncf; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDASetMaxNonlinIters(void *ida_mem, int maxcor) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetMaxNonlinIters", MSG_NO_MEM); + return (IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + IDA_mem->ida_maxcor = maxcor; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDASetSuppressAlg(void *ida_mem, booleantype suppressalg) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetSuppressAlg", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + IDA_mem->ida_suppressalg = suppressalg; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDASetId(void *ida_mem, N_Vector id) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetId", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + if (id == NULL) { + if (IDA_mem->ida_idMallocDone) { + N_VDestroy(IDA_mem->ida_id); + lrw -= lrw1; + liw -= liw1; + } + IDA_mem->ida_idMallocDone = FALSE; + return(IDA_SUCCESS); + } + + if ( !(IDA_mem->ida_idMallocDone) ) { + IDA_mem->ida_id = N_VClone(id); + lrw += lrw1; + liw += liw1; + IDA_mem->ida_idMallocDone = TRUE; + } + + /* Load the id vector */ + + N_VScale(ONE, id, IDA_mem->ida_id); + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDASetConstraints(void *ida_mem, N_Vector constraints) +{ + IDAMem IDA_mem; + realtype temptest; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetConstraints", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + if (constraints == NULL) { + if (IDA_mem->ida_constraintsMallocDone) { + N_VDestroy(IDA_mem->ida_constraints); + lrw -= lrw1; + liw -= liw1; + } + IDA_mem->ida_constraintsMallocDone = FALSE; + IDA_mem->ida_constraintsSet = FALSE; + return(IDA_SUCCESS); + } + + /* Test if required vector ops. are defined */ + + if (constraints->ops->nvdiv == NULL || + constraints->ops->nvmaxnorm == NULL || + constraints->ops->nvcompare == NULL || + constraints->ops->nvconstrmask == NULL || + constraints->ops->nvminquotient == NULL) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetConstraints", MSG_BAD_NVECTOR); + return(IDA_ILL_INPUT); + } + + /* Check the constraints vector */ + + temptest = N_VMaxNorm(constraints); + if((temptest > TWOPT5) || (temptest < HALF)){ + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetConstraints", MSG_BAD_CONSTR); + return(IDA_ILL_INPUT); + } + + if ( !(IDA_mem->ida_constraintsMallocDone) ) { + IDA_mem->ida_constraints = N_VClone(constraints); + lrw += lrw1; + liw += liw1; + IDA_mem->ida_constraintsMallocDone = TRUE; + } + + /* Load the constraints vector */ + + N_VScale(ONE, constraints, IDA_mem->ida_constraints); + + IDA_mem->ida_constraintsSet = TRUE; + + return(IDA_SUCCESS); +} + +/* + * IDASetRootDirection + * + * Specifies the direction of zero-crossings to be monitored. + * The default is to monitor both crossings. + */ + +int IDASetRootDirection(void *ida_mem, int *rootdir) +{ + IDAMem IDA_mem; + int i, nrt; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetRootDirection", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + nrt = IDA_mem->ida_nrtfn; + if (nrt==0) { + IDAProcessError(NULL, IDA_ILL_INPUT, "IDA", "IDASetRootDirection", MSG_NO_ROOT); + return(IDA_ILL_INPUT); + } + + for(i=0; iida_rootdir[i] = rootdir[i]; + + return(IDA_SUCCESS); +} + +/* + * IDASetNoInactiveRootWarn + * + * Disables issuing a warning if some root function appears + * to be identically zero at the beginning of the integration + */ + +int IDASetNoInactiveRootWarn(void *ida_mem) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetNoInactiveRootWarn", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + IDA_mem->ida_mxgnull = 0; + + return(IDA_SUCCESS); +} + + +/* + * ================================================================= + * IDA IC optional input functions + * ================================================================= + */ + +int IDASetNonlinConvCoefIC(void *ida_mem, realtype epiccon) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetNonlinConvCoefIC", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + if (epiccon <= ZERO) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetNonlinConvCoefIC", MSG_BAD_EPICCON); + return(IDA_ILL_INPUT); + } + + IDA_mem->ida_epiccon = epiccon; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDASetMaxNumStepsIC(void *ida_mem, int maxnh) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetMaxNumStepsIC", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + if (maxnh <= 0) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetMaxNumStepsIC", MSG_BAD_MAXNH); + return(IDA_ILL_INPUT); + } + + IDA_mem->ida_maxnh = maxnh; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDASetMaxNumJacsIC(void *ida_mem, int maxnj) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetMaxNumJacsIC", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + if (maxnj <= 0) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetMaxNumJacsIC", MSG_BAD_MAXNJ); + return(IDA_ILL_INPUT); + } + + IDA_mem->ida_maxnj = maxnj; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDASetMaxNumItersIC(void *ida_mem, int maxnit) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetMaxNumItersIC", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + if (maxnit <= 0) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetMaxNumItersIC", MSG_BAD_MAXNIT); + return(IDA_ILL_INPUT); + } + + IDA_mem->ida_maxnit = maxnit; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDASetLineSearchOffIC(void *ida_mem, booleantype lsoff) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetLineSearchOffIC", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + IDA_mem->ida_lsoff = lsoff; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDASetStepToleranceIC(void *ida_mem, realtype steptol) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetStepToleranceIC", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + if (steptol <= ZERO) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetStepToleranceIC", MSG_BAD_STEPTOL); + return(IDA_ILL_INPUT); + } + + IDA_mem->ida_steptol = steptol; + + return(IDA_SUCCESS); +} + +/* + * ================================================================= + * Readability constants + * ================================================================= + */ + +#define ewt (IDA_mem->ida_ewt) +#define kk (IDA_mem->ida_kk) +#define hh (IDA_mem->ida_hh) +#define h0u (IDA_mem->ida_h0u) +#define tn (IDA_mem->ida_tn) +#define nbacktr (IDA_mem->ida_nbacktr) +#define nst (IDA_mem->ida_nst) +#define nre (IDA_mem->ida_nre) +#define ncfn (IDA_mem->ida_ncfn) +#define netf (IDA_mem->ida_netf) +#define nni (IDA_mem->ida_nni) +#define nsetups (IDA_mem->ida_nsetups) +#define lrw (IDA_mem->ida_lrw) +#define liw (IDA_mem->ida_liw) +#define kused (IDA_mem->ida_kused) +#define hused (IDA_mem->ida_hused) +#define tolsf (IDA_mem->ida_tolsf) +#define efun (IDA_mem->ida_efun) +#define edata (IDA_mem->ida_edata) +#define nge (IDA_mem->ida_nge) +#define iroots (IDA_mem->ida_iroots) +#define ee (IDA_mem->ida_ee) + +/* + * ================================================================= + * IDA optional input functions + * ================================================================= + */ + +int IDAGetNumSteps(void *ida_mem, long int *nsteps) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetNumSteps", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *nsteps = nst; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetNumResEvals(void *ida_mem, long int *nrevals) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetNumResEvals", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *nrevals = nre; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetNumLinSolvSetups(void *ida_mem, long int *nlinsetups) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetNumLinSolvSetups", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *nlinsetups = nsetups; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetNumErrTestFails(void *ida_mem, long int *netfails) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetNumErrTestFails", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *netfails = netf; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetNumBacktrackOps(void *ida_mem, long int *nbacktracks) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetNumBacktrackOps", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *nbacktracks = nbacktr; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetConsistentIC(void *ida_mem, N_Vector yy0, N_Vector yp0) +{ + IDAMem IDA_mem; + + if (ida_mem == NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetConsistentIC", MSG_NO_MEM); + return (IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + if (IDA_mem->ida_kused != 0) { + IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAGetConsistentIC", MSG_TOO_LATE); + return(IDA_ILL_INPUT); + } + + if(yy0 != NULL) N_VScale(ONE, IDA_mem->ida_phi[0], yy0); + if(yp0 != NULL) N_VScale(ONE, IDA_mem->ida_phi[1], yp0); + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetLastOrder(void *ida_mem, int *klast) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetLastOrder", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *klast = kused; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetCurrentOrder(void *ida_mem, int *kcur) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetCurrentOrder", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *kcur = kk; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetActualInitStep(void *ida_mem, realtype *hinused) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetActualInitStep", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *hinused = h0u; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetLastStep(void *ida_mem, realtype *hlast) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetLastStep", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *hlast = hused; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetCurrentStep(void *ida_mem, realtype *hcur) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetCurrentStep", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *hcur = hh; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetCurrentTime(void *ida_mem, realtype *tcur) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetCurrentTime", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *tcur = tn; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetTolScaleFactor(void *ida_mem, realtype *tolsfact) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetTolScaleFactor", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *tolsfact = tolsf; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetErrWeights(void *ida_mem, N_Vector eweight) +{ + IDAMem IDA_mem; + + if (ida_mem == NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetErrWeights", MSG_NO_MEM); + return (IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + N_VScale(ONE, ewt, eweight); + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetEstLocalErrors(void *ida_mem, N_Vector ele) +{ + IDAMem IDA_mem; + + if (ida_mem == NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetEstLocalErrors", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + N_VScale(ONE, ee, ele); + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetWorkSpace(void *ida_mem, long int *lenrw, long int *leniw) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetWorkSpace", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *leniw = liw; + *lenrw = lrw; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetIntegratorStats(void *ida_mem, long int *nsteps, long int *nrevals, + long int *nlinsetups, long int *netfails, + int *klast, int *kcur, realtype *hinused, realtype *hlast, + realtype *hcur, realtype *tcur) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetIntegratorStats", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *nsteps = nst; + *nrevals = nre; + *nlinsetups = nsetups; + *netfails = netf; + *klast = kused; + *kcur = kk; + *hinused = h0u; + *hlast = hused; + *hcur = hh; + *tcur = tn; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetNumGEvals(void *ida_mem, long int *ngevals) +{ + IDAMem IDA_mem; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetNumGEvals", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + *ngevals = nge; + + return(IDA_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +int IDAGetRootInfo(void *ida_mem, int *rootsfound) +{ + IDAMem IDA_mem; + int i, nrt; + + if (ida_mem==NULL) { + IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetRootInfo", MSG_NO_MEM); + return(IDA_MEM_NULL); + } + + IDA_mem = (IDAMem) ida_mem; + + nrt = IDA_mem->ida_nrtfn; + + for (i=0; i +#include + +#include +#include "ida_direct_impl.h" +#include "ida_impl.h" + +#include + +/* + * ================================================================= + * FUNCTION SPECIFIC CONSTANTS + * ================================================================= + */ + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) +#define TWO RCONST(2.0) + +/* + * ================================================================= + * PROTOTYPES FOR PRIVATE FUNCTIONS + * ================================================================= + */ + +/* IDALAPACK DENSE linit, lsetup, lsolve, and lfree routines */ +static int idaLapackDenseInit(IDAMem IDA_mem); +static int idaLapackDenseSetup(IDAMem IDA_mem, + N_Vector yP, N_Vector ypP, N_Vector fctP, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); +static int idaLapackDenseSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight, + N_Vector yC, N_Vector ypC, N_Vector fctC); +static int idaLapackDenseFree(IDAMem IDA_mem); + +/* IDALAPACK BAND linit, lsetup, lsolve, and lfree routines */ +static int idaLapackBandInit(IDAMem IDA_mem); +static int idaLapackBandSetup(IDAMem IDA_mem, + N_Vector yP, N_Vector ypP, N_Vector fctP, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); +static int idaLapackBandSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight, + N_Vector yC, N_Vector ypC, N_Vector fctC); +static int idaLapackBandFree(IDAMem IDA_mem); + +/* + * ================================================================= + * READIBILITY REPLACEMENTS + * ================================================================= + */ + +#define res (IDA_mem->ida_res) +#define nst (IDA_mem->ida_nst) +#define tn (IDA_mem->ida_tn) +#define hh (IDA_mem->ida_hh) +#define cj (IDA_mem->ida_cj) +#define cjratio (IDA_mem->ida_cjratio) +#define ewt (IDA_mem->ida_ewt) +#define constraints (IDA_mem->ida_constraints) + +#define linit (IDA_mem->ida_linit) +#define lsetup (IDA_mem->ida_lsetup) +#define lsolve (IDA_mem->ida_lsolve) +#define lfree (IDA_mem->ida_lfree) +#define lperf (IDA_mem->ida_lperf) +#define lmem (IDA_mem->ida_lmem) +#define tempv (IDA_mem->ida_tempv1) +#define setupNonNull (IDA_mem->ida_setupNonNull) + +#define mtype (idadls_mem->d_type) +#define n (idadls_mem->d_n) +#define ml (idadls_mem->d_ml) +#define mu (idadls_mem->d_mu) +#define smu (idadls_mem->d_smu) +#define jacDQ (idadls_mem->d_jacDQ) +#define djac (idadls_mem->d_djac) +#define bjac (idadls_mem->d_bjac) +#define JJ (idadls_mem->d_J) +#define pivots (idadls_mem->d_pivots) +#define nje (idadls_mem->d_nje) +#define nreDQ (idadls_mem->d_nreDQ) +#define J_data (idadls_mem->d_J_data) +#define last_flag (idadls_mem->d_last_flag) + +/* + * ================================================================= + * EXPORTED FUNCTIONS FOR IMPLICIT INTEGRATION + * ================================================================= + */ + +/* + * ----------------------------------------------------------------- + * IDALapackDense + * ----------------------------------------------------------------- + * This routine initializes the memory record and sets various function + * fields specific to the linear solver module. IDALapackDense first + * calls the existing lfree routine if this is not NULL. Then it sets + * the ida_linit, ida_lsetup, ida_lsolve, ida_lfree fields in (*ida_mem) + * to be idaLapackDenseInit, idaLapackDenseSetup, idaLapackDenseSolve, + * and idaLapackDenseFree, respectively. It allocates memory for a + * structure of type IDADlsMemRec and sets the ida_lmem field in + * (*ida_mem) to the address of this structure. It sets setupNonNull + * in (*ida_mem) to TRUE, and the d_jac field to the default + * idaLapackDenseDQJac. Finally, it allocates memory for M, pivots. + * + * The return value is SUCCESS = 0, or LMEM_FAIL = -1. + * + * NOTE: The dense linear solver assumes a serial implementation + * of the NVECTOR package. Therefore, IDALapackDense will first + * test for a compatible N_Vector internal representation + * by checking that N_VGetArrayPointer and N_VSetArrayPointer + * exist. + * ----------------------------------------------------------------- + */ +int IDALapackDense(void *ida_mem, int N) +{ + IDAMem IDA_mem; + IDADlsMem idadls_mem; + + /* Return immediately if ida_mem is NULL */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDADLS_MEM_NULL, "IDALAPACK", "IDALapackDense", MSGD_IDAMEM_NULL); + return(IDADLS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + /* Test if the NVECTOR package is compatible with the LAPACK solver */ + if (tempv->ops->nvgetarraypointer == NULL || + tempv->ops->nvsetarraypointer == NULL) { + IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDALAPACK", "IDALapackDense", MSGD_BAD_NVECTOR); + return(IDADLS_ILL_INPUT); + } + + if (lfree !=NULL) lfree(IDA_mem); + + /* Set four main function fields in IDA_mem */ + linit = idaLapackDenseInit; + lsetup = idaLapackDenseSetup; + lsolve = idaLapackDenseSolve; + lperf = NULL; + lfree = idaLapackDenseFree; + + /* Get memory for IDADlsMemRec */ + idadls_mem = NULL; + idadls_mem = (IDADlsMem) malloc(sizeof(struct IDADlsMemRec)); + if (idadls_mem == NULL) { + IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDALAPACK", "IDALapackDense", MSGD_MEM_FAIL); + return(IDADLS_MEM_FAIL); + } + + /* Set matrix type */ + mtype = SUNDIALS_DENSE; + + /* Set default Jacobian routine and Jacobian data */ + jacDQ = TRUE; + djac = NULL; + J_data = NULL; + + last_flag = IDADLS_SUCCESS; + setupNonNull = TRUE; + + /* Set problem dimension */ + n = N; + + /* Allocate memory for JJ and pivot array */ + JJ = NULL; + pivots = NULL; + + JJ = NewDenseMat(N, N); + if (JJ == NULL) { + IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDALAPACK", "IDALapackDense", MSGD_MEM_FAIL); + free(idadls_mem); + return(IDADLS_MEM_FAIL); + } + pivots = NewIntArray(N); + if (pivots == NULL) { + IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDALAPACK", "IDALapackDense", MSGD_MEM_FAIL); + DestroyMat(JJ); + free(idadls_mem); + return(IDADLS_MEM_FAIL); + } + + /* Attach linear solver memory to integrator memory */ + lmem = idadls_mem; + + return(IDADLS_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * IDALapackBand + * ----------------------------------------------------------------- + * This routine initializes the memory record and sets various function + * fields specific to the band linear solver module. It first calls + * the existing lfree routine if this is not NULL. It then sets the + * ida_linit, ida_lsetup, ida_lsolve, and ida_lfree fields in (*ida_mem) + * to be idaLapackBandInit, idaLapackBandSetup, idaLapackBandSolve, + * and idaLapackBandFree, respectively. It allocates memory for a + * structure of type IDALapackBandMemRec and sets the ida_lmem field in + * (*ida_mem) to the address of this structure. It sets setupNonNull + * in (*ida_mem) to be TRUE, mu to be mupper, ml to be mlower, and + * the jacE and jacI field to NULL. + * Finally, it allocates memory for M and pivots. + * The IDALapackBand return value is IDADLS_SUCCESS = 0, + * IDADLS_MEM_FAIL = -1, or IDADLS_ILL_INPUT = -2. + * + * NOTE: The IDALAPACK linear solver assumes a serial implementation + * of the NVECTOR package. Therefore, IDALapackBand will first + * test for compatible a compatible N_Vector internal + * representation by checking that the function + * N_VGetArrayPointer exists. + * ----------------------------------------------------------------- + */ +int IDALapackBand(void *ida_mem, int N, int mupper, int mlower) +{ + IDAMem IDA_mem; + IDADlsMem idadls_mem; + + /* Return immediately if ida_mem is NULL */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDADLS_MEM_NULL, "IDALAPACK", "IDALapackBand", MSGD_IDAMEM_NULL); + return(IDADLS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + /* Test if the NVECTOR package is compatible with the BAND solver */ + if (tempv->ops->nvgetarraypointer == NULL) { + IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDALAPACK", "IDALapackBand", MSGD_BAD_NVECTOR); + return(IDADLS_ILL_INPUT); + } + + if (lfree != NULL) lfree(IDA_mem); + + /* Set four main function fields in IDA_mem */ + linit = idaLapackBandInit; + lsetup = idaLapackBandSetup; + lsolve = idaLapackBandSolve; + lperf = NULL; + lfree = idaLapackBandFree; + + /* Get memory for IDADlsMemRec */ + idadls_mem = NULL; + idadls_mem = (IDADlsMem) malloc(sizeof(struct IDADlsMemRec)); + if (idadls_mem == NULL) { + IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDALAPACK", "IDALapackBand", MSGD_MEM_FAIL); + return(IDADLS_MEM_FAIL); + } + + /* Set matrix type */ + mtype = SUNDIALS_BAND; + + /* Set default Jacobian routine and Jacobian data */ + jacDQ = TRUE; + bjac = NULL; + J_data = NULL; + + last_flag = IDADLS_SUCCESS; + setupNonNull = TRUE; + + /* Load problem dimension */ + n = N; + + /* Load half-bandwiths in idadls_mem */ + ml = mlower; + mu = mupper; + + /* Test ml and mu for legality */ + if ((ml < 0) || (mu < 0) || (ml >= N) || (mu >= N)) { + IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDALAPACK", "IDALapackBand", MSGD_BAD_SIZES); + return(IDADLS_ILL_INPUT); + } + + /* Set extended upper half-bandwith for M (required for pivoting) */ + smu = MIN(N-1, mu + ml); + + /* Allocate memory for JJ and pivot arrays */ + JJ = NULL; + pivots = NULL; + + JJ = NewBandMat(N, mu, ml, smu); + if (JJ == NULL) { + IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDALAPACK", "IDALapackBand", MSGD_MEM_FAIL); + free(idadls_mem); + return(IDADLS_MEM_FAIL); + } + pivots = NewIntArray(N); + if (pivots == NULL) { + IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDALAPACK", "IDALapackBand", MSGD_MEM_FAIL); + DestroyMat(JJ); + free(idadls_mem); + return(IDADLS_MEM_FAIL); + } + + /* Attach linear solver memory to integrator memory */ + lmem = idadls_mem; + + return(IDADLS_SUCCESS); +} + +/* + * ================================================================= + * PRIVATE FUNCTIONS FOR IMPLICIT INTEGRATION WITH DENSE JACOBIANS + * ================================================================= + */ + +/* + * idaLapackDenseInit does remaining initializations specific to the dense + * linear solver. + */ +static int idaLapackDenseInit(IDAMem IDA_mem) +{ + IDADlsMem idadls_mem; + + idadls_mem = (IDADlsMem) lmem; + + nje = 0; + nreDQ = 0; + + if (jacDQ) { + djac = idaDlsDenseDQJac; + J_data = IDA_mem; + } else { + J_data = IDA_mem->ida_user_data; + } + + last_flag = IDADLS_SUCCESS; + return(0); +} + +/* + * idaLapackDenseSetup does the setup operations for the dense linear solver. + * It calls the Jacobian function to obtain the Newton matrix M = F_y + c_j*F_y', + * updates counters, and calls the dense LU factorization routine. + */ +static int idaLapackDenseSetup(IDAMem IDA_mem, + N_Vector yP, N_Vector ypP, N_Vector fctP, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) +{ + IDADlsMem idadls_mem; + int ier, retval; + + idadls_mem = (IDADlsMem) lmem; + + /* Call Jacobian function */ + nje++; + SetToZero(JJ); + retval = djac(n, tn, cj, yP, ypP, fctP, JJ, J_data, tmp1, tmp2, tmp3); + if (retval < 0) { + IDAProcessError(IDA_mem, IDADLS_JACFUNC_UNRECVR, "IDALAPACK", "idaLapackDenseSetup", MSGD_JACFUNC_FAILED); + last_flag = IDADLS_JACFUNC_UNRECVR; + return(-1); + } else if (retval > 0) { + last_flag = IDADLS_JACFUNC_RECVR; + return(1); + } + + /* Do LU factorization of M */ + dgetrf_f77(&n, &n, JJ->data, &(JJ->ldim), pivots, &ier); + + /* Return 0 if the LU was complete; otherwise return 1 */ + last_flag = ier; + if (ier > 0) return(1); + return(0); +} + +/* + * idaLapackDenseSolve handles the solve operation for the dense linear solver + * by calling the dense backsolve routine. + */ +static int idaLapackDenseSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight, + N_Vector yC, N_Vector ypC, N_Vector fctC) +{ + IDADlsMem idadls_mem; + realtype *bd, fact; + int ier, one = 1; + + idadls_mem = (IDADlsMem) lmem; + + bd = N_VGetArrayPointer(b); + + dgetrs_f77("N", &n, &one, JJ->data, &(JJ->ldim), pivots, bd, &n, &ier, 1); + if (ier > 0) return(1); + + /* Scale the correction to account for change in cj. */ + if (cjratio != ONE) { + fact = TWO/(ONE + cjratio); + dscal_f77(&n, &fact, bd, &one); + } + + last_flag = IDADLS_SUCCESS; + return(0); +} + +/* + * idaLapackDenseFree frees memory specific to the dense linear solver. + */ +static int idaLapackDenseFree(IDAMem IDA_mem) +{ + IDADlsMem idadls_mem; + + idadls_mem = (IDADlsMem) lmem; + + DestroyMat(JJ); + DestroyArray(pivots); + free(idadls_mem); + idadls_mem = NULL; + + return(0); +} + +/* + * ================================================================= + * PRIVATE FUNCTIONS FOR IMPLICIT INTEGRATION WITH BAND JACOBIANS + * ================================================================= + */ + +/* + * idaLapackBandInit does remaining initializations specific to the band + * linear solver. + */ +static int idaLapackBandInit(IDAMem IDA_mem) +{ + IDADlsMem idadls_mem; + + idadls_mem = (IDADlsMem) lmem; + + nje = 0; + nreDQ = 0; + + if (jacDQ) { + bjac = idaDlsBandDQJac; + J_data = IDA_mem; + } else { + J_data = IDA_mem->ida_user_data; + } + + last_flag = IDADLS_SUCCESS; + return(0); +} + +/* + * idaLapackBandSetup does the setup operations for the band linear solver. + * It calls the Jacobian function to obtain the Newton matrix M = F_y + c_j*F_y', + * updates counters, and calls the band LU factorization routine. + */ +static int idaLapackBandSetup(IDAMem IDA_mem, + N_Vector yP, N_Vector ypP, N_Vector fctP, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) +{ + IDADlsMem idadls_mem; + int ier, retval; + + idadls_mem = (IDADlsMem) lmem; + + /* Call Jacobian function */ + nje++; + SetToZero(JJ); + retval = bjac(n, mu, ml, tn, cj, yP, ypP, fctP, JJ, J_data, tmp1, tmp2, tmp3); + if (retval < 0) { + IDAProcessError(IDA_mem, IDADLS_JACFUNC_UNRECVR, "IDALAPACK", "idaLapackBandSetup", MSGD_JACFUNC_FAILED); + last_flag = IDADLS_JACFUNC_UNRECVR; + return(-1); + } else if (retval > 0) { + last_flag = IDADLS_JACFUNC_RECVR; + return(+1); + } + + /* Do LU factorization of M */ + dgbtrf_f77(&n, &n, &ml, &mu, JJ->data, &(JJ->ldim), pivots, &ier); + + /* Return 0 if the LU was complete; otherwise return 1 */ + last_flag = ier; + if (ier > 0) return(1); + return(0); + +} + +/* + * idaLapackBandSolve handles the solve operation for the band linear solver + * by calling the band backsolve routine. + */ +static int idaLapackBandSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight, + N_Vector yC, N_Vector ypC, N_Vector fctC) +{ + IDADlsMem idadls_mem; + realtype *bd, fact; + int ier, one = 1; + + idadls_mem = (IDADlsMem) lmem; + + bd = N_VGetArrayPointer(b); + + dgbtrs_f77("N", &n, &ml, &mu, &one, JJ->data, &(JJ->ldim), pivots, bd, &n, &ier, 1); + if (ier > 0) return(1); + + /* For BDF, scale the correction to account for change in cj */ + if (cjratio != ONE) { + fact = TWO/(ONE + cjratio); + dscal_f77(&n, &fact, bd, &one); + } + + last_flag = IDADLS_SUCCESS; + return(0); +} + +/* + * idaLapackBandFree frees memory specific to the band linear solver. + */ +static int idaLapackBandFree(IDAMem IDA_mem) +{ + IDADlsMem idadls_mem; + + idadls_mem = (IDADlsMem) lmem; + + DestroyMat(JJ); + DestroyArray(pivots); + free(idadls_mem); + idadls_mem = NULL; + + return(0); +} + diff --git a/odemex/Parser/CVode/ida_src/src/ida/ida_spbcgs.c b/odemex/Parser/CVode/ida_src/src/ida/ida_spbcgs.c new file mode 100644 index 0000000..654afd0 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/ida_spbcgs.c @@ -0,0 +1,476 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.6 $ + * $Date: 2007/11/26 16:20:00 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2004, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for the IDA scaled preconditioned + * Bi-CGSTAB linear solver module, IDASPBCG. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include +#include "ida_spils_impl.h" +#include "ida_impl.h" + +#include +#include + +/* Constants */ + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) +#define PT9 RCONST(0.9) +#define PT05 RCONST(0.05) + +/* IDASPBCG linit, lsetup, lsolve, lperf, and lfree routines */ + +static int IDASpbcgInit(IDAMem IDA_mem); + +static int IDASpbcgSetup(IDAMem IDA_mem, + N_Vector yy_p, N_Vector yp_p, N_Vector rr_p, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); + +static int IDASpbcgSolve(IDAMem IDA_mem, N_Vector bb, N_Vector weight, + N_Vector yy_now, N_Vector yp_now, N_Vector rr_now); + +static int IDASpbcgPerf(IDAMem IDA_mem, int perftask); + +static int IDASpbcgFree(IDAMem IDA_mem); + + +/* Readability Replacements */ + +#define nst (IDA_mem->ida_nst) +#define tn (IDA_mem->ida_tn) +#define cj (IDA_mem->ida_cj) +#define epsNewt (IDA_mem->ida_epsNewt) +#define res (IDA_mem->ida_res) +#define user_data (IDA_mem->ida_user_data) +#define ewt (IDA_mem->ida_ewt) +#define errfp (IDA_mem->ida_errfp) +#define linit (IDA_mem->ida_linit) +#define lsetup (IDA_mem->ida_lsetup) +#define lsolve (IDA_mem->ida_lsolve) +#define lperf (IDA_mem->ida_lperf) +#define lfree (IDA_mem->ida_lfree) +#define lmem (IDA_mem->ida_lmem) +#define nni (IDA_mem->ida_nni) +#define ncfn (IDA_mem->ida_ncfn) +#define setupNonNull (IDA_mem->ida_setupNonNull) +#define vec_tmpl (IDA_mem->ida_tempv1) + +#define sqrtN (idaspils_mem->s_sqrtN) +#define epslin (idaspils_mem->s_epslin) +#define ytemp (idaspils_mem->s_ytemp) +#define yptemp (idaspils_mem->s_yptemp) +#define xx (idaspils_mem->s_xx) +#define ycur (idaspils_mem->s_ycur) +#define ypcur (idaspils_mem->s_ypcur) +#define rcur (idaspils_mem->s_rcur) +#define npe (idaspils_mem->s_npe) +#define nli (idaspils_mem->s_nli) +#define nps (idaspils_mem->s_nps) +#define ncfl (idaspils_mem->s_ncfl) +#define nst0 (idaspils_mem->s_nst0) +#define nni0 (idaspils_mem->s_nni0) +#define nli0 (idaspils_mem->s_nli0) +#define ncfn0 (idaspils_mem->s_ncfn0) +#define ncfl0 (idaspils_mem->s_ncfl0) +#define nwarn (idaspils_mem->s_nwarn) +#define njtimes (idaspils_mem->s_njtimes) +#define nres (idaspils_mem->s_nres) +#define spils_mem (idaspils_mem->s_spils_mem) + +#define jtimesDQ (idaspils_mem->s_jtimesDQ) +#define jtimes (idaspils_mem->s_jtimes) +#define jdata (idaspils_mem->s_jdata) + +#define last_flag (idaspils_mem->s_last_flag) + +/* + * ----------------------------------------------------------------- + * Function : IDASpbcg + * ----------------------------------------------------------------- + * This routine initializes the memory record and sets various function + * fields specific to the IDASPBCG linear solver module. + * + * IDASpbcg first calls the existing lfree routine if this is not NULL. + * It then sets the ida_linit, ida_lsetup, ida_lsolve, ida_lperf, and + * ida_lfree fields in (*IDA_mem) to be IDASpbcgInit, IDASpbcgSetup, + * IDASpbcgSolve, IDASpbcgPerf, and IDASpbcgFree, respectively. + * It allocates memory for a structure of type IDASpilsMemRec and sets + * the ida_lmem field in (*IDA_mem) to the address of this structure. + * It sets setupNonNull in (*IDA_mem). It then sets various fields + * in the IDASpilsMemRec structure. Finally, IDASpbcg allocates memory + * for ytemp, yptemp, and xx, and calls SpbcgMalloc to allocate memory + * for the Spbcg solver. + * + * The return value of IDASpbcg is: + * IDASPILS_SUCCESS = 0 if successful + * IDASPILS_MEM_FAIL = -1 if IDA_mem is NULL or a memory + * allocation failed + * IDASPILS_ILL_INPUT = -2 if a required vector operation is not + * implemented. + * ----------------------------------------------------------------- + */ + +int IDASpbcg(void *ida_mem, int maxl) +{ + IDAMem IDA_mem; + IDASpilsMem idaspils_mem; + SpbcgMem spbcg_mem; + int flag, maxl1; + + /* Return immediately if ida_mem is NULL */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPBCG", "IDASpbcg", MSGS_IDAMEM_NULL); + return(IDASPILS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + /* Check if N_VDotProd is present */ + if (vec_tmpl->ops->nvdotprod == NULL) { + IDAProcessError(NULL, IDASPILS_ILL_INPUT, "IDASPBCG", "IDASpbcg", MSGS_BAD_NVECTOR); + return(IDASPILS_ILL_INPUT); + } + + if (lfree != NULL) flag = lfree((IDAMem) ida_mem); + + /* Set five main function fields in ida_mem */ + linit = IDASpbcgInit; + lsetup = IDASpbcgSetup; + lsolve = IDASpbcgSolve; + lperf = IDASpbcgPerf; + lfree = IDASpbcgFree; + + /* Get memory for IDASpilsMemRec */ + idaspils_mem = NULL; + idaspils_mem = (IDASpilsMem) malloc(sizeof(struct IDASpilsMemRec)); + if (idaspils_mem == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcg", MSGS_MEM_FAIL); + return(IDASPILS_MEM_FAIL); + } + + /* Set ILS type */ + idaspils_mem->s_type = SPILS_SPBCG; + + /* Set SPBCG parameters that were passed in call sequence */ + maxl1 = (maxl <= 0) ? IDA_SPILS_MAXL : maxl; + idaspils_mem->s_maxl = maxl1; + + /* Set defaults for Jacobian-related fileds */ + jtimesDQ = TRUE; + jtimes = NULL; + jdata = NULL; + + /* Set defaults for preconditioner-related fields */ + idaspils_mem->s_pset = NULL; + idaspils_mem->s_psolve = NULL; + idaspils_mem->s_pfree = NULL; + idaspils_mem->s_pdata = IDA_mem->ida_user_data; + + /* Set default values for the rest of the Spbcg parameters */ + idaspils_mem->s_eplifac = PT05; + idaspils_mem->s_dqincfac = ONE; + + idaspils_mem->s_last_flag = IDASPILS_SUCCESS; + + /* Set setupNonNull to FALSE */ + setupNonNull = FALSE; + + /* Allocate memory for ytemp, yptemp, and xx */ + + ytemp = N_VClone(vec_tmpl); + if (ytemp == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcg", MSGS_MEM_FAIL); + free(idaspils_mem); idaspils_mem = NULL; + return(IDASPILS_MEM_FAIL); + } + + yptemp = N_VClone(vec_tmpl); + if (yptemp == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcg", MSGS_MEM_FAIL); + N_VDestroy(ytemp); + free(idaspils_mem); idaspils_mem = NULL; + return(IDASPILS_MEM_FAIL); + } + + xx = N_VClone(vec_tmpl); + if (xx == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcg", MSGS_MEM_FAIL); + N_VDestroy(ytemp); + N_VDestroy(yptemp); + free(idaspils_mem); idaspils_mem = NULL; + return(IDASPILS_MEM_FAIL); + } + + /* Compute sqrtN from a dot product */ + N_VConst(ONE, ytemp); + sqrtN = RSqrt(N_VDotProd(ytemp, ytemp)); + + /* Call SpbcgMalloc to allocate workspace for Spbcg */ + spbcg_mem = NULL; + spbcg_mem = SpbcgMalloc(maxl1, vec_tmpl); + if (spbcg_mem == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcg", MSGS_MEM_FAIL); + N_VDestroy(ytemp); + N_VDestroy(yptemp); + N_VDestroy(xx); + free(idaspils_mem); idaspils_mem = NULL; + return(IDASPILS_MEM_FAIL); + } + + /* Attach SPBCG memory to spils memory structure */ + spils_mem = (void *)spbcg_mem; + + /* Attach linear solver memory to the integrator memory */ + lmem = idaspils_mem; + + return(IDASPILS_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * IDASPBCG interface routines + * ----------------------------------------------------------------- + */ + +/* Additional readability Replacements */ + +#define maxl (idaspils_mem->s_maxl) +#define eplifac (idaspils_mem->s_eplifac) +#define psolve (idaspils_mem->s_psolve) +#define pset (idaspils_mem->s_pset) +#define pdata (idaspils_mem->s_pdata) + +static int IDASpbcgInit(IDAMem IDA_mem) +{ + IDASpilsMem idaspils_mem; + SpbcgMem spbcg_mem; + + idaspils_mem = (IDASpilsMem) lmem; + spbcg_mem = (SpbcgMem) spils_mem; + + /* Initialize counters */ + npe = nli = nps = ncfl = 0; + njtimes = nres = 0; + + /* Set setupNonNull to TRUE iff there is preconditioning with setup */ + setupNonNull = (psolve != NULL) && (pset != NULL); + + /* Set Jacobian-related fields, based on jtimesDQ */ + if (jtimesDQ) { + jtimes = IDASpilsDQJtimes; + jdata = IDA_mem; + } else { + jdata = user_data; + } + + /* Set maxl in the SPBCG memory in case it was changed by the user */ + spbcg_mem->l_max = maxl; + + last_flag = IDASPILS_SUCCESS; + + return(0); +} + +static int IDASpbcgSetup(IDAMem IDA_mem, + N_Vector yy_p, N_Vector yp_p, N_Vector rr_p, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) +{ + int retval; + IDASpilsMem idaspils_mem; + + idaspils_mem = (IDASpilsMem) lmem; + + /* Call user setup routine pset and update counter npe */ + retval = pset(tn, yy_p, yp_p, rr_p, cj, pdata, + tmp1, tmp2, tmp3); + npe++; + + if (retval < 0) { + IDAProcessError(IDA_mem, SPBCG_PSET_FAIL_UNREC, "IDASPBCG", "IDASpbcgSetup", MSGS_PSET_FAILED); + last_flag = SPBCG_PSET_FAIL_UNREC; + return(-1); + } + if (retval > 0) { + last_flag = SPBCG_PSET_FAIL_REC; + return(+1); + } + + last_flag = SPBCG_SUCCESS; + + return(0); +} + +/* + * ----------------------------------------------------------------- + * Function : IDASpbcgSolve + * ----------------------------------------------------------------- + * Note: The x-scaling and b-scaling arrays are both equal to weight. + * + * We set the initial guess, x = 0, then call SpbcgSolve. + * We copy the solution x into b, and update the counters nli, nps, + * and ncfl. If SpbcgSolve returned nli_inc = 0 (hence x = 0), we + * take the SPBCG vtemp vector (= P_inverse F) as the correction + * vector instead. Finally, we set the return value according to the + * success of SpbcgSolve. + * ----------------------------------------------------------------- + */ + +static int IDASpbcgSolve(IDAMem IDA_mem, N_Vector bb, N_Vector weight, + N_Vector yy_now, N_Vector yp_now, N_Vector rr_now) +{ + IDASpilsMem idaspils_mem; + SpbcgMem spbcg_mem; + int pretype, nli_inc, nps_inc, retval; + realtype res_norm; + + idaspils_mem = (IDASpilsMem) lmem; + + spbcg_mem = (SpbcgMem)spils_mem; + + /* Set SpbcgSolve convergence test constant epslin, in terms of the + Newton convergence test constant epsNewt and safety factors. The factor + sqrt(Neq) assures that the Bi-CGSTAB convergence test is applied to the + WRMS norm of the residual vector, rather than the weighted L2 norm. */ + epslin = sqrtN*eplifac*epsNewt; + + /* Set vectors ycur, ypcur, and rcur for use by the Atimes and Psolve */ + ycur = yy_now; + ypcur = yp_now; + rcur = rr_now; + + /* Set SpbcgSolve inputs pretype and initial guess xx = 0 */ + pretype = (psolve == NULL) ? PREC_NONE : PREC_LEFT; + N_VConst(ZERO, xx); + + /* Call SpbcgSolve and copy xx to bb */ + retval = SpbcgSolve(spbcg_mem, IDA_mem, xx, bb, pretype, epslin, + IDA_mem, weight, weight, IDASpilsAtimes, + IDASpilsPSolve, &res_norm, &nli_inc, &nps_inc); + + if (nli_inc == 0) N_VScale(ONE, SPBCG_VTEMP(spbcg_mem), bb); + else N_VScale(ONE, xx, bb); + + /* Increment counters nli, nps, and return if successful */ + nli += nli_inc; + nps += nps_inc; + if (retval != SPBCG_SUCCESS) ncfl++; + + /* Interpret return value from SpbcgSolve */ + + last_flag = retval; + + switch(retval) { + + case SPBCG_SUCCESS: + return(0); + break; + case SPBCG_RES_REDUCED: + return(1); + break; + case SPBCG_CONV_FAIL: + return(1); + break; + case SPBCG_PSOLVE_FAIL_REC: + return(1); + break; + case SPBCG_ATIMES_FAIL_REC: + return(1); + break; + case SPBCG_MEM_NULL: + return(-1); + break; + case SPBCG_ATIMES_FAIL_UNREC: + IDAProcessError(IDA_mem, SPBCG_ATIMES_FAIL_UNREC, "IDaSPBCG", "IDASpbcgSolve", MSGS_JTIMES_FAILED); + return(-1); + break; + case SPBCG_PSOLVE_FAIL_UNREC: + IDAProcessError(IDA_mem, SPBCG_PSOLVE_FAIL_UNREC, "IDASPBCG", "IDASpbcgSolve", MSGS_PSOLVE_FAILED); + return(-1); + break; + } + + return(0); +} + +/* + * ----------------------------------------------------------------- + * Function : IDASpbcgPerf + * ----------------------------------------------------------------- + * This routine handles performance monitoring specific to the + * IDASPBCG linear solver. When perftask = 0, it saves values of + * various counters. When perftask = 1, it examines difference + * quotients in these counters, and depending on their values, it + * prints up to three warning messages. Messages are printed up to + * a maximum of 10 times. + * ----------------------------------------------------------------- + */ + +static int IDASpbcgPerf(IDAMem IDA_mem, int perftask) +{ + IDASpilsMem idaspils_mem; + realtype avdim, rcfn, rcfl; + long int nstd, nnid; + booleantype lavd, lcfn, lcfl; + + idaspils_mem = (IDASpilsMem) lmem; + + if (perftask == 0) { + nst0 = nst; nni0 = nni; nli0 = nli; + ncfn0 = ncfn; ncfl0 = ncfl; + nwarn = 0; + return(0); + } + + nstd = nst - nst0; nnid = nni - nni0; + if (nstd == 0 || nnid == 0) return(0); + avdim = (realtype) ((nli - nli0)/((realtype) nnid)); + rcfn = (realtype) ((ncfn - ncfn0)/((realtype) nstd)); + rcfl = (realtype) ((ncfl - ncfl0)/((realtype) nnid)); + lavd = (avdim > ((realtype) maxl)); + lcfn = (rcfn > PT9); + lcfl = (rcfl > PT9); + if (!(lavd || lcfn || lcfl)) return(0); + nwarn++; + if (nwarn > 10) return(1); + if (lavd) + IDAProcessError(IDA_mem, IDA_WARNING, "IDASPBCG", "IDASpbcgPerf", MSGS_AVD_WARN, tn, avdim); + if (lcfn) + IDAProcessError(IDA_mem, IDA_WARNING, "IDASPBCG", "IDASpbcgPerf", MSGS_CFN_WARN, tn, rcfn); + if (lcfl) + IDAProcessError(IDA_mem, IDA_WARNING, "IDASPBCG", "IDASpbcgPerf", MSGS_CFL_WARN, tn, rcfl); + + return(0); +} + +static int IDASpbcgFree(IDAMem IDA_mem) +{ + IDASpilsMem idaspils_mem; + SpbcgMem spbcg_mem; + + idaspils_mem = (IDASpilsMem) lmem; + + N_VDestroy(ytemp); + N_VDestroy(xx); + + spbcg_mem = (SpbcgMem)spils_mem; + SpbcgFree(spbcg_mem); + + if (idaspils_mem->s_pfree != NULL) (idaspils_mem->s_pfree)(IDA_mem); + + free(idaspils_mem); idaspils_mem = NULL; + + return(0); +} diff --git a/odemex/Parser/CVode/ida_src/src/ida/ida_spgmr.c b/odemex/Parser/CVode/ida_src/src/ida/ida_spgmr.c new file mode 100644 index 0000000..4d47163 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/ida_spgmr.c @@ -0,0 +1,475 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.6 $ + * $Date: 2007/11/26 16:20:00 $ + * ----------------------------------------------------------------- + * Programmers: Alan C. Hindmarsh, and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California + * Produced at the Lawrence Livermore National Laboratory + * All rights reserved + * For details, see the LICENSE file + * ----------------------------------------------------------------- + * This is the implementation file for the IDA Scaled + * Preconditioned GMRES linear solver module, IDASPGMR. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include +#include "ida_spils_impl.h" +#include "ida_impl.h" + +#include +#include + +/* Constants */ + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) +#define PT9 RCONST(0.9) +#define PT05 RCONST(0.05) + +/* IDASPGMR linit, lsetup, lsolve, lperf, and lfree routines */ + +static int IDASpgmrInit(IDAMem IDA_mem); + +static int IDASpgmrSetup(IDAMem IDA_mem, + N_Vector yy_p, N_Vector yp_p, N_Vector rr_p, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); + +static int IDASpgmrSolve(IDAMem IDA_mem, N_Vector bb, N_Vector weight, + N_Vector yy_now, N_Vector yp_now, N_Vector rr_now); + +static int IDASpgmrPerf(IDAMem IDA_mem, int perftask); + +static int IDASpgmrFree(IDAMem IDA_mem); + + +/* Readability Replacements */ + +#define nst (IDA_mem->ida_nst) +#define tn (IDA_mem->ida_tn) +#define cj (IDA_mem->ida_cj) +#define epsNewt (IDA_mem->ida_epsNewt) +#define res (IDA_mem->ida_res) +#define user_data (IDA_mem->ida_user_data) +#define ewt (IDA_mem->ida_ewt) +#define errfp (IDA_mem->ida_errfp) +#define linit (IDA_mem->ida_linit) +#define lsetup (IDA_mem->ida_lsetup) +#define lsolve (IDA_mem->ida_lsolve) +#define lperf (IDA_mem->ida_lperf) +#define lfree (IDA_mem->ida_lfree) +#define lmem (IDA_mem->ida_lmem) +#define nni (IDA_mem->ida_nni) +#define ncfn (IDA_mem->ida_ncfn) +#define setupNonNull (IDA_mem->ida_setupNonNull) +#define vec_tmpl (IDA_mem->ida_tempv1) + +#define sqrtN (idaspils_mem->s_sqrtN) +#define epslin (idaspils_mem->s_epslin) +#define ytemp (idaspils_mem->s_ytemp) +#define yptemp (idaspils_mem->s_yptemp) +#define xx (idaspils_mem->s_xx) +#define ycur (idaspils_mem->s_ycur) +#define ypcur (idaspils_mem->s_ypcur) +#define rcur (idaspils_mem->s_rcur) +#define npe (idaspils_mem->s_npe) +#define nli (idaspils_mem->s_nli) +#define nps (idaspils_mem->s_nps) +#define ncfl (idaspils_mem->s_ncfl) +#define nst0 (idaspils_mem->s_nst0) +#define nni0 (idaspils_mem->s_nni0) +#define nli0 (idaspils_mem->s_nli0) +#define ncfn0 (idaspils_mem->s_ncfn0) +#define ncfl0 (idaspils_mem->s_ncfl0) +#define nwarn (idaspils_mem->s_nwarn) +#define njtimes (idaspils_mem->s_njtimes) +#define nres (idaspils_mem->s_nres) +#define spils_mem (idaspils_mem->s_spils_mem) + +#define jtimesDQ (idaspils_mem->s_jtimesDQ) +#define jtimes (idaspils_mem->s_jtimes) +#define jdata (idaspils_mem->s_jdata) + +#define last_flag (idaspils_mem->s_last_flag) + +/* + * ----------------------------------------------------------------- + * IDASpgmr + * ----------------------------------------------------------------- + * + * This routine initializes the memory record and sets various function + * fields specific to the IDASPGMR linear solver module. + * + * IDASpgmr first calls the existing lfree routine if this is not NULL. + * It then sets the ida_linit, ida_lsetup, ida_lsolve, ida_lperf, and + * ida_lfree fields in (*IDA_mem) to be IDASpgmrInit, IDASpgmrSetup, + * IDASpgmrSolve, IDASpgmrPerf, and IDASpgmrFree, respectively. + * It allocates memory for a structure of type IDASpilsMemRec and sets + * the ida_lmem field in (*IDA_mem) to the address of this structure. + * It sets setupNonNull in (*IDA_mem). It then various fields in the + * IDASpilsMemRec structure. Finally, IDASpgmr allocates memory for + * ytemp, yptemp, and xx, and calls SpgmrMalloc to allocate memory + * for the Spgmr solver. + * + * The return value of IDASpgmr is: + * IDASPILS_SUCCESS = 0 if successful + * IDASPILS_MEM_FAIL = -1 if IDA_mem is NULL or a memory allocation failed + * IDASPILS_ILL_INPUT = -2 if the gstype argument is illegal. + * + * ----------------------------------------------------------------- + */ + +int IDASpgmr(void *ida_mem, int maxl) +{ + IDAMem IDA_mem; + IDASpilsMem idaspils_mem; + SpgmrMem spgmr_mem; + int flag, maxl1; + + /* Return immediately if ida_mem is NULL */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPGMR", "IDASpgmr", MSGS_IDAMEM_NULL); + return(IDASPILS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + /* Check if N_VDotProd is present */ + if(vec_tmpl->ops->nvdotprod == NULL) { + IDAProcessError(NULL, IDASPILS_ILL_INPUT, "IDASPGMR", "IDASpgmr", MSGS_BAD_NVECTOR); + return(IDASPILS_ILL_INPUT); + } + + if (lfree != NULL) flag = lfree((IDAMem) ida_mem); + + /* Set five main function fields in ida_mem */ + linit = IDASpgmrInit; + lsetup = IDASpgmrSetup; + lsolve = IDASpgmrSolve; + lperf = IDASpgmrPerf; + lfree = IDASpgmrFree; + + /* Get memory for IDASpilsMemRec */ + idaspils_mem = NULL; + idaspils_mem = (IDASpilsMem) malloc(sizeof(struct IDASpilsMemRec)); + if (idaspils_mem == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPGMR", "IDASpgmr", MSGS_MEM_FAIL); + return(IDASPILS_MEM_FAIL); + } + + /* Set ILS type */ + idaspils_mem->s_type = SPILS_SPGMR; + + /* Set SPGMR parameters that were passed in call sequence */ + maxl1 = (maxl <= 0) ? IDA_SPILS_MAXL : maxl; + idaspils_mem->s_maxl = maxl1; + + /* Set defaults for Jacobian-related fileds */ + jtimesDQ = TRUE; + jtimes = NULL; + jdata = NULL; + + /* Set defaults for preconditioner-related fields */ + idaspils_mem->s_pset = NULL; + idaspils_mem->s_psolve = NULL; + idaspils_mem->s_pfree = NULL; + idaspils_mem->s_pdata = IDA_mem->ida_user_data; + + /* Set default values for the rest of the Spgmr parameters */ + idaspils_mem->s_gstype = MODIFIED_GS; + idaspils_mem->s_maxrs = IDA_SPILS_MAXRS; + idaspils_mem->s_eplifac = PT05; + idaspils_mem->s_dqincfac = ONE; + + idaspils_mem->s_last_flag = IDASPILS_SUCCESS; + + /* Set setupNonNull to FALSE */ + setupNonNull = FALSE; + + /* Allocate memory for ytemp, yptemp, and xx */ + + ytemp = N_VClone(vec_tmpl); + if (ytemp == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPGMR", "IDASpgmr", MSGS_MEM_FAIL); + free(idaspils_mem); idaspils_mem = NULL; + return(IDASPILS_MEM_FAIL); + } + + yptemp = N_VClone(vec_tmpl); + if (yptemp == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPGMR", "IDASpgmr", MSGS_MEM_FAIL); + N_VDestroy(ytemp); + free(idaspils_mem); idaspils_mem = NULL; + return(IDASPILS_MEM_FAIL); + } + + xx = N_VClone(vec_tmpl); + if (xx == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPGMR", "IDASpgmr", MSGS_MEM_FAIL); + N_VDestroy(ytemp); + N_VDestroy(yptemp); + free(idaspils_mem); idaspils_mem = NULL; + return(IDASPILS_MEM_FAIL); + } + + /* Compute sqrtN from a dot product */ + N_VConst(ONE, ytemp); + sqrtN = RSqrt( N_VDotProd(ytemp, ytemp) ); + + /* Call SpgmrMalloc to allocate workspace for Spgmr */ + spgmr_mem = NULL; + spgmr_mem = SpgmrMalloc(maxl1, vec_tmpl); + if (spgmr_mem == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPGMR", "IDASpgmr", MSGS_MEM_FAIL); + N_VDestroy(ytemp); + N_VDestroy(yptemp); + N_VDestroy(xx); + free(idaspils_mem); idaspils_mem = NULL; + return(IDASPILS_MEM_FAIL); + } + + /* Attach SPGMR memory to spils memory structure */ + spils_mem = (void *)spgmr_mem; + + /* Attach linear solver memory to the integrator memory */ + lmem = idaspils_mem; + + return(IDASPILS_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * IDASPGMR interface routines + * ----------------------------------------------------------------- + */ + +/* Additional readability Replacements */ + +#define gstype (idaspils_mem->s_gstype) +#define maxl (idaspils_mem->s_maxl) +#define maxrs (idaspils_mem->s_maxrs) +#define eplifac (idaspils_mem->s_eplifac) +#define psolve (idaspils_mem->s_psolve) +#define pset (idaspils_mem->s_pset) +#define pdata (idaspils_mem->s_pdata) + +static int IDASpgmrInit(IDAMem IDA_mem) +{ + IDASpilsMem idaspils_mem; + + idaspils_mem = (IDASpilsMem) lmem; + + /* Initialize counters */ + npe = nli = nps = ncfl = 0; + njtimes = nres = 0; + + /* Set setupNonNull to TRUE iff there is preconditioning with setup */ + setupNonNull = (psolve != NULL) && (pset != NULL); + + /* Set Jacobian-related fields, based on jtimesDQ */ + if (jtimesDQ) { + jtimes = IDASpilsDQJtimes; + jdata = IDA_mem; + } else { + jdata = user_data; + } + + last_flag = IDASPILS_SUCCESS; + return(0); +} + +static int IDASpgmrSetup(IDAMem IDA_mem, + N_Vector yy_p, N_Vector yp_p, N_Vector rr_p, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) +{ + int retval; + IDASpilsMem idaspils_mem; + + idaspils_mem = (IDASpilsMem) lmem; + + /* Call user setup routine pset and update counter npe. */ + retval = pset(tn, yy_p, yp_p, rr_p, cj, pdata, + tmp1, tmp2, tmp3); + npe++; + + /* Return flag showing success or failure of pset. */ + if (retval < 0) { + IDAProcessError(IDA_mem, SPGMR_PSET_FAIL_UNREC, "IDASPGMR", "IDASpgmrSetup", MSGS_PSET_FAILED); + last_flag = SPGMR_PSET_FAIL_UNREC; + return(-1); + } + if (retval > 0) { + last_flag = SPGMR_PSET_FAIL_REC; + return(+1); + } + + last_flag = SPGMR_SUCCESS; + return(0); +} + + +/* + * The x-scaling and b-scaling arrays are both equal to weight. + * + * We set the initial guess, x = 0, then call SpgmrSolve. + * We copy the solution x into b, and update the counters nli, nps, ncfl. + * If SpgmrSolve returned nli_inc = 0 (hence x = 0), we take the SPGMR + * vtemp vector (= P_inverse F) as the correction vector instead. + * Finally, we set the return value according to the success of SpgmrSolve. + */ + +static int IDASpgmrSolve(IDAMem IDA_mem, N_Vector bb, N_Vector weight, + N_Vector yy_now, N_Vector yp_now, N_Vector rr_now) +{ + IDASpilsMem idaspils_mem; + SpgmrMem spgmr_mem; + int pretype, nli_inc, nps_inc, retval; + realtype res_norm; + + idaspils_mem = (IDASpilsMem) lmem; + + spgmr_mem = (SpgmrMem) spils_mem; + + /* Set SpgmrSolve convergence test constant epslin, in terms of the + Newton convergence test constant epsNewt and safety factors. The factor + sqrt(Neq) assures that the GMRES convergence test is applied to the + WRMS norm of the residual vector, rather than the weighted L2 norm. */ + epslin = sqrtN*eplifac*epsNewt; + + /* Set vectors ycur, ypcur, and rcur for use by the Atimes and Psolve */ + ycur = yy_now; + ypcur = yp_now; + rcur = rr_now; + + /* Set SpgmrSolve inputs pretype and initial guess xx = 0. */ + pretype = (psolve == NULL) ? PREC_NONE : PREC_LEFT; + N_VConst(ZERO, xx); + + /* Call SpgmrSolve and copy xx to bb. */ + retval = SpgmrSolve(spgmr_mem, IDA_mem, xx, bb, pretype, gstype, epslin, + maxrs, IDA_mem, weight, weight, IDASpilsAtimes, + IDASpilsPSolve, &res_norm, &nli_inc, &nps_inc); + + if (nli_inc == 0) N_VScale(ONE, SPGMR_VTEMP(spgmr_mem), bb); + else N_VScale(ONE, xx, bb); + + /* Increment counters nli, nps, and return if successful. */ + nli += nli_inc; + nps += nps_inc; + if (retval != SPGMR_SUCCESS) ncfl++; + + /* Interpret return value from SpgmrSolve */ + + last_flag = retval; + + switch(retval) { + + case SPGMR_SUCCESS: + return(0); + break; + case SPGMR_RES_REDUCED: + return(1); + break; + case SPGMR_CONV_FAIL: + return(1); + break; + case SPGMR_QRFACT_FAIL: + return(1); + break; + case SPGMR_PSOLVE_FAIL_REC: + return(1); + break; + case SPGMR_ATIMES_FAIL_REC: + return(1); + break; + case SPGMR_MEM_NULL: + return(-1); + break; + case SPGMR_ATIMES_FAIL_UNREC: + IDAProcessError(IDA_mem, SPGMR_ATIMES_FAIL_UNREC, "IDASPGMR", "IDASpgmrSolve", MSGS_JTIMES_FAILED); + return(-1); + break; + case SPGMR_PSOLVE_FAIL_UNREC: + IDAProcessError(IDA_mem, SPGMR_PSOLVE_FAIL_UNREC, "IDASPGMR", "IDASpgmrSolve", MSGS_PSOLVE_FAILED); + return(-1); + break; + case SPGMR_GS_FAIL: + return(-1); + break; + case SPGMR_QRSOL_FAIL: + return(-1); + break; + } + + return(0); +} + +/* + * This routine handles performance monitoring specific to the IDASPGMR + * linear solver. When perftask = 0, it saves values of various counters. + * When perftask = 1, it examines difference quotients in these counters, + * and depending on their values, it prints up to three warning messages. + * Messages are printed up to a maximum of 10 times. + */ + +static int IDASpgmrPerf(IDAMem IDA_mem, int perftask) +{ + IDASpilsMem idaspils_mem; + realtype avdim, rcfn, rcfl; + long int nstd, nnid; + booleantype lavd, lcfn, lcfl; + + idaspils_mem = (IDASpilsMem) lmem; + + if (perftask == 0) { + nst0 = nst; nni0 = nni; nli0 = nli; + ncfn0 = ncfn; ncfl0 = ncfl; + nwarn = 0; + return(0); + } + + nstd = nst - nst0; nnid = nni - nni0; + if (nstd == 0 || nnid == 0) return(0); + avdim = (realtype) ((nli - nli0)/((realtype) nnid)); + rcfn = (realtype) ((ncfn - ncfn0)/((realtype) nstd)); + rcfl = (realtype) ((ncfl - ncfl0)/((realtype) nnid)); + lavd = (avdim > ((realtype) maxl )); + lcfn = (rcfn > PT9); + lcfl = (rcfl > PT9); + if (!(lavd || lcfn || lcfl)) return(0); + nwarn++; + if (nwarn > 10) return(1); + if (lavd) + IDAProcessError(IDA_mem, IDA_WARNING, "IDASPGMR", "IDASpgmrPerf", MSGS_AVD_WARN, tn, avdim); + if (lcfn) + IDAProcessError(IDA_mem, IDA_WARNING, "IDASPGMR", "IDASpgmrPerf", MSGS_CFN_WARN, tn, rcfn); + if (lcfl) + IDAProcessError(IDA_mem, IDA_WARNING, "IDASPGMR", "IDASpgmrPerf", MSGS_CFL_WARN, tn, rcfl); + + return(0); +} + +static int IDASpgmrFree(IDAMem IDA_mem) +{ + IDASpilsMem idaspils_mem; + SpgmrMem spgmr_mem; + + idaspils_mem = (IDASpilsMem) lmem; + + N_VDestroy(ytemp); + N_VDestroy(xx); + + spgmr_mem = (SpgmrMem) spils_mem; + SpgmrFree(spgmr_mem); + + if (idaspils_mem->s_pfree != NULL) (idaspils_mem->s_pfree)(IDA_mem); + + free(idaspils_mem); idaspils_mem = NULL; + + return(0); +} + diff --git a/odemex/Parser/CVode/ida_src/src/ida/ida_spils.c b/odemex/Parser/CVode/ida_src/src/ida/ida_spils.c new file mode 100644 index 0000000..dbca511 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/ida_spils.c @@ -0,0 +1,637 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.4 $ + * $Date: 2007/04/30 19:29:00 $ + * ----------------------------------------------------------------- + * Programmers: Alan C. Hindmarsh and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California + * Produced at the Lawrence Livermore National Laboratory + * All rights reserved + * For details, see the LICENSE file + * ----------------------------------------------------------------- + * This is the common implementation file for the IDA Scaled + * Preconditioned Linear Solver modules. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "ida_impl.h" +#include "ida_spils_impl.h" + +/* Private constants */ + +#define ZERO RCONST(0.0) +#define PT25 RCONST(0.25) +#define PT05 RCONST(0.05) +#define ONE RCONST(1.0) + +/* Algorithmic constants */ + +#define MAX_ITERS 3 /* max. number of attempts to recover in DQ J*v */ + +/* Readability Replacements */ + +#define lrw1 (IDA_mem->ida_lrw1) +#define liw1 (IDA_mem->ida_liw1) +#define tn (IDA_mem->ida_tn) +#define cj (IDA_mem->ida_cj) +#define res (IDA_mem->ida_res) +#define user_data (IDA_mem->ida_user_data) +#define ewt (IDA_mem->ida_ewt) +#define lmem (IDA_mem->ida_lmem) + +#define ils_type (idaspils_mem->s_type) +#define sqrtN (idaspils_mem->s_sqrtN) +#define epslin (idaspils_mem->s_epslin) +#define ytemp (idaspils_mem->s_ytemp) +#define yptemp (idaspils_mem->s_yptemp) +#define xx (idaspils_mem->s_xx) +#define ycur (idaspils_mem->s_ycur) +#define ypcur (idaspils_mem->s_ypcur) +#define rcur (idaspils_mem->s_rcur) +#define npe (idaspils_mem->s_npe) +#define nli (idaspils_mem->s_nli) +#define nps (idaspils_mem->s_nps) +#define ncfl (idaspils_mem->s_ncfl) +#define njtimes (idaspils_mem->s_njtimes) +#define nres (idaspils_mem->s_nres) + +#define jtimesDQ (idaspils_mem->s_jtimesDQ) +#define jtimes (idaspils_mem->s_jtimes) +#define jdata (idaspils_mem->s_jdata) + +#define last_flag (idaspils_mem->s_last_flag) + +/* + * ----------------------------------------------------------------- + * OPTIONAL INPUT and OUTPUT + * ----------------------------------------------------------------- + */ + +int IDASpilsSetGSType(void *ida_mem, int gstype) +{ + IDAMem IDA_mem; + IDASpilsMem idaspils_mem; + + /* Return immediately if ida_mem is NULL */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPILS", "IDASpilsSetGSType", MSGS_IDAMEM_NULL); + return(IDASPILS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + if (lmem == NULL) { + IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASPILS", "IDASpilsSetGSType", MSGS_LMEM_NULL); + return(IDASPILS_LMEM_NULL); + } + idaspils_mem = (IDASpilsMem) lmem; + + if (ils_type != SPILS_SPGMR) { + IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASPILS", "IDASpilsSetGSType", MSGS_BAD_LSTYPE); + return(IDASPILS_ILL_INPUT); + } + + /* Check for legal gstype */ + if ((gstype != MODIFIED_GS) && (gstype != CLASSICAL_GS)) { + IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASPILS", "IDASpilsSetGSType", MSGS_BAD_GSTYPE); + return(IDASPILS_ILL_INPUT); + } + + idaspils_mem->s_gstype = gstype; + + return(IDASPILS_SUCCESS); +} + +int IDASpilsSetMaxRestarts(void *ida_mem, int maxrs) +{ + IDAMem IDA_mem; + IDASpilsMem idaspils_mem; + + /* Return immediately if ida_mem is NULL */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPILS", "IDASpilsSetMaxRestarts", MSGS_IDAMEM_NULL); + return(IDASPILS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + if (lmem == NULL) { + IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASPILS", "IDASpilsSetMaxRestarts", MSGS_LMEM_NULL); + return(IDASPILS_LMEM_NULL); + } + idaspils_mem = (IDASpilsMem) lmem; + + if (ils_type != SPILS_SPGMR) { + IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASPILS", "IDASpilsSetMaxRestarts", MSGS_BAD_LSTYPE); + return(IDASPILS_ILL_INPUT); + } + + /* Check for legal maxrs */ + if (maxrs < 0) { + IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASPILS", "IDASpilsSetMaxRestarts", MSGS_NEG_MAXRS); + return(IDASPILS_ILL_INPUT); + } + + idaspils_mem->s_maxrs = maxrs; + + return(IDASPILS_SUCCESS); +} + +int IDASpilsSetMaxl(void *ida_mem, int maxl) +{ + IDAMem IDA_mem; + IDASpilsMem idaspils_mem; + + /* Return immediately if ida_mem is NULL */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPILS", "IDASpilsSetMaxl", MSGS_IDAMEM_NULL); + return(IDASPILS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + if (lmem == NULL) { + IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASPILS", "IDASpilsSetMaxl", MSGS_LMEM_NULL); + return(IDASPILS_LMEM_NULL); + } + idaspils_mem = (IDASpilsMem) lmem; + + if (ils_type == SPILS_SPGMR) { + IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASPILS", "IDASpilsSetMaxl", MSGS_BAD_LSTYPE); + return(IDASPILS_ILL_INPUT); + } + + idaspils_mem->s_maxl = (maxl <= 0) ? IDA_SPILS_MAXL : maxl; + + return(IDASPILS_SUCCESS); +} + +int IDASpilsSetEpsLin(void *ida_mem, realtype eplifac) +{ + IDAMem IDA_mem; + IDASpilsMem idaspils_mem; + + /* Return immediately if ida_mem is NULL */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPILS", "IDASpilsSetEpsLin", MSGS_IDAMEM_NULL); + return(IDASPILS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + if (lmem == NULL) { + IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASPILS", "IDASpilsSetEpsLin", MSGS_LMEM_NULL); + return(IDASPILS_LMEM_NULL); + } + idaspils_mem = (IDASpilsMem) lmem; + + /* Check for legal maxrs */ + if (eplifac < ZERO) { + IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASPILS", "IDASpilsSetEpsLin", MSGS_NEG_EPLIFAC); + return(IDASPILS_ILL_INPUT); + } + + if (eplifac == ZERO) + idaspils_mem->s_eplifac = PT05; + else + idaspils_mem->s_eplifac = eplifac; + + return(IDASPILS_SUCCESS); +} + +int IDASpilsSetIncrementFactor(void *ida_mem, realtype dqincfac) +{ + IDAMem IDA_mem; + IDASpilsMem idaspils_mem; + + /* Return immediately if ida_mem is NULL */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPILS", "IDASpilsSetIncrementFactor", MSGS_IDAMEM_NULL); + return(IDASPILS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + if (lmem == NULL) { + IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASPILS", "IDASpilsSetIncrementFactor", MSGS_LMEM_NULL); + return(IDASPILS_LMEM_NULL); + } + idaspils_mem = (IDASpilsMem) lmem; + + /* Check for legal maxrs */ + if (dqincfac <= ZERO) { + IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASPILS", "IDASpilsSetIncrementFactor", MSGS_NEG_DQINCFAC); + return(IDASPILS_ILL_INPUT); + } + + idaspils_mem->s_dqincfac = dqincfac; + + return(IDASPILS_SUCCESS); +} + +int IDASpilsSetPreconditioner(void *ida_mem, + IDASpilsPrecSetupFn pset, IDASpilsPrecSolveFn psolve) +{ + IDAMem IDA_mem; + IDASpilsMem idaspils_mem; + + /* Return immediately if ida_mem is NULL */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPILS", "IDASpilsSetPreconditioner", MSGS_IDAMEM_NULL); + return(IDASPILS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + if (lmem == NULL) { + IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASPILS", "IDASpilsSetPreconditioner", MSGS_LMEM_NULL); + return(IDASPILS_LMEM_NULL); + } + idaspils_mem = (IDASpilsMem) lmem; + + idaspils_mem->s_pset = pset; + idaspils_mem->s_psolve = psolve; + + return(IDASPILS_SUCCESS); +} + +int IDASpilsSetJacTimesVecFn(void *ida_mem, IDASpilsJacTimesVecFn jtv) +{ + IDAMem IDA_mem; + IDASpilsMem idaspils_mem; + + /* Return immediately if ida_mem is NULL */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPILS", "IDASpilsSetJacTimesVecFn", MSGS_IDAMEM_NULL); + return(IDASPILS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + if (lmem == NULL) { + IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASPILS", "IDASpilsSetJacTimesVecFn", MSGS_LMEM_NULL); + return(IDASPILS_LMEM_NULL); + } + idaspils_mem = (IDASpilsMem) lmem; + + if (jtv != NULL) { + jtimesDQ = FALSE; + jtimes = jtv; + } else { + jtimesDQ = TRUE; + } + + return(IDASPILS_SUCCESS); +} + +int IDASpilsGetWorkSpace(void *ida_mem, long int *lenrwLS, long int *leniwLS) +{ + IDAMem IDA_mem; + IDASpilsMem idaspils_mem; + int maxl; + + /* Return immediately if ida_mem is NULL */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPILS", "IDASpilsGetWorkSpace", MSGS_IDAMEM_NULL); + return(IDASPILS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + if (lmem == NULL) { + IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASPILS", "IDASpilsGetWorkSpace", MSGS_LMEM_NULL); + return(IDASPILS_LMEM_NULL); + } + idaspils_mem = (IDASpilsMem) lmem; + + switch(ils_type) { + case SPILS_SPGMR: + maxl = idaspils_mem->s_maxl; + *lenrwLS = lrw1*(maxl + 6) + maxl*(maxl + 4) + 1; + *leniwLS = liw1*(maxl + 6); + break; + case SPILS_SPBCG: + *lenrwLS = lrw1 * 10; + *leniwLS = liw1 * 10; + break; + case SPILS_SPTFQMR: + *lenrwLS = lrw1*13; + *leniwLS = liw1*13; + break; + } + + return(IDASPILS_SUCCESS); +} + +int IDASpilsGetNumPrecEvals(void *ida_mem, long int *npevals) +{ + IDAMem IDA_mem; + IDASpilsMem idaspils_mem; + + /* Return immediately if ida_mem is NULL */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPILS", "IDASpilsGetNumPrecEvals", MSGS_IDAMEM_NULL); + return(IDASPILS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + if (lmem == NULL) { + IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASPILS", "IDASpilsGetNumPrecEvals", MSGS_LMEM_NULL); + return(IDASPILS_LMEM_NULL); + } + idaspils_mem = (IDASpilsMem) lmem; + + *npevals = npe; + + return(IDASPILS_SUCCESS); +} + +int IDASpilsGetNumPrecSolves(void *ida_mem, long int *npsolves) +{ + IDAMem IDA_mem; + IDASpilsMem idaspils_mem; + + /* Return immediately if ida_mem is NULL */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPILS", "IDASpilsGetNumPrecSolves", MSGS_IDAMEM_NULL); + return(IDASPILS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + if (lmem == NULL) { + IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASPILS", "IDASpilsGetNumPrecSolves", MSGS_LMEM_NULL); + return(IDASPILS_LMEM_NULL); + } + idaspils_mem = (IDASpilsMem) lmem; + + *npsolves = nps; + + return(IDASPILS_SUCCESS); +} + +int IDASpilsGetNumLinIters(void *ida_mem, long int *nliters) +{ + IDAMem IDA_mem; + IDASpilsMem idaspils_mem; + + /* Return immediately if ida_mem is NULL */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPILS", "IDASpilsGetNumLinIters", MSGS_IDAMEM_NULL); + return(IDASPILS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + if (lmem == NULL) { + IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASPILS", "IDASpilsGetNumLinIters", MSGS_LMEM_NULL); + return(IDASPILS_LMEM_NULL); + } + idaspils_mem = (IDASpilsMem) lmem; + + *nliters = nli; + + return(IDASPILS_SUCCESS); +} + +int IDASpilsGetNumConvFails(void *ida_mem, long int *nlcfails) +{ + IDAMem IDA_mem; + IDASpilsMem idaspils_mem; + + /* Return immediately if ida_mem is NULL */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPILS", "IDASpilsGetNumConvFails", MSGS_IDAMEM_NULL); + return(IDASPILS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + if (lmem == NULL) { + IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASPILS", "IDASpilsGetNumConvFails", MSGS_LMEM_NULL); + return(IDASPILS_LMEM_NULL); + } + idaspils_mem = (IDASpilsMem) lmem; + + *nlcfails = ncfl; + + return(IDASPILS_SUCCESS); +} + +int IDASpilsGetNumJtimesEvals(void *ida_mem, long int *njvevals) +{ + IDAMem IDA_mem; + IDASpilsMem idaspils_mem; + + /* Return immediately if ida_mem is NULL */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPILS", "IDASpilsGetNumJtimesEvals", MSGS_IDAMEM_NULL); + return(IDASPILS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + if (lmem == NULL) { + IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASPILS", "IDASpilsGetNumJtimesEvals", MSGS_LMEM_NULL); + return(IDASPILS_LMEM_NULL); + } + idaspils_mem = (IDASpilsMem) lmem; + + *njvevals = njtimes; + + return(IDASPILS_SUCCESS); +} + +int IDASpilsGetNumResEvals(void *ida_mem, long int *nrevalsLS) +{ + IDAMem IDA_mem; + IDASpilsMem idaspils_mem; + + /* Return immediately if ida_mem is NULL */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPILS", "IDASpilsGetNumResEvals", MSGS_IDAMEM_NULL); + return(IDASPILS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + if (lmem == NULL) { + IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASPILS", "IDASpilsGetNumResEvals", MSGS_LMEM_NULL); + return(IDASPILS_LMEM_NULL); + } + idaspils_mem = (IDASpilsMem) lmem; + + *nrevalsLS = nres; + + return(IDASPILS_SUCCESS); +} + +int IDASpilsGetLastFlag(void *ida_mem, int *flag) +{ + IDAMem IDA_mem; + IDASpilsMem idaspils_mem; + + /* Return immediately if ida_mem is NULL */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPILS", "IDASpilsGetLastFlag", MSGS_IDAMEM_NULL); + return(IDASPILS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + if (lmem == NULL) { + IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASPILS", "IDASpilsGetLastFlag", MSGS_LMEM_NULL); + return(IDASPILS_LMEM_NULL); + } + idaspils_mem = (IDASpilsMem) lmem; + + *flag = last_flag; + + return(IDASPILS_SUCCESS); +} + +char *IDASpilsGetReturnFlagName(int flag) +{ + char *name; + + name = (char *)malloc(30*sizeof(char)); + + switch(flag) { + case IDASPILS_SUCCESS: + sprintf(name,"IDASPILS_SUCCESS"); + break; + case IDASPILS_MEM_NULL: + sprintf(name,"IDASPILS_MEM_NULL"); + break; + case IDASPILS_LMEM_NULL: + sprintf(name,"IDASPILS_LMEM_NULL"); + break; + case IDASPILS_ILL_INPUT: + sprintf(name,"IDASPILS_ILL_INPUT"); + break; + case IDASPILS_MEM_FAIL: + sprintf(name,"IDASPILS_MEM_FAIL"); + break; + case IDASPILS_PMEM_NULL: + sprintf(name,"IDASPILS_PMEM_NULL"); + break; + default: + sprintf(name,"NONE"); + } + + return(name); +} + +/* + * ----------------------------------------------------------------- + * IDASPILS private functions + * ----------------------------------------------------------------- + */ + +#define psolve (idaspils_mem->s_psolve) +#define pdata (idaspils_mem->s_pdata) +#define dqincfac (idaspils_mem->s_dqincfac) + +/* + * This routine generates the matrix-vector product z = Jv, where + * J is the system Jacobian, by calling either the user provided + * routine or the internal DQ routine. + */ + +int IDASpilsAtimes(void *ida_mem, N_Vector v, N_Vector z) +{ + IDAMem IDA_mem; + IDASpilsMem idaspils_mem; + int jtflag; + + IDA_mem = (IDAMem) ida_mem; + idaspils_mem = (IDASpilsMem) lmem; + + jtflag = jtimes(tn, ycur, ypcur, rcur, v, z, cj, jdata, ytemp, yptemp); + njtimes++; + + return(jtflag); +} + +/* + * This routine interfaces between the generic Solve routine and + * the user's psolve routine. It passes to psolve all required state + * information from ida_mem. Its return value is the same as that + * returned by psolve. Note that the generic solver guarantees + * that IDASilsPSolve will not be called in the case psolve = NULL. + */ + +int IDASpilsPSolve(void *ida_mem, N_Vector r, N_Vector z, int lr) +{ + IDAMem IDA_mem; + IDASpilsMem idaspils_mem; + int retval; + + IDA_mem = (IDAMem) ida_mem; + idaspils_mem = (IDASpilsMem) lmem; + + retval = psolve(tn, ycur, ypcur, rcur, r, z, cj, epslin, pdata, ytemp); + + /* This call is counted in nps within the IDASp**Solve routine */ + + return(retval); + +} + +/* + * This routine generates the matrix-vector product z = Jv, where + * J is the system Jacobian, by using a difference quotient approximation. + * The approximation is + * Jv = [F(t,y1,yp1) - F(t,y,yp)]/sigma, where + * y1 = y + sigma*v, yp1 = yp + cj*sigma*v, + * sigma = sqrt(Neq)*dqincfac. + * The return value from the call to res is saved in order to set the + * return flag from IDASp**Solve. + */ + +int IDASpilsDQJtimes(realtype tt, + N_Vector yy, N_Vector yp, N_Vector rr, + N_Vector v, N_Vector Jv, + realtype c_j, void *data, + N_Vector work1, N_Vector work2) +{ + IDAMem IDA_mem; + IDASpilsMem idaspils_mem; + N_Vector y_tmp, yp_tmp; + realtype sig, siginv; + int iter, retval; + + /* data is ida_mem */ + IDA_mem = (IDAMem) data; + idaspils_mem = (IDASpilsMem) lmem; + + switch(ils_type) { + case SPILS_SPGMR: + sig = sqrtN*dqincfac; + break; + case SPILS_SPBCG: + sig = dqincfac/N_VWrmsNorm(v, ewt); + break; + case SPILS_SPTFQMR: + sig = dqincfac/N_VWrmsNorm(v, ewt); + break; + } + + /* Rename work1 and work2 for readibility */ + y_tmp = work1; + yp_tmp = work2; + + for (iter=0; iter 0) return(+1); + + /* Set Jv to [Jv - rr]/sig and return. */ + siginv = ONE/sig; + N_VLinearSum(siginv, Jv, -siginv, rr, Jv); + + return(0); + +} diff --git a/odemex/Parser/CVode/ida_src/src/ida/ida_spils_impl.h b/odemex/Parser/CVode/ida_src/src/ida/ida_spils_impl.h new file mode 100644 index 0000000..e64dc0a --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/ida_spils_impl.h @@ -0,0 +1,188 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.4 $ + * $Date: 2007/04/30 19:29:00 $ + * ----------------------------------------------------------------- + * Programmers: Alan C. Hindmarsh and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the common header file (private version) for the Scaled + * Preconditioned Iterative Linear Solver modules. + * ----------------------------------------------------------------- + */ + +#ifndef _IDASPILS_IMPL_H +#define _IDASPILS_IMPL_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include "ida_impl.h" + +/* Types of iterative linear solvers */ + +#define SPILS_SPGMR 1 +#define SPILS_SPBCG 2 +#define SPILS_SPTFQMR 3 + +/* Constants */ + +#define IDA_SPILS_MAXL 5 +#define IDA_SPILS_MAXRS 5 + +/* + * ----------------------------------------------------------------- + * Types : IDASpilsMemRec, IDASpilsMem + * ----------------------------------------------------------------- + */ + +typedef struct IDASpilsMemRec { + + int s_type; /* type of scaled preconditioned iterative LS */ + + int s_gstype; /* type of Gram-Schmidt orthogonalization */ + realtype s_sqrtN; /* sqrt(N) */ + int s_maxl; /* maxl = maximum dimension of the Krylov space */ + int s_maxrs; /* maxrs = max. number of GMRES restarts */ + realtype s_eplifac; /* eplifac = linear convergence factor */ + realtype s_dqincfac; /* dqincfac = optional increment factor in Jv */ + realtype s_epslin; /* SpgrmSolve tolerance parameter */ + + long int s_npe; /* npe = total number of precond calls */ + long int s_nli; /* nli = total number of linear iterations */ + long int s_nps; /* nps = total number of psolve calls */ + long int s_ncfl; /* ncfl = total number of convergence failures */ + long int s_nres; /* nres = total number of calls to res */ + long int s_njtimes; /* njtimes = total number of calls to jtimes */ + + long int s_nst0; /* nst0 = saved nst (for performance monitor) */ + long int s_nni0; /* nni0 = saved nni (for performance monitor) */ + long int s_nli0; /* nli0 = saved nli (for performance monitor) */ + long int s_ncfn0; /* ncfn0 = saved ncfn (for performance monitor) */ + long int s_ncfl0; /* ncfl0 = saved ncfl (for performance monitor) */ + long int s_nwarn; /* nwarn = no. of warnings (for perf. monitor) */ + + N_Vector s_ytemp; /* temp vector used by IDAAtimesDQ */ + N_Vector s_yptemp; /* temp vector used by IDAAtimesDQ */ + N_Vector s_xx; /* temp vector used by the solve function */ + N_Vector s_ycur; /* current y vector in Newton iteration */ + N_Vector s_ypcur; /* current yp vector in Newton iteration */ + N_Vector s_rcur; /* rcur = F(tn, ycur, ypcur) */ + + void *s_spils_mem; /* memory used by the generic solver */ + + int s_last_flag; /* last error return flag */ + + /* Preconditioner computation + * (a) user-provided: + * - pdata == user_data + * - pfree == NULL (the user dealocates memory for f_data) + * (b) internal preconditioner module + * - pdata == ida_mem + * - pfree == set by the prec. module and called in IDASpilsFree + */ + + IDASpilsPrecSetupFn s_pset; + IDASpilsPrecSolveFn s_psolve; + void (*s_pfree)(IDAMem IDA_mem); + void *s_pdata; + + /* Jacobian times vector compuation + * (a) jtimes function provided by the user: + * - jdata == user_data + * - jtimesDQ == FALSE + * (b) internal jtimes + * - jdata == ida_mem + * - jtimesDQ == TRUE + */ + + booleantype s_jtimesDQ; + IDASpilsJacTimesVecFn s_jtimes; + void *s_jdata; + +} *IDASpilsMem; + + +/* + * ----------------------------------------------------------------- + * Prototypes of internal functions + * ----------------------------------------------------------------- + */ + +/* Atimes and PSolve routines called by generic solver */ + +int IDASpilsAtimes(void *ida_mem, N_Vector v, N_Vector z); + +int IDASpilsPSolve(void *ida_mem, N_Vector r, N_Vector z, int lr); + +/* Difference quotient approximation for Jac times vector */ + +int IDASpilsDQJtimes(realtype tt, + N_Vector yy, N_Vector yp, N_Vector rr, + N_Vector v, N_Vector Jv, + realtype c_j, void *data, + N_Vector work1, N_Vector work2); + + + +/* + * ----------------------------------------------------------------- + * Error and Warning Messages + * ----------------------------------------------------------------- + */ + +#if defined(SUNDIALS_EXTENDED_PRECISION) + +#define MSGS_TIME "at t = %Lg, " +#define MSGS_FRMT "%Le." + +#elif defined(SUNDIALS_DOUBLE_PRECISION) + +#define MSGS_TIME "at t = %lg, " +#define MSGS_FRMT "%le." + +#else + +#define MSGS_TIME "at t = %g, " +#define MSGS_FRMT "%e." + +#endif + + +/* Error Messages */ + +#define MSGS_IDAMEM_NULL "Integrator memory is NULL." +#define MSGS_MEM_FAIL "A memory request failed." +#define MSGS_BAD_NVECTOR "A required vector operation is not implemented." +#define MSGS_BAD_LSTYPE "Incompatible linear solver type." +#define MSGS_LMEM_NULL "Linear solver memory is NULL." +#define MSGS_BAD_GSTYPE "gstype has an illegal value." +#define MSGS_NEG_MAXRS "maxrs < 0 illegal." +#define MSGS_NEG_EPLIFAC "eplifac < 0.0 illegal." +#define MSGS_NEG_DQINCFAC "dqincfac < 0.0 illegal." + +#define MSGS_PSET_FAILED "The preconditioner setup routine failed in an unrecoverable manner." +#define MSGS_PSOLVE_FAILED "The preconditioner solve routine failed in an unrecoverable manner." +#define MSGS_JTIMES_FAILED "The Jacobian x vector routine failed in an unrecoverable manner." + +/* Warning Messages */ + +#define MSGS_WARN "Warning: " MSGS_TIME "poor iterative algorithm performance. " + +#define MSGS_AVD_WARN MSGS_WARN "Average number of linear iterations is " MSGS_FRMT +#define MSGS_CFN_WARN MSGS_WARN "Nonlinear convergence failure rate is " MSGS_FRMT +#define MSGS_CFL_WARN MSGS_WARN "Linear convergence failure rate is " MSGS_FRMT + + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/src/ida/ida_sptfqmr.c b/odemex/Parser/CVode/ida_src/src/ida/ida_sptfqmr.c new file mode 100644 index 0000000..65bd102 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/ida/ida_sptfqmr.c @@ -0,0 +1,477 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.6 $ + * $Date: 2007/11/26 16:20:00 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for the IDA scaled preconditioned + * TFQMR linear solver module, IDASPTFQMR. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include +#include "ida_spils_impl.h" +#include "ida_impl.h" + +#include +#include + +/* Constants */ + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) +#define PT9 RCONST(0.9) +#define PT05 RCONST(0.05) + +/* IDASPTFQMR linit, lsetup, lsolve, lperf, and lfree routines */ + +static int IDASptfqmrInit(IDAMem IDA_mem); + +static int IDASptfqmrSetup(IDAMem IDA_mem, + N_Vector yy_p, N_Vector yp_p, N_Vector rr_p, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); + +static int IDASptfqmrSolve(IDAMem IDA_mem, N_Vector bb, N_Vector weight, + N_Vector yy_now, N_Vector yp_now, N_Vector rr_now); + +static int IDASptfqmrPerf(IDAMem IDA_mem, int perftask); + +static int IDASptfqmrFree(IDAMem IDA_mem); + +/* Readability Replacements */ + +#define nst (IDA_mem->ida_nst) +#define tn (IDA_mem->ida_tn) +#define cj (IDA_mem->ida_cj) +#define epsNewt (IDA_mem->ida_epsNewt) +#define res (IDA_mem->ida_res) +#define user_data (IDA_mem->ida_user_data) +#define ewt (IDA_mem->ida_ewt) +#define errfp (IDA_mem->ida_errfp) +#define linit (IDA_mem->ida_linit) +#define lsetup (IDA_mem->ida_lsetup) +#define lsolve (IDA_mem->ida_lsolve) +#define lperf (IDA_mem->ida_lperf) +#define lfree (IDA_mem->ida_lfree) +#define lmem (IDA_mem->ida_lmem) +#define nni (IDA_mem->ida_nni) +#define ncfn (IDA_mem->ida_ncfn) +#define setupNonNull (IDA_mem->ida_setupNonNull) +#define vec_tmpl (IDA_mem->ida_tempv1) + +#define sqrtN (idaspils_mem->s_sqrtN) +#define epslin (idaspils_mem->s_epslin) +#define ytemp (idaspils_mem->s_ytemp) +#define yptemp (idaspils_mem->s_yptemp) +#define xx (idaspils_mem->s_xx) +#define ycur (idaspils_mem->s_ycur) +#define ypcur (idaspils_mem->s_ypcur) +#define rcur (idaspils_mem->s_rcur) +#define npe (idaspils_mem->s_npe) +#define nli (idaspils_mem->s_nli) +#define nps (idaspils_mem->s_nps) +#define ncfl (idaspils_mem->s_ncfl) +#define nst0 (idaspils_mem->s_nst0) +#define nni0 (idaspils_mem->s_nni0) +#define nli0 (idaspils_mem->s_nli0) +#define ncfn0 (idaspils_mem->s_ncfn0) +#define ncfl0 (idaspils_mem->s_ncfl0) +#define nwarn (idaspils_mem->s_nwarn) +#define njtimes (idaspils_mem->s_njtimes) +#define nres (idaspils_mem->s_nres) +#define spils_mem (idaspils_mem->s_spils_mem) + +#define jtimesDQ (idaspils_mem->s_jtimesDQ) +#define jtimes (idaspils_mem->s_jtimes) +#define jdata (idaspils_mem->s_jdata) + +#define last_flag (idaspils_mem->s_last_flag) + +/* + * ----------------------------------------------------------------- + * Function : IDASptfqmr + * ----------------------------------------------------------------- + * This routine initializes the memory record and sets various function + * fields specific to the IDASPTFQMR linear solver module. + * + * IDASptfqmr first calls the existing lfree routine if this is not NULL. + * It then sets the ida_linit, ida_lsetup, ida_lsolve, ida_lperf, and + * ida_lfree fields in (*IDA_mem) to be IDASptfqmrInit, IDASptfqmrSetup, + * IDASptfqmrSolve, IDASptfqmrPerf, and IDASptfqmrFree, respectively. + * It allocates memory for a structure of type IDASpilsMemRec and sets + * the ida_lmem field in (*IDA_mem) to the address of this structure. + * It sets setupNonNull in (*IDA_mem). It then sets various fields + * in the IDASpilsMemRec structure. Finally, IDASptfqmr allocates + * memory for ytemp, yptemp, and xx, and calls SptfqmrMalloc to + * allocate memory for the Sptfqmr solver. + * + * The return value of IDASptfqmr is: + * IDASPILS_SUCCESS = 0 if successful + * IDASPILS_MEM_FAIL = -1 if IDA_mem is NULL or a memory + * allocation failed + * IDASPILS_ILL_INPUT = -2 if a required vector operation is not + * implemented. + * ----------------------------------------------------------------- + */ + +int IDASptfqmr(void *ida_mem, int maxl) +{ + IDAMem IDA_mem; + IDASpilsMem idaspils_mem; + SptfqmrMem sptfqmr_mem; + int flag, maxl1; + + /* Return immediately if ida_mem is NULL */ + if (ida_mem == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPTFQMR", "IDASptfqmr", MSGS_IDAMEM_NULL); + return(IDASPILS_MEM_NULL); + } + IDA_mem = (IDAMem) ida_mem; + + /* Check if N_VDotProd is present */ + if (vec_tmpl->ops->nvdotprod == NULL) { + IDAProcessError(NULL, IDASPILS_ILL_INPUT, "IDASPTFQMR", "IDASptfqmr", MSGS_BAD_NVECTOR); + return(IDASPILS_ILL_INPUT); + } + + if (lfree != NULL) flag = lfree((IDAMem) ida_mem); + + /* Set five main function fields in ida_mem */ + linit = IDASptfqmrInit; + lsetup = IDASptfqmrSetup; + lsolve = IDASptfqmrSolve; + lperf = IDASptfqmrPerf; + lfree = IDASptfqmrFree; + + /* Get memory for IDASpilsMemRec */ + idaspils_mem = NULL; + idaspils_mem = (IDASpilsMem) malloc(sizeof(struct IDASpilsMemRec)); + if (idaspils_mem == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPTFQMR", "IDASptfqmr", MSGS_MEM_FAIL); + return(IDASPILS_MEM_FAIL); + } + + /* Set ILS type */ + idaspils_mem->s_type = SPILS_SPTFQMR; + + /* Set SPTFQMR parameters that were passed in call sequence */ + maxl1 = (maxl <= 0) ? IDA_SPILS_MAXL : maxl; + idaspils_mem->s_maxl = maxl1; + + /* Set defaults for Jacobian-related fileds */ + jtimesDQ = TRUE; + jtimes = NULL; + jdata = NULL; + + /* Set defaults for preconditioner-related fields */ + idaspils_mem->s_pset = NULL; + idaspils_mem->s_psolve = NULL; + idaspils_mem->s_pfree = NULL; + idaspils_mem->s_pdata = IDA_mem->ida_user_data; + + /* Set default values for the rest of the Sptfqmr parameters */ + idaspils_mem->s_eplifac = PT05; + idaspils_mem->s_dqincfac = ONE; + + idaspils_mem->s_last_flag = IDASPILS_SUCCESS; + + /* Set setupNonNull to FALSE */ + setupNonNull = FALSE; + + /* Allocate memory for ytemp, yptemp, and xx */ + + ytemp = N_VClone(vec_tmpl); + if (ytemp == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPTFQMR", "IDASptfqmr", MSGS_MEM_FAIL); + free(idaspils_mem); idaspils_mem = NULL; + return(IDASPILS_MEM_FAIL); + } + + yptemp = N_VClone(vec_tmpl); + if (yptemp == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPTFQMR", "IDASptfqmr", MSGS_MEM_FAIL); + N_VDestroy(ytemp); + free(idaspils_mem); idaspils_mem = NULL; + return(IDASPILS_MEM_FAIL); + } + + xx = N_VClone(vec_tmpl); + if (xx == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPTFQMR", "IDASptfqmr", MSGS_MEM_FAIL); + N_VDestroy(ytemp); + N_VDestroy(yptemp); + free(idaspils_mem); idaspils_mem = NULL; + return(IDASPILS_MEM_FAIL); + } + + /* Compute sqrtN from a dot product */ + N_VConst(ONE, ytemp); + sqrtN = RSqrt(N_VDotProd(ytemp, ytemp)); + + /* Call SptfqmrMalloc to allocate workspace for Sptfqmr */ + sptfqmr_mem = NULL; + sptfqmr_mem = SptfqmrMalloc(maxl1, vec_tmpl); + if (sptfqmr_mem == NULL) { + IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPTFQMR", "IDASptfqmr", MSGS_MEM_FAIL); + N_VDestroy(ytemp); + N_VDestroy(yptemp); + N_VDestroy(xx); + free(idaspils_mem); idaspils_mem = NULL; + return(IDASPILS_MEM_FAIL); + } + + /* Attach SPTFQMR memory to spils memory structure */ + spils_mem = (void *)sptfqmr_mem; + + /* Attach linear solver memory to the integrator memory */ + lmem = idaspils_mem; + + return(IDASPILS_SUCCESS); +} + +/* + * ----------------------------------------------------------------- + * IDASPTFQMR interface routines + * ----------------------------------------------------------------- + */ + +/* Additional readability Replacements */ + +#define maxl (idaspils_mem->s_maxl) +#define eplifac (idaspils_mem->s_eplifac) +#define psolve (idaspils_mem->s_psolve) +#define pset (idaspils_mem->s_pset) +#define pdata (idaspils_mem->s_pdata) + +static int IDASptfqmrInit(IDAMem IDA_mem) +{ + IDASpilsMem idaspils_mem; + SptfqmrMem sptfqmr_mem; + + idaspils_mem = (IDASpilsMem) lmem; + sptfqmr_mem = (SptfqmrMem) spils_mem; + + /* Initialize counters */ + npe = nli = nps = ncfl = 0; + njtimes = nres = 0; + + /* Set setupNonNull to TRUE iff there is preconditioning with setup */ + setupNonNull = (psolve != NULL) && (pset != NULL); + + /* Set Jacobian-related fields, based on jtimesDQ */ + if (jtimesDQ) { + jtimes = IDASpilsDQJtimes; + jdata = IDA_mem; + } else { + jdata = user_data; + } + + /* Set maxl in the SPTFQMR memory in case it was changed by the user */ + sptfqmr_mem->l_max = maxl; + + last_flag = IDASPILS_SUCCESS; + + return(0); +} + +static int IDASptfqmrSetup(IDAMem IDA_mem, + N_Vector yy_p, N_Vector yp_p, N_Vector rr_p, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) +{ + int retval; + IDASpilsMem idaspils_mem; + + idaspils_mem = (IDASpilsMem) lmem; + + /* Call user setup routine pset and update counter npe */ + retval = pset(tn, yy_p, yp_p, rr_p, cj, pdata, + tmp1, tmp2, tmp3); + npe++; + + if (retval < 0) { + IDAProcessError(IDA_mem, SPTFQMR_PSET_FAIL_UNREC, "IDASPTFQMR", "IDASptfqmrSetup", MSGS_PSET_FAILED); + last_flag = SPTFQMR_PSET_FAIL_UNREC; + return(-1); + } + if (retval > 0) { + last_flag = SPTFQMR_PSET_FAIL_REC; + return(+1); + } + + last_flag = SPTFQMR_SUCCESS; + + return(0); +} + +/* + * ----------------------------------------------------------------- + * Function : IDASptfqmrSolve + * ----------------------------------------------------------------- + * Note: The x-scaling and b-scaling arrays are both equal to weight. + * + * We set the initial guess, x = 0, then call SptfqmrSolve. + * We copy the solution x into b, and update the counters nli, nps, + * and ncfl. If SptfqmrSolve returned nli_inc = 0 (hence x = 0), we + * take the SPTFQMR vtemp vector (= P_inverse F) as the correction + * vector instead. Finally, we set the return value according to the + * success of SptfqmrSolve. + * ----------------------------------------------------------------- + */ + +static int IDASptfqmrSolve(IDAMem IDA_mem, N_Vector bb, N_Vector weight, + N_Vector yy_now, N_Vector yp_now, N_Vector rr_now) +{ + IDASpilsMem idaspils_mem; + SptfqmrMem sptfqmr_mem; + int pretype, nli_inc, nps_inc, retval; + realtype res_norm; + + idaspils_mem = (IDASpilsMem) lmem; + + sptfqmr_mem = (SptfqmrMem)spils_mem; + + /* Set SptfqmrSolve convergence test constant epslin, in terms of the + Newton convergence test constant epsNewt and safety factors. The factor + sqrt(Neq) assures that the TFQMR convergence test is applied to the + WRMS norm of the residual vector, rather than the weighted L2 norm. */ + epslin = sqrtN*eplifac*epsNewt; + + /* Set vectors ycur, ypcur, and rcur for use by the Atimes and Psolve */ + ycur = yy_now; + ypcur = yp_now; + rcur = rr_now; + + /* Set SptfqmrSolve inputs pretype and initial guess xx = 0 */ + pretype = (psolve == NULL) ? PREC_NONE : PREC_LEFT; + N_VConst(ZERO, xx); + + /* Call SptfqmrSolve and copy xx to bb */ + retval = SptfqmrSolve(sptfqmr_mem, IDA_mem, xx, bb, pretype, epslin, + IDA_mem, weight, weight, IDASpilsAtimes, + IDASpilsPSolve, &res_norm, &nli_inc, &nps_inc); + + if (nli_inc == 0) N_VScale(ONE, SPTFQMR_VTEMP(sptfqmr_mem), bb); + else N_VScale(ONE, xx, bb); + + /* Increment counters nli, nps, and return if successful */ + nli += nli_inc; + nps += nps_inc; + if (retval != SPTFQMR_SUCCESS) ncfl++; + + /* Interpret return value from SpgmrSolve */ + + last_flag = retval; + + switch(retval) { + + case SPTFQMR_SUCCESS: + return(0); + break; + case SPTFQMR_RES_REDUCED: + return(1); + break; + case SPTFQMR_CONV_FAIL: + return(1); + break; + case SPTFQMR_PSOLVE_FAIL_REC: + return(1); + break; + case SPTFQMR_ATIMES_FAIL_REC: + return(1); + break; + case SPTFQMR_MEM_NULL: + return(-1); + break; + case SPTFQMR_ATIMES_FAIL_UNREC: + IDAProcessError(IDA_mem, SPTFQMR_ATIMES_FAIL_UNREC, "IDASPTFQMR", "IDASptfqmrSolve", MSGS_JTIMES_FAILED); + return(-1); + break; + case SPTFQMR_PSOLVE_FAIL_UNREC: + IDAProcessError(IDA_mem, SPTFQMR_PSOLVE_FAIL_UNREC, "IDASPTFQMR", "IDASptfqmrSolve", MSGS_PSOLVE_FAILED); + return(-1); + break; + } + + return(0); +} + +/* + * ----------------------------------------------------------------- + * Function : IDASptfqmrPerf + * ----------------------------------------------------------------- + * This routine handles performance monitoring specific to the + * IDASPTFQMR linear solver. When perftask = 0, it saves values of + * various counters. When perftask = 1, it examines difference + * quotients in these counters, and depending on their values, it + * prints up to three warning messages. Messages are printed up to + * a maximum of 10 times. + * ----------------------------------------------------------------- + */ + +static int IDASptfqmrPerf(IDAMem IDA_mem, int perftask) +{ + IDASpilsMem idaspils_mem; + realtype avdim, rcfn, rcfl; + long int nstd, nnid; + booleantype lavd, lcfn, lcfl; + + idaspils_mem = (IDASpilsMem) lmem; + + if (perftask == 0) { + nst0 = nst; nni0 = nni; nli0 = nli; + ncfn0 = ncfn; ncfl0 = ncfl; + nwarn = 0; + return(0); + } + + nstd = nst - nst0; nnid = nni - nni0; + if (nstd == 0 || nnid == 0) return(0); + avdim = (realtype) ((nli - nli0)/((realtype) nnid)); + rcfn = (realtype) ((ncfn - ncfn0)/((realtype) nstd)); + rcfl = (realtype) ((ncfl - ncfl0)/((realtype) nnid)); + lavd = (avdim > ((realtype) maxl)); + lcfn = (rcfn > PT9); + lcfl = (rcfl > PT9); + if (!(lavd || lcfn || lcfl)) return(0); + nwarn++; + if (nwarn > 10) return(1); + if (lavd) + IDAProcessError(IDA_mem, IDA_WARNING, "IDASPTFQMR", "IDASptfqmrPerf", MSGS_AVD_WARN, tn, avdim); + if (lcfn) + IDAProcessError(IDA_mem, IDA_WARNING, "IDASPTFQMR", "IDASptfqmrPerf", MSGS_CFN_WARN, tn, rcfn); + if (lcfl) + IDAProcessError(IDA_mem, IDA_WARNING, "IDASPTFQMR", "IDASptfqmrPerf", MSGS_CFL_WARN, tn, rcfl); + + return(0); +} + +static int IDASptfqmrFree(IDAMem IDA_mem) +{ + IDASpilsMem idaspils_mem; + SptfqmrMem sptfqmr_mem; + + idaspils_mem = (IDASpilsMem) lmem; + + N_VDestroy(ytemp); + N_VDestroy(yptemp); + N_VDestroy(xx); + + sptfqmr_mem = (SptfqmrMem)spils_mem; + SptfqmrFree(sptfqmr_mem); + + if (idaspils_mem->s_pfree != NULL) (idaspils_mem->s_pfree)(IDA_mem); + + free(idaspils_mem); idaspils_mem = NULL; + + return(0); +} + diff --git a/odemex/Parser/CVode/ida_src/src/nvec_par/CMakeLists.txt b/odemex/Parser/CVode/ida_src/src/nvec_par/CMakeLists.txt new file mode 100644 index 0000000..f5e359f --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/nvec_par/CMakeLists.txt @@ -0,0 +1,89 @@ +# --------------------------------------------------------------- +# $Revision: 1.3 $ +# $Date: 2009/02/17 02:58:48 $ +# --------------------------------------------------------------- +# Programmer: Radu Serban @ LLNL +# --------------------------------------------------------------- +# Copyright (c) 2007, The Regents of the University of California. +# Produced at the Lawrence Livermore National Laboratory. +# All rights reserved. +# For details, see the LICENSE file. +# --------------------------------------------------------------- +# CMakeLists.txt file for the parallel NVECTOR library + +INSTALL(CODE "MESSAGE(\"\nInstall NVECTOR_PARALLEL\n\")") + +IF(MPI_MPICC) + # use MPI_MPICC as the compiler + SET(CMAKE_C_COMPILER ${MPI_MPICC}) +ELSE(MPI_MPICC) + # add MPI_INCLUDE_PATH to include directories + INCLUDE_DIRECTORIES(${MPI_INCLUDE_PATH}) +ENDIF(MPI_MPICC) + +# Add variable nvecparallel_SOURCES with the sources for the NVECPARALLEL lib +SET(nvecparallel_SOURCES nvector_parallel.c) + +# Add variable shared_SOURCES with the common SUNDIALS sources which will +# also be included in the NVECPARALLEL library +SET(shared_SOURCES sundials_math.c) +ADD_PREFIX(${sundials_SOURCE_DIR}/src/sundials/ shared_SOURCES) + +# Add variable nvecparallel_HEADERS with the exported NVECPARALLEL header files +SET(nvecparallel_HEADERS nvector_parallel.h) +ADD_PREFIX(${sundials_SOURCE_DIR}/include/nvector/ nvecparallel_HEADERS) + +# Add source directory to include directories +INCLUDE_DIRECTORIES(.) + +# Define C preprocessor flag -DBUILD_SUNDIALS_LIBRARY +ADD_DEFINITIONS(-DBUILD_SUNDIALS_LIBRARY) + +# Rules for building and installing the static library: +# - Add the build target for the NVECPARALLEL library +# - Set the library name and make sure it is not deleted +# - Install the NVECSERIAL library +IF(BUILD_STATIC_LIBS) + ADD_LIBRARY(sundials_nvecparallel_static STATIC ${nvecparallel_SOURCES} ${shared_SOURCES}) + SET_TARGET_PROPERTIES(sundials_nvecparallel_static + PROPERTIES OUTPUT_NAME sundials_nvecparallel CLEAN_DIRECT_OUTPUT 1) + INSTALL(TARGETS sundials_nvecparallel_static DESTINATION lib) +ENDIF(BUILD_STATIC_LIBS) + +# Rules for building and installing the shared library: +# - Add the build target for the NVECPARALLEL library +# - Set the library name and make sure it is not deleted +# - Set VERSION and SOVERSION for shared libraries +# - Install the NVECSERIAL library +IF(BUILD_SHARED_LIBS) + ADD_LIBRARY(sundials_nvecparallel_shared SHARED ${nvecparallel_SOURCES} ${shared_SOURCES}) + SET_TARGET_PROPERTIES(sundials_nvecparallel_shared + PROPERTIES OUTPUT_NAME sundials_nvecparallel CLEAN_DIRECT_OUTPUT 1) + SET_TARGET_PROPERTIES(sundials_nvecparallel_shared + PROPERTIES VERSION ${nveclib_VERSION} SOVERSION ${nveclib_SOVERSION}) + INSTALL(TARGETS sundials_nvecparallel_shared DESTINATION lib) +ENDIF(BUILD_SHARED_LIBS) + +# Install the NVECPARALLEL header files +INSTALL(FILES ${nvecparallel_HEADERS} DESTINATION include/nvector) + +# If FCMIX is enabled and MPI-F77 works, build and install the FNVECPARALLEL library +IF(FCMIX_ENABLE AND MPIF_FOUND) + SET(fnvecparallel_SOURCES fnvector_parallel.c) + IF(BUILD_STATIC_LIBS) + ADD_LIBRARY(sundials_fnvecparallel_static STATIC ${fnvecparallel_SOURCES}) + SET_TARGET_PROPERTIES(sundials_fnvecparallel_static + PROPERTIES OUTPUT_NAME sundials_fnvecparallel CLEAN_DIRECT_OUTPUT 1) + INSTALL(TARGETS sundials_fnvecparallel_static DESTINATION lib) + ENDIF(BUILD_STATIC_LIBS) + IF(BUILD_SHARED_LIBS) + ADD_LIBRARY(sundials_fnvecparallel_shared SHARED ${fnvecparallel_SOURCES}) + SET_TARGET_PROPERTIES(sundials_fnvecparallel_shared + PROPERTIES OUTPUT_NAME sundials_fnvecparallel CLEAN_DIRECT_OUTPUT 1) + SET_TARGET_PROPERTIES(sundials_fnvecparallel_shared + PROPERTIES VERSION ${nveclib_VERSION} SOVERSION ${nveclib_SOVERSION}) + INSTALL(TARGETS sundials_fnvecparallel_shared DESTINATION lib) + ENDIF(BUILD_SHARED_LIBS) +ENDIF(FCMIX_ENABLE AND MPIF_FOUND) +# +MESSAGE(STATUS "Added NVECTOR_PARALLEL module") diff --git a/odemex/Parser/CVode/ida_src/src/nvec_par/Makefile.in b/odemex/Parser/CVode/ida_src/src/nvec_par/Makefile.in new file mode 100644 index 0000000..bd7ea4f --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/nvec_par/Makefile.in @@ -0,0 +1,128 @@ +# ----------------------------------------------------------------- +# $Revision: 1.8 $ +# $Date: 2007/01/29 17:36:28 $ +# ----------------------------------------------------------------- +# Programmer(s): Radu Serban and Aaron Collier @ LLNL +# ----------------------------------------------------------------- +# Copyright (c) 2002, The Regents of the University of California. +# Produced at the Lawrence Livermore National Laboratory. +# All rights reserved. +# For details, see the LICENSE file. +# ----------------------------------------------------------------- +# Makefile for parallel NVECTOR module +# +# @configure_input@ +# ----------------------------------------------------------------- + +SHELL = @SHELL@ + +@SET_MAKE@ + +srcdir = @srcdir@ +builddir = @builddir@ +abs_builddir = @abs_builddir@ +top_builddir = @top_builddir@ +prefix = @prefix@ +exec_prefix = @exec_prefix@ +includedir = @includedir@ +libdir = @libdir@ + +INSTALL = @INSTALL@ +INSTALL_LIB = @INSTALL_PROGRAM@ +INSTALL_HEADER = @INSTALL_DATA@ + +LIBTOOL = @LIBTOOL@ +LIBTOOL_DEPS = @LIBTOOL_DEPS@ + +MPICC = @MPICC@ +MPI_INC_DIR = @MPI_INC_DIR@ +MPI_LIB_DIR = @MPI_LIB_DIR@ +MPI_LIBS = @MPI_LIBS@ +MPI_FLAGS = @MPI_FLAGS@ +CPPFLAGS = @CPPFLAGS@ +CFLAGS = @CFLAGS@ +LDFLAGS = @LDFLAGS@ +LIBS = @LIBS@ + +FCMIX_ENABLED = @FCMIX_ENABLED@ + +top_srcdir = $(srcdir)/../.. + +INCLUDES = -I$(top_srcdir)/include -I$(top_builddir)/include -I$(MPI_INC_DIR) + +LIB_REVISION = 0:2:0 + +NVECPAR_LIB = libsundials_nvecparallel.la +NVECPAR_LIB_FILES = nvector_parallel.lo + +FNVECPAR_LIB = libsundials_fnvecparallel.la +FNVECPAR_LIB_FILES = fnvector_parallel.lo + +SHARED_LIB_FILES = $(top_builddir)/src/sundials/sundials_math.lo + +mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs +rminstalldirs = $(SHELL) $(top_srcdir)/config/rminstalldirs + +all: $(NVECPAR_LIB) $(FNVECPAR_LIB) + +$(NVECPAR_LIB): shared $(NVECPAR_LIB_FILES) + $(LIBTOOL) --mode=link $(MPICC) $(CFLAGS) $(MPI_FLAGS) -o $(NVECPAR_LIB) $(NVECPAR_LIB_FILES) $(SHARED_LIB_FILES) $(LDFLAGS) -L$(MPI_LIB_DIR) $(MPI_LIBS) $(LIBS) -rpath $(libdir) -version-info $(LIB_REVISION) + +$(FNVECPAR_LIB): $(FNVECPAR_LIB_FILES) + @if test "X${FCMIX_ENABLED}" = "Xyes"; then \ + echo "${LIBTOOL} --mode=link ${MPICC} ${CFLAGS} ${MPI_FLAGS} -o ${FNVECPAR_LIB} ${FNVECPAR_LIB_FILES} ${SHARED_LIB_FILES} ${LDFLAGS} -L${MPI_LIB_DIR} ${MPI_LIBS} ${LIBS} -rpath ${libdir} -version-info ${LIB_REVISION}" ; \ + ${LIBTOOL} --mode=link ${MPICC} ${CFLAGS} ${MPI_FLAGS} -o ${FNVECPAR_LIB} ${FNVECPAR_LIB_FILES} ${SHARED_LIB_FILES} ${LDFLAGS} -L${MPI_LIB_DIR} ${MPI_LIBS} ${LIBS} -rpath ${libdir} -version-info ${LIB_REVISION} ; \ + fi + +install: $(NVECPAR_LIB) $(FNVECPAR_LIB) + $(mkinstalldirs) $(includedir)/nvector + $(mkinstalldirs) $(libdir) + $(LIBTOOL) --mode=install $(INSTALL_LIB) $(NVECPAR_LIB) $(libdir) + $(INSTALL_HEADER) $(top_srcdir)/include/nvector/nvector_parallel.h $(includedir)/nvector/ + @if test "X${FCMIX_ENABLED}" = "Xyes"; then \ + echo "${LIBTOOL} --mode=install ${INSTALL_LIB} ${FNVECPAR_LIB} ${libdir}" ; \ + ${LIBTOOL} --mode=install ${INSTALL_LIB} ${FNVECPAR_LIB} ${libdir} ; \ + fi + +uninstall: + $(LIBTOOL) --mode=uninstall rm -f $(libdir)/$(NVECPAR_LIB) + @if test "X${FCMIX_ENABLED}" = "Xyes"; then \ + echo "${LIBTOOL} --mode=uninstall rm -f ${libdir}/${FNVECPAR_LIB}" ; \ + ${LIBTOOL} --mode=uninstall rm -f ${libdir}/${FNVECPAR_LIB} ; \ + fi + rm -f $(includedir)/nvector/nvector_parallel.h + $(rminstalldirs) ${includedir}/nvector + +shared: + @cd ${top_builddir}/src/sundials ; \ + ${MAKE} ; \ + cd ${abs_builddir} + +clean: + $(LIBTOOL) --mode=clean rm -f $(NVECPAR_LIB) + rm -f $(NVECPAR_LIB_FILES) + rm -f nvector_parallel.o + @if test "X${FCMIX_ENABLED}" = "Xyes"; then \ + echo "${LIBTOOL} --mode=clean rm -f ${FNVECPAR_LIB}" ; \ + ${LIBTOOL} --mode=clean rm -f ${FNVECPAR_LIB} ; \ + echo "rm -f ${FNVECPAR_LIB_FILES}" ; \ + rm -f ${FNVECPAR_LIB_FILES} ; \ + echo "rm -f fnvector_parallel.o" ; \ + rm -f fnvector_parallel.o ; \ + fi + +distclean: clean + rm -f Makefile + +nvector_parallel.lo: $(srcdir)/nvector_parallel.c + $(LIBTOOL) --mode=compile $(MPICC) $(CPPFLAGS) $(MPI_FLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/nvector_parallel.c +fnvector_parallel.lo: $(srcdir)/fnvector_parallel.c + @if test "X${FCMIX_ENABLED}" = "Xyes"; then \ + echo "${LIBTOOL} --mode=compile ${MPICC} ${CPPFLAGS} ${MPI_FLAGS} $(INCLUDES) ${CFLAGS} -c ${srcdir}/fnvector_parallel.c" ; \ + ${LIBTOOL} --mode=compile ${MPICC} ${CPPFLAGS} ${MPI_FLAGS} $(INCLUDES) ${CFLAGS} -c ${srcdir}/fnvector_parallel.c ; \ + fi + +libtool: $(top_builddir)/$(LIBTOOL_DEPS) + @cd ${top_builddir} ; \ + ${SHELL} ./config.status --recheck ; \ + cd ${abs_builddir} diff --git a/odemex/Parser/CVode/ida_src/src/nvec_par/README b/odemex/Parser/CVode/ida_src/src/nvec_par/README new file mode 100644 index 0000000..726603e --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/nvec_par/README @@ -0,0 +1,135 @@ + NVECTOR_PARALLEL + Release 2.4.0, January 2008 + +MPI parallel implementation of the NVECTOR module for SUNDIALS. + +NVECTOR_PARALLEL defines the content field of N_Vector to be a structure +containing the global and local lengths of the vector, a pointer to the +beginning of a contiguous local data array, an MPI communicator, and a +boolean flag indicating ownership of the data array. + +NVECTOR_PARALLEL defines seven macros to provide access to the content of +a parallel N_Vector, several constructors for variables of type N_Vector, +a constructor for an array of variables of type N_Vector, and destructors +for N_Vector and N_Vector array. + +NVECTOR_PARALLEL provides implementations for all vector operations defined +by the generic NVECTOR module in the table of operations. + + +A. Documentation +---------------- + +The MPI parallel NVECTOR implementation is fully described in the user documentation +for any of the SUNDIALS solvers [1-5]. A PDF file for the user guide for a particular +solver is available in the solver's subdirectory under doc/. + + +B. Installation +--------------- + +For basic installation instructions see /sundials/INSTALL_NOTES. +For complete installation instructions see any of the user guides. + + +C. References +------------- + +[1] A. C. Hindmarsh and R. Serban, "User Documentation for CVODE v2.4.0," + LLLNL technical report UCRL-MA-208108, November 2004. + +[2] A. C. Hindmarsh and R. Serban, "User Documentation for CVODES v2.4.0," + LLNL technical report UCRL-MA-208111, November 2004. + +[3] A. C. Hindmarsh and R. Serban, "User Documentation for IDA v2.4.0," + LLNL technical report UCRL-MA-208112, November 2004. + +[4] R. Serban and C. Petra, "User Documentation for IDAS v1.0.0," + LLNL technical report UCRL-SM-234051, August 2007. + +[5] A. M. Collier, A. C. Hindmarsh, R. Serban,and C. S. Woodward, "User + Documentation for KINSOL v2.4.0," LLNL technical report UCRL-MA-208116, + November 2004. + + +D. Releases +----------- + +v. 2.4.0 - Jan. 2008 +v. 2.3.0 - Nov. 2006 +v. 2.2.0 - Mar. 2006 +v. 2.1.1 - May. 2005 +v. 2.1.0 - Apr. 2005 +v. 2.0.2 - Mar. 2005 +v. 2.0.1 - Jan. 2005 +v. 2.0 - Dec. 2004 +v. 1.0 - Jul. 2002 (first SUNDIALS release) + + +E. Revision History +------------------- + +v. 2.3.0 (Nov. 2006) ---> v. 2.4.0 (Jan. 2008) +--------------------------------------------------------- + +- none + +v. 2.2.0 (Mar. 2006) ---> v. 2.3.0 (Nov. 2006) +---------------------------------------------- + +- Changes related to the build system + - reorganized source tree. Header files in ${srcdir}/include/nvector; + sources in ${srcdir}/src/nvec_par + - exported header files in ${includedir}/sundials + +v. 2.1.1 (May. 2005) ---> v. 2.2.0 (Mar. 2006) +---------------------------------------------- + +- none + +v. 2.1.0 (Apr. 2005) ---> v. 2.1.1 (May. 2005) +---------------------------------------------- + +- Changes to user interface + - added argument to initialization routines to allow user to specify a + different MPI communicator + +- Changes to data structures + - added N_VCloneEmpty to global vector operations table + +v. 2.0.2 (Mar. 2005) ---> v. 2.1.0 (Apr. 2005) +---------------------------------------------- + +- none + +v. 2.0.1 (Jan. 2005) ---> v. 2.0.2 (Mar. 2005) +---------------------------------------------- + +- Changes related to the build system + - fixed autoconf-related bug to allow configuration with the PGI Fortran compiler + - modified to use customized detection of the Fortran name mangling scheme + (autoconf's AC_F77_WRAPPERS routine is problematic on some platforms) + - added --with-mpi-flags as a configure option to allow user to specify + MPI-specific flags + - updated Makefiles for Fortran examples to avoid C++ compiler errors (now use + CC and MPICC to link) + +v. 2.0 (Dec. 2004) ---> v. 2.0.1 (Jan. 2005) +-------------------------------------------- + +- Changes related to the build system + - changed order of compiler directives in header files to avoid compilation + errors when using a C++ compiler. + +v. 1.0 (Jul. 2002) ---> v. 2.0 (Dec. 2004) +------------------------------------------ + +- Revised to correspond to new generic NVECTOR module + (see sundials/shared/README). +- Extended the list of user-callable functions provided by NVECTOR_PARALLEL + outside the table of vector operations. +- Revised parallel N_VMin and N_VMinQuotient to use BIG_REAL if + local N is 0 or no quotients found. +- Revised the F/C interface to use underscore flags for name mapping + and to use precision flag from configure. +- Revised F/C routine NVECTOR names for uniformity. diff --git a/odemex/Parser/CVode/ida_src/src/nvec_par/fnvector_parallel.c b/odemex/Parser/CVode/ida_src/src/nvec_par/fnvector_parallel.c new file mode 100644 index 0000000..6ece6b9 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/nvec_par/fnvector_parallel.c @@ -0,0 +1,182 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.1 $ + * $Date: 2006/07/05 15:32:37 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This file (companion of nvector_parallel.h) contains the + * implementation needed for the Fortran initialization of parallel + * vector operations. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "fnvector_parallel.h" + +/* Define global vector variables */ + +N_Vector F2C_CVODE_vec; +N_Vector F2C_CVODE_vecQ; +N_Vector *F2C_CVODE_vecS; +N_Vector F2C_CVODE_vecB; +N_Vector F2C_CVODE_vecQB; + +N_Vector F2C_IDA_vec; +N_Vector F2C_IDA_vecQ; +N_Vector *F2C_IDA_vecS; +N_Vector F2C_IDA_vecB; +N_Vector F2C_IDA_vecQB; + +N_Vector F2C_KINSOL_vec; + +#ifndef SUNDIALS_MPI_COMM_F2C +#define MPI_Fint int +#endif + +/* Fortran callable interfaces */ + +void FNV_INITP(MPI_Fint *comm, int *code, long int *L, long int *N, int *ier) +{ + MPI_Comm F2C_comm; + +#ifdef SUNDIALS_MPI_COMM_F2C + F2C_comm = MPI_Comm_f2c(*comm); +#else + F2C_comm = MPI_COMM_WORLD; +#endif + + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + F2C_CVODE_vec = NULL; + F2C_CVODE_vec = N_VNewEmpty_Parallel(F2C_comm, *L, *N); + if (F2C_CVODE_vec == NULL) *ier = -1; + break; + case FCMIX_IDA: + F2C_IDA_vec = NULL; + F2C_IDA_vec = N_VNewEmpty_Parallel(F2C_comm, *L, *N); + if (F2C_IDA_vec == NULL) *ier = -1; + break; + case FCMIX_KINSOL: + F2C_KINSOL_vec = NULL; + F2C_KINSOL_vec = N_VNewEmpty_Parallel(F2C_comm, *L, *N); + if (F2C_KINSOL_vec == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + +void FNV_INITP_Q(MPI_Fint *comm, int *code, long int *Lq, long int *Nq, int *ier) +{ + MPI_Comm F2C_comm; + +#ifdef SUNDIALS_MPI_COMM_F2C + F2C_comm = MPI_Comm_f2c(*comm); +#else + F2C_comm = MPI_COMM_WORLD; +#endif + + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + F2C_CVODE_vecQ = NULL; + F2C_CVODE_vecQ = N_VNewEmpty_Parallel(F2C_comm, *Lq, *Nq); + if (F2C_CVODE_vecQ == NULL) *ier = -1; + break; + case FCMIX_IDA: + F2C_IDA_vecQ = NULL; + F2C_IDA_vecQ = N_VNewEmpty_Parallel(F2C_comm, *Lq, *Nq); + if (F2C_IDA_vecQ == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + +void FNV_INITP_B(MPI_Fint *comm, int *code, long int *LB, long int *NB, int *ier) +{ + MPI_Comm F2C_comm; + +#ifdef SUNDIALS_MPI_COMM_F2C + F2C_comm = MPI_Comm_f2c(*comm); +#else + F2C_comm = MPI_COMM_WORLD; +#endif + + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + F2C_CVODE_vecB = NULL; + F2C_CVODE_vecB = N_VNewEmpty_Parallel(F2C_comm, *LB, *NB); + if (F2C_CVODE_vecB == NULL) *ier = -1; + break; + case FCMIX_IDA: + F2C_IDA_vecB = NULL; + F2C_IDA_vecB = N_VNewEmpty_Parallel(F2C_comm, *LB, *NB); + if (F2C_IDA_vecB == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + +void FNV_INITP_QB(MPI_Fint *comm, int *code, long int *LqB, long int *NqB, int *ier) +{ + MPI_Comm F2C_comm; + +#ifdef SUNDIALS_MPI_COMM_F2C + F2C_comm = MPI_Comm_f2c(*comm); +#else + F2C_comm = MPI_COMM_WORLD; +#endif + + + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + F2C_CVODE_vecQB = NULL; + F2C_CVODE_vecQB = N_VNewEmpty_Parallel(F2C_comm, *LqB, *NqB); + if (F2C_CVODE_vecQB == NULL) *ier = -1; + break; + case FCMIX_IDA: + F2C_IDA_vecQB = NULL; + F2C_IDA_vecQB = N_VNewEmpty_Parallel(F2C_comm, *LqB, *NqB); + if (F2C_IDA_vecQB == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + +void FNV_INITP_S(int *code, int *Ns, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + F2C_CVODE_vecS = NULL; + F2C_CVODE_vecS = (N_Vector *) N_VCloneVectorArrayEmpty_Parallel(*Ns, F2C_CVODE_vec); + if (F2C_CVODE_vecS == NULL) *ier = -1; + break; + case FCMIX_IDA: + F2C_IDA_vecS = NULL; + F2C_IDA_vecS = (N_Vector *) N_VCloneVectorArrayEmpty_Parallel(*Ns, F2C_IDA_vec); + if (F2C_IDA_vecS == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} diff --git a/odemex/Parser/CVode/ida_src/src/nvec_par/fnvector_parallel.h b/odemex/Parser/CVode/ida_src/src/nvec_par/fnvector_parallel.h new file mode 100644 index 0000000..79837bb --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/nvec_par/fnvector_parallel.h @@ -0,0 +1,88 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.3 $ + * $Date: 2006/11/29 00:05:09 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This file (companion of nvector_parallel.c) contains the + * definitions needed for the initialization of parallel + * vector operations in Fortran. + * ----------------------------------------------------------------- + */ + +#ifndef _FNVECTOR_PARALLEL_H +#define _FNVECTOR_PARALLEL_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +#if defined(F77_FUNC) + +#define FNV_INITP F77_FUNC(fnvinitp, FNVINITP) +#define FNV_INITP_Q F77_FUNC_(fnvinitp_q, FNVINITP_Q) +#define FNV_INITP_S F77_FUNC_(fnvinitp_s, FNVINITP_S) +#define FNV_INITP_B F77_FUNC_(fnvinitp_b, FNVINITP_B) +#define FNV_INITP_QB F77_FUNC_(fnvinitp_qb, FNVINITP_QB) + +#else + +#define FNV_INITP fnvinitp_ +#define FNV_INITP_Q fnvinitp_q_ +#define FNV_INITP_S fnvinitp_s_ +#define FNV_INITP_B fnvinitp_b_ +#define FNV_INITP_QB fnvinitp_qb_ + +#endif + +/* Declarations of global variables */ + +extern N_Vector F2C_CVODE_vec; +extern N_Vector F2C_CVODE_vecQ; +extern N_Vector *F2C_CVODE_vecS; +extern N_Vector F2C_CVODE_vecB; +extern N_Vector F2C_CVODE_vecQB; + +extern N_Vector F2C_IDA_vec; +extern N_Vector F2C_IDA_vecQ; +extern N_Vector *F2C_IDA_vecS; +extern N_Vector F2C_IDA_vecB; +extern N_Vector F2C_IDA_vecQB; + +extern N_Vector F2C_KINSOL_vec; + +/* + * Prototypes of exported functions + * + * FNV_INITP - initializes parallel vector operations for main problem + * FNV_INITP_Q - initializes parallel vector operations for quadratures + * FNV_INITP_S - initializes parallel vector operations for sensitivities + * FNV_INITP_B - initializes parallel vector operations for adjoint problem + * FNV_INITP_QB - initializes parallel vector operations for adjoint quadratures + * + */ + +#ifndef SUNDIALS_MPI_COMM_F2C +#define MPI_Fint int +#endif + +void FNV_INITP(MPI_Fint *comm, int *code, long int *L, long int *N, int *ier); +void FNV_INITP_Q(MPI_Fint *comm, int *code, long int *Lq, long int *Nq, int *ier); +void FNV_INITP_B(MPI_Fint *comm, int *code, long int *LB, long int *NB, int *ier); +void FNV_INITP_QB(MPI_Fint *comm, int *code, long int *LqB, long int *NqB, int *ier); +void FNV_INITP_S(int *code, int *Ns, int *ier); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/src/nvec_par/nvector_parallel.c b/odemex/Parser/CVode/ida_src/src/nvec_par/nvector_parallel.c new file mode 100644 index 0000000..8a53fab --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/nvec_par/nvector_parallel.c @@ -0,0 +1,1152 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.1 $ + * $Date: 2006/07/05 15:32:37 $ + * ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, Radu Serban, + * and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for a parallel MPI implementation + * of the NVECTOR package. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include +#include + +#define ZERO RCONST(0.0) +#define HALF RCONST(0.5) +#define ONE RCONST(1.0) +#define ONEPT5 RCONST(1.5) + +/* Error Message */ + +#define BAD_N1 "N_VNew_Parallel -- Sum of local vector lengths differs from " +#define BAD_N2 "input global length. \n\n" +#define BAD_N BAD_N1 BAD_N2 + +/* Private function prototypes */ + +/* Reduction operations add/max/min over the processor group */ +static realtype VAllReduce_Parallel(realtype d, int op, MPI_Comm comm); +/* z=x */ +static void VCopy_Parallel(N_Vector x, N_Vector z); +/* z=x+y */ +static void VSum_Parallel(N_Vector x, N_Vector y, N_Vector z); +/* z=x-y */ +static void VDiff_Parallel(N_Vector x, N_Vector y, N_Vector z); +/* z=-x */ +static void VNeg_Parallel(N_Vector x, N_Vector z); +/* z=c(x+y) */ +static void VScaleSum_Parallel(realtype c, N_Vector x, N_Vector y, N_Vector z); +/* z=c(x-y) */ +static void VScaleDiff_Parallel(realtype c, N_Vector x, N_Vector y, N_Vector z); +/* z=ax+y */ +static void VLin1_Parallel(realtype a, N_Vector x, N_Vector y, N_Vector z); +/* z=ax-y */ +static void VLin2_Parallel(realtype a, N_Vector x, N_Vector y, N_Vector z); +/* y <- ax+y */ +static void Vaxpy_Parallel(realtype a, N_Vector x, N_Vector y); +/* x <- ax */ +static void VScaleBy_Parallel(realtype a, N_Vector x); + +/* + * ----------------------------------------------------------------- + * exported functions + * ----------------------------------------------------------------- + */ + +/* ---------------------------------------------------------------- + * Function to create a new parallel vector with empty data array + */ + +N_Vector N_VNewEmpty_Parallel(MPI_Comm comm, + long int local_length, + long int global_length) +{ + N_Vector v; + N_Vector_Ops ops; + N_VectorContent_Parallel content; + long int n, Nsum; + + /* Compute global length as sum of local lengths */ + n = local_length; + MPI_Allreduce(&n, &Nsum, 1, PVEC_INTEGER_MPI_TYPE, MPI_SUM, comm); + if (Nsum != global_length) { + printf(BAD_N); + return(NULL); + } + + /* Create vector */ + v = NULL; + v = (N_Vector) malloc(sizeof *v); + if (v == NULL) return(NULL); + + /* Create vector operation structure */ + ops = NULL; + ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); + if (ops == NULL) { free(v); return(NULL); } + + ops->nvclone = N_VClone_Parallel; + ops->nvcloneempty = N_VCloneEmpty_Parallel; + ops->nvdestroy = N_VDestroy_Parallel; + ops->nvspace = N_VSpace_Parallel; + ops->nvgetarraypointer = N_VGetArrayPointer_Parallel; + ops->nvsetarraypointer = N_VSetArrayPointer_Parallel; + ops->nvlinearsum = N_VLinearSum_Parallel; + ops->nvconst = N_VConst_Parallel; + ops->nvprod = N_VProd_Parallel; + ops->nvdiv = N_VDiv_Parallel; + ops->nvscale = N_VScale_Parallel; + ops->nvabs = N_VAbs_Parallel; + ops->nvinv = N_VInv_Parallel; + ops->nvaddconst = N_VAddConst_Parallel; + ops->nvdotprod = N_VDotProd_Parallel; + ops->nvmaxnorm = N_VMaxNorm_Parallel; + ops->nvwrmsnormmask = N_VWrmsNormMask_Parallel; + ops->nvwrmsnorm = N_VWrmsNorm_Parallel; + ops->nvmin = N_VMin_Parallel; + ops->nvwl2norm = N_VWL2Norm_Parallel; + ops->nvl1norm = N_VL1Norm_Parallel; + ops->nvcompare = N_VCompare_Parallel; + ops->nvinvtest = N_VInvTest_Parallel; + ops->nvconstrmask = N_VConstrMask_Parallel; + ops->nvminquotient = N_VMinQuotient_Parallel; + + /* Create content */ + content = NULL; + content = (N_VectorContent_Parallel) malloc(sizeof(struct _N_VectorContent_Parallel)); + if (content == NULL) { free(ops); free(v); return(NULL); } + + /* Attach lengths and communicator */ + content->local_length = local_length; + content->global_length = global_length; + content->comm = comm; + content->own_data = FALSE; + content->data = NULL; + + /* Attach content and ops */ + v->content = content; + v->ops = ops; + + return(v); +} + +/* ---------------------------------------------------------------- + * Function to create a new parallel vector + */ + +N_Vector N_VNew_Parallel(MPI_Comm comm, + long int local_length, + long int global_length) +{ + N_Vector v; + realtype *data; + + v = NULL; + v = N_VNewEmpty_Parallel(comm, local_length, global_length); + if (v == NULL) return(NULL); + + /* Create data */ + if(local_length > 0) { + + /* Allocate memory */ + data = NULL; + data = (realtype *) malloc(local_length * sizeof(realtype)); + if(data == NULL) { N_VDestroy_Parallel(v); return(NULL); } + + /* Attach data */ + NV_OWN_DATA_P(v) = TRUE; + NV_DATA_P(v) = data; + + } + + return(v); +} + +/* ---------------------------------------------------------------- + * Function to create a parallel N_Vector with user data component + */ + +N_Vector N_VMake_Parallel(MPI_Comm comm, + long int local_length, + long int global_length, + realtype *v_data) +{ + N_Vector v; + + v = NULL; + v = N_VNewEmpty_Parallel(comm, local_length, global_length); + if (v == NULL) return(NULL); + + if (local_length > 0) { + /* Attach data */ + NV_OWN_DATA_P(v) = FALSE; + NV_DATA_P(v) = v_data; + } + + return(v); +} + +/* ---------------------------------------------------------------- + * Function to create an array of new parallel vectors. + */ + +N_Vector *N_VCloneVectorArray_Parallel(int count, N_Vector w) +{ + N_Vector *vs; + int j; + + if (count <= 0) return(NULL); + + vs = NULL; + vs = (N_Vector *) malloc(count * sizeof(N_Vector)); + if(vs == NULL) return(NULL); + + for (j = 0; j < count; j++) { + vs[j] = NULL; + vs[j] = N_VClone_Parallel(w); + if (vs[j] == NULL) { + N_VDestroyVectorArray_Parallel(vs, j-1); + return(NULL); + } + } + + return(vs); +} + +/* ---------------------------------------------------------------- + * Function to create an array of new parallel vectors with empty + * (NULL) data array. + */ + +N_Vector *N_VCloneVectorArrayEmpty_Parallel(int count, N_Vector w) +{ + N_Vector *vs; + int j; + + if (count <= 0) return(NULL); + + vs = NULL; + vs = (N_Vector *) malloc(count * sizeof(N_Vector)); + if(vs == NULL) return(NULL); + + for (j = 0; j < count; j++) { + vs[j] = NULL; + vs[j] = N_VCloneEmpty_Parallel(w); + if (vs[j] == NULL) { + N_VDestroyVectorArray_Parallel(vs, j-1); + return(NULL); + } + } + + return(vs); +} + +/* ---------------------------------------------------------------- + * Function to free an array created with N_VCloneVectorArray_Parallel + */ + +void N_VDestroyVectorArray_Parallel(N_Vector *vs, int count) +{ + int j; + + for (j = 0; j < count; j++) N_VDestroy_Parallel(vs[j]); + + free(vs); vs = NULL; + + return; +} + +/* ---------------------------------------------------------------- + * Function to print a parallel vector + */ + +void N_VPrint_Parallel(N_Vector x) +{ + long int i, N; + realtype *xd; + + xd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + + for (i = 0; i < N; i++) { +#if defined(SUNDIALS_EXTENDED_PRECISION) + printf("%Lg\n", xd[i]); +#elif defined(SUNDIALS_DOUBLE_PRECISION) + printf("%lg\n", xd[i]); +#else + printf("%g\n", xd[i]); +#endif + } + printf("\n"); + + return; +} + +/* + * ----------------------------------------------------------------- + * implementation of vector operations + * ----------------------------------------------------------------- + */ + +N_Vector N_VCloneEmpty_Parallel(N_Vector w) +{ + N_Vector v; + N_Vector_Ops ops; + N_VectorContent_Parallel content; + + if (w == NULL) return(NULL); + + /* Create vector */ + v = NULL; + v = (N_Vector) malloc(sizeof *v); + if (v == NULL) return(NULL); + + /* Create vector operation structure */ + ops = NULL; + ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); + if (ops == NULL) { free(v); return(NULL); } + + ops->nvclone = w->ops->nvclone; + ops->nvcloneempty = w->ops->nvcloneempty; + ops->nvdestroy = w->ops->nvdestroy; + ops->nvspace = w->ops->nvspace; + ops->nvgetarraypointer = w->ops->nvgetarraypointer; + ops->nvsetarraypointer = w->ops->nvsetarraypointer; + ops->nvlinearsum = w->ops->nvlinearsum; + ops->nvconst = w->ops->nvconst; + ops->nvprod = w->ops->nvprod; + ops->nvdiv = w->ops->nvdiv; + ops->nvscale = w->ops->nvscale; + ops->nvabs = w->ops->nvabs; + ops->nvinv = w->ops->nvinv; + ops->nvaddconst = w->ops->nvaddconst; + ops->nvdotprod = w->ops->nvdotprod; + ops->nvmaxnorm = w->ops->nvmaxnorm; + ops->nvwrmsnormmask = w->ops->nvwrmsnormmask; + ops->nvwrmsnorm = w->ops->nvwrmsnorm; + ops->nvmin = w->ops->nvmin; + ops->nvwl2norm = w->ops->nvwl2norm; + ops->nvl1norm = w->ops->nvl1norm; + ops->nvcompare = w->ops->nvcompare; + ops->nvinvtest = w->ops->nvinvtest; + ops->nvconstrmask = w->ops->nvconstrmask; + ops->nvminquotient = w->ops->nvminquotient; + + /* Create content */ + content = NULL; + content = (N_VectorContent_Parallel) malloc(sizeof(struct _N_VectorContent_Parallel)); + if (content == NULL) { free(ops); free(v); return(NULL); } + + /* Attach lengths and communicator */ + content->local_length = NV_LOCLENGTH_P(w); + content->global_length = NV_GLOBLENGTH_P(w); + content->comm = NV_COMM_P(w); + content->own_data = FALSE; + content->data = NULL; + + /* Attach content and ops */ + v->content = content; + v->ops = ops; + + return(v); +} + +N_Vector N_VClone_Parallel(N_Vector w) +{ + N_Vector v; + realtype *data; + long int local_length; + + v = NULL; + v = N_VCloneEmpty_Parallel(w); + if (v == NULL) return(NULL); + + local_length = NV_LOCLENGTH_P(w); + + /* Create data */ + if(local_length > 0) { + + /* Allocate memory */ + data = NULL; + data = (realtype *) malloc(local_length * sizeof(realtype)); + if(data == NULL) { N_VDestroy_Parallel(v); return(NULL); } + + /* Attach data */ + NV_OWN_DATA_P(v) = TRUE; + NV_DATA_P(v) = data; + } + + return(v); +} + +void N_VDestroy_Parallel(N_Vector v) +{ + if ((NV_OWN_DATA_P(v) == TRUE) && (NV_DATA_P(v) != NULL)) { + free(NV_DATA_P(v)); + NV_DATA_P(v) = NULL; + } + free(v->content); v->content = NULL; + free(v->ops); v->ops = NULL; + free(v); v = NULL; + + return; +} + +void N_VSpace_Parallel(N_Vector v, long int *lrw, long int *liw) +{ + MPI_Comm comm; + int npes; + + comm = NV_COMM_P(v); + MPI_Comm_size(comm, &npes); + + *lrw = NV_GLOBLENGTH_P(v); + *liw = 2*npes; + + return; +} + +realtype *N_VGetArrayPointer_Parallel(N_Vector v) +{ + return((realtype *) NV_DATA_P(v)); +} + +void N_VSetArrayPointer_Parallel(realtype *v_data, N_Vector v) +{ + if (NV_LOCLENGTH_P(v) > 0) NV_DATA_P(v) = v_data; + + return; +} + +void N_VLinearSum_Parallel(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z) +{ + long int i, N; + realtype c, *xd, *yd, *zd; + N_Vector v1, v2; + booleantype test; + + xd = yd = zd = NULL; + + if ((b == ONE) && (z == y)) { /* BLAS usage: axpy y <- ax+y */ + Vaxpy_Parallel(a, x, y); + return; + } + + if ((a == ONE) && (z == x)) { /* BLAS usage: axpy x <- by+x */ + Vaxpy_Parallel(b, y, x); + return; + } + + /* Case: a == b == 1.0 */ + + if ((a == ONE) && (b == ONE)) { + VSum_Parallel(x, y, z); + return; + } + + /* Cases: (1) a == 1.0, b = -1.0, (2) a == -1.0, b == 1.0 */ + + if ((test = ((a == ONE) && (b == -ONE))) || ((a == -ONE) && (b == ONE))) { + v1 = test ? y : x; + v2 = test ? x : y; + VDiff_Parallel(v2, v1, z); + return; + } + + /* Cases: (1) a == 1.0, b == other or 0.0, (2) a == other or 0.0, b == 1.0 */ + /* if a or b is 0.0, then user should have called N_VScale */ + + if ((test = (a == ONE)) || (b == ONE)) { + c = test ? b : a; + v1 = test ? y : x; + v2 = test ? x : y; + VLin1_Parallel(c, v1, v2, z); + return; + } + + /* Cases: (1) a == -1.0, b != 1.0, (2) a != 1.0, b == -1.0 */ + + if ((test = (a == -ONE)) || (b == -ONE)) { + c = test ? b : a; + v1 = test ? y : x; + v2 = test ? x : y; + VLin2_Parallel(c, v1, v2, z); + return; + } + + /* Case: a == b */ + /* catches case both a and b are 0.0 - user should have called N_VConst */ + + if (a == b) { + VScaleSum_Parallel(a, x, y, z); + return; + } + + /* Case: a == -b */ + + if (a == -b) { + VScaleDiff_Parallel(a, x, y, z); + return; + } + + /* Do all cases not handled above: + (1) a == other, b == 0.0 - user should have called N_VScale + (2) a == 0.0, b == other - user should have called N_VScale + (3) a,b == other, a !=b, a != -b */ + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + yd = NV_DATA_P(y); + zd = NV_DATA_P(z); + + for (i = 0; i < N; i++) + zd[i] = (a*xd[i])+(b*yd[i]); + + return; +} + +void N_VConst_Parallel(realtype c, N_Vector z) +{ + long int i, N; + realtype *zd; + + zd = NULL; + + N = NV_LOCLENGTH_P(z); + zd = NV_DATA_P(z); + + for (i = 0; i < N; i++) zd[i] = c; + + return; +} + +void N_VProd_Parallel(N_Vector x, N_Vector y, N_Vector z) +{ + long int i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + yd = NV_DATA_P(y); + zd = NV_DATA_P(z); + + for (i = 0; i < N; i++) + zd[i] = xd[i]*yd[i]; + + return; +} + +void N_VDiv_Parallel(N_Vector x, N_Vector y, N_Vector z) +{ + long int i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + yd = NV_DATA_P(y); + zd = NV_DATA_P(z); + + for (i = 0; i < N; i++) + zd[i] = xd[i]/yd[i]; + + return; +} + +void N_VScale_Parallel(realtype c, N_Vector x, N_Vector z) +{ + long int i, N; + realtype *xd, *zd; + + xd = zd = NULL; + + if (z == x) { /* BLAS usage: scale x <- cx */ + VScaleBy_Parallel(c, x); + return; + } + + if (c == ONE) { + VCopy_Parallel(x, z); + } else if (c == -ONE) { + VNeg_Parallel(x, z); + } else { + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + zd = NV_DATA_P(z); + for (i = 0; i < N; i++) + zd[i] = c*xd[i]; + } + + return; +} + +void N_VAbs_Parallel(N_Vector x, N_Vector z) +{ + long int i, N; + realtype *xd, *zd; + + xd = zd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + zd = NV_DATA_P(z); + + for (i = 0; i < N; i++) + zd[i] = ABS(xd[i]); + + return; +} + +void N_VInv_Parallel(N_Vector x, N_Vector z) +{ + long int i, N; + realtype *xd, *zd; + + xd = zd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + zd = NV_DATA_P(z); + + for (i = 0; i < N; i++) + zd[i] = ONE/xd[i]; + + return; +} + +void N_VAddConst_Parallel(N_Vector x, realtype b, N_Vector z) +{ + long int i, N; + realtype *xd, *zd; + + xd = zd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + zd = NV_DATA_P(z); + + for (i = 0; i < N; i++) zd[i] = xd[i]+b; + + return; +} + +realtype N_VDotProd_Parallel(N_Vector x, N_Vector y) +{ + long int i, N; + realtype sum, *xd, *yd, gsum; + MPI_Comm comm; + + sum = ZERO; + xd = yd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + yd = NV_DATA_P(y); + comm = NV_COMM_P(x); + + for (i = 0; i < N; i++) sum += xd[i]*yd[i]; + + gsum = VAllReduce_Parallel(sum, 1, comm); + + return(gsum); +} + +realtype N_VMaxNorm_Parallel(N_Vector x) +{ + long int i, N; + realtype max, *xd, gmax; + MPI_Comm comm; + + xd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + comm = NV_COMM_P(x); + + max = ZERO; + + for (i = 0; i < N; i++) { + if (ABS(xd[i]) > max) max = ABS(xd[i]); + } + + gmax = VAllReduce_Parallel(max, 2, comm); + + return(gmax); +} + +realtype N_VWrmsNorm_Parallel(N_Vector x, N_Vector w) +{ + long int i, N, N_global; + realtype sum, prodi, *xd, *wd, gsum; + MPI_Comm comm; + + sum = ZERO; + xd = wd = NULL; + + N = NV_LOCLENGTH_P(x); + N_global = NV_GLOBLENGTH_P(x); + xd = NV_DATA_P(x); + wd = NV_DATA_P(w); + comm = NV_COMM_P(x); + + for (i = 0; i < N; i++) { + prodi = xd[i]*wd[i]; + sum += SQR(prodi); + } + + gsum = VAllReduce_Parallel(sum, 1, comm); + + return(RSqrt(gsum/N_global)); +} + +realtype N_VWrmsNormMask_Parallel(N_Vector x, N_Vector w, N_Vector id) +{ + long int i, N, N_global; + realtype sum, prodi, *xd, *wd, *idd, gsum; + MPI_Comm comm; + + sum = ZERO; + xd = wd = idd = NULL; + + N = NV_LOCLENGTH_P(x); + N_global = NV_GLOBLENGTH_P(x); + xd = NV_DATA_P(x); + wd = NV_DATA_P(w); + idd = NV_DATA_P(id); + comm = NV_COMM_P(x); + + for (i = 0; i < N; i++) { + if (idd[i] > ZERO) { + prodi = xd[i]*wd[i]; + sum += SQR(prodi); + } + } + + gsum = VAllReduce_Parallel(sum, 1, comm); + + return(RSqrt(gsum/N_global)); +} + +realtype N_VMin_Parallel(N_Vector x) +{ + long int i, N; + realtype min, *xd, gmin; + MPI_Comm comm; + + xd = NULL; + + N = NV_LOCLENGTH_P(x); + comm = NV_COMM_P(x); + + min = BIG_REAL; + + if (N > 0) { + + xd = NV_DATA_P(x); + + min = xd[0]; + + for (i = 1; i < N; i++) { + if (xd[i] < min) min = xd[i]; + } + + } + + gmin = VAllReduce_Parallel(min, 3, comm); + + return(gmin); +} + +realtype N_VWL2Norm_Parallel(N_Vector x, N_Vector w) +{ + long int i, N; + realtype sum, prodi, *xd, *wd, gsum; + MPI_Comm comm; + + sum = ZERO; + xd = wd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + wd = NV_DATA_P(w); + comm = NV_COMM_P(x); + + for (i = 0; i < N; i++) { + prodi = xd[i]*wd[i]; + sum += SQR(prodi); + } + + gsum = VAllReduce_Parallel(sum, 1, comm); + + return(RSqrt(gsum)); +} + +realtype N_VL1Norm_Parallel(N_Vector x) +{ + long int i, N; + realtype sum, gsum, *xd; + MPI_Comm comm; + + sum = ZERO; + xd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + comm = NV_COMM_P(x); + + for (i = 0; i= c) ? ONE : ZERO; + } + + return; +} + +booleantype N_VInvTest_Parallel(N_Vector x, N_Vector z) +{ + long int i, N; + realtype *xd, *zd, val, gval; + MPI_Comm comm; + + xd = zd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + zd = NV_DATA_P(z); + comm = NV_COMM_P(x); + + val = ONE; + for (i = 0; i < N; i++) { + if (xd[i] == ZERO) + val = ZERO; + else + zd[i] = ONE/xd[i]; + } + + gval = VAllReduce_Parallel(val, 3, comm); + + if (gval == ZERO) + return(FALSE); + else + return(TRUE); +} + +booleantype N_VConstrMask_Parallel(N_Vector c, N_Vector x, N_Vector m) +{ + long int i, N; + realtype temp; + realtype *cd, *xd, *md; + MPI_Comm comm; + + cd = xd = md = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + cd = NV_DATA_P(c); + md = NV_DATA_P(m); + comm = NV_COMM_P(x); + + temp = ONE; + + for (i = 0; i < N; i++) { + md[i] = ZERO; + if (cd[i] == ZERO) continue; + if (cd[i] > ONEPT5 || cd[i] < -ONEPT5) { + if (xd[i]*cd[i] <= ZERO) { temp = ZERO; md[i] = ONE; } + continue; + } + if (cd[i] > HALF || cd[i] < -HALF) { + if (xd[i]*cd[i] < ZERO ) { temp = ZERO; md[i] = ONE; } + } + } + + temp = VAllReduce_Parallel(temp, 3, comm); + + if (temp == ONE) return(TRUE); + else return(FALSE); +} + +realtype N_VMinQuotient_Parallel(N_Vector num, N_Vector denom) +{ + booleantype notEvenOnce; + long int i, N; + realtype *nd, *dd, min; + MPI_Comm comm; + + nd = dd = NULL; + + N = NV_LOCLENGTH_P(num); + nd = NV_DATA_P(num); + dd = NV_DATA_P(denom); + comm = NV_COMM_P(num); + + notEvenOnce = TRUE; + min = BIG_REAL; + + for (i = 0; i < N; i++) { + if (dd[i] == ZERO) continue; + else { + if (!notEvenOnce) min = MIN(min, nd[i]/dd[i]); + else { + min = nd[i]/dd[i]; + notEvenOnce = FALSE; + } + } + } + + return(VAllReduce_Parallel(min, 3, comm)); +} + +/* + * ----------------------------------------------------------------- + * private functions + * ----------------------------------------------------------------- + */ + +static realtype VAllReduce_Parallel(realtype d, int op, MPI_Comm comm) +{ + /* + * This function does a global reduction. The operation is + * sum if op = 1, + * max if op = 2, + * min if op = 3. + * The operation is over all processors in the communicator + */ + + realtype out; + + switch (op) { + case 1: MPI_Allreduce(&d, &out, 1, PVEC_REAL_MPI_TYPE, MPI_SUM, comm); + break; + + case 2: MPI_Allreduce(&d, &out, 1, PVEC_REAL_MPI_TYPE, MPI_MAX, comm); + break; + + case 3: MPI_Allreduce(&d, &out, 1, PVEC_REAL_MPI_TYPE, MPI_MIN, comm); + break; + + default: break; + } + + return(out); +} + +static void VCopy_Parallel(N_Vector x, N_Vector z) +{ + long int i, N; + realtype *xd, *zd; + + xd = zd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + zd = NV_DATA_P(z); + + for (i = 0; i < N; i++) + zd[i] = xd[i]; + + return; +} + +static void VSum_Parallel(N_Vector x, N_Vector y, N_Vector z) +{ + long int i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + yd = NV_DATA_P(y); + zd = NV_DATA_P(z); + + for (i = 0; i < N; i++) + zd[i] = xd[i]+yd[i]; + + return; +} + +static void VDiff_Parallel(N_Vector x, N_Vector y, N_Vector z) +{ + long int i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + yd = NV_DATA_P(y); + zd = NV_DATA_P(z); + + for (i = 0; i < N; i++) + zd[i] = xd[i]-yd[i]; + + return; +} + +static void VNeg_Parallel(N_Vector x, N_Vector z) +{ + long int i, N; + realtype *xd, *zd; + + xd = zd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + zd = NV_DATA_P(z); + + for (i = 0; i < N; i++) + zd[i] = -xd[i]; + + return; +} + +static void VScaleSum_Parallel(realtype c, N_Vector x, N_Vector y, N_Vector z) +{ + long int i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + yd = NV_DATA_P(y); + zd = NV_DATA_P(z); + + for (i = 0; i < N; i++) + zd[i] = c*(xd[i]+yd[i]); + + return; +} + +static void VScaleDiff_Parallel(realtype c, N_Vector x, N_Vector y, N_Vector z) +{ + long int i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + yd = NV_DATA_P(y); + zd = NV_DATA_P(z); + + for (i = 0; i < N; i++) + zd[i] = c*(xd[i]-yd[i]); + + return; +} + +static void VLin1_Parallel(realtype a, N_Vector x, N_Vector y, N_Vector z) +{ + long int i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + yd = NV_DATA_P(y); + zd = NV_DATA_P(z); + + for (i = 0; i < N; i++) + zd[i] = (a*xd[i])+yd[i]; + + return; +} + +static void VLin2_Parallel(realtype a, N_Vector x, N_Vector y, N_Vector z) +{ + long int i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + yd = NV_DATA_P(y); + zd = NV_DATA_P(z); + + for (i = 0; i < N; i++) + zd[i] = (a*xd[i])-yd[i]; + + return; +} + +static void Vaxpy_Parallel(realtype a, N_Vector x, N_Vector y) +{ + long int i, N; + realtype *xd, *yd; + + xd = yd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + yd = NV_DATA_P(y); + + if (a == ONE) { + for (i = 0; i < N; i++) + yd[i] += xd[i]; + return; + } + + if (a == -ONE) { + for (i = 0; i < N; i++) + yd[i] -= xd[i]; + return; + } + + for (i = 0; i < N; i++) + yd[i] += a*xd[i]; + + return; +} + +static void VScaleBy_Parallel(realtype a, N_Vector x) +{ + long int i, N; + realtype *xd; + + xd = NULL; + + N = NV_LOCLENGTH_P(x); + xd = NV_DATA_P(x); + + for (i = 0; i < N; i++) + xd[i] *= a; + + return; +} diff --git a/odemex/Parser/CVode/ida_src/src/nvec_ser/CMakeLists.txt b/odemex/Parser/CVode/ida_src/src/nvec_ser/CMakeLists.txt new file mode 100644 index 0000000..9c97be5 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/nvec_ser/CMakeLists.txt @@ -0,0 +1,82 @@ +# --------------------------------------------------------------- +# $Revision: 1.3 $ +# $Date: 2009/02/17 02:58:48 $ +# --------------------------------------------------------------- +# Programmer: Radu Serban @ LLNL +# --------------------------------------------------------------- +# Copyright (c) 2007, The Regents of the University of California. +# Produced at the Lawrence Livermore National Laboratory. +# All rights reserved. +# For details, see the LICENSE file. +# --------------------------------------------------------------- +# CMakeLists.txt file for the serial NVECTOR library + +INSTALL(CODE "MESSAGE(\"\nInstall NVECTOR_SERIAL\n\")") + +# Add variable nvecserial_SOURCES with the sources for the NVECSERIAL lib +SET(nvecserial_SOURCES nvector_serial.c) + +# Add variable shared_SOURCES with the common SUNDIALS sources which will +# also be included in the NVECSERIAL library +SET(shared_SOURCES sundials_math.c) +ADD_PREFIX(${sundials_SOURCE_DIR}/src/sundials/ shared_SOURCES) + +# Add variable nvecserial_HEADERS with the exported NVECSERIAL header files +SET(nvecserial_HEADERS nvector_serial.h) +ADD_PREFIX(${sundials_SOURCE_DIR}/include/nvector/ nvecserial_HEADERS) + +# Add source directory to include directories +INCLUDE_DIRECTORIES(.) + +# Define C preprocessor flag -DBUILD_SUNDIALS_LIBRARY +ADD_DEFINITIONS(-DBUILD_SUNDIALS_LIBRARY) + +# Rules for building and installing the static library: +# - Add the build target for the NVECSERIAL library +# - Set the library name and make sure it is not deleted +# - Install the NVECSERIAL library +IF(BUILD_STATIC_LIBS) + ADD_LIBRARY(sundials_nvecserial_static STATIC ${nvecserial_SOURCES} ${shared_SOURCES}) + SET_TARGET_PROPERTIES(sundials_nvecserial_static + PROPERTIES OUTPUT_NAME sundials_nvecserial CLEAN_DIRECT_OUTPUT 1) + INSTALL(TARGETS sundials_nvecserial_static DESTINATION lib) +ENDIF(BUILD_STATIC_LIBS) + +# Rules for building and installing the shared library: +# - Add the build target for the NVECSERIAL library +# - Set the library name and make sure it is not deleted +# - Set VERSION and SOVERSION for shared libraries +# - Install the NVECSERIAL library +IF(BUILD_SHARED_LIBS) + ADD_LIBRARY(sundials_nvecserial_shared SHARED ${nvecserial_SOURCES} ${shared_SOURCES}) + SET_TARGET_PROPERTIES(sundials_nvecserial_shared + PROPERTIES OUTPUT_NAME sundials_nvecserial CLEAN_DIRECT_OUTPUT 1) + SET_TARGET_PROPERTIES(sundials_nvecserial_shared + PROPERTIES VERSION ${nveclib_VERSION} SOVERSION ${nveclib_SOVERSION}) + INSTALL(TARGETS sundials_nvecserial_shared DESTINATION lib) +ENDIF(BUILD_SHARED_LIBS) + +# Install the NVECSERIAL header files +INSTALL(FILES ${nvecserial_HEADERS} DESTINATION include/nvector) + +# If FCMIX is enabled, build and install the FNVECSERIAL library +IF(FCMIX_ENABLE AND F77_FOUND) + SET(fnvecserial_SOURCES fnvector_serial.c) + IF(BUILD_STATIC_LIBS) + ADD_LIBRARY(sundials_fnvecserial_static STATIC ${fnvecserial_SOURCES}) + SET_TARGET_PROPERTIES(sundials_fnvecserial_static + PROPERTIES OUTPUT_NAME sundials_fnvecserial CLEAN_DIRECT_OUTPUT 1) + INSTALL(TARGETS sundials_fnvecserial_static DESTINATION lib) + ENDIF(BUILD_STATIC_LIBS) + IF(BUILD_SHARED_LIBS) + ADD_LIBRARY(sundials_fnvecserial_shared ${fnvecserial_SOURCES}) + SET_TARGET_PROPERTIES(sundials_fnvecserial_shared + PROPERTIES OUTPUT_NAME sundials_fnvecserial CLEAN_DIRECT_OUTPUT 1) + SET_TARGET_PROPERTIES(sundials_fnvecserial_shared + PROPERTIES VERSION ${nveclib_VERSION} SOVERSION ${nveclib_SOVERSION}) + INSTALL(TARGETS sundials_fnvecserial_shared DESTINATION lib) + ENDIF(BUILD_SHARED_LIBS) +ENDIF(FCMIX_ENABLE AND F77_FOUND) + +# +MESSAGE(STATUS "Added NVECTOR_SERIAL module") diff --git a/odemex/Parser/CVode/ida_src/src/nvec_ser/Makefile.in b/odemex/Parser/CVode/ida_src/src/nvec_ser/Makefile.in new file mode 100644 index 0000000..fe8a6dc --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/nvec_ser/Makefile.in @@ -0,0 +1,125 @@ +# ----------------------------------------------------------------- +# $Revision: 1.8 $ +# $Date: 2007/01/29 17:36:28 $ +# ----------------------------------------------------------------- +# Programmer(s): Radu Serban and Aaron Collier @ LLNL +# ----------------------------------------------------------------- +# Copyright (c) 2002, The Regents of the University of California. +# Produced at the Lawrence Livermore National Laboratory. +# All rights reserved. +# For details, see the LICENSE file. +# ----------------------------------------------------------------- +# Makefile for serial NVECTOR module +# +# @configure_input@ +# ----------------------------------------------------------------- + +SHELL = @SHELL@ + +@SET_MAKE@ + +srcdir = @srcdir@ +builddir = @builddir@ +abs_builddir = @abs_builddir@ +top_builddir = @top_builddir@ +prefix = @prefix@ +exec_prefix = @exec_prefix@ +includedir = @includedir@ +libdir = @libdir@ + +INSTALL = @INSTALL@ +INSTALL_LIB = @INSTALL_PROGRAM@ +INSTALL_HEADER = @INSTALL_DATA@ + +LIBTOOL = @LIBTOOL@ +LIBTOOL_DEPS = @LIBTOOL_DEPS@ + +CPP = @CPP@ +CPPFLAGS = @CPPFLAGS@ +CC = @CC@ +CFLAGS = @CFLAGS@ +LDFLAGS = @LDFLAGS@ +LIBS = @LIBS@ + +FCMIX_ENABLED = @FCMIX_ENABLED@ + +top_srcdir = $(srcdir)/../.. + +INCLUDES = -I$(top_srcdir)/include -I$(top_builddir)/include + +LIB_REVISION = 0:2:0 + +NVECSER_LIB = libsundials_nvecserial.la +NVECSER_LIB_FILES = nvector_serial.lo + +FNVECSER_LIB = libsundials_fnvecserial.la +FNVECSER_LIB_FILES = fnvector_serial.lo + +SHARED_LIB_FILES = $(top_builddir)/src/sundials/sundials_math.lo + +mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs +rminstalldirs = $(SHELL) $(top_srcdir)/config/rminstalldirs + +all: $(NVECSER_LIB) $(FNVECSER_LIB) + +$(NVECSER_LIB): shared $(NVECSER_LIB_FILES) + $(LIBTOOL) --mode=link $(CC) $(CFLAGS) -o $(NVECSER_LIB) $(NVECSER_LIB_FILES) $(SHARED_LIB_FILES) -rpath $(libdir) $(LDFLAGS) $(LIBS) -version-info $(LIB_REVISION) + +$(FNVECSER_LIB): $(FNVECSER_LIB_FILES) + @if test "X${FCMIX_ENABLED}" = "Xyes"; then \ + echo "${LIBTOOL} --mode=link ${CC} ${CFLAGS} -o ${FNVECSER_LIB} ${FNVECSER_LIB_FILES} ${SHARED_LIB_FILES} -rpath ${libdir} $(LDFLAGS) ${LIBS} -version-info ${LIB_REVISION}" ; \ + ${LIBTOOL} --mode=link ${CC} ${CFLAGS} -o ${FNVECSER_LIB} ${FNVECSER_LIB_FILES} ${SHARED_LIB_FILES} -rpath ${libdir} $(LDFLAGS) ${LIBS} -version-info ${LIB_REVISION} ; \ + fi + +install: $(NVECSER_LIB) $(FNVECSER_LIB) + $(mkinstalldirs) $(includedir)/nvector + $(mkinstalldirs) $(libdir) + $(LIBTOOL) --mode=install $(INSTALL_LIB) $(NVECSER_LIB) $(libdir) + $(INSTALL_HEADER) $(top_srcdir)/include/nvector/nvector_serial.h $(includedir)/nvector/ + @if test "X${FCMIX_ENABLED}" = "Xyes"; then \ + echo "${LIBTOOL} --mode=install ${INSTALL_LIB} ${FNVECSER_LIB} ${libdir}" ; \ + ${LIBTOOL} --mode=install ${INSTALL_LIB} ${FNVECSER_LIB} ${libdir} ; \ + fi + +uninstall: + $(LIBTOOL) --mode=uninstall rm -f $(libdir)/$(NVECSER_LIB) + @if test "X${FCMIX_ENABLED}" = "Xyes"; then \ + echo "${LIBTOOL} --mode=uninstall rm -f ${libdir}/${FNVECSER_LIB}" ; \ + ${LIBTOOL} --mode=uninstall rm -f ${libdir}/${FNVECSER_LIB} ; \ + fi + rm -f $(includedir)/nvector/nvector_serial.h + $(rminstalldirs) ${includedir}/nvector + +shared: + @cd ${top_builddir}/src/sundials ; \ + ${MAKE} ; \ + cd ${abs_builddir} + +clean: + $(LIBTOOL) --mode=clean rm -f $(NVECSER_LIB) + rm -f $(NVECSER_LIB_FILES) + rm -f nvector_serial.o + @if test "X${FCMIX_ENABLED}" = "Xyes"; then \ + echo "${LIBTOOL} --mode=clean rm -f ${FNVECSER_LIB}" ; \ + ${LIBTOOL} --mode=clean rm -f ${FNVECSER_LIB} ; \ + echo "rm -f ${FNVECSER_LIB_FILES}" ; \ + rm -f ${FNVECSER_LIB_FILES} ; \ + echo "rm -f fnvector_serial.o" ; \ + rm -f fnvector_serial.o ; \ + fi + +distclean: clean + rm -f Makefile + +nvector_serial.lo: $(srcdir)/nvector_serial.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/nvector_serial.c +fnvector_serial.lo: $(srcdir)/fnvector_serial.c + @if test "X${FCMIX_ENABLED}" = "Xyes"; then \ + echo "${LIBTOOL} --mode=compile ${CC} ${CPPFLAGS} $(INCLUDES) ${CFLAGS} -c ${srcdir}/fnvector_serial.c" ; \ + ${LIBTOOL} --mode=compile ${CC} ${CPPFLAGS} $(INCLUDES) ${CFLAGS} -c ${srcdir}/fnvector_serial.c ; \ + fi + +libtool: $(top_builddir)/$(LIBTOOL_DEPS) + @cd ${top_builddir} ; \ + ${SHELL} ./config.status --recheck ; \ + cd ${abs_builddir} diff --git a/odemex/Parser/CVode/ida_src/src/nvec_ser/README b/odemex/Parser/CVode/ida_src/src/nvec_ser/README new file mode 100644 index 0000000..03b7ee5 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/nvec_ser/README @@ -0,0 +1,131 @@ + NVECTOR_SERIAL + Release 2.4.0, January 2008 + +Serial implementation of the NVECTOR module for SUNDIALS. + +NVECTOR_SERIAL defines the content field of N_Vector to be a structure +containing the length of the vector, a pointer to the beginning of a +contiguous data array, and a boolean flag indicating ownership of the +data array. + +NVECTOR_SERIAL defines five macros to provide access to the content of +a serial N_Vector, several constructors for variables of type N_Vector, +a constructor for an array of variables of type N_Vector, and destructors +for N_Vector and N_Vector array. + +NVECTOR_SERIAL provides implementations for all vector operations defined +by the generic NVECTOR module in the table of operations. + + +A. Documentation +---------------- + +The serial NVECTOR implementation is fully described in the user documentation +for any of the SUNDIALS solvers [1-5]. A PDF file for the user guide for a +particular solver is available in the solver's subdirectory under doc/. + + +B. Installation +--------------- + +For basic installation instructions see /sundials/INSTALL_NOTES. +For complete installation instructions see any of the user guides. + + +C. References +------------- + +[1] A. C. Hindmarsh and R. Serban, "User Documentation for CVODE v2.4.0," + LLLNL technical report UCRL-MA-208108, November 2004. + +[2] A. C. Hindmarsh and R. Serban, "User Documentation for CVODES v2.4.0," + LLNL technical report UCRL-MA-208111, November 2004. + +[3] A. C. Hindmarsh and R. Serban, "User Documentation for IDA v2.4.0," + LLNL technical report UCRL-MA-208112, November 2004. + +[4] R. Serban and C. Petra, "User Documentation for IDAS v1.0.0," + LLNL technical report UCRL-SM-234051, August 2007. + +[5] A. M. Collier, A. C. Hindmarsh, R. Serban,and C. S. Woodward, "User + Documentation for KINSOL v2.4.0," LLNL technical report UCRL-MA-208116, + November 2004. + + +D. Releases +----------- + +v. 2.4.0 - Jan. 2008 +v. 2.3.0 - Nov. 2006 +v. 2.2.0 - Mar. 2006 +v. 2.1.1 - May. 2005 +v. 2.1.0 - Apr. 2005 +v. 2.0.2 - Mar. 2005 +v. 2.0.1 - Jan. 2005 +v. 2.0 - Dec. 2004 +v. 1.0 - Jul. 2002 (first SUNDIALS release) + + +E. Revision History +------------------- + +v. 2.3.0 (Nov. 2006) ---> v. 2.4.0 (Jan. 2008) +--------------------------------------------------------- + +- none + + +v. 2.2.0 (Mar. 2006) ---> v. 2.3.0 (Nov. 2006) +---------------------------------------------- + +- Changes related to the build system + - reorganized source tree. Header files in ${srcdir}/include/nvector; + sources in ${srcdir}/src/nvec_ser + - exported header files in ${includedir}/sundials + + +v. 2.1.1 (May. 2005) ---> v. 2.2.0 (Mar. 2006) +---------------------------------------------- + +- none + +v. 2.1.0 (Apr. 2005) ---> v. 2.1.1 (May. 2005) +---------------------------------------------- + +- Changes to data structures + - added N_VCloneEmpty to global vector operations table + +v. 2.0.2 (Mar. 2005) ---> v. 2.1.0 (Apr. 2005) +---------------------------------------------- + +- none + +v. 2.0.1 (Jan. 2005) ---> v. 2.0.2 (Mar. 2005) +---------------------------------------------- + +- Changes related to the build system + - fixed autoconf-related bug to allow configuration with the PGI Fortran compiler + - modified to use customized detection of the Fortran name mangling scheme + (autoconf's AC_F77_WRAPPERS routine is problematic on some platforms) + - added --with-mpi-flags as a configure option to allow user to specify + MPI-specific flags + - updated Makefiles for Fortran examples to avoid C++ compiler errors (now use + CC and MPICC to link) + +v. 2.0 (Dec. 2004) ---> v. 2.0.1 (Jan. 2005) +-------------------------------------------- + +- Changes related to the build system + - changed order of compiler directives in header files to avoid compilation + errors when using a C++ compiler. + +v. 1.0 (Jul. 2002) ---> v. 2.0 (Dec. 2004) +------------------------------------------ + +- Revised to correspond to new generic NVECTOR module + (see sundials/shared/README). +- Extended the list of user-callable functions provided by NVECTOR_SERIAL + outside the table of vector operations. +- Revised the F/C interface to use underscore flags for name mapping + and to use precision flag from configure. +- Revised F/C routine NVECTOR names for uniformity. diff --git a/odemex/Parser/CVode/ida_src/src/nvec_ser/fnvector_serial.c b/odemex/Parser/CVode/ida_src/src/nvec_ser/fnvector_serial.c new file mode 100644 index 0000000..8f83c80 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/nvec_ser/fnvector_serial.c @@ -0,0 +1,147 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.1 $ + * $Date: 2006/07/05 15:32:37 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This file (companion of nvector_serial.h) contains the + * implementation needed for the Fortran initialization of serial + * vector operations. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include "fnvector_serial.h" + +/* Define global vector variables */ + +N_Vector F2C_CVODE_vec; +N_Vector F2C_CVODE_vecQ; +N_Vector *F2C_CVODE_vecS; +N_Vector F2C_CVODE_vecB; +N_Vector F2C_CVODE_vecQB; + +N_Vector F2C_IDA_vec; +N_Vector F2C_IDA_vecQ; +N_Vector *F2C_IDA_vecS; +N_Vector F2C_IDA_vecB; +N_Vector F2C_IDA_vecQB; + +N_Vector F2C_KINSOL_vec; + +/* Fortran callable interfaces */ + +void FNV_INITS(int *code, long int *N, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + F2C_CVODE_vec = NULL; + F2C_CVODE_vec = N_VNewEmpty_Serial(*N); + if (F2C_CVODE_vec == NULL) *ier = -1; + break; + case FCMIX_IDA: + F2C_IDA_vec = NULL; + F2C_IDA_vec = N_VNewEmpty_Serial(*N); + if (F2C_IDA_vec == NULL) *ier = -1; + break; + case FCMIX_KINSOL: + F2C_KINSOL_vec = NULL; + F2C_KINSOL_vec = N_VNewEmpty_Serial(*N); + if (F2C_KINSOL_vec == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + +void FNV_INITS_Q(int *code, long int *Nq, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + F2C_CVODE_vecQ = NULL; + F2C_CVODE_vecQ = N_VNewEmpty_Serial(*Nq); + if (F2C_CVODE_vecQ == NULL) *ier = -1; + break; + case FCMIX_IDA: + F2C_IDA_vecQ = NULL; + F2C_IDA_vecQ = N_VNewEmpty_Serial(*Nq); + if (F2C_IDA_vecQ == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + +void FNV_INITS_B(int *code, long int *NB, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + F2C_CVODE_vecB = NULL; + F2C_CVODE_vecB = N_VNewEmpty_Serial(*NB); + if (F2C_CVODE_vecB == NULL) *ier = -1; + break; + case FCMIX_IDA: + F2C_IDA_vecB = NULL; + F2C_IDA_vecB = N_VNewEmpty_Serial(*NB); + if (F2C_IDA_vecB == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + +void FNV_INITS_QB(int *code, long int *NqB, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + F2C_CVODE_vecQB = NULL; + F2C_CVODE_vecQB = N_VNewEmpty_Serial(*NqB); + if (F2C_CVODE_vecQB == NULL) *ier = -1; + break; + case FCMIX_IDA: + F2C_IDA_vecQB = NULL; + F2C_IDA_vecQB = N_VNewEmpty_Serial(*NqB); + if (F2C_IDA_vecQB == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + +void FNV_INITS_S(int *code, int *Ns, int *ier) +{ + *ier = 0; + + switch(*code) { + case FCMIX_CVODE: + F2C_CVODE_vecS = NULL; + F2C_CVODE_vecS = (N_Vector *) N_VCloneVectorArrayEmpty_Serial(*Ns, F2C_CVODE_vec); + if (F2C_CVODE_vecS == NULL) *ier = -1; + break; + case FCMIX_IDA: + F2C_IDA_vecS = NULL; + F2C_IDA_vecS = (N_Vector *) N_VCloneVectorArrayEmpty_Serial(*Ns, F2C_IDA_vec); + if (F2C_IDA_vecS == NULL) *ier = -1; + break; + default: + *ier = -1; + } +} + + diff --git a/odemex/Parser/CVode/ida_src/src/nvec_ser/fnvector_serial.h b/odemex/Parser/CVode/ida_src/src/nvec_ser/fnvector_serial.h new file mode 100644 index 0000000..2642337 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/nvec_ser/fnvector_serial.h @@ -0,0 +1,84 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.3 $ + * $Date: 2006/11/29 00:05:09 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This file (companion of nvector_serial.h) contains the + * definitions needed for the initialization of serial + * vector operations in Fortran. + * ----------------------------------------------------------------- + */ + +#ifndef _FNVECTOR_SERIAL_H +#define _FNVECTOR_SERIAL_H + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#include +#include + +#if defined(F77_FUNC) + +#define FNV_INITS F77_FUNC(fnvinits, FNVINITS) +#define FNV_INITS_Q F77_FUNC_(fnvinits_q, FNVINITS_Q) +#define FNV_INITS_S F77_FUNC_(fnvinits_s, FNVINITS_S) +#define FNV_INITS_B F77_FUNC_(fnvinits_b, FNVINITS_B) +#define FNV_INITS_QB F77_FUNC_(fnvinits_qb, FNVINITS_QB) + +#else + +#define FNV_INITS fnvinits_ +#define FNV_INITS_Q fnvinits_q_ +#define FNV_INITS_S fnvinits_s_ +#define FNV_INITS_B fnvinits_b_ +#define FNV_INITS_QB fnvinits_qb_ + +#endif + +/* Declarations of global variables */ + +extern N_Vector F2C_CVODE_vec; +extern N_Vector F2C_CVODE_vecQ; +extern N_Vector *F2C_CVODE_vecS; +extern N_Vector F2C_CVODE_vecB; +extern N_Vector F2C_CVODE_vecQB; + +extern N_Vector F2C_IDA_vec; +extern N_Vector F2C_IDA_vecQ; +extern N_Vector *F2C_IDA_vecS; +extern N_Vector F2C_IDA_vecB; +extern N_Vector F2C_IDA_vecQB; + +extern N_Vector F2C_KINSOL_vec; + +/* + * Prototypes of exported functions + * + * FNV_INITS - initializes serial vector operations for main problem + * FNV_INITS_Q - initializes serial vector operations for quadratures + * FNV_INITS_S - initializes serial vector operations for sensitivities + * FNV_INITS_B - initializes serial vector operations for adjoint problem + * FNV_INITS_QB - initializes serial vector operations for adjoint quadratures + * + */ + +void FNV_INITS(int *code, long int *neq, int *ier); +void FNV_INITS_Q(int *code, long int *Nq, int *ier); +void FNV_INITS_S(int *code, int *Ns, int *ier); +void FNV_INITS_B(int *code, long int *NB, int *ier); +void FNV_INITS_QB(int *code, long int *NqB, int *ier); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/odemex/Parser/CVode/ida_src/src/nvec_ser/nvector_serial.c b/odemex/Parser/CVode/ida_src/src/nvec_ser/nvector_serial.c new file mode 100644 index 0000000..c890253 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/nvec_ser/nvector_serial.c @@ -0,0 +1,1034 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.1 $ + * $Date: 2006/07/05 15:32:37 $ + * ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, Radu Serban, + * and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for a serial implementation + * of the NVECTOR package. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include +#include + +#define ZERO RCONST(0.0) +#define HALF RCONST(0.5) +#define ONE RCONST(1.0) +#define ONEPT5 RCONST(1.5) + +/* Private function prototypes */ +/* z=x */ +static void VCopy_Serial(N_Vector x, N_Vector z); +/* z=x+y */ +static void VSum_Serial(N_Vector x, N_Vector y, N_Vector z); +/* z=x-y */ +static void VDiff_Serial(N_Vector x, N_Vector y, N_Vector z); +/* z=-x */ +static void VNeg_Serial(N_Vector x, N_Vector z); +/* z=c(x+y) */ +static void VScaleSum_Serial(realtype c, N_Vector x, N_Vector y, N_Vector z); +/* z=c(x-y) */ +static void VScaleDiff_Serial(realtype c, N_Vector x, N_Vector y, N_Vector z); +/* z=ax+y */ +static void VLin1_Serial(realtype a, N_Vector x, N_Vector y, N_Vector z); +/* z=ax-y */ +static void VLin2_Serial(realtype a, N_Vector x, N_Vector y, N_Vector z); +/* y <- ax+y */ +static void Vaxpy_Serial(realtype a, N_Vector x, N_Vector y); +/* x <- ax */ +static void VScaleBy_Serial(realtype a, N_Vector x); + +/* + * ----------------------------------------------------------------- + * exported functions + * ----------------------------------------------------------------- + */ + +/* ---------------------------------------------------------------------------- + * Function to create a new empty serial vector + */ + +N_Vector N_VNewEmpty_Serial(long int length) +{ + N_Vector v; + N_Vector_Ops ops; + N_VectorContent_Serial content; + + /* Create vector */ + v = NULL; + v = (N_Vector) malloc(sizeof *v); + if (v == NULL) return(NULL); + + /* Create vector operation structure */ + ops = NULL; + ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); + if (ops == NULL) { free(v); return(NULL); } + + ops->nvclone = N_VClone_Serial; + ops->nvcloneempty = N_VCloneEmpty_Serial; + ops->nvdestroy = N_VDestroy_Serial; + ops->nvspace = N_VSpace_Serial; + ops->nvgetarraypointer = N_VGetArrayPointer_Serial; + ops->nvsetarraypointer = N_VSetArrayPointer_Serial; + ops->nvlinearsum = N_VLinearSum_Serial; + ops->nvconst = N_VConst_Serial; + ops->nvprod = N_VProd_Serial; + ops->nvdiv = N_VDiv_Serial; + ops->nvscale = N_VScale_Serial; + ops->nvabs = N_VAbs_Serial; + ops->nvinv = N_VInv_Serial; + ops->nvaddconst = N_VAddConst_Serial; + ops->nvdotprod = N_VDotProd_Serial; + ops->nvmaxnorm = N_VMaxNorm_Serial; + ops->nvwrmsnormmask = N_VWrmsNormMask_Serial; + ops->nvwrmsnorm = N_VWrmsNorm_Serial; + ops->nvmin = N_VMin_Serial; + ops->nvwl2norm = N_VWL2Norm_Serial; + ops->nvl1norm = N_VL1Norm_Serial; + ops->nvcompare = N_VCompare_Serial; + ops->nvinvtest = N_VInvTest_Serial; + ops->nvconstrmask = N_VConstrMask_Serial; + ops->nvminquotient = N_VMinQuotient_Serial; + + /* Create content */ + content = NULL; + content = (N_VectorContent_Serial) malloc(sizeof(struct _N_VectorContent_Serial)); + if (content == NULL) { free(ops); free(v); return(NULL); } + + content->length = length; + content->own_data = FALSE; + content->data = NULL; + + /* Attach content and ops */ + v->content = content; + v->ops = ops; + + return(v); +} + +/* ---------------------------------------------------------------------------- + * Function to create a new serial vector + */ + +N_Vector N_VNew_Serial(long int length) +{ + N_Vector v; + realtype *data; + + v = NULL; + v = N_VNewEmpty_Serial(length); + if (v == NULL) return(NULL); + + /* Create data */ + if (length > 0) { + + /* Allocate memory */ + data = NULL; + data = (realtype *) malloc(length * sizeof(realtype)); + if(data == NULL) { N_VDestroy_Serial(v); return(NULL); } + + /* Attach data */ + NV_OWN_DATA_S(v) = TRUE; + NV_DATA_S(v) = data; + + } + + return(v); +} + +/* ---------------------------------------------------------------------------- + * Function to create a serial N_Vector with user data component + */ + +N_Vector N_VMake_Serial(long int length, realtype *v_data) +{ + N_Vector v; + + v = NULL; + v = N_VNewEmpty_Serial(length); + if (v == NULL) return(NULL); + + if (length > 0) { + /* Attach data */ + NV_OWN_DATA_S(v) = FALSE; + NV_DATA_S(v) = v_data; + } + + return(v); +} + +/* ---------------------------------------------------------------------------- + * Function to create an array of new serial vectors. + */ + +N_Vector *N_VCloneVectorArray_Serial(int count, N_Vector w) +{ + N_Vector *vs; + int j; + + if (count <= 0) return(NULL); + + vs = NULL; + vs = (N_Vector *) malloc(count * sizeof(N_Vector)); + if(vs == NULL) return(NULL); + + for (j = 0; j < count; j++) { + vs[j] = NULL; + vs[j] = N_VClone_Serial(w); + if (vs[j] == NULL) { + N_VDestroyVectorArray_Serial(vs, j-1); + return(NULL); + } + } + + return(vs); +} + +/* ---------------------------------------------------------------------------- + * Function to create an array of new serial vectors with NULL data array. + */ + +N_Vector *N_VCloneVectorArrayEmpty_Serial(int count, N_Vector w) +{ + N_Vector *vs; + int j; + + if (count <= 0) return(NULL); + + vs = NULL; + vs = (N_Vector *) malloc(count * sizeof(N_Vector)); + if(vs == NULL) return(NULL); + + for (j = 0; j < count; j++) { + vs[j] = NULL; + vs[j] = N_VCloneEmpty_Serial(w); + if (vs[j] == NULL) { + N_VDestroyVectorArray_Serial(vs, j-1); + return(NULL); + } + } + + return(vs); +} + +/* ---------------------------------------------------------------------------- + * Function to free an array created with N_VCloneVectorArray_Serial + */ + +void N_VDestroyVectorArray_Serial(N_Vector *vs, int count) +{ + int j; + + for (j = 0; j < count; j++) N_VDestroy_Serial(vs[j]); + + free(vs); vs = NULL; + + return; +} + +/* ---------------------------------------------------------------------------- + * Function to print the a serial vector + */ + +void N_VPrint_Serial(N_Vector x) +{ + long int i, N; + realtype *xd; + + xd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + + for (i = 0; i < N; i++) { +#if defined(SUNDIALS_EXTENDED_PRECISION) + printf("%11.8Lg\n", xd[i]); +#elif defined(SUNDIALS_DOUBLE_PRECISION) + printf("%11.8lg\n", xd[i]); +#else + printf("%11.8g\n", xd[i]); +#endif + } + printf("\n"); + + return; +} + +/* + * ----------------------------------------------------------------- + * implementation of vector operations + * ----------------------------------------------------------------- + */ + +N_Vector N_VCloneEmpty_Serial(N_Vector w) +{ + N_Vector v; + N_Vector_Ops ops; + N_VectorContent_Serial content; + + if (w == NULL) return(NULL); + + /* Create vector */ + v = NULL; + v = (N_Vector) malloc(sizeof *v); + if (v == NULL) return(NULL); + + /* Create vector operation structure */ + ops = NULL; + ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); + if (ops == NULL) { free(v); return(NULL); } + + ops->nvclone = w->ops->nvclone; + ops->nvcloneempty = w->ops->nvcloneempty; + ops->nvdestroy = w->ops->nvdestroy; + ops->nvspace = w->ops->nvspace; + ops->nvgetarraypointer = w->ops->nvgetarraypointer; + ops->nvsetarraypointer = w->ops->nvsetarraypointer; + ops->nvlinearsum = w->ops->nvlinearsum; + ops->nvconst = w->ops->nvconst; + ops->nvprod = w->ops->nvprod; + ops->nvdiv = w->ops->nvdiv; + ops->nvscale = w->ops->nvscale; + ops->nvabs = w->ops->nvabs; + ops->nvinv = w->ops->nvinv; + ops->nvaddconst = w->ops->nvaddconst; + ops->nvdotprod = w->ops->nvdotprod; + ops->nvmaxnorm = w->ops->nvmaxnorm; + ops->nvwrmsnormmask = w->ops->nvwrmsnormmask; + ops->nvwrmsnorm = w->ops->nvwrmsnorm; + ops->nvmin = w->ops->nvmin; + ops->nvwl2norm = w->ops->nvwl2norm; + ops->nvl1norm = w->ops->nvl1norm; + ops->nvcompare = w->ops->nvcompare; + ops->nvinvtest = w->ops->nvinvtest; + ops->nvconstrmask = w->ops->nvconstrmask; + ops->nvminquotient = w->ops->nvminquotient; + + /* Create content */ + content = NULL; + content = (N_VectorContent_Serial) malloc(sizeof(struct _N_VectorContent_Serial)); + if (content == NULL) { free(ops); free(v); return(NULL); } + + content->length = NV_LENGTH_S(w); + content->own_data = FALSE; + content->data = NULL; + + /* Attach content and ops */ + v->content = content; + v->ops = ops; + + return(v); +} + +N_Vector N_VClone_Serial(N_Vector w) +{ + N_Vector v; + realtype *data; + long int length; + + v = NULL; + v = N_VCloneEmpty_Serial(w); + if (v == NULL) return(NULL); + + length = NV_LENGTH_S(w); + + /* Create data */ + if (length > 0) { + + /* Allocate memory */ + data = NULL; + data = (realtype *) malloc(length * sizeof(realtype)); + if(data == NULL) { N_VDestroy_Serial(v); return(NULL); } + + /* Attach data */ + NV_OWN_DATA_S(v) = TRUE; + NV_DATA_S(v) = data; + + } + + return(v); +} + +void N_VDestroy_Serial(N_Vector v) +{ + if (NV_OWN_DATA_S(v) == TRUE) { + free(NV_DATA_S(v)); + NV_DATA_S(v) = NULL; + } + free(v->content); v->content = NULL; + free(v->ops); v->ops = NULL; + free(v); v = NULL; + + return; +} + +void N_VSpace_Serial(N_Vector v, long int *lrw, long int *liw) +{ + *lrw = NV_LENGTH_S(v); + *liw = 1; + + return; +} + +realtype *N_VGetArrayPointer_Serial(N_Vector v) +{ + return((realtype *) NV_DATA_S(v)); +} + +void N_VSetArrayPointer_Serial(realtype *v_data, N_Vector v) +{ + if (NV_LENGTH_S(v) > 0) NV_DATA_S(v) = v_data; + + return; +} + +void N_VLinearSum_Serial(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z) +{ + long int i, N; + realtype c, *xd, *yd, *zd; + N_Vector v1, v2; + booleantype test; + + xd = yd = zd = NULL; + + if ((b == ONE) && (z == y)) { /* BLAS usage: axpy y <- ax+y */ + Vaxpy_Serial(a,x,y); + return; + } + + if ((a == ONE) && (z == x)) { /* BLAS usage: axpy x <- by+x */ + Vaxpy_Serial(b,y,x); + return; + } + + /* Case: a == b == 1.0 */ + + if ((a == ONE) && (b == ONE)) { + VSum_Serial(x, y, z); + return; + } + + /* Cases: (1) a == 1.0, b = -1.0, (2) a == -1.0, b == 1.0 */ + + if ((test = ((a == ONE) && (b == -ONE))) || ((a == -ONE) && (b == ONE))) { + v1 = test ? y : x; + v2 = test ? x : y; + VDiff_Serial(v2, v1, z); + return; + } + + /* Cases: (1) a == 1.0, b == other or 0.0, (2) a == other or 0.0, b == 1.0 */ + /* if a or b is 0.0, then user should have called N_VScale */ + + if ((test = (a == ONE)) || (b == ONE)) { + c = test ? b : a; + v1 = test ? y : x; + v2 = test ? x : y; + VLin1_Serial(c, v1, v2, z); + return; + } + + /* Cases: (1) a == -1.0, b != 1.0, (2) a != 1.0, b == -1.0 */ + + if ((test = (a == -ONE)) || (b == -ONE)) { + c = test ? b : a; + v1 = test ? y : x; + v2 = test ? x : y; + VLin2_Serial(c, v1, v2, z); + return; + } + + /* Case: a == b */ + /* catches case both a and b are 0.0 - user should have called N_VConst */ + + if (a == b) { + VScaleSum_Serial(a, x, y, z); + return; + } + + /* Case: a == -b */ + + if (a == -b) { + VScaleDiff_Serial(a, x, y, z); + return; + } + + /* Do all cases not handled above: + (1) a == other, b == 0.0 - user should have called N_VScale + (2) a == 0.0, b == other - user should have called N_VScale + (3) a,b == other, a !=b, a != -b */ + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + yd = NV_DATA_S(y); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) + zd[i] = (a*xd[i])+(b*yd[i]); + + return; +} + +void N_VConst_Serial(realtype c, N_Vector z) +{ + long int i, N; + realtype *zd; + + zd = NULL; + + N = NV_LENGTH_S(z); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) zd[i] = c; + + return; +} + +void N_VProd_Serial(N_Vector x, N_Vector y, N_Vector z) +{ + long int i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + yd = NV_DATA_S(y); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) + zd[i] = xd[i]*yd[i]; + + return; +} + +void N_VDiv_Serial(N_Vector x, N_Vector y, N_Vector z) +{ + long int i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + yd = NV_DATA_S(y); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) + zd[i] = xd[i]/yd[i]; + + return; +} + +void N_VScale_Serial(realtype c, N_Vector x, N_Vector z) +{ + long int i, N; + realtype *xd, *zd; + + xd = zd = NULL; + + if (z == x) { /* BLAS usage: scale x <- cx */ + VScaleBy_Serial(c, x); + return; + } + + if (c == ONE) { + VCopy_Serial(x, z); + } else if (c == -ONE) { + VNeg_Serial(x, z); + } else { + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + zd = NV_DATA_S(z); + for (i = 0; i < N; i++) + zd[i] = c*xd[i]; + } + + return; +} + +void N_VAbs_Serial(N_Vector x, N_Vector z) +{ + long int i, N; + realtype *xd, *zd; + + xd = zd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) + zd[i] = ABS(xd[i]); + + return; +} + +void N_VInv_Serial(N_Vector x, N_Vector z) +{ + long int i, N; + realtype *xd, *zd; + + xd = zd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) + zd[i] = ONE/xd[i]; + + return; +} + +void N_VAddConst_Serial(N_Vector x, realtype b, N_Vector z) +{ + long int i, N; + realtype *xd, *zd; + + xd = zd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) + zd[i] = xd[i]+b; + + return; +} + +realtype N_VDotProd_Serial(N_Vector x, N_Vector y) +{ + long int i, N; + realtype sum, *xd, *yd; + + sum = ZERO; + xd = yd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + yd = NV_DATA_S(y); + + for (i = 0; i < N; i++) + sum += xd[i]*yd[i]; + + return(sum); +} + +realtype N_VMaxNorm_Serial(N_Vector x) +{ + long int i, N; + realtype max, *xd; + + max = ZERO; + xd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + + for (i = 0; i < N; i++) { + if (ABS(xd[i]) > max) max = ABS(xd[i]); + } + + return(max); +} + +realtype N_VWrmsNorm_Serial(N_Vector x, N_Vector w) +{ + long int i, N; + realtype sum, prodi, *xd, *wd; + + sum = ZERO; + xd = wd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + wd = NV_DATA_S(w); + + for (i = 0; i < N; i++) { + prodi = xd[i]*wd[i]; + sum += SQR(prodi); + } + + return(RSqrt(sum/N)); +} + +realtype N_VWrmsNormMask_Serial(N_Vector x, N_Vector w, N_Vector id) +{ + long int i, N; + realtype sum, prodi, *xd, *wd, *idd; + + sum = ZERO; + xd = wd = idd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + wd = NV_DATA_S(w); + idd = NV_DATA_S(id); + + for (i = 0; i < N; i++) { + if (idd[i] > ZERO) { + prodi = xd[i]*wd[i]; + sum += SQR(prodi); + } + } + + return(RSqrt(sum / N)); +} + +realtype N_VMin_Serial(N_Vector x) +{ + long int i, N; + realtype min, *xd; + + xd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + + min = xd[0]; + + for (i = 1; i < N; i++) { + if (xd[i] < min) min = xd[i]; + } + + return(min); +} + +realtype N_VWL2Norm_Serial(N_Vector x, N_Vector w) +{ + long int i, N; + realtype sum, prodi, *xd, *wd; + + sum = ZERO; + xd = wd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + wd = NV_DATA_S(w); + + for (i = 0; i < N; i++) { + prodi = xd[i]*wd[i]; + sum += SQR(prodi); + } + + return(RSqrt(sum)); +} + +realtype N_VL1Norm_Serial(N_Vector x) +{ + long int i, N; + realtype sum, *xd; + + sum = ZERO; + xd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + + for (i = 0; i= c) ? ONE : ZERO; + } + + return; +} + +booleantype N_VInvTest_Serial(N_Vector x, N_Vector z) +{ + long int i, N; + realtype *xd, *zd; + + xd = zd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) { + if (xd[i] == ZERO) return(FALSE); + zd[i] = ONE/xd[i]; + } + + return(TRUE); +} + +booleantype N_VConstrMask_Serial(N_Vector c, N_Vector x, N_Vector m) +{ + long int i, N; + booleantype test; + realtype *cd, *xd, *md; + + cd = xd = md = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + cd = NV_DATA_S(c); + md = NV_DATA_S(m); + + test = TRUE; + + for (i = 0; i < N; i++) { + md[i] = ZERO; + if (cd[i] == ZERO) continue; + if (cd[i] > ONEPT5 || cd[i] < -ONEPT5) { + if ( xd[i]*cd[i] <= ZERO) { test = FALSE; md[i] = ONE; } + continue; + } + if ( cd[i] > HALF || cd[i] < -HALF) { + if (xd[i]*cd[i] < ZERO ) { test = FALSE; md[i] = ONE; } + } + } + + return(test); +} + +realtype N_VMinQuotient_Serial(N_Vector num, N_Vector denom) +{ + booleantype notEvenOnce; + long int i, N; + realtype *nd, *dd, min; + + nd = dd = NULL; + + N = NV_LENGTH_S(num); + nd = NV_DATA_S(num); + dd = NV_DATA_S(denom); + + notEvenOnce = TRUE; + min = BIG_REAL; + + for (i = 0; i < N; i++) { + if (dd[i] == ZERO) continue; + else { + if (!notEvenOnce) min = MIN(min, nd[i]/dd[i]); + else { + min = nd[i]/dd[i]; + notEvenOnce = FALSE; + } + } + } + + return(min); +} + +/* + * ----------------------------------------------------------------- + * private functions + * ----------------------------------------------------------------- + */ + +static void VCopy_Serial(N_Vector x, N_Vector z) +{ + long int i, N; + realtype *xd, *zd; + + xd = zd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) + zd[i] = xd[i]; + + return; +} + +static void VSum_Serial(N_Vector x, N_Vector y, N_Vector z) +{ + long int i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + yd = NV_DATA_S(y); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) + zd[i] = xd[i]+yd[i]; + + return; +} + +static void VDiff_Serial(N_Vector x, N_Vector y, N_Vector z) +{ + long int i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + yd = NV_DATA_S(y); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) + zd[i] = xd[i]-yd[i]; + + return; +} + +static void VNeg_Serial(N_Vector x, N_Vector z) +{ + long int i, N; + realtype *xd, *zd; + + xd = zd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) + zd[i] = -xd[i]; + + return; +} + +static void VScaleSum_Serial(realtype c, N_Vector x, N_Vector y, N_Vector z) +{ + long int i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + yd = NV_DATA_S(y); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) + zd[i] = c*(xd[i]+yd[i]); + + return; +} + +static void VScaleDiff_Serial(realtype c, N_Vector x, N_Vector y, N_Vector z) +{ + long int i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + yd = NV_DATA_S(y); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) + zd[i] = c*(xd[i]-yd[i]); + + return; +} + +static void VLin1_Serial(realtype a, N_Vector x, N_Vector y, N_Vector z) +{ + long int i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + yd = NV_DATA_S(y); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) + zd[i] = (a*xd[i])+yd[i]; + + return; +} + +static void VLin2_Serial(realtype a, N_Vector x, N_Vector y, N_Vector z) +{ + long int i, N; + realtype *xd, *yd, *zd; + + xd = yd = zd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + yd = NV_DATA_S(y); + zd = NV_DATA_S(z); + + for (i = 0; i < N; i++) + zd[i] = (a*xd[i])-yd[i]; + + return; +} + +static void Vaxpy_Serial(realtype a, N_Vector x, N_Vector y) +{ + long int i, N; + realtype *xd, *yd; + + xd = yd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + yd = NV_DATA_S(y); + + if (a == ONE) { + for (i = 0; i < N; i++) + yd[i] += xd[i]; + return; + } + + if (a == -ONE) { + for (i = 0; i < N; i++) + yd[i] -= xd[i]; + return; + } + + for (i = 0; i < N; i++) + yd[i] += a*xd[i]; + + return; +} + +static void VScaleBy_Serial(realtype a, N_Vector x) +{ + long int i, N; + realtype *xd; + + xd = NULL; + + N = NV_LENGTH_S(x); + xd = NV_DATA_S(x); + + for (i = 0; i < N; i++) + xd[i] *= a; + + return; +} diff --git a/odemex/Parser/CVode/ida_src/src/sundials/CMakeLists.txt b/odemex/Parser/CVode/ida_src/src/sundials/CMakeLists.txt new file mode 100644 index 0000000..459dcdf --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/sundials/CMakeLists.txt @@ -0,0 +1,45 @@ +# --------------------------------------------------------------- +# $Revision: 1.4 $ +# $Date: 2009/02/17 02:52:53 $ +# --------------------------------------------------------------- +# Programmer: Radu Serban @ LLNL +# --------------------------------------------------------------- +# Copyright (c) 2007, The Regents of the University of California. +# Produced at the Lawrence Livermore National Laboratory. +# All rights reserved. +# For details, see the LICENSE file. +# --------------------------------------------------------------- +# CMakeLists.txt file for the generic SUNDIALS modules + +# From here we only install the generic SUNDIALS headers. +# The implementations themselves are incorporated in the individual SUNDIALS solver libraries. + +INSTALL(CODE "MESSAGE(\"\nInstall shared components\n\")") + +# Add variable sundials_HEADERS with the exported SUNDIALS header files +SET(sundials_HEADERS + sundials_band.h + sundials_dense.h + sundials_direct.h + sundials_iterative.h + sundials_math.h + sundials_nvector.h + sundials_fnvector.h + sundials_spbcgs.h + sundials_spgmr.h + sundials_sptfqmr.h + sundials_types.h + ) + +# Add prefix with complete path to the SUNDIALS header files +ADD_PREFIX(${sundials_SOURCE_DIR}/include/sundials/ sundials_HEADERS) + +# Install the SUNDIALS header files +INSTALL(FILES ${sundials_HEADERS} DESTINATION include/sundials) + +# If Blas/Lapack support was enabled, install the Lapack interface headers +IF(LAPACK_FOUND) + SET(sundials_BL_HEADERS sundials_lapack.h) + ADD_PREFIX(${sundials_SOURCE_DIR}/include/sundials/ sundials_BL_HEADERS) + INSTALL(FILES ${sundials_BL_HEADERS} DESTINATION include/sundials) +ENDIF(LAPACK_FOUND) diff --git a/odemex/Parser/CVode/ida_src/src/sundials/Makefile.in b/odemex/Parser/CVode/ida_src/src/sundials/Makefile.in new file mode 100644 index 0000000..f750ba1 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/sundials/Makefile.in @@ -0,0 +1,137 @@ +# ----------------------------------------------------------------- +# $Revision: 1.12 $ +# $Date: 2009/02/17 02:52:53 $ +# ----------------------------------------------------------------- +# Programmer(s): Radu Serban and Aaron Collier @ LLNL +# ----------------------------------------------------------------- +# Copyright (c) 2002, The Regents of the University of California. +# Produced at the Lawrence Livermore National Laboratory. +# All rights reserved. +# For details, see the LICENSE file. +# ----------------------------------------------------------------- +# Makefile for SHARED module +# +# @configure_input@ +# ----------------------------------------------------------------- + +SHELL = @SHELL@ + +srcdir = @srcdir@ +builddir = @builddir@ +abs_builddir = @abs_builddir@ +top_builddir = @top_builddir@ +prefix = @prefix@ +exec_prefix = @exec_prefix@ +includedir = @includedir@ +libdir = @libdir@ +bindir = @bindir@ + +INSTALL = @INSTALL@ +INSTALL_PROG = @INSTALL_PROGRAM@ +INSTALL_HEADER = @INSTALL_DATA@ + +LIBTOOL = @LIBTOOL@ +LIBTOOL_DEPS = @LIBTOOL_DEPS@ + +CPP = @CPP@ +CPPFLAGS = @CPPFLAGS@ +CC = @CC@ +CFLAGS = @CFLAGS@ +LDFLAGS = @LDFLAGS@ +LIBS = @LIBS@ + +LAPACK_ENABLED = @LAPACK_ENABLED@ + +top_srcdir = $(srcdir)/../.. + +INCLUDES = -I$(top_srcdir)/include -I$(top_builddir)/include + +SHARED_SRC_FILES = sundials_direct.c sundials_band.c sundials_dense.c sundials_iterative.c sundials_math.c sundials_nvector.c sundials_spgmr.c sundials_spbcgs.c sundials_sptfqmr.c + +SHARED_OBJ_FILES = $(SHARED_SRC_FILES:.c=.o) + +SHARED_LIB_FILES = $(SHARED_SRC_FILES:.c=.lo) + +mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs +rminstalldirs = $(SHELL) $(top_srcdir)/config/rminstalldirs + +# ---------------------------------------------------------------------------------------------------------------------- + + +all: + @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ + make lib_with_bl; \ + else \ + make lib_without_bl; \ + fi + +lib_without_bl: $(SHARED_LIB_FILES) + +lib_with_bl: $(SHARED_LIB_FILES) + +install: + $(mkinstalldirs) $(includedir)/sundials + $(INSTALL_HEADER) $(top_srcdir)/include/sundials/sundials_direct.h $(includedir)/sundials/ + $(INSTALL_HEADER) $(top_srcdir)/include/sundials/sundials_band.h $(includedir)/sundials/ + $(INSTALL_HEADER) $(top_srcdir)/include/sundials/sundials_dense.h $(includedir)/sundials/ + $(INSTALL_HEADER) $(top_srcdir)/include/sundials/sundials_iterative.h $(includedir)/sundials/ + $(INSTALL_HEADER) $(top_srcdir)/include/sundials/sundials_spgmr.h $(includedir)/sundials/ + $(INSTALL_HEADER) $(top_srcdir)/include/sundials/sundials_spbcgs.h $(includedir)/sundials/ + $(INSTALL_HEADER) $(top_srcdir)/include/sundials/sundials_sptfqmr.h $(includedir)/sundials/ + $(INSTALL_HEADER) $(top_srcdir)/include/sundials/sundials_math.h $(includedir)/sundials/ + $(INSTALL_HEADER) $(top_srcdir)/include/sundials/sundials_types.h $(includedir)/sundials/ + $(INSTALL_HEADER) $(top_srcdir)/include/sundials/sundials_nvector.h $(includedir)/sundials/ + $(INSTALL_HEADER) $(top_srcdir)/include/sundials/sundials_fnvector.h $(includedir)/sundials/ + $(INSTALL_HEADER) $(top_builddir)/include/sundials/sundials_config.h $(includedir)/sundials/ + @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ + $(INSTALL_HEADER) $(top_srcdir)/include/sundials/sundials_lapack.h $(includedir)/sundials/ ; \ + fi + +uninstall: + rm -f $(includedir)/sundials/sundials_direct.h + rm -f $(includedir)/sundials/sundials_band.h + rm -f $(includedir)/sundials/sundials_dense.h + rm -f $(includedir)/sundials/sundials_lapack.h + rm -f $(includedir)/sundials/sundials_iterative.h + rm -f $(includedir)/sundials/sundials_spgmr.h + rm -f $(includedir)/sundials/sundials_spbcgs.h + rm -f $(includedir)/sundials/sundials_sptfqmr.h + rm -f $(includedir)/sundials/sundials_math.h + rm -f $(includedir)/sundials/sundials_types.h + rm -f $(includedir)/sundials/sundials_nvector.h + rm -f $(includedir)/sundials/sundials_fnvector.h + rm -f $(includedir)/sundials/sundials_config.h + $(rminstalldirs) $(includedir)/sundials + +clean: + rm -f $(SHARED_LIB_FILES) + rm -f $(SHARED_OBJ_FILES) + rm -rf .libs + +distclean: clean + rm -f $(top_builddir)/include/sundials/sundials_config.h + rm -f Makefile + +sundials_direct.lo: $(srcdir)/sundials_direct.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/sundials_direct.c +sundials_band.lo: $(srcdir)/sundials_band.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/sundials_band.c +sundials_dense.lo: $(srcdir)/sundials_dense.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/sundials_dense.c +sundials_iterative.lo: $(srcdir)/sundials_iterative.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/sundials_iterative.c +sundials_spgmr.lo: $(srcdir)/sundials_spgmr.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/sundials_spgmr.c +sundials_spbcgs.lo: $(srcdir)/sundials_spbcgs.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/sundials_spbcgs.c +sundials_sptfqmr.lo: $(srcdir)/sundials_sptfqmr.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/sundials_sptfqmr.c +sundials_math.lo: $(srcdir)/sundials_math.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/sundials_math.c +sundials_nvector.lo: $(srcdir)/sundials_nvector.c + $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/sundials_nvector.c + +libtool: $(top_builddir)/$(LIBTOOL_DEPS) + @cd ${top_builddir} ; \ + ${SHELL} ./config.status --recheck ; \ + cd ${abs_builddir} diff --git a/odemex/Parser/CVode/ida_src/src/sundials/README b/odemex/Parser/CVode/ida_src/src/sundials/README new file mode 100644 index 0000000..d73e577 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/sundials/README @@ -0,0 +1,201 @@ + SUNDIALS + Shared Module + Release 2.4.0, January 2008 + + +The family of solvers referred to as SUNDIALS consists of solvers +CVODE (ODE), CVODES (ODE with sensitivity analysis capabilities), +IDA (DAE), IDAS (DAE with sensitivity analysis capabilities), and +KINSOL (for nonlinear algebraic systems). + +The various solvers of this family share many subordinate modules contained +in this module: +- generic NVECTOR module +- generic linear solver modules (band, dense, lapack, spgmr, bcg, tfqmr) +- definitions of SUNDIALS types (realtype, booleantype) +- common math functions (RpowerI, RPowerR, RSqrt, RAbs,...) + + +A. Documentation +---------------- +All shared submodules are fully described in the user documentation for any of +the SUNDIALS solvers [1-5]. A PDF file for the user guide for a particular solver +is available in the solver's subdirectory under doc/. + + +B. Installation +--------------- + +For basic installation instructions see the file /sundials/INSTALL_NOTES. +For complete installation instructions see any of the user guides. + + +C. References +------------- + +[1] A. C. Hindmarsh and R. Serban, "User Documentation for CVODE v2.4.0," + LLLNL technical report UCRL-MA-208108, November 2004. + +[2] A. C. Hindmarsh and R. Serban, "User Documentation for CVODES v2.4.0," + LLNL technical report UCRL-MA-208111, November 2004. + +[3] A. C. Hindmarsh and R. Serban, "User Documentation for IDA v2.4.0," + LLNL technical report UCRL-MA-208112, November 2004. + +[4] R. Serban and C. Petra, "User Documentation for IDAS v1.0.0," + LLNL technical report UCRL-SM-234051, August 2007. + +[5] A. M. Collier, A. C. Hindmarsh, R. Serban,and C. S. Woodward, "User + Documentation for KINSOL v2.4.0," LLNL technical report UCRL-MA-208116, + November 2004. + + +D. Releases +----------- + +v. 2.4.0 - Jan. 2008 +v. 2.3.0 - Nov. 2006 +v. 2.2.0 - Mar. 2006 +v. 2.1.1 - May. 2005 +v. 2.1.0 - Apr. 2005 +v. 2.0.2 - Mar. 2005 +v. 2.0.1 - Jan. 2005 +v. 2.0 - Dec. 2004 +v. 1.0 - Jul. 2002 (first SUNDIALS release) +v. 0.0 - Mar. 2002 + + +E. Revision History +------------------- + +v. 2.3.0 (Nov. 2006) ---> v. 2.4.0 (Jan. 2008) +--------------------------------------------------------- + +- New features + - added a new generic linear solver module based on Blas + Lapack + for both dense and banded matrices. + +- Changes to user interface + - common functionality for all direct linear solvers (dense, band, and + the new Lapack solver) has been collected into the DLS (Direct Linear + Solver) module, implemented in the files sundials_direct.h and + sundials_direct.c (similar to the SPILS module for the iterative linear + solvers). + - in order to include the new Lapack-based linear solver, all dimensions + for the above linear solvers (problem sizes, bandwidths,... including + the underlying matrix data types) are now of type 'int' (and not 'long int'). + + +v. 2.2.0 (Mar. 2006) ---> v. 2.3.0 (Nov. 2006) +---------------------------------------------- + +- Changes to the user interface + - modified sundials_dense and sundials_smalldense to work with + rectangular m by n matrices (m <= n). + +- Changes related to the build system + - reorganized source tree + - exported header files are installed in solver-specific subdirectories + of ${includedir} + - sundialsTB is distributed only as part of the SUNDIALS tarball + +v. 2.1.1 (May 2005) ---> v. 2.2.0 (Mar. 2006) +---------------------------------------------- + +- New features + - added SPBCG (scaled preconditioned Bi-CGStab) linear solver module + - added SPTFQMR (scaled preconditioned TFQMR) linear solver module + +- Changes related to the build system + - updated configure script and Makefiles for Fortran examples to avoid C++ + compiler errors (now use CC and MPICC to link only if necessary) + - SUNDIALS shared header files are installed under a 'sundials' subdirectory + of the install include directory + - the shared object files are now linked into each SUNDIALS library rather + than into a separate libsundials_shared library + +- Changes to the user interface + - added prefix 'sundials_' to all shared header files + +v. 2.1.0 (Apr. 2005) ---> v. 2.1.1 (May.2005) +---------------------------------------------- + +- Changes to data structures + - added N_VCloneEmpty to global vector operations table + +v. 2.0.2 (Mar. 2005) ---> v. 2.1.0 (Apr. 2005) +---------------------------------------------- + +- none + +v. 2.0.1 (Jan. 2005) ---> v. 2.0.2 (Mar. 2005) +---------------------------------------------- + +- Changes related to the build system + - fixed autoconf-related bug to allow configuration with the PGI Fortran compiler + - modified to use customized detection of the Fortran name mangling scheme + (autoconf's AC_F77_WRAPPERS routine is problematic on some platforms) + - added --with-mpi-flags as a configure option to allow user to specify + MPI-specific flags + - updated Makefiles for Fortran examples to avoid C++ compiler errors (now use + CC and MPICC to link) + +v. 2.0 (Dec. 2004) ---> v. 2.0.1 (Jan. 2005) +-------------------------------------------- + +- Changes related to the build system + - changed order of compiler directives in header files to avoid compilation + errors when using a C++ compiler. + +v. 1.0 (Jul. 2002) ---> v. 2.0 (Dec. 2004) +------------------------------------------ + +- Changes to the generic NVECTOR module + - removed machEnv, redefined table of vector operations (now contained + in the N_Vector structure itself). + - all SUNDIALS functions create new N_Vector variables through cloning, using + an N_Vector passed by the user as a template. + - a particular NVECTOR implementation is supposed to provide user-callable + constructor and destructor functions. + - removed from structure of vector operations the following functions: + N_VNew, N_VNew_S, N_VFree, N_VFree_S, N_VMake, N_VDispose, N_VGetData, + N_VSetData, N_VConstrProdPos, and N_VOneMask. + - added in structure of vector operations the following functions: + N_VClone, N_VDestroy, N_VSpace, N_VGetArrayPointer, N_VSetArrayPointer, + and N_VWrmsNormMask. + - Note that nvec_ser and nvec_par are now separate modules outside the + shared SUNDIALS module. + +- Changes to the generic linear solvers + - in SPGMR, added a dummy N_Vector argument to be used as a template + for cloning. + - in SPGMR, removed N (problem dimension) from argument list of SpgmrMalloc. + - iterative.{c,h} replace iterativ.{c,h} + - modified constant names in iterative.h (preconditioner types are prefixed + with 'PREC_'). + - changed numerical values for MODIFIED_GS (from 0 to 1) and CLASSICAL_GS + (from 1 to 2). + +- Changes to sundialsmath submodule + - replaced internal routine for estimation of unit roundoff with definition + of unit roundoff from float.h + - modified functions to call appropriate math routines given the precision + level specified by the user. + +- Changes to sundialstypes submodule + - removed type 'integertype'. + - added definitions for 'BIG_REAL', 'SMALL_REAL', and 'UNIT_ROUNDOFF' using + values from float.h based on the precision. + - changed definition of macro RCONST to depend on precision. + +v 0.0 (Mar. 2002) ---> v. 1.0 (Jul. 2002) +----------------------------------------- + +20020321 Defined and implemented generic NVECTOR module, and separate serial/ + parallel NVECTOR modules, including serial/parallel F/C interfaces. + Modified dense and band backsolve routines to take real* type for + RHS and solution vector. +20020329 Named the DenseMat, BandMat, and SpgmrMemRec structures. +20020626 Changed type names to realtype, integertype, booleantype. + Renamed llnltypes and llnlmath files. + diff --git a/odemex/Parser/CVode/ida_src/src/sundials/sundials_band.c b/odemex/Parser/CVode/ida_src/src/sundials/sundials_band.c new file mode 100644 index 0000000..fa4eea7 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/sundials/sundials_band.c @@ -0,0 +1,235 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.6 $ + * $Date: 2009/02/17 02:42:29 $ + * ----------------------------------------------------------------- + * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for a generic BAND linear + * solver package. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include +#include + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + +#define ROW(i,j,smu) (i-j+smu) + +/* + * ----------------------------------------------------- + * Functions working on DlsMat + * ----------------------------------------------------- + */ + +int BandGBTRF(DlsMat A, int *p) +{ + return(bandGBTRF(A->cols, A->M, A->mu, A->ml, A->s_mu, p)); +} + +void BandGBTRS(DlsMat A, int *p, realtype *b) +{ + bandGBTRS(A->cols, A->M, A->s_mu, A->ml, p, b); +} + +void BandCopy(DlsMat A, DlsMat B, int copymu, int copyml) +{ + bandCopy(A->cols, B->cols, A->M, A->s_mu, B->s_mu, copymu, copyml); +} + +void BandScale(realtype c, DlsMat A) +{ + bandScale(c, A->cols, A->M, A->mu, A->ml, A->s_mu); +} + +/* + * ----------------------------------------------------- + * Functions working on realtype** + * ----------------------------------------------------- + */ + +int bandGBTRF(realtype **a, int n, int mu, int ml, int smu, int *p) +{ + int c, r, num_rows; + int i, j, k, l, storage_l, storage_k, last_col_k, last_row_k; + realtype *a_c, *col_k, *diag_k, *sub_diag_k, *col_j, *kptr, *jptr; + realtype max, temp, mult, a_kj; + booleantype swap; + + /* zero out the first smu - mu rows of the rectangular array a */ + + num_rows = smu - mu; + if (num_rows > 0) { + for (c=0; c < n; c++) { + a_c = a[c]; + for (r=0; r < num_rows; r++) { + a_c[r] = ZERO; + } + } + } + + /* k = elimination step number */ + + for (k=0; k < n-1; k++, p++) { + + col_k = a[k]; + diag_k = col_k + smu; + sub_diag_k = diag_k + 1; + last_row_k = MIN(n-1,k+ml); + + /* find l = pivot row number */ + + l=k; + max = ABS(*diag_k); + for (i=k+1, kptr=sub_diag_k; i <= last_row_k; i++, kptr++) { + if (ABS(*kptr) > max) { + l=i; + max = ABS(*kptr); + } + } + storage_l = ROW(l, k, smu); + *p = l; + + /* check for zero pivot element */ + + if (col_k[storage_l] == ZERO) return(k+1); + + /* swap a(l,k) and a(k,k) if necessary */ + + if ( (swap = (l != k) )) { + temp = col_k[storage_l]; + col_k[storage_l] = *diag_k; + *diag_k = temp; + } + + /* Scale the elements below the diagonal in */ + /* column k by -1.0 / a(k,k). After the above swap, */ + /* a(k,k) holds the pivot element. This scaling */ + /* stores the pivot row multipliers -a(i,k)/a(k,k) */ + /* in a(i,k), i=k+1, ..., MIN(n-1,k+ml). */ + + mult = -ONE / (*diag_k); + for (i=k+1, kptr = sub_diag_k; i <= last_row_k; i++, kptr++) + (*kptr) *= mult; + + /* row_i = row_i - [a(i,k)/a(k,k)] row_k, i=k+1, ..., MIN(n-1,k+ml) */ + /* row k is the pivot row after swapping with row l. */ + /* The computation is done one column at a time, */ + /* column j=k+1, ..., MIN(k+smu,n-1). */ + + last_col_k = MIN(k+smu,n-1); + for (j=k+1; j <= last_col_k; j++) { + + col_j = a[j]; + storage_l = ROW(l,j,smu); + storage_k = ROW(k,j,smu); + a_kj = col_j[storage_l]; + + /* Swap the elements a(k,j) and a(k,l) if l!=k. */ + + if (swap) { + col_j[storage_l] = col_j[storage_k]; + col_j[storage_k] = a_kj; + } + + /* a(i,j) = a(i,j) - [a(i,k)/a(k,k)]*a(k,j) */ + /* a_kj = a(k,j), *kptr = - a(i,k)/a(k,k), *jptr = a(i,j) */ + + if (a_kj != ZERO) { + for (i=k+1, kptr=sub_diag_k, jptr=col_j+ROW(k+1,j,smu); + i <= last_row_k; + i++, kptr++, jptr++) + (*jptr) += a_kj * (*kptr); + } + } + } + + /* set the last pivot row to be n-1 and check for a zero pivot */ + + *p = n-1; + if (a[n-1][smu] == ZERO) return(n); + + /* return 0 to indicate success */ + + return(0); +} + +void bandGBTRS(realtype **a, int n, int smu, int ml, int *p, realtype *b) +{ + int k, l, i, first_row_k, last_row_k; + realtype mult, *diag_k; + + /* Solve Ly = Pb, store solution y in b */ + + for (k=0; k < n-1; k++) { + l = p[k]; + mult = b[l]; + if (l != k) { + b[l] = b[k]; + b[k] = mult; + } + diag_k = a[k]+smu; + last_row_k = MIN(n-1,k+ml); + for (i=k+1; i <= last_row_k; i++) + b[i] += mult * diag_k[i-k]; + } + + /* Solve Ux = y, store solution x in b */ + + for (k=n-1; k >= 0; k--) { + diag_k = a[k]+smu; + first_row_k = MAX(0,k-smu); + b[k] /= (*diag_k); + mult = -b[k]; + for (i=first_row_k; i <= k-1; i++) + b[i] += mult*diag_k[i-k]; + } +} + +void bandCopy(realtype **a, realtype **b, int n, int a_smu, int b_smu, + int copymu, int copyml) +{ + int i, j, copySize; + realtype *a_col_j, *b_col_j; + + copySize = copymu + copyml + 1; + + for (j=0; j < n; j++) { + a_col_j = a[j]+a_smu-copymu; + b_col_j = b[j]+b_smu-copymu; + for (i=0; i < copySize; i++) + b_col_j[i] = a_col_j[i]; + } +} + +void bandScale(realtype c, realtype **a, int n, int mu, int ml, int smu) +{ + int i, j, colSize; + realtype *col_j; + + colSize = mu + ml + 1; + + for(j=0; j < n; j++) { + col_j = a[j]+smu-mu; + for (i=0; i < colSize; i++) + col_j[i] *= c; + } +} + +void bandAddIdentity(realtype **a, int n, int smu) +{ + int j; + + for(j=0; j < n; j++) + a[j][smu] += ONE; +} diff --git a/odemex/Parser/CVode/ida_src/src/sundials/sundials_dense.c b/odemex/Parser/CVode/ida_src/src/sundials/sundials_dense.c new file mode 100644 index 0000000..104e070 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/sundials/sundials_dense.c @@ -0,0 +1,373 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.6 $ + * $Date: 2009/02/17 02:42:29 $ + * ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and + * Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for a generic package of dense + * matrix operations. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include +#include + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) +#define TWO RCONST(2.0) + +/* + * ----------------------------------------------------- + * Functions working on DlsMat + * ----------------------------------------------------- + */ + +int DenseGETRF(DlsMat A, int *p) +{ + return(denseGETRF(A->cols, A->M, A->N, p)); +} + +void DenseGETRS(DlsMat A, int *p, realtype *b) +{ + denseGETRS(A->cols, A->N, p, b); +} + +int DensePOTRF(DlsMat A) +{ + return(densePOTRF(A->cols, A->M)); +} + +void DensePOTRS(DlsMat A, realtype *b) +{ + densePOTRS(A->cols, A->M, b); +} + +int DenseGEQRF(DlsMat A, realtype *beta, realtype *wrk) +{ + return(denseGEQRF(A->cols, A->M, A->N, beta, wrk)); +} + +int DenseORMQR(DlsMat A, realtype *beta, realtype *vn, realtype *vm, realtype *wrk) +{ + return(denseORMQR(A->cols, A->M, A->N, beta, vn, vm, wrk)); +} + +void DenseCopy(DlsMat A, DlsMat B) +{ + denseCopy(A->cols, B->cols, A->M, A->N); +} + +void DenseScale(realtype c, DlsMat A) +{ + denseScale(c, A->cols, A->M, A->N); +} + +int denseGETRF(realtype **a, int m, int n, int *p) +{ + int i, j, k, l; + realtype *col_j, *col_k; + realtype temp, mult, a_kj; + + /* k-th elimination step number */ + for (k=0; k < n; k++) { + + col_k = a[k]; + + /* find l = pivot row number */ + l=k; + for (i=k+1; i < m; i++) + if (ABS(col_k[i]) > ABS(col_k[l])) l=i; + p[k] = l; + + /* check for zero pivot element */ + if (col_k[l] == ZERO) return(k+1); + + /* swap a(k,1:n) and a(l,1:n) if necessary */ + if ( l!= k ) { + for (i=0; i 0; k--) { + col_k = a[k]; + b[k] /= col_k[k]; + for (i=0; i0) { + for(i=j; i=0; i--) { + col_i = a[i]; + for (j=i+1; j= n) + * using Householder reflections. + * + * On exit, the elements on and above the diagonal of A contain the n by n + * upper triangular matrix R; the elements below the diagonal, with the array beta, + * represent the orthogonal matrix Q as a product of elementary reflectors . + * + * v (of length m) must be provided as workspace. + * + */ + +int denseGEQRF(realtype **a, int m, int n, realtype *beta, realtype *v) +{ + realtype ajj, s, mu, v1, v1_2; + realtype *col_j, *col_k; + int i, j, k; + + /* For each column...*/ + for(j=0; j= n. + * + * v (of length m) must be provided as workspace. + */ +int denseORMQR(realtype **a, int m, int n, realtype *beta, + realtype *vn, realtype *vm, realtype *v) +{ + realtype *col_j, s; + int i, j; + + /* Initialize vm */ + for(i=0; i=0; j--) { + + col_j = a[j]; + + v[0] = ONE; + s = vm[j]; + for(i=1; i +#include + +#include +#include + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + +DlsMat NewDenseMat(int M, int N) +{ + DlsMat A; + int j; + + if ( (M <= 0) || (N <= 0) ) return(NULL); + + A = NULL; + A = (DlsMat) malloc(sizeof *A); + if (A==NULL) return (NULL); + + A->data = (realtype *) malloc(M * N * sizeof(realtype)); + if (A->data == NULL) { + free(A); A = NULL; + return(NULL); + } + A->cols = (realtype **) malloc(N * sizeof(realtype *)); + if (A->cols == NULL) { + free(A->data); A->data = NULL; + free(A); A = NULL; + return(NULL); + } + + for (j=0; j < N; j++) A->cols[j] = A->data + j * M; + + A->M = M; + A->N = N; + A->ldim = M; + A->ldata = M*N; + + A->type = SUNDIALS_DENSE; + + return(A); +} + +realtype **newDenseMat(int m, int n) +{ + int j; + realtype **a; + + if ( (n <= 0) || (m <= 0) ) return(NULL); + + a = NULL; + a = (realtype **) malloc(n * sizeof(realtype *)); + if (a == NULL) return(NULL); + + a[0] = NULL; + a[0] = (realtype *) malloc(m * n * sizeof(realtype)); + if (a[0] == NULL) { + free(a); a = NULL; + return(NULL); + } + + for (j=1; j < n; j++) a[j] = a[0] + j * m; + + return(a); +} + + +DlsMat NewBandMat(int N, int mu, int ml, int smu) +{ + DlsMat A; + int j, colSize; + + if (N <= 0) return(NULL); + + A = NULL; + A = (DlsMat) malloc(sizeof *A); + if (A == NULL) return (NULL); + + colSize = smu + ml + 1; + A->data = NULL; + A->data = (realtype *) malloc(N * colSize * sizeof(realtype)); + if (A->data == NULL) { + free(A); A = NULL; + return(NULL); + } + + A->cols = NULL; + A->cols = (realtype **) malloc(N * sizeof(realtype *)); + if (A->cols == NULL) { + free(A->data); + free(A); A = NULL; + return(NULL); + } + + for (j=0; j < N; j++) A->cols[j] = A->data + j * colSize; + + A->M = N; + A->N = N; + A->mu = mu; + A->ml = ml; + A->s_mu = smu; + A->ldim = colSize; + A->ldata = N * colSize; + + A->type = SUNDIALS_BAND; + + return(A); +} + +realtype **newBandMat(int n, int smu, int ml) +{ + realtype **a; + int j, colSize; + + if (n <= 0) return(NULL); + + a = NULL; + a = (realtype **) malloc(n * sizeof(realtype *)); + if (a == NULL) return(NULL); + + colSize = smu + ml + 1; + a[0] = NULL; + a[0] = (realtype *) malloc(n * colSize * sizeof(realtype)); + if (a[0] == NULL) { + free(a); a = NULL; + return(NULL); + } + + for (j=1; j < n; j++) a[j] = a[0] + j * colSize; + + return(a); +} + +void DestroyMat(DlsMat A) +{ + free(A->data); A->data = NULL; + free(A->cols); + free(A); A = NULL; +} + +void destroyMat(realtype **a) +{ + free(a[0]); a[0] = NULL; + free(a); a = NULL; +} + +int *NewIntArray(int N) +{ + int *vec; + + if (N <= 0) return(NULL); + + vec = NULL; + vec = (int *) malloc(N * sizeof(int)); + + return(vec); +} + +int *newIntArray(int n) +{ + int *v; + + if (n <= 0) return(NULL); + + v = NULL; + v = (int *) malloc(n * sizeof(int)); + + return(v); +} + +realtype *NewRealArray(int N) +{ + realtype *vec; + + if (N <= 0) return(NULL); + + vec = NULL; + vec = (realtype *) malloc(N * sizeof(realtype)); + + return(vec); +} + +realtype *newRealArray(int m) +{ + realtype *v; + + if (m <= 0) return(NULL); + + v = NULL; + v = (realtype *) malloc(m * sizeof(realtype)); + + return(v); +} + +void DestroyArray(void *V) +{ + free(V); + V = NULL; +} + +void destroyArray(void *v) +{ + free(v); + v = NULL; +} + + +void AddIdentity(DlsMat A) +{ + int i; + + switch (A->type) { + + case SUNDIALS_DENSE: + for (i=0; iN; i++) A->cols[i][i] += ONE; + break; + + case SUNDIALS_BAND: + for (i=0; iM; i++) A->cols[i][A->s_mu] += ONE; + break; + + } + +} + + +void SetToZero(DlsMat A) +{ + int i, j, colSize; + realtype *col_j; + + switch (A->type) { + + case SUNDIALS_DENSE: + + for (j=0; jN; j++) { + col_j = A->cols[j]; + for (i=0; iM; i++) + col_j[i] = ZERO; + } + + break; + + case SUNDIALS_BAND: + + colSize = A->mu + A->ml + 1; + for (j=0; jM; j++) { + col_j = A->cols[j] + A->s_mu - A->mu; + for (i=0; itype) { + + case SUNDIALS_DENSE: + + printf("\n"); + for (i=0; i < A->M; i++) { + for (j=0; j < A->N; j++) { +#if defined(SUNDIALS_EXTENDED_PRECISION) + printf("%12Lg ", DENSE_ELEM(A,i,j)); +#elif defined(SUNDIALS_DOUBLE_PRECISION) + printf("%12lg ", DENSE_ELEM(A,i,j)); +#else + printf("%12g ", DENSE_ELEM(A,i,j)); +#endif + } + printf("\n"); + } + printf("\n"); + + break; + + case SUNDIALS_BAND: + + a = A->cols; + printf("\n"); + for (i=0; i < A->N; i++) { + start = MAX(0,i-A->ml); + finish = MIN(A->N-1,i+A->mu); + for (j=0; j < start; j++) printf("%12s ",""); + for (j=start; j <= finish; j++) { +#if defined(SUNDIALS_EXTENDED_PRECISION) + printf("%12Lg ", a[j][i-j+A->s_mu]); +#elif defined(SUNDIALS_DOUBLE_PRECISION) + printf("%12lg ", a[j][i-j+A->s_mu]); +#else + printf("%12g ", a[j][i-j+A->s_mu]); +#endif + } + printf("\n"); + } + printf("\n"); + + break; + + } + +} + + diff --git a/odemex/Parser/CVode/ida_src/src/sundials/sundials_iterative.c b/odemex/Parser/CVode/ida_src/src/sundials/sundials_iterative.c new file mode 100644 index 0000000..41ccc17 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/sundials/sundials_iterative.c @@ -0,0 +1,288 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.1 $ + * $Date: 2006/07/05 15:32:38 $ + * ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and + * Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for the iterative.h header + * file. It contains the implementation of functions that may be + * useful for many different iterative solvers of A x = b. + * ----------------------------------------------------------------- + */ + +#include + +#include +#include + +#define FACTOR RCONST(1000.0) +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + +/* + * ----------------------------------------------------------------- + * Function : ModifiedGS + * ----------------------------------------------------------------- + * This implementation of ModifiedGS is a slight modification of a + * previous modified Gram-Schmidt routine (called mgs) written by + * Milo Dorr. + * ----------------------------------------------------------------- + */ + +int ModifiedGS(N_Vector *v, realtype **h, int k, int p, + realtype *new_vk_norm) +{ + int i, k_minus_1, i0; + realtype new_norm_2, new_product, vk_norm, temp; + + vk_norm = RSqrt(N_VDotProd(v[k],v[k])); + k_minus_1 = k - 1; + i0 = MAX(k-p, 0); + + /* Perform modified Gram-Schmidt */ + + for (i=i0; i < k; i++) { + h[i][k_minus_1] = N_VDotProd(v[i], v[k]); + N_VLinearSum(ONE, v[k], -h[i][k_minus_1], v[i], v[k]); + } + + /* Compute the norm of the new vector at v[k] */ + + *new_vk_norm = RSqrt(N_VDotProd(v[k], v[k])); + + /* If the norm of the new vector at v[k] is less than + FACTOR (== 1000) times unit roundoff times the norm of the + input vector v[k], then the vector will be reorthogonalized + in order to ensure that nonorthogonality is not being masked + by a very small vector length. */ + + temp = FACTOR * vk_norm; + if ((temp + (*new_vk_norm)) != temp) return(0); + + new_norm_2 = ZERO; + + for (i=i0; i < k; i++) { + new_product = N_VDotProd(v[i], v[k]); + temp = FACTOR * h[i][k_minus_1]; + if ((temp + new_product) == temp) continue; + h[i][k_minus_1] += new_product; + N_VLinearSum(ONE, v[k],-new_product, v[i], v[k]); + new_norm_2 += SQR(new_product); + } + + if (new_norm_2 != ZERO) { + new_product = SQR(*new_vk_norm) - new_norm_2; + *new_vk_norm = (new_product > ZERO) ? RSqrt(new_product) : ZERO; + } + + return(0); +} + +/* + * ----------------------------------------------------------------- + * Function : ClassicalGS + * ----------------------------------------------------------------- + * This implementation of ClassicalGS was contributed by Homer Walker + * and Peter Brown. + * ----------------------------------------------------------------- + */ + +int ClassicalGS(N_Vector *v, realtype **h, int k, int p, + realtype *new_vk_norm, N_Vector temp, realtype *s) +{ + int i, k_minus_1, i0; + realtype vk_norm; + + k_minus_1 = k - 1; + + /* Perform Classical Gram-Schmidt */ + + vk_norm = RSqrt(N_VDotProd(v[k], v[k])); + + i0 = MAX(k-p, 0); + for (i=i0; i < k; i++) { + h[i][k_minus_1] = N_VDotProd(v[i], v[k]); + } + + for (i=i0; i < k; i++) { + N_VLinearSum(ONE, v[k], -h[i][k_minus_1], v[i], v[k]); + } + + /* Compute the norm of the new vector at v[k] */ + + *new_vk_norm = RSqrt(N_VDotProd(v[k], v[k])); + + /* Reorthogonalize if necessary */ + + if ((FACTOR * (*new_vk_norm)) < vk_norm) { + + for (i=i0; i < k; i++) { + s[i] = N_VDotProd(v[i], v[k]); + } + + if (i0 < k) { + N_VScale(s[i0], v[i0], temp); + h[i0][k_minus_1] += s[i0]; + } + for (i=i0+1; i < k; i++) { + N_VLinearSum(s[i], v[i], ONE, temp, temp); + h[i][k_minus_1] += s[i]; + } + N_VLinearSum(ONE, v[k], -ONE, temp, v[k]); + + *new_vk_norm = RSqrt(N_VDotProd(v[k],v[k])); + } + + return(0); +} + +/* + * ----------------------------------------------------------------- + * Function : QRfact + * ----------------------------------------------------------------- + * This implementation of QRfact is a slight modification of a + * previous routine (called qrfact) written by Milo Dorr. + * ----------------------------------------------------------------- + */ + +int QRfact(int n, realtype **h, realtype *q, int job) +{ + realtype c, s, temp1, temp2, temp3; + int i, j, k, q_ptr, n_minus_1, code=0; + + switch (job) { + case 0: + + /* Compute a new factorization of H */ + + code = 0; + for (k=0; k < n; k++) { + + /* Multiply column k by the previous k-1 Givens rotations */ + + for (j=0; j < k-1; j++) { + i = 2*j; + temp1 = h[j][k]; + temp2 = h[j+1][k]; + c = q[i]; + s = q[i+1]; + h[j][k] = c*temp1 - s*temp2; + h[j+1][k] = s*temp1 + c*temp2; + } + + /* Compute the Givens rotation components c and s */ + + q_ptr = 2*k; + temp1 = h[k][k]; + temp2 = h[k+1][k]; + if( temp2 == ZERO) { + c = ONE; + s = ZERO; + } else if (ABS(temp2) >= ABS(temp1)) { + temp3 = temp1/temp2; + s = -ONE/RSqrt(ONE+SQR(temp3)); + c = -s*temp3; + } else { + temp3 = temp2/temp1; + c = ONE/RSqrt(ONE+SQR(temp3)); + s = -c*temp3; + } + q[q_ptr] = c; + q[q_ptr+1] = s; + if( (h[k][k] = c*temp1 - s*temp2) == ZERO) code = k+1; + } + break; + + default: + + /* Update the factored H to which a new column has been added */ + + n_minus_1 = n - 1; + code = 0; + + /* Multiply the new column by the previous n-1 Givens rotations */ + + for (k=0; k < n_minus_1; k++) { + i = 2*k; + temp1 = h[k][n_minus_1]; + temp2 = h[k+1][n_minus_1]; + c = q[i]; + s = q[i+1]; + h[k][n_minus_1] = c*temp1 - s*temp2; + h[k+1][n_minus_1] = s*temp1 + c*temp2; + } + + /* Compute new Givens rotation and multiply it times the last two + entries in the new column of H. Note that the second entry of + this product will be 0, so it is not necessary to compute it. */ + + temp1 = h[n_minus_1][n_minus_1]; + temp2 = h[n][n_minus_1]; + if (temp2 == ZERO) { + c = ONE; + s = ZERO; + } else if (ABS(temp2) >= ABS(temp1)) { + temp3 = temp1/temp2; + s = -ONE/RSqrt(ONE+SQR(temp3)); + c = -s*temp3; + } else { + temp3 = temp2/temp1; + c = ONE/RSqrt(ONE+SQR(temp3)); + s = -c*temp3; + } + q_ptr = 2*n_minus_1; + q[q_ptr] = c; + q[q_ptr+1] = s; + if ((h[n_minus_1][n_minus_1] = c*temp1 - s*temp2) == ZERO) + code = n; + } + + return (code); +} + +/* + * ----------------------------------------------------------------- + * Function : QRsol + * ----------------------------------------------------------------- + * This implementation of QRsol is a slight modification of a + * previous routine (called qrsol) written by Milo Dorr. + * ----------------------------------------------------------------- + */ + +int QRsol(int n, realtype **h, realtype *q, realtype *b) +{ + realtype c, s, temp1, temp2; + int i, k, q_ptr, code=0; + + /* Compute Q*b */ + + for (k=0; k < n; k++) { + q_ptr = 2*k; + c = q[q_ptr]; + s = q[q_ptr+1]; + temp1 = b[k]; + temp2 = b[k+1]; + b[k] = c*temp1 - s*temp2; + b[k+1] = s*temp1 + c*temp2; + } + + /* Solve R*x = Q*b */ + + for (k=n-1; k >= 0; k--) { + if (h[k][k] == ZERO) { + code = k + 1; + break; + } + b[k] /= h[k][k]; + for (i=0; i < k; i++) b[i] -= b[k]*h[i][k]; + } + + return (code); +} diff --git a/odemex/Parser/CVode/ida_src/src/sundials/sundials_math.c b/odemex/Parser/CVode/ida_src/src/sundials/sundials_math.c new file mode 100644 index 0000000..8bc9d59 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/sundials/sundials_math.c @@ -0,0 +1,94 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.1 $ + * $Date: 2006/07/05 15:32:38 $ + * ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and + * Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for a simple C-language math + * library. + * ----------------------------------------------------------------- + */ + +#include +#include +#include + +#include + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + +realtype RPowerI(realtype base, int exponent) +{ + int i, expt; + realtype prod; + + prod = ONE; + expt = abs(exponent); + for(i = 1; i <= expt; i++) prod *= base; + if (exponent < 0) prod = ONE/prod; + return(prod); +} + +realtype RPowerR(realtype base, realtype exponent) +{ + if (base <= ZERO) return(ZERO); + +#if defined(SUNDIALS_USE_GENERIC_MATH) + return((realtype) pow((double) base, (double) exponent)); +#elif defined(SUNDIALS_DOUBLE_PRECISION) + return(pow(base, exponent)); +#elif defined(SUNDIALS_SINGLE_PRECISION) + return(powf(base, exponent)); +#elif defined(SUNDIALS_EXTENDED_PRECISION) + return(powl(base, exponent)); +#endif +} + +realtype RSqrt(realtype x) +{ + if (x <= ZERO) return(ZERO); + +#if defined(SUNDIALS_USE_GENERIC_MATH) + return((realtype) sqrt((double) x)); +#elif defined(SUNDIALS_DOUBLE_PRECISION) + return(sqrt(x)); +#elif defined(SUNDIALS_SINGLE_PRECISION) + return(sqrtf(x)); +#elif defined(SUNDIALS_EXTENDED_PRECISION) + return(sqrtl(x)); +#endif +} + +realtype RAbs(realtype x) +{ +#if defined(SUNDIALS_USE_GENERIC_MATH) + return((realtype) fabs((double) x)); +#elif defined(SUNDIALS_DOUBLE_PRECISION) + return(fabs(x)); +#elif defined(SUNDIALS_SINGLE_PRECISION) + return(fabsf(x)); +#elif defined(SUNDIALS_EXTENDED_PRECISION) + return(fabsl(x)); +#endif +} + +realtype RExp(realtype x) +{ +#if defined(SUNDIALS_USE_GENERIC_MATH) + return((realtype) exp((double) x)); +#elif defined(SUNDIALS_DOUBLE_PRECISION) + return(exp(x)); +#elif defined(SUNDIALS_SINGLE_PRECISION) + return(expf(x)); +#elif defined(SUNDIALS_EXTENDED_PRECISION) + return(expl(x)); +#endif +} diff --git a/odemex/Parser/CVode/ida_src/src/sundials/sundials_nvector.c b/odemex/Parser/CVode/ida_src/src/sundials/sundials_nvector.c new file mode 100644 index 0000000..e8e1b83 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/sundials/sundials_nvector.c @@ -0,0 +1,233 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.3 $ + * $Date: 2007/04/06 20:33:30 $ + * ----------------------------------------------------------------- + * Programmer(s): Radu Serban and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for a generic NVECTOR package. + * It contains the implementation of the N_Vector operations listed + * in nvector.h. + * ----------------------------------------------------------------- + */ + +#include + +#include + +/* + * ----------------------------------------------------------------- + * Functions in the 'ops' structure + * ----------------------------------------------------------------- + */ + +N_Vector N_VClone(N_Vector w) +{ + N_Vector v = NULL; + v = w->ops->nvclone(w); + return(v); +} + +N_Vector N_VCloneEmpty(N_Vector w) +{ + N_Vector v = NULL; + v = w->ops->nvcloneempty(w); + return(v); +} + +void N_VDestroy(N_Vector v) +{ + if (v==NULL) return; + v->ops->nvdestroy(v); + return; +} + +void N_VSpace(N_Vector v, long int *lrw, long int *liw) +{ + v->ops->nvspace(v, lrw, liw); + return; +} + +realtype *N_VGetArrayPointer(N_Vector v) +{ + return((realtype *) v->ops->nvgetarraypointer(v)); +} + +void N_VSetArrayPointer(realtype *v_data, N_Vector v) +{ + v->ops->nvsetarraypointer(v_data, v); + return; +} + +void N_VLinearSum(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z) +{ + z->ops->nvlinearsum(a, x, b, y, z); + return; +} + +void N_VConst(realtype c, N_Vector z) +{ + z->ops->nvconst(c, z); + return; +} + +void N_VProd(N_Vector x, N_Vector y, N_Vector z) +{ + z->ops->nvprod(x, y, z); + return; +} + +void N_VDiv(N_Vector x, N_Vector y, N_Vector z) +{ + z->ops->nvdiv(x, y, z); + return; +} + +void N_VScale(realtype c, N_Vector x, N_Vector z) +{ + z->ops->nvscale(c, x, z); + return; +} + +void N_VAbs(N_Vector x, N_Vector z) +{ + z->ops->nvabs(x, z); + return; +} + +void N_VInv(N_Vector x, N_Vector z) +{ + z->ops->nvinv(x, z); + return; +} + +void N_VAddConst(N_Vector x, realtype b, N_Vector z) +{ + z->ops->nvaddconst(x, b, z); + return; +} + +realtype N_VDotProd(N_Vector x, N_Vector y) +{ + return((realtype) y->ops->nvdotprod(x, y)); +} + +realtype N_VMaxNorm(N_Vector x) +{ + return((realtype) x->ops->nvmaxnorm(x)); +} + +realtype N_VWrmsNorm(N_Vector x, N_Vector w) +{ + return((realtype) x->ops->nvwrmsnorm(x, w)); +} + +realtype N_VWrmsNormMask(N_Vector x, N_Vector w, N_Vector id) +{ + return((realtype) x->ops->nvwrmsnormmask(x, w, id)); +} + +realtype N_VMin(N_Vector x) +{ + return((realtype) x->ops->nvmin(x)); +} + +realtype N_VWL2Norm(N_Vector x, N_Vector w) +{ + return((realtype) x->ops->nvwl2norm(x, w)); +} + +realtype N_VL1Norm(N_Vector x) +{ + return((realtype) x->ops->nvl1norm(x)); +} + +void N_VCompare(realtype c, N_Vector x, N_Vector z) +{ + z->ops->nvcompare(c, x, z); + return; +} + +booleantype N_VInvTest(N_Vector x, N_Vector z) +{ + return((booleantype) z->ops->nvinvtest(x, z)); +} + +booleantype N_VConstrMask(N_Vector c, N_Vector x, N_Vector m) +{ + return((booleantype) x->ops->nvconstrmask(c, x, m)); +} + +realtype N_VMinQuotient(N_Vector num, N_Vector denom) +{ + return((realtype) num->ops->nvminquotient(num, denom)); +} + +/* + * ----------------------------------------------------------------- + * Additional functions exported by the generic NVECTOR: + * N_VCloneEmptyVectorArray + * N_VCloneVectorArray + * N_VDestroyVectorArray + * ----------------------------------------------------------------- + */ + +N_Vector *N_VCloneEmptyVectorArray(int count, N_Vector w) +{ + N_Vector *vs = NULL; + int j; + + if (count <= 0) return(NULL); + + vs = (N_Vector *) malloc(count * sizeof(N_Vector)); + if(vs == NULL) return(NULL); + + for (j = 0; j < count; j++) { + vs[j] = N_VCloneEmpty(w); + if (vs[j] == NULL) { + N_VDestroyVectorArray(vs, j-1); + return(NULL); + } + } + + return(vs); +} + +N_Vector *N_VCloneVectorArray(int count, N_Vector w) +{ + N_Vector *vs = NULL; + int j; + + if (count <= 0) return(NULL); + + vs = (N_Vector *) malloc(count * sizeof(N_Vector)); + if(vs == NULL) return(NULL); + + for (j = 0; j < count; j++) { + vs[j] = N_VClone(w); + if (vs[j] == NULL) { + N_VDestroyVectorArray(vs, j-1); + return(NULL); + } + } + + return(vs); +} + +void N_VDestroyVectorArray(N_Vector *vs, int count) +{ + int j; + + if (vs==NULL) return; + + for (j = 0; j < count; j++) N_VDestroy(vs[j]); + + free(vs); vs = NULL; + + return; +} diff --git a/odemex/Parser/CVode/ida_src/src/sundials/sundials_spbcgs.c b/odemex/Parser/CVode/ida_src/src/sundials/sundials_spbcgs.c new file mode 100644 index 0000000..b73bf26 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/sundials/sundials_spbcgs.c @@ -0,0 +1,379 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2007/04/06 20:33:30 $ + * ----------------------------------------------------------------- + * Programmer(s): Peter Brown and Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2004, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for the scaled, preconditioned + * Bi-CGSTAB (SPBCG) iterative linear solver. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include +#include + +/* + * ----------------------------------------------------------------- + * private constants + * ----------------------------------------------------------------- + */ + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + +/* + * ----------------------------------------------------------------- + * Function : SpbcgMalloc + * ----------------------------------------------------------------- + */ + +SpbcgMem SpbcgMalloc(int l_max, N_Vector vec_tmpl) +{ + SpbcgMem mem; + N_Vector r_star, r, p, q, u, Ap, vtemp; + + /* Check the input parameters */ + + if (l_max <= 0) return(NULL); + + /* Get arrays to hold temporary vectors */ + + r_star = N_VClone(vec_tmpl); + if (r_star == NULL) { + return(NULL); + } + + r = N_VClone(vec_tmpl); + if (r == NULL) { + N_VDestroy(r_star); + return(NULL); + } + + p = N_VClone(vec_tmpl); + if (p == NULL) { + N_VDestroy(r_star); + N_VDestroy(r); + return(NULL); + } + + q = N_VClone(vec_tmpl); + if (q == NULL) { + N_VDestroy(r_star); + N_VDestroy(r); + N_VDestroy(p); + return(NULL); + } + + u = N_VClone(vec_tmpl); + if (u == NULL) { + N_VDestroy(r_star); + N_VDestroy(r); + N_VDestroy(p); + N_VDestroy(q); + return(NULL); + } + + Ap = N_VClone(vec_tmpl); + if (Ap == NULL) { + N_VDestroy(r_star); + N_VDestroy(r); + N_VDestroy(p); + N_VDestroy(q); + N_VDestroy(u); + return(NULL); + } + + vtemp = N_VClone(vec_tmpl); + if (vtemp == NULL) { + N_VDestroy(r_star); + N_VDestroy(r); + N_VDestroy(p); + N_VDestroy(q); + N_VDestroy(u); + N_VDestroy(Ap); + return(NULL); + } + + /* Get memory for an SpbcgMemRec containing SPBCG matrices and vectors */ + + mem = NULL; + mem = (SpbcgMem) malloc(sizeof(SpbcgMemRec)); + if (mem == NULL) { + N_VDestroy(r_star); + N_VDestroy(r); + N_VDestroy(p); + N_VDestroy(q); + N_VDestroy(u); + N_VDestroy(Ap); + N_VDestroy(vtemp); + return(NULL); + } + + /* Set the fields of mem */ + + mem->l_max = l_max; + mem->r_star = r_star; + mem->r = r; + mem->p = p; + mem->q = q; + mem->u = u; + mem->Ap = Ap; + mem->vtemp = vtemp; + + /* Return the pointer to SPBCG memory */ + + return(mem); +} + +/* + * ----------------------------------------------------------------- + * Function : SpbcgSolve + * ----------------------------------------------------------------- + */ + +int SpbcgSolve(SpbcgMem mem, void *A_data, N_Vector x, N_Vector b, + int pretype, realtype delta, void *P_data, N_Vector sx, + N_Vector sb, ATimesFn atimes, PSolveFn psolve, + realtype *res_norm, int *nli, int *nps) +{ + realtype alpha, beta, omega, omega_denom, beta_num, beta_denom, r_norm, rho; + N_Vector r_star, r, p, q, u, Ap, vtemp; + booleantype preOnLeft, preOnRight, scale_x, scale_b, converged; + int l, l_max, ier; + + if (mem == NULL) return(SPBCG_MEM_NULL); + + /* Make local copies of mem variables */ + + l_max = mem->l_max; + r_star = mem->r_star; + r = mem->r; + p = mem->p; + q = mem->q; + u = mem->u; + Ap = mem->Ap; + vtemp = mem->vtemp; + + *nli = *nps = 0; /* Initialize counters */ + converged = FALSE; /* Initialize converged flag */ + + if ((pretype != PREC_LEFT) && (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) pretype = PREC_NONE; + + preOnLeft = ((pretype == PREC_BOTH) || (pretype == PREC_LEFT)); + preOnRight = ((pretype == PREC_BOTH) || (pretype == PREC_RIGHT)); + + scale_x = (sx != NULL); + scale_b = (sb != NULL); + + /* Set r_star to initial (unscaled) residual r_0 = b - A*x_0 */ + + if (N_VDotProd(x, x) == ZERO) N_VScale(ONE, b, r_star); + else { + ier = atimes(A_data, x, r_star); + if (ier != 0) + return((ier < 0) ? SPBCG_ATIMES_FAIL_UNREC : SPBCG_ATIMES_FAIL_REC); + N_VLinearSum(ONE, b, -ONE, r_star, r_star); + } + + /* Apply left preconditioner and b-scaling to r_star = r_0 */ + + if (preOnLeft) { + ier = psolve(P_data, r_star, r, PREC_LEFT); + (*nps)++; + if (ier != 0) return((ier < 0) ? SPBCG_PSOLVE_FAIL_UNREC : SPBCG_PSOLVE_FAIL_REC); + } + else N_VScale(ONE, r_star, r); + + if (scale_b) N_VProd(sb, r, r_star); + else N_VScale(ONE, r, r_star); + + /* Initialize beta_denom to the dot product of r0 with r0 */ + + beta_denom = N_VDotProd(r_star, r_star); + + /* Set r_norm to L2 norm of r_star = sb P1_inv r_0, and + return if small */ + + *res_norm = r_norm = rho = RSqrt(beta_denom); + if (r_norm <= delta) return(SPBCG_SUCCESS); + + /* Copy r_star to r and p */ + + N_VScale(ONE, r_star, r); + N_VScale(ONE, r_star, p); + + /* Begin main iteration loop */ + + for(l = 0; l < l_max; l++) { + + (*nli)++; + + /* Generate Ap = A-tilde p, where A-tilde = sb P1_inv A P2_inv sx_inv */ + + /* Apply x-scaling: vtemp = sx_inv p */ + + if (scale_x) N_VDiv(p, sx, vtemp); + else N_VScale(ONE, p, vtemp); + + /* Apply right preconditioner: vtemp = P2_inv sx_inv p */ + + if (preOnRight) { + N_VScale(ONE, vtemp, Ap); + ier = psolve(P_data, Ap, vtemp, PREC_RIGHT); + (*nps)++; + if (ier != 0) return((ier < 0) ? SPBCG_PSOLVE_FAIL_UNREC : SPBCG_PSOLVE_FAIL_REC); + } + + /* Apply A: Ap = A P2_inv sx_inv p */ + + ier = atimes(A_data, vtemp, Ap ); + if (ier != 0) + return((ier < 0) ? SPBCG_ATIMES_FAIL_UNREC : SPBCG_ATIMES_FAIL_REC); + + /* Apply left preconditioner: vtemp = P1_inv A P2_inv sx_inv p */ + + if (preOnLeft) { + ier = psolve(P_data, Ap, vtemp, PREC_LEFT); + (*nps)++; + if (ier != 0) return((ier < 0) ? SPBCG_PSOLVE_FAIL_UNREC : SPBCG_PSOLVE_FAIL_REC); + } + else N_VScale(ONE, Ap, vtemp); + + /* Apply b-scaling: Ap = sb P1_inv A P2_inv sx_inv p */ + + if (scale_b) N_VProd(sb, vtemp, Ap); + else N_VScale(ONE, vtemp, Ap); + + + /* Calculate alpha = / */ + + alpha = ((N_VDotProd(r, r_star) / N_VDotProd(Ap, r_star))); + + /* Update q = r - alpha*Ap = r - alpha*(sb P1_inv A P2_inv sx_inv p) */ + + N_VLinearSum(ONE, r, -alpha, Ap, q); + + /* Generate u = A-tilde q */ + + /* Apply x-scaling: vtemp = sx_inv q */ + + if (scale_x) N_VDiv(q, sx, vtemp); + else N_VScale(ONE, q, vtemp); + + /* Apply right preconditioner: vtemp = P2_inv sx_inv q */ + + if (preOnRight) { + N_VScale(ONE, vtemp, u); + ier = psolve(P_data, u, vtemp, PREC_RIGHT); + (*nps)++; + if (ier != 0) return((ier < 0) ? SPBCG_PSOLVE_FAIL_UNREC : SPBCG_PSOLVE_FAIL_REC); + } + + /* Apply A: u = A P2_inv sx_inv u */ + + ier = atimes(A_data, vtemp, u ); + if (ier != 0) + return((ier < 0) ? SPBCG_ATIMES_FAIL_UNREC : SPBCG_ATIMES_FAIL_REC); + + /* Apply left preconditioner: vtemp = P1_inv A P2_inv sx_inv p */ + + if (preOnLeft) { + ier = psolve(P_data, u, vtemp, PREC_LEFT); + (*nps)++; + if (ier != 0) return((ier < 0) ? SPBCG_PSOLVE_FAIL_UNREC : SPBCG_PSOLVE_FAIL_REC); + } + else N_VScale(ONE, u, vtemp); + + /* Apply b-scaling: u = sb P1_inv A P2_inv sx_inv u */ + + if (scale_b) N_VProd(sb, vtemp, u); + else N_VScale(ONE, vtemp, u); + + + /* Calculate omega = / */ + + omega_denom = N_VDotProd(u, u); + if (omega_denom == ZERO) omega_denom = ONE; + omega = (N_VDotProd(u, q) / omega_denom); + + /* Update x = x + alpha*p + omega*q */ + + N_VLinearSum(alpha, p, omega, q, vtemp); + N_VLinearSum(ONE, x, ONE, vtemp, x); + + /* Update the residual r = q - omega*u */ + + N_VLinearSum(ONE, q, -omega, u, r); + + /* Set rho = norm(r) and check convergence */ + + *res_norm = rho = RSqrt(N_VDotProd(r, r)); + if (rho <= delta) { + converged = TRUE; + break; + } + + /* Not yet converged, continue iteration */ + /* Update beta = / * alpha / omega */ + + beta_num = N_VDotProd(r, r_star); + beta = ((beta_num / beta_denom) * (alpha / omega)); + beta_denom = beta_num; + + /* Update p = r + beta*(p - omega*Ap) */ + + N_VLinearSum(ONE, p, -omega, Ap, vtemp); + N_VLinearSum(ONE, r, beta, vtemp, p); + + } + + /* Main loop finished */ + + if ((converged == TRUE) || (rho < r_norm)) { + + /* Apply the x-scaling and right preconditioner: x = P2_inv sx_inv x */ + + if (scale_x) N_VDiv(x, sx, x); + if (preOnRight) { + ier = psolve(P_data, x, vtemp, PREC_RIGHT); + (*nps)++; + if (ier != 0) return((ier < 0) ? SPBCG_PSOLVE_FAIL_UNREC : SPBCG_PSOLVE_FAIL_REC); + N_VScale(ONE, vtemp, x); + } + + if (converged == TRUE) return(SPBCG_SUCCESS); + else return(SPBCG_RES_REDUCED); + } + else return(SPBCG_CONV_FAIL); +} + +/* + * ----------------------------------------------------------------- + * Function : SpbcgFree + * ----------------------------------------------------------------- + */ + +void SpbcgFree(SpbcgMem mem) +{ + + if (mem == NULL) return; + + N_VDestroy(mem->r_star); + N_VDestroy(mem->r); + N_VDestroy(mem->p); + N_VDestroy(mem->q); + N_VDestroy(mem->u); + N_VDestroy(mem->Ap); + N_VDestroy(mem->vtemp); + + free(mem); mem = NULL; +} diff --git a/odemex/Parser/CVode/ida_src/src/sundials/sundials_spgmr.c b/odemex/Parser/CVode/ida_src/src/sundials/sundials_spgmr.c new file mode 100644 index 0000000..7efd187 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/sundials/sundials_spgmr.c @@ -0,0 +1,458 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2007/04/06 20:33:30 $ + * ----------------------------------------------------------------- + * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and + * Radu Serban @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2002, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for the scaled preconditioned + * GMRES (SPGMR) iterative linear solver. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include +#include + +/* + * ----------------------------------------------------------------- + * private constants + * ----------------------------------------------------------------- + */ + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + +/* + * ----------------------------------------------------------------- + * Function : SpgmrMalloc + * ----------------------------------------------------------------- + */ + +SpgmrMem SpgmrMalloc(int l_max, N_Vector vec_tmpl) +{ + SpgmrMem mem; + N_Vector *V, xcor, vtemp; + realtype **Hes, *givens, *yg; + int k, i; + + /* Check the input parameters. */ + + if (l_max <= 0) return(NULL); + + /* Get memory for the Krylov basis vectors V[0], ..., V[l_max]. */ + + V = N_VCloneVectorArray(l_max+1, vec_tmpl); + if (V == NULL) return(NULL); + + /* Get memory for the Hessenberg matrix Hes. */ + + Hes = NULL; + Hes = (realtype **) malloc((l_max+1)*sizeof(realtype *)); + if (Hes == NULL) { + N_VDestroyVectorArray(V, l_max+1); + return(NULL); + } + + for (k = 0; k <= l_max; k++) { + Hes[k] = NULL; + Hes[k] = (realtype *) malloc(l_max*sizeof(realtype)); + if (Hes[k] == NULL) { + for (i = 0; i < k; i++) {free(Hes[i]); Hes[i] = NULL;} + free(Hes); Hes = NULL; + N_VDestroyVectorArray(V, l_max+1); + return(NULL); + } + } + + /* Get memory for Givens rotation components. */ + + givens = NULL; + givens = (realtype *) malloc(2*l_max*sizeof(realtype)); + if (givens == NULL) { + for (i = 0; i <= l_max; i++) {free(Hes[i]); Hes[i] = NULL;} + free(Hes); Hes = NULL; + N_VDestroyVectorArray(V, l_max+1); + return(NULL); + } + + /* Get memory to hold the correction to z_tilde. */ + + xcor = N_VClone(vec_tmpl); + if (xcor == NULL) { + free(givens); givens = NULL; + for (i = 0; i <= l_max; i++) {free(Hes[i]); Hes[i] = NULL;} + free(Hes); Hes = NULL; + N_VDestroyVectorArray(V, l_max+1); + return(NULL); + } + + /* Get memory to hold SPGMR y and g vectors. */ + + yg = NULL; + yg = (realtype *) malloc((l_max+1)*sizeof(realtype)); + if (yg == NULL) { + N_VDestroy(xcor); + free(givens); givens = NULL; + for (i = 0; i <= l_max; i++) {free(Hes[i]); Hes[i] = NULL;} + free(Hes); Hes = NULL; + N_VDestroyVectorArray(V, l_max+1); + return(NULL); + } + + /* Get an array to hold a temporary vector. */ + + vtemp = N_VClone(vec_tmpl); + if (vtemp == NULL) { + free(yg); yg = NULL; + N_VDestroy(xcor); + free(givens); givens = NULL; + for (i = 0; i <= l_max; i++) {free(Hes[i]); Hes[i] = NULL;} + free(Hes); Hes = NULL; + N_VDestroyVectorArray(V, l_max+1); + return(NULL); + } + + /* Get memory for an SpgmrMemRec containing SPGMR matrices and vectors. */ + + mem = NULL; + mem = (SpgmrMem) malloc(sizeof(SpgmrMemRec)); + if (mem == NULL) { + N_VDestroy(vtemp); + free(yg); yg = NULL; + N_VDestroy(xcor); + free(givens); givens = NULL; + for (i = 0; i <= l_max; i++) {free(Hes[i]); Hes[i] = NULL;} + free(Hes); Hes = NULL; + N_VDestroyVectorArray(V, l_max+1); + return(NULL); + } + + /* Set the fields of mem. */ + + mem->l_max = l_max; + mem->V = V; + mem->Hes = Hes; + mem->givens = givens; + mem->xcor = xcor; + mem->yg = yg; + mem->vtemp = vtemp; + + /* Return the pointer to SPGMR memory. */ + + return(mem); +} + +/* + * ----------------------------------------------------------------- + * Function : SpgmrSolve + * ----------------------------------------------------------------- + */ + +int SpgmrSolve(SpgmrMem mem, void *A_data, N_Vector x, N_Vector b, + int pretype, int gstype, realtype delta, int max_restarts, + void *P_data, N_Vector s1, N_Vector s2, ATimesFn atimes, + PSolveFn psolve, realtype *res_norm, int *nli, int *nps) +{ + N_Vector *V, xcor, vtemp; + realtype **Hes, *givens, *yg; + realtype beta, rotation_product, r_norm, s_product, rho; + booleantype preOnLeft, preOnRight, scale2, scale1, converged; + int i, j, k, l, l_plus_1, l_max, krydim, ier, ntries; + + if (mem == NULL) return(SPGMR_MEM_NULL); + + /* Initialize some variables */ + + l_plus_1 = 0; + krydim = 0; + + /* Make local copies of mem variables. */ + + l_max = mem->l_max; + V = mem->V; + Hes = mem->Hes; + givens = mem->givens; + xcor = mem->xcor; + yg = mem->yg; + vtemp = mem->vtemp; + + *nli = *nps = 0; /* Initialize counters */ + converged = FALSE; /* Initialize converged flag */ + + if (max_restarts < 0) max_restarts = 0; + + if ((pretype != PREC_LEFT) && (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) + pretype = PREC_NONE; + + preOnLeft = ((pretype == PREC_LEFT) || (pretype == PREC_BOTH)); + preOnRight = ((pretype == PREC_RIGHT) || (pretype == PREC_BOTH)); + scale1 = (s1 != NULL); + scale2 = (s2 != NULL); + + /* Set vtemp and V[0] to initial (unscaled) residual r_0 = b - A*x_0. */ + + if (N_VDotProd(x, x) == ZERO) { + N_VScale(ONE, b, vtemp); + } else { + ier = atimes(A_data, x, vtemp); + if (ier != 0) + return((ier < 0) ? SPGMR_ATIMES_FAIL_UNREC : SPGMR_ATIMES_FAIL_REC); + N_VLinearSum(ONE, b, -ONE, vtemp, vtemp); + } + N_VScale(ONE, vtemp, V[0]); + + /* Apply left preconditioner and left scaling to V[0] = r_0. */ + + if (preOnLeft) { + ier = psolve(P_data, V[0], vtemp, PREC_LEFT); + (*nps)++; + if (ier != 0) + return((ier < 0) ? SPGMR_PSOLVE_FAIL_UNREC : SPGMR_PSOLVE_FAIL_REC); + } else { + N_VScale(ONE, V[0], vtemp); + } + + if (scale1) { + N_VProd(s1, vtemp, V[0]); + } else { + N_VScale(ONE, vtemp, V[0]); + } + + /* Set r_norm = beta to L2 norm of V[0] = s1 P1_inv r_0, and + return if small. */ + + *res_norm = r_norm = beta = RSqrt(N_VDotProd(V[0], V[0])); + if (r_norm <= delta) + return(SPGMR_SUCCESS); + + /* Initialize rho to avoid compiler warning message */ + + rho = beta; + + /* Set xcor = 0. */ + + N_VConst(ZERO, xcor); + + + /* Begin outer iterations: up to (max_restarts + 1) attempts. */ + + for (ntries = 0; ntries <= max_restarts; ntries++) { + + /* Initialize the Hessenberg matrix Hes and Givens rotation + product. Normalize the initial vector V[0]. */ + + for (i = 0; i <= l_max; i++) + for (j = 0; j < l_max; j++) + Hes[i][j] = ZERO; + + rotation_product = ONE; + + N_VScale(ONE/r_norm, V[0], V[0]); + + /* Inner loop: generate Krylov sequence and Arnoldi basis. */ + + for (l = 0; l < l_max; l++) { + + (*nli)++; + + krydim = l_plus_1 = l + 1; + + /* Generate A-tilde V[l], where A-tilde = s1 P1_inv A P2_inv s2_inv. */ + + /* Apply right scaling: vtemp = s2_inv V[l]. */ + + if (scale2) N_VDiv(V[l], s2, vtemp); + else N_VScale(ONE, V[l], vtemp); + + /* Apply right preconditioner: vtemp = P2_inv s2_inv V[l]. */ + + if (preOnRight) { + N_VScale(ONE, vtemp, V[l_plus_1]); + ier = psolve(P_data, V[l_plus_1], vtemp, PREC_RIGHT); + (*nps)++; + if (ier != 0) + return((ier < 0) ? SPGMR_PSOLVE_FAIL_UNREC : SPGMR_PSOLVE_FAIL_REC); + } + + /* Apply A: V[l+1] = A P2_inv s2_inv V[l]. */ + + ier = atimes(A_data, vtemp, V[l_plus_1] ); + if (ier != 0) + return((ier < 0) ? SPGMR_ATIMES_FAIL_UNREC : SPGMR_ATIMES_FAIL_REC); + + /* Apply left preconditioning: vtemp = P1_inv A P2_inv s2_inv V[l]. */ + + if (preOnLeft) { + ier = psolve(P_data, V[l_plus_1], vtemp, PREC_LEFT); + (*nps)++; + if (ier != 0) + return((ier < 0) ? SPGMR_PSOLVE_FAIL_UNREC : SPGMR_PSOLVE_FAIL_REC); + } else { + N_VScale(ONE, V[l_plus_1], vtemp); + } + + /* Apply left scaling: V[l+1] = s1 P1_inv A P2_inv s2_inv V[l]. */ + + if (scale1) { + N_VProd(s1, vtemp, V[l_plus_1]); + } else { + N_VScale(ONE, vtemp, V[l_plus_1]); + } + + /* Orthogonalize V[l+1] against previous V[i]: V[l+1] = w_tilde. */ + + if (gstype == CLASSICAL_GS) { + if (ClassicalGS(V, Hes, l_plus_1, l_max, &(Hes[l_plus_1][l]), + vtemp, yg) != 0) + return(SPGMR_GS_FAIL); + } else { + if (ModifiedGS(V, Hes, l_plus_1, l_max, &(Hes[l_plus_1][l])) != 0) + return(SPGMR_GS_FAIL); + } + + /* Update the QR factorization of Hes. */ + + if(QRfact(krydim, Hes, givens, l) != 0 ) + return(SPGMR_QRFACT_FAIL); + + /* Update residual norm estimate; break if convergence test passes. */ + + rotation_product *= givens[2*l+1]; + *res_norm = rho = ABS(rotation_product*r_norm); + + if (rho <= delta) { converged = TRUE; break; } + + /* Normalize V[l+1] with norm value from the Gram-Schmidt routine. */ + + N_VScale(ONE/Hes[l_plus_1][l], V[l_plus_1], V[l_plus_1]); + } + + /* Inner loop is done. Compute the new correction vector xcor. */ + + /* Construct g, then solve for y. */ + + yg[0] = r_norm; + for (i = 1; i <= krydim; i++) yg[i]=ZERO; + if (QRsol(krydim, Hes, givens, yg) != 0) + return(SPGMR_QRSOL_FAIL); + + /* Add correction vector V_l y to xcor. */ + + for (k = 0; k < krydim; k++) + N_VLinearSum(yg[k], V[k], ONE, xcor, xcor); + + /* If converged, construct the final solution vector x and return. */ + + if (converged) { + + /* Apply right scaling and right precond.: vtemp = P2_inv s2_inv xcor. */ + + if (scale2) N_VDiv(xcor, s2, xcor); + if (preOnRight) { + ier = psolve(P_data, xcor, vtemp, PREC_RIGHT); + (*nps)++; + if (ier != 0) + return((ier < 0) ? SPGMR_PSOLVE_FAIL_UNREC : SPGMR_PSOLVE_FAIL_REC); + } else { + N_VScale(ONE, xcor, vtemp); + } + + /* Add vtemp to initial x to get final solution x, and return */ + + N_VLinearSum(ONE, x, ONE, vtemp, x); + + return(SPGMR_SUCCESS); + } + + /* Not yet converged; if allowed, prepare for restart. */ + + if (ntries == max_restarts) break; + + /* Construct last column of Q in yg. */ + + s_product = ONE; + for (i = krydim; i > 0; i--) { + yg[i] = s_product*givens[2*i-2]; + s_product *= givens[2*i-1]; + } + yg[0] = s_product; + + /* Scale r_norm and yg. */ + r_norm *= s_product; + for (i = 0; i <= krydim; i++) + yg[i] *= r_norm; + r_norm = ABS(r_norm); + + /* Multiply yg by V_(krydim+1) to get last residual vector; restart. */ + N_VScale(yg[0], V[0], V[0]); + for (k = 1; k <= krydim; k++) + N_VLinearSum(yg[k], V[k], ONE, V[0], V[0]); + + } + + /* Failed to converge, even after allowed restarts. + If the residual norm was reduced below its initial value, compute + and return x anyway. Otherwise return failure flag. */ + + if (rho < beta) { + + /* Apply right scaling and right precond.: vtemp = P2_inv s2_inv xcor. */ + + if (scale2) N_VDiv(xcor, s2, xcor); + if (preOnRight) { + ier = psolve(P_data, xcor, vtemp, PREC_RIGHT); + (*nps)++; + if (ier != 0) + return((ier < 0) ? SPGMR_PSOLVE_FAIL_UNREC : SPGMR_PSOLVE_FAIL_REC); + } else { + N_VScale(ONE, xcor, vtemp); + } + + /* Add vtemp to initial x to get final solution x, and return. */ + + N_VLinearSum(ONE, x, ONE, vtemp, x); + + return(SPGMR_RES_REDUCED); + } + + return(SPGMR_CONV_FAIL); +} + +/* + * ----------------------------------------------------------------- + * Function : SpgmrFree + * ----------------------------------------------------------------- + */ + +void SpgmrFree(SpgmrMem mem) +{ + int i, l_max; + realtype **Hes, *givens, *yg; + + if (mem == NULL) return; + + l_max = mem->l_max; + Hes = mem->Hes; + givens = mem->givens; + yg = mem->yg; + + for (i = 0; i <= l_max; i++) {free(Hes[i]); Hes[i] = NULL;} + free(Hes); Hes = NULL; + free(mem->givens); givens = NULL; + free(mem->yg); yg = NULL; + + N_VDestroyVectorArray(mem->V, l_max+1); + N_VDestroy(mem->xcor); + N_VDestroy(mem->vtemp); + + free(mem); mem = NULL; +} diff --git a/odemex/Parser/CVode/ida_src/src/sundials/sundials_sptfqmr.c b/odemex/Parser/CVode/ida_src/src/sundials/sundials_sptfqmr.c new file mode 100644 index 0000000..626ca00 --- /dev/null +++ b/odemex/Parser/CVode/ida_src/src/sundials/sundials_sptfqmr.c @@ -0,0 +1,516 @@ +/* + * ----------------------------------------------------------------- + * $Revision: 1.2 $ + * $Date: 2007/04/06 20:33:30 $ + * ----------------------------------------------------------------- + * Programmer(s): Aaron Collier @ LLNL + * ----------------------------------------------------------------- + * Copyright (c) 2005, The Regents of the University of California. + * Produced at the Lawrence Livermore National Laboratory. + * All rights reserved. + * For details, see the LICENSE file. + * ----------------------------------------------------------------- + * This is the implementation file for the scaled preconditioned + * Transpose-Free Quasi-Minimal Residual (SPTFQMR) linear solver. + * ----------------------------------------------------------------- + */ + +#include +#include + +#include +#include + +/* + * ----------------------------------------------------------------- + * private constants + * ----------------------------------------------------------------- + */ + +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + +/* + * ----------------------------------------------------------------- + * Function : SptfqmrMalloc + * ----------------------------------------------------------------- + */ + +SptfqmrMem SptfqmrMalloc(int l_max, N_Vector vec_tmpl) +{ + SptfqmrMem mem; + N_Vector *r; + N_Vector q, d, v, p, u; + N_Vector r_star, vtemp1, vtemp2, vtemp3; + + /* Check the input parameters */ + if ((l_max <= 0) || (vec_tmpl == NULL)) return(NULL); + + /* Allocate space for vectors */ + + r_star = N_VClone(vec_tmpl); + if (r_star == NULL) return(NULL); + + q = N_VClone(vec_tmpl); + if (q == NULL) { + N_VDestroy(r_star); + return(NULL); + } + + d = N_VClone(vec_tmpl); + if (d == NULL) { + N_VDestroy(r_star); + N_VDestroy(q); + return(NULL); + } + + v = N_VClone(vec_tmpl); + if (v == NULL) { + N_VDestroy(r_star); + N_VDestroy(q); + N_VDestroy(d); + return(NULL); + } + + p = N_VClone(vec_tmpl); + if (p == NULL) { + N_VDestroy(r_star); + N_VDestroy(q); + N_VDestroy(d); + N_VDestroy(v); + return(NULL); + } + + r = N_VCloneVectorArray(2, vec_tmpl); + if (r == NULL) { + N_VDestroy(r_star); + N_VDestroy(q); + N_VDestroy(d); + N_VDestroy(v); + N_VDestroy(p); + return(NULL); + } + + u = N_VClone(vec_tmpl); + if (u == NULL) { + N_VDestroy(r_star); + N_VDestroy(q); + N_VDestroy(d); + N_VDestroy(v); + N_VDestroy(p); + N_VDestroyVectorArray(r, 2); + return(NULL); + } + + vtemp1 = N_VClone(vec_tmpl); + if (vtemp1 == NULL) { + N_VDestroy(r_star); + N_VDestroy(q); + N_VDestroy(d); + N_VDestroy(v); + N_VDestroy(p); + N_VDestroyVectorArray(r, 2); + N_VDestroy(u); + return(NULL); + } + + vtemp2 = N_VClone(vec_tmpl); + if (vtemp2 == NULL) { + N_VDestroy(r_star); + N_VDestroy(q); + N_VDestroy(d); + N_VDestroy(v); + N_VDestroy(p); + N_VDestroyVectorArray(r, 2); + N_VDestroy(u); + N_VDestroy(vtemp1); + return(NULL); + } + + vtemp3 = N_VClone(vec_tmpl); + if (vtemp3 == NULL) { + N_VDestroy(r_star); + N_VDestroy(q); + N_VDestroy(d); + N_VDestroy(v); + N_VDestroy(p); + N_VDestroyVectorArray(r, 2); + N_VDestroy(u); + N_VDestroy(vtemp1); + N_VDestroy(vtemp2); + return(NULL); + } + + /* Allocate memory for SptfqmrMemRec */ + mem = NULL; + mem = (SptfqmrMem) malloc(sizeof(SptfqmrMemRec)); + if (mem == NULL) { + N_VDestroy(r_star); + N_VDestroy(q); + N_VDestroy(d); + N_VDestroy(v); + N_VDestroy(p); + N_VDestroyVectorArray(r, 2); + N_VDestroy(u); + N_VDestroy(vtemp1); + N_VDestroy(vtemp2); + N_VDestroy(vtemp3); + return(NULL); + } + + /* Intialize SptfqmrMemRec data structure */ + mem->l_max = l_max; + mem->r_star = r_star; + mem->q = q; + mem->d = d; + mem->v = v; + mem->p = p; + mem->r = r; + mem->u = u; + mem->vtemp1 = vtemp1; + mem->vtemp2 = vtemp2; + mem->vtemp3 = vtemp3; + + /* Return pointer to SPTFQMR memory block */ + return(mem); +} + +#define l_max (mem->l_max) +#define r_star (mem->r_star) +#define q_ (mem->q) +#define d_ (mem->d) +#define v_ (mem->v) +#define p_ (mem->p) +#define r_ (mem->r) +#define u_ (mem->u) +#define vtemp1 (mem->vtemp1) +#define vtemp2 (mem->vtemp2) +#define vtemp3 (mem->vtemp3) + +/* + * ----------------------------------------------------------------- + * Function : SptfqmrSolve + * ----------------------------------------------------------------- + */ + +int SptfqmrSolve(SptfqmrMem mem, void *A_data, N_Vector x, N_Vector b, + int pretype, realtype delta, void *P_data, N_Vector sx, + N_Vector sb, ATimesFn atimes, PSolveFn psolve, + realtype *res_norm, int *nli, int *nps) +{ + realtype alpha, tau, eta, beta, c, sigma, v_bar, omega; + realtype rho[2]; + realtype r_init_norm, r_curr_norm; + realtype temp_val; + booleantype preOnLeft, preOnRight, scale_x, scale_b, converged; + booleantype b_ok; + int n, m, ier; + + /* Exit immediately if memory pointer is NULL */ + if (mem == NULL) return(SPTFQMR_MEM_NULL); + + temp_val = r_curr_norm = -ONE; /* Initialize to avoid compiler warnings */ + + *nli = *nps = 0; /* Initialize counters */ + converged = FALSE; /* Initialize convergence flag */ + b_ok = FALSE; + + if ((pretype != PREC_LEFT) && + (pretype != PREC_RIGHT) && + (pretype != PREC_BOTH)) pretype = PREC_NONE; + + preOnLeft = ((pretype == PREC_BOTH) || (pretype == PREC_LEFT)); + preOnRight = ((pretype == PREC_BOTH) || (pretype == PREC_RIGHT)); + + scale_x = (sx != NULL); + scale_b = (sb != NULL); + + /* Set r_star to initial (unscaled) residual r_star = r_0 = b - A*x_0 */ + /* NOTE: if x == 0 then just set residual to b and continue */ + if (N_VDotProd(x, x) == ZERO) N_VScale(ONE, b, r_star); + else { + ier = atimes(A_data, x, r_star); + if (ier != 0) + return((ier < 0) ? SPTFQMR_ATIMES_FAIL_UNREC : SPTFQMR_ATIMES_FAIL_REC); + N_VLinearSum(ONE, b, -ONE, r_star, r_star); + } + + /* Apply left preconditioner and b-scaling to r_star (or really just r_0) */ + if (preOnLeft) { + ier = psolve(P_data, r_star, vtemp1, PREC_LEFT); + (*nps)++; + if (ier != 0) + return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); + } + else N_VScale(ONE, r_star, vtemp1); + if (scale_b) N_VProd(sb, vtemp1, r_star); + else N_VScale(ONE, vtemp1, r_star); + + /* Initialize rho[0] */ + /* NOTE: initialized here to reduce number of computations - avoid need + to compute r_star^T*r_star twice, and avoid needlessly squaring + values */ + rho[0] = N_VDotProd(r_star, r_star); + + /* Compute norm of initial residual (r_0) to see if we really need + to do anything */ + *res_norm = r_init_norm = RSqrt(rho[0]); + if (r_init_norm <= delta) return(SPTFQMR_SUCCESS); + + /* Set v_ = A*r_0 (preconditioned and scaled) */ + if (scale_x) N_VDiv(r_star, sx, vtemp1); + else N_VScale(ONE, r_star, vtemp1); + if (preOnRight) { + N_VScale(ONE, vtemp1, v_); + ier = psolve(P_data, v_, vtemp1, PREC_RIGHT); + (*nps)++; + if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); + } + ier = atimes(A_data, vtemp1, v_); + if (ier != 0) + return((ier < 0) ? SPTFQMR_ATIMES_FAIL_UNREC : SPTFQMR_ATIMES_FAIL_REC); + if (preOnLeft) { + ier = psolve(P_data, v_, vtemp1, PREC_LEFT); + (*nps)++; + if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); + } + else N_VScale(ONE, v_, vtemp1); + if (scale_b) N_VProd(sb, vtemp1, v_); + else N_VScale(ONE, vtemp1, v_); + + /* Initialize remaining variables */ + N_VScale(ONE, r_star, r_[0]); + N_VScale(ONE, r_star, u_); + N_VScale(ONE, r_star, p_); + N_VConst(ZERO, d_); + + tau = r_init_norm; + v_bar = eta = ZERO; + + /* START outer loop */ + for (n = 0; n < l_max; ++n) { + + /* Increment linear iteration counter */ + (*nli)++; + + /* sigma = r_star^T*v_ */ + sigma = N_VDotProd(r_star, v_); + + /* alpha = rho[0]/sigma */ + alpha = rho[0]/sigma; + + /* q_ = u_-alpha*v_ */ + N_VLinearSum(ONE, u_, -alpha, v_, q_); + + /* r_[1] = r_[0]-alpha*A*(u_+q_) */ + N_VLinearSum(ONE, u_, ONE, q_, r_[1]); + if (scale_x) N_VDiv(r_[1], sx, r_[1]); + if (preOnRight) { + N_VScale(ONE, r_[1], vtemp1); + ier = psolve(P_data, vtemp1, r_[1], PREC_RIGHT); + (*nps)++; + if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); + } + ier = atimes(A_data, r_[1], vtemp1); + if (ier != 0) + return((ier < 0) ? SPTFQMR_ATIMES_FAIL_UNREC : SPTFQMR_ATIMES_FAIL_REC); + if (preOnLeft) { + ier = psolve(P_data, vtemp1, r_[1], PREC_LEFT); + (*nps)++; + if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); + } + else N_VScale(ONE, vtemp1, r_[1]); + if (scale_b) N_VProd(sb, r_[1], vtemp1); + else N_VScale(ONE, r_[1], vtemp1); + N_VLinearSum(ONE, r_[0], -alpha, vtemp1, r_[1]); + + /* START inner loop */ + for (m = 0; m < 2; ++m) { + + /* d_ = [*]+(v_bar^2*eta/alpha)*d_ */ + /* NOTES: + * (1) [*] = u_ if m == 0, and q_ if m == 1 + * (2) using temp_val reduces the number of required computations + * if the inner loop is executed twice + */ + if (m == 0) { + temp_val = RSqrt(N_VDotProd(r_[1], r_[1])); + omega = RSqrt(RSqrt(N_VDotProd(r_[0], r_[0]))*temp_val); + N_VLinearSum(ONE, u_, SQR(v_bar)*eta/alpha, d_, d_); + } + else { + omega = temp_val; + N_VLinearSum(ONE, q_, SQR(v_bar)*eta/alpha, d_, d_); + } + + /* v_bar = omega/tau */ + v_bar = omega/tau; + + /* c = (1+v_bar^2)^(-1/2) */ + c = ONE / RSqrt(ONE+SQR(v_bar)); + + /* tau = tau*v_bar*c */ + tau = tau*v_bar*c; + + /* eta = c^2*alpha */ + eta = SQR(c)*alpha; + + /* x = x+eta*d_ */ + N_VLinearSum(ONE, x, eta, d_, x); + + /* Check for convergence... */ + /* NOTE: just use approximation to norm of residual, if possible */ + *res_norm = r_curr_norm = tau*RSqrt(m+1); + + /* Exit inner loop if iteration has converged based upon approximation + to norm of current residual */ + if (r_curr_norm <= delta) { + converged = TRUE; + break; + } + + /* Decide if actual norm of residual vector should be computed */ + /* NOTES: + * (1) if r_curr_norm > delta, then check if actual residual norm + * is OK (recall we first compute an approximation) + * (2) if r_curr_norm >= r_init_norm and m == 1 and n == l_max, then + * compute actual residual norm to see if the iteration can be + * saved + * (3) the scaled and preconditioned right-hand side of the given + * linear system (denoted by b) is only computed once, and the + * result is stored in vtemp3 so it can be reused - reduces the + * number of psovles if using left preconditioning + */ + if ((r_curr_norm > delta) || + (r_curr_norm >= r_init_norm && m == 1 && n == l_max)) { + + /* Compute norm of residual ||b-A*x||_2 (preconditioned and scaled) */ + if (scale_x) N_VDiv(x, sx, vtemp1); + else N_VScale(ONE, x, vtemp1); + if (preOnRight) { + ier = psolve(P_data, vtemp1, vtemp2, PREC_RIGHT); + (*nps)++; + if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_UNREC); + N_VScale(ONE, vtemp2, vtemp1); + } + ier = atimes(A_data, vtemp1, vtemp2); + if (ier != 0) + return((ier < 0) ? SPTFQMR_ATIMES_FAIL_UNREC : SPTFQMR_ATIMES_FAIL_REC); + if (preOnLeft) { + ier = psolve(P_data, vtemp2, vtemp1, PREC_LEFT); + (*nps)++; + if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); + } + else N_VScale(ONE, vtemp2, vtemp1); + if (scale_b) N_VProd(sb, vtemp1, vtemp2); + else N_VScale(ONE, vtemp1, vtemp2); + /* Only precondition and scale b once (result saved for reuse) */ + if (!b_ok) { + b_ok = TRUE; + if (preOnLeft) { + ier = psolve(P_data, b, vtemp3, PREC_LEFT); + (*nps)++; + if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); + } + else N_VScale(ONE, b, vtemp3); + if (scale_b) N_VProd(sb, vtemp3, vtemp3); + } + N_VLinearSum(ONE, vtemp3, -ONE, vtemp2, vtemp1); + *res_norm = r_curr_norm = RSqrt(N_VDotProd(vtemp1, vtemp1)); + + /* Exit inner loop if inequality condition is satisfied + (meaning exit if we have converged) */ + if (r_curr_norm <= delta) { + converged = TRUE; + break; + } + + } + + } /* END inner loop */ + + /* If converged, then exit outer loop as well */ + if (converged == TRUE) break; + + /* rho[1] = r_star^T*r_[1] */ + rho[1] = N_VDotProd(r_star, r_[1]); + + /* beta = rho[1]/rho[0] */ + beta = rho[1]/rho[0]; + + /* u_ = r_[1]+beta*q_ */ + N_VLinearSum(ONE, r_[1], beta, q_, u_); + + /* p_ = u_+beta*(q_+beta*p_) */ + N_VLinearSum(beta, q_, SQR(beta), p_, p_); + N_VLinearSum(ONE, u_, ONE, p_, p_); + + /* v_ = A*p_ */ + if (scale_x) N_VDiv(p_, sx, vtemp1); + else N_VScale(ONE, p_, vtemp1); + if (preOnRight) { + N_VScale(ONE, vtemp1, v_); + ier = psolve(P_data, v_, vtemp1, PREC_RIGHT); + (*nps)++; + if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); + } + ier = atimes(A_data, vtemp1, v_); + if (ier != 0) + return((ier < 0) ? SPTFQMR_ATIMES_FAIL_UNREC : SPTFQMR_ATIMES_FAIL_REC); + if (preOnLeft) { + ier = psolve(P_data, v_, vtemp1, PREC_LEFT); + (*nps)++; + if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); + } + else N_VScale(ONE, v_, vtemp1); + if (scale_b) N_VProd(sb, vtemp1, v_); + else N_VScale(ONE, vtemp1, v_); + + /* Shift variable values */ + /* NOTE: reduces storage requirements */ + N_VScale(ONE, r_[1], r_[0]); + rho[0] = rho[1]; + + } /* END outer loop */ + + /* Determine return value */ + /* If iteration converged or residual was reduced, then return current iterate (x) */ + if ((converged == TRUE) || (r_curr_norm < r_init_norm)) { + if (scale_x) N_VDiv(x, sx, x); + if (preOnRight) { + ier = psolve(P_data, x, vtemp1, PREC_RIGHT); + (*nps)++; + if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_UNREC); + N_VScale(ONE, vtemp1, x); + } + if (converged == TRUE) return(SPTFQMR_SUCCESS); + else return(SPTFQMR_RES_REDUCED); + } + /* Otherwise, return error code */ + else return(SPTFQMR_CONV_FAIL); +} + +/* + * ----------------------------------------------------------------- + * Function : SptfqmrFree + * ----------------------------------------------------------------- + */ + +void SptfqmrFree(SptfqmrMem mem) +{ + + if (mem == NULL) return; + + N_VDestroy(r_star); + N_VDestroy(q_); + N_VDestroy(d_); + N_VDestroy(v_); + N_VDestroy(p_); + N_VDestroyVectorArray(r_, 2); + N_VDestroy(u_); + N_VDestroy(vtemp1); + N_VDestroy(vtemp2); + N_VDestroy(vtemp3); + + free(mem); mem = NULL; +} diff --git a/odemex/Parser/CVode/lib/CVODE.lib b/odemex/Parser/CVode/lib/CVODE.lib new file mode 100644 index 0000000..490d142 Binary files /dev/null and b/odemex/Parser/CVode/lib/CVODE.lib differ diff --git a/odemex/Parser/CVode/setupCVode.m b/odemex/Parser/CVode/setupCVode.m new file mode 100644 index 0000000..bf31417 --- /dev/null +++ b/odemex/Parser/CVode/setupCVode.m @@ -0,0 +1,170 @@ +% This file compiles CVode for use with MATLAB + +chooseCompiler; +mkdir( [cvodeDir '/tmp'] ); + +% List of directories to include in the compilation +list = { 'cvodes' 'nvec_ser' 'sundials' }; + +% Make a list of filenames to include in the compilation +names = ''; +sourceDir = [ parserDir 'CVode/' ]; + +for q = 1 : length( list ) + fList = dir( sprintf( '%s/cv_src/src/%s/*.c', sourceDir, list{q} ) ); + + for l = 1 : length( fList ) + names = sprintf( '%s ''%s/cv_src/src/%s/%s''', names, sourceDir, list{q}, fList(l).name ); + end +end + +% for q = 1 : length( list ) +% tmp = ls( sprintf( '%s/cv_src/src/%s/*.c', sourceDir, list{q} ) ); +% % Under Windows we need to add the directory name +% % under linux this is already done. +% if ~isunix +% tmp = [ repmat( sprintf( '%s/cv_src/src/%s/', sourceDir, list{q} ), size( tmp, 1 ), 1 ), tmp, repmat( ' ', size( tmp, 1 ), 1 )]; +% end +% +% [a, b] = size(tmp); +% +% names = [ names ' ' reshape( tmp.', 1, a*b ) ]; +% end + +% Get rid of extra spaces since the compiler seems to dislike these. +nLen = 1; +len = length( names ); +while( nLen < len ) + len = nLen; + names = strrep( names, sprintf( '\n' ), ' ' ); + names = strrep( names, sprintf( '\r\n' ), ' ' ); + names = strrep( names, ' ', ' ' ); + nLen = length( names ); +end + +if ( compiler < 3 ) + % Compile the CVode source files! + eval( sprintf( 'mex -v -c -O -outdir ''%s/tmp'' -I''%s/cv_src/include/'' %s COMPFLAGS="$COMPFLAGS %s"', cvodeDir, sourceDir, names, flags ) ); +% eval( sprintf( 'mex %s -v -c -outdir ''%s/tmp'' -I''%s/cv_src/include/'' ''%s'' COMPFLAGS="$COMPFLAGS %s" "%s" "%s"', extraflags, cvodeDir, sourceDir, names, flags, lapack, blas ) ); +end + +% Bind the object code files into a library. +% To be able to do that the lib.exe needs to be +% in the system path. +disp('Generating library ...'); + +% LCCWIN32 +if compiler == 1 + disp( 'Compiler: Lcc-win32' ); + eval( sprintf( '!"%s/bin/lcclib" /OUT:"%s\\tmp\\%s" "%s\\tmp\\*.obj"', compilerLocation, cvodeDir, libraryName, cvodeDir ) ); + delete( [ cvodeDir '/tmp/*.obj' ] ); + movefile( [ cvodeDir '/tmp/*.lib' ], [ cvodeDir '/lib' ] ); + rmdir( [ cvodeDir '/tmp' ] ) +end + +% MSVC +if compiler == 2 + disp( 'Compiler: Microsoft Visual C++' ) + + curDir = pwd; + %cd( [ compilerLocation '\bin\'] ) + + p = [ sprintf( 'PATH=%s\\Common7\\IDE;%s\\VC\\BIN;%s\\Common7\\Tools;%s\\Framework\\v3.5;%s\\Framework\\v2.0.50727;%s\\VC\\VCPackages\nlib "%s\\tmp\\*.obj" /OUT:"%s\\lib\\%s"\ncd\n', vsroot, vsroot, vsroot, netroot, netroot, vsroot, curDir, curDir, libraryName ) ]; + + %fid = fopen( [ compilerLocation '\bin\mslibmaker.bat' ], 'w' ); + % fprintf( fid, '%s\n', p ); + %fclose( fid ); + + fid = fopen( [ 'mslibmaker.bat' ], 'w' ); + fprintf( fid, '%s\n', p ); + fclose( fid ); + + dos( 'mslibmaker', '-echo' ); + delete mslibmaker.bat; + + delete( [ cvodeDir '/tmp/*.obj' ] ); + rmdir( [ cvodeDir '/tmp' ] ) +end + +% GCC win +if compiler == 3 + eval( sprintf( 'mex %s -v -c -outdir ''%s/tmp'' -I''%s/cv_src/include/'' ''%s'' COMPFLAGS="$COMPFLAGS %s" "%s" "%s"', extraflags, cvodeDir, sourceDir, names, flags, lapack, blas ) ); + + clear names, tmp; + names = ''; + tmp = ls( sprintf( '%s\\tmp\\*.obj', cvodeDir ) ); + + tmp = [ repmat( sprintf( '"%s\\tmp\\', cvodeDir ), size( tmp, 1 ), 1 ), tmp, repmat( '" ', size( tmp, 1 ), 1 )]; + [a, b] = size(tmp); + names = [ names reshape( tmp.', 1, a*b ) ]; + + nLen = 1; + len = length( names ); + while( nLen < len ) + len = nLen; + names = strrep( names, ' ', ' ' ); + nLen = length( names ); + end + + if ( exist( sprintf( '%s\\lib\\%s', cvodeDir, libraryName ) ) ~= 0 ) + delete( sprintf( '%s\\lib\\%s', cvodeDir, libraryName ) ); + disp( 'Old library deleted and updated with new version' ); + end + + eval( ['!' cygwinLib 'ar cr ' sprintf( '"%s\\lib\\%s" %s', cvodeDir, libraryName, names ) ] ); + + delete( [ cvodeDir '/tmp/*.obj' ] ); + rmdir( [ cvodeDir '/tmp' ] ) + +end + +% GCC linux +if compiler == 4 + eval( strrep( strcat( sprintf( 'mex %s -v -c -outdir ''%s/tmp'' -I''%s/cv_src/include/'' %s CFLAGS="$CFLAGS -fPIC %s"', extraflags, cvodeDir, sourceDir, names, flags ) ), sprintf( '\n' ), ' ' ) ); + + clear names; + names = ''; + tmp = ls( sprintf( '%s/tmp/*.o', cvodeDir ) ); + + tmp = strrep( tmp, sprintf('\n'), ' ' ); + names = strrep( tmp, sprintf('\t'), ' ' ); + + if ( exist( sprintf( '%s/lib/%s', cvodeDir, libraryName ) ) ~= 0 ) + delete( sprintf( '%s/lib/%s', cvodeDir, libraryName ) ); + disp( 'Old library deleted and updated with new version' ); + end + ['ar cr ' sprintf( '"%s/lib/%s" %s', cvodeDir, libraryName, strrep( names, '''', '"' ) ) ] + system( ['ar cr ' sprintf( '"%s/lib/%s" %s', cvodeDir, libraryName, strrep( names, '''', '"' ) ) ] ); + + delete( [ cvodeDir '/tmp/*.o' ] ); + rmdir( [ cvodeDir '/tmp' ] ) + +end + +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/Parser/CVode/setupIDA.m b/odemex/Parser/CVode/setupIDA.m new file mode 100644 index 0000000..5cd544b --- /dev/null +++ b/odemex/Parser/CVode/setupIDA.m @@ -0,0 +1,154 @@ +% This file compiles CVode for use with MATLAB + +chooseCompiler; +mkdir tmp; + +% List of directories to include in the compilation +list = { 'ida' 'nvec_ser' 'sundials' }; + +% Make a list of filenames to include in the compilation +names = ''; +for q = 1 : length( list ) + sprintf( 'ida_src/src/%s/*.c', list{q} ) + tmp = ls( sprintf( 'ida_src/src/%s/*.c', list{q} ) ); + % Under Windows we need to add the directory name + % under linux this is already done. + if ~isunix + tmp = [ repmat( sprintf( 'ida_src/src/%s/', list{q} ), size( tmp, 1 ), 1 ), tmp, repmat( ' ', size( tmp, 1 ), 1 )]; + end + + [a, b] = size(tmp); + + names = [ names ' ' reshape( tmp.', 1, a*b ) ]; +end + +% Get rid of extra spaces since the compiler seems to dislike these. +nLen = 1; +len = length( names ); +while( nLen < len ) + len = nLen; + names = strrep( names, ' ', ' ' ); + nLen = length( names ); +end + +if ( compiler < 3 ) + % Compile the CVode source files! + eval( sprintf( 'mex -v -c -O -outdir tmp -Iida_src/include/ %s COMPFLAGS="$COMPFLAGS %s"', names, flags ) ); +end + +% Bind the object code files into a library. +% To be able to do that the lib.exe needs to be +% in the system path. +disp('Generating library ...'); + +% LCCWIN32 +if compiler == 1 + disp( 'Compiler: Lcc-win32' ); + eval( sprintf( '!"%s/bin/lcclib" /OUT:tmp\\%s tmp\\*.obj', compilerLocation, idaName ) ); + delete tmp/*.obj; + movefile( 'tmp/*.lib', 'lib'); + rmdir( 'tmp' ) +end + +% MSVC +if compiler == 2 + disp( 'Compiler: Microsoft Visual C++' ) + + curDir = pwd; + cd( [ compilerLocation '\bin\'] ) + + p = [ sprintf( 'PATH=%s\\Common7\\IDE;%s\\VC\\BIN;%s\\Common7\\Tools;%s\\Framework\\v3.5;%s\\Framework\\v2.0.50727;%s\\VC\\VCPackages\nlib "%s\\tmp\\*.obj" /OUT:"%s\\lib\\%s"\ncd\n', vsroot, vsroot, vsroot, netroot, netroot, vsroot, curDir, curDir, idaName ) ]; + + fid = fopen( [ compilerLocation '\bin\mslibmaker.bat' ], 'w' ); + fprintf( fid, '%s\n', p ); + fclose( fid ); + + dos( 'mslibmaker', '-echo' ); + delete mslibmaker.bat; + + cd( curDir ); + delete tmp/*.obj; + rmdir( 'tmp' ) +end + +% GCC win +if compiler == 3 + eval( sprintf( 'mex %s -v -c -outdir tmp -Iida_src/include/ %s COMPFLAGS="$COMPFLAGS %s" "%s" "%s"', extraflags, names, flags, lapack, blas ) ); + + clear names, tmp; + names = ''; + tmp = ls( sprintf( '%s\\tmp\\*.obj', cvodeDir ) ); + + tmp = [ repmat( sprintf( '"%s\\tmp\\', cvodeDir ), size( tmp, 1 ), 1 ), tmp, repmat( '" ', size( tmp, 1 ), 1 )]; + [a, b] = size(tmp); + names = [ names reshape( tmp.', 1, a*b ) ]; + + nLen = 1; + len = length( names ); + while( nLen < len ) + len = nLen; + names = strrep( names, ' ', ' ' ); + nLen = length( names ); + end + + if ( exist( sprintf( '%s\\lib\\%s', cvodeDir, idaName ) ) ~= 0 ) + delete( sprintf( '%s\\lib\\%s', cvodeDir, idaName ) ); + disp( 'Old library deleted and updated with new version' ); + end + + eval( ['!' cygwinLib 'ar cr ' sprintf( '"%s\\lib\\%s" %s', cvodeDir, idaName, names ) ] ); + + delete tmp/*.obj; + rmdir( 'tmp' ) + +end + +% GCC linux +if compiler == 4 + + eval( strrep( strcat( sprintf( 'mex %s -v -c -outdir tmp -Iida_src/include/ %s COMPFLAGS="$COMPFLAGS %s"', extraflags, names, flags ) ), sprintf( '\n' ), ' ' ) ); + + clear names, tmp; + names = ''; + tmp = ls( sprintf( '%s/tmp/*.o', cvodeDir ) ); + + tmp = strrep( tmp, sprintf('\n'), ' ' ); + names = strrep( tmp, sprintf('\t'), ' ' ); + + if ( exist( sprintf( '%s/lib/%s', cvodeDir, idaName ) ) ~= 0 ) + delete( sprintf( '%s/lib/%s', cvodeDir, idaName ) ); + disp( 'Old library deleted and updated with new version' ); + end + system( ['ar cr ' sprintf( '"%s/lib/%s" %s', cvodeDir, idaName, names ) ] ); + + delete tmp/*.o; + rmdir( 'tmp' ) + +end +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/Parser/cParserSet.m b/odemex/Parser/cParserSet.m new file mode 100644 index 0000000..801e69b --- /dev/null +++ b/odemex/Parser/cParserSet.m @@ -0,0 +1,135 @@ +% Function to set options of the parser +% +% Possible options are: +% solver Type of solver to use (* is default) +% 1 dense solver* +% 2 dense solver with LAPACK/BLAS +% 3 scaled preconditioned GMRES +% 4 preconditioned Bi-CGStab solver +% 5 preconditioned TFQMR iterative 6 solver +% 10 non-stiff problems +% +% blockSize Number of time steps to allocate each block +% when output times are not specified. +% Default: 1000 +% +% maxErrFail Maximum number of times the error criterions may +% fail within one timestep (many failures means +% long simulation time). +% Default: 15 +% +% maxConvFail Number of times the convergence of the linear +% subproblem may fail during one timestep. +% Default: 1000000 +% +% maxStep Maximum number of time steps allowed +% Default: 1000000000 +% +% nonNegative Will enforce non negativity of the solutions +% note that this amounts to reiterating a step +% whenever it is even slightly negative +% resulting in significant slowdowns +% Default: 0 (off) +% +% fixedRange Makes sure that when a dynamic time interval +% [ start finish ] is given, the end time actually +% corresponds to the specified end time. +% Default: 1 (on) +% +% aJac Use analytic Jacobian RHS for sensitivity +% calculation (experimental!!) +% +% minStep minimum stepsize (default = 1e-14) +% +% maxStepSize maximum stepsize (default = 1e14) +% +% Written by J. Vanlier +% Contact: j.vanlier@tue.nl + +function options = cParserSet( varargin ) + +inputArgs = { 'debug', 'fJac', 'aJac', 'solver', 'blockSize', 'maxErrFail', 'maxConvFail', 'maxStep', 'nonNegative', 'minStep', 'fixedRange', 'maxStepSize' }; +defaultVals = { 0, 0, 0, 1, 1000, 15, 1000000, 1000000000, 0, 1e-14, 1, 1e5 }; + +start = 1; + +if nargin == 0 + options = []; +else + try + if isa( varargin{ 1 }, 'char' ) + start = 1; + options = []; + else + if isa( varargin{ 1 }, 'struct' ) + options = varargin{1}; + start = 2; + else + disp( 'Argument one is invalid' ); + return; + end + end + catch + end +end + +if ~isempty( options ) + for a = 1 : length( inputArgs ) + try + getfield( options, inputArgs{a} ); + catch + disp( 'Invalid options structure!' ); + return; + end + end +else + for a = 1 : length( defaultVals ) + options = setfield( options, inputArgs{a}, defaultVals{a} ); + end +end + +for a = start : 2 : nargin - 1 + try + found = 0; + for b = 1 : length( inputArgs ) + if strcmp( varargin{ a }, inputArgs{ b } ) + found = 1; + end + end + if found == 1 + options = setfield( options, varargin{ a }, varargin{ a + 1 } ); + else + disp( sprintf( 'Invalid option: %s', varargin{ a } ) ) + end + catch + disp( sprintf( 'Problem setting options.' ) ) + end +end + +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/Parser/compileC.m b/odemex/Parser/compileC.m new file mode 100644 index 0000000..08cd8e2 --- /dev/null +++ b/odemex/Parser/compileC.m @@ -0,0 +1,75 @@ +% This function compiles the ODE file +% +% function compileC( outputName ) +% +% Input arguments +% outputName - filename without extension that specifies the name +% of the binary. +% +% Written by J. Vanlier +% Contact: j.vanlier@tue.nl + +function compileC( outputName, IDA ) + + DAE = 0; + if nargin > 1 + if IDA == 1 + DAE = 1; + end + end + + compilerPath = fileparts( mfilename( 'fullpath' ) ); + addpath( [ compilerPath '/CVode' ] ); + tempPath = [ compilerPath '/temp' ]; + eval( 'chooseCompiler' ); + + if nargin == 0 + disp( 'Please specify an output name for the MEX file (without extension)' ); + return; + end + + if DAE == 0 + eval( 'chooseCompiler' ); + if ~isunix + eval(sprintf('mex %s COMPFLAGS="$COMPFLAGS %s" -output %s -I"%s" "%s" "%s" "%s" "%s%s"', extraflags, flags, outputName, [compilerPath '/CVode/cv_src/include'], [compilerPath '/outputC/mexG.c'], [compilerPath '/outputC/ode.c'], [compilerPath '/outputC/model/dxdt.c'], [compilerPath '/CVode/lib/'], libraryName ) ); + else + eval(sprintf('mex %s CLIBS="\\$CLIBS -L./" COMPFLAGS="\\$COMPFLAGS %s -fPIC" -output %s -I"%s" "%s" "%s" "%s" "%s%s"', extraflags, flags, outputName, [compilerPath '/CVode/cv_src/include'], [compilerPath '/outputC/mexG.c'], [compilerPath '/outputC/ode.c'], [compilerPath '/outputC/model/dxdt.c'], [compilerPath '/CVode/lib/'], libraryName ) ); + end + else + eval( 'chooseCompiler' ); + if ~isunix + eval(sprintf('mex %s COMPFLAGS="$COMPFLAGS %s" -output %s -I"%s" "%s" "%s" "%s" "%s%s"', extraflags, flags, outputName, [compilerPath '/CVode/ida_src/include'], [compilerPath '/outputC_IDA/mexG.c'], [compilerPath '/outputC_IDA/ode.c'], [compilerPath '/outputC_IDA/model/dxdt.c'], [compilerPath '/CVode/lib/'], idaName ) ); + else + eval(sprintf('mex %s COMPFLAGS="$COMPFLAGS %s -fPIC" -output %s -I"%s" "%s" "%s" "%s" "%s%s"', extraflags, flags, outputName, [compilerPath '/CVode/ida_src/include'], [compilerPath '/outputC_IDA/mexG.c'], [compilerPath '/outputC_IDA/ode.c'], [compilerPath '/outputC_IDA/model/dxdt.c'], [compilerPath '/CVode/lib/'], idaName ) ); + + end + +end + +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/Parser/convertToC.m b/odemex/Parser/convertToC.m new file mode 100644 index 0000000..b775c9e --- /dev/null +++ b/odemex/Parser/convertToC.m @@ -0,0 +1,535 @@ +% M-File to C-file RHS parser +% +% function convertToC( mStruct, odeInput, dependencies, options ) +% +% Input arguments: +% mStruct - Structure containing state, parameter and input +% indices and constants in fields s p u and c +% respectively +% odeInput - Filename of main input RHS file +% dependencies - Filename of files the RHS file depends on +% (options) - This argument is optional and can be set with +% cParserSet (example: cParserSet( 'blockSize', 5000 )) +% +% ** Note that there is no support for vectors, cell arrays, structures or +% functions with more than one output argument! Also note that in order to +% take powers, use intPow( x, integer exponent ) for integer powers and +% pow( x, double exponent ). Note that the former results in a considerable +% computational improvement. +% +% Written by J. Vanlier +% Contact: j.vanlier@tue.nl + +function convertToC( mStruct, odeInput, dependencies, options ) + + parserPath = fileparts( mfilename( 'fullpath' ) ); + addpath( [ parserPath '/parserDependencies' ], '-begin' ); + + if nargin < 1 + disp( 'This file requires at least a structure with variable indices and one input filename' ); + end + + l = 'Input filenames: '; + + %% Basic input checking + if exist( odeInput ) == 0 + disp( 'Input file does not exist' ); + return; + else + l = sprintf( '%s"%s"', l, odeInput ); + end + + depNames = {}; + try + for a = 1 : length( dependencies ) + if exist( dependencies{ a } ) == 0 + disp( sprintf( 'Dependency file %s does not exist', dependencies{a} ) ); + return; + else + l = sprintf( '%s, "%s"', l, dependencies{ a } ); + [jnk b] = fileparts( dependencies{ a } ); + depNames{ a } = b; + end + end + catch + if nargin > 2 + if ~isempty( dependencies ) + disp( 'ERROR: Failure processing dependency list. Make sure it is a cell array' ); + return; + end + end + end + + disp( sprintf( '\nODE RHS m-file parser\n%s\n', l ) ); + + %% Grab parser options + fixedRange = 1; + try + fixedRange = getField( options, 'fixedRange' ); + catch + end + + try + aJac = getField( options, 'aJac' ); + catch + aJac = 0; + end + if ( aJac == 1 ) + disp( 'Evaluate sensitivity jacobian' ); + end + + try + fJac = getField( options, 'fJac' ); + catch + fJac = 0; + end + if ( fJac == 1 ) + disp( 'Evaluate jacobian' ); + end + + try + debug = getField( options, 'debug' ); + catch + debug = 0; + end + if ( debug == 1 ) + disp( '<< DEBUG MODE >>' ); + end + + try + solver = getField( options, 'solver' ); + catch + solver = 1; + end + switch solver + case 1 + disp( 'Solver: Dense' ); + case 2 + disp( 'Solver: Dense solver with MATLAB BLAS' ); + case 3 + disp( 'Solver: Scaled preconditioned GMRES' ); + case 4 + disp( 'Solver: Bi-CGStab' ); + case 5 + disp( 'Solver: TFQMR' ); + case 10 + disp( 'Solver Adams Moulton order 1-12' ); + otherwise + disp( 'ERROR: Non existant solver specified. Aborting!' ); + return; + end + + try + blockSize = getfield( options, 'blockSize' ); + catch + blockSize = 1000; + end + disp( sprintf( 'Blocksize: %d timepoints', blockSize ) ); + + try + maxErrFail = getfield( options, 'maxErrFail' ); + catch + maxErrFail = 15; + end + disp( sprintf( 'Maximum number of error test failures: %d', maxErrFail ) ); + + try + maxConvFail = getfield( options, 'maxConvFail' ); + catch + maxConvFail = 1000000; + end + disp( sprintf( 'Maximum number of convergence failures (solving linear system): %d', maxConvFail ) ); + + try + maxStep = getfield( options, 'maxStep' ); + catch + maxStep = 1000000000; + end + disp( sprintf( 'Maximum number of time steps to evaluate: %d', maxStep ) ); + + try + maxStepSize = getField( options, 'maxStepSize' ); + catch + maxStepSize = 1e14; + end + disp( sprintf( 'Maximum step size: %d', maxStepSize ) ); + + try + minStep = getField( options, 'minStep' ); + catch + minStep = 1e-14; + end + disp( sprintf( 'Minimum step size: %e', minStep ) ); + + try + nonNegative = getField( options, 'nonNegative' ); + catch + nonNegative = 0; + end + if max( nonNegative ) == 1 + if length( nonNegative ) == length( fieldnames( mStruct.s ) ) + disp( 'Enforce Non Negativity of subset of solutions' ); + else + disp( 'Warning, Non Negative list should be as long as the number of states. Ignoring Non Negativity flag.' ); + nonNegative = 0; + end + else + disp( 'Not enforcing Non Negativity of the solutions' ); + end + + %% Start declaring things we need + odeOutput = [ parserPath '/outputC/model/dxdt.c' ]; + hOutput = [ parserPath '/outputC/model/dxdtDefs.h']; + expressionTokens = '&()[]/*+-^@ %<>,;={}|'; + + try + convertables = { odeInput, dependencies{:} }; + catch + convertables = { odeInput }; + end + + % Declare and sort the states + try + [ states ] = grabFieldNames( mStruct.s ); + [ stateIndices ] = grabIndices( states, mStruct.s ); + nStates = max(cell2mat(stateIndices)); + catch + disp( 'ERROR: Input structure requires state indices' ); + end + + % Declare the parameters + try + [ parameters, parameterIndices ] = grabFieldNames( mStruct.p ); + [ parameterIndices ] = grabIndices( parameters, mStruct.p ); + nPars = max(cell2mat(parameterIndices)); + catch + disp( 'ERROR: Input structure requires parameter indices' ); + end + + % Declare the constants + try + [ constants, constantIndices ] = grabFieldNames( mStruct.c ); + [ constantIndices ] = grabIndices( constants, mStruct.c ); + catch + disp( 'No constants' ); + constants = {}; + end + + % Declare the inputs + try + [ inputs, inputIndices ] = grabFieldNames( mStruct.u ); + [ inputIndices ] = grabIndices( inputs, mStruct.u ); + catch + disp( 'No inputs' ); + inputs = {}; + end + + %% Load the files + for a = 1 : length( convertables ) + try + [ g{a} ] = textread( convertables{ a }, '%s', 'delimiter', '\n' ); + catch + disp( sprintf( 'Error! Cannot find file %s', convertables{a} ) ); + end + + % Make sure comments are turned C/C++ compatible + for b = 1 : length( g{a} ) + if findstr( g{a}{b}, '%' ) > 0 + g{a}{b} = strcat( strrep( g{a}{b}, '%', '/*' ), '*/' ); + end + end + g{a} = strrep( g{a}, '~', '!' ); + end + + % Remove all lines before function keyword + for a = 1 : length( convertables ) + b = 1; + while( 1 ) + if b > length( g{a} ) + disp( sprintf( 'Error! Function %s is missing function keyword! Aborting!\n' ), convertables{a} ); + return; + end + if ( findstr( lower( g{a}{b} ), 'function' ) ) + break; + end + g{a}(b) = []; + end + end + + % Find out what name the user used for the different vectors + [ outVars, inVars ] = analyseFunctionHeader( g{1}{1} ); + timeVar = inVars{1}; + stateVar = inVars{2}; + parVar = inVars{3}; + inVar = inVars{4}; + try + structVar = inVars{5}; + catch + disp( '*** WARNING: No structure as input argument' ); + end + outVar = outVars{1}; + + %% Replace structure references + for a = 1 : length( convertables ) + for b = 1 : length( g{a} ) + g{a}{b} = replaceStructNames( g{a}{b}, states, stateIndices, '.s' ); + g{a}{b} = replaceStructNames( g{a}{b}, parameters, parameterIndices, '.p' ); + try + g{a}{b} = replaceStructNames( g{a}{b}, inputs, inputIndices, '.u' ); + catch + end + try + g{a}{b} = replaceStructNames( g{a}{b}, constants, constantIndices, '.c' ); + catch + end + end + end + + %% Parse the file + for a = 1 : length( convertables ) + identifierLists{a} = {}; + identifierIteratorLists{a} = {}; + end + for a = 1 : length( convertables ) + for b = 2 : length( g{ a } ) + [ token, remainder, removedChars ] = strtok2( g{a}{b}, expressionTokens ); + + g{a}{b} = ''; + while( ~isempty( remainder ) || ~isempty( token ) || ~isempty( removedChars ) ) + found = 0; + + % Ignore comments + if length( removedChars ) > 1 + if ~isempty( findstr( removedChars, '//' ) ) || ~isempty( findstr( removedChars, '/*' ) ) + g{a}{b} = strcat( g{a}{b}, removedChars, token, remainder ); + break; + end + end + % Remove lines with vector stuff in them + if strcmp( token, ':' ) || strcmp( lower( token ), 'zeros' ) + disp( sprintf( 'Warning: Vectorised code detected; [%s] line ignored!', strcat( g{a}{b}, removedChars, token, remainder ) ) ); + g{a}{b} = ''; + break; + end + if ~isempty( str2num( token ) ) + found = 1; + end + if strcmp( token, 'for' ) + [ itervar, remainder, removedChars ] = strtok2( remainder, expressionTokens ); + [ iterstart, remainder, removedChars ] = strtok2( remainder, expressionTokens ); + [ dummy, remainder, removedChars ] = strtok2( remainder, expressionTokens ); + [ iterend, remainder, removedChars ] = strtok2( remainder, expressionTokens ); + + str = sprintf('for(%s=%s;%s<=%s;%s++){',itervar,(iterstart),itervar,(iterend),itervar); + identifierIteratorLists{a} = { identifierIteratorLists{a}{:}, itervar }; + g{a}{b} = str; + token = ''; + found = 1; + end + if strcmp( token, 'if' ) + remainder = sprintf( '%s{', remainder ); + found = 1; + end + if strcmp( token, 'else' ); + token = sprintf( '} else {', g{a}{b} ); + found = 1; + end + if strcmp( token, 'end' ); + token = '}'; + found = 1; + end + if strcmp( token, timeVar ) + found = 1; + end + if strcmp( lower(token), lower(depNames) ) + found = 1; + end + if strcmp( token, stateVar ) | strcmp( token, parVar ) | strcmp( token, inVar ) | strcmp( token, outVar ) + % Only process assignments + tmp = strtok( remainder, ' ' ); + if strcmp( tmp(1), '(' ) + if strcmp( token, stateVar ) token = 'stateVars'; end; + if strcmp( token, parVar ) token = 'data->p'; end; + if strcmp( token, inVar ) token = 'data->u'; end; + if strcmp( token, outVar ) token = 'ydots'; end; + [ cal, remainder ] = grabBetweenBrackets( remainder ); + cal = dec1( cal ); + token = sprintf( '%s', token ); + remainder = sprintf( '[%s]%s', cal, remainder ); + found = 1; + end + end + + if strcmp( token, 'cell' ) | ( ( ( exist( token ) == 0 ) | ( exist( token ) == 1 ) ) && ( found == 0 ) ) + if ~isempty( strtok( token ) ) + ignoreToken = 0; + for i = 1 : numel(identifierIteratorLists{a}) + if strcmp(token,identifierIteratorLists{a}{i}) == 1 + ignoreToken = 1; + end + end + if ignoreToken == 0 + identifierLists{a} = { identifierLists{a}{:}, token }; + end + end + end + g{a}{b} = strcat( g{a}{b}, removedChars, token ); + [ token, remainder, removedChars ] = strtok2( remainder, expressionTokens ); + + % Modified by Mario Bortolozzi and Joep Vanlier + %if found == 0, + % if ( ( exist( token, 'var' ) == 0 ) || ( exist( token, 'var' ) == 1 ) ), + % if ~isempty( strtok( token ) ) +% % identifierLists{a} = { token }; + % identifierLists{a} = { identifierLists{a}{:}, token }; + % end + % end + %end + %g{a}{b} = strcat( g{a}{b}, removedChars, token ); + %[ token, remainder, removedChars ] = strtok2( remainder, expressionTokens ); + + end + end + end + + %% Start generating the right hand side file + c = 1; + l = ''; + + l = sprintf( '#include "../dxdt.h"\n\n' ); + + for a = 2 : length( convertables ) + [ outVars, inVars, funcName ] = analyseFunctionHeader( g{a}{1} ); + identifierLists{a} = { identifierLists{a}{:}, outVars{:} }; + + if length( outVars ) == 1 + % Print the function header + l = sprintf( '%srealtype %s( %s ) {\n\n', l, funcName, printList( inVars, 'realtype ' ) ); + + % Print the list of identifiers + l = sprintf( '%s\t%s;\n', l, printUniqueList( identifierLists{a}, inVars ) ); + + % Print the list of iterator identifiers + l = sprintf( '%s\t%s;\n', l, printUniqueList( identifierIteratorLists{a}, inVars, 'int' ) ); + + % Print the rest of the file + for b = 2 : length( g{a} ) + l = sprintf( '%s\t%s\n', l, g{a}{b} ); + end + l = sprintf( '%s\treturn %s;\n\n}\n\n', l, outVars{ 1 } ); + end + end + + % Print RHS function header + l = sprintf( '%s\n\nint rhs( realtype t, N_Vector y, N_Vector ydot, void *f_data ) {\n\n\tstruct mData *data = ( struct mData * ) f_data;\n\n', l ); + + % Print the list of identifiers + l = sprintf( '%s\t%s;\n', l, printUniqueList( identifierLists{1} ) ); + if numel(identifierIteratorLists{1}) > 0, l = sprintf( '%s\t%s;\n', l, printUniqueList( identifierIteratorLists{1},{},'int' ) ); end; + + % Fetch variables + l = sprintf( '%s\n\trealtype *stateVars;', l ); + l = sprintf( '%s\n\trealtype *ydots;\n', l ); + + l = sprintf( '%s\n\tstateVars = NV_DATA_S(y);\n', l ); + l = sprintf( '%s\tydots = NV_DATA_S(ydot);\n\n', l ); + + % Print the rest of the file + for b = 2 : length( g{1} ) + l = sprintf( '%s\t%s\n', l, g{1}{b} ); + end + + l = sprintf( '%s\n\n\t#ifdef NON_NEGATIVE\n\t\treturn', l ); + + if max( nonNegative ) == 1 + for a = 1 : length( states ) - 1 + if nonNegative( a ) == 1 + l = sprintf( '%s ( stateVars[%d] < 0.0f ) || ', l, a - 1 ); + end + end + if nonNegative( length( states ) ) == 1 + l = sprintf( '%s ( stateVars[%d] < 0.0f )', l, length( states ) - 1 ); + end + else + l = sprintf( '%s 0', l ); + end + + l = sprintf( '%s;\n\t#else\n\t\treturn 0;\n\t#endif\n\n};\n', l ); + + mz = 0; + try + for a = 1 : length( inputIndices ) + mz = max( [ mz, max( inputIndices{a} ) ] ); + end + catch + end + + if ( ( aJac == 1 ) | ( fJac == 1 ) ) + disp( 'Generating Jacobian information' ); + jacGen1; + l = [ l sensRHS ]; + end + + %if aJac == 1 + % s = sprintf( '\n#define AJAC\n#define N_STATES %d\n#define N_PARAMS %d\n#define N_INPUTS %d\n#define SOLVER %d\n#define BLOCK_SIZE %d\n\n#define MAX_CONV_FAIL %d\n#define MAX_STEPS %d\n#define MAX_ERRFAILS %d\n#define MIN_STEPSIZE %.30f\n#define MAX_STEPSIZE %.30f\n\n', max( cell2mat( stateIndices ) ), max( cell2mat( parameterIndices ) ), mz, solver, blockSize, maxConvFail, maxStep, maxErrFail, minStep, maxStepSize ); + %else + s = sprintf( '\n#define N_STATES %d\n#define N_PARAMS %d\n#define N_INPUTS %d\n#define SOLVER %d\n#define BLOCK_SIZE %d\n\n#define MAX_CONV_FAIL %d\n#define MAX_STEPS %d\n#define MAX_ERRFAILS %d\n#define MIN_STEPSIZE %.30f\n#define MAX_STEPSIZE %.30f\n\n', max( cell2mat( stateIndices ) ), max( cell2mat( parameterIndices ) ), mz, solver, blockSize, maxConvFail, maxStep, maxErrFail, minStep, maxStepSize ); + %end + + if aJac == 1 + s = sprintf( '%s#define AJAC\n', s ); + end + + if fJac == 1 + s = sprintf( '%s#define FJAC\n', s ); + end + + if debug == 1 + s = sprintf( '%s#define DEBUG\n', s ); + end + + if max( nonNegative ) == 1 + s = sprintf( '%s#define NON_NEGATIVE\n', s ); + end + if fixedRange == 1 + s = sprintf( '%s#define FIXEDRANGE\n', s ); + end + + fid = fopen( odeOutput, 'w' ); + fprintf( fid, '%s\n', l ); + fclose( fid ); + + fid = fopen( hOutput, 'w' ); + fprintf( fid, '%s\n', s ); + fclose( fid ); + + disp( 'Files generated!' ); + + +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/Parser/convertToC_IDA.m b/odemex/Parser/convertToC_IDA.m new file mode 100644 index 0000000..b7418da --- /dev/null +++ b/odemex/Parser/convertToC_IDA.m @@ -0,0 +1,445 @@ +% M-File to C-file RHS parser +% +% function convertToC_IDA( mStruct, odeInput, dependencies, options ) +% +% Input arguments: +% mStruct - Structure containing state, parameter and input +% indices and constants in fields s p u and c +% respectively +% odeInput - Filename of main input RHS file +% dependencies - Filename of files the RHS file depends on +% (options) - This argument is optional and can be set with +% cParserSet (example: cParserSet( 'blockSize', 5000 )) +% +% ** Note that there is no support for vectors, cell arrays, structures or +% functions with more than one output argument! Also note that in order to +% take powers, use intPow( x, integer exponent ) for integer powers and +% pow( x, double exponent ). Note that the former results in a considerable +% computational improvement. +% +% Written by J. Vanlier +% Contact: j.vanlier@tue.nl + +function convertToC( mStruct, odeInput, dependencies, options, M ) + + parserPath = fileparts( mfilename( 'fullpath' ) ); + addpath( [ parserPath '/parserDependencies' ], '-begin' ); + + if nargin < 1 + disp( 'This file requires at least a structure with variable indices and one input filename' ); + end + + l = 'Input filenames: '; + + if nargin < 5 + M = eye( length(fieldnames(mStruct.s)) ); + end + + %% Basic input checking + if exist( odeInput ) == 0 + disp( 'Input file does not exist' ); + return; + else + l = sprintf( '%s"%s"', l, odeInput ); + end + + depNames = {}; + try + for a = 1 : length( dependencies ) + if exist( dependencies{ a } ) == 0 + disp( sprintf( 'Dependency file %s does not exist', dependencies{a} ) ); + return; + else + l = sprintf( '%s, "%s"', l, dependencies{ a } ); + [jnk b] = fileparts( dependencies{ a } ); + depNames{ a } = b; + end + end + catch + if nargin > 2 + if ~isempty( dependencies ) + disp( 'ERROR: Failure processing dependency list. Make sure it is a cell array' ); + return; + end + end + end + + disp( sprintf( '\nODE RHS m-file parser\n%s\n', l ) ); + + %% Grab parser options + try + solver = getField( options, 'solver' ); + catch + solver = 1; + end + switch solver + case 1 + disp( 'Solver: Dense' ); + case 2 + disp( 'Solver: Dense solver with MATLAB BLAS' ); + case 3 + disp( 'Solver: Scaled preconditioned GMRES' ); + case 4 + disp( 'Solver: Bi-CGStab' ); + case 5 + disp( 'Solver: TFQMR' ); + case 10 + disp( 'Solver Adams Moulton order 1-12' ); + otherwise + disp( 'ERROR: Non existant solver specified. Aborting!' ); + return; + end + + try + blockSize = getfield( options, 'blockSize' ); + catch + blockSize = 1000; + end + disp( sprintf( 'Blocksize: %d timepoints', blockSize ) ); + + try + maxErrFail = getfield( options, 'maxErrFail' ); + catch + maxErrFail = 15; + end + disp( sprintf( 'Maximum number of error test failures: %d', maxErrFail ) ); + + try + maxConvFail = getfield( options, 'maxConvFail' ); + catch + maxConvFail = 1000000; + end + disp( sprintf( 'Maximum number of convergence failures (solving linear system): %d', maxConvFail ) ); + + try + maxStep = getfield( options, 'maxStep' ); + catch + maxStep = 1000000000; + end + disp( sprintf( 'Maximum number of time steps to evaluate: %d', maxStep ) ); + + try + minStep = getField( options, 'minStep' ); + catch + minStep = 1e-14; + end + disp( sprintf( 'Minimum step size: %e', minStep ) ); + + try + nonNegative = getField( options, 'nonNegative' ); + catch + nonNegative = 0; + end + if max( nonNegative ) == 1 + if length( nonNegative ) == length( fieldnames( mStruct.s ) ) + disp( 'Enforce Non Negativity of subset of solutions' ); + else + disp( 'Warning, Non Negative list should be as long as the number of states. Ignoring Non Negativity flag.' ); + nonNegative = 0; + end + else + disp( 'Not enforcing Non Negativity of the solutions' ); + end + + %% Start declaring things we need + + odeOutput = [ parserPath '/outputC_IDA/model/dxdt.c' ]; + hOutput = [ parserPath '/outputC_IDA/model/dxdtDefs.h' ]; + expressionTokens = '()[]/*+-^@ %<>,;={}'; + + try + convertables = { odeInput, dependencies{:} }; + catch + convertables = { odeInput }; + end + + % Declare and sort the states + try + [ states ] = grabFieldNames( mStruct.s ); + [ stateIndices ] = grabIndices( states, mStruct.s ); + catch + disp( 'ERROR: Input structure requires state indices' ); + end + + % Declare the parameters + try + [ parameters, parameterIndices ] = grabFieldNames( mStruct.p ); + [ parameterIndices ] = grabIndices( parameters, mStruct.p ); + catch + disp( 'ERROR: Input structure requires parameter indices' ); + end + + % Declare the constants + try + [ constants, constantIndices ] = grabFieldNames( mStruct.c ); + [ constantIndices ] = grabIndices( constants, mStruct.c ); + catch + disp( 'No constants' ); + constants = {}; + end + + % Declare the inputs + try + [ inputs, inputIndices ] = grabFieldNames( mStruct.u ); + [ inputIndices ] = grabIndices( inputs, mStruct.u ); + catch + disp( 'No inputs' ); + inputs = {}; + end + + % Currently the number of equations equals the number of states + nEqs = length( states ); + + %% Load the files + for a = 1 : length( convertables ) + try + [ g{a} ] = textread( convertables{ a }, '%s', 'delimiter', '\n' ); + catch + disp( sprintf( 'Error! Cannot find file %s', convertables{a} ) ); + end + + % Make sure comments are turned C/C++ compatible + for b = 1 : length( g{a} ) + if findstr( g{a}{b}, '%' ) > 0 + g{a}{b} = strcat( strrep( g{a}{b}, '%', '/*' ), '*/' ); + end + end + g{a} = strrep( g{a}, '~', '!' ); + end + + % Remove all lines before function keyword + for a = 1 : length( convertables ) + b = 1; + while( 1 ) + if b > length( g{a} ) + disp( sprintf( 'Error! Function %s is missing function keyword! Aborting!\n' ), convertables{a} ); + return; + end + if ( findstr( lower( g{a}{b} ), 'function' ) ) + break; + end + g{a}(b) = []; + end + end + + % Find out what name the user used for the different vectors + [ outVars, inVars ] = analyseFunctionHeader( g{1}{1} ); + timeVar = inVars{1}; + stateVar = inVars{2}; + parVar = inVars{3}; + inVar = inVars{4}; + outVar = outVars{1}; + + %% Replace structure references + for a = 1 : length( convertables ) + for b = 1 : length( g{a} ) + g{a}{b} = replaceStructNames( g{a}{b}, states, stateIndices, '.s' ); + g{a}{b} = replaceStructNames( g{a}{b}, parameters, parameterIndices, '.p' ); + try + g{a}{b} = replaceStructNames( g{a}{b}, inputs, inputIndices, '.u' ); + catch + end + try + g{a}{b} = replaceStructNames( g{a}{b}, constants, constantIndices, '.c' ); + catch + end + end + end + + %% Parse the file + identifierLists = {{}, {}}; + + for a = 1 : length( convertables ) + for b = 2 : length( g{ a } ) + [ token, remainder, removedChars ] = strtok2( g{a}{b}, expressionTokens ); + g{a}{b} = ''; + while( ~isempty( remainder ) || ~isempty( token ) || ~isempty( removedChars ) ) + found = 0; + + % Ignore comments + if length( removedChars ) > 1 + if ~isempty( findstr( removedChars, '//' ) ) || ~isempty( findstr( removedChars, '/*' ) ) + g{a}{b} = strcat( g{a}{b}, removedChars, token, remainder ); + break; + end + end + % Remove lines with vector stuff in them + if strcmp( token, ':' ) || strcmp( lower( token ), 'zeros' ) + disp( sprintf( 'Warning: Vectorised code detected; [%s] line ignored!', strcat( g{a}{b}, removedChars, token, remainder ) ) ); + g{a}{b} = ''; + break; + end + if ~isempty( str2num( token ) ) + found = 1; + end + if strcmp( token, 'if' ) + remainder = sprintf( '%s{', remainder ); + found = 1; + end + if strcmp( token, 'else' ); + token = sprintf( '} else {', g{a}{b} ); + found = 1; + end + if strcmp( token, 'end' ); + token = '}'; + found = 1; + end + if strcmp( token, timeVar ) + found = 1; + end + if strcmp( lower(token), lower(depNames) ) + found = 1; + end + if strcmp( token, stateVar ) | strcmp( token, parVar ) | strcmp( token, inVar ) | strcmp( token, outVar ) + % Only process assignments + tmp = strtok( remainder, ' ' ); + if strcmp( tmp(1), '(' ) + if strcmp( token, stateVar ) token = 'stateVars'; end; + if strcmp( token, parVar ) token = 'data->p'; end; + if strcmp( token, inVar ) token = 'data->u'; end; + if strcmp( token, outVar ) token = 'dEqs'; end; + [ cal, remainder ] = grabBetweenBrackets( remainder ); + cal = dec1( cal ); + token = sprintf( '%s', token ); + remainder = sprintf( '[%s]%s', cal, remainder ); + found = 1; + end + end + if strcmp( token, 'cell' ) |( ( ( exist( token ) == 0 ) | ( exist( token ) == 1 ) ) && ( found == 0 ) ) + if ~isempty( token ) + identifierLists{a} = { identifierLists{a}{:}, token }; + end + end + g{a}{b} = strcat( g{a}{b}, removedChars, token ); + [ token, remainder, removedChars ] = strtok2( remainder, expressionTokens ); + end + end + end + + %% Start generating the right hand side file + c = 1; + l = ''; + + l = sprintf( '#include "../dxdt.h"\n\n' ); + + for a = 2 : length( convertables ) + [ outVars, inVars, funcName ] = analyseFunctionHeader( g{a}{1} ); + identifierLists{a} = { identifierLists{a}{:}, outVars{:} }; + + if length( outVars ) == 1 + % Print the function header + l = sprintf( '%srealtype %s( %s ) {\n\n', l, funcName, printList( inVars, 'realtype ' ) ); + + % Print the list of identifiers + l = sprintf( '%s\t%s;\n', l, printUniqueList( identifierLists{a}, inVars ) ); + + % Print the rest of the file + for b = 2 : length( g{a} ) + l = sprintf( '%s\t%s\n', l, g{a}{b} ); + end + l = sprintf( '%s\treturn %s;\n\n}\n\n', l, outVars{ 1 } ); + end + end + + % Print RHS function header + l = sprintf( '%s\n\nint rhs( realtype t, N_Vector y, N_Vector ydot, N_Vector resid, void *f_data ) {\n\n\tstruct mData *data = ( struct mData * ) f_data;\n\n', l ); + + % Print the list of identifiers + l = sprintf( '%s\t%s;', l, printUniqueList( identifierLists{1} ) ); + + % Fetch variables + l = sprintf( '%s\n\trealtype *stateVars;', l ); + l = sprintf( '%s\n\trealtype *ydots;\n', l ); + l = sprintf( '%s\n\trealtype *resids;\n', l ); + l = sprintf( '%s\trealtype\tdEqs[%d];\n', l, nEqs ); + + % Make a list of derivative variables + l = sprintf( '%s\n\tstateVars = NV_DATA_S(y);', l ); + l = sprintf( '%s\n\tydots = NV_DATA_S(ydot);\n', l ); + l = sprintf( '%s\n\tresids = NV_DATA_S(resid);\n', l ); + + % Print the rest of the file + for b = 2 : length( g{1} ) + l = sprintf( '%s\t%s\n', l, g{1}{b} ); + end + + % Build up the residual vector using the mass matrix + for b = 1 : length( M ) + z = ''; + for c = 1 : length( M ) + if M( b, c ) ~= 0 + z = sprintf( '%s + %d * ydots[%d]', z, M( b, c ), c - 1 ); + end + end + l = sprintf( '%s\n\tresids[%d] = %s - dEqs[%d];', l, b - 1, z, b - 1 ); + end + + l = sprintf( '%s\n\n\t#ifdef NON_NEGATIVE\n\t\treturn', l ); + + if max( nonNegative ) == 1 + for a = 1 : length( states ) - 1 + if nonNegative( a ) == 1 + l = sprintf( '%s ( stateVars[%d] < 0.0f ) || ', l, a - 1 ); + end + end + if nonNegative( length( states ) ) == 1 + l = sprintf( '%s ( stateVars[%d] < 0.0f )', l, length( states ) - 1 ); + end + else + l = sprintf( '%s 0', l ); + end + + l = sprintf( '%s;\n\t#else\n\t\treturn 0;\n\t#endif\n\n};\n', l ); + + mz = 0; + try + for a = 1 : length( inputIndices ) + mz = max( [ mz, max( inputIndices{a} ) ] ); + end + catch + end + + s = sprintf( '\n#define N_STATES %d\n#define N_PARAMS %d\n#define N_INPUTS %d\n#define SOLVER %d\n#define BLOCK_SIZE %d\n\n#define MAX_CONV_FAIL %d\n#define MAX_STEPS %d\n#define MAX_ERRFAILS %d\n#define MIN_STEPSIZE %.30f\n\n', length( states ), length( parameters ), mz, solver, blockSize, maxConvFail, maxStep, maxErrFail, minStep ); + + if max( nonNegative ) == 1 + s = sprintf( '%s#define NON_NEGATIVE\n', s ); + end + + fid = fopen( odeOutput, 'w' ); + fprintf( fid, '%s\n', l ); + fclose( fid ); + + fid = fopen( hOutput, 'w' ); + fprintf( fid, '%s\n', s ); + fclose( fid ); + + disp( 'Files generated!' ); + + +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/Parser/outputC/dxdt.h b/odemex/Parser/outputC/dxdt.h new file mode 100644 index 0000000..3fdaddd --- /dev/null +++ b/odemex/Parser/outputC/dxdt.h @@ -0,0 +1,40 @@ +/* + Joep Vanlier, 2011 + + Licensing: + Copyright (C) 2009-2011 Joep Vanlier. All rights + reserved. + + Contact:joep.vanlier@gmail.com + + This file is part of the puaMAT. + + puaMAT is free software: you can redistribute it + and/or modify it under the terms of the GNU General + Public License as published by the Free Software + Foundation, either version 3 of the License, or (at + your option) any later version. + + puaMAT is distributed in the hope that it will be + useful, but WITHOUT ANY WARRANTY; without even the + implied warranty of MERCHANTABILITY or FITNESS FOR A + PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General + Public License along with puaMAT. If not, see + http://www.gnu.org/licenses/ +*/ +#include "ode.h" +#include "model/dxdtDefs.h" + +#ifndef _DXDT_H_ +#define _DXDT_H_ + +#define realtype double + +int rhs(realtype t, N_Vector y, N_Vector ydot, void *f_data); +int sensRhs (int Ns, realtype t, N_Vector y, N_Vector ydot, N_Vector *yS, N_Vector *ySdot, void *user_data, N_Vector tmp1, N_Vector tmp2); +int fJac(long int N, realtype t, N_Vector y, N_Vector fy, DlsMat Jac, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); + +#endif diff --git a/odemex/Parser/outputC/mexG.c b/odemex/Parser/outputC/mexG.c new file mode 100644 index 0000000..2d18bad --- /dev/null +++ b/odemex/Parser/outputC/mexG.c @@ -0,0 +1,473 @@ +/* + Joep Vanlier, 2011 + + Licensing: + Copyright (C) 2009-2011 Joep Vanlier. All rights + reserved. + + Contact:joep.vanlier@gmail.com + + This file is part of the puaMAT. + + puaMAT is free software: you can redistribute it + and/or modify it under the terms of the GNU General + Public License as published by the Free Software + Foundation, either version 3 of the License, or (at + your option) any later version. + + puaMAT is distributed in the hope that it will be + useful, but WITHOUT ANY WARRANTY; without even the + implied warranty of MERCHANTABILITY or FITNESS FOR A + PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General + Public License along with puaMAT. If not, see + http://www.gnu.org/licenses/ +*/ +#include "ode.h" +#include "dxdt.h" +#include "time.h" +#include "string.h" + +const int numInputArgs = 5; +const int numOutputArgs = 1; + +void mexFunction (int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { + + time_t tStart, tEnd; + struct mVector t; + struct mVector tol; + struct mData data; + int k, p, q, ind; + int nBlocks; + realtype t0; + realtype y[ N_STATES ]; + realtype *yOutput; + realtype *tOutput; + int mSize; + + int sensitivity; + double *sensitivities; + double *sensitivityOutputs; + double *tols; + unsigned int sensitivityBlock; + size_t sensitivityBlockSize; + int *sParList; + + /* Structures required for CVode */ + int flag; + N_Vector y0 = NULL; + N_Vector *yS0 = NULL; + void *cvode_mem = NULL; + void *pData = NULL; + realtype tret; + + /* Function pointer for the RHS */ + int (*f)(realtype t, N_Vector y, N_Vector ydot, void *f_data) = &rhs; + + /* Function pointer for the analytic jacobian of the right hand side */ + #ifdef AJAC + int (*g)(int Ns, realtype t, N_Vector y, N_Vector ydot, N_Vector *yS, N_Vector *ySdot, void *user_data, N_Vector tmp1, N_Vector tmp2) = &sensRhs; + #endif + + #ifdef FJAC + int (*fj)(long int N, realtype t, N_Vector y, N_Vector fy, DlsMat Jac, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) = &fJac; + #endif + + if (nrhs == 0) { + printf( "Call function as:\ny = funcName(t, y0[%d], p[%d], u[%d], [reltol, abstol, maxtime])\n", N_STATES, N_PARAMS, N_INPUTS ); + return; + } + + if ( nrhs < numInputArgs ) mexErrMsgTxt( "ERROR: Incorrect number of input arguments\nFormat should be: (t, y0, x, u, [reltol, abstol, max_integration_time], sensitivity*)\n* are optional" ); + + /* Check input dimensions */ + if ( mxGetNumberOfElements( prhs[1] ) != N_STATES ) { + printf( "ERROR: Initial condition vector has incorrect length! Expected %d, found %d", N_STATES, mxGetNumberOfElements( prhs[1] ) ); + mexErrMsgTxt( "" ); + } + if ( mxGetNumberOfElements( prhs[2] ) != N_PARAMS ) { + printf( "ERROR: Parameter vector has incorrect length! Expected %d, found %d", N_PARAMS, mxGetNumberOfElements( prhs[2] ) ); + mexErrMsgTxt( "" ); + } + if ( mxGetNumberOfElements( prhs[3] ) != N_INPUTS ) { + printf( "ERROR: Input vector has incorrect length! Expected %d, found %d", N_INPUTS, mxGetNumberOfElements( prhs[3] ) ); + mexErrMsgTxt( "" ); + } + if ( mxGetNumberOfElements( prhs[4] ) != 3 ) { + mexErrMsgTxt( "ERROR: Tolerance vector should be of the form [ relative tolerance, absolute tolerance, maximal time allowed for integration in seconds ]" ); + } + + /* Grab vectors for own use from MATLAB */ + grabVectorFromMatlab( &t, prhs[0] ); + grabVectorFromMatlab( &tol, prhs[4] ); + + if ( t.length < 1 ) + mexErrMsgTxt( "ERROR: Time vector should be at least one element. Either provide a single time to obtain a single value at time t, a begin and end time if the solver is allowed to determine the timesteps or a series of timepoints at which to compute the solution." ); + + sensitivity = 0; + if ( nrhs > 5 ) { + if ( t.length < 3 ) { + mexErrMsgTxt( "ERROR: Sensitivity analysis is currently only supported for fixed time vector problems. Please supply a time vector longer than 2." ); + } else { + if ( nlhs > 2 ) { + if ( nrhs < 7 ) + { + /* Include sensitivity analysis */ + sensitivity = *mxGetPr( prhs[5] ); + } else { + if ( mxGetNumberOfElements( prhs[6] ) < ( N_STATES + N_PARAMS ) * N_STATES ) + mexErrMsgTxt( "Initial condition vector for sensitivity analysis is of incorrect length!" ); + else + sensitivity = *mxGetPr( prhs[5] ); + } + } else mexErrMsgTxt( "Sensitivity analysis requires 3 outputs" ); + } + } + + if ( prhs[3] != NULL ) + data.u = mxGetPr( prhs[3] ); + else + data.u = NULL; + + if ( sensitivity == 0 ) { + /* Set parameter pointer to matlab structure */ + data.p = mxGetPr( prhs[2] ); + /* Copy initial condition to local structure */ + memcpy( y, mxGetPr( prhs[1] ), sizeof( realtype ) * mxGetNumberOfElements( prhs[1] ) ); + y0 = N_VMake_Serial( N_STATES, y ); /* Warning, realtype has to be double for this */ + } else { + /* Allocate memory for the parameters and initial conditions */ + data.p = malloc( sizeof( realtype ) * ( N_STATES + N_PARAMS ) ); + /* Copy parameters to local structure */ + memcpy( &data.p[0], mxGetPr( prhs[2] ), sizeof( realtype ) * mxGetNumberOfElements( prhs[2] ) ); + /* Copy initial conditions to local structure */ + memcpy( &data.p[N_PARAMS], mxGetPr( prhs[1] ), sizeof( realtype ) * mxGetNumberOfElements( prhs[1] ) ); + /* Set initial condition pointer to appropriate address */ + y0 = N_VMake_Serial( N_STATES, &data.p[N_PARAMS] ); /* Warning, realtype has to be double for this */ + } + + /* Set begin time */ + if ( t.length == 1 ) + t0 = 0.0; + else + t0 = t.val[0]; + + /* Start up CVode */ + #if SOLVER < 10 + cvode_mem = CVodeCreate( CV_BDF, CV_NEWTON ); + #else + cvode_mem = CVodeCreate( CV_ADAMS, CV_FUNCTIONAL ); + #endif + + + /* Initialise CVode */ + if ( CVodeInit( cvode_mem, f, t0, y0 ) != CV_SUCCESS ) { + N_VDestroy_Serial( y0 ); + mexErrMsgTxt( "ERROR: Failed to initialise CVode" ); + } + + /* Specify tolerances */ + if ( CVodeSStolerances( cvode_mem, tol.val[0], tol.val[1] ) != CV_SUCCESS ) { + N_VDestroy_Serial( y0 ); + CVodeFree( &cvode_mem ); + mexErrMsgTxt( "ERROR: Failed to set tolerances" ); + } + + CVodeSetMaxStep( cvode_mem, MAX_STEPSIZE ); + CVodeSetMinStep( cvode_mem, MIN_STEPSIZE ); + CVodeSetMaxConvFails( cvode_mem, MAX_CONV_FAIL ); + CVodeSetMaxNumSteps( cvode_mem, MAX_STEPS ); + CVodeSetMaxErrTestFails( cvode_mem, MAX_ERRFAILS ); + CVodeSetMaxTime( cvode_mem, tol.val[2] ); + + /* We need to pass our parameters and inputs to the ODE file */ + pData = &data; + if ( CVodeSetUserData( cvode_mem, pData ) != CV_SUCCESS ) { + mexErrMsgTxt( "ERROR: Failed passing parameters and initial conditions" ); + } + + #if SOLVER == 1 + /* Attach dense linear solver module */ + if ( CVDense( cvode_mem, N_STATES ) != CV_SUCCESS ) { + N_VDestroy_Serial( y0 ); + CVodeFree( &cvode_mem ); + mexErrMsgTxt( "ERROR: Failed to attach linear solver module" ); + } + #endif + #if SOLVER == 2 + /* Use LAPACK solver */ + if ( CVLapackDense( cvode_mem, N_STATES ) != CV_SUCCESS ) { + N_VDestroy_Serial( y0 ); + CVodeFree( &cvode_mem ); + mexErrMsgTxt( "ERROR: Failed to attach linear solver module" ); + } + #endif + + #ifdef FJAC + if ( CVDlsSetDenseJacFn(cvode_mem, fj) != CV_SUCCESS ) { + N_VDestroy_Serial( y0 ); + CVodeFree( &cvode_mem ); + mexErrMsgTxt( "Failed to supply analytical Jacobian of RHS" ); + } + #endif + #if SOLVER == 3 + /* Use scaled preconditioned GMRES */ + if ( CVSpgmr( cvode_mem, PREC_BOTH, 0 ) != CV_SUCCESS ) { + N_VDestroy_Serial( y0 ); + CVodeFree( &cvode_mem ); + mexErrMsgTxt( "ERROR: Failed to attach linear solver module" ); + } + #endif + #if SOLVER == 4 + /* Use preconditioned Bi-CGStab solver */ + if ( CVSpbcg( cvode_mem, PREC_BOTH, 0 ) != CV_SUCCESS ) { + N_VDestroy_Serial( y0 ); + CVodeFree( &cvode_mem ); + mexErrMsgTxt( "ERROR: Failed to attach linear solver module" ); + } + #endif + #if SOLVER == 5 + /* Use preconditioned TFQMR iterative solver */ + if ( CVSptfqmr( cvode_mem, PREC_BOTH, 0 ) != CV_SUCCESS ) { + N_VDestroy_Serial( y0 ); + CVodeFree( &cvode_mem ); + mexErrMsgTxt( "ERROR: Failed to attach linear solver module" ); + } + #endif + +/* Current implementation keeps tolerances the same for all vectors + if ( CVodeSVtolerances( cvode_mem, reltol, abstol ) != CV_SUCCESS ) { + mexErrMsgTxt( "ERROR: Failed to set SV tolerances" ); + } */ + + if ( sensitivity == 1 ) + { + sensitivityBlock = ( N_STATES + N_PARAMS ) * N_STATES; + sensitivityBlockSize = sizeof( double ) * ( N_STATES + N_PARAMS ) * N_STATES; + + /* Create an empty list of vectors for the sensitivities */ + yS0 = N_VCloneEmptyVectorArray( N_STATES + N_PARAMS, y0 ); + + if ( nrhs < 7 ) { + /* Allocate memory for the sensitivities at the current point */ + sensitivities = malloc( sensitivityBlockSize ); + + /* Initialise the sensitivities */ + for ( k = 0; k < ( N_STATES + N_PARAMS ) * N_STATES; k++ ) { + sensitivities[ k ] = 0; + } + + /* Sensitivity initial conditions should be one on the diagonal for initial condition sensitivities */ + ind = N_STATES * N_PARAMS; + for ( k = 0; k < N_STATES; k++ ) { + sensitivities[ ind + k + k * N_STATES ] = 1; + } + } else { + sensitivities = mxGetPr( prhs[6] ); + } + + tols = malloc( ( N_STATES + N_PARAMS ) * sizeof( double ) ); + + /* Set the pointer to the sensitivity matrix so that CVode can find it */ + for ( k = 0; k < N_STATES + N_PARAMS; k++ ) { + N_VSetArrayPointer_Serial( &sensitivities[k * N_STATES], yS0[k] ); + tols[ k ] = tol.val[1]; + } + + sParList = malloc( sizeof( int ) * ( N_STATES + N_PARAMS ) ); + for ( k = 0; k < N_PARAMS; k++ ) { + sParList[k] = k; + } + for ( k = N_PARAMS; k < N_PARAMS+N_STATES; k++ ) { + sParList[k] = k; + } + + /* Initialise the sensitivity module of CVode */ + #ifdef AJAC + flag = CVodeSensInit( cvode_mem, N_STATES+N_PARAMS, CV_SIMULTANEOUS, g, yS0 ); + #else + flag = CVodeSensInit( cvode_mem, N_STATES+N_PARAMS, CV_SIMULTANEOUS, NULL, yS0 ); + #endif + + flag = CVodeSensSStolerances( cvode_mem, tol.val[0], tols ); + flag = CVodeSetSensParams( cvode_mem, data.p, NULL, sParList ); + + free( sParList ); + + if ( flag != CV_SUCCESS ) { + N_VDestroy_Serial( y0 ); + N_VDestroyVectorArray_Serial( yS0, N_STATES + N_PARAMS ); + free( sensitivities ); + free( data.p ); + free( tols ); + free( cvode_mem ); + mexErrMsgTxt( "ERROR: Failed to set the sensitivity analysis parameters" ); + } + + /* Allocate memory for the output sensitivities */ + if ( nlhs > 2 ) mxDestroyArray(plhs[2]); + plhs[2] = mxCreateDoubleMatrix( sensitivityBlock, t.length, mxREAL ); + sensitivityOutputs = mxGetPr( plhs[2] ); + } + + + /* Start the timer */ + time( &tStart ); + + if ( t.length == 2 ) { + nBlocks = 1; + mSize = nBlocks * BLOCK_SIZE; + + /* No steps were specified, just begin and end (dynamic memory allocation) */ + if ( nlhs > 0 ) mxDestroyArray(plhs[0]); + plhs[0] = mxCreateDoubleMatrix( 1, BLOCK_SIZE, mxREAL ); + tOutput = mxGetPr(plhs[0]); + tOutput[0] = t.val[0]; + + if ( nlhs > 1 ) mxDestroyArray(plhs[1]); + plhs[1] = mxCreateDoubleMatrix( N_STATES, BLOCK_SIZE, mxREAL ); + yOutput = mxGetPr(plhs[1]); + memcpy( &yOutput[0], &NV_DATA_S( y0 )[0], sizeof( realtype ) * N_STATES ); + + p = 0; k = 0; + tret = t.val[0]; + while ( tret < t.val[1] ) + { + p = p + N_STATES; k++; + flag = CVode( cvode_mem, t.val[1], y0, &tret, CV_ONE_STEP ); + if ( flag < 0 ) handleError( cvode_mem, y0, flag, plhs, nrhs, 0, NULL, NULL, NULL ); + + /* Check if the memory is still sufficient to store the output */ + if ( ( k + 1 ) > mSize ) { + /* If we run out of memory, increase the storage size */ + nBlocks ++; + mSize = nBlocks * BLOCK_SIZE; + + /* We're not done yet so resize the block */ + tOutput = reAllocate2DOutputMemory( tOutput, cvode_mem, y0, plhs[0], 1, mSize ); + yOutput = reAllocate2DOutputMemory( yOutput, cvode_mem, y0, plhs[1], N_STATES, mSize ); + } + + /* Fetch the output */ + memcpy( &yOutput[p], &NV_DATA_S( y0 )[0], sizeof( realtype ) * N_STATES ); + tOutput[k] = tret; + time( &tEnd ); + if ( difftime( tEnd, tStart ) > tol.val[2] ) { + printf( "WARNING: Simulation time exceeded! Aborting simulation at t = %e\n", tret ); + break; + } + + } + + #ifdef FIXEDRANGE + /* Added by Ir. C. A. Tiemann to support fixed end time */ + tret = tOutput[k-1]; + memcpy( &NV_DATA_S( y0 )[0], &yOutput[p-N_STATES], sizeof( realtype ) * N_STATES ); + flag = CVode( cvode_mem, t.val[1], y0, &tret, CV_NORMAL ); + memcpy( &yOutput[p], &NV_DATA_S( y0 )[0], sizeof( realtype ) * N_STATES ); + tOutput[k] = tret; + #endif + + if ( nBlocks > 1 ) { + printf( "WARNING: Required %d memory reallocations. Consider increasing block size.\n\n", nBlocks ); + } + + /* After we are done simulating, we tighten the memory block to the true size */ + tOutput = reAllocate2DOutputMemory( tOutput, cvode_mem, y0, plhs[0], 1, k + 1 ); + yOutput = reAllocate2DOutputMemory( yOutput, cvode_mem, y0, plhs[1], N_STATES, k + 1 ); + + } else { + /* Only one time point */ + if ( t.length == 1 ) { + + /* Steps were specified --> Static memory allocation (faster) */ + if ( nlhs > 0 ) mxDestroyArray(plhs[0]); + plhs[0] = mxCreateDoubleMatrix( 1, 1, mxREAL ); + tOutput = mxGetPr(plhs[0]); + if ( nlhs > 1 ) mxDestroyArray(plhs[1]); + plhs[1] = mxCreateDoubleMatrix( N_STATES, 1, mxREAL ); + yOutput = mxGetPr(plhs[1]); + tret = 0.0; + + /* Simulate up to a point */ + flag = CVode( cvode_mem, t.val[0], y0, &tret, CV_NORMAL ); + if ( flag < 0 ) handleError( cvode_mem, y0, flag, plhs, nrhs, 0, NULL, NULL, NULL ); + + memcpy( &yOutput[0], &NV_DATA_S( y0 )[0], sizeof( realtype ) * N_STATES ); + tOutput[0] = tret; + } else { + + /* Steps were specified --> Static memory allocation (faster) */ + if ( nlhs > 0 ) mxDestroyArray(plhs[0]); + plhs[0] = mxCreateDoubleMatrix( 1, t.length, mxREAL ); + tOutput = mxGetPr(plhs[0]); + tOutput[0] = t.val[0]; + tret = t.val[0]; + + if ( nlhs > 1 ) mxDestroyArray(plhs[1]); + + plhs[1] = mxCreateDoubleMatrix( N_STATES, t.length, mxREAL ); + yOutput = mxGetPr(plhs[1]); + + memcpy( &yOutput[0], &NV_DATA_S( y0 )[0], sizeof( realtype ) * N_STATES ); + + if ( sensitivity == 1 ) { + memcpy( &sensitivityOutputs[ 0 ], sensitivities, sensitivityBlockSize ); + } + + /* Fixed steps were specified */ + p = N_STATES; + q = sensitivityBlock; + + for ( k = 1; k < t.length; k++ ) { + flag = CVode( cvode_mem, t.val[k], y0, &tret, CV_NORMAL ); + if ( flag < 0 ) handleError( cvode_mem, y0, flag, plhs, nrhs, sensitivity, yS0, sensitivities, &data ); + /* Fetch the output */ + memcpy( &yOutput[p], &NV_DATA_S( y0 )[0], sizeof( realtype ) * N_STATES ); + p = p + N_STATES; + tOutput[k] = t.val[k]; + if ( sensitivity == 1 ) { + flag = CVodeGetSens(cvode_mem, &tret, yS0); + if ( flag < 0 ) + handleError( cvode_mem, y0, flag, plhs, nrhs, sensitivity, yS0, sensitivities, &data ); + else { + memcpy( &sensitivityOutputs[ q ], sensitivities, sensitivityBlockSize ); + q = q + sensitivityBlock; + } + } + + time( &tEnd ); + if ( difftime( tEnd, tStart ) > tol.val[2] ) { + printf( "WARNING: Simulation time exceeded! Aborting simulation", t.val[k] ); + tOutput = reAllocate2DOutputMemory( tOutput, cvode_mem, y0, plhs[0], 1, k ); + yOutput = reAllocate2DOutputMemory( yOutput, cvode_mem, y0, plhs[1], N_STATES, k ); + break; + } + } + } + } + N_VDestroy_Serial( y0 ); + + /* Free CVode memory */ + CVodeFree( &cvode_mem ); + + if ( sensitivity == 1 ) { + free( data.p ); + free( tols ); + if ( nrhs < 7 ) free( sensitivities ); + N_VDestroyVectorArray_Serial( yS0, N_STATES + N_PARAMS ); + } + + /* If we desire only one output, we probably meant the solution array + since it is pretty pointless to output the time array */ + if ( nlhs == 1 ) { + mxDestroyArray( plhs[0] ); + plhs[0] = plhs[1]; + } + +} + + + diff --git a/odemex/Parser/outputC/model/aJac.c b/odemex/Parser/outputC/model/aJac.c new file mode 100644 index 0000000..424c30f --- /dev/null +++ b/odemex/Parser/outputC/model/aJac.c @@ -0,0 +1,50 @@ + t0 = MatrixWithNoName[0][0] = -p_2; + MatrixWithNoName[0][1] = p_4; + MatrixWithNoName[1][1] = -p_2; + MatrixWithNoName[1][2] = p_5; + MatrixWithNoName[2][2] = -p_2; + MatrixWithNoName[2][3] = p_6; + MatrixWithNoName[3][3] = -p_2; + MatrixWithNoName[3][4] = p_7; + MatrixWithNoName[4][4] = -p_2; + MatrixWithNoName[4][5] = p_8; + MatrixWithNoName[5][5] = -p_2; + MatrixWithNoName[5][6] = p_9; + MatrixWithNoName[6][6] = -p_2; + MatrixWithNoName[6][7] = p_10; + MatrixWithNoName[7][7] = -p_2; + MatrixWithNoName[7][8] = p_11; + MatrixWithNoName[8][8] = -p_2; + MatrixWithNoName[8][9] = p_12; + MatrixWithNoName[9][9] = -p_2; + MatrixWithNoName[9][10] = p_13; + MatrixWithNoName[10][10] = -p_2; + MatrixWithNoName[10][11] = p_14; + MatrixWithNoName[11][11] = -p_2; + MatrixWithNoName[11][12] = p_15; + MatrixWithNoName[12][12] = -p_2; + MatrixWithNoName[12][13] = p_16; + MatrixWithNoName[13][13] = -p_2; + MatrixWithNoName[13][14] = p_17; + MatrixWithNoName[14][14] = -p_2; + MatrixWithNoName[14][15] = p_18; + MatrixWithNoName[15][15] = -p_2; + MatrixWithNoName[15][16] = p_19; + MatrixWithNoName[16][16] = -p_2; + MatrixWithNoName[16][17] = p_20; + MatrixWithNoName[17][17] = -p_2; + MatrixWithNoName[17][18] = p_21; + MatrixWithNoName[18][18] = -p_2; + MatrixWithNoName[18][19] = p_22; + MatrixWithNoName[19][19] = -p_2; + MatrixWithNoName[19][20] = p_23; + MatrixWithNoName[20][20] = -p_2; + MatrixWithNoName[20][21] = p_24; + MatrixWithNoName[21][21] = -p_2; + MatrixWithNoName[21][22] = p_25; + MatrixWithNoName[22][22] = -p_2; + MatrixWithNoName[22][23] = p_26; + MatrixWithNoName[23][0] = p_0*p_1*x_23*1.0/pow(p_1*(x_23*x_23)+1.0,2.0)*-2.0; + MatrixWithNoName[23][23] = -p_2; + MatrixWithNoName[23][24] = p_27; + MatrixWithNoName[24][24] = -p_2; diff --git a/odemex/Parser/outputC/model/dxdt.c b/odemex/Parser/outputC/model/dxdt.c new file mode 100644 index 0000000..00d821e --- /dev/null +++ b/odemex/Parser/outputC/model/dxdt.c @@ -0,0 +1,154 @@ +#include "../dxdt.h" + + + +int rhs( realtype t, N_Vector y, N_Vector ydot, void *f_data ) { + + struct mData *data = ( struct mData * ) f_data; + + realtype ApoB_count , CE_count , DNL , J_ApoB_prod , J_CE_ER_deformation , J_CE_ER_formation , J_CE_HDL_for , J_CE_HDL_upt , J_CE_HDL_upt_1 , J_CE_HDL_upt_2 , J_CE_deformation , J_CE_formation , J_CE_upt_1 , J_CE_upt_2 , J_CE_upt_ph , J_FC_metabolism , J_FC_production , J_FFA_prod , J_FFA_upt_1 , J_FFA_upt_2 , J_TG_ER_formation , J_TG_ER_formation_DNL , J_TG_ER_production , J_TG_formation , J_TG_formation_DNL , J_TG_hyd_1 , J_TG_hyd_2 , J_TG_hyd_ph , J_TG_metabolism , J_TG_metabolism_DNL , J_TG_production , J_TG_upt_1 , J_TG_upt_2 , J_TG_upt_ph , J_VLDL_CE , J_VLDL_CE_1 , J_VLDL_CE_2 , J_VLDL_TG , J_VLDL_TG_1 , J_VLDL_TG_2 , J_VLDL_TG_DNL_1 , J_VLDL_TG_DNL_2 , TG_count , VLDL_clearance , VLDL_diameter , Vm_ApoB_prod , Vm_CE_ER_def , Vm_CE_ER_for , Vm_CE_def , Vm_CE_for , Vm_FC_met , Vm_FC_prod , Vm_FFA_prod , Vm_FFA_upt , Vm_HDL_CE_for , Vm_HDL_CE_upt , Vm_TG_CE_upt , Vm_TG_CE_upt_0 , Vm_TG_CE_upt_ph , Vm_TG_CE_upt_ph_0 , Vm_TG_ER_for , Vm_TG_ER_prod , Vm_TG_for , Vm_TG_hyd , Vm_TG_hyd_ph , Vm_TG_met , Vm_TG_prod , Vm_VLDL_CE , Vm_VLDL_TG , dDNL , dFFA , dVLDL_TG_C_ratio , dVLDL_clearance , dVLDL_diameter , dVLDL_production , dhep_CE_abs , dhep_FC_abs , dhep_HDL_CE_upt , dhep_TG_abs , dplasma_C , dplasma_C_HDL , dplasma_TG , dxdt , hep_CE , hep_CE_ER , hep_FC , hep_TG , hep_TG_DNL , hep_TG_ER , hep_TG_ER_DNL , lipo_rc , lipo_vc , mvCE , mvFC , mvPL , mvTG , mwApoB , mwCE , mwFC , mwPL , mwTG , navg , npi , plasma_C , plasma_C_HDL , plasma_FFA , plasma_TG , plasma_volume , rs , uH ; + + realtype *stateVars; + realtype *ydots; + + stateVars = NV_DATA_S(y); + ydots = NV_DATA_S(ydot); + + + + mwTG =859.2; + mvTG =946.8384; + mwCE =647.9; + mvCE =685.4782; + mwFC =386.7; + mvFC =394.8207; + mwPL =786; + mvPL =773.424; + mwApoB =546340; + navg =6.0221; + uH =1.6605; + plasma_volume =0.001; + rs =2; + npi =3.1416; + + hep_FC =stateVars[0]; + hep_CE =stateVars[1]; + hep_CE_ER =stateVars[2]; + hep_TG =stateVars[3]; + hep_TG_ER =stateVars[4]; + hep_TG_DNL =stateVars[5]; + hep_TG_ER_DNL =stateVars[6]; + plasma_TG =stateVars[7]; + plasma_C =stateVars[8]; + plasma_C_HDL =stateVars[9]; + plasma_FFA =stateVars[10]; + + Vm_FC_prod =data->p[0]; + Vm_FC_met =data->p[1]; + Vm_CE_for =data->p[2]; + Vm_CE_def =data->p[3]; + Vm_CE_ER_for =data->p[4]; + Vm_CE_ER_def =data->p[5]; + Vm_TG_prod =data->p[6]; + Vm_TG_met =data->p[7]; + Vm_TG_for =data->p[8]; + Vm_TG_ER_prod =data->p[9]; + Vm_TG_ER_for =data->p[10]; + Vm_FFA_upt =data->p[11]; + Vm_FFA_prod =data->p[12]; + Vm_VLDL_TG =data->p[13]; + Vm_VLDL_CE =data->p[14]; + Vm_TG_CE_upt =data->p[15]; + Vm_TG_CE_upt_ph =data->p[16]; + Vm_TG_hyd =data->p[17]; + Vm_TG_hyd_ph =data->p[18]; + Vm_HDL_CE_for =data->p[19]; + Vm_HDL_CE_upt =data->p[20]; + Vm_ApoB_prod =data->p[21]; + Vm_TG_CE_upt_0 =data->p[22]; + Vm_TG_CE_upt_ph_0 =data->p[23]; + + J_FC_production =Vm_FC_prod; + J_FC_metabolism =Vm_FC_met *hep_FC; + J_CE_formation =Vm_CE_for *hep_FC; + J_CE_deformation =Vm_CE_def *hep_CE; + J_CE_ER_formation =Vm_CE_ER_for *hep_FC; + J_CE_ER_deformation =Vm_CE_ER_def *hep_CE_ER; + J_TG_production =Vm_TG_prod; + J_TG_metabolism =Vm_TG_met *hep_TG; + J_TG_metabolism_DNL =Vm_TG_met *hep_TG_DNL; + J_TG_formation =Vm_TG_for *hep_TG_ER; + J_TG_formation_DNL =Vm_TG_for *hep_TG_ER_DNL; + J_TG_ER_production =Vm_TG_ER_prod; + J_TG_ER_formation =Vm_TG_ER_for *hep_TG; + J_TG_ER_formation_DNL =Vm_TG_ER_for *hep_TG_DNL; + J_FFA_upt_1 =Vm_FFA_upt *plasma_FFA; + J_FFA_upt_2 =Vm_FFA_upt *plasma_FFA *plasma_volume; + J_FFA_prod =Vm_FFA_prod; + J_VLDL_TG_1 =Vm_VLDL_TG *hep_TG_ER; + J_VLDL_TG_DNL_1 =Vm_VLDL_TG *hep_TG_ER_DNL; + J_VLDL_CE_1 =Vm_VLDL_CE *hep_CE_ER; + J_VLDL_TG_2 =Vm_VLDL_TG *hep_TG_ER /plasma_volume; + J_VLDL_TG_DNL_2 =Vm_VLDL_TG *hep_TG_ER_DNL /plasma_volume; + J_VLDL_CE_2 =Vm_VLDL_CE *hep_CE_ER /plasma_volume; + J_TG_upt_1 =Vm_TG_CE_upt *plasma_TG; + J_CE_upt_1 =Vm_TG_CE_upt *plasma_C; + J_TG_upt_ph =Vm_TG_CE_upt_ph *plasma_TG; + J_CE_upt_ph =Vm_TG_CE_upt_ph *plasma_C; + J_CE_HDL_for =Vm_HDL_CE_for; + J_CE_HDL_upt_1 =Vm_HDL_CE_upt *plasma_C_HDL; + J_TG_hyd_1 =Vm_TG_hyd *plasma_TG; + J_TG_hyd_ph =Vm_TG_hyd_ph *plasma_TG; + J_TG_upt_2 =Vm_TG_CE_upt *plasma_TG *plasma_volume; + J_CE_upt_2 =Vm_TG_CE_upt *plasma_C *plasma_volume; + J_CE_HDL_upt_2 =Vm_HDL_CE_upt *plasma_C_HDL *plasma_volume; + J_TG_hyd_2 =Vm_TG_hyd *plasma_TG *plasma_volume; + J_VLDL_TG =Vm_VLDL_TG * (hep_TG_ER +hep_TG_ER_DNL); + J_VLDL_CE =Vm_VLDL_CE *hep_CE_ER; + J_ApoB_prod =Vm_ApoB_prod; + ApoB_count =J_ApoB_prod *navg *pow(10,23) *pow(10,-6); + TG_count =J_VLDL_TG *navg *pow(10,23) *pow(10,-6) /ApoB_count; + CE_count =J_VLDL_CE *navg *pow(10,23) *pow(10,-6) /ApoB_count; + DNL = (hep_TG_DNL +hep_TG_ER_DNL) / (hep_TG +hep_TG_ER +hep_TG_DNL +hep_TG_ER_DNL); + lipo_vc = ( (TG_count *mvTG) + (CE_count *mvCE) ) * (pow(10,21) / (navg *pow(10,23))); + lipo_rc =pow((3 *lipo_vc) / (4 *npi),1/3); + VLDL_diameter = (lipo_vc +lipo_rc) *2; + VLDL_clearance = (Vm_TG_CE_upt +Vm_TG_CE_upt_ph) / (Vm_TG_CE_upt_0 +Vm_TG_CE_upt_ph_0); + J_CE_HDL_upt =Vm_HDL_CE_upt *plasma_C_HDL; + dhep_TG_abs =hep_TG +hep_TG_ER +hep_TG_DNL +hep_TG_ER_DNL; + dhep_CE_abs =hep_CE +hep_CE_ER; + dhep_FC_abs =hep_FC; + dplasma_C =plasma_C +plasma_C_HDL; + dplasma_TG =plasma_TG; + dVLDL_TG_C_ratio =TG_count /CE_count; + dVLDL_diameter =VLDL_diameter; + dVLDL_production =J_VLDL_TG; + dVLDL_clearance =VLDL_clearance; + dDNL =DNL; + dFFA =plasma_FFA; + dplasma_C_HDL =plasma_C_HDL; + dhep_HDL_CE_upt =J_CE_HDL_upt *plasma_volume; + + ydots[0] =J_FC_production -J_FC_metabolism -J_CE_formation +J_CE_deformation -J_CE_ER_formation +J_CE_ER_deformation; + ydots[1] =J_CE_formation -J_CE_deformation +J_CE_upt_2 +J_CE_HDL_upt_2; + ydots[2] =J_CE_ER_formation -J_CE_ER_deformation -J_VLDL_CE_1; + ydots[3] = -J_TG_metabolism +J_TG_formation -J_TG_ER_formation + (J_FFA_upt_2/3.0) +J_TG_upt_2 +J_TG_hyd_2; + ydots[4] = -J_TG_formation +J_TG_ER_formation -J_VLDL_TG_1; + ydots[5] =J_TG_production -J_TG_metabolism_DNL +J_TG_formation_DNL -J_TG_ER_formation_DNL; + ydots[6] =J_TG_ER_production -J_TG_formation_DNL +J_TG_ER_formation_DNL -J_VLDL_TG_DNL_1; + ydots[7] =J_VLDL_TG_2 +J_VLDL_TG_DNL_2 -J_TG_upt_1 -J_TG_upt_ph -J_TG_hyd_1 -J_TG_hyd_ph; + ydots[8] =J_VLDL_CE_2 -J_CE_upt_1 -J_CE_upt_ph; + ydots[9] =J_CE_HDL_for -J_CE_HDL_upt_1; + ydots[10] =J_FFA_prod -J_FFA_upt_1; + + + + + #ifdef NON_NEGATIVE + return 0; + #else + return 0; + #endif + +}; + diff --git a/odemex/Parser/outputC/model/dxdtDefs.h b/odemex/Parser/outputC/model/dxdtDefs.h new file mode 100644 index 0000000..9987c4e --- /dev/null +++ b/odemex/Parser/outputC/model/dxdtDefs.h @@ -0,0 +1,15 @@ + +#define N_STATES 11 +#define N_PARAMS 24 +#define N_INPUTS 0 +#define SOLVER 1 +#define BLOCK_SIZE 1000 + +#define MAX_CONV_FAIL 1000000 +#define MAX_STEPS 1000000000 +#define MAX_ERRFAILS 15 +#define MIN_STEPSIZE 0.000000000000010000000000000000 +#define MAX_STEPSIZE 100000000000000.000000000000000000000000000000 + +#define FIXEDRANGE + diff --git a/odemex/Parser/outputC/ode.c b/odemex/Parser/outputC/ode.c new file mode 100644 index 0000000..2543276 --- /dev/null +++ b/odemex/Parser/outputC/ode.c @@ -0,0 +1,225 @@ +/* + Joep Vanlier, 2011 + + Licensing: + Copyright (C) 2009-2011 Joep Vanlier. All rights + reserved. + + Contact:joep.vanlier@gmail.com + + This file is part of the puaMAT. + + puaMAT is free software: you can redistribute it + and/or modify it under the terms of the GNU General + Public License as published by the Free Software + Foundation, either version 3 of the License, or (at + your option) any later version. + + puaMAT is distributed in the hope that it will be + useful, but WITHOUT ANY WARRANTY; without even the + implied warranty of MERCHANTABILITY or FITNESS FOR A + PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General + Public License along with puaMAT. If not, see + http://www.gnu.org/licenses/ +*/ +#include "ode.h" +#include "model/dxdtDefs.h" + +void grabVectorFromMatlab( struct mVector *vector, const mxArray *prhs ) { + if ( mxIsDouble( prhs ) ) { + vector->length = mxGetN( prhs ) * mxGetM( prhs ); + vector->val = mxGetPr( prhs ); + } else { + mexErrMsgTxt( "ERROR: Check your parameters! Are they all doubles?" ); + } +} + +realtype interpolate( realtype *time, realtype *data, int n, realtype t, int type ) { + + realtype *deriv2; + realtype val; + + int max = n-1; + int min = 0; + int cur = max/2; + + double a, b, h, tmp; + + /* Out of bounds? */ + if ( t >= time[ max ] ) + return data[ n-1 ]; + else if ( t <= time[ min ] ) + return data[ 0 ]; + + /* Where are we? */ + while ( min != max - 1 ) + { + if ( time[ cur ] <= t ) + min = cur; + else + max = cur; + + cur = min + ( max - min ) / 2; + } + + switch( type ) + { + /* Piecewise */ + case 0: + val = data[ min ]; + return val; + break; + /* Linear Interpolation */ + case 1: + val = data[min] + ( t - time[min] ) * ( data[max] - data[min] ) / ( time[max] - time[min] ); + return val; + break; + /* Spline Interpolation */ + case 2: + deriv2 = &data[n]; + h = time[max] - time[min]; + a = ( time[ max ] - t ) / h; + b = ( t - time[ min ] ) / h; + val = a * data[ min ] + b * data[ max ] + ( ( a * a * a - a ) * deriv2[ min ] + ( b * b * b - b ) * deriv2[ max ] ) * ( h * h ) / 6.0; + return val; + break; + } +} + +realtype tpow(realtype x, unsigned int y) { + realtype z = y&1? x : 1; + while(y >>= 1) { + x *= x; + if(y & 1) z *= x; + } + return z; +} + +realtype intPow( double x, int y ) { + if(y < 0) + return 1.0/tpow(x, -y); + else + return tpow(x, y); +} + +realtype maximum( realtype a, realtype b ) { + return (a > b ? a : b); +} + +realtype minimum( realtype a, realtype b ) { + return (a > b ? b : a); +} + +void memErr( void *cvode_mem, N_Vector y0, void *pOld, const char *msg ) { + N_VDestroy_Serial( y0 ); + CVodeFree( &cvode_mem ); + mxFree( pOld ); + mexErrMsgTxt( msg ); +} + +void handleError( void *cvode_mem, N_Vector y0, int flag, mxArray *plhs[], int nrhs, int sensitivity, N_Vector *yS0, realtype *sensitivities, struct mData *data ) { + + #ifdef DEBUG + long int temp; + realtype tempreal; + #endif + + #ifdef DEBUG + printf( "<<< DEBUG OUTPUT >>>\n" ); + printf( "PARAMETERS: \n" ); + for ( temp = 0; temp < N_PARAMS; temp++ ) { + printf( "P(%d) = %f\n", temp, data->p[ temp ] ); + } + CVodeGetNumSteps(cvode_mem, &temp); + printf( "Number of steps taken by the solver: %d\n", temp ); + CVodeGetNumErrTestFails(cvode_mem, &temp); + printf( "Number of local error test failures: %d\n", temp ); + CVodeGetLastStep(cvode_mem, &tempreal); + printf( "Last stepsize: %f\n", tempreal ); + CVodeGetCurrentStep(cvode_mem, &tempreal); + printf( "Last step: %f\n", tempreal ); + #endif + + if ( sensitivity == 1 ) { + if ( nrhs < 7 ) free( sensitivities ); + free( data->p ); + N_VDestroyVectorArray_Serial( yS0, N_STATES + N_PARAMS ); + if ( plhs[2] != NULL ) mxDestroyArray(plhs[2]); + } + + if ( plhs[1] != NULL ) mxDestroyArray(plhs[1]); + if ( plhs[0] != NULL ) mxDestroyArray(plhs[0]); + + N_VDestroy_Serial( y0 ); + /*printf( "Freeing..." );*/ + /*CVodeFree( &cvode_mem );*/ + /*printf( "Success!\n" );*/ + + switch( flag ) { + case CV_MEM_NULL: + printf( "ERROR: No memory was allocated for cvode_mem\n" ); + break; + case CV_NO_MALLOC: + printf( "ERROR: Forgot or failed CVodeInit\n" ); + break; + case CV_ILL_INPUT: + printf( "ERROR: Input for CVode was illegal\n" ); + break; + case CV_TOO_CLOSE: + printf( "ERROR: Initial time too close to final time\n" ); + break; + case CV_TOO_MUCH_WORK: + printf( "ERROR: Solver took maximum number of internal steps, but hasn't reached t_out\n" ); + break; + case CV_TOO_MUCH_ACC: + printf( "ERROR: Could not attain desired accuracy\n" ); + break; + case CV_ERR_FAILURE: + printf( "ERROR: Error tests failed too many times\n" ); + break; + case CV_CONV_FAILURE: + printf( "ERROR: Convergence failure in solving the linear system\n" ); + break; + case CV_LINIT_FAIL: + printf( "ERROR: Linear solver failed to initialize\n" ); + break; + case CV_LSETUP_FAIL: + printf( "ERROR: Linear solver setup failed\n" ); + break; + case CV_RHSFUNC_FAIL: + printf( "ERROR: Right hand side failed in an unrecoverable manner\n" ); + break; + case CV_REPTD_RHSFUNC_ERR: + printf( "ERROR: Convergence test failures occured too many times in RHS\n" ); + break; + case CV_UNREC_RHSFUNC_ERR: + printf( "ERROR: Unrecoverable error in the RHS\n" ); + break; + case CV_RTFUNC_FAIL: + printf( "ERROR: Rootfinding function failed!\n" ); + break; + default: + printf( "ERROR: I have no idea what's going on :(\n" ); + break; + } + + mexErrMsgTxt( "Aborting" ); +} + +realtype *reAllocate2DOutputMemory( realtype *pMem, void *cvode_mem, N_Vector y0, mxArray *plhs, mwSize dim1, mwSize dim2 ) { + void *pOld; + + pOld = pMem; + pMem = mxRealloc( pMem, sizeof( realtype ) * dim1 * dim2 ); + + if ( pMem == NULL ) memErr( cvode_mem, y0, pOld, "ERROR: Insufficient memory for reallocation during simulation loop!" ); + + mxSetPr( plhs, pMem ); + mxSetM( plhs, dim1 ); + mxSetN( plhs, dim2 ); + + return pMem; +} diff --git a/odemex/Parser/outputC/ode.h b/odemex/Parser/outputC/ode.h new file mode 100644 index 0000000..392b1a6 --- /dev/null +++ b/odemex/Parser/outputC/ode.h @@ -0,0 +1,74 @@ +/* + Joep Vanlier, 2011 + + Licensing: + Copyright (C) 2009-2011 Joep Vanlier. All rights + reserved. + + Contact:joep.vanlier@gmail.com + + This file is part of the puaMAT. + + puaMAT is free software: you can redistribute it + and/or modify it under the terms of the GNU General + Public License as published by the Free Software + Foundation, either version 3 of the License, or (at + your option) any later version. + + puaMAT is distributed in the hope that it will be + useful, but WITHOUT ANY WARRANTY; without even the + implied warranty of MERCHANTABILITY or FITNESS FOR A + PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General + Public License along with puaMAT. If not, see + http://www.gnu.org/licenses/ +*/ +#include "mex.h" +#include "cvodes.h" +#include "model/dxdtDefs.h" +#include +#include +#include + +#define N_PI (3.141592653589793) +#define N_EXP (2.7182818284590455) + +#if SOLVER == 2 + #include "cvodes_lapack.h" +#endif +#if SOLVER == 3 + #include "cvodes_spgmr.h" +#endif +#if SOLVER == 4 + #include "cvodes_spbcgs.h" +#endif +#if SOLVER == 5 + #include "cvodes_sptfqmr.h" +#endif + +#ifndef ODE_H +#define ODE_H + +struct mVector { + double *val; + int length; +}; + +struct mData { + realtype *u; + realtype *p; +}; + +void grabVectorFromMatlab( struct mVector *vector, const mxArray *prhs ); +void handleError( void *cvode_mem, N_Vector y0, int flag, mxArray *plhs[], int nrhs, int sensitivity, N_Vector *yS0, realtype *sensitivities, struct mData *data ); +void memErr( void *cvode_mem, N_Vector y0, void *pOld, const char *msg ); +realtype *reAllocate2DOutputMemory( realtype *pMem, void *cvode_mem, N_Vector y0, mxArray *plhs, int dim1, int dim2 ); + +realtype interpolate( realtype *time, realtype *data, int n, realtype t, int type ); +realtype maximum( realtype x, realtype y ); +realtype minimum( realtype x, realtype y ); +realtype intPow( realtype x, int y ); + +#endif diff --git a/odemex/Parser/outputC_IDA/dxdt.h b/odemex/Parser/outputC_IDA/dxdt.h new file mode 100644 index 0000000..b77175b --- /dev/null +++ b/odemex/Parser/outputC_IDA/dxdt.h @@ -0,0 +1,39 @@ +/* + Joep Vanlier, 2011 + + Licensing: + Copyright (C) 2009-2011 Joep Vanlier. All rights + reserved. + + Contact:joep.vanlier@gmail.com + + This file is part of the puaMAT. + + puaMAT is free software: you can redistribute it + and/or modify it under the terms of the GNU General + Public License as published by the Free Software + Foundation, either version 3 of the License, or (at + your option) any later version. + + puaMAT is distributed in the hope that it will be + useful, but WITHOUT ANY WARRANTY; without even the + implied warranty of MERCHANTABILITY or FITNESS FOR A + PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General + Public License along with puaMAT. If not, see + http://www.gnu.org/licenses/ +*/ +#include "ode.h" +#include "model/dxdtDefs.h" + +#ifndef _DXDT_H_ +#define _DXDT_H_ + +#define realtype double + +int rhs( realtype t, N_Vector y, N_Vector ydot, N_Vector resid, void *f_data ); + + +#endif diff --git a/odemex/Parser/outputC_IDA/mexG.c b/odemex/Parser/outputC_IDA/mexG.c new file mode 100644 index 0000000..db85759 --- /dev/null +++ b/odemex/Parser/outputC_IDA/mexG.c @@ -0,0 +1,340 @@ +/* + Joep Vanlier, 2011 + + Licensing: + Copyright (C) 2009-2011 Joep Vanlier. All rights + reserved. + + Contact:joep.vanlier@gmail.com + + This file is part of the puaMAT. + + puaMAT is free software: you can redistribute it + and/or modify it under the terms of the GNU General + Public License as published by the Free Software + Foundation, either version 3 of the License, or (at + your option) any later version. + + puaMAT is distributed in the hope that it will be + useful, but WITHOUT ANY WARRANTY; without even the + implied warranty of MERCHANTABILITY or FITNESS FOR A + PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General + Public License along with puaMAT. If not, see + http://www.gnu.org/licenses/ +*/ +#include "ode.h" +#include "dxdt.h" +#include "time.h" +#include "string.h" + +const int numInputArgs = 5; +const int numOutputArgs = 1; + +void mexFunction (int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { + + time_t tStart, tEnd; + struct mVector t; + struct mVector tol; + struct mData data; + int k, p; + int nBlocks; + realtype t0; + realtype y[ N_STATES ]; + realtype yd[ N_STATES ]; + realtype *yOutput; + realtype *tOutput; + int mSize; + + int sensitivity; + + /* Structures required for IDA */ + int flag; + N_Vector y0 = NULL; + N_Vector yp0 = NULL; + N_Vector *yS0 = NULL; + void *cvode_mem = NULL; + void *pData = NULL; + realtype tret; + + /* Function pointer for the RHS */ + int (*f)(realtype t, N_Vector y, N_Vector ydot, N_Vector rr, void *f_data) = &rhs; + + if (nrhs == 0) { + printf( "Call function as:\ny = funcName(t, y0[%d], p[%d], u[%d], [reltol, abstol, maxtime])\n", N_STATES, N_PARAMS, N_INPUTS ); + return; + } + + if ( nrhs < numInputArgs ) mexErrMsgTxt( "ERROR: Incorrect number of input arguments\nFormat should be: (t, y0, x, u, [reltol, abstol, max_integration_time])\n" ); + + /* Check input dimensions */ + if ( mxGetNumberOfElements( prhs[1] ) != N_STATES ) { + printf( "ERROR: Initial condition vector has incorrect length! Expected %d, found %d", N_STATES, mxGetNumberOfElements( prhs[1] ) ); + mexErrMsgTxt( "" ); + } + if ( mxGetNumberOfElements( prhs[2] ) != N_PARAMS ) { + printf( "ERROR: Parameter vector has incorrect length! Expected %d, found %d", N_PARAMS, mxGetNumberOfElements( prhs[2] ) ); + mexErrMsgTxt( "" ); + } + if ( mxGetNumberOfElements( prhs[3] ) != N_INPUTS ) { + printf( "ERROR: Input vector has incorrect length! Expected %d, found %d", N_INPUTS, mxGetNumberOfElements( prhs[3] ) ); + mexErrMsgTxt( "" ); + } + if ( mxGetNumberOfElements( prhs[4] ) != 3 ) { + mexErrMsgTxt( "ERROR: Tolerance vector should be of the form [ relative tolerance, absolute tolerance, maximal time allowed for integration in seconds ]" ); + } + + /* Grab vectors for own use from MATLAB */ + grabVectorFromMatlab( &t, prhs[0] ); + grabVectorFromMatlab( &tol, prhs[4] ); + + if ( t.length < 1 ) + mexErrMsgTxt( "ERROR: Time vector should be at least one element. Either provide a single time to obtain a single value at time t, a begin and end time if the solver is allowed to determine the timesteps or a series of timepoints at which to compute the solution." ); + + sensitivity = 0; + if ( nrhs > 5 ) { + mexErrMsgTxt( "ERROR: Sensitivity analysis is currently not supported for DAE problems." ); + } + + if ( prhs[3] != NULL ) + data.u = mxGetPr( prhs[3] ); + else + data.u = NULL; + + /* Set parameter pointer to matlab structure */ + data.p = mxGetPr( prhs[2] ); + /* Copy initial condition to local structure */ + memcpy( y, mxGetPr( prhs[1] ), sizeof( realtype ) * mxGetNumberOfElements( prhs[1] ) ); + memset( yd, 0, sizeof( realtype ) * mxGetNumberOfElements( prhs[1] ) ); + y0 = N_VMake_Serial( N_STATES, y ); /* Warning, realtype has to be double for this */ + yp0 = N_VMake_Serial( N_STATES, yd ); /* Warning, realtype has to be double for this */ + + /* Compute appropriate initial condition for ydot */ + f(0, y0, yp0, yp0, &data); + for ( k = 0; k < N_STATES; k++ ) + NV_DATA_S(yp0)[k] = - NV_DATA_S(yp0)[k]; + + /* Set begin time */ + if ( t.length == 1 ) + t0 = 0.0; + else + t0 = t.val[0]; + + /* Start up IDA */ + cvode_mem = IDACreate( ); + + /* Initialise IDA */ + if ( IDAInit( cvode_mem, f, t0, y0, yp0 ) != IDA_SUCCESS ) { + N_VDestroy_Serial( y0 ); + N_VDestroy_Serial( yp0 ); + mexErrMsgTxt( "ERROR: Failed to initialise IDA" ); + } + + /* Specify tolerances */ + if ( IDASStolerances( cvode_mem, tol.val[0], tol.val[1] ) != IDA_SUCCESS ) { + N_VDestroy_Serial( y0 ); + N_VDestroy_Serial( yp0 ); + IDAFree( &cvode_mem ); + mexErrMsgTxt( "ERROR: Failed to set tolerances" ); + } + + IDASetMinStep( cvode_mem, MIN_STEPSIZE ); + IDASetMaxConvFails( cvode_mem, MAX_CONV_FAIL ); + IDASetMaxNumSteps( cvode_mem, MAX_STEPS ); + IDASetMaxErrTestFails( cvode_mem, MAX_ERRFAILS ); + IDASetMaxTime( cvode_mem, tol.val[2] ); + + #if SOLVER == 1 + /* Attach dense linear solver module */ + if ( IDADense( cvode_mem, N_STATES ) != IDA_SUCCESS ) { + N_VDestroy_Serial( y0 ); + N_VDestroy_Serial( yp0 ); + IDAFree( &cvode_mem ); + mexErrMsgTxt( "ERROR: Failed to attach linear solver module" ); + } + #endif + #if SOLVER == 2 + /* Use LAPACK solver */ + if ( IDALapackDense( cvode_mem, N_STATES ) != IDA_SUCCESS ) { + N_VDestroy_Serial( y0 ); + N_VDestroy_Serial( yp0 ); + IDAFree( &cvode_mem ); + mexErrMsgTxt( "ERROR: Failed to attach linear solver module" ); + } + #endif + #if SOLVER == 3 + /* Use scaled preconditioned GMRES */ + if ( IDASpgmr( cvode_mem, PREC_BOTH, 0 ) != IDA_SUCCESS ) { + N_VDestroy_Serial( y0 ); + N_VDestroy_Serial( yp0 ); + IDAFree( &cvode_mem ); + mexErrMsgTxt( "ERROR: Failed to attach linear solver module" ); + } + #endif + #if SOLVER == 4 + /* Use preconditioned Bi-CGStab solver */ + if ( IDASpbcg( cvode_mem, PREC_BOTH, 0 ) != IDA_SUCCESS ) { + N_VDestroy_Serial( y0 ); + N_VDestroy_Serial( yp0 ); + IDAFree( &cvode_mem ); + mexErrMsgTxt( "ERROR: Failed to attach linear solver module" ); + } + #endif + #if SOLVER == 5 + /* Use preconditioned TFQMR iterative solver */ + if ( IDASptfqmr( cvode_mem, PREC_BOTH, 0 ) != IDA_SUCCESS ) { + N_VDestroy_Serial( y0 ); + N_VDestroy_Serial( yp0 ); + IDAFree( &cvode_mem ); + mexErrMsgTxt( "ERROR: Failed to attach linear solver module" ); + } + #endif + +/* Current implementation keeps tolerances the same for all vectors + if ( IDASVTolerances( cvode_mem, reltol, abstol ) != IDA_SUCCESS ) { + mexErrMsgTxt( "ERROR: Failed to set SV tolerances" ); + }*/ + + /* We need to pass our parameters and inputs to the ODE file */ + pData = &data; + if ( IDASetUserData( cvode_mem, pData ) != IDA_SUCCESS ) { + mexErrMsgTxt( "ERROR: Failed passing parameters and initial conditions" ); + } + + IDASetLineSearchOffIC( cvode_mem, 1 ); + IDASetMaxNumStepsIC( cvode_mem, 100 ); + IDASetMaxNumJacsIC( cvode_mem, 100 ); + IDASetMaxNumItersIC( cvode_mem, 100 ); + + // flag = IDACalcIC( cvode_mem, IDA_Y_INIT, 0.001 ); + // if ( ( flag < 0 ) && ( flag != IDA_NO_RECOVERY ) ) handleError( cvode_mem, y0, yp0, flag, plhs ); + + /* Start the timer */ + time( &tStart ); + + if ( t.length == 2 ) { + nBlocks = 1; + mSize = nBlocks * BLOCK_SIZE; + + /* No steps were specified, just begin and end (dynamic memory allocation) */ + if ( nlhs > 0 ) mxDestroyArray(plhs[0]); + plhs[0] = mxCreateDoubleMatrix( 1, BLOCK_SIZE, mxREAL ); + tOutput = mxGetPr(plhs[0]); + tOutput[0] = t.val[0]; + + if ( nlhs > 1 ) mxDestroyArray(plhs[1]); + plhs[1] = mxCreateDoubleMatrix( N_STATES, BLOCK_SIZE, mxREAL ); + yOutput = mxGetPr(plhs[1]); + memcpy( &yOutput[0], &NV_DATA_S( y0 )[0], sizeof( realtype ) * N_STATES ); + + p = 0; k = 0; + tret = t.val[0]; + while ( tret < t.val[1] ) + { + p = p + N_STATES; k++; + flag = IDASolve( cvode_mem, t.val[1], &tret, y0, yp0, IDA_ONE_STEP ); + if ( flag < 0 ) handleError( cvode_mem, y0, yp0, flag, plhs ); + + /* Check if the memory is still sufficient to store the output */ + if ( ( k + 1 ) > mSize ) { + /* If we run out of memory, increase the storage size */ + nBlocks ++; + mSize = nBlocks * BLOCK_SIZE; + + /* We're not done yet so resize the block */ + tOutput = reAllocate2DOutputMemory( tOutput, cvode_mem, y0, yp0, plhs[0], 1, mSize ); + yOutput = reAllocate2DOutputMemory( yOutput, cvode_mem, y0, yp0, plhs[1], N_STATES, mSize ); + } + + /* Fetch the output */ + memcpy( &yOutput[p], &NV_DATA_S( y0 )[0], sizeof( realtype ) * N_STATES ); + tOutput[k] = tret; + time( &tEnd ); + if ( difftime( tEnd, tStart ) > tol.val[2] ) { + printf( "WARNING: Simulation time exceeded! Aborting simulation at t = %e\n", tret ); + break; + } + + } + if ( nBlocks > 1 ) { + printf( "WARNING: Required %d memory reallocations. Consider increasing block size.\n\n", nBlocks ); + } + + /* After we are done simulating, we tighten the memory block to the true size */ + tOutput = reAllocate2DOutputMemory( tOutput, cvode_mem, y0, yp0, plhs[0], 1, k + 1 ); + yOutput = reAllocate2DOutputMemory( yOutput, cvode_mem, y0, yp0, plhs[1], N_STATES, k + 1 ); + + } else { + /* Only one time point */ + if ( t.length == 1 ) { + + /* Steps were specified --> Static memory allocation (faster) */ + if ( nlhs > 0 ) mxDestroyArray(plhs[0]); + plhs[0] = mxCreateDoubleMatrix( 1, 1, mxREAL ); + tOutput = mxGetPr(plhs[0]); + if ( nlhs > 1 ) mxDestroyArray(plhs[1]); + plhs[1] = mxCreateDoubleMatrix( N_STATES, 1, mxREAL ); + yOutput = mxGetPr(plhs[1]); + tret = 0.0; + + /* Simulate up to a point */ + flag = IDASolve( cvode_mem, t.val[0], &tret, y0, yp0, IDA_NORMAL ); + if ( flag < 0 ) handleError( cvode_mem, y0, yp0, flag, plhs ); + + memcpy( &yOutput[0], &NV_DATA_S( y0 )[0], sizeof( realtype ) * N_STATES ); + tOutput[0] = tret; + } else { + /* Steps were specified --> Static memory allocation (faster) */ + if ( nlhs > 0 ) mxDestroyArray(plhs[0]); + plhs[0] = mxCreateDoubleMatrix( 1, t.length, mxREAL ); + tOutput = mxGetPr(plhs[0]); + tOutput[0] = t.val[0]; + tret = t.val[0]; + + if ( nlhs > 1 ) mxDestroyArray(plhs[1]); + plhs[1] = mxCreateDoubleMatrix( N_STATES, t.length, mxREAL ); + yOutput = mxGetPr(plhs[1]); + + memcpy( &yOutput[0], &NV_DATA_S( y0 )[0], sizeof( realtype ) * N_STATES ); + + /* Fixed steps were specified */ + p = N_STATES; + + for ( k = 1; k < t.length; k++ ) { + flag = IDASolve( cvode_mem, t.val[k], &tret, y0, yp0, IDA_NORMAL ); + if ( flag < 0 ) handleError( cvode_mem, y0, yp0, flag, plhs ); + + /* Fetch the output */ + memcpy( &yOutput[p], &NV_DATA_S( y0 )[0], sizeof( realtype ) * N_STATES ); + p = p + N_STATES; + tOutput[k] = t.val[k]; + + time( &tEnd ); + if ( difftime( tEnd, tStart ) > tol.val[2] ) { + printf( "WARNING: Simulation time exceeded! Aborting simulation", t.val[k] ); + tOutput = reAllocate2DOutputMemory( tOutput, cvode_mem, y0, yp0, plhs[0], 1, k ); + yOutput = reAllocate2DOutputMemory( yOutput, cvode_mem, y0, yp0, plhs[1], N_STATES, k ); + break; + } + } + } + } + N_VDestroy_Serial( y0 ); + N_VDestroy_Serial( yp0 ); + + /* Free IDA memory */ + IDAFree( &cvode_mem ); + + /* If we desire only one output, we probably meant the solution array + since it is pretty pointless to output the time array */ + if ( nlhs == 1 ) { + mxDestroyArray( plhs[0] ); + plhs[0] = plhs[1]; + } + +} + + + diff --git a/odemex/Parser/outputC_IDA/ode.c b/odemex/Parser/outputC_IDA/ode.c new file mode 100644 index 0000000..a8b3fee --- /dev/null +++ b/odemex/Parser/outputC_IDA/ode.c @@ -0,0 +1,204 @@ +/* + Joep Vanlier, 2011 + + Licensing: + Copyright (C) 2009-2011 Joep Vanlier. All rights + reserved. + + Contact:joep.vanlier@gmail.com + + This file is part of the puaMAT. + + puaMAT is free software: you can redistribute it + and/or modify it under the terms of the GNU General + Public License as published by the Free Software + Foundation, either version 3 of the License, or (at + your option) any later version. + + puaMAT is distributed in the hope that it will be + useful, but WITHOUT ANY WARRANTY; without even the + implied warranty of MERCHANTABILITY or FITNESS FOR A + PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General + Public License along with puaMAT. If not, see + http://www.gnu.org/licenses/ +*/ +#include "ode.h" + +void grabVectorFromMatlab( struct mVector *vector, const mxArray *prhs ) { + if ( mxIsDouble( prhs ) ) { + vector->length = mxGetN( prhs ) * mxGetM( prhs ); + vector->val = mxGetPr( prhs ); + } else { + mexErrMsgTxt( "ERROR: Check your parameters! Are they all doubles?" ); + } +} + +realtype interpolate( realtype *time, realtype *data, int n, realtype t, int type ) { + + realtype *deriv2; + realtype val; + + int max = n-1; + int min = 0; + int cur = max/2; + + double a, b, h, tmp; + + /* Out of bounds? */ + if ( t >= time[ max ] ) + return data[ n-1 ]; + else if ( t <= time[ min ] ) + return data[ 0 ]; + + /* Where are we? */ + while ( min != max - 1 ) + { + if ( time[ cur ] <= t ) + min = cur; + else + max = cur; + + cur = min + ( max - min ) / 2; + } + + switch( type ) + { + /* Piecewise */ + case 0: + val = data[ min ]; + return val; + break; + /* Linear Interpolation */ + case 1: + val = data[min] + ( t - time[min] ) * ( data[max] - data[min] ) / ( time[max] - time[min] ); + return val; + break; + /* Spline Interpolation */ + case 2: + deriv2 = &data[n]; + h = time[max] - time[min]; + a = ( time[ max ] - t ) / h; + b = ( t - time[ min ] ) / h; + val = a * data[ min ] + b * data[ max ] + ( ( a * a * a - a ) * deriv2[ min ] + ( b * b * b - b ) * deriv2[ max ] ) * ( h * h ) / 6.0; + return val; + break; + } +} inline; +realtype tpow(realtype x, unsigned int y) { + realtype z = y&1? x : 1; + while(y >>= 1) { + x *= x; + if(y & 1) z *= x; + } + return z; +} inline; + +realtype intPow( double x, int y ) { + if(y < 0) + return 1.0/tpow(x, -y); + else + return tpow(x, y); +} inline; + +realtype maximum( realtype a, realtype b ) { + return (a > b ? a : b); +} inline; + +realtype minimum( realtype a, realtype b ) { + return (a > b ? b : a); +} inline; + +void memErr( void *cvode_mem, N_Vector y0, N_Vector yp0, void *pOld, const char *msg ) { + N_VDestroy_Serial( y0 ); + N_VDestroy_Serial( yp0 ); + printf( "Freeing..." ); + IDAFree(&cvode_mem ); + printf( "Success!\n" ); + + mxFree( pOld ); + mexErrMsgTxt( msg ); +} inline; + +void handleError( void *cvode_mem, N_Vector y0, N_Vector yp0, int flag, mxArray *plhs[] ) { + + if ( plhs[1] != NULL ) mxDestroyArray(plhs[1]); + if ( plhs[0] != NULL ) mxDestroyArray(plhs[0]); + N_VDestroy_Serial( y0 ); + N_VDestroy_Serial( yp0 ); + printf( "Freeing..." ); + //IDAFree( &cvode_mem ); + printf( "Success!\n" ); + + switch( flag ) { + case IDA_NO_MALLOC: + printf( "ERROR: IDAInit not called\n" ); + break; + case IDA_NO_RECOVERY: + printf( "ERROR: There were recoverable errors but IC failed to recover.\n" ); + break; + case IDA_BAD_EWT: + printf( "ERROR: Error weight vector component zero\n" ); + break; + case IDA_FIRST_RES_FAIL: + printf( "ERROR: Error in user residual function\n" ); + break; + case IDA_CONSTR_FAIL: + printf( "CalcIC could not find solution satisfying constraints\n" ); + break; + case IDA_LINESEARCH_FAIL: + printf( "ERROR: Linesearch failed\n" ); + break; + case IDA_MEM_NULL: + printf( "ERROR: No memory was allocated for cvode_mem\n" ); + break; + case IDA_ILL_INPUT: + printf( "ERROR: Input for CVode was illegal\n" ); + break; + case IDA_TOO_MUCH_WORK: + printf( "ERROR: Solver took maximum number of internal steps, but hasn't reached t_out\n" ); + break; + case IDA_TOO_MUCH_ACC: + printf( "ERROR: Could not attain desired accuracy\n" ); + break; + case IDA_LINIT_FAIL: + printf( "ERROR: Linear solver failed to initialize\n" ); + break; + case IDA_LSETUP_FAIL: + printf( "ERROR: Linear solver setup failed\n" ); + break; + case IDA_RES_FAIL: + printf( "ERROR: Right hand side failed in an unrecoverable manner\n" ); + break; + case IDA_RTFUNC_FAIL: + printf( "ERROR: Rootfinding function failed!\n" ); + break; + case IDA_LSOLVE_FAIL: + printf( "ERROR: Linear solver failed\n" ); + break; + case IDA_CONV_FAIL: + printf( "ERROR: No Newton Convergence\n" ); + break; + default: + printf( "ERROR: I have no idea what's going on :(\n" ); + break; + } + mexErrMsgTxt( "Aborting" ); +} inline; + +realtype *reAllocate2DOutputMemory( realtype *pMem, void *cvode_mem, N_Vector y0, N_Vector yp0, mxArray *plhs, mwSize dim1, mwSize dim2 ) { + void *pOld; + + pOld = pMem; + pMem = mxRealloc( pMem, sizeof( realtype ) * dim1 * dim2 ); + + if ( pMem == NULL ) memErr( cvode_mem, y0, yp0, pOld, "ERROR: Insufficient memory for reallocation during simulation loop!" ); + + mxSetPr( plhs, pMem ); + mxSetM( plhs, dim1 ); + mxSetN( plhs, dim2 ); + + return pMem; +} inline; diff --git a/odemex/Parser/outputC_IDA/ode.h b/odemex/Parser/outputC_IDA/ode.h new file mode 100644 index 0000000..cd1f97a --- /dev/null +++ b/odemex/Parser/outputC_IDA/ode.h @@ -0,0 +1,73 @@ +/* + Joep Vanlier, 2011 + + Licensing: + Copyright (C) 2009-2011 Joep Vanlier. All rights + reserved. + + Contact:joep.vanlier@gmail.com + + This file is part of the puaMAT. + + puaMAT is free software: you can redistribute it + and/or modify it under the terms of the GNU General + Public License as published by the Free Software + Foundation, either version 3 of the License, or (at + your option) any later version. + + puaMAT is distributed in the hope that it will be + useful, but WITHOUT ANY WARRANTY; without even the + implied warranty of MERCHANTABILITY or FITNESS FOR A + PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General + Public License along with puaMAT. If not, see + http://www.gnu.org/licenses/ +*/ +#include "mex.h" +#include "ida.h" +#include "model/dxdtDefs.h" +#include +#include + +#define N_PI (3.141592653589793) +#define N_EXP (2.7182818284590455) + +#if SOLVER == 2 + #include "idas_lapack.h" +#endif +#if SOLVER == 3 + #include "idas_spgmr.h" +#endif +#if SOLVER == 4 + #include "idas_spbcgs.h" +#endif +#if SOLVER == 5 + #include "idas_sptfqmr.h" +#endif + +#ifndef ODE_H +#define ODE_H + +struct mVector { + double *val; + int length; +}; + +struct mData { + realtype *u; + realtype *p; +}; + +void grabVectorFromMatlab( struct mVector *vector, const mxArray *prhs ); +void handleError( void *cvode_mem, N_Vector y0, N_Vector yp0, int flag, mxArray *plhs[] ); +void memErr( void *cvode_mem, N_Vector y0, N_Vector yp0, void *pOld, const char *msg ); +realtype *reAllocate2DOutputMemory( realtype *pMem, void *cvode_mem, N_Vector y0, N_Vector yp0, mxArray *plhs, int dim1, int dim2 ); + +realtype interpolate( realtype *time, realtype *data, int n, realtype t, int type ); +realtype maximum( realtype x, realtype y ); +realtype minimum( realtype x, realtype y ); +realtype intPow( realtype x, int y ); + +#endif diff --git a/odemex/Parser/parserDependencies/Interpolate.m b/odemex/Parser/parserDependencies/Interpolate.m new file mode 100644 index 0000000..21dad30 --- /dev/null +++ b/odemex/Parser/parserDependencies/Interpolate.m @@ -0,0 +1,28 @@ + +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/Parser/parserDependencies/analyseFunctionHeader.m b/odemex/Parser/parserDependencies/analyseFunctionHeader.m new file mode 100644 index 0000000..72a5664 --- /dev/null +++ b/odemex/Parser/parserDependencies/analyseFunctionHeader.m @@ -0,0 +1,59 @@ +function [ outVars, inVars, funcName ] = analyseFunctionHeader( string ) + +outVars = {}; +inVars = {}; + +% remove function handle +string = strrep( string, 'function', '' ); + +[ pre post ] = strtok( string, '=' ); + +funcName = fliplr( strtok( fliplr(strtok( post, '(' ) ), ' =' ) ); + +[ tok rem ] = strtok( pre, '[], ' ); +if isempty( tok ) + disp( 'WARNING: No output variable when parsing function' ); +end +while ( ~isempty( rem ) | ~isempty( tok ) ) + outVars = { outVars{:}, tok }; + [ tok rem ] = strtok( rem, '[], ' ); +end + +post = grabBetweenBrackets( post ); +[ tok rem ] = strtok( post, '[], ' ); + +if isempty( tok ) + disp( 'WARNING: No input variable when parsing function' ); +end +while ( ~isempty( rem ) | ~isempty( tok ) ) + inVars = { inVars{:}, tok }; + [ tok rem ] = strtok( rem, '[], ' ); +end + +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/Parser/parserDependencies/dec1.m b/odemex/Parser/parserDependencies/dec1.m new file mode 100644 index 0000000..a1da31d --- /dev/null +++ b/odemex/Parser/parserDependencies/dec1.m @@ -0,0 +1,41 @@ +% Attempt to subtract 1 and evaluate. If it cannot be evaluated return a +% string expression + +function string = dec1( string ) + +string = [ '(' string ') - 1' ]; + +try + tmp = eval( string ); + string = num2str( tmp ); +catch + +end + +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/Parser/parserDependencies/grabBetweenBrackets.m b/odemex/Parser/parserDependencies/grabBetweenBrackets.m new file mode 100644 index 0000000..1ecb14b --- /dev/null +++ b/odemex/Parser/parserDependencies/grabBetweenBrackets.m @@ -0,0 +1,58 @@ +function [ between, rest ] = grabBetweenBrackets( inputString ) + +brackets = 1; +ptr = 1; +between = ''; + +while( ~strcmp( inputString( ptr ), '(' ) ) + ptr = ptr + 1; +end + +ptr = ptr + 1; +startPtr = ptr; + +while ( ( brackets > 0 ) & ( ptr <= length( inputString ) ) ) + if strcmp( inputString( ptr ), '(' ) + brackets = brackets + 1; + end + if strcmp( inputString( ptr ), ')' ) + brackets = brackets - 1; + end + ptr = ptr + 1; +end + +if ( brackets > 0 ) + disp( sprintf( 'WARNING: No closing bracket detected.\nRelevant code: %s!\n', inputString ) ); +end + +between = inputString( startPtr : ptr - 2 ); +rest = inputString( ptr : end ); + + +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/Parser/parserDependencies/grabFieldNames.m b/odemex/Parser/parserDependencies/grabFieldNames.m new file mode 100644 index 0000000..bc2361b --- /dev/null +++ b/odemex/Parser/parserDependencies/grabFieldNames.m @@ -0,0 +1,31 @@ +function [ names, indices ] = grabFieldNames( inputStruct ) + + names = fieldnames( inputStruct ); + [ names, indices ] = sortList( names ); +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/Parser/parserDependencies/grabIndices.m b/odemex/Parser/parserDependencies/grabIndices.m new file mode 100644 index 0000000..501aee7 --- /dev/null +++ b/odemex/Parser/parserDependencies/grabIndices.m @@ -0,0 +1,33 @@ +function [ indices ] = grabIndices( names, struct ) + + for a = 1 : length( names ) + indices{ a } = getfield( struct, names{a} ); + end +end +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/Parser/parserDependencies/intPow.m b/odemex/Parser/parserDependencies/intPow.m new file mode 100644 index 0000000..529782a --- /dev/null +++ b/odemex/Parser/parserDependencies/intPow.m @@ -0,0 +1,30 @@ +function y = intPow( double, int ) + y = double ^ int; + +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/Parser/parserDependencies/jacGen1.m b/odemex/Parser/parserDependencies/jacGen1.m new file mode 100644 index 0000000..b3d0522 --- /dev/null +++ b/odemex/Parser/parserDependencies/jacGen1.m @@ -0,0 +1,125 @@ + +%modelStruct = mStruct; +eval( sprintf( '%s = mStruct;', structVar ) ); + +jacFileName = [ parserPath '/outputC/model/aJac.c' ]; + +disp( 'Computing RHS derivatives ...' ); +for a = 1 : nStates + eval( sprintf( 'syms x_%d;', a - 1 ) ); + eval( sprintf( 'x(%d) = x_%d;', a, a - 1 ) ); +end + +try + for a = 1 : length( fieldnames( mStruct.u ) ) + eval( sprintf( 'syms u_%d;', a - 1 ) ); + eval( sprintf( 'u(%d) = u_%d;', a, a - 1 ) ); + end +catch +end + +for a = 1 : nStates + nPars + for b = 1 : nStates + eval( sprintf( 'syms s_%d_%d;', a - 1 , b - 1 ) ); + eval( sprintf( 'S(%d, %d) = s_%d_%d;', b, a, a - 1, b - 1) ); + end +end + +for a = 1 : nPars + eval( sprintf( 'syms p_%d;', a - 1 ) ); + eval( sprintf( 'p(%d) = p_%d;', a, a - 1 ) ); +end + +m_file = textread( odeInput, '%s', 'delimiter', '\n' ); + +m_file = sprintf( '%s\n', m_file{2:end} ); +eval( m_file ); + +for a = 1 : nStates + for b = 1 : nStates + dfdy( b, a ) = diff( dx(a), x(b) ); + end +end + +for a = 1 : nStates + for b = 1 : nPars + dfdp( a, b ) = diff( dx(a), p(b) ); + end +end + +for a = 1 : nStates + dfdp( a, a+nPars ) = 0; +end + +if ( aJac == 1 ) + + %% Generate the analytical sensitivity equations + disp( 'Generating sensitivity equations ...' ); + ccode( ( dfdy.' * S + dfdp ).', 'file', jacFileName ); + + disp( 'Reading sensitivity equation C-file' ); + c_file = textread( jacFileName, '%s', 'delimiter', '\n' ); + + disp( 'Replacing state names' ); + c_file = regexprep( c_file, 'MatrixWithNoName\[(\d*)\]', 'NV_DATA_S(ySdot[$1])' ); + c_file = regexprep( c_file, 'p_(\d*)', 'data->p[$1]' ); + c_file = regexprep( c_file, 'u_(\d*)', 'data->u[$1]' ); + c_file = regexprep( c_file, 'x_(\d*)', 'stateVars[$1]' ); + c_file = regexprep( c_file, 's_(\d*)_(\d*)', 'NV_DATA_S(yS[$1])[$2]' ); + c_file = regexprep( c_file, '^t0 = ', '' ); + + fullstring = sprintf( '%s\n', c_file{:} ); + + [startIndex, endIndex, tokIndex, matchStr, tokenStr] = regexp( fullstring, 't(\d*)' ); + + maxT = 0; + for a = 1 : length( tokenStr ) + val = str2num( tokenStr{a}{1} ); + maxT = max( [ val, maxT ] ); + end + + preString = sprintf('int sensRhs (int Ns, realtype t, N_Vector y, N_Vector ydot, N_Vector *yS, N_Vector *ySdot, void *user_data, N_Vector tmp1, N_Vector tmp2) {\n\n'); + for a = 1 : maxT + preString = sprintf( '%srealtype t%d;', preString, a ); + end + postString = sprintf( '\nstruct mData *data = ( struct mData * ) user_data;\nrealtype *stateVars;\nstateVars = NV_DATA_S(y);\n\n' ); + sensRHS = sprintf( '%s\n%s\n%s\nreturn 0;\n};\n', preString, postString, fullstring ); + +else + sensRHS = ''; +end + +if ( fJac == 1 ) + %% Analytical Jacobian + disp( 'Generating jacobian ...' ); + %ccode( (dfdy.').', 'file', jacFileName ); + ccode( (dfdy.').', 'file', jacFileName ); + %ccode( (sym(0).').', 'file', jacFileName ); + + disp( 'Reading jacobian C-file' ); + c_file = textread( jacFileName, '%s', 'delimiter', '\n' ); + + disp( 'Replacing state names' ); + c_file = regexprep( c_file, 'MatrixWithNoName\[(\d*)\]', 'DENSE_COL(Jac,$1)' ); + c_file = regexprep( c_file, 'p_(\d*)', 'data->p[$1]' ); + c_file = regexprep( c_file, 'u_(\d*)', 'data->u[$1]' ); + c_file = regexprep( c_file, 'x_(\d*)', 'stateVars[$1]' ); + c_file = regexprep( c_file, '^t0 = ', '' ); + + fullstring = sprintf( '%s\n', c_file{:} ); + + [startIndex, endIndex, tokIndex, matchStr, tokenStr] = regexp( fullstring, 't(\d*)' ); + + maxT = 0; + for a = 1 : length( tokenStr ) + val = str2num( tokenStr{a}{1} ); + maxT = max( [ val, maxT ] ); + end + + preString = sprintf('int fJac (long int N, realtype t, N_Vector y, N_Vector fy, DlsMat Jac, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) {\n\n'); + for a = 1 : maxT + preString = sprintf( '%srealtype t%d;', preString, a ); + end + postString = sprintf( '\nstruct mData *data = ( struct mData * ) user_data;\nrealtype *stateVars;\nstateVars = NV_DATA_S(y);\n\n' ); + sensRHS = sprintf( '%s%s\n%s\n%s\nreturn 0;\n};\n', sensRHS, preString, postString, fullstring ); +end \ No newline at end of file diff --git a/odemex/Parser/parserDependencies/maximum.m b/odemex/Parser/parserDependencies/maximum.m new file mode 100644 index 0000000..616b877 --- /dev/null +++ b/odemex/Parser/parserDependencies/maximum.m @@ -0,0 +1,29 @@ +function maxi = maximum( a, b ) + maxi = max( a(1), b(1) ); +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/Parser/parserDependencies/minimum.m b/odemex/Parser/parserDependencies/minimum.m new file mode 100644 index 0000000..ae4b3ff --- /dev/null +++ b/odemex/Parser/parserDependencies/minimum.m @@ -0,0 +1,29 @@ +function mini = minimum( a, b ) + mini = min( a(1), b(1) ); +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/Parser/parserDependencies/pow.m b/odemex/Parser/parserDependencies/pow.m new file mode 100644 index 0000000..8012a5f --- /dev/null +++ b/odemex/Parser/parserDependencies/pow.m @@ -0,0 +1,30 @@ +function y = intPow( double1, double2 ) + y = double1 ^ double2; + +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/Parser/parserDependencies/printList.m b/odemex/Parser/parserDependencies/printList.m new file mode 100644 index 0000000..28e9a0d --- /dev/null +++ b/odemex/Parser/parserDependencies/printList.m @@ -0,0 +1,39 @@ +% Print unique members in comma separated value ingoring the ones found in +% invars. + +function l = printList( llist, add ) + + l = sprintf( 'realtype %s ', llist{1} ); + + for b = 2 : length( llist ) + l = sprintf( '%s, %s %s', l, add, llist{b} ); + end + +end +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/Parser/parserDependencies/printUniqueList.m b/odemex/Parser/parserDependencies/printUniqueList.m new file mode 100644 index 0000000..dfae851 --- /dev/null +++ b/odemex/Parser/parserDependencies/printUniqueList.m @@ -0,0 +1,60 @@ +% Print unique members in comma separated value ingoring the ones found in +% invars. + +function l = printUniqueList( llist, invars, idtype ) + + llist = unique( llist ); + + if nargin > 1 + for b = 1 : length( invars ) + a = 1; + while( a <= length( llist ) ) + if strcmp( llist(a), invars(b) ) + llist( a ) = []; + else + a = a + 1; + end + end + end + end + + if nargin < 3, idtype = 'realtype'; end + + if ~isempty( llist ) + l = sprintf( '%s %s ', idtype, llist{1} ); + + for b = 2 : length( llist ) + l = sprintf( '%s, %s %s', l, llist{b} ); + end + else + l = ''; + end + +end +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/Parser/parserDependencies/replaceStructNames.m b/odemex/Parser/parserDependencies/replaceStructNames.m new file mode 100644 index 0000000..38c04c9 --- /dev/null +++ b/odemex/Parser/parserDependencies/replaceStructNames.m @@ -0,0 +1,35 @@ +% This function seeks patterns of structName.name and replaces them with +% the corresponding indices in the list indices. + +function [ string ] = replaceStructNames( string, names, indices, structName ) + + for a = 1 : length( names ) + string = regexprep( string, sprintf( '\\w*%s[.]%s', structName, names{a} ), num2str( indices{a}(1) ) ); + end +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/Parser/parserDependencies/sortList.m b/odemex/Parser/parserDependencies/sortList.m new file mode 100644 index 0000000..bad9274 --- /dev/null +++ b/odemex/Parser/parserDependencies/sortList.m @@ -0,0 +1,40 @@ +function [ outList, M ] = sortList( list ) + for a = 1 : length( list ) + sizes(a) = length( list{a} ); + end + + [N, I] = sort( -sizes ); + + outList(1:length(I)) = list( I ); + + for a = 1 : length( list ) + M(a) = find( I == a ); + end +end +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/Parser/parserDependencies/strtok2.m b/odemex/Parser/parserDependencies/strtok2.m new file mode 100644 index 0000000..57550e9 --- /dev/null +++ b/odemex/Parser/parserDependencies/strtok2.m @@ -0,0 +1,41 @@ +% Function that grabs a token, but shows you which chars were removed + +function [ token, remain, tokensLost ] = strtok2( string, tokens ) + + l = length( string ); + [ token, remain ] = strtok( string, tokens ); + + missing = length( string ) - length( token ) - length( remain ); + + tokensLost = string( 1 : missing ); + + + + +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/SBML Tools/SBMLtoM.m b/odemex/SBML Tools/SBMLtoM.m new file mode 100644 index 0000000..dd3ec59 --- /dev/null +++ b/odemex/SBML Tools/SBMLtoM.m @@ -0,0 +1,260 @@ +% This function converts an SBML file into a MATLAB file, the parser can +% handle. It also returns the initial conditions and all the necessary +% structures to convert to C. +% +% function [ modelStruct, p, x0, u0 ] = SBMLToM( inDir, inFn, outDir, outFn ) +% +% Input Arguments: +% inDir input directory (location of the SBML files) +% inFn input filename +% outDir output directory (where to put the M-file) +% outFn output filename (of the m-file) +% +% Optional: constantList (cell array of parameters that should be treated as +% constants) +% +% Note: SBML toolbox for MATLAB needs to be installed for this to work! +% See http://sbml.org/Software/SBMLToolbox +% +% Authors: J Vanlier, R Oosterhof +function [ modelStruct, p, x0, u0 ] = SBMLToM( inDir, inFn, outDir, outFn, constantList, lumpList ) + + model = translateSBML( [ inDir '/' inFn ] ); + + b = 1; c = 1; u0 = []; + for a = 1 : length( model.species ) + if model.species(a).constant == 0 + x0( c ) = model.species(a).initialConcentration; + eval( sprintf( 'modelStruct.s.%s = %d;', model.species(a).id, c ) ); + c = c + 1; + else + u0( b ) = model.species(a).initialConcentration; + eval( sprintf( 'modelStruct.u.%s = %d;', model.species(a).id, b ) ); + b = b + 1; + end + end + nStates = c; + nInputs = b; + + lumpIDs = zeros( length( lumpList ), 1 ); + + for a = 1 : length( model.compartment ) + eval( sprintf( 'modelStruct.c.%s = %.15f;', model.compartment(1).id, model.compartment(1).size ) ); + end + + c = 1; + for a = 1 : length( model.reaction ) + try + for b = 1 : length( model.reaction(a).kineticLaw.parameter ) + p( c ) = model.reaction(a).kineticLaw.parameter(b).value; + eval( sprintf( 'modelStruct.p.%s = %d;', model.reaction(a).kineticLaw.parameter(b).id, c ) ); + c = c + 1; + end + catch + end + end + + try + for a = 1 : length( model.rule ) + parOmit{a} = model.rule(a).variable; + rulesStr{a} = avoidIntegerDivision( strrep( model.rule(a).formula, 'power', 'pow' ) ); + end + + change = 1; + while( change ) + change = 0; + for a = 1 : length( rulesStr ) + for b = a : length( rulesStr ) + if ~isempty( findstr( rulesStr{a}, parOmit{b} ) ) + disp( 'Switching rules due to interdependency' ); + tmp1 = rulesStr{a}; + tmp2 = parOmit{a}; + rulesStr{a} = rulesStr{b}; + rulesStr{b} = tmp1; + parOmit{a} = parOmit{b}; + parOmit{b} = tmp2; + change = 1; + end + end + end + end + catch + end + + % Added by ir. R. Oosterhof altered by ir J. Vanlier + %if ~isfield( 'modelStruct', 'p' ) + for a = 1 : length( model.parameter ) + scmp = 0; + for b = 1 : length( parOmit ) + scmp = scmp | ( strcmp( model.parameter(a).id, parOmit{b} ) ); + end + + if ~scmp + isconstant = 0; + for d = 1 : length( constantList ) + if findstr( model.parameter(a).id, constantList{d} ) + eval( sprintf( 'modelStruct.c.%s = %.15f;', model.parameter(a).id, model.parameter(a).value ) ); + isconstant = 1; + end + end + + if ~isconstant + % If this is in one of the lump lists then it is a lumped + % parameter + lumped = 0; + for q = 1 : length( lumpList ) + if sum( find( cell2mat( regexp(model.parameter(a).id, lumpList{q} ) ) == 1 ) ) + % First time this lumped group comes around + if lumpIDs(q) == 0 + lumpIDs(q) = c; + + p( c ) = model.parameter(a).value; + c = c + 1; + end + lumped = lumpIDs(q); + end + end + + if lumped == 0 + p( c ) = model.parameter(a).value; + eval( sprintf( 'modelStruct.p.%s = %d;', model.parameter(a).id, c ) ); + c = c + 1; + else + eval( sprintf( 'modelStruct.p.%s = %d;', model.parameter(a).id, lumped ) ); + end + end + end + end + + declarations{ 1 } = sprintf( 'function dx = mymodel2(t, x, p, u, modelStruct)\n' ); + c = 2; + names = fieldnames( modelStruct.s ); + for a = 1 : length( names ) + declarations{ c } = sprintf( '\t%s = x( modelStruct.s.%s );\n', names{ a }, names{ a } ); + c = c + 1; + end + + try + names = fieldnames( modelStruct.u ); + for a = 1 : length( names ) + declarations{ c } = sprintf( '\t%s = u( modelStruct.u.%s );\n', names{ a }, names{ a } ); + c = c + 1; + end + catch + end + + names = fieldnames( modelStruct.c ); + for a = 1 : length( names ) + declarations{ c } = sprintf( '\t%s = modelStruct.c.%s;\n', names{ a }, names{ a } ); + c = c + 1; + end + + names = fieldnames( modelStruct.p ); + for a = 1 : length( names ) + declarations{ c } = sprintf( '\t%s = p( modelStruct.p.%s );\n', names{ a }, names{ a } ); + c = c + 1; + end + + try + for a = 1 : length( rulesStr ) + rules{a} = sprintf( '\t%s = %s;\n', parOmit{a}, rulesStr{a} ); + end + catch + rules = {}; + end + + names = fieldnames( modelStruct.s ); + for a = 1 : nStates - 1 + odes{ a } = sprintf( '\tdx( modelStruct.s.%s ) = ', names{a} ); + end + + for a = 1 : length( model.reaction ) + for b = 1 : length( model.reaction(a).reactant ) + try + speciesID = eval( sprintf( 'modelStruct.s.%s', model.reaction(a).reactant(b).species ) ); + odes{ speciesID } = sprintf( '%s - %d * %s', odes{ speciesID }, model.reaction(a).reactant(b).stoichiometry, model.reaction(a).id ); + catch + end + end + for b = 1 : length( model.reaction(a).product ) + try + speciesID = eval( sprintf( 'modelStruct.s.%s', model.reaction(a).product(b).species ) ); + odes{ speciesID } = sprintf( '%s + %d * %s', odes{ speciesID }, model.reaction(a).product(b).stoichiometry, model.reaction(a).id ); + catch + end + end + end + + for a = 1 : nStates - 1 + % Added by ir. R. Oosterhof + if isspace( odes{ a }(end) ) + odes{ a } = sprintf( '%s0;\n', odes{ a } ); + else + % + odes{ a } = sprintf( '%s;\n', odes{ a } ); + end + end + + for a = 1 : length( model.reaction ) + reactions{a} = sprintf( '\t%s = %s;\n', model.reaction(a).id, model.reaction(a).kineticLaw.math ); + end + + for a = 1 : length( model.functionDefinition ) + [ junk, tok ] = strtok( model.functionDefinition.math, '(' ); + [ toka, rema ] = strtok( tok(2:end-1), '(' ); + commas = findstr( toka, ',' ); + inVars = toka( 1 : commas( end ) - 1 ); + func = [ toka( commas( end ) + 1 : end ) rema ]; + + funcNames{ a } = model.functionDefinition.id; + funcs{ a } = sprintf( 'function returnedValue = %s( %s )\n\n\treturnedValue = %s;', model.functionDefinition.id, inVars, func ); + end + + odefile = [ declarations{:} rules{:} sprintf( '\n\n\t%%%% Flux equations\n' ) reactions{:} sprintf( '\n\n\t%%%% State equations\n' ) odes{:} sprintf( '\n\n\tdx = dx(:);' ) ]; + + try + d = fopen( [ outDir '/' outFn ], 'w' ); + fprintf( d, odefile ); + fclose( d ); + + if exist( 'funcNames' ) ~= 0 + for a = 1 : length( funcNames ) + d = fopen( [ outDir '/' funcNames{ a } '.m' ], 'w' ); + fprintf( d, funcs{ a } ); + fclose( d ); + end + end + catch + disp( 'Error writing file: Correct path?' ); + end + + + + +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/SBML Tools/avoidIntegerDivision.m b/odemex/SBML Tools/avoidIntegerDivision.m new file mode 100644 index 0000000..4f6d3c7 --- /dev/null +++ b/odemex/SBML Tools/avoidIntegerDivision.m @@ -0,0 +1,24 @@ +function str = avoidIntegerDivision( string ) + + expressionTokens = '&()[]/*+-^@ %<>,;={}'; + + str = []; + + [ tok, remainder, z ] = strtok2( string, expressionTokens ); + + while ( ( ~isempty( remainder ) ) || ( ~isempty( tok ) ) ) + + no = str2num( tok ); + if ~isempty( no ) + if round( no ) == no + tok = sprintf( '%d.0', no ); + end + end + + str = [ str, z, tok ]; + + [ tok, remainder, z ] = strtok2( remainder, expressionTokens ); + + end + + str = [ str, z, tok ]; \ No newline at end of file diff --git a/odemex/SBML Tools/strtok2.m b/odemex/SBML Tools/strtok2.m new file mode 100644 index 0000000..44e6f95 --- /dev/null +++ b/odemex/SBML Tools/strtok2.m @@ -0,0 +1,13 @@ +% Function that grabs a token, but shows you which chars were removed + +function [ token, remain, tokensLost ] = strtok2( string, tokens ) + + l = length( string ); + [ token, remain ] = strtok( string, tokens ); + + missing = length( string ) - length( token ) - length( remain ); + + tokensLost = string( 1 : missing ); + + + diff --git a/odemex/SBML_Files/HIF_4.xml b/odemex/SBML_Files/HIF_4.xml new file mode 100644 index 0000000..c4d82f5 --- /dev/null +++ b/odemex/SBML_Files/HIF_4.xml @@ -0,0 +1,226 @@ + + + + + + + + + + + v + v + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + c + + influx + v + + + + + + + + + + + + + + + + + + + + + c + + + + + ARNT_complexation_fwd + HIF_1a + ARNT + + + + ARNT_complexation_bwd + HIF_1a_ARNT + + + + + + + + + + + + + + + + + + + + + + + c + + + + + HRE_complexation_fwd + HRE + HIF_1a_ARNT + + + + HRE_complexation_bwd + HIF_1a_ARNT_HRE + + + + + + + + + + + + + + + + + + + + + + + c + + + + + PHD_complexation_fwd + HIF_1a + PHD + + + + PHD_complexation_bwd + HIF_1a_PHD + + + + + + + + + + + + + + + + + + + + + + + + c + HIF_hydroxylation_fwd + HIF_1a_PHD + O2 + + + + + + + + + + + + + + + + c + HIF_degradation_fwd + HIF_1a_OH + + + + + + + + + + diff --git a/odemex/SBML_Files/model.xml b/odemex/SBML_Files/model.xml new file mode 100644 index 0000000..f9592e5 --- /dev/null +++ b/odemex/SBML_Files/model.xml @@ -0,0 +1,806 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + krbEGF + EGF + freeEGFReceptor + + + + + + + + + + + + + + + + + kruEGF + boundEGFReceptor + + + + + + + + + + + + + + + + + krbNGF + NGF + freeNGFReceptor + + + + + + + + + + + + + + + + + kruNGF + boundNGFReceptor + + + + + + + + + + + + + + + + + + + + + kEGF + boundEGFReceptor + SosInactive + + + + SosInactive + KmEGF + + + + + + + + + + + + + + + + + + + + + + kNGF + boundNGFReceptor + SosInactive + + + + SosInactive + KmNGF + + + + + + + + + + + + + + + + + + + + + + kdSos + P90RskActive + SosActive + + + + SosActive + KmdSos + + + + + + + + + + + + + + + + + + + + + + kSos + SosActive + RasInactive + + + + RasInactive + KmSos + + + + + + + + + + + + + + + + + + + + + + kRasGap + RasGapActive + RasActive + + + + RasActive + KmRasGap + + + + + + + + + + + + + + + + + + + + + + kRasToRaf1 + RasActive + Raf1Inactive + + + + Raf1Inactive + KmRasToRaf1 + + + + + + + + + + + + + + + + + + + + + + kpRaf1 + Raf1Active + MekInactive + + + + MekInactive + KmpRaf1 + + + + + + + + + + + + + + + + + + + + + + kpBRaf + BRafActive + MekInactive + + + + MekInactive + KmpBRaf + + + + + + + + + + + + + + + + + + + + + + kpMekCytoplasmic + MekActive + ErkInactive + + + + ErkInactive + KmpMekCytoplasmic + + + + + + + + + + + + + + + + + + + + + + kdMek + PP2AActive + MekActive + + + + MekActive + KmdMek + + + + + + + + + + + + + + + + + + + + + + kdErk + PP2AActive + ErkActive + + + + ErkActive + KmdErk + + + + + + + + + + + + + + + + + + + + + + kdRaf1 + Raf1PPtase + Raf1Active + + + + Raf1Active + KmdRaf1 + + + + + + + + + + + + + + + + + + + + + + kpP90Rsk + ErkActive + P90RskInactive + + + + P90RskInactive + KmpP90Rsk + + + + + + + + + + + + + + + + + + + + + + kPI3K + boundEGFReceptor + PI3KInactive + + + + PI3KInactive + KmPI3K + + + + + + + + + + + + + + + + + + + + + + kPI3KRas + RasActive + PI3KInactive + + + + PI3KInactive + KmPI3KRas + + + + + + + + + + + + + + + + + + + + + + kAkt + PI3KActive + AktInactive + + + + AktInactive + KmAkt + + + + + + + + + + + + + + + + + + + + + + kdRaf1ByAkt + AktActive + Raf1Active + + + + Raf1Active + KmRaf1ByAkt + + + + + + + + + + + + + + + + + + + + + + kC3GNGF + boundNGFReceptor + C3GInactive + + + + C3GInactive + KmC3GNGF + + + + + + + + + + + + + + + + + + + + + + kC3G + C3GActive + Rap1Inactive + + + + Rap1Inactive + KmC3G + + + + + + + + + + + + + + + + + + + + + + kRapGap + RapGapActive + Rap1Active + + + + Rap1Active + KmRapGap + + + + + + + + + + + + + + + + + + + + + + kRap1ToBRaf + Rap1Active + BRafInactive + + + + BRafInactive + KmRap1ToBRaf + + + + + + + + + + + + + + + + + + + + + + kdBRaf + Raf1PPtase + BRafActive + + + + BRafActive + KmdBRaf + + + + + + + + diff --git a/odemex/addPaths.m b/odemex/addPaths.m new file mode 100644 index 0000000..dc3b18c --- /dev/null +++ b/odemex/addPaths.m @@ -0,0 +1,52 @@ +% List of functions within the toolboxes +% +% Compiling ODE's +% convertToC( mStruct, odeInput, dependencies, options ) +% compileC( outputName ) +% +% Generic Functions +% nJac( func, pars, dx, subVec ) +% +% Monte Carlo Markov Chains +% [ chain, energy, nAcc, nRej ] = mcmcCoV( funVec, parameters, methodOpts, numSteps, (lb), (ub), (Aineq), (Bineq), (burnIn) ) +% [ CoV, scale ] = tuneChain( fun, initPars, CoV, iter, (lb), (ub), (A), (B), (burnIn), (minSteps) ) +% +% Profile Likelihoods +% [ plOut, sse ] = PL( func, initPar, param, outer, thresh, loga, opts, minStep, maxStep, minChange, maxChange ) + +q = dir; +cdir = [ pwd '/' ]; +for a = 1 : length( q ) + if q(a).isdir == 1 + if ( q(a).isdir ~= '.' ) || ( q(a).isdir ~= '..' ) + addpath( [ cdir, q(a).name ] ); + end + end +end +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/observerFunctions/ccode/jac.c b/odemex/observerFunctions/ccode/jac.c new file mode 100644 index 0000000..5822cb9 --- /dev/null +++ b/odemex/observerFunctions/ccode/jac.c @@ -0,0 +1,289 @@ +#include "objfn.h" + + +void jacobian(double *jac, double *s, double *p, double *d, double *u, double *S ) { + jac[(0)*(N_OBS)+(0)] = s[(1-1)*N_STATES+(1-1)]*u[1-1]*(p[N_PARS+1-1]+1.0)+S[(1-1)*SENSDIM+(1-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(0)*(N_OBS)+(1)] = s[(2-1)*N_STATES+(1-1)]*u[1-1]*(p[N_PARS+1-1]+1.0)+S[(2-1)*SENSDIM+(1-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(0)*(N_OBS)+(2)] = s[(3-1)*N_STATES+(1-1)]*u[1-1]*(p[N_PARS+1-1]+1.0)+S[(3-1)*SENSDIM+(1-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(0)*(N_OBS)+(3)] = s[(4-1)*N_STATES+(1-1)]*u[1-1]*(p[N_PARS+1-1]+1.0)+S[(4-1)*SENSDIM+(1-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(0)*(N_OBS)+(4)] = s[(5-1)*N_STATES+(1-1)]*u[1-1]*(p[N_PARS+1-1]+1.0)+S[(5-1)*SENSDIM+(1-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(0)*(N_OBS)+(5)] = s[(6-1)*N_STATES+(1-1)]*u[1-1]*(p[N_PARS+1-1]+1.0)+S[(6-1)*SENSDIM+(1-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(0)*(N_OBS)+(6)] = s[(7-1)*N_STATES+(1-1)]*u[1-1]*(p[N_PARS+1-1]+1.0)+S[(7-1)*SENSDIM+(1-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(0)*(N_OBS)+(7)] = s[(9-1)*N_STATES+(1-1)]*u[1-1]*(p[N_PARS+1-1]+1.0)+S[(9-1)*SENSDIM+(1-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(0)*(N_OBS)+(8)] = s[(11-1)*N_STATES+(1-1)]*u[1-1]*(p[N_PARS+1-1]+1.0)+S[(11-1)*SENSDIM+(1-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(0)*(N_OBS)+(9)] = s[(12-1)*N_STATES+(1-1)]*u[1-1]*(p[N_PARS+1-1]+1.0)+S[(12-1)*SENSDIM+(1-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(0)*(N_OBS)+(10)] = s[(13-1)*N_STATES+(1-1)]*u[1-1]*(p[N_PARS+1-1]+1.0)+S[(13-1)*SENSDIM+(1-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(0)*(N_OBS)+(11)] = (S[(1-1)*SENSDIM+(1-1)]*p[2-1])/(p[N_PARS+2-1]+1.0)+(S[(1-1)*SENSDIM+(2-1)]*p[2-1])/(p[N_PARS+2-1]+1.0); + jac[(0)*(N_OBS)+(12)] = (S[(13-1)*SENSDIM+(1-1)]*p[2-1])/(p[N_PARS+2-1]+1.0)+(S[(13-1)*SENSDIM+(2-1)]*p[2-1])/(p[N_PARS+2-1]+1.0); + jac[(0)*(N_OBS)+(13)] = (S[(23-1)*SENSDIM+(1-1)]*p[2-1])/(p[N_PARS+2-1]+1.0)+(S[(23-1)*SENSDIM+(2-1)]*p[2-1])/(p[N_PARS+2-1]+1.0); + jac[(0)*(N_OBS)+(14)] = (S[(33-1)*SENSDIM+(1-1)]*p[2-1])/(p[N_PARS+2-1]+1.0)+(S[(33-1)*SENSDIM+(2-1)]*p[2-1])/(p[N_PARS+2-1]+1.0); + jac[(0)*(N_OBS)+(15)] = (S[(43-1)*SENSDIM+(1-1)]*p[2-1])/(p[N_PARS+2-1]+1.0)+(S[(43-1)*SENSDIM+(2-1)]*p[2-1])/(p[N_PARS+2-1]+1.0); + jac[(0)*(N_OBS)+(16)] = (S[(1-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(1-1)*N_STATES+(1-1)])-(S[(1-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(1-1)*N_STATES+(1-1)]*s[(1-1)*N_STATES+(1-1)])*s[(1-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(17)] = (S[(2-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(2-1)*N_STATES+(1-1)])-(S[(2-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(2-1)*N_STATES+(1-1)]*s[(2-1)*N_STATES+(1-1)])*s[(2-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(18)] = (S[(3-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(3-1)*N_STATES+(1-1)])-(S[(3-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(3-1)*N_STATES+(1-1)]*s[(3-1)*N_STATES+(1-1)])*s[(3-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(19)] = (S[(4-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(4-1)*N_STATES+(1-1)])-(S[(4-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(4-1)*N_STATES+(1-1)]*s[(4-1)*N_STATES+(1-1)])*s[(4-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(20)] = (S[(5-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(5-1)*N_STATES+(1-1)])-(S[(5-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(5-1)*N_STATES+(1-1)]*s[(5-1)*N_STATES+(1-1)])*s[(5-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(21)] = (S[(6-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(6-1)*N_STATES+(1-1)])-(S[(6-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(6-1)*N_STATES+(1-1)]*s[(6-1)*N_STATES+(1-1)])*s[(6-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(22)] = (S[(8-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(8-1)*N_STATES+(1-1)])-(S[(8-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(8-1)*N_STATES+(1-1)]*s[(8-1)*N_STATES+(1-1)])*s[(8-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(23)] = (S[(10-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(10-1)*N_STATES+(1-1)])-(S[(10-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(10-1)*N_STATES+(1-1)]*s[(10-1)*N_STATES+(1-1)])*s[(10-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(24)] = (S[(11-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(11-1)*N_STATES+(1-1)])-(S[(11-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(11-1)*N_STATES+(1-1)]*s[(11-1)*N_STATES+(1-1)])*s[(11-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(25)] = (S[(12-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(12-1)*N_STATES+(1-1)])-(S[(12-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(12-1)*N_STATES+(1-1)]*s[(12-1)*N_STATES+(1-1)])*s[(12-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(26)] = (S[(13-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(13-1)*N_STATES+(1-1)])-(S[(13-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(13-1)*N_STATES+(1-1)]*s[(13-1)*N_STATES+(1-1)])*s[(13-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(27)] = (S[(14-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(14-1)*N_STATES+(1-1)])-(S[(14-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(14-1)*N_STATES+(1-1)]*s[(14-1)*N_STATES+(1-1)])*s[(14-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(28)] = (S[(15-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(15-1)*N_STATES+(1-1)])-(S[(15-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(15-1)*N_STATES+(1-1)]*s[(15-1)*N_STATES+(1-1)])*s[(15-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(29)] = (S[(16-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(16-1)*N_STATES+(1-1)])-(S[(16-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(16-1)*N_STATES+(1-1)]*s[(16-1)*N_STATES+(1-1)])*s[(16-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(30)] = (S[(17-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(17-1)*N_STATES+(1-1)])-(S[(17-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(17-1)*N_STATES+(1-1)]*s[(17-1)*N_STATES+(1-1)])*s[(17-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(31)] = (S[(18-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(18-1)*N_STATES+(1-1)])-(S[(18-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(18-1)*N_STATES+(1-1)]*s[(18-1)*N_STATES+(1-1)])*s[(18-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(32)] = (S[(19-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(19-1)*N_STATES+(1-1)])-(S[(19-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(19-1)*N_STATES+(1-1)]*s[(19-1)*N_STATES+(1-1)])*s[(19-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(33)] = (S[(20-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(20-1)*N_STATES+(1-1)])-(S[(20-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(20-1)*N_STATES+(1-1)]*s[(20-1)*N_STATES+(1-1)])*s[(20-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(34)] = (S[(21-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(21-1)*N_STATES+(1-1)])-(S[(21-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(21-1)*N_STATES+(1-1)]*s[(21-1)*N_STATES+(1-1)])*s[(21-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(35)] = (S[(22-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(22-1)*N_STATES+(1-1)])-(S[(22-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(22-1)*N_STATES+(1-1)]*s[(22-1)*N_STATES+(1-1)])*s[(22-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(36)] = (S[(23-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(23-1)*N_STATES+(1-1)])-(S[(23-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(23-1)*N_STATES+(1-1)]*s[(23-1)*N_STATES+(1-1)])*s[(23-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(37)] = (S[(24-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(24-1)*N_STATES+(1-1)])-(S[(24-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(24-1)*N_STATES+(1-1)]*s[(24-1)*N_STATES+(1-1)])*s[(24-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(38)] = (S[(25-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(25-1)*N_STATES+(1-1)])-(S[(25-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(25-1)*N_STATES+(1-1)]*s[(25-1)*N_STATES+(1-1)])*s[(25-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(39)] = (S[(26-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(26-1)*N_STATES+(1-1)])-(S[(26-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(26-1)*N_STATES+(1-1)]*s[(26-1)*N_STATES+(1-1)])*s[(26-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(40)] = (S[(27-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(27-1)*N_STATES+(1-1)])-(S[(27-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(27-1)*N_STATES+(1-1)]*s[(27-1)*N_STATES+(1-1)])*s[(27-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(41)] = (S[(28-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(28-1)*N_STATES+(1-1)])-(S[(28-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(28-1)*N_STATES+(1-1)]*s[(28-1)*N_STATES+(1-1)])*s[(28-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(42)] = (S[(29-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(29-1)*N_STATES+(1-1)])-(S[(29-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(29-1)*N_STATES+(1-1)]*s[(29-1)*N_STATES+(1-1)])*s[(29-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(43)] = (S[(30-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(30-1)*N_STATES+(1-1)])-(S[(30-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(30-1)*N_STATES+(1-1)]*s[(30-1)*N_STATES+(1-1)])*s[(30-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(44)] = (S[(31-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(31-1)*N_STATES+(1-1)])-(S[(31-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(31-1)*N_STATES+(1-1)]*s[(31-1)*N_STATES+(1-1)])*s[(31-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(45)] = (S[(32-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(32-1)*N_STATES+(1-1)])-(S[(32-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(32-1)*N_STATES+(1-1)]*s[(32-1)*N_STATES+(1-1)])*s[(32-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(46)] = (S[(33-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(33-1)*N_STATES+(1-1)])-(S[(33-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(33-1)*N_STATES+(1-1)]*s[(33-1)*N_STATES+(1-1)])*s[(33-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(47)] = (S[(34-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(34-1)*N_STATES+(1-1)])-(S[(34-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(34-1)*N_STATES+(1-1)]*s[(34-1)*N_STATES+(1-1)])*s[(34-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(48)] = (S[(35-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(35-1)*N_STATES+(1-1)])-(S[(35-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(35-1)*N_STATES+(1-1)]*s[(35-1)*N_STATES+(1-1)])*s[(35-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(49)] = (S[(36-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(36-1)*N_STATES+(1-1)])-(S[(36-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(36-1)*N_STATES+(1-1)]*s[(36-1)*N_STATES+(1-1)])*s[(36-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(50)] = (S[(37-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(37-1)*N_STATES+(1-1)])-(S[(37-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(37-1)*N_STATES+(1-1)]*s[(37-1)*N_STATES+(1-1)])*s[(37-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(51)] = (S[(38-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(38-1)*N_STATES+(1-1)])-(S[(38-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(38-1)*N_STATES+(1-1)]*s[(38-1)*N_STATES+(1-1)])*s[(38-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(52)] = (S[(39-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(39-1)*N_STATES+(1-1)])-(S[(39-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(39-1)*N_STATES+(1-1)]*s[(39-1)*N_STATES+(1-1)])*s[(39-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(53)] = (S[(40-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(40-1)*N_STATES+(1-1)])-(S[(40-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(40-1)*N_STATES+(1-1)]*s[(40-1)*N_STATES+(1-1)])*s[(40-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(54)] = (S[(41-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(41-1)*N_STATES+(1-1)])-(S[(41-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(41-1)*N_STATES+(1-1)]*s[(41-1)*N_STATES+(1-1)])*s[(41-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(55)] = (S[(42-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(42-1)*N_STATES+(1-1)])-(S[(42-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(42-1)*N_STATES+(1-1)]*s[(42-1)*N_STATES+(1-1)])*s[(42-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(56)] = (S[(43-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(43-1)*N_STATES+(1-1)])-(S[(43-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(43-1)*N_STATES+(1-1)]*s[(43-1)*N_STATES+(1-1)])*s[(43-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(57)] = (S[(44-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(44-1)*N_STATES+(1-1)])-(S[(44-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(44-1)*N_STATES+(1-1)]*s[(44-1)*N_STATES+(1-1)])*s[(44-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(58)] = (S[(45-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(45-1)*N_STATES+(1-1)])-(S[(45-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(45-1)*N_STATES+(1-1)]*s[(45-1)*N_STATES+(1-1)])*s[(45-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(59)] = (S[(46-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(46-1)*N_STATES+(1-1)])-(S[(46-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(46-1)*N_STATES+(1-1)]*s[(46-1)*N_STATES+(1-1)])*s[(46-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(60)] = (S[(47-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(47-1)*N_STATES+(1-1)])-(S[(47-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(47-1)*N_STATES+(1-1)]*s[(47-1)*N_STATES+(1-1)])*s[(47-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(61)] = (S[(48-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(48-1)*N_STATES+(1-1)])-(S[(48-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(48-1)*N_STATES+(1-1)]*s[(48-1)*N_STATES+(1-1)])*s[(48-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(62)] = (S[(49-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(49-1)*N_STATES+(1-1)])-(S[(49-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(49-1)*N_STATES+(1-1)]*s[(49-1)*N_STATES+(1-1)])*s[(49-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(63)] = (S[(50-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(50-1)*N_STATES+(1-1)])-(S[(50-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(50-1)*N_STATES+(1-1)]*s[(50-1)*N_STATES+(1-1)])*s[(50-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(64)] = (S[(51-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(51-1)*N_STATES+(1-1)])-(S[(51-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(51-1)*N_STATES+(1-1)]*s[(51-1)*N_STATES+(1-1)])*s[(51-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(65)] = (S[(52-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(52-1)*N_STATES+(1-1)])-(S[(52-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(52-1)*N_STATES+(1-1)]*s[(52-1)*N_STATES+(1-1)])*s[(52-1)*N_STATES+(2-1)])/p[2-1]; + jac[(0)*(N_OBS)+(66)] = (S[(53-1)*SENSDIM+(2-1)]*p[3-1])/(p[2-1]*s[(53-1)*N_STATES+(1-1)])-(S[(53-1)*SENSDIM+(1-1)]*p[3-1]*1.0/(s[(53-1)*N_STATES+(1-1)]*s[(53-1)*N_STATES+(1-1)])*s[(53-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(0)] = S[(1-1)*SENSDIM+(3-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(1)*(N_OBS)+(1)] = S[(2-1)*SENSDIM+(3-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(1)*(N_OBS)+(2)] = S[(3-1)*SENSDIM+(3-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(1)*(N_OBS)+(3)] = S[(4-1)*SENSDIM+(3-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(1)*(N_OBS)+(4)] = S[(5-1)*SENSDIM+(3-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(1)*(N_OBS)+(5)] = S[(6-1)*SENSDIM+(3-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(1)*(N_OBS)+(6)] = S[(7-1)*SENSDIM+(3-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(1)*(N_OBS)+(7)] = S[(9-1)*SENSDIM+(3-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(1)*(N_OBS)+(8)] = S[(11-1)*SENSDIM+(3-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(1)*(N_OBS)+(9)] = S[(12-1)*SENSDIM+(3-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(1)*(N_OBS)+(10)] = S[(13-1)*SENSDIM+(3-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(1)*(N_OBS)+(11)] = (-d[1-1]+s[(1-1)*N_STATES+(1-1)]+s[(1-1)*N_STATES+(2-1)])/(p[N_PARS+2-1]+1.0)+(S[(1-1)*SENSDIM+(3-1)]*p[2-1])/(p[N_PARS+2-1]+1.0)+(S[(1-1)*SENSDIM+(4-1)]*p[2-1])/(p[N_PARS+2-1]+1.0); + jac[(1)*(N_OBS)+(12)] = (-d[2-1]+s[(13-1)*N_STATES+(1-1)]+s[(13-1)*N_STATES+(2-1)])/(p[N_PARS+2-1]+1.0)+(S[(13-1)*SENSDIM+(3-1)]*p[2-1])/(p[N_PARS+2-1]+1.0)+(S[(13-1)*SENSDIM+(4-1)]*p[2-1])/(p[N_PARS+2-1]+1.0); + jac[(1)*(N_OBS)+(13)] = (-d[3-1]+s[(23-1)*N_STATES+(1-1)]+s[(23-1)*N_STATES+(2-1)])/(p[N_PARS+2-1]+1.0)+(S[(23-1)*SENSDIM+(3-1)]*p[2-1])/(p[N_PARS+2-1]+1.0)+(S[(23-1)*SENSDIM+(4-1)]*p[2-1])/(p[N_PARS+2-1]+1.0); + jac[(1)*(N_OBS)+(14)] = (-d[4-1]+s[(33-1)*N_STATES+(1-1)]+s[(33-1)*N_STATES+(2-1)])/(p[N_PARS+2-1]+1.0)+(S[(33-1)*SENSDIM+(3-1)]*p[2-1])/(p[N_PARS+2-1]+1.0)+(S[(33-1)*SENSDIM+(4-1)]*p[2-1])/(p[N_PARS+2-1]+1.0); + jac[(1)*(N_OBS)+(15)] = (-d[5-1]+s[(43-1)*N_STATES+(1-1)]+s[(43-1)*N_STATES+(2-1)])/(p[N_PARS+2-1]+1.0)+(S[(43-1)*SENSDIM+(3-1)]*p[2-1])/(p[N_PARS+2-1]+1.0)+(S[(43-1)*SENSDIM+(4-1)]*p[2-1])/(p[N_PARS+2-1]+1.0); + jac[(1)*(N_OBS)+(16)] = (S[(1-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(1-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(1-1)*N_STATES+(2-1)])/s[(1-1)*N_STATES+(1-1)]-(S[(1-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(1-1)*N_STATES+(1-1)]*s[(1-1)*N_STATES+(1-1)])*s[(1-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(17)] = (S[(2-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(2-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(2-1)*N_STATES+(2-1)])/s[(2-1)*N_STATES+(1-1)]-(S[(2-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(2-1)*N_STATES+(1-1)]*s[(2-1)*N_STATES+(1-1)])*s[(2-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(18)] = (S[(3-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(3-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(3-1)*N_STATES+(2-1)])/s[(3-1)*N_STATES+(1-1)]-(S[(3-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(3-1)*N_STATES+(1-1)]*s[(3-1)*N_STATES+(1-1)])*s[(3-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(19)] = (S[(4-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(4-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(4-1)*N_STATES+(2-1)])/s[(4-1)*N_STATES+(1-1)]-(S[(4-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(4-1)*N_STATES+(1-1)]*s[(4-1)*N_STATES+(1-1)])*s[(4-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(20)] = (S[(5-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(5-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(5-1)*N_STATES+(2-1)])/s[(5-1)*N_STATES+(1-1)]-(S[(5-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(5-1)*N_STATES+(1-1)]*s[(5-1)*N_STATES+(1-1)])*s[(5-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(21)] = (S[(6-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(6-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(6-1)*N_STATES+(2-1)])/s[(6-1)*N_STATES+(1-1)]-(S[(6-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(6-1)*N_STATES+(1-1)]*s[(6-1)*N_STATES+(1-1)])*s[(6-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(22)] = (S[(8-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(8-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(8-1)*N_STATES+(2-1)])/s[(8-1)*N_STATES+(1-1)]-(S[(8-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(8-1)*N_STATES+(1-1)]*s[(8-1)*N_STATES+(1-1)])*s[(8-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(23)] = (S[(10-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(10-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(10-1)*N_STATES+(2-1)])/s[(10-1)*N_STATES+(1-1)]-(S[(10-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(10-1)*N_STATES+(1-1)]*s[(10-1)*N_STATES+(1-1)])*s[(10-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(24)] = (S[(11-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(11-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(11-1)*N_STATES+(2-1)])/s[(11-1)*N_STATES+(1-1)]-(S[(11-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(11-1)*N_STATES+(1-1)]*s[(11-1)*N_STATES+(1-1)])*s[(11-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(25)] = (S[(12-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(12-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(12-1)*N_STATES+(2-1)])/s[(12-1)*N_STATES+(1-1)]-(S[(12-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(12-1)*N_STATES+(1-1)]*s[(12-1)*N_STATES+(1-1)])*s[(12-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(26)] = (S[(13-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(13-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(13-1)*N_STATES+(2-1)])/s[(13-1)*N_STATES+(1-1)]-(S[(13-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(13-1)*N_STATES+(1-1)]*s[(13-1)*N_STATES+(1-1)])*s[(13-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(27)] = (S[(14-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(14-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(14-1)*N_STATES+(2-1)])/s[(14-1)*N_STATES+(1-1)]-(S[(14-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(14-1)*N_STATES+(1-1)]*s[(14-1)*N_STATES+(1-1)])*s[(14-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(28)] = (S[(15-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(15-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(15-1)*N_STATES+(2-1)])/s[(15-1)*N_STATES+(1-1)]-(S[(15-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(15-1)*N_STATES+(1-1)]*s[(15-1)*N_STATES+(1-1)])*s[(15-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(29)] = (S[(16-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(16-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(16-1)*N_STATES+(2-1)])/s[(16-1)*N_STATES+(1-1)]-(S[(16-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(16-1)*N_STATES+(1-1)]*s[(16-1)*N_STATES+(1-1)])*s[(16-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(30)] = (S[(17-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(17-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(17-1)*N_STATES+(2-1)])/s[(17-1)*N_STATES+(1-1)]-(S[(17-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(17-1)*N_STATES+(1-1)]*s[(17-1)*N_STATES+(1-1)])*s[(17-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(31)] = (S[(18-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(18-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(18-1)*N_STATES+(2-1)])/s[(18-1)*N_STATES+(1-1)]-(S[(18-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(18-1)*N_STATES+(1-1)]*s[(18-1)*N_STATES+(1-1)])*s[(18-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(32)] = (S[(19-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(19-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(19-1)*N_STATES+(2-1)])/s[(19-1)*N_STATES+(1-1)]-(S[(19-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(19-1)*N_STATES+(1-1)]*s[(19-1)*N_STATES+(1-1)])*s[(19-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(33)] = (S[(20-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(20-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(20-1)*N_STATES+(2-1)])/s[(20-1)*N_STATES+(1-1)]-(S[(20-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(20-1)*N_STATES+(1-1)]*s[(20-1)*N_STATES+(1-1)])*s[(20-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(34)] = (S[(21-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(21-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(21-1)*N_STATES+(2-1)])/s[(21-1)*N_STATES+(1-1)]-(S[(21-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(21-1)*N_STATES+(1-1)]*s[(21-1)*N_STATES+(1-1)])*s[(21-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(35)] = (S[(22-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(22-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(22-1)*N_STATES+(2-1)])/s[(22-1)*N_STATES+(1-1)]-(S[(22-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(22-1)*N_STATES+(1-1)]*s[(22-1)*N_STATES+(1-1)])*s[(22-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(36)] = (S[(23-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(23-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(23-1)*N_STATES+(2-1)])/s[(23-1)*N_STATES+(1-1)]-(S[(23-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(23-1)*N_STATES+(1-1)]*s[(23-1)*N_STATES+(1-1)])*s[(23-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(37)] = (S[(24-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(24-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(24-1)*N_STATES+(2-1)])/s[(24-1)*N_STATES+(1-1)]-(S[(24-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(24-1)*N_STATES+(1-1)]*s[(24-1)*N_STATES+(1-1)])*s[(24-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(38)] = (S[(25-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(25-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(25-1)*N_STATES+(2-1)])/s[(25-1)*N_STATES+(1-1)]-(S[(25-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(25-1)*N_STATES+(1-1)]*s[(25-1)*N_STATES+(1-1)])*s[(25-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(39)] = (S[(26-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(26-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(26-1)*N_STATES+(2-1)])/s[(26-1)*N_STATES+(1-1)]-(S[(26-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(26-1)*N_STATES+(1-1)]*s[(26-1)*N_STATES+(1-1)])*s[(26-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(40)] = (S[(27-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(27-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(27-1)*N_STATES+(2-1)])/s[(27-1)*N_STATES+(1-1)]-(S[(27-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(27-1)*N_STATES+(1-1)]*s[(27-1)*N_STATES+(1-1)])*s[(27-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(41)] = (S[(28-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(28-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(28-1)*N_STATES+(2-1)])/s[(28-1)*N_STATES+(1-1)]-(S[(28-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(28-1)*N_STATES+(1-1)]*s[(28-1)*N_STATES+(1-1)])*s[(28-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(42)] = (S[(29-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(29-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(29-1)*N_STATES+(2-1)])/s[(29-1)*N_STATES+(1-1)]-(S[(29-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(29-1)*N_STATES+(1-1)]*s[(29-1)*N_STATES+(1-1)])*s[(29-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(43)] = (S[(30-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(30-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(30-1)*N_STATES+(2-1)])/s[(30-1)*N_STATES+(1-1)]-(S[(30-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(30-1)*N_STATES+(1-1)]*s[(30-1)*N_STATES+(1-1)])*s[(30-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(44)] = (S[(31-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(31-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(31-1)*N_STATES+(2-1)])/s[(31-1)*N_STATES+(1-1)]-(S[(31-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(31-1)*N_STATES+(1-1)]*s[(31-1)*N_STATES+(1-1)])*s[(31-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(45)] = (S[(32-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(32-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(32-1)*N_STATES+(2-1)])/s[(32-1)*N_STATES+(1-1)]-(S[(32-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(32-1)*N_STATES+(1-1)]*s[(32-1)*N_STATES+(1-1)])*s[(32-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(46)] = (S[(33-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(33-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(33-1)*N_STATES+(2-1)])/s[(33-1)*N_STATES+(1-1)]-(S[(33-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(33-1)*N_STATES+(1-1)]*s[(33-1)*N_STATES+(1-1)])*s[(33-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(47)] = (S[(34-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(34-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(34-1)*N_STATES+(2-1)])/s[(34-1)*N_STATES+(1-1)]-(S[(34-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(34-1)*N_STATES+(1-1)]*s[(34-1)*N_STATES+(1-1)])*s[(34-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(48)] = (S[(35-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(35-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(35-1)*N_STATES+(2-1)])/s[(35-1)*N_STATES+(1-1)]-(S[(35-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(35-1)*N_STATES+(1-1)]*s[(35-1)*N_STATES+(1-1)])*s[(35-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(49)] = (S[(36-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(36-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(36-1)*N_STATES+(2-1)])/s[(36-1)*N_STATES+(1-1)]-(S[(36-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(36-1)*N_STATES+(1-1)]*s[(36-1)*N_STATES+(1-1)])*s[(36-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(50)] = (S[(37-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(37-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(37-1)*N_STATES+(2-1)])/s[(37-1)*N_STATES+(1-1)]-(S[(37-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(37-1)*N_STATES+(1-1)]*s[(37-1)*N_STATES+(1-1)])*s[(37-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(51)] = (S[(38-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(38-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(38-1)*N_STATES+(2-1)])/s[(38-1)*N_STATES+(1-1)]-(S[(38-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(38-1)*N_STATES+(1-1)]*s[(38-1)*N_STATES+(1-1)])*s[(38-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(52)] = (S[(39-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(39-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(39-1)*N_STATES+(2-1)])/s[(39-1)*N_STATES+(1-1)]-(S[(39-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(39-1)*N_STATES+(1-1)]*s[(39-1)*N_STATES+(1-1)])*s[(39-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(53)] = (S[(40-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(40-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(40-1)*N_STATES+(2-1)])/s[(40-1)*N_STATES+(1-1)]-(S[(40-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(40-1)*N_STATES+(1-1)]*s[(40-1)*N_STATES+(1-1)])*s[(40-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(54)] = (S[(41-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(41-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(41-1)*N_STATES+(2-1)])/s[(41-1)*N_STATES+(1-1)]-(S[(41-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(41-1)*N_STATES+(1-1)]*s[(41-1)*N_STATES+(1-1)])*s[(41-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(55)] = (S[(42-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(42-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(42-1)*N_STATES+(2-1)])/s[(42-1)*N_STATES+(1-1)]-(S[(42-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(42-1)*N_STATES+(1-1)]*s[(42-1)*N_STATES+(1-1)])*s[(42-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(56)] = (S[(43-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(43-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(43-1)*N_STATES+(2-1)])/s[(43-1)*N_STATES+(1-1)]-(S[(43-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(43-1)*N_STATES+(1-1)]*s[(43-1)*N_STATES+(1-1)])*s[(43-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(57)] = (S[(44-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(44-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(44-1)*N_STATES+(2-1)])/s[(44-1)*N_STATES+(1-1)]-(S[(44-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(44-1)*N_STATES+(1-1)]*s[(44-1)*N_STATES+(1-1)])*s[(44-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(58)] = (S[(45-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(45-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(45-1)*N_STATES+(2-1)])/s[(45-1)*N_STATES+(1-1)]-(S[(45-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(45-1)*N_STATES+(1-1)]*s[(45-1)*N_STATES+(1-1)])*s[(45-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(59)] = (S[(46-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(46-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(46-1)*N_STATES+(2-1)])/s[(46-1)*N_STATES+(1-1)]-(S[(46-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(46-1)*N_STATES+(1-1)]*s[(46-1)*N_STATES+(1-1)])*s[(46-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(60)] = (S[(47-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(47-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(47-1)*N_STATES+(2-1)])/s[(47-1)*N_STATES+(1-1)]-(S[(47-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(47-1)*N_STATES+(1-1)]*s[(47-1)*N_STATES+(1-1)])*s[(47-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(61)] = (S[(48-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(48-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(48-1)*N_STATES+(2-1)])/s[(48-1)*N_STATES+(1-1)]-(S[(48-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(48-1)*N_STATES+(1-1)]*s[(48-1)*N_STATES+(1-1)])*s[(48-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(62)] = (S[(49-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(49-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(49-1)*N_STATES+(2-1)])/s[(49-1)*N_STATES+(1-1)]-(S[(49-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(49-1)*N_STATES+(1-1)]*s[(49-1)*N_STATES+(1-1)])*s[(49-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(63)] = (S[(50-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(50-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(50-1)*N_STATES+(2-1)])/s[(50-1)*N_STATES+(1-1)]-(S[(50-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(50-1)*N_STATES+(1-1)]*s[(50-1)*N_STATES+(1-1)])*s[(50-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(64)] = (S[(51-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(51-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(51-1)*N_STATES+(2-1)])/s[(51-1)*N_STATES+(1-1)]-(S[(51-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(51-1)*N_STATES+(1-1)]*s[(51-1)*N_STATES+(1-1)])*s[(51-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(65)] = (S[(52-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(52-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(52-1)*N_STATES+(2-1)])/s[(52-1)*N_STATES+(1-1)]-(S[(52-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(52-1)*N_STATES+(1-1)]*s[(52-1)*N_STATES+(1-1)])*s[(52-1)*N_STATES+(2-1)])/p[2-1]; + jac[(1)*(N_OBS)+(66)] = (S[(53-1)*SENSDIM+(4-1)]*p[3-1])/(p[2-1]*s[(53-1)*N_STATES+(1-1)])-(1.0/(p[2-1]*p[2-1])*p[3-1]*s[(53-1)*N_STATES+(2-1)])/s[(53-1)*N_STATES+(1-1)]-(S[(53-1)*SENSDIM+(3-1)]*p[3-1]*1.0/(s[(53-1)*N_STATES+(1-1)]*s[(53-1)*N_STATES+(1-1)])*s[(53-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(0)] = S[(1-1)*SENSDIM+(5-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(2)*(N_OBS)+(1)] = S[(2-1)*SENSDIM+(5-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(2)*(N_OBS)+(2)] = S[(3-1)*SENSDIM+(5-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(2)*(N_OBS)+(3)] = S[(4-1)*SENSDIM+(5-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(2)*(N_OBS)+(4)] = S[(5-1)*SENSDIM+(5-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(2)*(N_OBS)+(5)] = S[(6-1)*SENSDIM+(5-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(2)*(N_OBS)+(6)] = S[(7-1)*SENSDIM+(5-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(2)*(N_OBS)+(7)] = S[(9-1)*SENSDIM+(5-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(2)*(N_OBS)+(8)] = S[(11-1)*SENSDIM+(5-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(2)*(N_OBS)+(9)] = S[(12-1)*SENSDIM+(5-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(2)*(N_OBS)+(10)] = S[(13-1)*SENSDIM+(5-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(2)*(N_OBS)+(11)] = (S[(1-1)*SENSDIM+(5-1)]*p[2-1])/(p[N_PARS+2-1]+1.0)+(S[(1-1)*SENSDIM+(6-1)]*p[2-1])/(p[N_PARS+2-1]+1.0); + jac[(2)*(N_OBS)+(12)] = (S[(13-1)*SENSDIM+(5-1)]*p[2-1])/(p[N_PARS+2-1]+1.0)+(S[(13-1)*SENSDIM+(6-1)]*p[2-1])/(p[N_PARS+2-1]+1.0); + jac[(2)*(N_OBS)+(13)] = (S[(23-1)*SENSDIM+(5-1)]*p[2-1])/(p[N_PARS+2-1]+1.0)+(S[(23-1)*SENSDIM+(6-1)]*p[2-1])/(p[N_PARS+2-1]+1.0); + jac[(2)*(N_OBS)+(14)] = (S[(33-1)*SENSDIM+(5-1)]*p[2-1])/(p[N_PARS+2-1]+1.0)+(S[(33-1)*SENSDIM+(6-1)]*p[2-1])/(p[N_PARS+2-1]+1.0); + jac[(2)*(N_OBS)+(15)] = (S[(43-1)*SENSDIM+(5-1)]*p[2-1])/(p[N_PARS+2-1]+1.0)+(S[(43-1)*SENSDIM+(6-1)]*p[2-1])/(p[N_PARS+2-1]+1.0); + jac[(2)*(N_OBS)+(16)] = s[(1-1)*N_STATES+(2-1)]/(p[2-1]*s[(1-1)*N_STATES+(1-1)])+(S[(1-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(1-1)*N_STATES+(1-1)])-(S[(1-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(1-1)*N_STATES+(1-1)]*s[(1-1)*N_STATES+(1-1)])*s[(1-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(17)] = s[(2-1)*N_STATES+(2-1)]/(p[2-1]*s[(2-1)*N_STATES+(1-1)])+(S[(2-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(2-1)*N_STATES+(1-1)])-(S[(2-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(2-1)*N_STATES+(1-1)]*s[(2-1)*N_STATES+(1-1)])*s[(2-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(18)] = s[(3-1)*N_STATES+(2-1)]/(p[2-1]*s[(3-1)*N_STATES+(1-1)])+(S[(3-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(3-1)*N_STATES+(1-1)])-(S[(3-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(3-1)*N_STATES+(1-1)]*s[(3-1)*N_STATES+(1-1)])*s[(3-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(19)] = s[(4-1)*N_STATES+(2-1)]/(p[2-1]*s[(4-1)*N_STATES+(1-1)])+(S[(4-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(4-1)*N_STATES+(1-1)])-(S[(4-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(4-1)*N_STATES+(1-1)]*s[(4-1)*N_STATES+(1-1)])*s[(4-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(20)] = s[(5-1)*N_STATES+(2-1)]/(p[2-1]*s[(5-1)*N_STATES+(1-1)])+(S[(5-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(5-1)*N_STATES+(1-1)])-(S[(5-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(5-1)*N_STATES+(1-1)]*s[(5-1)*N_STATES+(1-1)])*s[(5-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(21)] = s[(6-1)*N_STATES+(2-1)]/(p[2-1]*s[(6-1)*N_STATES+(1-1)])+(S[(6-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(6-1)*N_STATES+(1-1)])-(S[(6-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(6-1)*N_STATES+(1-1)]*s[(6-1)*N_STATES+(1-1)])*s[(6-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(22)] = s[(8-1)*N_STATES+(2-1)]/(p[2-1]*s[(8-1)*N_STATES+(1-1)])+(S[(8-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(8-1)*N_STATES+(1-1)])-(S[(8-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(8-1)*N_STATES+(1-1)]*s[(8-1)*N_STATES+(1-1)])*s[(8-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(23)] = s[(10-1)*N_STATES+(2-1)]/(p[2-1]*s[(10-1)*N_STATES+(1-1)])+(S[(10-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(10-1)*N_STATES+(1-1)])-(S[(10-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(10-1)*N_STATES+(1-1)]*s[(10-1)*N_STATES+(1-1)])*s[(10-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(24)] = s[(11-1)*N_STATES+(2-1)]/(p[2-1]*s[(11-1)*N_STATES+(1-1)])+(S[(11-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(11-1)*N_STATES+(1-1)])-(S[(11-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(11-1)*N_STATES+(1-1)]*s[(11-1)*N_STATES+(1-1)])*s[(11-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(25)] = s[(12-1)*N_STATES+(2-1)]/(p[2-1]*s[(12-1)*N_STATES+(1-1)])+(S[(12-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(12-1)*N_STATES+(1-1)])-(S[(12-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(12-1)*N_STATES+(1-1)]*s[(12-1)*N_STATES+(1-1)])*s[(12-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(26)] = s[(13-1)*N_STATES+(2-1)]/(p[2-1]*s[(13-1)*N_STATES+(1-1)])+(S[(13-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(13-1)*N_STATES+(1-1)])-(S[(13-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(13-1)*N_STATES+(1-1)]*s[(13-1)*N_STATES+(1-1)])*s[(13-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(27)] = s[(14-1)*N_STATES+(2-1)]/(p[2-1]*s[(14-1)*N_STATES+(1-1)])+(S[(14-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(14-1)*N_STATES+(1-1)])-(S[(14-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(14-1)*N_STATES+(1-1)]*s[(14-1)*N_STATES+(1-1)])*s[(14-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(28)] = s[(15-1)*N_STATES+(2-1)]/(p[2-1]*s[(15-1)*N_STATES+(1-1)])+(S[(15-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(15-1)*N_STATES+(1-1)])-(S[(15-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(15-1)*N_STATES+(1-1)]*s[(15-1)*N_STATES+(1-1)])*s[(15-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(29)] = s[(16-1)*N_STATES+(2-1)]/(p[2-1]*s[(16-1)*N_STATES+(1-1)])+(S[(16-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(16-1)*N_STATES+(1-1)])-(S[(16-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(16-1)*N_STATES+(1-1)]*s[(16-1)*N_STATES+(1-1)])*s[(16-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(30)] = s[(17-1)*N_STATES+(2-1)]/(p[2-1]*s[(17-1)*N_STATES+(1-1)])+(S[(17-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(17-1)*N_STATES+(1-1)])-(S[(17-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(17-1)*N_STATES+(1-1)]*s[(17-1)*N_STATES+(1-1)])*s[(17-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(31)] = s[(18-1)*N_STATES+(2-1)]/(p[2-1]*s[(18-1)*N_STATES+(1-1)])+(S[(18-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(18-1)*N_STATES+(1-1)])-(S[(18-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(18-1)*N_STATES+(1-1)]*s[(18-1)*N_STATES+(1-1)])*s[(18-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(32)] = s[(19-1)*N_STATES+(2-1)]/(p[2-1]*s[(19-1)*N_STATES+(1-1)])+(S[(19-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(19-1)*N_STATES+(1-1)])-(S[(19-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(19-1)*N_STATES+(1-1)]*s[(19-1)*N_STATES+(1-1)])*s[(19-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(33)] = s[(20-1)*N_STATES+(2-1)]/(p[2-1]*s[(20-1)*N_STATES+(1-1)])+(S[(20-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(20-1)*N_STATES+(1-1)])-(S[(20-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(20-1)*N_STATES+(1-1)]*s[(20-1)*N_STATES+(1-1)])*s[(20-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(34)] = s[(21-1)*N_STATES+(2-1)]/(p[2-1]*s[(21-1)*N_STATES+(1-1)])+(S[(21-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(21-1)*N_STATES+(1-1)])-(S[(21-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(21-1)*N_STATES+(1-1)]*s[(21-1)*N_STATES+(1-1)])*s[(21-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(35)] = s[(22-1)*N_STATES+(2-1)]/(p[2-1]*s[(22-1)*N_STATES+(1-1)])+(S[(22-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(22-1)*N_STATES+(1-1)])-(S[(22-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(22-1)*N_STATES+(1-1)]*s[(22-1)*N_STATES+(1-1)])*s[(22-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(36)] = s[(23-1)*N_STATES+(2-1)]/(p[2-1]*s[(23-1)*N_STATES+(1-1)])+(S[(23-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(23-1)*N_STATES+(1-1)])-(S[(23-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(23-1)*N_STATES+(1-1)]*s[(23-1)*N_STATES+(1-1)])*s[(23-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(37)] = s[(24-1)*N_STATES+(2-1)]/(p[2-1]*s[(24-1)*N_STATES+(1-1)])+(S[(24-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(24-1)*N_STATES+(1-1)])-(S[(24-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(24-1)*N_STATES+(1-1)]*s[(24-1)*N_STATES+(1-1)])*s[(24-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(38)] = s[(25-1)*N_STATES+(2-1)]/(p[2-1]*s[(25-1)*N_STATES+(1-1)])+(S[(25-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(25-1)*N_STATES+(1-1)])-(S[(25-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(25-1)*N_STATES+(1-1)]*s[(25-1)*N_STATES+(1-1)])*s[(25-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(39)] = s[(26-1)*N_STATES+(2-1)]/(p[2-1]*s[(26-1)*N_STATES+(1-1)])+(S[(26-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(26-1)*N_STATES+(1-1)])-(S[(26-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(26-1)*N_STATES+(1-1)]*s[(26-1)*N_STATES+(1-1)])*s[(26-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(40)] = s[(27-1)*N_STATES+(2-1)]/(p[2-1]*s[(27-1)*N_STATES+(1-1)])+(S[(27-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(27-1)*N_STATES+(1-1)])-(S[(27-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(27-1)*N_STATES+(1-1)]*s[(27-1)*N_STATES+(1-1)])*s[(27-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(41)] = s[(28-1)*N_STATES+(2-1)]/(p[2-1]*s[(28-1)*N_STATES+(1-1)])+(S[(28-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(28-1)*N_STATES+(1-1)])-(S[(28-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(28-1)*N_STATES+(1-1)]*s[(28-1)*N_STATES+(1-1)])*s[(28-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(42)] = s[(29-1)*N_STATES+(2-1)]/(p[2-1]*s[(29-1)*N_STATES+(1-1)])+(S[(29-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(29-1)*N_STATES+(1-1)])-(S[(29-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(29-1)*N_STATES+(1-1)]*s[(29-1)*N_STATES+(1-1)])*s[(29-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(43)] = s[(30-1)*N_STATES+(2-1)]/(p[2-1]*s[(30-1)*N_STATES+(1-1)])+(S[(30-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(30-1)*N_STATES+(1-1)])-(S[(30-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(30-1)*N_STATES+(1-1)]*s[(30-1)*N_STATES+(1-1)])*s[(30-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(44)] = s[(31-1)*N_STATES+(2-1)]/(p[2-1]*s[(31-1)*N_STATES+(1-1)])+(S[(31-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(31-1)*N_STATES+(1-1)])-(S[(31-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(31-1)*N_STATES+(1-1)]*s[(31-1)*N_STATES+(1-1)])*s[(31-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(45)] = s[(32-1)*N_STATES+(2-1)]/(p[2-1]*s[(32-1)*N_STATES+(1-1)])+(S[(32-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(32-1)*N_STATES+(1-1)])-(S[(32-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(32-1)*N_STATES+(1-1)]*s[(32-1)*N_STATES+(1-1)])*s[(32-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(46)] = s[(33-1)*N_STATES+(2-1)]/(p[2-1]*s[(33-1)*N_STATES+(1-1)])+(S[(33-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(33-1)*N_STATES+(1-1)])-(S[(33-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(33-1)*N_STATES+(1-1)]*s[(33-1)*N_STATES+(1-1)])*s[(33-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(47)] = s[(34-1)*N_STATES+(2-1)]/(p[2-1]*s[(34-1)*N_STATES+(1-1)])+(S[(34-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(34-1)*N_STATES+(1-1)])-(S[(34-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(34-1)*N_STATES+(1-1)]*s[(34-1)*N_STATES+(1-1)])*s[(34-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(48)] = s[(35-1)*N_STATES+(2-1)]/(p[2-1]*s[(35-1)*N_STATES+(1-1)])+(S[(35-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(35-1)*N_STATES+(1-1)])-(S[(35-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(35-1)*N_STATES+(1-1)]*s[(35-1)*N_STATES+(1-1)])*s[(35-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(49)] = s[(36-1)*N_STATES+(2-1)]/(p[2-1]*s[(36-1)*N_STATES+(1-1)])+(S[(36-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(36-1)*N_STATES+(1-1)])-(S[(36-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(36-1)*N_STATES+(1-1)]*s[(36-1)*N_STATES+(1-1)])*s[(36-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(50)] = s[(37-1)*N_STATES+(2-1)]/(p[2-1]*s[(37-1)*N_STATES+(1-1)])+(S[(37-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(37-1)*N_STATES+(1-1)])-(S[(37-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(37-1)*N_STATES+(1-1)]*s[(37-1)*N_STATES+(1-1)])*s[(37-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(51)] = s[(38-1)*N_STATES+(2-1)]/(p[2-1]*s[(38-1)*N_STATES+(1-1)])+(S[(38-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(38-1)*N_STATES+(1-1)])-(S[(38-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(38-1)*N_STATES+(1-1)]*s[(38-1)*N_STATES+(1-1)])*s[(38-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(52)] = s[(39-1)*N_STATES+(2-1)]/(p[2-1]*s[(39-1)*N_STATES+(1-1)])+(S[(39-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(39-1)*N_STATES+(1-1)])-(S[(39-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(39-1)*N_STATES+(1-1)]*s[(39-1)*N_STATES+(1-1)])*s[(39-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(53)] = s[(40-1)*N_STATES+(2-1)]/(p[2-1]*s[(40-1)*N_STATES+(1-1)])+(S[(40-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(40-1)*N_STATES+(1-1)])-(S[(40-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(40-1)*N_STATES+(1-1)]*s[(40-1)*N_STATES+(1-1)])*s[(40-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(54)] = s[(41-1)*N_STATES+(2-1)]/(p[2-1]*s[(41-1)*N_STATES+(1-1)])+(S[(41-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(41-1)*N_STATES+(1-1)])-(S[(41-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(41-1)*N_STATES+(1-1)]*s[(41-1)*N_STATES+(1-1)])*s[(41-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(55)] = s[(42-1)*N_STATES+(2-1)]/(p[2-1]*s[(42-1)*N_STATES+(1-1)])+(S[(42-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(42-1)*N_STATES+(1-1)])-(S[(42-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(42-1)*N_STATES+(1-1)]*s[(42-1)*N_STATES+(1-1)])*s[(42-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(56)] = s[(43-1)*N_STATES+(2-1)]/(p[2-1]*s[(43-1)*N_STATES+(1-1)])+(S[(43-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(43-1)*N_STATES+(1-1)])-(S[(43-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(43-1)*N_STATES+(1-1)]*s[(43-1)*N_STATES+(1-1)])*s[(43-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(57)] = s[(44-1)*N_STATES+(2-1)]/(p[2-1]*s[(44-1)*N_STATES+(1-1)])+(S[(44-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(44-1)*N_STATES+(1-1)])-(S[(44-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(44-1)*N_STATES+(1-1)]*s[(44-1)*N_STATES+(1-1)])*s[(44-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(58)] = s[(45-1)*N_STATES+(2-1)]/(p[2-1]*s[(45-1)*N_STATES+(1-1)])+(S[(45-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(45-1)*N_STATES+(1-1)])-(S[(45-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(45-1)*N_STATES+(1-1)]*s[(45-1)*N_STATES+(1-1)])*s[(45-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(59)] = s[(46-1)*N_STATES+(2-1)]/(p[2-1]*s[(46-1)*N_STATES+(1-1)])+(S[(46-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(46-1)*N_STATES+(1-1)])-(S[(46-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(46-1)*N_STATES+(1-1)]*s[(46-1)*N_STATES+(1-1)])*s[(46-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(60)] = s[(47-1)*N_STATES+(2-1)]/(p[2-1]*s[(47-1)*N_STATES+(1-1)])+(S[(47-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(47-1)*N_STATES+(1-1)])-(S[(47-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(47-1)*N_STATES+(1-1)]*s[(47-1)*N_STATES+(1-1)])*s[(47-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(61)] = s[(48-1)*N_STATES+(2-1)]/(p[2-1]*s[(48-1)*N_STATES+(1-1)])+(S[(48-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(48-1)*N_STATES+(1-1)])-(S[(48-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(48-1)*N_STATES+(1-1)]*s[(48-1)*N_STATES+(1-1)])*s[(48-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(62)] = s[(49-1)*N_STATES+(2-1)]/(p[2-1]*s[(49-1)*N_STATES+(1-1)])+(S[(49-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(49-1)*N_STATES+(1-1)])-(S[(49-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(49-1)*N_STATES+(1-1)]*s[(49-1)*N_STATES+(1-1)])*s[(49-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(63)] = s[(50-1)*N_STATES+(2-1)]/(p[2-1]*s[(50-1)*N_STATES+(1-1)])+(S[(50-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(50-1)*N_STATES+(1-1)])-(S[(50-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(50-1)*N_STATES+(1-1)]*s[(50-1)*N_STATES+(1-1)])*s[(50-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(64)] = s[(51-1)*N_STATES+(2-1)]/(p[2-1]*s[(51-1)*N_STATES+(1-1)])+(S[(51-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(51-1)*N_STATES+(1-1)])-(S[(51-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(51-1)*N_STATES+(1-1)]*s[(51-1)*N_STATES+(1-1)])*s[(51-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(65)] = s[(52-1)*N_STATES+(2-1)]/(p[2-1]*s[(52-1)*N_STATES+(1-1)])+(S[(52-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(52-1)*N_STATES+(1-1)])-(S[(52-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(52-1)*N_STATES+(1-1)]*s[(52-1)*N_STATES+(1-1)])*s[(52-1)*N_STATES+(2-1)])/p[2-1]; + jac[(2)*(N_OBS)+(66)] = s[(53-1)*N_STATES+(2-1)]/(p[2-1]*s[(53-1)*N_STATES+(1-1)])+(S[(53-1)*SENSDIM+(6-1)]*p[3-1])/(p[2-1]*s[(53-1)*N_STATES+(1-1)])-(S[(53-1)*SENSDIM+(5-1)]*p[3-1]*1.0/(s[(53-1)*N_STATES+(1-1)]*s[(53-1)*N_STATES+(1-1)])*s[(53-1)*N_STATES+(2-1)])/p[2-1]; + jac[(3)*(N_OBS)+(0)] = p[1-1]*s[(1-1)*N_STATES+(1-1)]*u[1-1]; + jac[(3)*(N_OBS)+(1)] = p[1-1]*s[(2-1)*N_STATES+(1-1)]*u[1-1]; + jac[(3)*(N_OBS)+(2)] = p[1-1]*s[(3-1)*N_STATES+(1-1)]*u[1-1]; + jac[(3)*(N_OBS)+(3)] = p[1-1]*s[(4-1)*N_STATES+(1-1)]*u[1-1]; + jac[(3)*(N_OBS)+(4)] = p[1-1]*s[(5-1)*N_STATES+(1-1)]*u[1-1]; + jac[(3)*(N_OBS)+(5)] = p[1-1]*s[(6-1)*N_STATES+(1-1)]*u[1-1]; + jac[(3)*(N_OBS)+(6)] = p[1-1]*s[(7-1)*N_STATES+(1-1)]*u[1-1]; + jac[(3)*(N_OBS)+(7)] = p[1-1]*s[(9-1)*N_STATES+(1-1)]*u[1-1]; + jac[(3)*(N_OBS)+(8)] = p[1-1]*s[(11-1)*N_STATES+(1-1)]*u[1-1]; + jac[(3)*(N_OBS)+(9)] = p[1-1]*s[(12-1)*N_STATES+(1-1)]*u[1-1]; + jac[(3)*(N_OBS)+(10)] = p[1-1]*s[(13-1)*N_STATES+(1-1)]*u[1-1]; + jac[(4)*(N_OBS)+(11)] = -p[2-1]*1.0/pow(p[N_PARS+2-1]+1.0,2.0)*(-d[1-1]+s[(1-1)*N_STATES+(1-1)]+s[(1-1)*N_STATES+(2-1)]); + jac[(4)*(N_OBS)+(12)] = -p[2-1]*1.0/pow(p[N_PARS+2-1]+1.0,2.0)*(-d[2-1]+s[(13-1)*N_STATES+(1-1)]+s[(13-1)*N_STATES+(2-1)]); + jac[(4)*(N_OBS)+(13)] = -p[2-1]*1.0/pow(p[N_PARS+2-1]+1.0,2.0)*(-d[3-1]+s[(23-1)*N_STATES+(1-1)]+s[(23-1)*N_STATES+(2-1)]); + jac[(4)*(N_OBS)+(14)] = -p[2-1]*1.0/pow(p[N_PARS+2-1]+1.0,2.0)*(-d[4-1]+s[(33-1)*N_STATES+(1-1)]+s[(33-1)*N_STATES+(2-1)]); + jac[(4)*(N_OBS)+(15)] = -p[2-1]*1.0/pow(p[N_PARS+2-1]+1.0,2.0)*(-d[5-1]+s[(43-1)*N_STATES+(1-1)]+s[(43-1)*N_STATES+(2-1)]); + jac[(5)*(N_OBS)+(0)] = S[(1-1)*SENSDIM+(9-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(5)*(N_OBS)+(1)] = S[(2-1)*SENSDIM+(9-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(5)*(N_OBS)+(2)] = S[(3-1)*SENSDIM+(9-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(5)*(N_OBS)+(3)] = S[(4-1)*SENSDIM+(9-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(5)*(N_OBS)+(4)] = S[(5-1)*SENSDIM+(9-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(5)*(N_OBS)+(5)] = S[(6-1)*SENSDIM+(9-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(5)*(N_OBS)+(6)] = S[(7-1)*SENSDIM+(9-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(5)*(N_OBS)+(7)] = S[(9-1)*SENSDIM+(9-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(5)*(N_OBS)+(8)] = S[(11-1)*SENSDIM+(9-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(5)*(N_OBS)+(9)] = S[(12-1)*SENSDIM+(9-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(5)*(N_OBS)+(10)] = S[(13-1)*SENSDIM+(9-1)]*p[1-1]*u[1-1]*(p[N_PARS+1-1]+1.0); + jac[(5)*(N_OBS)+(11)] = (S[(1-1)*SENSDIM+(10-1)]*p[2-1])/(p[N_PARS+2-1]+1.0)+(S[(1-1)*SENSDIM+(9-1)]*p[2-1])/(p[N_PARS+2-1]+1.0); + jac[(5)*(N_OBS)+(12)] = (S[(13-1)*SENSDIM+(10-1)]*p[2-1])/(p[N_PARS+2-1]+1.0)+(S[(13-1)*SENSDIM+(9-1)]*p[2-1])/(p[N_PARS+2-1]+1.0); + jac[(5)*(N_OBS)+(13)] = (S[(23-1)*SENSDIM+(10-1)]*p[2-1])/(p[N_PARS+2-1]+1.0)+(S[(23-1)*SENSDIM+(9-1)]*p[2-1])/(p[N_PARS+2-1]+1.0); + jac[(5)*(N_OBS)+(14)] = (S[(33-1)*SENSDIM+(10-1)]*p[2-1])/(p[N_PARS+2-1]+1.0)+(S[(33-1)*SENSDIM+(9-1)]*p[2-1])/(p[N_PARS+2-1]+1.0); + jac[(5)*(N_OBS)+(15)] = (S[(43-1)*SENSDIM+(10-1)]*p[2-1])/(p[N_PARS+2-1]+1.0)+(S[(43-1)*SENSDIM+(9-1)]*p[2-1])/(p[N_PARS+2-1]+1.0); + jac[(5)*(N_OBS)+(16)] = (S[(1-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(1-1)*N_STATES+(1-1)])-(S[(1-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(1-1)*N_STATES+(1-1)]*s[(1-1)*N_STATES+(1-1)])*s[(1-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(17)] = (S[(2-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(2-1)*N_STATES+(1-1)])-(S[(2-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(2-1)*N_STATES+(1-1)]*s[(2-1)*N_STATES+(1-1)])*s[(2-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(18)] = (S[(3-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(3-1)*N_STATES+(1-1)])-(S[(3-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(3-1)*N_STATES+(1-1)]*s[(3-1)*N_STATES+(1-1)])*s[(3-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(19)] = (S[(4-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(4-1)*N_STATES+(1-1)])-(S[(4-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(4-1)*N_STATES+(1-1)]*s[(4-1)*N_STATES+(1-1)])*s[(4-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(20)] = (S[(5-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(5-1)*N_STATES+(1-1)])-(S[(5-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(5-1)*N_STATES+(1-1)]*s[(5-1)*N_STATES+(1-1)])*s[(5-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(21)] = (S[(6-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(6-1)*N_STATES+(1-1)])-(S[(6-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(6-1)*N_STATES+(1-1)]*s[(6-1)*N_STATES+(1-1)])*s[(6-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(22)] = (S[(8-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(8-1)*N_STATES+(1-1)])-(S[(8-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(8-1)*N_STATES+(1-1)]*s[(8-1)*N_STATES+(1-1)])*s[(8-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(23)] = (S[(10-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(10-1)*N_STATES+(1-1)])-(S[(10-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(10-1)*N_STATES+(1-1)]*s[(10-1)*N_STATES+(1-1)])*s[(10-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(24)] = (S[(11-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(11-1)*N_STATES+(1-1)])-(S[(11-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(11-1)*N_STATES+(1-1)]*s[(11-1)*N_STATES+(1-1)])*s[(11-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(25)] = (S[(12-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(12-1)*N_STATES+(1-1)])-(S[(12-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(12-1)*N_STATES+(1-1)]*s[(12-1)*N_STATES+(1-1)])*s[(12-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(26)] = (S[(13-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(13-1)*N_STATES+(1-1)])-(S[(13-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(13-1)*N_STATES+(1-1)]*s[(13-1)*N_STATES+(1-1)])*s[(13-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(27)] = (S[(14-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(14-1)*N_STATES+(1-1)])-(S[(14-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(14-1)*N_STATES+(1-1)]*s[(14-1)*N_STATES+(1-1)])*s[(14-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(28)] = (S[(15-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(15-1)*N_STATES+(1-1)])-(S[(15-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(15-1)*N_STATES+(1-1)]*s[(15-1)*N_STATES+(1-1)])*s[(15-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(29)] = (S[(16-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(16-1)*N_STATES+(1-1)])-(S[(16-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(16-1)*N_STATES+(1-1)]*s[(16-1)*N_STATES+(1-1)])*s[(16-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(30)] = (S[(17-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(17-1)*N_STATES+(1-1)])-(S[(17-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(17-1)*N_STATES+(1-1)]*s[(17-1)*N_STATES+(1-1)])*s[(17-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(31)] = (S[(18-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(18-1)*N_STATES+(1-1)])-(S[(18-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(18-1)*N_STATES+(1-1)]*s[(18-1)*N_STATES+(1-1)])*s[(18-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(32)] = (S[(19-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(19-1)*N_STATES+(1-1)])-(S[(19-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(19-1)*N_STATES+(1-1)]*s[(19-1)*N_STATES+(1-1)])*s[(19-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(33)] = (S[(20-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(20-1)*N_STATES+(1-1)])-(S[(20-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(20-1)*N_STATES+(1-1)]*s[(20-1)*N_STATES+(1-1)])*s[(20-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(34)] = (S[(21-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(21-1)*N_STATES+(1-1)])-(S[(21-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(21-1)*N_STATES+(1-1)]*s[(21-1)*N_STATES+(1-1)])*s[(21-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(35)] = (S[(22-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(22-1)*N_STATES+(1-1)])-(S[(22-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(22-1)*N_STATES+(1-1)]*s[(22-1)*N_STATES+(1-1)])*s[(22-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(36)] = (S[(23-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(23-1)*N_STATES+(1-1)])-(S[(23-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(23-1)*N_STATES+(1-1)]*s[(23-1)*N_STATES+(1-1)])*s[(23-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(37)] = (S[(24-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(24-1)*N_STATES+(1-1)])-(S[(24-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(24-1)*N_STATES+(1-1)]*s[(24-1)*N_STATES+(1-1)])*s[(24-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(38)] = (S[(25-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(25-1)*N_STATES+(1-1)])-(S[(25-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(25-1)*N_STATES+(1-1)]*s[(25-1)*N_STATES+(1-1)])*s[(25-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(39)] = (S[(26-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(26-1)*N_STATES+(1-1)])-(S[(26-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(26-1)*N_STATES+(1-1)]*s[(26-1)*N_STATES+(1-1)])*s[(26-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(40)] = (S[(27-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(27-1)*N_STATES+(1-1)])-(S[(27-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(27-1)*N_STATES+(1-1)]*s[(27-1)*N_STATES+(1-1)])*s[(27-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(41)] = (S[(28-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(28-1)*N_STATES+(1-1)])-(S[(28-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(28-1)*N_STATES+(1-1)]*s[(28-1)*N_STATES+(1-1)])*s[(28-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(42)] = (S[(29-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(29-1)*N_STATES+(1-1)])-(S[(29-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(29-1)*N_STATES+(1-1)]*s[(29-1)*N_STATES+(1-1)])*s[(29-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(43)] = (S[(30-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(30-1)*N_STATES+(1-1)])-(S[(30-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(30-1)*N_STATES+(1-1)]*s[(30-1)*N_STATES+(1-1)])*s[(30-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(44)] = (S[(31-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(31-1)*N_STATES+(1-1)])-(S[(31-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(31-1)*N_STATES+(1-1)]*s[(31-1)*N_STATES+(1-1)])*s[(31-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(45)] = (S[(32-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(32-1)*N_STATES+(1-1)])-(S[(32-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(32-1)*N_STATES+(1-1)]*s[(32-1)*N_STATES+(1-1)])*s[(32-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(46)] = (S[(33-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(33-1)*N_STATES+(1-1)])-(S[(33-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(33-1)*N_STATES+(1-1)]*s[(33-1)*N_STATES+(1-1)])*s[(33-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(47)] = (S[(34-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(34-1)*N_STATES+(1-1)])-(S[(34-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(34-1)*N_STATES+(1-1)]*s[(34-1)*N_STATES+(1-1)])*s[(34-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(48)] = (S[(35-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(35-1)*N_STATES+(1-1)])-(S[(35-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(35-1)*N_STATES+(1-1)]*s[(35-1)*N_STATES+(1-1)])*s[(35-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(49)] = (S[(36-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(36-1)*N_STATES+(1-1)])-(S[(36-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(36-1)*N_STATES+(1-1)]*s[(36-1)*N_STATES+(1-1)])*s[(36-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(50)] = (S[(37-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(37-1)*N_STATES+(1-1)])-(S[(37-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(37-1)*N_STATES+(1-1)]*s[(37-1)*N_STATES+(1-1)])*s[(37-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(51)] = (S[(38-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(38-1)*N_STATES+(1-1)])-(S[(38-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(38-1)*N_STATES+(1-1)]*s[(38-1)*N_STATES+(1-1)])*s[(38-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(52)] = (S[(39-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(39-1)*N_STATES+(1-1)])-(S[(39-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(39-1)*N_STATES+(1-1)]*s[(39-1)*N_STATES+(1-1)])*s[(39-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(53)] = (S[(40-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(40-1)*N_STATES+(1-1)])-(S[(40-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(40-1)*N_STATES+(1-1)]*s[(40-1)*N_STATES+(1-1)])*s[(40-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(54)] = (S[(41-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(41-1)*N_STATES+(1-1)])-(S[(41-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(41-1)*N_STATES+(1-1)]*s[(41-1)*N_STATES+(1-1)])*s[(41-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(55)] = (S[(42-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(42-1)*N_STATES+(1-1)])-(S[(42-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(42-1)*N_STATES+(1-1)]*s[(42-1)*N_STATES+(1-1)])*s[(42-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(56)] = (S[(43-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(43-1)*N_STATES+(1-1)])-(S[(43-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(43-1)*N_STATES+(1-1)]*s[(43-1)*N_STATES+(1-1)])*s[(43-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(57)] = (S[(44-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(44-1)*N_STATES+(1-1)])-(S[(44-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(44-1)*N_STATES+(1-1)]*s[(44-1)*N_STATES+(1-1)])*s[(44-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(58)] = (S[(45-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(45-1)*N_STATES+(1-1)])-(S[(45-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(45-1)*N_STATES+(1-1)]*s[(45-1)*N_STATES+(1-1)])*s[(45-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(59)] = (S[(46-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(46-1)*N_STATES+(1-1)])-(S[(46-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(46-1)*N_STATES+(1-1)]*s[(46-1)*N_STATES+(1-1)])*s[(46-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(60)] = (S[(47-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(47-1)*N_STATES+(1-1)])-(S[(47-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(47-1)*N_STATES+(1-1)]*s[(47-1)*N_STATES+(1-1)])*s[(47-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(61)] = (S[(48-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(48-1)*N_STATES+(1-1)])-(S[(48-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(48-1)*N_STATES+(1-1)]*s[(48-1)*N_STATES+(1-1)])*s[(48-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(62)] = (S[(49-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(49-1)*N_STATES+(1-1)])-(S[(49-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(49-1)*N_STATES+(1-1)]*s[(49-1)*N_STATES+(1-1)])*s[(49-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(63)] = (S[(50-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(50-1)*N_STATES+(1-1)])-(S[(50-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(50-1)*N_STATES+(1-1)]*s[(50-1)*N_STATES+(1-1)])*s[(50-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(64)] = (S[(51-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(51-1)*N_STATES+(1-1)])-(S[(51-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(51-1)*N_STATES+(1-1)]*s[(51-1)*N_STATES+(1-1)])*s[(51-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(65)] = (S[(52-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(52-1)*N_STATES+(1-1)])-(S[(52-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(52-1)*N_STATES+(1-1)]*s[(52-1)*N_STATES+(1-1)])*s[(52-1)*N_STATES+(2-1)])/p[2-1]; + jac[(5)*(N_OBS)+(66)] = (S[(53-1)*SENSDIM+(10-1)]*p[3-1])/(p[2-1]*s[(53-1)*N_STATES+(1-1)])-(S[(53-1)*SENSDIM+(9-1)]*p[3-1]*1.0/(s[(53-1)*N_STATES+(1-1)]*s[(53-1)*N_STATES+(1-1)])*s[(53-1)*N_STATES+(2-1)])/p[2-1]; +} diff --git a/odemex/observerFunctions/ccode/jac.h b/odemex/observerFunctions/ccode/jac.h new file mode 100644 index 0000000..940c2e2 --- /dev/null +++ b/odemex/observerFunctions/ccode/jac.h @@ -0,0 +1,4 @@ +#define CJAC + +void jacobian(double *obj, double *s, double *p, double *d, double *u, double *S ); + diff --git a/odemex/observerFunctions/ccode/objfn.c b/odemex/observerFunctions/ccode/objfn.c new file mode 100644 index 0000000..7434101 --- /dev/null +++ b/odemex/observerFunctions/ccode/objfn.c @@ -0,0 +1,72 @@ +#include "objfn.h" + + +void objectiveFn(double *obs, double *s, double *p, double *d, double *u ) { + obs[0] = p[1-1]*s[(1-1)*N_STATES+(1-1)]*u[1-1]*(p[N_PARS+1-1]+1.0); + obs[1] = p[1-1]*s[(2-1)*N_STATES+(1-1)]*u[1-1]*(p[N_PARS+1-1]+1.0); + obs[2] = p[1-1]*s[(3-1)*N_STATES+(1-1)]*u[1-1]*(p[N_PARS+1-1]+1.0); + obs[3] = p[1-1]*s[(4-1)*N_STATES+(1-1)]*u[1-1]*(p[N_PARS+1-1]+1.0); + obs[4] = p[1-1]*s[(5-1)*N_STATES+(1-1)]*u[1-1]*(p[N_PARS+1-1]+1.0); + obs[5] = p[1-1]*s[(6-1)*N_STATES+(1-1)]*u[1-1]*(p[N_PARS+1-1]+1.0); + obs[6] = p[1-1]*s[(7-1)*N_STATES+(1-1)]*u[1-1]*(p[N_PARS+1-1]+1.0); + obs[7] = p[1-1]*s[(9-1)*N_STATES+(1-1)]*u[1-1]*(p[N_PARS+1-1]+1.0); + obs[8] = p[1-1]*s[(11-1)*N_STATES+(1-1)]*u[1-1]*(p[N_PARS+1-1]+1.0); + obs[9] = p[1-1]*s[(12-1)*N_STATES+(1-1)]*u[1-1]*(p[N_PARS+1-1]+1.0); + obs[10] = p[1-1]*s[(13-1)*N_STATES+(1-1)]*u[1-1]*(p[N_PARS+1-1]+1.0); + obs[11] = (p[2-1]*(-d[1-1]+s[(1-1)*N_STATES+(1-1)]+s[(1-1)*N_STATES+(2-1)]))/(p[N_PARS+2-1]+1.0); + obs[12] = (p[2-1]*(-d[2-1]+s[(13-1)*N_STATES+(1-1)]+s[(13-1)*N_STATES+(2-1)]))/(p[N_PARS+2-1]+1.0); + obs[13] = (p[2-1]*(-d[3-1]+s[(23-1)*N_STATES+(1-1)]+s[(23-1)*N_STATES+(2-1)]))/(p[N_PARS+2-1]+1.0); + obs[14] = (p[2-1]*(-d[4-1]+s[(33-1)*N_STATES+(1-1)]+s[(33-1)*N_STATES+(2-1)]))/(p[N_PARS+2-1]+1.0); + obs[15] = (p[2-1]*(-d[5-1]+s[(43-1)*N_STATES+(1-1)]+s[(43-1)*N_STATES+(2-1)]))/(p[N_PARS+2-1]+1.0); + obs[16] = (p[3-1]*s[(1-1)*N_STATES+(2-1)])/(p[2-1]*s[(1-1)*N_STATES+(1-1)]); + obs[17] = (p[3-1]*s[(2-1)*N_STATES+(2-1)])/(p[2-1]*s[(2-1)*N_STATES+(1-1)]); + obs[18] = (p[3-1]*s[(3-1)*N_STATES+(2-1)])/(p[2-1]*s[(3-1)*N_STATES+(1-1)]); + obs[19] = (p[3-1]*s[(4-1)*N_STATES+(2-1)])/(p[2-1]*s[(4-1)*N_STATES+(1-1)]); + obs[20] = (p[3-1]*s[(5-1)*N_STATES+(2-1)])/(p[2-1]*s[(5-1)*N_STATES+(1-1)]); + obs[21] = (p[3-1]*s[(6-1)*N_STATES+(2-1)])/(p[2-1]*s[(6-1)*N_STATES+(1-1)]); + obs[22] = (p[3-1]*s[(8-1)*N_STATES+(2-1)])/(p[2-1]*s[(8-1)*N_STATES+(1-1)]); + obs[23] = (p[3-1]*s[(10-1)*N_STATES+(2-1)])/(p[2-1]*s[(10-1)*N_STATES+(1-1)]); + obs[24] = (p[3-1]*s[(11-1)*N_STATES+(2-1)])/(p[2-1]*s[(11-1)*N_STATES+(1-1)]); + obs[25] = (p[3-1]*s[(12-1)*N_STATES+(2-1)])/(p[2-1]*s[(12-1)*N_STATES+(1-1)]); + obs[26] = (p[3-1]*s[(13-1)*N_STATES+(2-1)])/(p[2-1]*s[(13-1)*N_STATES+(1-1)]); + obs[27] = (p[3-1]*s[(14-1)*N_STATES+(2-1)])/(p[2-1]*s[(14-1)*N_STATES+(1-1)]); + obs[28] = (p[3-1]*s[(15-1)*N_STATES+(2-1)])/(p[2-1]*s[(15-1)*N_STATES+(1-1)]); + obs[29] = (p[3-1]*s[(16-1)*N_STATES+(2-1)])/(p[2-1]*s[(16-1)*N_STATES+(1-1)]); + obs[30] = (p[3-1]*s[(17-1)*N_STATES+(2-1)])/(p[2-1]*s[(17-1)*N_STATES+(1-1)]); + obs[31] = (p[3-1]*s[(18-1)*N_STATES+(2-1)])/(p[2-1]*s[(18-1)*N_STATES+(1-1)]); + obs[32] = (p[3-1]*s[(19-1)*N_STATES+(2-1)])/(p[2-1]*s[(19-1)*N_STATES+(1-1)]); + obs[33] = (p[3-1]*s[(20-1)*N_STATES+(2-1)])/(p[2-1]*s[(20-1)*N_STATES+(1-1)]); + obs[34] = (p[3-1]*s[(21-1)*N_STATES+(2-1)])/(p[2-1]*s[(21-1)*N_STATES+(1-1)]); + obs[35] = (p[3-1]*s[(22-1)*N_STATES+(2-1)])/(p[2-1]*s[(22-1)*N_STATES+(1-1)]); + obs[36] = (p[3-1]*s[(23-1)*N_STATES+(2-1)])/(p[2-1]*s[(23-1)*N_STATES+(1-1)]); + obs[37] = (p[3-1]*s[(24-1)*N_STATES+(2-1)])/(p[2-1]*s[(24-1)*N_STATES+(1-1)]); + obs[38] = (p[3-1]*s[(25-1)*N_STATES+(2-1)])/(p[2-1]*s[(25-1)*N_STATES+(1-1)]); + obs[39] = (p[3-1]*s[(26-1)*N_STATES+(2-1)])/(p[2-1]*s[(26-1)*N_STATES+(1-1)]); + obs[40] = (p[3-1]*s[(27-1)*N_STATES+(2-1)])/(p[2-1]*s[(27-1)*N_STATES+(1-1)]); + obs[41] = (p[3-1]*s[(28-1)*N_STATES+(2-1)])/(p[2-1]*s[(28-1)*N_STATES+(1-1)]); + obs[42] = (p[3-1]*s[(29-1)*N_STATES+(2-1)])/(p[2-1]*s[(29-1)*N_STATES+(1-1)]); + obs[43] = (p[3-1]*s[(30-1)*N_STATES+(2-1)])/(p[2-1]*s[(30-1)*N_STATES+(1-1)]); + obs[44] = (p[3-1]*s[(31-1)*N_STATES+(2-1)])/(p[2-1]*s[(31-1)*N_STATES+(1-1)]); + obs[45] = (p[3-1]*s[(32-1)*N_STATES+(2-1)])/(p[2-1]*s[(32-1)*N_STATES+(1-1)]); + obs[46] = (p[3-1]*s[(33-1)*N_STATES+(2-1)])/(p[2-1]*s[(33-1)*N_STATES+(1-1)]); + obs[47] = (p[3-1]*s[(34-1)*N_STATES+(2-1)])/(p[2-1]*s[(34-1)*N_STATES+(1-1)]); + obs[48] = (p[3-1]*s[(35-1)*N_STATES+(2-1)])/(p[2-1]*s[(35-1)*N_STATES+(1-1)]); + obs[49] = (p[3-1]*s[(36-1)*N_STATES+(2-1)])/(p[2-1]*s[(36-1)*N_STATES+(1-1)]); + obs[50] = (p[3-1]*s[(37-1)*N_STATES+(2-1)])/(p[2-1]*s[(37-1)*N_STATES+(1-1)]); + obs[51] = (p[3-1]*s[(38-1)*N_STATES+(2-1)])/(p[2-1]*s[(38-1)*N_STATES+(1-1)]); + obs[52] = (p[3-1]*s[(39-1)*N_STATES+(2-1)])/(p[2-1]*s[(39-1)*N_STATES+(1-1)]); + obs[53] = (p[3-1]*s[(40-1)*N_STATES+(2-1)])/(p[2-1]*s[(40-1)*N_STATES+(1-1)]); + obs[54] = (p[3-1]*s[(41-1)*N_STATES+(2-1)])/(p[2-1]*s[(41-1)*N_STATES+(1-1)]); + obs[55] = (p[3-1]*s[(42-1)*N_STATES+(2-1)])/(p[2-1]*s[(42-1)*N_STATES+(1-1)]); + obs[56] = (p[3-1]*s[(43-1)*N_STATES+(2-1)])/(p[2-1]*s[(43-1)*N_STATES+(1-1)]); + obs[57] = (p[3-1]*s[(44-1)*N_STATES+(2-1)])/(p[2-1]*s[(44-1)*N_STATES+(1-1)]); + obs[58] = (p[3-1]*s[(45-1)*N_STATES+(2-1)])/(p[2-1]*s[(45-1)*N_STATES+(1-1)]); + obs[59] = (p[3-1]*s[(46-1)*N_STATES+(2-1)])/(p[2-1]*s[(46-1)*N_STATES+(1-1)]); + obs[60] = (p[3-1]*s[(47-1)*N_STATES+(2-1)])/(p[2-1]*s[(47-1)*N_STATES+(1-1)]); + obs[61] = (p[3-1]*s[(48-1)*N_STATES+(2-1)])/(p[2-1]*s[(48-1)*N_STATES+(1-1)]); + obs[62] = (p[3-1]*s[(49-1)*N_STATES+(2-1)])/(p[2-1]*s[(49-1)*N_STATES+(1-1)]); + obs[63] = (p[3-1]*s[(50-1)*N_STATES+(2-1)])/(p[2-1]*s[(50-1)*N_STATES+(1-1)]); + obs[64] = (p[3-1]*s[(51-1)*N_STATES+(2-1)])/(p[2-1]*s[(51-1)*N_STATES+(1-1)]); + obs[65] = (p[3-1]*s[(52-1)*N_STATES+(2-1)])/(p[2-1]*s[(52-1)*N_STATES+(1-1)]); + obs[66] = (p[3-1]*s[(53-1)*N_STATES+(2-1)])/(p[2-1]*s[(53-1)*N_STATES+(1-1)]); +} diff --git a/odemex/observerFunctions/ccode/objfn.h b/odemex/observerFunctions/ccode/objfn.h new file mode 100644 index 0000000..5dd5ab7 --- /dev/null +++ b/odemex/observerFunctions/ccode/objfn.h @@ -0,0 +1,15 @@ + +#include "mex.h" + +#define N_DATA 5 +#define N_INPUT 1 +#define N_PARS 3 +#define N_STATES 2 +#define N_OBSPARS 2 +#define N_ICPARS 1 +#define N_OBS 67 +#define N_TIME 53 +#define SENSDIM 10 + +void objectiveFn(double *obj, double *s, double *p, double *d, double *u ); + diff --git a/odemex/observerFunctions/ccode/wrap.c b/odemex/observerFunctions/ccode/wrap.c new file mode 100644 index 0000000..dfc9343 --- /dev/null +++ b/odemex/observerFunctions/ccode/wrap.c @@ -0,0 +1,74 @@ + +#include "jac.h" +#include "objfn.h" +//#include "time.h" +//%#include "string.h" + +int sensitivities; + +void mexFunction (int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { + + sensitivities = 0; + + if (nrhs == 0) { + //printf( "Call function as:\ny = funcName(x0)\n", N_STATES, N_PARAMS, N_INPUTS ); + return; + } + + if ( nrhs < 4 ) mexErrMsgTxt( "ERROR: Incorrect number of input arguments\nFormat should be: (x, p, data, u, S*)\n* are optional" ); + + /* Check input dimensions */ + if ( ( mxGetM( prhs[0] ) != N_STATES ) && ( mxGetN( prhs[0] ) != N_TIME ) ) + { + printf( "ERROR: State matrix has incorrect dimensions! Expected %d by %d, found %d by %d", N_STATES, N_TIME, mxGetM( prhs[0] ), mxGetN( prhs[0] ) ); + mexErrMsgTxt( "" ); + } + + if ( mxGetN( prhs[1] ) != ( N_PARS + N_OBSPARS + N_ICPARS ) ) + { + printf( "ERROR: Parameter vector has incorrect dimensions! Expected %d, found %d", N_PARS+N_OBSPARS+N_ICPARS, mxGetN( prhs[1] ) ); + mexErrMsgTxt( "" ); + } + + if ( mxGetN( prhs[2] ) != ( N_DATA ) ) + { + printf( "ERROR: Data vector has incorrect dimensions! Expected %d, found %d", N_DATA, mxGetN( prhs[2] ) ); + mexErrMsgTxt( "" ); + } + + if ( mxGetN( prhs[3] ) != ( N_INPUT ) ) + { + printf( "ERROR: Input vector has incorrect dimensions! Expected %d, found %d", N_INPUT, mxGetN( prhs[3] ) ); + mexErrMsgTxt( "" ); + } + + if ( nlhs > 1 ) + { + if ( nrhs < 5 ) mexErrMsgTxt( "ERROR: Sensitivity outputs require a valid sensitivity matrix" ); + if ( mxGetM( prhs[4] ) != ( N_STATES * ( N_STATES + N_PARS ) ) && ( mxGetN( prhs[4] ) != N_TIME ) ) + { + printf( "ERROR: Sensitivity matrix has incorrect dimensions! Expected %d by %d, found %d by %d", N_STATES * ( N_STATES + N_PARS ), N_TIME, mxGetM( prhs[4] ), mxGetN( prhs[4] ) ); + mexErrMsgTxt( "" ); + } else { + #ifdef CJAC + sensitivities = 1; + #endif + } + } + + plhs[0] = mxCreateDoubleMatrix( N_OBS, 1, mxREAL ); + + objectiveFn( mxGetPr( plhs[0] ), mxGetPr( prhs[0] ), mxGetPr( prhs[1] ), mxGetPr( prhs[2] ), mxGetPr( prhs[3] ) ); + + #ifdef CJAC + if ( sensitivities == 1 ) + { + plhs[1] = mxCreateDoubleMatrix( N_OBS, N_OBSPARS + N_PARS + N_ICPARS, mxREAL ); + jacobian( mxGetPr( plhs[1] ), mxGetPr( prhs[0] ), mxGetPr( prhs[1] ), mxGetPr( prhs[2] ), mxGetPr( prhs[3] ), mxGetPr( prhs[4] ) ); + } + #endif + +} + + + diff --git a/odemex/observerFunctions/compileObjective.m b/odemex/observerFunctions/compileObjective.m new file mode 100644 index 0000000..5811e28 --- /dev/null +++ b/odemex/observerFunctions/compileObjective.m @@ -0,0 +1,36 @@ + +function compileObjective( outputFileName, jac, observPath ) + if jac == 1 + eval( sprintf( 'mex -output %s %sccode/wrap.c %sccode/objfn.c %sccode/jac.c', outputFileName, observPath, observPath, observPath ) ); + else + eval( sprintf( 'mex -output %s %sccode/wrap.c %sccode/objfn.c', outputFileName, observPath, observPath ) ); + end + +% +% Joep Vanlier, 2012 +% +% Licensing: +% Copyright (C) 2009-2012 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% + \ No newline at end of file diff --git a/odemex/observerFunctions/grabNextBracket.m b/odemex/observerFunctions/grabNextBracket.m new file mode 100644 index 0000000..80e5c4f --- /dev/null +++ b/odemex/observerFunctions/grabNextBracket.m @@ -0,0 +1,59 @@ +function [ before, values, remainder ] = grabNextBracket( l ) + + before = ''; + values = []; + remainder = ''; + + pos = 1; + + while ( pos < length( l ) & ( l(pos) ~= '[' ) ) + pos = pos + 1; + end + + if l(pos) == '[' + + before = l( 1 : pos ); + pos1 = pos; + depth = 1; + + while ( ( pos <= length( l ) ) & ( depth > 0 ) ) + if l(pos) == ']' + depth = depth - 1; + end + pos = pos + 1; + end + values = eval( l( pos1 : pos - 1 ) ); + + remainder = l( pos-1:end ); + else + before = l; + end + + +% +% Joep Vanlier, 2012 +% +% Licensing: +% Copyright (C) 2009-2012 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/observerFunctions/grabNextDataBracket.m b/odemex/observerFunctions/grabNextDataBracket.m new file mode 100644 index 0000000..72cfe20 --- /dev/null +++ b/odemex/observerFunctions/grabNextDataBracket.m @@ -0,0 +1,59 @@ +function [ before, values, remainder ] = grabNextDataBracket( l ); + + before = ''; + values = []; + remainder = ''; + + pos = 1; + + while ( pos < length( l ) & ( l(pos) ~= '{' ) ) + pos = pos + 1; + end + + if l(pos) == '{' + + before = [ l( 1 : pos - 1 ) '[' ]; + pos1 = pos; + depth = 1; + + while ( ( pos <= length( l ) ) & ( depth > 0 ) ) + if l(pos) == '}' + depth = depth - 1; + end + pos = pos + 1; + end + values = eval( [ '[' l( pos1 + 1: pos - 2 ) ']' ] ); + + remainder = [ ']' l( pos:end ) ]; + else + before = l; + end + + +% +% Joep Vanlier, 2012 +% +% Licensing: +% Copyright (C) 2009-2012 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/observerFunctions/nJac.m b/odemex/observerFunctions/nJac.m new file mode 100644 index 0000000..b9db964 --- /dev/null +++ b/odemex/observerFunctions/nJac.m @@ -0,0 +1,40 @@ + +function jac = nJac( func, pars, dx, subVec ) + + JacDiffs = dx * eye( length( pars ) ); + + if nargin < 4 + subVec = 1 : length( pars ); + end + + for a = subVec + jac(:,a) = ( feval( func, pars + JacDiffs(a,:) ) - feval( func, pars ) ) / dx; + end + +end% +% Joep Vanlier, 2012 +% +% Licensing: +% Copyright (C) 2009-2012 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/observerFunctions/observerFunctions.m b/odemex/observerFunctions/observerFunctions.m new file mode 100644 index 0000000..0a4ca74 --- /dev/null +++ b/odemex/observerFunctions/observerFunctions.m @@ -0,0 +1,344 @@ +function [ timePts, parIndices, obsIndices, icIndices ] = observerFunctions( obsName, obs, mStruct, cjac ) + +observPath = [ fileparts( mfilename( 'fullpath' ) ) '/' ]; + +nStates = max( structIndices( mStruct.s ) ); +nPars = max( structIndices( mStruct.p ) ); +try + nInput = max( structIndices( mStruct.u ) ); +catch + nInput = 0 ; +end +parIndices = 1 : nPars; + +allNames = []; types = []; +try allNames = [ allNames ; fieldnames( mStruct.c ); ]; types = [ types ; ones( length( fieldnames( mStruct.c ) ), 1 ) ]; catch; end; +try allNames = [ allNames ; fieldnames( mStruct.p ); ]; types = [ types ; 2*ones( length( fieldnames( mStruct.p ) ), 1 ) ]; catch; end; +try allNames = [ allNames ; fieldnames( mStruct.s ); ]; types = [ types ; 3*ones( length( fieldnames( mStruct.s ) ), 1 ) ]; catch; end; +try allNames = [ allNames ; fieldnames( mStruct.i ); ]; types = [ types ; 4*ones( length( fieldnames( mStruct.i ) ), 1 ) ]; catch; end; +try allNames = [ allNames ; fieldnames( mStruct.o ); ]; types = [ types ; 5*ones( length( fieldnames( mStruct.o ) ), 1 ) ]; catch; end; +try allNames = [ allNames ; fieldnames( mStruct.u ); ]; types = [ types ; 6*ones( length( fieldnames( mStruct.u ) ), 1 ) ]; catch; end; + +try + nObsPars = max( structIndices( mStruct.o ) ); + obsIndices = [ 1 : nObsPars ] + nPars; +catch + nObsPars = 0; + obsIndices = []; +end + +icIndices = zeros( nStates, 1 ); +try + icPars = structIndices( mStruct.i ); + nIcPars = length( icPars ); + + icIndices( icPars ) = [1:nIcPars]+nObsPars+nPars; +catch + nIcPars = 0; +end + +% Grab all the time points that need to be simulated for the objective +% function +disp( 'Fetching timepoints' ); +timePts = []; +for a = 1 : length( obs ) + [ before, values, remainder ] = grabNextBracket( obs{a} ); + timePts = [timePts, values]; + while length( remainder ) > 1 + [ before, values, remainder ] = grabNextBracket( remainder ); + timePts = [timePts, values]; + end +end +timePts = unique( timePts ); + +% If the zeroth timepoint isn't in the list, add it, because otherwise the +% simulation will have problems +if max(timePts==0) ~= 1 + timePts = [0 timePts]; +end +nTime = length(timePts); + +disp( 'Replacing timepoints with their indices' ); +% Replace the time points by their indices +for a = 1 : length( obs ) + [ before, values, remainder ] = grabNextBracket( obs{a} ); + obsB{a} = [ before replaceWithIndex( values, timePts ) ]; + while length( remainder ) > 1 + [ before, values, remainder ] = grabNextBracket( remainder ); + obsB{a} = [ obsB{a} before replaceWithIndex( values, timePts ) ]; + end + obsB{a} = [ obsB{a} remainder ]; +end + +% Grab all the data points +disp( 'Fetching datapoints' ); +dataPts = []; +for a = 1 : length( obs ) + [ before, values, remainder ] = grabNextDataBracket( obsB{a} ); + obsB{a} = [ before printAsString( values ) ]; + dataPts = [dataPts, values]; + while length( remainder ) > 1 + [ before, values, remainder ] = grabNextDataBracket( remainder ); + obsB{a} = [ obsB{a} before printAsString( values ) ]; + dataPts = [dataPts, values]; + end +end +obsB{a} = [ obsB{a} remainder ]; +dataPts = unique( dataPts ); +nData = length( dataPts ); + +disp( 'Generating syms for the datapoints' ); +for it1 = 1 : length( dataPts ) + data(it1) = sym( sprintf( 'data_%d', it1 ) ); +end + + + +% Generate all required state syms +disp( 'Generating syms for the states' ); + +fields = fieldnames( mStruct.s ); +for it1 = 1 : length( fields ) + for it2 = 1 : length( timePts ) + syms( sprintf( 's%d_%d', getfield( mStruct.s, fields{it1} ), it2 ) ); + eval( sprintf( 's%d(%d) = s%d_%d;', getfield( mStruct.s, fields{it1} ), it2, getfield( mStruct.s, fields{it1} ), it2 ) ); + end +end + +% Process the model parameters +disp( 'Generating syms for the model parameters' ); +names = fieldnames( mStruct.p ); +for it2 = 1 : length( names ) + parNo = getfield( mStruct.p, names{it2}); + p(parNo) = sym( sprintf( 'p%d', parNo ) ); +end + +% Process the observable parameters +disp( 'Generating syms for the observational parameters' ); +try + names = fieldnames( mStruct.o ); + for it2 = 1 : length( names ) + parNo = getfield( mStruct.o, names{it2} ); + eval( sprintf( 'syms o%d;', parNo ) ); + eval( sprintf( 'o(%d) = o%d;', parNo, parNo ) ); + end +catch +end + +% Process the initial condition parameters +disp( 'Generating syms for the initial condition parameters' ); +try + names = fieldnames( mStruct.i ); + for it2 = 1 : length( names ) + parNo = getfield( mStruct.i, names{it2} ); + eval( sprintf( 'syms i%d;', parNo ) ); + eval( sprintf( 'i(%d) = i%d;', parNo, parNo ) ); + end +catch +end + +% Process the inputs +disp( 'Generating syms for the inputs' ); +try + names = fieldnames( mStruct.u ); + for it2 = 1 : length( names ) + parNo = getfield( mStruct.u, names{it2} ); + eval( sprintf( 'syms u%d;', parNo ) ); + eval( sprintf( 'u(%d) = u%d;', parNo, parNo ) ); + end +catch +end + +% Replace identifiers by their respective indices +disp( 'Parsing the objective function cell array' ); +expressionTokens = '&()[]/*+-^@ %<>,;={}|'; +for c = 1 : length( obs ) + output = ''; + + remain = obsB{c}; + while length( remain ) > 0 + [ token, remain, tokensLost ] = strtok2( remain, expressionTokens ); + + for q = 1 : length( allNames ) + if strcmp( token, allNames(q) ) == 1 + switch types( q ) + case 1 + token = num2str( getfield( mStruct.c, allNames{q} ) ); + case 2 + token = sprintf( 'p(%d)', getfield( mStruct.p, allNames{q} ) ); + case 3 + token = sprintf( 's%d', getfield( mStruct.s, allNames{q} ) ); + case 4 + token = sprintf( 'i(%d)', getfield( mStruct.i, allNames{q} ) ); + case 5 + token = sprintf( 'o(%d)', getfield( mStruct.o, allNames{q} ) ); + case 6 + token = sprintf( 'u(%d)', getfield( mStruct.u, allNames{q} ) ); + end + end + end + output = [ output tokensLost token ]; + end + obsB{c} = output; +end + +% Construct objective function +obj = []; +for a = 1 : length( obsB ); + try + obj = [ obj, eval( obsB{a} ) ]; + catch ME + a + obsB{a} + disp( '>>> ERROR: Undeclared variable in objective function(s)' ); + rethrow(ME) + end +end + +c_code = ccode( obj ); +c_code = strrep( c_code, 'obj[0]', 'obs' ); +c_code = regexprep( c_code, 's(\d+)_(\d+)', 's[($2-1)*N_STATES+($1-1)]' ); +c_code = regexprep( c_code, 'p(\d+)', 'p[$1-1]' ); +c_code = regexprep( c_code, 'u(\d+)', 'u[$1-1]' ); +c_code = regexprep( c_code, 'o(\d+)', 'p[N_PARS+$1-1]' ); +c_code = regexprep( c_code, 'i(\d+)', 'p[N_PARS+N_OBSPARS+$1-1]' ); +c_code = regexprep( c_code, 'data_(\d+)', 'd[$1-1]' ); + +% Set up the header file +nObs = length( obj ); +nStates = length( fieldnames( mStruct.s ) ); +nPars = length( fieldnames( mStruct.p ) ); +nObsPars = length( fieldnames( mStruct.o ) ); + +disp( 'Writing C file for the objective function' ) +fid = fopen( [observPath 'ccode/objfn.c'], 'w' ); +fprintf( fid, '#include "objfn.h"\n\n\nvoid objectiveFn(double *obs, double *s, double *p, double *d, double *u ) {\n%s\n}\n', c_code ); +fid = fclose( fid ); + +fid = fopen( [observPath 'ccode/objfn.h'], 'w' ); +fprintf( fid, '\n#include "mex.h"\n\n#define N_DATA %d\n#define N_INPUT %d\n#define N_PARS %d\n#define N_STATES %d\n#define N_OBSPARS %d\n#define N_ICPARS %d\n#define N_OBS %d\n#define N_TIME %d\n#define SENSDIM %d\n\nvoid objectiveFn(double *obj, double *s, double *p, double *d, double *u );\n\n', nData, nInput, nPars, nStates, nObsPars, nIcPars, nObs, nTime, nStates * ( nStates + nPars ) ); +fid = fclose(fid); + +if cjac == 1 + + % Now that the objective function is computed, we can process the + % derivatives + % + % dy1 dp1 + % dy2 dp1 + % dy1 dp2 + % dy2 dp2 + % Compute all the derivatives + disp( 'Generating syms for all state derivatives output' ); + S = sym( zeros( nStates * (nPars+nStates), length( timePts ) ) ); + for a = 1 : length( timePts ) + for b = 1 : nStates * ( nPars + nStates ) + S( b, a ) = sym( sprintf( 'S_%d_%d', b, a ) ); + end + end + + disp( 'Constructing the Jacobian (model parameters)' ); + jac = sym( zeros( length( obj ), nPars + nObsPars + nIcPars ) ); + for a = 1 : length( obj ) + disp( sprintf( 'Observable %d/%d', a, length(obj) ) ); + for b = 1 : nPars + index = length( obj ) * (b-1) + a; + + % Process all partial derivatives with respect to the observables + % do/dx dx/dp (based on model sensitivities) + for c = 1 : nStates + index = ( nStates * (b-1) ) + c; + curJac = eval(sprintf( 'jacobian(obj(%d),s%d)', a, c ) ); + jac( a, b ) = jac( a, b ) + curJac * S(index,:).'; + end + + % Process partial derivatives directly with respect to the + % parameters + % do/dp + curJac = eval( sprintf( 'diff(obj(%d),p(%d))', a, b ) ); + jac(a,b) = jac(a,b) + curJac; + end + + % Objective function parameters (metapars) + for b = 1 : nObsPars + % Process derivatives w.r.t. parameters + curJac = eval( sprintf( 'diff(obj(%d),o(%d))', a, b ) ); + jac(a,b+nPars) = jac(a,b+nPars) + curJac; + end + + % Initial condition parameters + for b = 1 : nIcPars + % Process all partial derivatives with respect to the observables + % do/dx dx/dp (based on model sensitivities) + for c = 1 : nStates + index = ( nStates * (nPars+icPars(b)-1) ) + c; + curJac = eval(sprintf( 'jacobian(obj(%d),s%d)', a, c ) ); + jac( a, b+nPars+nObsPars ) = jac( a, b+nPars+nObsPars ) + curJac * S(index,:).'; + end + + % Process derivatives w.r.t. parameters + % curJac = eval( sprintf( 'diff(obj(%d),i(%d))', a, icPars(b) ) ); + % jac(a,b+nPars+nObsPars) = jac(a,b+nPars+nObsPars) + curJac; + end + end + + + disp( 'Writing C file for the jacobian' ) + jac = jac.'; + c_code = ccode( jac ); + %c_code = regexprep( c_code, 'jac\[(\d+)\]\[(\d+)\]', 'jac[($1)*(N_PARS+N_OBSPARS+N_ICPARS)+($2)]' ); + c_code = regexprep( c_code, 'jac\[(\d+)\]\[(\d+)\]', 'jac[($1)*(N_OBS)+($2)]' ); + c_code = regexprep( c_code, 's(\d+)_(\d+)', 's[($2-1)*N_STATES+($1-1)]' ); + c_code = regexprep( c_code, 'S_(\d+)_(\d+)', 'S[($2-1)*SENSDIM+($1-1)]' ); + c_code = regexprep( c_code, 'p(\d+)', 'p[$1-1]' ); + c_code = regexprep( c_code, 'u(\d+)', 'u[$1-1]' ); + c_code = regexprep( c_code, 'o(\d+)', 'p[N_PARS+$1-1]' ); + c_code = regexprep( c_code, 'i(\d+)', 'p[N_PARS+N_OBSPARS+$1-1]' ); + c_code = regexprep( c_code, 'data_(\d+)', 'd[$1-1]' ); + + fid = fopen( [observPath 'ccode/jac.c' ], 'w' ); + fprintf( fid, '#include "objfn.h"\n\n\nvoid jacobian(double *jac, double *s, double *p, double *d, double *u, double *S ) {\n%s\n}\n', c_code ); + fid = fclose( fid ); + + fid = fopen( [observPath 'ccode/jac.h'], 'w' ); + fprintf( fid, '#define CJAC\n\nvoid jacobian(double *obj, double *s, double *p, double *d, double *u, double *S );\n\n', nData, nPars, nStates, nObsPars, nObs, nTime ); + fid = fclose(fid); +else + fid = fopen( [observPath 'ccode/jac.h'], 'w' ); + fprintf( fid, '\n\n', nData, nPars, nStates, nObsPars, nObs, nTime ); + fid = fclose(fid); +end + +% Compiling C function(s) +disp( 'Compiling C functions' ); +compileObjective( obsName, cjac, observPath ); + +disp( 'Done!' ); + +% +% Joep Vanlier, 2012 +% +% Licensing: +% Copyright (C) 2009-2012 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/observerFunctions/printAsString.m b/odemex/observerFunctions/printAsString.m new file mode 100644 index 0000000..7845b72 --- /dev/null +++ b/odemex/observerFunctions/printAsString.m @@ -0,0 +1,37 @@ +function s = printAsString( list ) + + s = ''; + if ~isempty( list ) + s = sprintf( '%d', list(1) ); + for a = 2 : length( list ) + s = sprintf( '%s, %d', s, list(a) ); + end + end + +% +% Joep Vanlier, 2012 +% +% Licensing: +% Copyright (C) 2009-2012 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/observerFunctions/replaceWithIndex.m b/odemex/observerFunctions/replaceWithIndex.m new file mode 100644 index 0000000..0661a34 --- /dev/null +++ b/odemex/observerFunctions/replaceWithIndex.m @@ -0,0 +1,45 @@ +function s = replaceWithIndex( list, allpoints ) + + s = ''; + indices = []; + for a = 1 : length( list ) + for b = 1 : length( allpoints ) + if ( list(a) == allpoints(b) ) + indices(a) = b; + end + end + end + if ~isempty( indices ) + s = sprintf( '%d', indices(1) ); + for a = 2 : length( indices ) + s = sprintf( '%s, %d', s, indices(a) ); + end + end + +% +% Joep Vanlier, 2012 +% +% Licensing: +% Copyright (C) 2009-2012 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/observerFunctions/strtok2.m b/odemex/observerFunctions/strtok2.m new file mode 100644 index 0000000..57550e9 --- /dev/null +++ b/odemex/observerFunctions/strtok2.m @@ -0,0 +1,41 @@ +% Function that grabs a token, but shows you which chars were removed + +function [ token, remain, tokensLost ] = strtok2( string, tokens ) + + l = length( string ); + [ token, remain ] = strtok( string, tokens ); + + missing = length( string ) - length( token ) - length( remain ); + + tokensLost = string( 1 : missing ); + + + + +% +% Joep Vanlier, 2011 +% +% Licensing: +% Copyright (C) 2009-2011 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/observerFunctions/structIndices.m b/odemex/observerFunctions/structIndices.m new file mode 100644 index 0000000..7e58072 --- /dev/null +++ b/odemex/observerFunctions/structIndices.m @@ -0,0 +1,34 @@ +function [ indices ] = structIndices( struct ) + + names = fieldnames( struct ); + for a = 1 : length( names ) + indices(a) = getfield( struct, names{a} ); + end +end +% +% Joep Vanlier, 2012 +% +% Licensing: +% Copyright (C) 2009-2012 Joep Vanlier. All rights +% reserved. +% +% Contact:joep.vanlier@gmail.com +% +% This file is part of the puaMAT. +% +% puaMAT is free software: you can redistribute it +% and/or modify it under the terms of the GNU General +% Public License as published by the Free Software +% Foundation, either version 3 of the License, or (at +% your option) any later version. +% +% puaMAT is distributed in the hope that it will be +% useful, but WITHOUT ANY WARRANTY; without even the +% implied warranty of MERCHANTABILITY or FITNESS FOR A +% PARTICULAR PURPOSE. See the GNU General Public +% License for more details. +% +% You should have received a copy of the GNU General +% Public License along with puaMAT. If not, see +% http://www.gnu.org/licenses/ +% diff --git a/odemex/observerFunctions/useObserver.m b/odemex/observerFunctions/useObserver.m new file mode 100644 index 0000000..aabefcc --- /dev/null +++ b/odemex/observerFunctions/useObserver.m @@ -0,0 +1,9 @@ +function [f,J] = useObserver( obsFunc, simFunc, pars ) + +if nargout == 1 + [f] = feval( simFunc, pars ); + f = obsFunc( f, pars ); +else + [~, f, J] = feval( simFunc, pars ); + [f, J] = obsFunc( f, pars, J ); +end diff --git a/setup.m b/setup.m new file mode 100644 index 0000000..a36e582 --- /dev/null +++ b/setup.m @@ -0,0 +1,11 @@ +function setup() + +addpath(genpath('.')); + +disp('Added the AMF core folder and subfolders to path.'); + +try + matlabpool +catch err + fprintf('No parallel pool available.'); +end \ No newline at end of file diff --git a/temp/C_tiemannModel_ODE.m b/temp/C_tiemannModel_ODE.m new file mode 100644 index 0000000..f4e373b --- /dev/null +++ b/temp/C_tiemannModel_ODE.m @@ -0,0 +1,129 @@ +function dxdt = C_tiemannModel_ODE(t,x,p,u,m) + + +mwTG = m.c.mwTG; +mvTG = m.c.mvTG; +mwCE = m.c.mwCE; +mvCE = m.c.mvCE; +mwFC = m.c.mwFC; +mvFC = m.c.mvFC; +mwPL = m.c.mwPL; +mvPL = m.c.mvPL; +mwApoB = m.c.mwApoB; +navg = m.c.navg; +uH = m.c.uH; +plasma_volume = m.c.plasma_volume; +rs = m.c.rs; +npi = m.c.npi; + +hep_FC = x(m.s.hep_FC); +hep_CE = x(m.s.hep_CE); +hep_CE_ER = x(m.s.hep_CE_ER); +hep_TG = x(m.s.hep_TG); +hep_TG_ER = x(m.s.hep_TG_ER); +hep_TG_DNL = x(m.s.hep_TG_DNL); +hep_TG_ER_DNL = x(m.s.hep_TG_ER_DNL); +plasma_TG = x(m.s.plasma_TG); +plasma_C = x(m.s.plasma_C); +plasma_C_HDL = x(m.s.plasma_C_HDL); +plasma_FFA = x(m.s.plasma_FFA); + +Vm_FC_prod = p(m.p.Vm_FC_prod); +Vm_FC_met = p(m.p.Vm_FC_met); +Vm_CE_for = p(m.p.Vm_CE_for); +Vm_CE_def = p(m.p.Vm_CE_def); +Vm_CE_ER_for = p(m.p.Vm_CE_ER_for); +Vm_CE_ER_def = p(m.p.Vm_CE_ER_def); +Vm_TG_prod = p(m.p.Vm_TG_prod); +Vm_TG_met = p(m.p.Vm_TG_met); +Vm_TG_for = p(m.p.Vm_TG_for); +Vm_TG_ER_prod = p(m.p.Vm_TG_ER_prod); +Vm_TG_ER_for = p(m.p.Vm_TG_ER_for); +Vm_FFA_upt = p(m.p.Vm_FFA_upt); +Vm_FFA_prod = p(m.p.Vm_FFA_prod); +Vm_VLDL_TG = p(m.p.Vm_VLDL_TG); +Vm_VLDL_CE = p(m.p.Vm_VLDL_CE); +Vm_TG_CE_upt = p(m.p.Vm_TG_CE_upt); +Vm_TG_CE_upt_ph = p(m.p.Vm_TG_CE_upt_ph); +Vm_TG_hyd = p(m.p.Vm_TG_hyd); +Vm_TG_hyd_ph = p(m.p.Vm_TG_hyd_ph); +Vm_HDL_CE_for = p(m.p.Vm_HDL_CE_for); +Vm_HDL_CE_upt = p(m.p.Vm_HDL_CE_upt); +Vm_ApoB_prod = p(m.p.Vm_ApoB_prod); +Vm_TG_CE_upt_0 = p(m.p.Vm_TG_CE_upt_0); +Vm_TG_CE_upt_ph_0 = p(m.p.Vm_TG_CE_upt_ph_0); + +J_FC_production = Vm_FC_prod; +J_FC_metabolism = Vm_FC_met * hep_FC; +J_CE_formation = Vm_CE_for * hep_FC; +J_CE_deformation = Vm_CE_def * hep_CE; +J_CE_ER_formation = Vm_CE_ER_for * hep_FC; +J_CE_ER_deformation = Vm_CE_ER_def * hep_CE_ER; +J_TG_production = Vm_TG_prod; +J_TG_metabolism = Vm_TG_met * hep_TG; +J_TG_metabolism_DNL = Vm_TG_met * hep_TG_DNL; +J_TG_formation = Vm_TG_for * hep_TG_ER; +J_TG_formation_DNL = Vm_TG_for * hep_TG_ER_DNL; +J_TG_ER_production = Vm_TG_ER_prod; +J_TG_ER_formation = Vm_TG_ER_for * hep_TG; +J_TG_ER_formation_DNL = Vm_TG_ER_for * hep_TG_DNL; +J_FFA_upt_1 = Vm_FFA_upt * plasma_FFA; +J_FFA_upt_2 = Vm_FFA_upt * plasma_FFA * plasma_volume; +J_FFA_prod = Vm_FFA_prod; +J_VLDL_TG_1 = Vm_VLDL_TG * hep_TG_ER; +J_VLDL_TG_DNL_1 = Vm_VLDL_TG * hep_TG_ER_DNL; +J_VLDL_CE_1 = Vm_VLDL_CE * hep_CE_ER; +J_VLDL_TG_2 = Vm_VLDL_TG * hep_TG_ER / plasma_volume; +J_VLDL_TG_DNL_2 = Vm_VLDL_TG * hep_TG_ER_DNL / plasma_volume; +J_VLDL_CE_2 = Vm_VLDL_CE * hep_CE_ER / plasma_volume; +J_TG_upt_1 = Vm_TG_CE_upt * plasma_TG; +J_CE_upt_1 = Vm_TG_CE_upt * plasma_C; +J_TG_upt_ph = Vm_TG_CE_upt_ph * plasma_TG; +J_CE_upt_ph = Vm_TG_CE_upt_ph * plasma_C; +J_CE_HDL_for = Vm_HDL_CE_for; +J_CE_HDL_upt_1 = Vm_HDL_CE_upt * plasma_C_HDL; +J_TG_hyd_1 = Vm_TG_hyd * plasma_TG; +J_TG_hyd_ph = Vm_TG_hyd_ph * plasma_TG; +J_TG_upt_2 = Vm_TG_CE_upt * plasma_TG * plasma_volume; +J_CE_upt_2 = Vm_TG_CE_upt * plasma_C * plasma_volume; +J_CE_HDL_upt_2 = Vm_HDL_CE_upt * plasma_C_HDL * plasma_volume; +J_TG_hyd_2 = Vm_TG_hyd * plasma_TG * plasma_volume; +J_VLDL_TG = Vm_VLDL_TG * (hep_TG_ER + hep_TG_ER_DNL); +J_VLDL_CE = Vm_VLDL_CE * hep_CE_ER; +J_ApoB_prod = Vm_ApoB_prod; +ApoB_count = J_ApoB_prod * navg * 10^23 * 10^-6; +TG_count = J_VLDL_TG * navg * 10^23 * 10^-6 / ApoB_count; +CE_count = J_VLDL_CE * navg * 10^23 * 10^-6 / ApoB_count; +DNL = (hep_TG_DNL + hep_TG_ER_DNL) / (hep_TG + hep_TG_ER + hep_TG_DNL + hep_TG_ER_DNL); +lipo_vc = ( (TG_count * mvTG) + (CE_count * mvCE) ) * (pow(10,21) / (navg * 10^23)); +lipo_rc = pow((3 * lipo_vc) / (4 * npi), 1/3); +VLDL_diameter = (lipo_vc + lipo_rc) * 2; +VLDL_clearance = (Vm_TG_CE_upt + Vm_TG_CE_upt_ph) / (Vm_TG_CE_upt_0 + Vm_TG_CE_upt_ph_0); +J_CE_HDL_upt = Vm_HDL_CE_upt * plasma_C_HDL; +dhep_TG_abs = hep_TG + hep_TG_ER + hep_TG_DNL + hep_TG_ER_DNL; +dhep_CE_abs = hep_CE + hep_CE_ER; +dhep_FC_abs = hep_FC; +dplasma_C = plasma_C + plasma_C_HDL; +dplasma_TG = plasma_TG; +dVLDL_TG_C_ratio = TG_count / CE_count; +dVLDL_diameter = VLDL_diameter; +dVLDL_production = J_VLDL_TG; +dVLDL_clearance = VLDL_clearance; +dDNL = DNL; +dFFA = plasma_FFA; +dplasma_C_HDL = plasma_C_HDL; +dhep_HDL_CE_upt = J_CE_HDL_upt * plasma_volume; + +dxdt(1) = J_FC_production - J_FC_metabolism - J_CE_formation + J_CE_deformation - J_CE_ER_formation + J_CE_ER_deformation; +dxdt(2) = J_CE_formation - J_CE_deformation + J_CE_upt_2 + J_CE_HDL_upt_2; +dxdt(3) = J_CE_ER_formation - J_CE_ER_deformation - J_VLDL_CE_1; +dxdt(4) = - J_TG_metabolism + J_TG_formation - J_TG_ER_formation + (J_FFA_upt_2/3.0) + J_TG_upt_2 + J_TG_hyd_2; +dxdt(5) = - J_TG_formation + J_TG_ER_formation - J_VLDL_TG_1; +dxdt(6) = J_TG_production - J_TG_metabolism_DNL + J_TG_formation_DNL - J_TG_ER_formation_DNL; +dxdt(7) = J_TG_ER_production - J_TG_formation_DNL + J_TG_ER_formation_DNL - J_VLDL_TG_DNL_1; +dxdt(8) = J_VLDL_TG_2 + J_VLDL_TG_DNL_2 - J_TG_upt_1 - J_TG_upt_ph - J_TG_hyd_1 - J_TG_hyd_ph; +dxdt(9) = J_VLDL_CE_2 - J_CE_upt_1 - J_CE_upt_ph; +dxdt(10) = J_CE_HDL_for - J_CE_HDL_upt_1; +dxdt(11) = J_FFA_prod - J_FFA_upt_1; + +dxdt = dxdt(:); \ No newline at end of file diff --git a/temp/C_tiemannModel_ODEC.mexw64 b/temp/C_tiemannModel_ODEC.mexw64 new file mode 100644 index 0000000..3daa2a7 Binary files /dev/null and b/temp/C_tiemannModel_ODEC.mexw64 differ diff --git a/temp/C_tiemannModel_ODEMEX.m b/temp/C_tiemannModel_ODEMEX.m new file mode 100644 index 0000000..e2ac3f1 --- /dev/null +++ b/temp/C_tiemannModel_ODEMEX.m @@ -0,0 +1,129 @@ +function dxdt = C_tiemannModel_ODEMEX(t,x,p,u,m) + + +mwTG = m.c.mwTG; +mvTG = m.c.mvTG; +mwCE = m.c.mwCE; +mvCE = m.c.mvCE; +mwFC = m.c.mwFC; +mvFC = m.c.mvFC; +mwPL = m.c.mwPL; +mvPL = m.c.mvPL; +mwApoB = m.c.mwApoB; +navg = m.c.navg; +uH = m.c.uH; +plasma_volume = m.c.plasma_volume; +rs = m.c.rs; +npi = m.c.npi; + +hep_FC = x(m.s.hep_FC); +hep_CE = x(m.s.hep_CE); +hep_CE_ER = x(m.s.hep_CE_ER); +hep_TG = x(m.s.hep_TG); +hep_TG_ER = x(m.s.hep_TG_ER); +hep_TG_DNL = x(m.s.hep_TG_DNL); +hep_TG_ER_DNL = x(m.s.hep_TG_ER_DNL); +plasma_TG = x(m.s.plasma_TG); +plasma_C = x(m.s.plasma_C); +plasma_C_HDL = x(m.s.plasma_C_HDL); +plasma_FFA = x(m.s.plasma_FFA); + +Vm_FC_prod = p(m.p.Vm_FC_prod); +Vm_FC_met = p(m.p.Vm_FC_met); +Vm_CE_for = p(m.p.Vm_CE_for); +Vm_CE_def = p(m.p.Vm_CE_def); +Vm_CE_ER_for = p(m.p.Vm_CE_ER_for); +Vm_CE_ER_def = p(m.p.Vm_CE_ER_def); +Vm_TG_prod = p(m.p.Vm_TG_prod); +Vm_TG_met = p(m.p.Vm_TG_met); +Vm_TG_for = p(m.p.Vm_TG_for); +Vm_TG_ER_prod = p(m.p.Vm_TG_ER_prod); +Vm_TG_ER_for = p(m.p.Vm_TG_ER_for); +Vm_FFA_upt = p(m.p.Vm_FFA_upt); +Vm_FFA_prod = p(m.p.Vm_FFA_prod); +Vm_VLDL_TG = p(m.p.Vm_VLDL_TG); +Vm_VLDL_CE = p(m.p.Vm_VLDL_CE); +Vm_TG_CE_upt = p(m.p.Vm_TG_CE_upt); +Vm_TG_CE_upt_ph = p(m.p.Vm_TG_CE_upt_ph); +Vm_TG_hyd = p(m.p.Vm_TG_hyd); +Vm_TG_hyd_ph = p(m.p.Vm_TG_hyd_ph); +Vm_HDL_CE_for = p(m.p.Vm_HDL_CE_for); +Vm_HDL_CE_upt = p(m.p.Vm_HDL_CE_upt); +Vm_ApoB_prod = p(m.p.Vm_ApoB_prod); +Vm_TG_CE_upt_0 = p(m.p.Vm_TG_CE_upt_0); +Vm_TG_CE_upt_ph_0 = p(m.p.Vm_TG_CE_upt_ph_0); + +J_FC_production = Vm_FC_prod; +J_FC_metabolism = Vm_FC_met * hep_FC; +J_CE_formation = Vm_CE_for * hep_FC; +J_CE_deformation = Vm_CE_def * hep_CE; +J_CE_ER_formation = Vm_CE_ER_for * hep_FC; +J_CE_ER_deformation = Vm_CE_ER_def * hep_CE_ER; +J_TG_production = Vm_TG_prod; +J_TG_metabolism = Vm_TG_met * hep_TG; +J_TG_metabolism_DNL = Vm_TG_met * hep_TG_DNL; +J_TG_formation = Vm_TG_for * hep_TG_ER; +J_TG_formation_DNL = Vm_TG_for * hep_TG_ER_DNL; +J_TG_ER_production = Vm_TG_ER_prod; +J_TG_ER_formation = Vm_TG_ER_for * hep_TG; +J_TG_ER_formation_DNL = Vm_TG_ER_for * hep_TG_DNL; +J_FFA_upt_1 = Vm_FFA_upt * plasma_FFA; +J_FFA_upt_2 = Vm_FFA_upt * plasma_FFA * plasma_volume; +J_FFA_prod = Vm_FFA_prod; +J_VLDL_TG_1 = Vm_VLDL_TG * hep_TG_ER; +J_VLDL_TG_DNL_1 = Vm_VLDL_TG * hep_TG_ER_DNL; +J_VLDL_CE_1 = Vm_VLDL_CE * hep_CE_ER; +J_VLDL_TG_2 = Vm_VLDL_TG * hep_TG_ER / plasma_volume; +J_VLDL_TG_DNL_2 = Vm_VLDL_TG * hep_TG_ER_DNL / plasma_volume; +J_VLDL_CE_2 = Vm_VLDL_CE * hep_CE_ER / plasma_volume; +J_TG_upt_1 = Vm_TG_CE_upt * plasma_TG; +J_CE_upt_1 = Vm_TG_CE_upt * plasma_C; +J_TG_upt_ph = Vm_TG_CE_upt_ph * plasma_TG; +J_CE_upt_ph = Vm_TG_CE_upt_ph * plasma_C; +J_CE_HDL_for = Vm_HDL_CE_for; +J_CE_HDL_upt_1 = Vm_HDL_CE_upt * plasma_C_HDL; +J_TG_hyd_1 = Vm_TG_hyd * plasma_TG; +J_TG_hyd_ph = Vm_TG_hyd_ph * plasma_TG; +J_TG_upt_2 = Vm_TG_CE_upt * plasma_TG * plasma_volume; +J_CE_upt_2 = Vm_TG_CE_upt * plasma_C * plasma_volume; +J_CE_HDL_upt_2 = Vm_HDL_CE_upt * plasma_C_HDL * plasma_volume; +J_TG_hyd_2 = Vm_TG_hyd * plasma_TG * plasma_volume; +J_VLDL_TG = Vm_VLDL_TG * (hep_TG_ER + hep_TG_ER_DNL); +J_VLDL_CE = Vm_VLDL_CE * hep_CE_ER; +J_ApoB_prod = Vm_ApoB_prod; +ApoB_count = J_ApoB_prod * navg * pow(10,23) * pow(10,-6); +TG_count = J_VLDL_TG * navg * pow(10,23) * pow(10,-6) / ApoB_count; +CE_count = J_VLDL_CE * navg * pow(10,23) * pow(10,-6) / ApoB_count; +DNL = (hep_TG_DNL + hep_TG_ER_DNL) / (hep_TG + hep_TG_ER + hep_TG_DNL + hep_TG_ER_DNL); +lipo_vc = ( (TG_count * mvTG) + (CE_count * mvCE) ) * (pow(10,21) / (navg * pow(10,23))); +lipo_rc = pow((3 * lipo_vc) / (4 * npi), 1/3); +VLDL_diameter = (lipo_vc + lipo_rc) * 2; +VLDL_clearance = (Vm_TG_CE_upt + Vm_TG_CE_upt_ph) / (Vm_TG_CE_upt_0 + Vm_TG_CE_upt_ph_0); +J_CE_HDL_upt = Vm_HDL_CE_upt * plasma_C_HDL; +dhep_TG_abs = hep_TG + hep_TG_ER + hep_TG_DNL + hep_TG_ER_DNL; +dhep_CE_abs = hep_CE + hep_CE_ER; +dhep_FC_abs = hep_FC; +dplasma_C = plasma_C + plasma_C_HDL; +dplasma_TG = plasma_TG; +dVLDL_TG_C_ratio = TG_count / CE_count; +dVLDL_diameter = VLDL_diameter; +dVLDL_production = J_VLDL_TG; +dVLDL_clearance = VLDL_clearance; +dDNL = DNL; +dFFA = plasma_FFA; +dplasma_C_HDL = plasma_C_HDL; +dhep_HDL_CE_upt = J_CE_HDL_upt * plasma_volume; + +dxdt(1) = J_FC_production - J_FC_metabolism - J_CE_formation + J_CE_deformation - J_CE_ER_formation + J_CE_ER_deformation; +dxdt(2) = J_CE_formation - J_CE_deformation + J_CE_upt_2 + J_CE_HDL_upt_2; +dxdt(3) = J_CE_ER_formation - J_CE_ER_deformation - J_VLDL_CE_1; +dxdt(4) = - J_TG_metabolism + J_TG_formation - J_TG_ER_formation + (J_FFA_upt_2/3.0) + J_TG_upt_2 + J_TG_hyd_2; +dxdt(5) = - J_TG_formation + J_TG_ER_formation - J_VLDL_TG_1; +dxdt(6) = J_TG_production - J_TG_metabolism_DNL + J_TG_formation_DNL - J_TG_ER_formation_DNL; +dxdt(7) = J_TG_ER_production - J_TG_formation_DNL + J_TG_ER_formation_DNL - J_VLDL_TG_DNL_1; +dxdt(8) = J_VLDL_TG_2 + J_VLDL_TG_DNL_2 - J_TG_upt_1 - J_TG_upt_ph - J_TG_hyd_1 - J_TG_hyd_ph; +dxdt(9) = J_VLDL_CE_2 - J_CE_upt_1 - J_CE_upt_ph; +dxdt(10) = J_CE_HDL_for - J_CE_HDL_upt_1; +dxdt(11) = J_FFA_prod - J_FFA_upt_1; + +dxdt = dxdt(:); \ No newline at end of file diff --git a/temp/C_tiemannModel_REACTIONS.m b/temp/C_tiemannModel_REACTIONS.m new file mode 100644 index 0000000..58b73b1 --- /dev/null +++ b/temp/C_tiemannModel_REACTIONS.m @@ -0,0 +1,176 @@ +function v = C_tiemannModel_REACTIONS(t,x,p,u,m) + + +mwTG = m.c.mwTG; +mvTG = m.c.mvTG; +mwCE = m.c.mwCE; +mvCE = m.c.mvCE; +mwFC = m.c.mwFC; +mvFC = m.c.mvFC; +mwPL = m.c.mwPL; +mvPL = m.c.mvPL; +mwApoB = m.c.mwApoB; +navg = m.c.navg; +uH = m.c.uH; +plasma_volume = m.c.plasma_volume; +rs = m.c.rs; +npi = m.c.npi; + +hep_FC = x(m.s.hep_FC); +hep_CE = x(m.s.hep_CE); +hep_CE_ER = x(m.s.hep_CE_ER); +hep_TG = x(m.s.hep_TG); +hep_TG_ER = x(m.s.hep_TG_ER); +hep_TG_DNL = x(m.s.hep_TG_DNL); +hep_TG_ER_DNL = x(m.s.hep_TG_ER_DNL); +plasma_TG = x(m.s.plasma_TG); +plasma_C = x(m.s.plasma_C); +plasma_C_HDL = x(m.s.plasma_C_HDL); +plasma_FFA = x(m.s.plasma_FFA); + +Vm_FC_prod = p(m.p.Vm_FC_prod); +Vm_FC_met = p(m.p.Vm_FC_met); +Vm_CE_for = p(m.p.Vm_CE_for); +Vm_CE_def = p(m.p.Vm_CE_def); +Vm_CE_ER_for = p(m.p.Vm_CE_ER_for); +Vm_CE_ER_def = p(m.p.Vm_CE_ER_def); +Vm_TG_prod = p(m.p.Vm_TG_prod); +Vm_TG_met = p(m.p.Vm_TG_met); +Vm_TG_for = p(m.p.Vm_TG_for); +Vm_TG_ER_prod = p(m.p.Vm_TG_ER_prod); +Vm_TG_ER_for = p(m.p.Vm_TG_ER_for); +Vm_FFA_upt = p(m.p.Vm_FFA_upt); +Vm_FFA_prod = p(m.p.Vm_FFA_prod); +Vm_VLDL_TG = p(m.p.Vm_VLDL_TG); +Vm_VLDL_CE = p(m.p.Vm_VLDL_CE); +Vm_TG_CE_upt = p(m.p.Vm_TG_CE_upt); +Vm_TG_CE_upt_ph = p(m.p.Vm_TG_CE_upt_ph); +Vm_TG_hyd = p(m.p.Vm_TG_hyd); +Vm_TG_hyd_ph = p(m.p.Vm_TG_hyd_ph); +Vm_HDL_CE_for = p(m.p.Vm_HDL_CE_for); +Vm_HDL_CE_upt = p(m.p.Vm_HDL_CE_upt); +Vm_ApoB_prod = p(m.p.Vm_ApoB_prod); +Vm_TG_CE_upt_0 = p(m.p.Vm_TG_CE_upt_0); +Vm_TG_CE_upt_ph_0 = p(m.p.Vm_TG_CE_upt_ph_0); + +J_FC_production = Vm_FC_prod; +J_FC_metabolism = Vm_FC_met * hep_FC; +J_CE_formation = Vm_CE_for * hep_FC; +J_CE_deformation = Vm_CE_def * hep_CE; +J_CE_ER_formation = Vm_CE_ER_for * hep_FC; +J_CE_ER_deformation = Vm_CE_ER_def * hep_CE_ER; +J_TG_production = Vm_TG_prod; +J_TG_metabolism = Vm_TG_met * hep_TG; +J_TG_metabolism_DNL = Vm_TG_met * hep_TG_DNL; +J_TG_formation = Vm_TG_for * hep_TG_ER; +J_TG_formation_DNL = Vm_TG_for * hep_TG_ER_DNL; +J_TG_ER_production = Vm_TG_ER_prod; +J_TG_ER_formation = Vm_TG_ER_for * hep_TG; +J_TG_ER_formation_DNL = Vm_TG_ER_for * hep_TG_DNL; +J_FFA_upt_1 = Vm_FFA_upt * plasma_FFA; +J_FFA_upt_2 = Vm_FFA_upt * plasma_FFA * plasma_volume; +J_FFA_prod = Vm_FFA_prod; +J_VLDL_TG_1 = Vm_VLDL_TG * hep_TG_ER; +J_VLDL_TG_DNL_1 = Vm_VLDL_TG * hep_TG_ER_DNL; +J_VLDL_CE_1 = Vm_VLDL_CE * hep_CE_ER; +J_VLDL_TG_2 = Vm_VLDL_TG * hep_TG_ER / plasma_volume; +J_VLDL_TG_DNL_2 = Vm_VLDL_TG * hep_TG_ER_DNL / plasma_volume; +J_VLDL_CE_2 = Vm_VLDL_CE * hep_CE_ER / plasma_volume; +J_TG_upt_1 = Vm_TG_CE_upt * plasma_TG; +J_CE_upt_1 = Vm_TG_CE_upt * plasma_C; +J_TG_upt_ph = Vm_TG_CE_upt_ph * plasma_TG; +J_CE_upt_ph = Vm_TG_CE_upt_ph * plasma_C; +J_CE_HDL_for = Vm_HDL_CE_for; +J_CE_HDL_upt_1 = Vm_HDL_CE_upt * plasma_C_HDL; +J_TG_hyd_1 = Vm_TG_hyd * plasma_TG; +J_TG_hyd_ph = Vm_TG_hyd_ph * plasma_TG; +J_TG_upt_2 = Vm_TG_CE_upt * plasma_TG * plasma_volume; +J_CE_upt_2 = Vm_TG_CE_upt * plasma_C * plasma_volume; +J_CE_HDL_upt_2 = Vm_HDL_CE_upt * plasma_C_HDL * plasma_volume; +J_TG_hyd_2 = Vm_TG_hyd * plasma_TG * plasma_volume; +J_VLDL_TG = Vm_VLDL_TG * (hep_TG_ER + hep_TG_ER_DNL); +J_VLDL_CE = Vm_VLDL_CE * hep_CE_ER; +J_ApoB_prod = Vm_ApoB_prod; +ApoB_count = J_ApoB_prod * navg * pow(10,23) * pow(10,-6); +TG_count = J_VLDL_TG * navg * pow(10,23) * pow(10,-6) / ApoB_count; +CE_count = J_VLDL_CE * navg * pow(10,23) * pow(10,-6) / ApoB_count; +DNL = (hep_TG_DNL + hep_TG_ER_DNL) / (hep_TG + hep_TG_ER + hep_TG_DNL + hep_TG_ER_DNL); +lipo_vc = ( (TG_count * mvTG) + (CE_count * mvCE) ) * (pow(10,21) / (navg * pow(10,23))); +lipo_rc = pow((3 * lipo_vc) / (4 * npi), 1/3); +VLDL_diameter = (lipo_vc + lipo_rc) * 2; +VLDL_clearance = (Vm_TG_CE_upt + Vm_TG_CE_upt_ph) / (Vm_TG_CE_upt_0 + Vm_TG_CE_upt_ph_0); +J_CE_HDL_upt = Vm_HDL_CE_upt * plasma_C_HDL; +dhep_TG_abs = hep_TG + hep_TG_ER + hep_TG_DNL + hep_TG_ER_DNL; +dhep_CE_abs = hep_CE + hep_CE_ER; +dhep_FC_abs = hep_FC; +dplasma_C = plasma_C + plasma_C_HDL; +dplasma_TG = plasma_TG; +dVLDL_TG_C_ratio = TG_count / CE_count; +dVLDL_diameter = VLDL_diameter; +dVLDL_production = J_VLDL_TG; +dVLDL_clearance = VLDL_clearance; +dDNL = DNL; +dFFA = plasma_FFA; +dplasma_C_HDL = plasma_C_HDL; +dhep_HDL_CE_upt = J_CE_HDL_upt * plasma_volume; + +v(1) = J_FC_production; +v(2) = J_FC_metabolism; +v(3) = J_CE_formation; +v(4) = J_CE_deformation; +v(5) = J_CE_ER_formation; +v(6) = J_CE_ER_deformation; +v(7) = J_TG_production; +v(8) = J_TG_metabolism; +v(9) = J_TG_metabolism_DNL; +v(10) = J_TG_formation; +v(11) = J_TG_formation_DNL; +v(12) = J_TG_ER_production; +v(13) = J_TG_ER_formation; +v(14) = J_TG_ER_formation_DNL; +v(15) = J_FFA_upt_1; +v(16) = J_FFA_upt_2; +v(17) = J_FFA_prod; +v(18) = J_VLDL_TG_1; +v(19) = J_VLDL_TG_DNL_1; +v(20) = J_VLDL_CE_1; +v(21) = J_VLDL_TG_2; +v(22) = J_VLDL_TG_DNL_2; +v(23) = J_VLDL_CE_2; +v(24) = J_TG_upt_1; +v(25) = J_CE_upt_1; +v(26) = J_TG_upt_ph; +v(27) = J_CE_upt_ph; +v(28) = J_CE_HDL_for; +v(29) = J_CE_HDL_upt_1; +v(30) = J_TG_hyd_1; +v(31) = J_TG_hyd_ph; +v(32) = J_TG_upt_2; +v(33) = J_CE_upt_2; +v(34) = J_CE_HDL_upt_2; +v(35) = J_TG_hyd_2; +v(36) = J_VLDL_TG; +v(37) = J_VLDL_CE; +v(38) = J_ApoB_prod; +v(39) = ApoB_count; +v(40) = TG_count; +v(41) = CE_count; +v(42) = DNL; +v(43) = lipo_vc; +v(44) = lipo_rc; +v(45) = VLDL_diameter; +v(46) = VLDL_clearance; +v(47) = J_CE_HDL_upt; +v(48) = dhep_TG_abs; +v(49) = dhep_CE_abs; +v(50) = dhep_FC_abs; +v(51) = dplasma_C; +v(52) = dplasma_TG; +v(53) = dVLDL_TG_C_ratio; +v(54) = dVLDL_diameter; +v(55) = dVLDL_production; +v(56) = dVLDL_clearance; +v(57) = dDNL; +v(58) = dFFA; +v(59) = dplasma_C_HDL; +v(60) = dhep_HDL_CE_upt;