/*
    This file is part of SeDuMi 1.03BETA
    Copyright (C) 1999 Jos F. Sturm
    Dept. Quantitative Economics, Maastricht University, the Netherlands.
    Affiliations up to SeDuMi 1.02 (AUG1998):
      CRL, McMaster University, Canada.
      Supported by the Netherlands Organization for Scientific Research (NWO).
  
    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 should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

*/
#include <string.h>
#include "triuaux.h"
#include "blksdp.h"

/* ************************************************************
   PROCEDURE matperm - Let Y = X(perm,perm)
   INPUT
     x -  n x n input matrix
     perm - length n permutation
     n - order
   OUTPUT
     y - n x n matrix, Y = X(perm,perm)
   ************************************************************ */
void matperm(double *y, const double *x, const int *perm, const int n)
{
  int i,j,inz;
  const double *xj;

  inz = 0;
  for(j = 0; j < n; j++){
    xj = x + perm[j] * n;
    for(i = 0; i < n; i++)
      y[inz++] = xj[perm[i]];
  }
}

/* ************************************************************
   PROCEDURE invmatperm - Let Y(perm,perm) = X
   ************************************************************ */
void invmatperm(double *y, const double *x, const int *perm, const int n)
{
  int i,j,inz;
  double *yj;

  inz = 0;
  for(j = 0; j < n; j++){
    yj = y + perm[j] * n;
    for(i = 0; i < n; i++)
      yj[perm[i]] = x[inz++];
  }
}

/* ************************************************************
   PROCEDURE realltxl: Computes L'*X*L in only n*(n+1)^2/2
   multiplications.
   INPUT
     l - n x n full matrix, tril(l) = L.
     x - n x n full symmetric matrix: instead of X*L, we actually
       compute X'*L.
     n - order.
   OUTPUT
     y - n x n full matrix; tril(Y) = tril(L'*X*L).
   WORK
     xl - length n^2 working vector, to store tril(X'*L).
   ************************************************************ */
void realltxl(double *y, const double *ld, const double *x,
              const int n, double *xld)
{
  int inz, i,j, m, icol, jcol;
/* ------------------------------------------------------------
   Compute xl = tril(X'*L):   n^2 + (n-1)^2 + .. + 1^2 mults.
   For each j, let xj and lj point to x(j,j) and l(j,j); m is
   remaining length of column j, i.e. m=n-j.
   ------------------------------------------------------------ */
  inz = 0; jcol = 0;
  for(j = 0, m = n; j < n; j++, m--, jcol += n+1){
    inz += j;                                 /* go to tril */
    for(i = j, icol = jcol; i < n; i++, icol += n)
      xld[inz++] = realdot(x+icol,ld+jcol,m);   /*xl(i,j) = x(:,i)'*l(j:n,j) */
  }
/* ------------------------------------------------------------
   Compute y = tril(L'*XL):  1*n + 2*(n-1) + ... + n*1 mults.
   ------------------------------------------------------------ */
  inz = 0; jcol = 0;
  for(j = 0; j < n; j++, jcol += n+1){
    inz += j;                                 /* go to tril */
    for(i = j, icol = jcol; i < n; i++, icol += n+1){
      y[inz] = realdot(ld + icol,xld+inz,n-i); /* yij = l(i:n,i)' * xl(:,j) */
      inz++;
    }
  }
}

/* ************************************************************
   PROCEDURE prpiltxl: Computes L'*X*L, with X,L complex, diag(L) real.
   INPUT
     l - n x n full matrix, tril(l) = L. Assume IM diag(L) is all-0.
     x - n x n full Hermitian matrix: instead of X*L, we actually
       compute X'*L.
     n - order.
   OUTPUT
     y - n x n full matrix; tril(Y) = tril(L'*X*L).
   WORK
     xld - length 2 * n^2 working vector, to store tril(X'*L).
   ************************************************************ */
