function [u,edge,eqn,info] = Maxwellsaddle(node,elem,HB,pde,bdFlag,option)
%% MAXWELL Maxwell equation: lowest order edge element.
%
% u = Maxwellsaddle(node,elem,HB,pde,bdFlag) produces the lowest order edge
%   element approximation of the electric field of the time harmonic
%   Maxwell equation.
%
%                     curl(mu^(-1)curl u)  = J    in \Omega,
%                                  div  u  = 0
%                                   n � u = n � g_D  on \Gamma_D,
%                     n � (mu^(-1)curl u) = n � g_N  on \Gamma_N.
%
% based on the weak formulation
%
% (mu^{-1}curl u, curl v) +(grad p ,v)= (J,v) - <n � g_N,v>_{\Gamma_N}.
% (u,grad q)                          = 0
% Assume P\in H_0^1.
% The data of the equation is enclosed in the pde structure:
%   - pde.mu      : permeability, i.e., magnetic constant/tensor
%   - pde.omega   : wave number
%   - pde.J       : current density
%   - pde.g_D     : Dirichlet boundary condition
%   - pde.g_N     : Neumann boundary condition
%
% The mesh is given by (node,elem) and HB is needed for fast solvers. The
% boundary faces is specified by bdFlag; see bddoc.
%
% The function Maxwell assembes the matrix equation (A-M)*u = b and solves
% it by the direct solver (small size dof <= 2e3) or the HX preconditioned
% Krylov iterative methods (large size dof > 2e3).
%
% u = Maxwellsaddle(node,elem,HB,pde,bdFlag,option) specifies the solver options.
%   - option.solver == 'direct': the built in direct solver \ (mldivide)
%   - option.solver == 'mg':     multigrid-type solvers mg is used.
%   - option.solver == 'notsolve': the solution u = u_D.
% The default setting is to use the direct solver for small size problems
% and multigrid solvers for large size problems. For more options on the
% multigrid solver mg, type help mg.
%
% [u,edge] = Maxwellsaddle(node,elem,pde,bdEdge) returns also the edge array
% which is essential for edge elements.
%
% [u,edge,eqn] = Maxwellsaddle(node,elem,pde,bdEdge) returns also the equation
% structure eqn, which includes:
% - eqn.A: matrix for differential operator;
% - eqn.M: mass matrix;
% - eqn.f: right hand side
% - eqn.g: vector enclosed the Neumann boundary condition
%
% [u,edge,eqn,info] = Maxwellsaddle(node,elem,pde,bdEdge) returns also the
% information on the assembeling and solver, which includes:
% - info.assembleTime: time to assemble the matrix equation
% - info.solverTime:   time to solve the matrix equation
% - info.itStep:       number of iteration steps for the mg solver
% - info.error:        l2 norm of the residual b - A*u
% - info.flag:         flag for the mg solver.
%   flag = 0: converge within max iteration
%   flag = 1: iterated maxIt times but did not converge
%   flag = 2: direct solver
%   flag = 3: no solve
%
% Example
%   cubeMaxwell
%
% See also Maxwell1, Maxwell2, cubeMaxwell, mgMaxwell
%
% Reference page in Help browser
%       Maxwelldoc
%
% Created by Jie Zhou based on Maxwell(node,elem,pde,bdEdge) on
% 09,Sep,2013.
% Copyright (C) Long Chen. See COPYRIGHT.txt for details.

%% Set up optional input arguments
if ~exist('bdFlag','var'), bdFlag = []; end
if ~exist('option','var'), option = []; end

%% Sort elem to ascend ordering
[elem,bdFlag] = sortelem3(elem,bdFlag);

%% Construct Data Structure
[elem2dof,edge] = dof3edge(elem);
locEdge = [1 2; 1 3; 1 4; 2 3; 2 4; 3 4];
N = size(node,1);   NT = size(elem,1);  Ne = size(edge,1);

%% Compute coefficients
if ~isfield(pde,'mu'), pde.mu = 1; end
if ~isempty(pde.mu) && isnumeric(pde.mu)
    mu = pde.mu;                % mu is an array
else                            % mu is a function
    center = (node(elem(:,1),:) + node(elem(:,2),:) + ...
              node(elem(:,3),:) + node(elem(:,4),:))/4;
    mu = pde.mu(center);
end
if ~isfield(pde,'epsilon'), pde.epsilon = 0; end
if ~isempty(pde.epsilon) && isnumeric(pde.epsilon)
    epsilon = pde.epsilon;      % epsilon is an array
else                            % epsilon is a function
    center = (node(elem(:,1),:) + node(elem(:,2),:) + ...
              node(elem(:,3),:) + node(elem(:,4),:))/4;
    epsilon = pde.epsilon(center);
end
if isfield(pde,'omega')
    omega = pde.omega;
else
    omega = 1;
end
epsilon = omega^2*epsilon;

tstart = tic;
%% Element-wise basis
% edge indices of 6 local bases:
% [1 2], [1 3], [1 4], [2 3], [2 4], [3 4]
% phi = lambda_iDlambda_j - lambda_jDlambda_i;
% curl phi = 2*Dlambda_i � Dlambda_j;
[Dlambda,volume] = gradbasis3(node,elem);
curlPhi(:,:,6) = 2*mycross(Dlambda(:,:,3),Dlambda(:,:,4),2);
curlPhi(:,:,1) = 2*mycross(Dlambda(:,:,1),Dlambda(:,:,2),2);
curlPhi(:,:,2) = 2*mycross(Dlambda(:,:,1),Dlambda(:,:,3),2);
curlPhi(:,:,3) = 2*mycross(Dlambda(:,:,1),Dlambda(:,:,4),2);
curlPhi(:,:,4) = 2*mycross(Dlambda(:,:,2),Dlambda(:,:,3),2);
curlPhi(:,:,5) = 2*mycross(Dlambda(:,:,2),Dlambda(:,:,4),2);
DiDj = zeros(NT,4,4);
for i = 1:4
    for j = i:4
        DiDj(:,i,j) = dot(Dlambda(:,:,i),Dlambda(:,:,j),2);
        DiDj(:,j,i) = DiDj(:,i,j);
    end
end

%% Assemble matrices
ii = zeros(21*NT,1); jj = zeros(21*NT,1);
sA = zeros(21*NT,1); sM = zeros(21*NT,1);
index = 0;
for i = 1:6
    for j = i:6
        % local to global index map
        % curl-curl matrix
        Aij = dot(curlPhi(:,:,i),curlPhi(:,:,j),2).*volume./mu;
        ii(index+1:index+NT) = double(elem2dof(:,i));
        jj(index+1:index+NT) = double(elem2dof(:,j));
        sA(index+1:index+NT) = Aij;
        % mass matrix
        % locEdge = [1 2; 1 3; 1 4; 2 3; 2 4; 3 4];
        i1 = locEdge(i,1); i2 = locEdge(i,2);
        j1 = locEdge(j,1); j2 = locEdge(j,2);
        Mij = 1/20*volume.*( (1+(i1==j1))*DiDj(:,i2,j2) ...
                           - (1+(i1==j2))*DiDj(:,i2,j1) ...
                           - (1+(i2==j1))*DiDj(:,i1,j2) ...
                           + (1+(i2==j2))*DiDj(:,i1,j1));
        %Mij = Mij.*epsilon;
        sM(index+1:index+NT) = Mij;
        index = index + NT;
    end
end
clear curlPhi % clear large size data
diagIdx = (ii == jj);   upperIdx = ~diagIdx;
A = sparse(ii(diagIdx),jj(diagIdx),sA(diagIdx),Ne,Ne);
AU = sparse(ii(upperIdx),jj(upperIdx),sA(upperIdx),Ne,Ne);
A = A + AU + AU';
M = sparse(ii(diagIdx),jj(diagIdx),sM(diagIdx),Ne,Ne);
MU = sparse(ii(upperIdx),jj(upperIdx),sM(upperIdx),Ne,Ne);
M = M + MU + MU';
grad =icdmat(double(edge),[-1,1]);
G    = grad'*M;

% bigA = A + M;

%% Assemble right hand side
f = zeros(Ne,1);
if ~isfield(pde,'J') || (isfield(pde,'J') && isreal(pde.J) && all(pde.J==0))
    pde.J = [];
end
if ~isfield(option,'fquadorder')
    option.fquadorder = 2;   % default order is 3
end
if isfield(pde,'J') && ~isempty(pde.J)
    [lambda,w] = quadpts3(option.fquadorder);
    nQuad = size(lambda,1);
    bt = zeros(NT,6);
    for p = 1:nQuad
        % quadrature points in the x-y-z coordinate
        pxyz = lambda(p,1)*node(elem(:,1),:) ...
             + lambda(p,2)*node(elem(:,2),:) ...
             + lambda(p,3)*node(elem(:,3),:) ...
             + lambda(p,4)*node(elem(:,4),:);
        Jp = pde.J(pxyz);
    %   locEdge = [1 2; 1 3; 1 4; 2 3; 2 4; 3 4];
        for k = 1:6
            i = locEdge(k,1); j = locEdge(k,2);
            % phi_k = lambda_iDlambda_j - lambda_jDlambda_i;
            phi_k = lambda(p,i)*Dlambda(:,:,j)-lambda(p,j)*Dlambda(:,:,i);
            rhs = dot(phi_k,Jp,2);
            bt(:,k) = bt(:,k) + w(p)*rhs;
        end
    end
    bt = bt.*repmat(volume,1,6);
    f = accumarray(elem2dof(:),bt(:),[Ne 1]);
end
clear pxyz Jp bt rhs phi_k

%% Set up solver
if isempty(option) || ~isfield(option,'solver')    % no option.solver
    if Ne <= 1e4  % Direct solver for small size systems
        option.solver = 'direct';
    else            % Multigrid-type  solver for large size systems
        option.solver = 'cg';
    end
end
solver = option.solver;

%% Assembeling corresponding matrices for HX preconditioner
if ~strcmp(solver,'direct') && ~strcmp(solver,'nosolve')
    AP = sparse(N,N);  % AP = - div(mu^{-1}grad) + |Re(epsilon)| I
    BP = sparse(N,N);  % BP = - div(|Re(epsilon)|grad)
    for i = 1:4
        for j = i:4
            temp = DiDj(:,i,j).*volume;
            Aij = 1./mu.*temp;
            Bij = abs(real(epsilon)).*temp;
            Mij = 1/20*abs(real(epsilon)).*volume;
            if (j==i)
                AP = AP + sparse(elem(:,i),elem(:,j),Aij+2*Mij,N,N);
                BP = BP + sparse(elem(:,i),elem(:,j),Bij,N,N);
            else
                AP = AP + sparse([elem(:,i);elem(:,j)],[elem(:,j);elem(:,i)],...
                                 [Aij+Mij; Aij+Mij],N,N);
                BP = BP + sparse([elem(:,i);elem(:,j)],[elem(:,j);elem(:,i)],...
                                 [Bij; Bij],N,N);
            end
        end
    end
end
clear Aij Bij Mij

%% Boundary conditions
if ~isfield(pde,'g_D'), pde.g_D = []; end
if ~isfield(pde,'g_N'), pde.g_N = []; end
if ~isfield(pde,'g_R'), pde.g_R = []; end
if (isempty(pde.g_D) && isempty(pde.g_N) && isempty(pde.g_R))
    % no boundary data is given = homogenous Neumann boundary condition
    bdFlag = [];
end

%% Part 1: Find Dirichlet dof and modify the matrix
% Find Dirichlet boundary dof: fixedDof
isBdEdge = [];
if isempty(bdFlag) && ~isempty(pde.g_D) && isempty(pde.g_N)
    % Dirichlet boundary condition only
    bdFlag = setboundary3(node,elem,'Dirichlet');
end
if ~isempty(bdFlag)
    % Find boundary edges and nodes
    isBdEdge = false(Ne,1);
    isBdNode = false(N,1);
    isBdEdge(elem2dof(bdFlag(:,1) == 1,[4,5,6])) = true;
    isBdEdge(elem2dof(bdFlag(:,2) == 1,[2,3,6])) = true;
    isBdEdge(elem2dof(bdFlag(:,3) == 1,[1,3,5])) = true;
    isBdEdge(elem2dof(bdFlag(:,4) == 1,[1,2,4])) = true;
    bdEdge = edge(isBdEdge,:);
    isBdNode(bdEdge) = true;
end
% modify the matrix to include the Dirichlet boundary condition
if any(isBdEdge)  % contains Dirichlet boundary condition
    bdidx = zeros(Ne,1);
    bdidx(isBdEdge) = 1;
    Tbd = spdiags(bdidx,0,Ne,Ne);
    Te = spdiags(1-bdidx,0,Ne,Ne);
    AD = Te*(A - epsilon*M)*Te + Tbd;
    if ~strcmp(solver,'direct') && ~strcmp(solver,'nosolve')
        % modify the corresponding Poisson matrix
        bdidx = zeros(N,1);
        bdidx(isBdNode) = 1;
        Tbd = spdiags(bdidx,0,N,N);
        Tv = spdiags(1-bdidx,0,N,N);
        AP = Tv*AP*Tv + Tbd;
        BP = Tv*BP*Tv + Tbd;
       % G  = Te*G*Tv  ;
    end
else      % pure Neumann boundary condition
    AD = A - epsilon*M  ;
    if ~strcmp(solver,'direct') && ~strcmp(solver,'nosolve')
       BP = BP + 1e-8*speye(N);  % make B non-singular
    end
end

%% Part 2: Find boundary edges and modify the load b
g = zeros(Ne,1);
% Find Neumann boundary faces
if isempty(bdFlag) && (~isempty(pde.g_N) || ~isempty(pde.g_R))
    bdFlag = setboundary3(node,elem,'Neumann');
end
% non-zero Neumann boundary condition
if ~isempty(bdFlag) && ~isempty(pde.g_N)
    % face 1
    isBdElem = find(bdFlag(:,1) == 2); %#ok<*NASGU>
    face = [2 3 4]; face2locdof = [6 5 4];
    if ~isempty(isBdElem)
        bdb = bdfaceintegral(isBdElem,face,face2locdof);
        g = bdb;
    end
    % face 2
    isBdElem = find(bdFlag(:,2) == 2);
    face = [1 4 3]; face2locdof = [6 2 3];
    if ~isempty(isBdElem)
        bdb = bdfaceintegral(isBdElem,face,face2locdof);
        g = g + bdb;
    end
    % face 3
    isBdElem = find(bdFlag(:,3) == 2);
    face = [1 2 4]; face2locdof = [5 3 1];
    if ~isempty(isBdElem)
        bdb = bdfaceintegral(isBdElem,face,face2locdof);
        g = g + bdb;
    end
    % face 4
    isBdElem = find(bdFlag(:,4) == 2);
    face = [1 3 2]; face2locdof = [4 1 2];
    if ~isempty(isBdElem)
        bdb = bdfaceintegral(isBdElem,face,face2locdof);
        g = g + bdb;
    end
    f = f - g;