void prpiltxl(double *y,double *ypi, const double *ld,const double *ldpi,
              const double *x,const double *xpi,
              const int n, double *xld)
{
  int inz, i,j, m, icol, jcol;
  double *xldpi;
/* ------------------------------------------------------------
   Partition working array xld into real and imaginary part
   ------------------------------------------------------------ */
  xldpi = xld + SQR(n);
/* ------------------------------------------------------------
   Compute xl = tril(X'*L)        (= tril(XL), since X is Hermitian.)
   For each j, let xj and lj point to x(j,j) and l(j,j); m is
   remaining length of column j, i.e. m=n-j.
   ------------------------------------------------------------ */
  inz = 0; jcol = 0;
  for(j = 0, m = n; j < n; j++, m--, jcol += n+1){
    inz += j;                                 /* go to tril */
    for(i = j, icol = jcol; i < n; i++, icol += n){
/* xl(i,j) = x(:,i)'*l(j:n,j), assume IM l(j,j) == 0 */
      xld[inz] = realdot(x+icol,ld+jcol,m)
        + realdot(xpi+icol+1,ldpi+jcol+1,m-1);
      xldpi[inz] = realdot(x+icol+1,ldpi+jcol+1,m-1)
        - realdot(xpi+icol,ld+jcol,m);
      inz++;
    }
  }
/* ------------------------------------------------------------
   Compute y = tril(L'*XL)
   ------------------------------------------------------------ */
  inz = 0; jcol = 0;
  for(j = 0; j < n; j++, jcol += n+1){
    inz += j;                                 /* go to tril */
    for(i = j, icol = jcol; i < n; i++, icol += n+1){
/* yij = l(i:n,i)' * xl(:,j). Assume IM l(i,i) == 0 */
      y[inz] = realdot(ld + icol,xld+inz,n-i)
        + realdot(ldpi + icol+1,xldpi+inz+1,n-i-1);
      ypi[inz] = realdot(ld + icol,xldpi+inz,n-i)
        - realdot(ldpi+icol+1,xld+inz+1,n-i-1);;
      inz++;
    }
  }
}

/* ************************************************************
   PROCEDURE utmulx - Compute y = triu(U'*XU), U upper triag, in
   1*n + 2*(n-1) + ... + n*1 mults. Only triu(XU) will be used.
   ************************************************************ */
void utmulx(double *y, const double *u, const double *xu, const int n)
{
  int inz,i,j, m;
  const double *ui;

  inz = 0;
  for(j = 0, m = n; j < n; j++, xu += n){
    for(i = 0, ui = u; i <= j; i++, ui += n)
      y[inz++] = realdot(ui,xu,i+1);     /* yij = u(0:i,i)' * xu(0:i,j) */
    inz += --m;                          /* skip tril */
  }
}

/* ************************************************************
   PROCEDURE prpiutmulx - Compute y = triu(U'*XU), U upper triag, in
   4*(1*n + 2*(n-1) + ... + n*1) - n(n-1) mults. Only triu(XU) will be used.
   CAUTION: assumes that diag(imag(U)) == 0.
   ************************************************************ */
void prpiutmulx(double *y, double *ypi, const double *u, const double *upi,
                const double *xu, const double *xupi, const int n)
{
  int inz,i,j, m, icol;

  inz = 0;
  for(j = 0, m = n; j < n; j++, xu += n, xupi += n){
    for(i = 0, icol = 0; i <= j; i++, icol += n){
/* yij = u(0:i,i)' * xu(0:i,j) where IM(u(i,i))==0*/
      y[inz] = realdot(u+icol,xu,i+1) + realdot(upi + icol, xupi,i);
      ypi[inz] = realdot(u+icol,xupi,i+1) - realdot(upi + icol, xu, i);
      inz++;
    }
    inz += --m;                          /* skip tril */
  }
}

/* ************************************************************
   PROCEDURE realutxu: Computes U'*X*U in only n*(n+1)^2/2
   multiplications.
   INPUT
     u - n x n full matrix, triu(u) = U.
     x - n x n full symmetric matrix: instead of X*U, we actually
       compute X'*U.
     n - order.
   OUTPUT
     y - n x n full matrix; triu(Y) = triu(U'*X*U).
   WORK
     xu - length n^2 working vector, to store triu(X'*U).
   ************************************************************ */
void realutxu(double *y, const double *u, const double *x,
              const int n, double *xu)
{
  int inz, i,j, m, icol,jcol;
/* ------------------------------------------------------------
   Compute xu = triu(X'*U):   1^2 + 2^2 + ... + (n-1)^2 + n^2 mults.
   For each j, let uj point to u(0,j); m is
   remaining length of column j, i.e. m=j.
   ------------------------------------------------------------ */
  inz = 0; jcol = 0;
  for(j = 0, m = n; j < n; j++, jcol += n){
    for(i = 0, icol = 0; i <= j; i++, icol += n)
      xu[inz++] = realdot(x+icol,u+jcol,j+1);  /*xu(i,j) = x(:,i)'*u(0:j,j) */
    inz += --m;                                /* skip tril */
  }
/* ------------------------------------------------------------
   Compute y = triu(U'*XU):  1*n + 2*(n-1) + ... + n*1 mults.
   ------------------------------------------------------------ */
  utmulx(y, u, xu, n);
}

/* ************************************************************
   PROCEDURE prpiutxu: Computes U'*X*U with complex data.
   INPUT
     u - n x n full matrix, triu(u) = U.
     x - n x n full symmetric matrix: instead of X*U, we actually
       compute X'*U.
     n - order.
   OUTPUT
     y - n x n full matrix; triu(Y) = triu(U'*X*U).
   WORK
     xu - length n^2 working vector, to store triu(X'*U).
   ************************************************************ */
void prpiutxu(double *y, double *ypi, const double *u, const double *upi,
              const double *x, const double *xpi,
              const int n, double *xu)
{
  int inz, i,j, m, icol,jcol;
  double *xupi;
/* ------------------------------------------------------------
   Partition working array xu into real and imaginary part
   ------------------------------------------------------------ */
  xupi = xu + SQR(n);
/* ------------------------------------------------------------
   Compute xu = triu(X'*U)   ( =triu(XU), since X is Hermitian.)
   For each j, let uj point to u(0,j); m is
   remaining length of column j, i.e. m=j.
   ------------------------------------------------------------ */
  inz = 0; jcol = 0;
  for(j = 0, m = n; j < n; j++, jcol += n){
    for(i = 0, icol = 0; i <= j; i++, icol += n){
/*xu(i,j) = x(:,i)'*u(0:j,j), assume IM u(j,j) == 0 */
      xu[inz] = realdot(x+icol,u+jcol,j+1) + realdot(xpi+icol,upi+jcol,j);
      xupi[inz] = realdot(x+icol,upi+jcol,j) - realdot(xpi+icol,u+jcol,j+1);
      inz++;
    }
    inz += --m;                                /* skip tril */
  }
/* ------------------------------------------------------------
   Compute y = triu(U'*XU)
   ------------------------------------------------------------ */
  prpiutmulx(y, ypi, u, upi, xu, xupi, n);
}

/* ************************************************************
   PROCEDURE partfwsolve -- Solve y from U(1:n,1:n)'*y(1:n) = x(1:n)
      where U is upper-triangular, and of order m >= n.
   INPUT
     u - m x m full matrix; only its upper-triangular entries get used
     x - length n vector.
     m - order of u, m >= n
     n - order of x
   OUTPUT
     y - length n vector, y = (U'\x)_{1:n}.
   ************************************************************ */
void partfwsolve(double *y, const double *u, const double *x,
                const int m, const int n)
{
  int k;
/* ------------------------------------------------------------
   The first equation, u(:,1)'*y=x(1), yields y(1) = x(1)/u(1,1).
   For k = 2:n, we solve
   u(1:k-1,k)'*y(1:k-1) + u(k,k)*y(k) = x(k).
   ------------------------------------------------------------ */
  y[0] = x[0] / u[0];
  u += m;                             /* done with the first column of u */
  for(k = 1; k < n; k++, u += m)
    y[k] = (x[k] - realdot(y,u,k)) / u[k];
}