end
% nonzero Dirichlet boundary condition
u = zeros(Ne,1);
if ~isempty(bdEdge) && ~isempty(pde.g_D) && ...
   ~(isnumeric(pde.g_D) && all(pde.g_D == 0))
    % else no bddof or g_D = 0 (no modification needed)
    if (isnumeric(pde.g_D) && length(pde.g_D) == Ne)
        u(isBdEdge) = pde.g_D(isBdEdge);
    else
        u(isBdEdge) = edgeinterpolate(pde.g_D,node,bdEdge);
    end
    f = f - (A - epsilon*M)*u;
    f(isBdEdge) = u(isBdEdge);
end
%% We always assume the Langrange multer is in zeros boundary condition
p     = zeros(N,1);
g0    = zeros(N,1);
g0    = -G*u;

%% Remark
% The order of assign Neumann and Dirichlet boundary condition is
% important to get the right setting of the intersection of Dirichlet and
% Neumann faces.

%% Record assembling time
info.assembleTime = toc(tstart);
if ~isfield(option,'printlevel'), option.printlevel = 1; end
if option.printlevel >= 1
    fprintf('Time to assemble matrix equation %4.2g s\n',info.assembleTime);
end

%% Solve the system of linear equations
% if strcmp(solver,'direct')
%     % exact solver
%     tstart = tic;
%     freeDof = find(~isBdEdge);
%     u(freeDof) = AD(freeDof,freeDof)\f(freeDof);
%     time = toc(tstart); itStep = 0; flag = 2; err = norm(f - AD*u);
% elseif strcmp(solver,'nosolve')
%     eqn = struct('A',A,'M',M,'f',f,'g',g,'bigA',AD,'isBdEdge',isBdEdge);
%     info = [];
%     return;
% else
% %     u0 = edgeinterpolate(pde.g_D,node,edge);
%     u0 = u;
%     option.x0 = u0;
%     [u,flag,itStep,err,time] = mgMaxwell(AD,f,AP,BP,node,elem,edge,HB,isBdEdge,option);
% end
temp  = zeros(N+Ne,1);
bigAD = [AD G';G sparse(N,N)];
freeEdge = find(~isBdEdge);
freeNode = find(~isBdNode);
freeDof  = [freeEdge;Ne+freeNode];
tstart = tic;
temp(freeDof) = bigAD(freeDof,freeDof)\[f(freeEdge);g0(freeNode)];
time = toc(tstart);itStep = 0; flag = 2; err = norm([f(freeEdge);g0(freeNode)] - bigAD(freeDof,freeDof)*temp(freeDof));
u(freeEdge) = temp(freeEdge);
p(freeNode) = temp(Ne + freeNode);

%check the Langrange is correct or not.
normp  = norm(p);
if(normp>1.0/N)
disp('the Langrange multer is wrong')
end

%% Output
eqn = struct('A',A,'M',M,'f',f,'g',g,'bigA',AD,'isBdEdge',isBdEdge);
info = struct('solverTime',time,'itStep',itStep,'error',err,'flag',flag);

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% subfunctions bdfaceintegral
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    function bdb = bdfaceintegral(isBdElem,face,face2locdof)
    %% Compute boundary surface integral of lowest order edge element.
    %  bdb(k) = \int_{face} (n�g_N, phi_k) dS

    %% Compute scaled normal
    faceIdx = true(4,1);
    faceIdx(face) = false;
    normal = -3*repmat(volume(isBdElem),1,3).*Dlambda(isBdElem,:,faceIdx);

    %% Data structure
    tetLocEdge = [1 2; 1 3; 1 4; 2 3; 2 4; 3 4]; % edge of a tetrahedral [1 2 3 4]
    face2locEdge = [2 3; 3 1; 1 2]; % edge of the face [1 2 3]

    %% Compute surface integral
    Nbd = length(isBdElem);
    bt = zeros(Nbd,3);
    idx = zeros(Nbd,3,'int32');
    [lambda,w] = quadpts(3); % quadrature order is 3
    nQuad = size(lambda,1);
    for pp = 1:nQuad
        % quadrature points in the x-y-z coordinate
        pxyz = lambda(pp,1)*node(elem(isBdElem,face(1)),:) ...
             + lambda(pp,2)*node(elem(isBdElem,face(2)),:) ...
             + lambda(pp,3)*node(elem(isBdElem,face(3)),:);
        gNp = pde.g_N(pxyz,normal);
        for s = 1:3
            kk = face2locdof(s);
            pidx = face(face2locEdge(s,1))< face(face2locEdge(s,2));
            % phi_k = lambda_iDlambda_j - lambda_jDlambda_i;
            % lambda_i is associated to the local index of the face [1 2 3]
            % Dlambda_j is associtated to the index of tetrahedron
            % - when the direction of the local edge s is consistent with the
            %   global oritentation given in the triangulation,
            %           s(1) -- k(1),  s(2) -- k(2)
            % - otherwise
            %           s(2) -- k(1),  s(1) -- k(2)
            if pidx
                phi_k = lambda(pp,face2locEdge(s,1))*Dlambda(isBdElem,:,tetLocEdge(kk,2)) ...
                      - lambda(pp,face2locEdge(s,2))*Dlambda(isBdElem,:,tetLocEdge(kk,1));
            else
                phi_k = lambda(pp,face2locEdge(s,2))*Dlambda(isBdElem,:,tetLocEdge(kk,2)) ...
                      - lambda(pp,face2locEdge(s,1))*Dlambda(isBdElem,:,tetLocEdge(kk,1));
            end
            rhs = dot(phi_k,gNp,2);
            bt(:,s) = bt(:,s) + w(pp)*rhs; % area is included in normal; see line 28
            idx(:,s) = elem2dof(isBdElem,kk);
        end
    end
    %% Distribute to DOF
    bdb = accumarray(idx(:),bt(:),[Ne 1]);
    end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
end


function [structout] = maternfit(varargin)
%MATERNFIT  Parametric spectral fit to the Matern form. [with A. Sykulski]
%
%   MATERNFIT performs a parametric fit of the spectrum of a time series to
%   that expected for a Matern process plus optional spin.
%
%   The time series may either be real-valued or complex-valued.
%
%   The Matern process plus spin has a spectrum given by, see MATERNSPEC,
%
%        SPP(F) = SIGMA^2 / [(F-NU)^2/LAMBDA^2 + 1]^ALPHA
%                           / (LAMBDA * MATERNC(ALPHA)) + 2*pi * EPSILON^2
%
%   where SIGMA is the standard deviation, NU is a frequency shift, LAMBDA
%   is a damping coefficient, ALPHA is 1/2 of the spectral slope, and
%   EPSILON^2 is the variance of an optional additive noise component.
%
%   The coefficient LAMBDA * MATERNC(ALPHA) in the above form lets us
%   parameterize the spectrum in terms of the process variance SIGMA^2.
%
%   The optimal parameters are found using a frequency-domain maximum
%   likelihood method, accounting for both aliasing and spectral blurring.
%
%   For further details on the parameter inference method method, see
%
%     Sykulski, Olhede, Lilly, and Danioux (2016).  Lagrangian time series
%        models for ocean surface drifter trajectories. Journal of the
%        Royal Statisical Society, Series C. 65 (1): 29--50.
%
%     Sykulski, Olhede, Guillaumin, Lilly, and Early (2019). The de-biased
%        Whittle likelihood. Biometrika, 106 (2): 251--266.
%
%   For details on the Matern process and its spectrum, see:
%
%     Lilly, Sykulski, Early, and Olhede, (2017).  Fractional Brownian
%        motion, the Matern process, and stochastic modeling of turbulent
%        dispersion.  Nonlinear Processes in Geophysics, 24: 481--514.
%   __________________________________________________________________
%
%   Usage
%
%   FIT=MATERNFIT(DT,Z,FO) where Z is a times series oriented as column
%   vector, returns the result of a fitting the periodogram of Z to a
%   spectrum having a Matern form, fit over all frequencies. The range
%   of frequencies involved in the fit can be modified, as described below.
%
%   DT is the sample interval, which has units of days, while FO is a
%   signed reference frequency in units of radians per day.  FO is used in
%   determining search ranges and initial guesses.  In oceanographic
%   applications, one would normally choose FO as the Coriolis frequency.
%
%   The output argument FIT is a structure which will be described later.
%
%   The default search ranges and initial guess values are as follows:
%
%                     Low  Guess  High
%        SIGMA    =  [0      1    100] * STD(Z)
%        ALPHA    =  [1/2    1     10]
%        LAMBDA   =  [1e-3  2e-3   10] * ABS(FO)
%        EPSILON  =  [0      0      0] * STD(Z)
%        NU       =  [0      0      0] * ABS(FO)
%
%   Note that by default, neither the EPSILON nor NU parameters are used.
%
%   The search ranges and guesses can all be modified, as described below.
%
%   A common special case is the inclusion of an additive noise component.
%   Calling flag MATERNFIT(...'noisy'), which sets
%
%        EPSILON  =  [0     0.01     2] * STD(Z)
%
%   for the range of the EPSILON parameter.  According to the spectral
%   normalizations used here, a white noice time series with standard
%   deviation EPSILON will have a spectral
%   __________________________________________________________________
%
%   Output format
%
%   The following parameters are output as fields of the structure FIT.
%
%      SIGMA     Standard deviation of currents in cm/s
%      ALPHA     Slope parameter
%      LAMBDA    Damping parameter in rad / day
%      NU        Oscillation frequency in rad /day
%      RANGE     Ranges of fit search for each parameter
%      PARAMS    Sub-structure with fields described below
%
%   The associated spectra can be then created from SIGMA, ALPHA, LAMBDA,
%   and NU using MATERNSPEC.
%
%   RANGE is substructure with fields SIGMA, ALPHA, LAMBDA, and NU, such
%   that RANGE.SIGMA specifies the *dimensional* values of the associated
%   range and initial guess with format [MIN GUESS MAX], and so forth for
%   all the other parameters.
%
%   PARAMS is a substructure containing various parameter values
%   characterizing the fit itself:
%
%      PARAMS.DT      Sample rate, as input to MATERNFIT
%      PARAMS.FO      Reference frequency, as input to MATERNFIT
%      PARAMS.A       Index into first frequency F(A) used in the fit
%      PARAMS.B       Index into last frequency F(B) used in the fit
%      PARAMS.P       Number of free parameters used in the fit
%      LIKE           Negative of the log-likelihood
%      AICC           Akaike Information Criterion, corrected version
%      ERR            Normalized error of fit to log spectra
%      EXITFLAG       The exit flag from the optimization routine
%      ITER           The number of iterations in the optimization routine
%      PARAMS.SIDE    String specifying frequency side options
%      PARAMS.ALG     String specifying algorithm options
%      PARAMS.VER     String specifiying raw or difference option
%      PARAMS.CORES   String specifying series or parallel computation
%
%   These parameters are described in more detail below.
%   __________________________________________________________________
%
%   Options for multiple input time series
%
%   FIT=MATERNFIT(DT,Z,FO) may have Z being a matrix with N columns, or a
%   cell array of N different time series.  In both of these cases, DT and
%   FO may be scalars or length N arrays.
%
%   In these cases, the fields SIGMA, ALPHA, LAMBDA, and NU of FIT will
%   also be arrays with N elements, as all non-string fields of PARAMS. The
%   fields of RANGE will then all be N x 3 arrays.
%
%   Alternatively, MATERNFIT(...,'average') with Z a matrix or a cell
%   array of matrices causes the columns of each matrix to be interpreted
%   as members of an ensemble, averaging over columns to create an average
%   spectrum. One fit per matrix is returned, rather than one per column.
%   __________________________________________________________________
%
%   Specifiying frequencies
%
%   MATERNFIT(DT,Z,FO,RA,RB), where RA and RB are both real-valued scalars,
%   applies the fit to only frequencies in the range
%
%               ABS(FO)*RA < F < ABS(FO)*RB
%
%   with the default behavior corresponding to MATERNFIT(DT,Z,FO,0,INF).
%   Thus RA is the smallest permissible ratio of F to the reference
%   frequency, while RB is similarly the largest permissible ratio.
%
%   MATERNFIT(DT,Z,FO,RA,[RB,RN]) also works, where the fifth argument is
%   an array of length two. In this case the fit is applied to the range
%
%               ABS(FO)*RA < F < MIN( ABS(FO)*RB, PI/DT*RN )
%
%   RB is the largest permissible ratio of F to the reference frequency,
%   while RN is the largest permissible ratio of F to the Nyquist PI/DT.
%   The fit extends to the smaller of these two frequencies.
%
%   If RA and RB are imaginary numbers, rather than real numbers, then
%   the fit is only applied to frequencies in the range
%
%               IMAG(RA) < F < IMAG(RB)
%
%   that is, the range is found without scaling by the reference frequency.
%
%   MATERNFIT can create the fit by utilizing both positive and negative
%   frequency sides of the spectrum, the default behavior, or to only one
%   side (plus the zero frequency). This is modified as follows:
%
%      MATERNFIT(...,'both',...), the default, uses both sides.
%      MATERNFIT(...,'positive',...), uses the side where F/FO is positive.
%      MATERNFIT(...,'negative',...), uses the side where F/FO is negative.
%
%   Thus, changing the sign of the reference frequency also changes the
%   side of the spectrum to be fit using the 'postive' or 'negative' flags.
%   __________________________________________________________________
%
%   Parameter range specification
%
%   The default search ranges and guess values can be modified.  As an
%   example, to modify the default range and guess for the SIGMA parameter
%   corresponding to the background flow, use
%
%       MATERNFIT(...,'range.sigma',[MIN GUESS MAX],...)
%
%   and so forth for other parameters. SIGMA ranges input to MATERNFIT
%   represent *fractions* of the total signal standard deviation.  Thus
%
%       MATERNFIT(...,'range.sigma',[0 1 100],...)
%
%   corresponds to the default setting.  The upper limit is set very high
%   because occasionally an optimum spectral fit is found that has much
%   larger total variance than the signal.
%
%   The ranges of LAMBDA and NU are nondimensional values representing
%   fractions of the magnitude of the reference frequency ABS(FO).  Thus
%
%       MATERNFIT(...,'range.lambda',[1/1000 2/1000 1],...)
%
%   corresponds to the default range for LAMBDA.
%
%   The slope parameter ALPHA can take on a value of no less than 1/2, so
%   the lower range for ALPHA cannot be less than 1/2.
%
%   This approach can be used to omit parameters from the fit, by setting
%   the MIN, GUESS, and MAX values to be identical.  For example,
%
%      MATERNFIT(...,'range.alpha',[2 2 2])
%
%   sets the ALPHA parameter to a value of 2.  Fixed parameters are then
%   not included in the optimization, thus speeding up the fit.
%   __________________________________________________________________
%
%   Parameter value specification
%
%   Parameters can also be set to particular values for each time series.
%   This is done by setting the 'value' field as follows
%
%       MATERNFIT(...,'value.sigma',SIGMA,...)
%
%   and so forth for the other parameters.
%
%   Here SIGMA is an array of the same length as the number of time series
%   in Z.  Thus SIGMA is a scalar if Z is a single array, an array of
%   LENGTH(Z) is Z is a cell array, or of SIZE(Z,2) if Z is a matrix.
%
%   Note that the values specified in this way are actual dimensional
%   values, not nondimensional values as with setting the range.
%
%   This approach works by internally setting the dimension MIN, GUESS, and
%   MAX to the value specified for each time series, overriding the default
%   choices. This will be reflected in the output RANGE fields.
%
%   If both ranges and values are specified for the same parameter, the
%   value settings take precedence.
%   __________________________________________________________________
%
%   Numerical options
%
%   MATERNFIT has options for specifying numerical details of the fit and
%   the optimization algorithm.
%
%   MATERNFIT can use one of two different optimization algorithms.
%
%     MATERNFIT(...,'bnd',...), the default, uses FMINSEARCHBND by J.
%       D'Errico included with JLAB in accordance with its license terms.
%       This in turn calls Matlab's FMINSEARCH using Nelder-Mead.
%
%     MATERNFIT(...,'con',...) alternately uses FMINCON with the default
%       interior-point algorithm.  This requires Matlab's Optimization
%       Toolbox to be installed.  This is mainly for testing.
%
%     MATERNFIT(...,'nlo',...) uses the Nelder-Mead algorithm from the
%       NLopt toolbox at https://nlopt.readthedocs.io.  This requires NLopt
%       to be installed.  Again, this is mainly for testing at the moment.
%
%   In tests, FMINCON is generally faster, and most of the fits agree
%   closely with those using FMINSEARCHBND.  However, occasionally FMINCON
%   produces fits that are significantly worse than those obtained from
%   FMINSEARCHBND, which is why the latter is preferred by default.
%
%   MATERNFIT can employ two different versions of the fit.
%
%     MATERNFIT(...,'difference',...) estimates the Matern parameters by
%       fitting the first difference of the time series to the first
%       difference of a Matern process.  This amounts to a form of pre-
%       whitening, and is the default behavior when a taper is not input.
%     MATERNFIT(...,'raw',...) fits the time series directly to a Matern.
%       This is the default behavior when a taper *is* input.
%
%   These choices are reflected in the output fields PARAMS.ALG and
%   PARAMS.VER, respectively.
%   __________________________________________________________________
%
%   Tapering
%
%   The default behavior of fitting the first difference of the spectrum
%   is usually sufficient to account for spectral blurring.  For very steep
%   spectra or those with a very large dynamic range, this is no longer the
%   case, because leakage from high-energy portions of the spectra will
%   obscure the structure of low-energy portions.
%
%   To addess this, MATERNFIT can optionally perform the fit by fitting
%   to the tapered and aliased spectrum, correctly accounting for the
%   influence of tapering.  This is accomplished with
%
%      MATERNFIT(...,'taper',PSI,...)
%
%   where PSI is a data taper of the same length as Z.  If Z is a cell
%   array, then PSI is a cell array of data tapers having the same length
%   as the components of Z.  PSI is typically computed by SLEPTAP.
%
%   When a taper is input, the default behavior is *not* to difference
%   the time series, corresponding to the 'raw' option.  If both a taper
%   and the 'difference' flag are both input, then the taper length must
%   be one less than the data length.
%   __________________________________________________________________
%
%   Error
%
%   While the maximum likelikehood method is not about finding the best
%   fit in a least squares sense, a measure of the mean squared error
%   provides a useful measure of evaluating the degree of misfit.
%
%   The error ERR returned by MATERNFIT is the squared difference between
%   the *natural log* of the periodogram and that of the fit spectrum,
%   summed over all frequencies used in the fit, and divided by the sum of
%   the squared natural log of the periodogram over the same frequencies.
%
%   The error is computed over the inertial side, anti-inertial side, or
%   both sides, depending on which frequency range is used for the fit.
%
%   When the 'difference' behavior is employed, as is the default, ERR will
%   reflect the error between the periodogram of the first difference of
%   the time series and the spectrum of the first difference of the fit.
%   __________________________________________________________________
%
%   Parallelization
%
%   With Matlab's Parallel Computing toolbox installed, when Z is a cell
%   array or a matrix, MATERNFIT(...,'parallel') will loop over the
%   elements of Z using a parfor loop to speed things up.
%
%   This choice is reflected in the output field PARAMS.CORES, which
%   will take on the values 'series' (the default) or 'parallel'.
%   __________________________________________________________________
%
%   'maternfit --t' runs a test.
%
%   Usage: fit=maternfit(dt,z,fo);
%          fit=maternfit(dt,z,fo,a,b);
%   __________________________________________________________________
%   This is part of JLAB --- type 'help jlab' for more information
%   (C) 2014--2021 J.M. Lilly and A.M. Sykulski
%                                --- type 'help jlab_license' for details

%   __________________________________________________________________
%
%   Extensions
%
%   Two extensions of the basic Matern form are supported, discussed in
%   more detail in MATERNSPEC.
%
%   An oscillatory version, with nonzero MU, and a noisy version, with
%   nonzero EPSILON, are available as options with these two extensions.
%
%   Generalized Matern
%
%   MATERFIT(...,'general') fits to the spectrum of generalized Matern
%   process. A parameter GAMMA is used with the default range
%
%        GAMMA  =  [1/2     1    20]
%
%   such that the initial guess is the standard Matern process.
%
%   The difference between the generalized Matern and standard Matern is
%   limited to frequency band in the vicinity of the falloff frequency, so
%   unless you are averaging over many time series (decribed below), you
%   can expect a lot of variability in the fit value of GAMMA.
%
%   Extended Matern
%
%   MATERFIT(...,'extended') fits to the spectrum of an extended Matern
%   process. A parameter MU is used with the default range
%
%            MU  =  [1/100  10  100] * ABS(FO)
%
%   and in this case, the ALPHA parameter has the default range
%
%       ALPHA    =  [-1/2    1    10]
%
%   which has a different lower bound than for the standard Matern process.
%   __________________________________________________________________

%   Composite Matern
%
%   MATERFIT(...,'composite') fits to the spectrum of an composite Matern
%   process. A parameter MU is used with the default range

%Notes to self:
%Note, this is all set up to run the 5-parameter Matern process, I have
%just not checked the code.  Also make sure to comment, which I can grab
%from SPECFIT, and also make sure to assign bgtype in output params.
%
%This is basically just a stripped-down version of SPECFIT.  Use Mac's
%Filemerge tool to compare them.

if nargin>0
%    if strcmpi(varargin{1}, '--f')
 %       maternfit_fig,return
    if strcmpi(varargin{1}, '--t')
        maternfit_test,return
    end
end
%--------------------------------------------------------------------------
%Set search ranges for parameters
range=struct;

%Ranges for the background process
range.sigma=[0 1 100];            %Range of standard deviation as fraction of total
range.alpha=[1/2 1 10];           %Range of slope parameter
range.lambda=[1/1000 2/1000 10];  %Range of decay parameter as multiple of Coriolis
range.mu=[0 0 0];                 %Range of damping parameter as multiple of inverse Coriolis
range.nu=[0 0 0];                 %Frequency shift is fixed at NU=0
range.epsilon=[0 0.01 2];         %Noise level
%--------------------------------------------------------------------------
%Initialize value structure
names=fieldnames(range);
for i=1:length(names)
    eval(['value.' names{i} '=[];'])
end
%--------------------------------------------------------------------------
dt=double(varargin{1});
z=varargin{2};
varargin=varargin(3:end);
%--------------------------------------------------------------------------
%Sorting out input options

opts.side='both';            %Determines side: opposite, same, or both
opts.alg='bnd';              %Algorithm: bnd, con, or nlopt
opts.ver='difference';       %Fit version: difference or raw
opts.cores='serial';         %Serial or parallel computation
opts.bgtype='mat';      %Type of model for background
opts.noise='clean';          %Noisy or clean
opts.cols='fit';             %Fit or average

psi=[];                      %The default data taper is the empty taper
verstrin=false;              %Flag for whether or not version string is input
for i=1:30
    if ischar(varargin{end})
        if strcmpi(varargin{end}(1:3),'con')||strcmpi(varargin{end}(1:3),'bnd')||strcmpi(varargin{end}(1:3),'nlo')
            opts.alg=varargin{end};
            if strcmpi(opts.alg(1:3),'con')
                if exist('fmincon.m')~=2
                    error('Sorry, MATERNFIT with ALG=''con'' requires the Optimization Toolbox')
                end
            end
        elseif strcmpi(varargin{end}(1:3),'raw')||strcmpi(varargin{end}(1:3),'dif')||strcmpi(varargin{end}(1:3),'sec')
            opts.ver=varargin{end};
            verstrin=true;
        elseif strcmpi(varargin{end}(1:3),'bot')||strcmpi(varargin{end}(1:3),'pos')||strcmpi(varargin{end}(1:3),'neg')
            opts.side=varargin{end};
        elseif strcmpi(varargin{end}(1:3),'ser')||strcmpi(varargin{end}(1:3),'par')
            opts.cores=varargin{end};
        elseif strcmpi(varargin{end}(1:3),'sta')||strcmpi(varargin{end}(1:3),'com')
            opts.model=varargin{end};
        elseif strcmpi(varargin{end}(1:3),'mat')||strcmpi(varargin{end}(1:3),'exp')||strcmpi(varargin{end}(1:3),'ext')||strcmpi(varargin{end}(1:3),'gen')
            opts.bgtype=varargin{end};
        elseif strcmpi(varargin{end}(1:3),'noi')||strcmpi(varargin{end}(1:3),'cle')
            opts.noise=varargin{end};
        elseif strcmpi(varargin{end}(1:3),'fit')||strcmpi(varargin{end}(1:3),'ave')
            opts.cols=varargin{end};
        end
        varargin=varargin(1:end-1);
    elseif length(varargin)>1
        if ischar(varargin{end-1})&&~ischar(varargin{end})
            if strcmpi(varargin{end-1}(1:3),'tap')
                psi=varargin{end};
            elseif strcmpi(varargin{end-1}(1:3),'ran')
                name=varargin{end-1}(7:end);
                range=setfield(range,name,varargin{end});
            elseif strcmpi(varargin{end-1}(1:3),'val')
                name=varargin{end-1}(7:end);
                value=setfield(value,name,varargin{end});
            end
            varargin=varargin(1:end-2);
        end
    end
end
%--------------------------------------------------------------------------
%Make sure ranges and flags are set correctly for specified model type
if strcmpi(opts.bgtype(1:3),'exp')
    range.alpha=[-1/2 -1/2 -1/2];
    range.mu=[1/100 10 100];
    %range.lambda=[1/100000 2/1000 10];  %Range of decay parameter as multiple of Coriolis
elseif strcmpi(opts.bgtype(1:3),'ext')
    range.alpha=[-1/2 1 10];
    range.mu=[1/100 10 100];
elseif strcmpi(opts.bgtype(1:3),'gen')
    range.mu=[1/2 1 20];
elseif strcmp(opts.bgtype(1:3),'mat')
    if range.alpha(1)<=1/2
        %Correction for alpha being less than permitted value
        range.alpha(1)=1/2+1e-10;
    end
end
if strcmpi(opts.noise(1:3),'cle')
    range.epsilon=[0 0 0];
end
if isfield(range,'gamma')
    range.mu=range.gamma;
    range=rmfield(range,'gamma');
end
%--------------------------------------------------------------------------
%Convert value structure to a numeric array
if iscell(z)
    N=length(z);
else
    N=size(z,2);
end
values=nan*zeros(6,3);
values(1,:)=range.sigma;
values(2,:)=range.alpha;
values(3,:)=range.lambda;
values(4,:)=range.mu;
values(5,:)=range.nu;
values(6,:)=range.epsilon;
if ~isempty(value.sigma),   values(1,:)=value.sigma;end
if ~isempty(value.alpha),   values(1,:)=value.alpha;end
if ~isempty(value.lambda),  values(1,:)=value.lambda;end
if ~isempty(value.mu),      values(1,:)=value.mu;end
if ~isempty(value.nu),      values(1,:)=value.nu;end
if ~isempty(value.epsilon), values(1,:)=value.epsilon;end
%Have to convert this to numeric values because I can't pass a structure
%through to the workers, for some unknown reason
%--------------------------------------------------------------------------
%Frequency range
flow=0;
fhigh=inf;
fc=varargin{1};
varargin=varargin(2:end);

if length(varargin)==2
    flow=varargin{1};
    fhigh=varargin{2};
end
if length(fhigh)==1
    fhigh=[fhigh inf];
end
%--------------------------------------------------------------------------
%Re-sizing of dt and fc
dt=dt(:);

if length(dt)==1
    if iscell(z)
        dt=dt+zeros(length(z),1);
     elseif ~strcmpi(opts.cols(1:3),'ave')
        dt=dt+zeros(size(z,2),1);
    end
end

fc=fc(:);
if length(fc)==1
    if iscell(z)
        fc=fc+zeros(length(z),1);
    elseif ~strcmpi(opts.cols(1:3),'ave')
        fc=fc+zeros(size(z,2),1);
    end
end
%--------------------------------------------------------------------------
%Difference z if requested, and compute standard deviation

%Default to raw algorithm if taper is input
if ~isempty(psi)&&~verstrin
    opts.ver='raw';
end

if ~iscell(z)
    stdz=std(z);
    if strcmpi(opts.ver(1:3),'dif')
        z=diff(z);
    elseif strcmpi(opts.ver(1:3),'sec')
        z=diff(diff(z));
    end
else
    for i=1:length(z)
        stdz{i}=std(z{i});
        if strcmpi(opts.ver(1:3),'dif')
            z{i}=diff(z{i});
        elseif strcmpi(opts.ver(1:3),'sec')
            z{i}=diff(diff(z{i}));
        end
    end
end
%--------------------------------------------------------------------------
%Compute data window from taper or periodogram
if ~isempty(psi)
    if iscell(psi)
        for i=1:length(psi)
            if size(psi{i},1)~=size(z{i},1)
                error('Length of taper does not match length of data.')
            end
            win{i}=conv(psi{i}(:),psi{i}(:));
            win{i}=win{i}(end-length(z{i})+1:end);
        end
    else
        if size(psi,1)~=size(z,1)
            error('Length of taper does not match length of data.')
        end
        win=conv(psi(:),psi(:));
        win=win(end-size(z,1)+1:end);
    end
else
    if iscell(z)
        for i=1:length(z)
            N=length(z{i});
            win{i}=[N:-1:1]'./N;
            psi{i}=[];
        end
    else
        N=size(z,1);
        win=[N:-1:1]'./N;
        psi=[];
    end
end
%--------------------------------------------------------------------------
if ~iscell(z)&&( size(z,2)==1 || strcmpi(opts.cols(1:3),'ave'))
    %Single time series input, no loop
    [x,xa,xb,xo,like,aicc,P,a,b,err,exitflag,iters]=...
        maternfit_one(dt,z,flow,fhigh,opts,fc,psi,win,stdz,values);
    %The rest of this simply implements different types of loops
elseif ~iscell(z)
    %Loop over matrix columns
    N=size(z,2);[x,xa,xb,xo]=vzeros(N,6);
    [like,aicc,P,a,b,err,exitflag,iters]=vzeros(N,1);
    if strcmpi(opts.cores(1:3),'ser')
        %For series loop over matrix columns
        for i=1:size(z,2)
            disp(['MATERNFIT processing series ' int2str(i) ' of ' int2str(size(z,2)) '.'])
            [x(i,:),xa(i,:),xb(i,:),xo(i,:),like(i),aicc(i),P(i),a(i),b(i),err(i),exitflag(i),iters(i)]=...
                maternfit_one(dt(i),z(:,i),flow,fhigh,opts,fc(i),psi,win,stdz(i),values);
        end
    elseif strcmpi(opts.cores(1:3),'par')
        %For parallel loop over matrix columns
        disp('MATERNFIT using parallel for loop...')
        parfor i=1:size(z,2)
            %dt(i),flow,fhigh,opts,fc(i),fit
            disp(['MATERNFIT processing series ' int2str(i) ' of ' int2str(size(z,2)) '.'])
            [x(i,:),xa(i,:),xb(i,:),xo(i,:),like(i),aicc(i),P(i),a(i),b(i),err(i),exitflag(i),iters(i)]=...
                maternfit_one(dt(i),z(:,i),flow,fhigh,opts,fc(i),psi,win,stdz(i),values);
        end
    end
elseif iscell(z)
    %Loop over cell array
    N=length(z);[x,xa,xb,xo]=vzeros(N,6);
    [like,aicc,P,a,b,err,exitflag,iters]=vzeros(N,1);
    if strcmpi(opts.cores(1:3),'ser')
        %For series loop over cell array
        for i=1:length(z)
            disp(['MATERNFIT processing series ' int2str(i) ' of ' int2str(length(z)) '.'])
            [x(i,:),xa(i,:),xb(i,:),xo(i,:),like(i),aicc(i),P(i),a(i),b(i),err(i),exitflag(i),iters(i)]=...
                maternfit_one(dt(i),z{i},flow,fhigh,opts,fc(i),psi{i},win{i},stdz{i},values);
        end
    elseif strcmpi(opts.cores(1:3),'par')
        %For parallel loop over cell array
        disp('MATERNFIT using parallel for loop...')
        parfor i=1:length(z)
            disp(['MATERNFIT processing series ' int2str(i) ' of ' int2str(length(z)) '.'])
            [x(i,:),xa(i,:),xb(i,:),xo(i,:),like(i),aicc(i),P(i),a(i),b(i),err(i),exitflag(i),iters(i)]=...
                maternfit_one(dt(i),z{i},flow,fhigh,opts,fc(i),psi{i},win{i},stdz{i},values);
        end
    end
end

sigma=x(:,1);
alpha=x(:,2);
lambda=x(:,3);
mu=x(:,4);
nu=x(:,5);
epsilon=x(:,6);

clear range
range.sigma=  [xa(:,1)  xo(:,1)  xb(:,1)];
range.alpha=  [xa(:,2)  xo(:,2)  xb(:,2)];
range.lambda= [xa(:,3)  xo(:,3)  xb(:,3)];
if strcmpi(opts.bgtype(1:3),'gen')
    range.gamma=[xa(:,4)  xo(:,4)  xb(:,4)];
else
    range.mu=[xa(:,4)  xo(:,4)  xb(:,4)];
end
range.nu=     [xa(:,5)  xo(:,5)  xb(:,5)];
range.epsilon=[xa(:,6)  xo(:,6)  xb(:,6)];

structout=[];

use opts

make params dt fc a b P like aicc err exitflag iters side alg ver cores
%make params dt fc a b P like aicc err exitflag iters side alg ver bgtype cores

if strcmpi(opts.bgtype(1:3),'gen')
    gamma=mu;
    make structout sigma alpha lambda gamma nu epsilon range params
else
    make structout sigma alpha lambda mu nu epsilon range params
end

%remove some fields I don't use
if strcmpi(opts.bgtype(1:3),'mat')
    structout=rmfield(structout,'mu');
    structout.range=rmfield(structout.range,'mu');
end
if strcmpi(opts.noise(1:3),'cle')
    structout=rmfield(structout,'epsilon');
    structout.range=rmfield(structout.range,'epsilon');
end
if all(range.nu==0)
    structout=rmfield(structout,'nu');
    structout.range=rmfield(structout.range,'nu');
end

%--------------------------------------------------------------------------
function[x,exitflag,iters]=maternfit_optimize(dt,N,om,spp,snn,index,xa,xo,xb,opts,realflag)
%Optimization for all parameters using both sides
%Optimizations like to work with doubles... see comment below
xa=double(xa);
xo=double(xo);
xb=double(xb);
%xa,xo,xb

xanorm=(xa./xo);
xbnorm=(xb./xo);
xanorm(~isfinite(xanorm))=0;
xbnorm(~isfinite(xbnorm))=0;

guess=ones(size(xo));
guess((xanorm==0)&(xbnorm==0))=0;

tol=1e-6;%tol=1e-3;
if strcmpi(opts.alg(1:3),'bnd')
    options=optimset('MaxFunEvals',10000,'MaxIter',10000,'TolFun',tol,'TolX',tol);
    [xf,fval1,exitflag,struct]=fminsearchbnd(@(z) specmodel(dt,z.*xo,spp,snn,index,N,opts,realflag),...
        guess,xanorm,xbnorm,options);
    iters=struct.iterations;
elseif strcmpi(opts.alg(1:3),'con')
    options=optimoptions('fmincon','Algorithm','interior-point','MaxFunEvals',10000,'MaxIter',10000,'TolFun',tol,'TolX',tol,'Display','off');
    [xf,fval1,exitflag,struct]=fmincon(@(z) specmodel(dt,z.*xo,spp,snn,index,N,opts,realflag),...
        guess,[],[],[],[],xanorm,xbnorm,[],options);
    iters=struct.iterations;
elseif strcmpi(opts.alg(1:3),'nlo')
    %opt.algorithm = NLOPT_GN_DIRECT_L;
    opt.algorithm = NLOPT_LN_NELDERMEAD;  %Works, not too much slower than Matlab
    %opt.algorithm = NLOPT_LN_PRAXIS;   %Works,but slower than NM
    %opt.algorithm = NLOPT_GN_CRS2_LM;
    %opt.algorithm = NLOPT_GD_STOGO;
    %opt.algorithm = NLOPT_GN_ISRES;
    %opt.algorithm = NLOPT_GN_ESCH;
    %opt.algorithm = NLOPT_LN_COBYLA;
    %opt.algorithm =NLOPT_LN_SBPLX;  %Works,but slower than NM
    %opt.algorithm = NLOPT_LN_BOBYQA;  %Somewhat slower than NM, and different results
    %opt.algorithm = NLOPT_AUGLAG;    opt.lower_bounds = xanorm;
    opt.lower_bounds = xanorm;
    opt.upper_bounds = xbnorm;
    opt.min_objective = @(z) specmodel(dt,z.*xo,spp,snn,index,N,opts,realflag);
    opt.fc_tol = [tol tol tol tol];
    opt.xtol_rel = tol;
    [xf, fmin, exitflag] = nlopt_optimize(opt, guess);
    iters=nan;  %Not sure how to return this
end

x=xf.*xo;% scale back to correct units
[like,Spp,Snn,f]=specmodel(dt,x,spp,snn,index,N,opts,realflag);
%--------------------------------------------------------------------------
function [like,Spp,Snn,f,indexn]=specmodel(dt,x,spphat,snnhat,index,N,opts,realflag)
% Computes the value of the Whittle likelihood for parameter set X,
% given periodogram estimates SPPHAT and SNNHAT of positive and negative
% sides of the spectrum, respectively.  Only frequencies in the locations
% given by INDEX are used to compute the likelihood.  N is the data length.

%Optimizations like to work with doubles... this prevents a strange error
%where, inside the optimization loop, the spectrum takes on negative values
x=double(x);

if strcmpi(opts.ver(1:3),'dif')
    N=N+1;
elseif strcmpi(opts.ver(1:3),'sec')
    N=N+2;
end

%Compute the blurred spectrum by first computing the covariance.
R=maternfit_materncov(dt,N,x,realflag,opts.bgtype);
[f,Spp,Snn]=maternfit_blurspec(dt,R,opts.ver,opts.win);

%length(R)
%[f,Spp2,Snn2]=blurspec(1,R,opts.ver,'window',opts.win);aresame(Spp,Spp2)
%Same answers but slower

%length(index),N,length(f),length(Spp)
indexn=fixindex(N,index);        %This deals with zero and Nyquist for negative frequencies
if strcmpi(opts.side(1:3),'pos')
    %Include only positive frequencies
    like=sum(log(Spp(index))+spphat(index)./Spp(index));
elseif strcmpi(opts.side(1:3),'neg')
    %Include only negative frequencies
    like=sum(log(Snn(index))+snnhat(index)./Snn(index));
else
    % vsize(Spp,spphat,index)
    likepp=sum(log(Spp(index))+spphat(index)./Spp(index));
    likenn=sum(log(Snn(indexn))+snnhat(indexn)./Snn(indexn));
    like=likepp+likenn;
end

%FMINCON likes to work with doubles
like=double(like);

%hold on,plot(f,spphat),plot(-f, Spp)
%--------------------------------------------------------------------------
%function[x,xar,xbr,like,aicc,P,f,spp,snn,Spp,Snn,a,b,err]=maternfit_one(dt,z,flow,fhigh,side,alg,ver,range,fc)
function[x,xa,xb,xo,like,aicc,P,a,b,err,exitflag,iters]=maternfit_one(dt,z,flow,fhigh,opts,fc,psi,win,stdz,values)

%This is pretty dumb, but Matlab doesn't want me to pass a structure
%through parfor.  Thus I have to convert to a matrix and then back again.
sigma=values(1,:);
alpha=values(2,:);
lambda=values(3,:);
mu=values(4,:);
nu=values(5,:);
epsilon=values(6,:);

[x,xa,xb,xo]=vzeros(1,6,nan);
[like,aicc,P,a,b,err,exitflag,iters]=vzeros(1,1,nan);
if anyany(~isfinite(z))
    return
end

N=size(z,1);
realflag=isreal(z);

%Put window into options to simplify argument passing
opts.win=win;

if strcmpi(opts.cols(1:3),'ave')
    stdz=sqrt(vmean(squared(stdz),2));
end

%Multiply standard deviation ranges by sample standard deviation
sigma    = sigma*stdz;
epsilon  = epsilon*stdz;

%Multiply damping and frequency ranges by Coriolis frequency
lambda  = lambda*abs(fc);
if ~strcmpi(opts.bgtype(1:3),'gen')
    mu      = mu.*abs(fc);   %Is this a time or frequency scale?
end
xa=[sigma(1)  alpha(1)   lambda(1)  mu(1)  nu(1)  epsilon(1)];
xo=[sigma(2)  alpha(2)   lambda(2)  mu(2)  nu(2)  epsilon(2)];
xb=[sigma(3)  alpha(3)   lambda(3)  mu(3)  nu(3)  epsilon(3)];

%Periodogram from mspec  ... use dt = 1
%vsize(dt,z,psi),length(find(isfinite(z))),isreal(z)
[om,spp,snn]=mspec(dt,z,psi);
if isreal(z)
    snn=spp;
end

if strcmpi(opts.cols(1:3),'ave')
    spp=vmean(spp,2);
    snn=vmean(snn,2);
end

if ~isnan(fc)
    if isreal(flow(1))
        a=find(om>=flow*abs(fc),1,'first');   %Look up multiple of Corilois frequency
    else
        a=find(om>=imag(flow),1,'first');
    end
    if isreal(fhigh(1))
        b=find(om<min(fhigh(1)*abs(fc),fhigh(2)*pi/dt),1,'last');    %Look up multiple of Corilios frequency
    else
        b=find(om<min(imag(fhigh(1)),real(fhigh(2))*pi/dt),1,'last');
    end
else
    a=1;
    b=length(om);
end

%figure,plot(om,spp),hold on,plot(-om,snn),ylog,vlines([om(a) om(b) -om(a) -om(b)])

%[like,Spp,Snn,f,indexn]=specmodel(dt,x(:,4),spp,snn,a:b,N,opts);
%figure,subplot(1,2,1),plot(f,[Spp spp]),ylog,vlines(x(9,2),'r')
%subplot(1,2,2),plot(f,[Snn snn]),ylog,

%Fit to background on requested side
%xa,xo,xb
%vsize(dt,N,om,spp,snn,a:b,xa,xo,xb,opts,realflag)
%[xa;xo;xb]
[x,exitflag,iters]=maternfit_optimize(dt,N,om,spp,snn,a:b,xa,xo,xb,opts,realflag);

%Final value of likelihood and spectra
%vsize(dt,x,spp,snn,a:b,N,opts,realflag)
[like,Spp,Snn,f,indexn]=specmodel(dt,x,spp,snn,a:b,N,opts,realflag);

% Compute the number of free parameters
P=0;
for i=1:size(x,1)
    if ~isnan(xo(i,1))
        P=P+length(find(xa(i,:)~=xb(i,:)));
    end
end

% Compute the value of the AICC information criterion
if (strcmpi(opts.side(1:3),'opp')||strcmpi(opts.side(1:3),'sam'))
    M=length(a:b);
else
    M=length(a:b)+length(indexn);
end
aicc=2*like + frac(4*M*P,2*M-P-1);

%figure,plot(f,[Spp spp]),hold on,plot(-f,[Snn snn]),ylog
%vlines(f(a)),vlines(f(b))

%Compute an error measure
if strcmpi(opts.side(1:3),'sam')
    numer=sum(squared(log(spp(a:b))-log(Spp(a:b))));
    denom=sum(squared(log(spp(a:b))));
    err=frac(numer,denom);
elseif strcmpi(opts.side(1:3),'opp')
    numer=sum(squared(log(snn(a:b))-log(Snn(a:b))));
    denom=sum(squared(log(snn(a:b))));
    err=frac(numer,denom);
else
    numerp=sum(squared(log(spp(a:b))-log(Spp(a:b))));
    denomp=sum(squared(log(spp(a:b))));
    numern=sum(squared(log(snn(a:b))-log(Snn(a:b))));
    denomn=sum(squared(log(snn(a:b))));
    err=frac(numerp+numern,denomp+denomn);
end

vtranspose(x,xa,xb,xo);
vcolon(x,xa,xb,xo);
vtranspose(x,xa,xb,xo);
%--------------------------------------------------------------------------
function[index]=fixindex(N,index)
%This modifies the frequency index appropriate for negative frequencies,
%due to the fact that zero is repeated for both even and odd, while the
%Nyquist is also repeated for even. See comments at MSPEC.

if iseven(N)
    if index(end)==((N/2)+1)
        index=index(1:end-1);
    end
end
if index(1)==1
    index=index(2:end);
end
%--------------------------------------------------------------------------
function[omega,Spp,Snn]=maternfit_blurspec(dt,R,ver,win)
%This is a version of BLURSPEC, stripped down for speed.

%I don't take dt into account during difference
if strcmpi(ver(1:3),'dif')
    R=2*R(1:end-1,:)-R(2:end,:)-[conj(R(2,:));R(1:end-2,:)];
elseif strcmpi(ver(1:3),'sec')
    R=2*R(1:end-1,:)-R(2:end,:)-[conj(R(2,:));R(1:end-2,:)];
    R=2*R(1:end-1,:)-R(2:end,:)-[conj(R(2,:));R(1:end-2,:)];
end

R=R.*win;
R(1,:)=R(1,:)./2;    %Don't forget to divide first element by two
S=dt*2*real(fft(R)); %But I do take it into account in spectrum

S=abs(S);  %Sometimes there are small negative parts after blurring
N=size(R,1);
omega=frac(1,dt)*2*pi*(0:floor(N/2))'./N;
%omega=fourier(N);

Spp=S(1:length(omega),:);
Snn=[S(1,:);S(end:-1:end-length(omega)+2,:)];
%--------------------------------------------------------------------------
function[R]=maternfit_materncov(dt,N,x,realflag,model)
sigma=x(1);
alpha=x(2);
lambda=x(3);
mu=x(4);
nu=x(5);
epsilon=x(6);

tau=dt*[0:N-1]';

if isnan(sigma)
    R=[];
else
    %This is just copied from MATERNCOV, but it is faster to have it internal
    if strcmpi(model(1:3),'mat')
        fact=2*frac(1,gamma(alpha-1/2).*pow2(alpha-1/2));
        R=fact.*((lambda*tau).^(alpha-1/2)).*besselk(abs(alpha-1/2),lambda*tau);
        R(1)=1;%because of being undefiend there
    elseif strcmpi(model(1:3),'ext')
        if alpha==-1/2
            tnorm=sqrt(tau.^2+mu.^2);
            fact=besselk(1,mu.*lambda);
            R=frac(1,fact).*frac(mu,tnorm).*besselk(1,lambda.*tnorm);
        else
            tnorm=lambda.*sqrt(tau.^2+mu.^2);
            fact=1./(abs(mu.*lambda)).^(alpha-1/2)./besselk(abs(alpha-1/2),abs(mu.*lambda));
            R=fact*tnorm.^(alpha-1/2).*besselk(abs(alpha-1/2),tnorm);
        end
    elseif strcmpi(model(1:3),'gen')
        M=10;P=10;  %Specifying oversampling rates for numerical computations
        [f,Spp,Snn]=maternspec(dt,M*N*P,sigma,alpha,lambda/P,mu,'generalized');
        S=[flipud(Snn(2:end));Spp];%plot(Spp),hold on
        Ri=ifft(ifftshift(S))./dt;  %Make sure it's ifftshift not fftshift
        Ri=Ri(1:P:end);
        R=Ri(1:N);%plot(Ri),hold on
        R=R./R(1);
    elseif strcmpi(model(1:3),'com')
        M=10;P=10;  %Specifying oversampling rates for numerical computations
        [f,Spp,Snn]=maternspec(dt,M*N*P,sigma,alpha,lambda/P,mu/P,nu/P,'composite');
        S=[flipud(Snn(2:end));Spp];%figure,plot(S)
        Ri=ifft(ifftshift(S))./dt;  %Make sure it's ifftshift not fftshift
        Ri=Ri(1:P:end);
        R=Ri(1:N);
        R=R./R(1);
    end
    if (nu~=0)&&~strcmpi(model(1:3),'com')
        R=R.*exp(sqrt(-1)*tau*nu);
    end
    R=R.*sigma.^2;
    R(1)=R(1)+squared(epsilon);
end

if realflag
     R=real(R);
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%End of function body; begin tests and figures
function[]=maternfit_test
%--------------------------------------------------------------------------
sigo=17;
alpha=1.5;
h=1/10;

rng(0);
dt=1;
z=maternoise(dt,1000,sigo,alpha,h);
fit=maternfit(dt,z,frac(1,2)*pi);
bool=aresame(abs(fit.sigma./sigo-1),0,0.2)&&aresame(fit.alpha,alpha,0.06)&&aresame(fit.lambda,h,0.002);
reporttest('MATERNFIT recovers Matern parameters with unit sample rate',allall(bool))

fit2=maternfit(dt,z,frac(1,2)*pi,'range.sigma',[0 17 100],'range.alpha',[0 1.5 100],'range.lambda',[1/1000 1/10 10]);

clear bool
bool(1)=aresame(fit.sigma,fit2.sigma,1e-2);
bool(2)=aresame(fit.alpha,fit2.alpha,1e-4);
bool(3)=aresame(fit.lambda,fit2.lambda,1e-4);

reporttest('MATERNFIT is independent of initial guess',allall(bool))

rng(0);
epsilono=2;
zn=epsilono.*(randn(length(z),1)+1i.*randn(length(z),1))./sqrt(2);
fit=maternfit(dt,zn,frac(1,2)*pi,'noisy','value.sigma',0);
bool=(abs(fit.sigma)<1e-7)&&aresame(abs(fit.epsilon./epsilono-1),0,0.05);
reporttest('MATERNFIT recovers Matern parameters with unit sample rate, noise only',allall(bool))

rng(0);
fit=maternfit(dt,z+zn,frac(1,2)*pi,'noisy');
bool=aresame(abs(fit.sigma./sigo-1),0,0.2)&&aresame(fit.alpha,alpha,0.5)&&aresame(fit.lambda,h,0.1)&&aresame(abs(fit.epsilon./epsilono-1),0,0.3);
reporttest('MATERNFIT recovers Matern parameters with unit sample rate, noisy version',allall(bool))
%--------------------------------------------------------------------------
sigo=17;
alpha=1.5;
h=1/10;

rng(0);
dt=1;
z=maternoise(dt,1000,sigo,alpha,h,'real');
fit=maternfit(dt,z,frac(1,2)*pi);
bool=aresame(abs(fit.sigma./sigo-1),0,0.2)&&aresame(fit.alpha,alpha,0.06)&&aresame(fit.lambda,h,0.0025);
reporttest('MATERNFIT recovers Matern parameters with unit sample rate and real signal',allall(bool))

fit2=maternfit(dt,z,frac(1,2)*pi,'range.sigma',[0 17 100],'range.alpha',[0 1.5 100],'range.lambda',[1/1000 1/10 10]);

clear bool
bool(1)=aresame(fit.sigma,fit2.sigma,1e-2);
bool(2)=aresame(fit.alpha,fit2.alpha,1e-4);
bool(3)=aresame(fit.lambda,fit2.lambda,1e-4);

reporttest('MATERNFIT is independent of initial guess for real signal',allall(bool))

rng(0);
epsilono=2;
zn=epsilono.*randn(length(z),1);
fit=maternfit(dt,zn,frac(1,2)*pi,'noisy','value.sigma',0);
bool=(abs(fit.sigma)<1e-7)&&aresame(abs(fit.epsilon./epsilono-1),0,0.1);
reporttest('MATERNFIT recovers Matern parameters with unit sample rate and real signal, noise only',allall(bool))

rng(0);
fit=maternfit(dt,z+zn,frac(1,2)*pi,'noisy');
bool=aresame(abs(fit.sigma./sigo-1),0,0.2)&&aresame(fit.alpha,alpha,0.5)&&aresame(fit.lambda,h,0.1)&&aresame(abs(fit.epsilon./epsilono-1),0,0.3);
reporttest('MATERNFIT recovers Matern parameters with unit sample rate and real signal, noisy version',allall(bool))
%--------------------------------------------------------------------------

% rng(0);
% dt=3600;
% z=maternoise(dt,1000,sigo,alpha,h./dt);
% fit=maternfit(dt,real(z),frac(1,2)*pi./dt);
% bool=aresame(abs(fit.sigma./sigo-1),0,0.2)&&aresame(fit.alpha,alpha,0.06)&&aresame(fit.lambda,h./dt,0.002);
% reporttest('MATERNFIT recovers Matern parameters with non-unit sample rate',allall(bool))

rng(0);
dt=3600;
z=maternoise(dt,1000,sigo,alpha,h./dt);
fit=maternfit(dt,z,frac(1,2)*pi./dt);
bool=aresame(abs(fit.sigma./sigo-1),0,0.2)&&aresame(fit.alpha,alpha,0.06)&&aresame(fit.lambda,h./dt,0.002);
reporttest('MATERNFIT recovers Matern parameters with non-unit sample rate',allall(bool))

rng(0);
epsilono=2;
zn=epsilono.*(randn(length(z),1)+1i.*randn(length(z),1))./sqrt(2);
fit=maternfit(dt,zn,frac(1,2)*pi,'noisy','value.sigma',0);
bool=(abs(fit.sigma)<1e-7)&&aresame(abs(fit.epsilon./epsilono-1),0,0.1);
reporttest('MATERNFIT recovers Matern parameters with non-unit sample rate, noise only',allall(bool))

h=1;
rng(0);
dt=3600;

z=maternoise(dt,1000,sigo,alpha,h./dt);
psi=sleptap(size(z,1),3,1);
fit=maternfit(dt,z,frac(1,2)*pi./dt,'tapered',psi);
bool=aresame(abs(fit.sigma./sigo-1),0,0.2)&&aresame(fit.alpha,alpha,0.06)&&aresame(fit.lambda,h./dt,0.002);
reporttest('MATERNFIT recovers Matern parameters with non-unit sample rate, tapered version',allall(bool))

psi=sleptap(size(z,1)-1,3,1);
tic;
fit=maternfit(dt,z,frac(1,2)*pi./dt,'tapered',psi,'difference');
bool=aresame(abs(fit.sigma./sigo-1),0,0.2)&&aresame(fit.alpha,alpha,0.06)&&aresame(fit.lambda,h./dt,0.002);
reporttest('MATERNFIT recovers Matern parameters with non-unit sample rate, differenced tapered version',allall(bool))
etime1=toc;

sigo=17;
alpha=1.5;
h=1/10;
rng(0);

dt=3600;
gamma=5;
N=1000;
% clf
% z=maternoise(dt,[N,2000],sigo,alpha,h./dt,1,'generalized');
% plot(vmean(abs(fft(z)),2)),xlog,ylog
% z=maternoise(dt,[N,2000],sigo,alpha,h./dt,'chol');
% hold on,plot(vmean(abs(fft(z)),2)),xlog,ylog
z=maternoise(dt,[N,5000],sigo,alpha,h./dt,5,'generalized');
zn=epsilono.*randn(size(z,1),5000);
%hold on,plot(vmean(abs(fft(z)),2))

% [tau,tpz1]=materncov(dt,N,sigo,alpha,h./dt);
% [tau,tpz2]=materncov(dt,N,sigo,alpha,h./dt,1,'generalized');
% [tau,tpz3]=materncov(dt,N,sigo,alpha,h./dt,2,'generalized');
% [tau,tpz4]=materncov(dt,N,sigo,alpha,h./dt,5,'generalized');
% figure,plot(tau,[tpz1 tpz2 tpz3 tpz4])

%[f,s]=maternspec(dt,N,sigo,alpha,h./dt,5,'generalized');plot(f,s./maxmax(s))
%[f,s]=maternspec(dt,N,sigo,alpha,h./dt,1,'generalized');hold on,plot(f,s./maxmax(s))
%[f,s]=maternspec(dt,N,sigo,alpha,h./dt,1/2,'generalized');hold on,plot(f,s./maxmax(s))
%[f,s]=maternspec(dt,N,sigo,alpha,h./dt,1/10,'generalized');hold on,plot(f,s./maxmax(s))

fit=maternfit(dt,z,frac(1,2)*pi./dt,'generalized','average');
%fit=maternfit(dt,z,frac(1,2)*pi./dt,'generalized');
bool=aresame(abs(fit.sigma./sigo-1),0,0.2)&&aresame(fit.alpha,alpha,0.06)&&aresame(fit.lambda,h./dt,0.002)&&aresame(fit.gamma,5,0.25);
reporttest('MATERNFIT recovers generalized Matern parameters with non-unit sample rate',allall(bool))

fit=maternfit(dt,z+zn,frac(1,2)*pi./dt,'generalized','average','noisy');
%fit=maternfit(dt,z,frac(1,2)*pi./dt,'generalized');
bool=aresame(abs(fit.sigma./sigo-1),0,0.2)&&aresame(fit.alpha,alpha,0.06)&&aresame(fit.lambda,h./dt,0.002)&&aresame(fit.gamma,5,0.25)&&aresame(abs(fit.epsilon./epsilono-1),0,0.1);
reporttest('MATERNFIT recovers generalized Matern parameters with non-unit sample rate, noisy version',allall(bool))

% if exist('nlopt_optimize')==3
%     psi=sleptap(size(z,1)-1,3,1);
%     tic;
%     fit=maternfit(dt,z,frac(1,2)*pi./dt,'tapered',psi,'difference','nlopt');
%     bool=aresame(abs(fit.sigma./sigo-1),0,0.2)&&aresame(fit.alpha,alpha,0.06)&&aresame(fit.lambda,h./dt,0.002);
%     reporttest('MATERNFIT using NLopt version of previous',allall(bool))
%     etime2=toc;
%     disp(['MATERNFIT NLopt version took ' num2str(etime2./etime1) ' as much time as FMINSEARCH.'])
% end

% sigo=17;
% alpha=1.5;
% h=1/10;
%
% rng(0);
% dt=1;
% z=maternoise(dt,1000,sigo,alpha,h);
% fit=maternfit(dt,[z z],frac(1,2)*pi);


function [x,mc,mn,mx]=v_melbankm(p,n,fs,fl,fh,w)
%V_MELBANKM determine matrix for a mel/erb/bark-spaced filterbank [X,MN,MX]=(P,N,FS,FL,FH,W)
%
% Inputs:
%       p   number of filters in v_filterbank or the filter spacing in k-mel/bark/erb [ceil(4.6*log10(fs))]
%		n   length of fft
%		fs  sample rate in Hz
%		fl  low end of the lowest filter as a fraction of fs [default = 0]
%		fh  high end of highest filter as a fraction of fs [default = 0.5]
%		w   any sensible combination of the following:
%             'b' = bark scale instead of mel
%             'e' = erb-rate scale
%             'l' = log10 Hz frequency scale
%             'f' = linear frequency scale
%
%             'c' = fl/fh specify centre of low and high filters
%             'h' = fl/fh are in Hz instead of fractions of fs
%             'H' = fl/fh are in mel/erb/bark/log10
%
%		      't' = triangular shaped filters in mel/erb/bark domain (default)
%		      'n' = hanning shaped filters in mel/erb/bark domain
%		      'm' = hamming shaped filters in mel/erb/bark domain
%
%		      'z' = highest and lowest filters taper down to zero [default]
%		      'y' = lowest filter remains at 1 down to 0 frequency and highest filter
%                   remains at 1 up to nyquist freqency. See note (1) below.
%
%             'u' = scale filters to sum to unity
%
%             's' = single-sided: do not double filters to account for negative frequencies
%
%             'g' = plot idealized filters [default if no output arguments present]
%
% Outputs:	x     a sparse matrix containing the v_filterbank amplitudes
%		          If the mn and mx outputs are given then size(x)=[p,mx-mn+1]
%                 otherwise size(x)=[p,1+floor(n/2)]
%                 Note that the peak filter values equal 2 to account for the power in the negative FFT frequencies.
%           mc    the v_filterbank centre frequencies in mel/erb/bark
%		    mn    the lowest fft bin with a non-zero coefficient
%		    mx    the highest fft bin with a non-zero coefficient
%                 NOTE: For legacy compatibility reasons, you must specify both or neither of mn and mx.
%
% Notes: (1) If 'ty' or 'ny' is specified, the total power in the fft is preserved.
%        (2) The filter shape (triangular, hamming etc) is defined in the mel (or erb etc) domain
%            rather than in the linear frequency domain which is more common (e.g. [2]).
%        (3) A mel-filterbank can also be created using v_filtbank() which uses triangular
%            filters in the linear frequency domain and copes better with the narrow filters
%            that arise when p is large on n is small.
%
% Examples of use:
%
% (a) Calcuate the Mel-frequency Cepstral Coefficients
%
%       f=v_rfft(s);			        % v_rfft() returns only 1+floor(n/2) coefficients
%		x=v_melbankm(p,n,fs);	        % n is the fft length, p is the number of filters wanted
%		z=log(x*abs(f).^2);         % multiply x by the power spectrum
%		c=dct(z);                   % take the DCT
%
% (b) Calcuate the Mel-frequency Cepstral Coefficients efficiently
%
%       f=fft(s);                        % n is the fft length, p is the number of filters wanted
%       [x,mc,na,nb]=v_melbankm(p,n,fs);   % na:nb gives the fft bins that are needed
%       z=log(x*(f(na:nb)).*conj(f(na:nb)));
%		c=dct(z);                   % take the DCT
%
% (c) Plot the calculated filterbanks
%
%      plot((0:floor(n/2))*fs/n,melbankm(p,n,fs)')   % fs=sample frequency
%
% (d) Plot the idealized filterbanks (without output sampling)
%
%      v_melbankm(p,n,fs);
%
% References:
%
% [1] S. S. Stevens, J. Volkman, and E. B. Newman. A scale for the measurement
%     of the psychological magnitude of pitch. J. Acoust Soc Amer, 8: 185-19, 1937.
% [2] S. Davis and P. Mermelstein. Comparison of parametric representations for
%     monosyllabic word recognition in continuously spoken sentences.
%     IEEE Trans Acoustics Speech and Signal Processing, 28 (4): 357-366, Aug. 1980.

%      Copyright (C) Mike Brookes 1997-2009
%      Version: $Id: v_melbankm.m 10865 2018-09-21 17:22:45Z dmb $
%
%   VOICEBOX is a MATLAB toolbox for speech processing.
%   Home page: http://www.ee.ic.ac.uk/hp/staff/dmb/voicebox/voicebox.html
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%   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 2 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 can obtain a copy of the GNU General Public License from
%   http://www.gnu.org/copyleft/gpl.html or by writing to
%   Free Software Foundation, Inc.,675 Mass Ave, Cambridge, MA 02139, USA.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% Note, in the comments, "FFT bin_0" assumes DC = bin 0 whereas "FFT bin_1" assumes DC = bin 1

if nargin < 6
    w='tz'; % default options
end
if nargin < 5 || isempty(fh)
    fh=0.5; % max freq is the nyquist
end
if nargin < 4 || isempty(fl)
    fl=0; % min freq is DC
end

sfact=2-any(w=='s');   % 1 if single sided else 2
wr=' ';   % default warping is mel
for i=1:length(w)
    if any(w(i)=='lebf')
        wr=w(i);
    end
end
if any(w=='h') || any(w=='H')
    mflh=[fl fh];
else
    mflh=[fl fh]*fs;
end
if ~any(w=='H')
    switch wr
        case 'f'                        % no transformation
        case 'l'
            if fl<=0
                error('Low frequency limit must be >0 for ''l'' option');
            end
            mflh=log10(mflh);           % convert frequency limits into log10 Hz
        case 'e'
            mflh=v_frq2erb(mflh);       % convert frequency limits into erb-rate
        case 'b'
            mflh=v_frq2bark(mflh);      % convert frequency limits into bark
        otherwise
            mflh=v_frq2mel(mflh);       % convert frequency limits into mel
    end
end
melrng=mflh*(-1:2:1)';                  % mel range
fn2=floor(n/2);                         % bin index of highest positive frequency (Nyquist if n is even)
if isempty(p)
    p=ceil(4.6*log10(fs));              % default number of filters
end
if any(w=='c')                          % c option: specify filter centres not edges
    if p<1
        p=round(melrng/(p*1000))+1;
    end
    melinc=melrng/(p-1);
    mflh=mflh+(-1:2:1)*melinc;
else
    if p<1
        p=round(melrng/(p*1000))-1;
    end
    melinc=melrng/(p+1);
end
%
% Calculate the FFT bins corresponding to [filter#1-low filter#1-mid filter#p-mid filter#p-high]
%
switch wr
    case 'f'
        blim=(mflh(1)+[0 1 p p+1]*melinc)*n/fs;
    case 'l'
        blim=10.^(mflh(1)+[0 1 p p+1]*melinc)*n/fs;
    case 'e'
        blim=v_erb2frq(mflh(1)+[0 1 p p+1]*melinc)*n/fs;
    case 'b'
        blim=v_bark2frq(mflh(1)+[0 1 p p+1]*melinc)*n/fs;
    otherwise
        blim=v_mel2frq(mflh(1)+[0 1 p p+1]*melinc)*n/fs;
end
mc=mflh(1)+(1:p)*melinc;        % mel centre frequencies
b1=floor(blim(1))+1;            % lowest FFT bin_0 required (might be negative)
b4=min(fn2,ceil(blim(4))-1);    % highest FFT bin_0 required
%
% now map all the useful FFT bins_0 to filter_1 centres
%
switch wr
    case 'f'
        pf=((b1:b4)*fs/n-mflh(1))/melinc;
    case 'l'
        pf=(log10((b1:b4)*fs/n)-mflh(1))/melinc;
    case 'e'
        pf=(v_frq2erb((b1:b4)*fs/n)-mflh(1))/melinc;
    case 'b'
        pf=(v_frq2bark((b1:b4)*fs/n)-mflh(1))/melinc;
    otherwise
        pf=(v_frq2mel((b1:b4)*fs/n)-mflh(1))/melinc;
end
%
%  remove any incorrect entries in pf due to rounding errors
%
if pf(1)<0
    pf(1)=[];
    b1=b1+1;
end
if pf(end)>=p+1
    pf(end)=[];
    b4=b4-1;
end
fp=floor(pf);                   % FFT bin_0 i contributes to filters_1 fp(1+i-b1)+[0 1]
pm=pf-fp;                       % multiplier for upper filter
k2=find(fp>0,1);                % FFT bin_1 k2+b1 is the first to contribute to both upper and lower filters
k3=find(fp<p,1,'last');         % FFT bin_1 k3+b1 is the last to contribute to both upper and lower filters
k4=numel(fp);                   % FFT bin_1 k4+b1 is the last to contribute to any filters
if isempty(k2)
    k2=k4+1;
end
if isempty(k3)
    k3=0;
end
if any(w=='y')                  % preserve power in FFT
    mn=1;                       % lowest fft bin required (1 = DC)
    mx=fn2+1;                   % highest fft bin required (1 = DC)
    r=[ones(1,k2+b1-1) 1+fp(k2:k3) fp(k2:k3) repmat(p,1,fn2-k3-b1+1)];  % filter number_1
    c=[1:k2+b1-1 k2+b1:k3+b1 k2+b1:k3+b1 k3+b1+1:fn2+1];                % FFT bin1
    v=[ones(1,k2+b1-1) pm(k2:k3) 1-pm(k2:k3) ones(1,fn2-k3-b1+1)];
else
    r=[1+fp(1:k3) fp(k2:k4)];       % filter number_1
    c=[1:k3 k2:k4];                 % FFT bin_1 - b1
    v=[pm(1:k3) 1-pm(k2:k4)];
    mn=b1+1;                        % lowest fft bin_1
    mx=b4+1;                        % highest fft bin_1
end
if b1<0
    c=abs(c+b1-1)-b1+1;             % convert negative frequencies into positive
end
% end
if any(w=='n')
    v=0.5-0.5*cos(v*pi);            % convert triangles to Hanning
elseif any(w=='m')
    v=0.5-0.46/1.08*cos(v*pi);      % convert triangles to Hamming
end
if sfact==2                         % double all except the DC and Nyquist (if any) terms
    msk=(c+mn>2) & (c+mn<n-fn2+2);  % there is no Nyquist term if n is odd
    v(msk)=2*v(msk);
end
%
% sort out the output argument options
%
if nargout > 2
    x=sparse(r,c,v);
    if nargout == 3                 % if exactly three output arguments, then
        mc=mn;                      % delete mc output for legacy code compatibility
        mn=mx;
    end
else
    x=sparse(r,c+mn-1,v,p,1+fn2);
end
if any(w=='u')
    sx=sum(x,2);
    x=x./repmat(sx+(sx==0),1,size(x,2));
end
%
% plot results if no output arguments or g option given
%
if ~nargout || any(w=='g')          % plot idealized filters
    ng=201;                         % 201 points
    me=mflh(1)+(0:p+1)'*melinc;
    switch wr
        case 'f'
            fe=me;                  % defining frequencies
            xg=repmat(linspace(0,1,ng),p,1).*repmat(me(3:end)-me(1:end-2),1,ng)+repmat(me(1:end-2),1,ng);
        case 'l'
            fe=10.^me;              % defining frequencies
            xg=10.^(repmat(linspace(0,1,ng),p,1).*repmat(me(3:end)-me(1:end-2),1,ng)+repmat(me(1:end-2),1,ng));
        case 'e'
            fe=v_erb2frq(me);       % defining frequencies
            xg=v_erb2frq(repmat(linspace(0,1,ng),p,1).*repmat(me(3:end)-me(1:end-2),1,ng)+repmat(me(1:end-2),1,ng));
        case 'b'
            fe=v_bark2frq(me);      % defining frequencies
            xg=v_bark2frq(repmat(linspace(0,1,ng),p,1).*repmat(me(3:end)-me(1:end-2),1,ng)+repmat(me(1:end-2),1,ng));
        otherwise
            fe=v_mel2frq(me);       % defining frequencies
            xg=v_mel2frq(repmat(linspace(0,1,ng),p,1).*repmat(me(3:end)-me(1:end-2),1,ng)+repmat(me(1:end-2),1,ng));
    end

    v=1-abs(linspace(-1,1,ng));
    if any(w=='n')
        v=0.5-0.5*cos(v*pi);        % convert triangles to Hanning
    elseif any(w=='m')
        v=0.5-0.46/1.08*cos(v*pi);  % convert triangles to Hamming
    end
    v=v*sfact;                      % multiply by 2 if double sided
    v=repmat(v,p,1);
    if any(w=='y')                  % extend first and last filters
        v(1,xg(1,:)<fe(2))=sfact;
        v(end,xg(end,:)>fe(p+1))=sfact;
    end
    if any(w=='u')                  % scale to unity sum
        dx=(xg(:,3:end)-xg(:,1:end-2))/2;
        dx=dx(:,[1 1:ng-2 ng-2]);
        vs=sum(v.*dx,2);
        v=v./repmat(vs+(vs==0),1,ng)*fs/n;
    end
    plot(xg',v','b');
    set(gca,'xlim',[fe(1) fe(end)]);
    xlabel(['Frequency (' v_xticksi 'Hz)']);
end


function sor_test01 ( w )

%*****************************************************************************80
%
%% SOR_TEST01 tests SOR1.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    03 July 2011
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'SOR_TEST01:\n' );

  it_num = 400;
  n = 20;

  x_exact = ( 1 : n )';
  a = dif2 ( n );
  b = a * x_exact;

  x = zeros ( n, 1 );
  x_plot(1:n,1) = x;

  step = 1 : it_num + 1;
  e = nan ( it_num+1, 1 );
  xm = nan ( it_num+1, 1 );

  e(1,1) = ( norm ( a * x - b ) ).^2;

  for it = 1 : it_num

    x_new = sor1 ( n, a, b, x, w );

    e(it+1,1) = ( norm ( a * x_new - b ) ).^2;
    x_plot(1:n,it+1) = x_new;
    xm(it,1) = sum ( ( x_new(:) - x(:) ).^2 ) / n;
%
%  Update the solution
%
    x = x_new;

  end
%
%  Display the error.
%
  figure ( 1 )
  plot ( step, log ( e ), 'm-*' )
  title ( 'Log (Error^2)' )
  xlabel ( 'Step' )
  ylabel ( 'Error' )
  grid
%
%  Display the motion.
%
  figure ( 2 )
  plot ( step, log ( xm ), 'm-*' )
  title ( 'Log (Average generator motion)' )
  xlabel ( 'Step' )
  ylabel ( 'Energy' )
  grid
%
%  Plot the evolution of the locations of the generators.
%
  figure ( 3 )

  y = ( 0 : it_num );
  for k = 1 : n
    plot ( x_plot(k,1:it_num+1), y )
    hold on;
  end
  grid on
  hold off;

  title ( 'Generator evolution.' );
  xlabel ( 'Generator positions' );
  ylabel ( 'Iterations' );

  return
end


function x_new = r83_jac_sl ( n, a, b, x, it_max, job )

%*****************************************************************************80
%
%% R83_JAC_SL solves a R83 system using Jacobi iteration.
%
%  Discussion:
%
%    The R83 storage format is used for a tridiagonal matrix.
%    The superdiagonal is stored in entries (1,2:N), the diagonal in
%    entries (2,1:N), and the subdiagonal in (3,1:N-1).  Thus, the
%    original matrix is "collapsed" vertically into the array.
%
%    This routine simply applies a given number of steps of the
%    iteration to an input approximate solution.  On first call, you can
%    simply pass in the zero vector as an approximate solution.  If
%    the returned value is not acceptable, you may call again, using
%    it as the starting point for additional iterations.
%
%  Example:
%
%    Here is how a R83 matrix of order 5 would be stored:
%
%       *  A12 A23 A34 A45
%      A11 A22 A33 A44 A55
%      A21 A32 A43 A54  *
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    02 February 2004
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the order of the matrix.
%    N must be at least 2.
%
%    Input, real A(3,N), the R83 matrix.
%
%    Input, real B(N), the right hand side of the linear system.
%
%    Input, real X(N), an approximate solution to the system.
%
%    Input, integer IT_MAX, the maximum number of iterations.
%
%    Input, integer JOB, specifies the system to solve.
%    0, solve A * x = b.
%    nonzero, solve A' * x = b.
%
%    Output, real X_NEW(N), an updated approximate solution to the system.
%

%
%  No diagonal matrix entry can be zero.
%
  for i = 1 : n
    if ( a(2,i) == 0.0E+00 )
      fprintf ( 1, '\n' );
      fprintf ( 1, 'R83_JAC_SL - Fatal error!\n' );
      fprintf ( 1, '  Zero diagonal entry, index = %d\n', i );
      return;
    end
  end

  if ( job == 0 )

    for it_num = 1 : it_max

      x_new(1) = b(1) - a(3,1) * x(2);
      for i = 2 : n - 1
        x_new(i) = b(i) - a(1,i) * x(i-1) - a(3,i) * x(i+1);
      end
      x_new(n) = b(n) - a(1,n) * x(n-1);

      x_new(1:n) = x_new(1:n) ./ a(2,1:n);

      x(1:n) = x_new(1:n);

    end

  else

    for it_num = 1 : it_max

      x_new(1) = b(1) - a(1,2) * x(2);
      for i = 2 : n - 1
        x_new(i) = b(i) - a(3,i-1) * x(i-1) - a(1,i+1) * x(i+1);
      end
      x_new(n) = b(n) - a(3,n-1) * x(n-1);

      x_new(1:n) = x_new(1:n) ./ a(2,1:n);

      x(1:n) = x_new(1:n);

    end

  end

  x_new(1:n) = x(1:n);

  return
end


 function [smap x y] = mri_sensemap_sim(varargin)
%function [smap x y] = mri_sensemap_sim(varargin)
%|
%| Simulate 2D sensitivity maps for sensitivity-encoded MRI
%| based on grivich:00:tmf doi:10.1119/1.19461
%|
%| option
%|	nx, ny, dx, dy, ncoil, rcoil, coil_distance, orbit (see below)
%|	chat	0|1	show images?
%|
%| out
%|	smap	[nx ny ncoil]	simulated sensitivity maps (complex!)
%|
%| See also ir_mri_sensemap_sim.m for new 3D version!
%|
%| Copyright 2005-6-20, Jeff Fessler and Amanda Funai, University of Michigan
%| 2014-08-19 JF more testing, verifying phase is correct

if nargin == 1 % tests
	if streq(varargin{1}, 'test')
		mri_sensemap_sim_test
	elseif streq(varargin{1}, 'test1')
		mri_sensemap_sim_test1
	end
return
end

arg.nx = 64;
arg.ny = [];
arg.dx = 3; % pixel size in mm
arg.dy = [];
arg.ncoil = 4; % # of coils
arg.rcoil = 100; % coil radius
arg.orbit = 360;
arg.coil_distance = 1.2; % multiplies fov/2
arg.flag_old = false; % old way based on wang:00:dop
arg.chat = nargout == 0;

arg = vararg_pair(arg, varargin);

if isempty(arg.dy), arg.dy = arg.dx; end
if isempty(arg.ny), arg.ny = arg.nx; end
if isempty(arg.rcoil), arg.rcoil = arg.dx * arg.nx / 2 * 0.50; end

[smap x y] = mri_sensemap_sim_do(arg.nx, arg.ny, arg.dx, arg.dy, ...
	arg.ncoil, arg.rcoil, arg.orbit, arg.coil_distance, ...
	arg.flag_old, arg.chat);

if ~nargout, clear, end

% mri_sensemap_sim_do()
function [smap x y] = mri_sensemap_sim_do(nx, ny, dx, dy, ncoil, rcoil, ...
		orbit, coil_distance, flag_old, chat)

rlist = rcoil * ones(ncoil, 1); % coil radii

plist = zeros(ncoil,3); % position of coil center [x y 0]
nlist = zeros(ncoil,3); % normal vector (inward) from coil center

% circular coil configuration, like head coils
alist = deg2rad(orbit)/ncoil * [0:(ncoil-1)]; % list of coil angles in radians
for ii=1:ncoil
	phi = alist(ii);
	Rad = max(nx/2 * dx, ny/2 * dy) * coil_distance;
	plist(ii,:) = Rad * [cos(phi) sin(phi) 0];
	nlist(ii,:) = -[cos(phi) sin(phi) 0];
	olist(ii,:) = [-sin(phi) cos(phi) 0]; % unit vector orthogonal to nlist
end

% object coordinates for slice z=0
x = ([1:nx] - (nx+1)/2) * dx;
y = ([1:ny] - (ny+1)/2) * dy;
z = 0;
[xx yy zz] = ndgrid(x,y,z);

smap = zeros(nx, ny, ncoil, 'single');
for ii=1:ncoil
	% rotate coordinates to correspond to coil orientation
	zr =	(xx - plist(ii,1)) .* nlist(ii,1) + ...
		(yy - plist(ii,2)) .* nlist(ii,2) + ...
		(zz - plist(ii,3)) .* nlist(ii,3);
	xr =	xx .* nlist(ii,2) - yy .* nlist(ii,1);

	if 0 % see coordinates
		im plc 1 2
		im(1, x, y, xr), xlabel x, ylabel y
		im(2, x, y, zr)
		keyboard
	end

	[sx sy sz] = mri_smap1(xr, 0, zr, rlist(ii)); % in coil coordinates

	if 0 % see field components
		im plc 2 2
		im(1, x, y, sx), cbar
		im(2, x, y, sy), cbar
		im(3, x, y, sz), cbar
		im subplot 2
		tmp = sqrt(sx.^2 + sz.^2);
		quiver(x, y, (sx./tmp)', (sz./tmp)', 0), axis square
	end

	if flag_old
		smap(:,:,ii) = sz; % old way (wrong!) based only on smap_z

	else
		if nlist(ii,3) || olist(ii,3)
			fail 'unsupported'
		end
		% assume z component of plist and nlist are 0
		bx = sz * nlist(ii,1) + sx * olist(ii,1);
		by = sz * nlist(ii,2) + sx * olist(ii,2);
		smap(:,:,ii) = bx + 1i * by;

		if 0 % see final field components vs phase
			im subplot 4
			bb = sqrt(bx.^2 + by.^2);
			quiver(x, y, (bx./bb)', (by./bb)', 0), axis square
			im(2, x, y, angle(smap(:,:,ii))), cbar
			keyboard
		end
	end
end
smap = smap * rlist(1) / (2*pi); % trick: scale so maximum is near unity

if chat && im % show smap and array geometry in z=0 plane
	mri_sensemap_sim_show(smap, x, y, dx, dy, nlist, plist, rlist)
end

% mri_sensemap_sim_show()
function mri_sensemap_sim_show(smap, x, y, dx, dy, nlist, plist, rlist)
[nx ny ncoil] = size(smap);
nshow = min(max(ncoil,2),4);
im('plc', 3, nshow)
for ii=1:min(ncoil,nshow)
	clim = [0 max(abs(smap(:)))];
	tmp = smap(:,:,ii);
	im(ii, x, y, abs(tmp), clim, 'Magnitude'), cbar
%	xmax = max(max(abs(x)), max(plist(:,1)));
%	ymax = max(max(abs(y)), max(plist(:,2)));
	xmax = max([max(abs(x)) max(abs(y)) max(col(plist(:,[1 2])))]);
%	axis([-xmax xmax -ymax ymax]*1.05)
	axis(xmax * [-1 1 -1 1] * 1.1)
	xtick([-1 0 1] * nx/2 * dx)
	ytick([-1 0 1] * ny/2 * dy)

	hold on
	plot(0,0,'.', plist(:,1), plist(:,2), 'o')
	xdir = nlist(ii,2);
	ydir = nlist(ii,1);
	r = rlist(ii);
	plot(plist(ii,1)+r*xdir*[-1 1], plist(ii,2)+r*ydir*[1 -1], '-')
	hold off

%	ph = ir_unwrap(angle(tmp)); % trick: unwrap phase for pretty display
	ph = angle(tmp); % show raw phase (understandable with hsv colormap)
	im(ii+nshow, 'hsv', x, y, ph, [-pi pi], 'Phase'), cbar
	axis(xmax*[-1 1 -1 1]*1.1)
	xtick([-1 0 1] * nx/2 * dx)
	ytick([-1 0 1] * ny/2 * dy)
end

ssos = sqrt(sum(abs(smap), 3)); % bug! missing .^2 !
minmax(ssos)
ssos = ssos / ssos(end/2,end/2);
im(2*nshow+1, x, y, ssos, 'SSoS (normalized)'), cbar
xtick([-1 0 1] * nx/2 * dx)
ytick([-1 0 1] * ny/2 * dy)

if ncoil == 1
	subplot(122)
	bx = real(smap);
	by = imag(smap);
	quiver(x, y, bx', by'), title 'Field pattern in x-y plane'
	axis equal, axis tight
end

% clf, im(angle(smap(:,:,2))), cbar

% mri_smap_r(r, z)
% function for testing near 0
function out = mri_smap_r(r, z)
M = 4 * r ./ ((1 + r).^2 + z.^2); % = k^2, see ellipke
[K E] = ellipke(M);
out = 2 * z ./ r .* ((1 + r).^2 + z.^2).^(-0.5) .* ...
	((1 + r.^2 + z.^2) ./ ((1 - r).^2 + z.^2) .* E - K);

% mri_smap1()
% based on grivich:00:tmf
% for a circular coil in "x-y plane" of radius a
% note that coil x-y plane is not same as object x-y plane!
function [smap_x smap_y smap_z] = mri_smap1(x, y, z, a)
x = x ./ a; % normalized units
y = y ./ a;
z = z ./ a;
r = sqrt(x.^2 + y.^2);
M = 4 * r ./ ((1 + r).^2 + z.^2); % = k^2, see ellipke
[K E] = ellipke(M);
if ir_is_octave
	K = reshape(K, size(M)); % ellipke shape bug in octave
	E = reshape(E, size(M));
end

% the following is B_z in eqn (18) in grivich:00:tmf
% and same as eqn [10] in wang:00:dop to within constant scale factor
smap_z = 2 * ((1 + r).^2 + z.^2).^(-0.5) .* ...
	(K + (1 - r.^2 - z.^2) ./ ((1 - r).^2 + z.^2) .* E);
smap_z = smap_z / a;

if 0 && any(r(:) == 0) % test code to explore when r is near 0
	r0 = linspace(0,5e-7,101);
	z0 = 0.4;
	t0 = mri_smap_r(r0, z0);
	slope = 3*pi * z0 / ((1+z0^2)^2.5);
	clf, plot(r0, t0, '-', r0, slope * r0, '--'); grid, prompt
end

% the following is B_r in eqn (17) in grivich:00:tmf
smap_r = 2 * z ./ r .* ((1+r).^2 + z.^2).^(-0.5) .* ...
	((1 + r.^2 + z.^2) ./ ((1-r).^2 + z.^2) .* E - K);
bad = abs(r) < 1e-6;
smap_r(bad) = 3 * pi * z(bad) ./ ((1 + z(bad).^2).^2.5) .* r(bad);
smap_r = smap_r / a;

if any(isnan(smap_r(:))) || any(isnan(smap_z(:)))
	keyboard
end

smap_x = smap_r .* div0(x, r);
smap_y = smap_r .* div0(y, r);

%phi = atan2(y, x);
%smap_x = smap_r .* cos(phi);
%smap_y = smap_r .* sin(phi);

% mri_sensemap_sim_test1
% test mri_smap1 routine, cf Fig. 4 of grivich:00:tmf
function mri_sensemap_sim_test1
a = 1;
x = linspace(-2,2,99);
y = linspace(-2,2,97);
zlist = [0.1 0.2 0.5 1.0];
[xx yy zz] = ndgrid(x, y, zlist);
[smap_x smap_y smap_z] = mri_smap1(xx, yy, zz, a);
im('plc', 4, numel(zlist))
mri_sensemap_sim_test1_show(smap_x, x, y, 0, zlist, 'x')
mri_sensemap_sim_test1_show(smap_y, x, y, 4, zlist, 'y')
mri_sensemap_sim_test1_show(smap_z, x, y, 8, zlist, 'z')
smap_b = sqrt(smap_x.^2 + smap_y.^2);
mri_sensemap_sim_test1_show(smap_b, x, y, 12, zlist, 'b')

% mri_sensemap_sim_test1_show()
function mri_sensemap_sim_test1_show(map, x, y, offset, zlist, leg)
clim = [-20 20];
for iz = 1:numel(zlist)
	p = (iz-1) * 4;
	im(offset+iz, x, y, map(:,:,iz), leg, clim), cbar
	axis equal
	if iz == 1
		xtick([-2 2]), ytick([-2 2])
	else
		xtick off, ytick off
	end
	if zlist(iz) < 0.5
		blim = [7 12 19];
	else
		blim = [1 3 5];
	end
	hold on
	contour(x, y, abs(map(:,:,iz))', blim, 'b-')
	contour(x, y, abs(map(:,:,iz))', [0 0]+0.001, 'g-')
	hold off
end
drawnow

% mri_sensemap_sim_test
function mri_sensemap_sim_test

[smap x y] = mri_sensemap_sim('chat', 1, 'nx', 32, ...
	'rcoil', [], 'ncoil', 4, 'coil_distance', 1.2);

if 1 % check rotational symmetry in 4-coil case
	for ic=2:4
		tmp = rot90(smap(:,:,1), (ic-1));
		equivs(abs(tmp), abs(smap(:,:,ic)))
	%	im(8+ic, x, y, abs(tmp)), cbar
		p1 = angle(tmp) + (ic-1) * pi/2; % add pi/2 to rotated
		p2 = angle(smap(:,:,ic));
		tmp = exp(1i * (p2 - p1));
		equivs(tmp, ones(size(tmp))) % trick: equivs mod 2*pi
	end
end

if 0 && im % see ellipke
	m = linspace(0,1,101);
	[k e] = ellipke(m);
	clf, plot(m, k, '-', m, e, '--'), legend('k', 'e')
	yaxis_pi('0 p/2 p 3*p/2')
end


%kkshad 'Compute the object surface shading giving a 3D cue '
% This MatLab function was automatically generated by a converter (KhorosToMatLab) from the Khoros kshad.pane file
%
% Parameters:
% InputFile: i1 'Z-buffer', required: 'Distance between view plane and object surface'
% OutputFile: o 'Shading', required: 'Shading information using Phong s model'
% Integer: background 'background', default: 255: 'Image background color (gray level)'
% Integer: Imin ' minimum ', default: 100: 'Minimum intensity of light that reaches the object surface '
% Integer: Imax ' maximum ', default: 244: 'Maximum intensity of light that reaches the object surface '
% InputFile: i2 'Normal Vectors', optional: 'Surface normal vectors'
% Double: Ka 'ambient ', default: 20: 'Coeficient of reflection for the ambient light'
% Double: Kd 'difuse ', default: 80: 'Coeficient of reflection for the difuse light'
% Double: Ks 'specular', default: 20: 'Coficient of reflection for the specular light'
% Integer: n 'n factor', default: 7: 'Falling factor for the specular light'
% Double: alpha 'alpha', default: 0: 'View plane rotation angle around Z axis'
% Double: beta 'beta ', default: 0: 'View plane rotation angle around X axis'
% InputFile: i3 '"Texture"', optional: '"Texture" information to be incorporated on shading'
% Double: Kt '"texture"', default: 0: 'Coficient of texture influence'
%
% Example: o = kkshad({i1, i2, i3}, {'i1','';'o','';'background',255;'Imin',100;'Imax',244;'i2','';'Ka',20;'Kd',80;'Ks',20;'n',7;'alpha',0;'beta',0;'i3','';'Kt',0})
%
% Khoros helpfile follows below:
%
%  PROGRAM
% kshad - Compute shading
%
%  DESCRIPTION
% Create a shaded image file based on z-buffer and/or normal vectors.
%
% The operator "kshad"
% creates a shaded image file of type KUBYTE from the z-buffer of a volume and
% optionally, also from the normal vectors of the volume.
%
% There are two
% shading possibilities: depth shading and gradient shading. The depth shading
% uses only the z-buffer information from the input file. The gradient shading
% uses the z-buffer and the angles between the normals and the light source
% direction (given by angles alpha and beta) to create the shaded image.
%
% The normal vectors can be computed in three different ways: in the image
% space, in the object space and in the voxel space. Each one will possibly
% give a different shaded image. These vectors must have their directions
% inverted (pointing towards the interior of the object).
%
% The input parameters Imax, Imin, Ka, Kd, Ks, and n, are chosen to
% adjust the gradient shading quality according to the Phong equation (see
% equation below).
% However, the depth shading only needs the Imax and Imin parameters. The
% image background color (gray level) also can be chosen by the user. If the
% texture information is to be added, then the texture file as well as the
% texture coeficient Kt must be given.
%
% Angles alpha and beta estabilish rotations of the light source around z and x
% axes respectively (see figure in man page of kzbuff), and they are
% recommended to be
% the same used to generate the z-buffer image (so that observer and light
% source have the same position), avoiding problems with shadowing, not
% implemented. Different values of alpha and beta can be used without
% restrictions when there is only one object and its visible surface is
% convex. The rotations are made firstly around x and then around z.
%
% Depth Shading Intensity (Id):
% Id(u,v) = [(Imax-Imin)/(dmin-dmax)] * [d(u,v)-dmax] + Imin
% where
% d corresponds to the distance in the z-buffer image
%
% Gradient Shading Intensity (Ig):
% Ig(u,v) = Imax*Ka + Id(u,v)*{kd*cos[theta(u,v)] + Ks*[cos(2*theta(u,v))^n] +
% Kt*T(u,v)}
% where
% theta is the angle between the surface nomal and the ray of light;
% Ka is the coeficient of reflection for the ambient light;
% Kd is the coeficient of diffuse reflection;
% Ks is the coeficient of specular reflection;
% Kt is the coeficient of texture;
% T is the optional texture information;
%
%
%
%  EXAMPLES
% kshad -i1 zbuffer.viff -i2 normals.viff -o image.viff -Ka 30 -Kd 80 -Ks 20
%       -n 7 -Imax 220 -Imin 100 -background 255 -alpha 0 -beta 0
%
% The program will create from the zbuffer.viff and normals.viff files an image
% represented by the
% image.viff file using the gradient shading. The gradient
% shading will use 30% (Ka) of reflection coeficient for the ambient light,
% 80% (Kd) of difuse reflection coeficient and 20% (Ks) of specular reflection
% coeficient for the light source. The maximum (Imax) and minimum (Imin)
% intensity of the light source reflected on the object surface will be
% respectively 220 and 100. The falling factor (n) for the specular reflection
% light component will be 7 and the image background color (gray level) will
% be 255. The zbuffer.viff image was generated by a view plane rotated zero
% degree around x axis and zero degree around z axis, therefore the position
% of the light source is given by setting angles alpha and beta to zero.
%
%  "SEE ALSO"
% kzbuff, kisnorm, kvsnorm, ktextu, kvoxext
%
%  RESTRICTIONS
% The input objects must have only the value segment.
%
% The z-buffer and texture
% input objects can not have dimention e > 1. The input object normal must have
% dimention e=3.
%
% The input objects must match in their dimentions w and h.
%
% The input objects can not be of data types KBIT and KCOMPLEX.
%
% In case of t > 1 in the input objects, the operator will be applied to the time
% t=0 only.
%
% None of the input and output objects are referenced, therefore some attributes
% may change, as the VALUE_POSITION, for example.
%
%  REFERENCES
%
%  COPYRIGHT
% Copyright (C) 1993, 1994, 1995 UNICAMP, R A Lotufo,  All rights reserved.
%

function varargout = kkshad(varargin)
if nargin ==0
  Inputs={};arglist={'',''};
elseif nargin ==1
  Inputs=varargin{1};arglist={'',''};
elseif nargin ==2
  Inputs=varargin{1}; arglist=varargin{2};
else error('Usage: [out1,..] = kkshad(Inputs,arglist).');
end
if size(arglist,2)~=2
  error('arglist must be of form {''ParameterTag1'',value1;''ParameterTag2'',value2}')
 end
narglist={'i1', '__input';'o', '__output';'background', 255;'Imin', 100;'Imax', 244;'i2', '__input';'Ka', 20;'Kd', 80;'Ks', 20;'n', 7;'alpha', 0;'beta', 0;'i3', '__input';'Kt', 0};
maxval={0,0,255,255,255,1,100,100,100,200,0,0,1,100};
minval={0,0,0,0,0,1,0,0,0,0,0,0,1,0};
istoggle=[0,0,1,1,1,1,1,1,1,1,1,1,1,1];
was_set=istoggle * 0;
paramtype={'InputFile','OutputFile','Integer','Integer','Integer','InputFile','Double','Double','Double','Integer','Double','Double','InputFile','Double'};
% identify the input arrays and assign them to the arguments as stated by the user
if ~iscell(Inputs)
Inputs = {Inputs};
end
NumReqOutputs=1; nextinput=1; nextoutput=1;
  for ii=1:size(arglist,1)
  wasmatched=0;
  for jj=1:size(narglist,1)
   if strcmp(arglist{ii,1},narglist{jj,1})  % a given argument was matched to the possible arguments
     wasmatched = 1;
     was_set(jj) = 1;
     if strcmp(narglist{jj,2}, '__input')
      if (nextinput > length(Inputs))
        error(['Input ' narglist{jj,1} ' has no corresponding input!']);
      end
      narglist{jj,2} = 'OK_in';
      nextinput = nextinput + 1;
     elseif strcmp(narglist{jj,2}, '__output')
      if (nextoutput > nargout)
        error(['Output nr. ' narglist{jj,1} ' is not present in the assignment list of outputs !']);
      end
      if (isempty(arglist{ii,2}))
        narglist{jj,2} = 'OK_out';
      else
        narglist{jj,2} = arglist{ii,2};
      end

      nextoutput = nextoutput + 1;
      if (minval{jj} == 0)
         NumReqOutputs = NumReqOutputs - 1;
      end
     elseif isstr(arglist{ii,2})
      narglist{jj,2} = arglist{ii,2};
     else
        if strcmp(paramtype{jj}, 'Integer') & (round(arglist{ii,2}) ~= arglist{ii,2})
            error(['Argument ' arglist{ii,1} ' is of integer type but non-integer number ' arglist{ii,2} ' was supplied']);
        end
        if (minval{jj} ~= 0 | maxval{jj} ~= 0)
          if (minval{jj} == 1 & maxval{jj} == 1 & arglist{ii,2} < 0)
            error(['Argument ' arglist{ii,1} ' must be bigger or equal to zero!']);
          elseif (minval{jj} == -1 & maxval{jj} == -1 & arglist{ii,2} > 0)
            error(['Argument ' arglist{ii,1} ' must be smaller or equal to zero!']);
          elseif (minval{jj} == 2 & maxval{jj} == 2 & arglist{ii,2} <= 0)
            error(['Argument ' arglist{ii,1} ' must be bigger than zero!']);
          elseif (minval{jj} == -2 & maxval{jj} == -2 & arglist{ii,2} >= 0)
            error(['Argument ' arglist{ii,1} ' must be smaller than zero!']);
          elseif (minval{jj} ~= maxval{jj} & arglist{ii,2} < minval{jj})
            error(['Argument ' arglist{ii,1} ' must be bigger than ' num2str(minval{jj})]);
          elseif (minval{jj} ~= maxval{jj} & arglist{ii,2} > maxval{jj})
            error(['Argument ' arglist{ii,1} ' must be smaller than ' num2str(maxval{jj})]);
          end
        end
     end
     if ~strcmp(narglist{jj,2},'OK_out') &  ~strcmp(narglist{jj,2},'OK_in')
       narglist{jj,2} = arglist{ii,2};
     end
   end
   end
   if (wasmatched == 0 & ~strcmp(arglist{ii,1},''))
        error(['Argument ' arglist{ii,1} ' is not a valid argument for this function']);
   end
end
% match the remaining inputs/outputs to the unused arguments and test for missing required inputs
 for jj=1:size(narglist,1)
     if  strcmp(paramtype{jj}, 'Toggle')
        if (narglist{jj,2} ==0)
          narglist{jj,1} = '';
        end;
        narglist{jj,2} = '';
     end;
     if  ~strcmp(narglist{jj,2},'__input') && ~strcmp(narglist{jj,2},'__output') && istoggle(jj) && ~ was_set(jj)
          narglist{jj,1} = '';
          narglist{jj,2} = '';
     end;
     if strcmp(narglist{jj,2}, '__input')
      if (minval{jj} == 0)  % meaning this input is required
        if (nextinput > size(Inputs))
           error(['Required input ' narglist{jj,1} ' has no corresponding input in the list!']);
        else
          narglist{jj,2} = 'OK_in';
          nextinput = nextinput + 1;
        end
      else  % this is an optional input
        if (nextinput <= length(Inputs))
          narglist{jj,2} = 'OK_in';
          nextinput = nextinput + 1;
        else
          narglist{jj,1} = '';
          narglist{jj,2} = '';
        end;
      end;
     else
     if strcmp(narglist{jj,2}, '__output')
      if (minval{jj} == 0) % this is a required output
        if (nextoutput > nargout & nargout > 1)
           error(['Required output ' narglist{jj,1} ' is not stated in the assignment list!']);
        else
          narglist{jj,2} = 'OK_out';
          nextoutput = nextoutput + 1;
          NumReqOutputs = NumReqOutputs-1;
        end
      else % this is an optional output
        if (nargout - nextoutput >= NumReqOutputs)
          narglist{jj,2} = 'OK_out';
          nextoutput = nextoutput + 1;
        else
          narglist{jj,1} = '';
          narglist{jj,2} = '';
        end;
      end
     end
  end
end
if nargout
   varargout = cell(1,nargout);
else
  varargout = cell(1,1);
end
global KhorosRoot
if exist('KhorosRoot') && ~isempty(KhorosRoot)
w=['"' KhorosRoot];
else
if ispc
  w='"C:\Program Files\dip\khorosBin\';
else
[s,w] = system('which cantata');
w=['"' w(1:end-8)];
end
end
[varargout{:}]=callKhoros([w 'kshad"  '],Inputs,narglist);