/* Complex case. Assume IM diag(u) is all-0.
 Solves U' * y = x */
void prpipartfwsolve(double *y,double *ypi, const double *u,const double *upi,
                     const double *x,const double *xpi,
                     const int m, const int n)
{
  int k;
/* ------------------------------------------------------------
   The first equation, u(:,1)'*y=x(1), yields y(1) = x(1)/u(1,1).
   For k = 2:n, we solve
   u(1:k-1,k)'*y(1:k-1) + u(k,k)*y(k) = x(k).
   Assume that IM u(k,k) == 0.
   ------------------------------------------------------------ */
  y[0] = x[0] / u[0];
  ypi[0] = xpi[0] / u[0];
  u += m;                             /* done with the first column of u */
  upi += m;
  for(k = 1; k < n; k++, u += m, upi+=m){
/* y(k) = {x(k) - u(1:k-1,k)'*y(1:k-1)} / ukk */
    y[k] = (x[k] - realdot(u,y,k) - realdot(upi,ypi,k)) / u[k];
    ypi[k] = (xpi[k] - realdot(u,ypi,k) + realdot(upi,y,k)) / u[k];
  }
}

/* ************************************************************
   PROCEDURE partbwsolve -- Solve y from L(j:m,j:m)'*y(j:m) = x(j:m)
      where L is lower-triangular, and of order m > j.
   INPUT
     l - m x m full matrix; only its lower-triangular entries get used
     x - length n vector.
     m - order of l, m > j
     j - last entry of x to be computed (going backwards). If j = 0, then
       all m entries are computed, otherwise only the m-j bottom ones.
       0 <= j < m.
   OUTPUT
     y - length m vector, y[j:m-1] = (L'\x)_{[j:m-1]}.
   ************************************************************ */
void partbwsolve(double *y, const double *l, const double *x,
                 const int m, const int j)
{
  int k;
  const double *lk;
  double ldoty;
/* ------------------------------------------------------------
   The last equation, l(:,m)'*y=x(m), yields y(m) = x(m)/l(m,m).
   For k = m-1:j, we solve
   l(k+1:m,k)'*y(k+1:m) + l(k,k)*y(k) = x(k).
   ------------------------------------------------------------ */
  k = m-1;
  lk = l + m*k;
  ldoty = 0.0;
  for(k = m-1; k > j; k--){
    y[k] = (x[k] - ldoty) / lk[k];
    lk -= m;
    ldoty = realdot(y+k,lk+k,m-k);       /* ldoty = l(k:m,k-1)'*y(k:m) */
  }
  y[j] = (x[j] - ldoty) / lk[j];
}

/* Complex case. Assume IM diag(l) is all-0.
 Solves L' * y = x */
void prpipartbwsolve(double *y,double *ypi, const double *l,const double *lpi,
                     const double *x,const double *xpi,
                     const int m, const int j)
{
  int k;
  const double *lk, *lkpi;
  double ldoty, ldotyim;
/* ------------------------------------------------------------
   The last equation, l(:,m)'*y=x(m), yields y(m) = x(m)/l(m,m).
   For k = m-1:j, we solve
   l(k+1:m,k)'*y(k+1:m) + l(k,k)*y(k) = x(k). Assume l(k,k) == 0.
   ------------------------------------------------------------ */
  k = m-1;
  lk = l + m*k; lkpi = lpi + m*k;
  ldoty = 0.0; ldotyim = 0.0;
  for(k = m-1; k > j; k--){
/* y(k) = (x(k) - l(k+1:m,k)'*y(k+1:m)) / l(k,k) */
    y[k] = (x[k] - ldoty) / lk[k];
    ypi[k] = (xpi[k] - ldotyim) / lk[k];
/* ldoty = l(k:m,k-1)'*y(k:m) */
    lk -= m; lkpi -= m;
    ldoty = realdot(lk+k,y+k,m-k) + realdot(lkpi+k,ypi+k,m-k);;
    ldotyim = realdot(lk+k,ypi+k,m-k) - realdot(lkpi+k,y+k,m-k);;
  }
  y[j] = (x[j] - ldoty) / lk[j];
  ypi[j] = (xpi[j] - ldotyim) / lk[j];
}

/* ************************************************************
   PROCEDURE invutxu: Computes U'\(X/U) in only n*(n+1)^2/2
   multiplications.
   INPUT
     u - m x m full matrix, triu(u) = U.
     x - m x m full symmetric matrix: instead of triu(X/U), we actually
       compute tril(U'\X)' literally.
     m - order.
   OUTPUT
     y - m x m full matrix; triu(Y) = triu(U'\X/U).
   WORK
     xu - length m^2 working vector, to store triu(X/U).
   ************************************************************ */
void invutxu(double *y, const double *u, const double *x,
              const int m, double *xu)
{
  int j, jcol;
/* ------------------------------------------------------------
   Compute xu = (X/U)' = U'\X because X is symmetric.
   ------------------------------------------------------------ */
  jcol = 0;
  for(j = 0; j < m; j++, jcol += m)        /* Computes complete U'\X */
    partfwsolve(xu+jcol, u, x+jcol, m,m);
/* ------------------------------------------------------------
   Let triu(xu) = tril(ux)' = triu(X/U)    NB:discards triu(U'\X)
   ------------------------------------------------------------ */
  tril2sym(xu,m);
/* ------------------------------------------------------------
   Compute y = triu(U'\XU):  1*n + 2*(n-1) + ... + n*1 mults.
   viz. fwsolve to j-th entry in column j.
   ------------------------------------------------------------ */
  for(j = 1, jcol = 0; j <= m; j++, jcol += m)
    partfwsolve(y+jcol, u, xu+jcol, m,j);
}

/* ************************************************************
   PROCEDURE prpiinvutxu: Computes U'\(X/U) with complex data.
   INPUT
     u - m x m full matrix, triu(u) = U.
     x - m x m full symmetric matrix: instead of triu(X/U), we actually
       compute tril(U'\X)' literally.
     m - order.
   OUTPUT
     y - m x m full matrix; triu(Y) = triu(U'\X/U).
   WORK
     xu - length 2 * m^2 working vector, to store triu(X/U).
   ************************************************************ */
void prpiinvutxu(double *y,double *ypi, const double *u,const double *upi,
             const double *x,const double *xpi, const int m, double *xu)
{
  int j, jcol;
  double *xupi;
/* ------------------------------------------------------------
   Partition xu in real and imaginary part
   ------------------------------------------------------------ */
  xupi = xu + SQR(m);
/* ------------------------------------------------------------
   Compute xu = (X/U)' = U'\X because X is symmetric.
   ------------------------------------------------------------ */
  jcol = 0;
  for(j = 0; j < m; j++, jcol += m)        /* Computes complete U'\X */
    prpipartfwsolve(xu+jcol,xupi+jcol, u,upi, x+jcol,xpi+jcol, m,m);
/* ------------------------------------------------------------
   Let triu(xu) = tril(ux)' = triu(X/U)    NB:discards triu(U'\X)
   ------------------------------------------------------------ */
  tril2herm(xu,xupi,m);
/* ------------------------------------------------------------
   Compute y = triu(U'\XU):  1*n + 2*(n-1) + ... + n*1 mults.
   viz. fwsolve to j-th entry in column j.
   ------------------------------------------------------------ */
  for(j = 1, jcol = 0; j <= m; j++, jcol += m)
    prpipartfwsolve(y+jcol,ypi+jcol, u,upi, xu+jcol,xupi+jcol, m,j);
}

/* ************************************************************
   PROCEDURE invltxl: Computes L'\(X/L) in only n*(n+1)^2/2
   multiplications.
   INPUT
     l - m x m full matrix, tril(l) = L.
     x - m x m full symmetric matrix: instead of tril(X/L), we actually
       compute triu(L'\X)' literally.
     m - order.
   OUTPUT
     y - m x m full matrix; tril(Y) = tril(L'\X/L).
   WORK
     xl - length m^2 working vector, to store tril(X/L).
   ************************************************************ */
void invltxl(double *y, const double *l, const double *x,
              const int m, double *xl)
{
  int j, jcol;
/* ------------------------------------------------------------
   Compute xl = tril(X'/L)' = triu(L'\X)
   ------------------------------------------------------------ */
  jcol = 0;
  for(j = 0; j < m; j++, jcol += m)        /* Computes complete L'\X */
    partbwsolve(xl+jcol, l, x+jcol, m,0);
/* ------------------------------------------------------------
   Let tril(xl) = triu(lx)' = tril(X/L)    NB:discards tril(L'\X)
   ------------------------------------------------------------ */
  triu2sym(xl,m);
/* ------------------------------------------------------------
   Compute y = tril(L'\XL):  1*n + 2*(n-1) + ... + n*1 mults.
   viz. bwsolve to j-th entry in column j=0:m-1.
   ------------------------------------------------------------ */
  for(j = 0, jcol = 0; j < m; j++, jcol += m)
    partbwsolve(y+jcol, l, xl+jcol, m,j);
}

/* complex case. xl is 2*m^2. assume IM diag(l) is all-0. */
void prpiinvltxl(double *y,double *ypi, const double *l,const double *lpi,
                 const double *x,const double *xpi, const int m, double *xl)
{
  int j, jcol;
  double *xlpi;
/* ------------------------------------------------------------
   Partition xl in real and imaginary part
   ------------------------------------------------------------ */
  xlpi = xl + SQR(m);
/* ------------------------------------------------------------
   Compute xl = tril(X'/L)' = triu(L'\X)
   ------------------------------------------------------------ */
  jcol = 0;
  for(j = 0; j < m; j++, jcol += m)        /* Computes complete L'\X */
    prpipartbwsolve(xl+jcol,xlpi+jcol, l,lpi, x+jcol,xpi+jcol, m,0);
/* ------------------------------------------------------------
   Let tril(xl) = triu(lx)' = tril(X/L)    NB:discards tril(L'\X)
   ------------------------------------------------------------ */
  triu2herm(xl,xlpi,m);
/* ------------------------------------------------------------
   Compute y = tril(L'\XL)
   by bwsolve to j-th entry in column j=0:m-1.
   ------------------------------------------------------------ */
  for(j = 0, jcol = 0; j < m; j++, jcol += m)
    prpipartbwsolve(y+jcol,ypi+jcol, l,lpi, xl+jcol,xlpi+jcol, m,j);
}

/* ************************************************************
   PROCEDURE psdscaleK - Computes y = D(d)x over PSD blocks.
   Uses D=U'*U factorization, (transp == 0) Y = UXU'
   or (transp == 1) Y = U'XU.
   INPUT
     x - length lenud input vector.
     ud - Cholesky factor of d for PSD part (after PERM ordering).
     perm - ordering: UD=chol(d(perm,perm)), for numerical stability.
        If perm==NULL, then no reordering is applied.
     cK   - structure describing symmetric cone K.
   OUTPUT
     y - length lenud output vector, y=D(d)x for PSD blocks.
   WORK
     fwork - fwork(2*max(K.s)^2): length 2 * max(rmaxn^2,2*hmaxn^2)
       working vector.
   REMARK lenud := cK.rDim + cK.hDim
   ************************************************************ */
void psdscaleK(double *y, const double *ud, const int *perm, const double *x,
            const coneK cK, const char transp, double *fwork)
{
  int k,nk,nksqr;
  double *z, *zpi;
  char use_pivot;
/* ------------------------------------------------------------
   Partition fwork into fwork(psdblk) and z(psdblk), where
   psdblk = max(rmaxn^2,2*hmaxn^2). Let zpi = z+hmaxn^2.
   ------------------------------------------------------------ */
  use_pivot = (perm != (const int *) NULL);
  z = fwork + MAX(SQR(cK.rMaxn),2*SQR(cK.hMaxn));
  zpi = z + SQR(cK.hMaxn);
/* ------------------------------------------------------------
   PSD: (I) full and !transp
   Y = Ld' * X * Ld. Let Y=X(p,p), where Ld = Ud' (stored in tril(Ud)).
   tril(Y_new) = tril(Ld'* tril(Y*Ld)).
   ------------------------------------------------------------ */
  if(!transp){
    if(use_pivot){            /* with pivoting */
      for(k = 0; k < cK.rsdpN; k++){                /* real symmetric */
        nk = cK.sdpNL[k];
        matperm(z,x,perm,nk);
        realltxl(y,ud,z,nk,fwork);
        tril2sym(y,nk);
        nksqr = SQR(nk);
        y += nksqr; ud += nksqr;
        x += nksqr; perm += nk;
      }
      for(; k < cK.sdpN; k++){                     /* complex Hermitian */
        nk = cK.sdpNL[k];
        nksqr = SQR(nk);
        matperm(z,x,perm,nk);
        matperm(zpi,x+nksqr,perm,nk);
        prpiltxl(y,y+nksqr,ud,ud+nksqr,z,zpi,nk,fwork);
        tril2herm(y,y+nksqr,nk);
        nksqr += nksqr;                              /* 2*n^2 for real+imag */
        y += nksqr; ud += nksqr;
        x += nksqr; perm += nk;
      }
    }
    else{ /* without pivoting */
      for(k = 0; k < cK.rsdpN; k++){                /* real symmetric */
        nk = cK.sdpNL[k];
        realltxl(y,ud,x,nk,fwork);
        tril2sym(y,nk);
        nksqr = SQR(nk);
        y += nksqr; ud += nksqr;
        x += nksqr;
      }
      for(; k < cK.sdpN; k++){                     /* complex Hermitian */
        nk = cK.sdpNL[k];
        nksqr = SQR(nk);
        prpiltxl(y,y+nksqr,ud,ud+nksqr,x,x+nksqr,nk,fwork);
        tril2herm(y,y+nksqr,nk);
        nksqr += nksqr;                              /* 2*n^2 for real+imag */
        y += nksqr; ud += nksqr;
        x += nksqr;
      }
    }
  }
  else{
/* ------------------------------------------------------------
   (II) transp == 1 then Y = Ud' * X * Ud
   ------------------------------------------------------------ */
    if(use_pivot){            /* with pivoting */
      for(k = 0; k < cK.rsdpN; k++){                /* real symmetric */
        nk = cK.sdpNL[k];
        realutxu(z,ud,x,nk,fwork);
        triu2sym(z,nk);
        invmatperm(y,z,perm,nk);            /* Y(perm,perm) = Z */
        nksqr = SQR(nk);
        y += nksqr; ud += nksqr;
        x += nksqr; perm += nk;
      }
      for(; k < cK.sdpN; k++){                     /* complex Hermitian */
        nk = cK.sdpNL[k];
        nksqr = SQR(nk);
        prpiutxu(z,zpi, ud,ud+nksqr,x,x+nksqr,nk,fwork);
        triu2herm(z,zpi,nk);
        invmatperm(y,z,perm,nk);                     /* Y(perm,perm) = Z */
        invmatperm(y+nksqr,zpi,perm,nk);            /* imaginary part */
        nksqr += nksqr;                              /* 2*n^2 for real+imag */
        y += nksqr; ud += nksqr;
        x += nksqr; perm += nk;
      }
    }
    else{ /* without pivoting */
      for(k = 0; k < cK.rsdpN; k++){                /* real symmetric */
        nk = cK.sdpNL[k];
        realutxu(y,ud,x,nk,fwork);
        triu2sym(y,nk);
        nksqr = SQR(nk);
        y += nksqr; ud += nksqr;
        x += nksqr;
      }
      for(; k < cK.sdpN; k++){                     /* complex Hermitian */
        nk = cK.sdpNL[k];
        nksqr = SQR(nk);
        prpiutxu(y,y+nksqr, ud,ud+nksqr,x,x+nksqr,nk,fwork);
        triu2herm(y,y+nksqr,nk);
        nksqr += nksqr;                              /* 2*n^2 for real+imag */
        y += nksqr; ud += nksqr;
        x += nksqr;
      }
    }
  }
}

#ifdef SEDUMI_OLD
/* ************************************************************
   PROCEDURE scaleK - Computes y = D(d)x.
   For PSD, uses D=U'*U factorization, (transp == 0) Y = UXU'
   or (transp == 1) Y = U'XU.
   INPUT
     x - length N(K) input vector.
     d - scaling vector, only LP and Lorentz part needed.
     ud - Cholesky factor of d for PSD part (after PERM ordering).
     qdetd - sqrt(det(d)) for Lorentz part.
     perm - ordering: UD=chol(d(perm,perm)), for numerical stability.
     cK   - structure describing symmetric cone K.
     invdx - length cK.qDim vector containing D(d)\x for Lorentz part.
       This is optional. If invdx == NULL, then not used.
   OUTPUT
     y - length N(K) output vector, y=D(d)x.
     dmult - If !NULL then lorN-vector containing mu[k], such that
       (D(d)x)_k = y_k + mu[k] * d_k, where "_k" is the kth Lorentz block.
   WORK
     fwork - fwork(2*max(K.s)^2): length 2 * max(rmaxn^2,2*hmaxn^2)
       working vector.
   ************************************************************ */
void scaleK(double *y, double *dmult, const double *d, const double *ud,
            const double *qdetd, const int *perm, const double *x,
            const coneK cK, const char transp, const double *invdx,
            double *fwork)
{
  int k,nk;
  double detdk;
/* ------------------------------------------------------------
   LP: y = d .* x
   ------------------------------------------------------------ */
  realHadamard(y, d,x,cK.lpN);
  y += cK.lpN;             /* Next, point to lorentz & sdp blocks */
  d += cK.lpN; x += cK.lpN;
/* ------------------------------------------------------------
   LORENTZ (1/3): y = D(d) x
   ------------------------------------------------------------ */
  if(dmult == (double *) NULL)
    for(k = 0; k < cK.lorN; k++){
      nk = cK.lorNL[k];
      qlmul(y,d,x,qdetd[k],nk);
      y += nk; d += nk; x +=nk;
    }
  else
/* ------------------------------------------------------------
   LORENTZ (2/3): D(d) x = y + dmult * d. This storage scheme avoids
   cancelation in y.
   ------------------------------------------------------------ */
    if(invdx == (const double *) NULL)
      for(k = 0; k < cK.lorN; k++){
        nk = cK.lorNL[k];
        dmult[k] = qscale(y,d,x,qdetd[k],nk);
        y += nk; d += nk; x +=nk;
      }
    else{
/* ------------------------------------------------------------
   LORENTZ (3/3): D(d) x = D(d^2) invdx = y + dmult * d
   USES D(d^2)invdx = (d'*invdx) * d + det(d) * [-invdx(1); invdx(2:nk)]
   We let y = det(d) * [-invdx(1); invdx(2:nk)].
   ------------------------------------------------------------ */
      for(k = 0; k < cK.lorN; k++){
        nk = cK.lorNL[k];
        dmult[k] = realdot(d,invdx,nk);
        detdk = SQR(qdetd[k]);
        y[0] = - detdk * invdx[0];
        scalarmul(y+1, detdk,invdx+1,nk-1);
        y += nk; d += nk; invdx +=nk;
      }
      x += cK.qDim;         /* point beyond Lorentz */
    }
/* ------------------------------------------------------------
   PSD scale
   ------------------------------------------------------------ */
  psdscaleK(y, ud, perm, x, cK, transp, fwork);
}
#endif
