From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

 / 
PDL-LinearAlgebra-0.433
River stage one • 2 direct dependents • 3 total dependents
/ lib/PDL/LinearAlgebra/Complex.pd

NAME

PDL::LinearAlgebra::Complex - PDL interface to the lapack linear algebra programming library (complex number)

SYNOPSIS


            

              
              
use PDL;
use PDL::LinearAlgebra::Complex;
$a = random(cdouble, 100, 100);
$s = zeroes(cdouble, 100);
$u = zeroes(cdouble, 100, 100);
$v = zeroes(cdouble, 100, 100);
$info = 0;
$job = 0;
cgesdd($a, $job, $info, $s , $u, $v);

DESCRIPTION

This module provides an interface to parts of the lapack library (complex numbers). These routines accept either float or double ndarrays.

Solves the equation


            

              
              
A * X = B

where A is an n by n tridiagonal matrix, by Gaussian elimination with partial pivoting, and B is an n by nrhs matrix.

Note that the equation A**T*X = B may be solved by interchanging the order of the arguments DU and DL.

NB This differs from the LINPACK function cgtsl in that DL starts from its first element, while the LINPACK equivalent starts from its second element.


            

              
              
Arguments
=========
DL:   On entry, DL must contain the (n-1) sub-diagonal elements of A.
      On exit, DL is overwritten by the (n-2) elements of the
      second super-diagonal of the upper triangular matrix U from
      the LU factorization of A, in DL(1), ..., DL(n-2).
D:    On entry, D must contain the diagonal elements of A.
      On exit, D is overwritten by the n diagonal elements of U.
DU:   On entry, DU must contain the (n-1) super-diagonal elements of A.
      On exit, DU is overwritten by the (n-1) elements of the
      first super-diagonal of the U.
B:    On entry, the n by nrhs matrix of right hand side matrix B.
      On exit, if info = 0, the n by nrhs solution matrix X.
info:   = 0:  successful exit
        < 0:  if info = -i, the i-th argument had an illegal value
        > 0:  if info = i, U(i,i) is exactly zero, and the solution
              has not been computed.  The factorization has not been
              completed unless i = n.

            

          

            

              
              
$dl = random(float, 9) + random(float, 9) * i;
$d = random(float, 10) + random(float, 10) * i;
$du = random(float, 9) + random(float, 9) * i;
$b = random(10,5) + random(10,5) * i;
cgtsv($dl, $d, $du, $b, ($info=null));
print "X is:\n$b" unless $info;

');

pp_defc("gesvd", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)gesvd)(char *jobu, char *jobvt, integer *m, integer *n, $GENERIC() *a, integer *lda, $GENERIC() *s, $GENERIC() *u, int *ldu, $GENERIC() *vt, integer *ldvt, $GENERIC() *work, integer *lwork, $GENERIC() *rwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,m,n); int jobu(); int jobvt(); [o]s(minmn=CALC(PDLMIN($SIZE(m),$SIZE(n)))); [o]U(2,p,p); [o]VT(2,s,s); int [o]info(); [t]rwork(rworkn=CALC(5*$SIZE(minmn)));', RedoDimsCode => ' PDL_MAYBE_SIZE(PDL_Long, $PDL(jobu), tmp==1 || tmp==2, $PDL(U), $SIZE(p), $SIZE(m)) PDL_MAYBE_SIZE(PDL_Long, $PDL(jobvt), tmp==1 || tmp==2, $PDL(VT), $SIZE(s), $SIZE(n)) ', Code => generate_code ' integer lwork = -1; char trau, travt; $GENERIC() *rwork; $GENERIC() tmp_work[2];


            

              
              
switch ($jobu())
{
        case 1: trau = \'A\';
                break;
        case 2: trau = \'S\';
                break;
        case 3: trau = \'O\';
                break;
        default: trau = \'N\';
}
switch ($jobvt())
{
        case 1: travt = \'A\';
                break;
        case 2: travt = \'S\';
                break;
        case 3: travt = \'O\';
                break;
        default: travt = \'N\';
}
FORTRAN($TFD(c,z)gesvd)(
&trau,
&travt,
&(integer){$SIZE(m)},
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(m)},
$P(s),
$P(U),
&(integer){$SIZE(p)},
$P(VT),
&(integer){$SIZE(s)},
&tmp_work[0],
&lwork,
$P(rwork),
$P(info));
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc(2*lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)gesvd)(
&trau,
&travt,
&(integer){$SIZE(m)},
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(m)},
$P(s),
$P(U),
&(integer){$SIZE(p)},
$P(VT),
&(integer){$SIZE(s)},
work,
&lwork,
$P(rwork),
$P(info));
free(work);
}
',
Doc=>'

Complex version of "gesvd" in PDL::LinearAlgebra::Real.

The SVD is written


            

              
              
A = U * SIGMA * ConjugateTranspose(V)

');

pp_defc("gesdd", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)gesdd)(char *jobz, integer *m, integer *n, $GENERIC() * a, integer *lda, $GENERIC() *s, $GENERIC() *u, int *ldu, $GENERIC() *vt, integer *ldvt, $GENERIC() *work, integer *lwork, $GENERIC() *rwork, integer *iwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,m,n); int jobz(); [o]s(minmn=CALC(PDLMIN($SIZE(m),$SIZE(n)))); [o]U(2,p,p); [o]VT(2,s,s); int [o]info(); int [t]iwork(iworkn);', RedoDimsCode => ' PDL_MAYBE_SIZE(PDL_Long, $PDL(jobz), tmp==1 || (tmp==2) || (tmp==3 && $SIZE(m)<$SIZE(n)), $PDL(U), $SIZE(p), $SIZE(minmn)) PDL_MAYBE_SIZE(PDL_Long, $PDL(jobz), tmp==1 || (tmp==2) || (tmp==3 && $SIZE(m)>=$SIZE(n)), $PDL(VT), $SIZE(s), $SIZE(minmn)) $SIZE(iworkn) = 8 * $SIZE(minmn); ', Code => generate_code ' integer lwork; char tra; $GENERIC() *rwork; $GENERIC() tmp_work[2]; lwork = $SIZE(minmn);


            

              
              
switch ($jobz())
{
        case 1: tra = \'A\';
                rwork = ($GENERIC() *)malloc( (5 * lwork *lwork + 5 * lwork) * sizeof($GENERIC()));
                break;
        case 2: tra = \'S\';
                rwork = ($GENERIC() *)malloc( (5 * lwork *lwork + 5 * lwork) * sizeof($GENERIC()));
                break;
        case 3: tra = \'O\';
                rwork = ($GENERIC() *)malloc( (5 * lwork *lwork + 5 * lwork) * sizeof($GENERIC()));
                break;
        default: tra = \'N\';
                rwork = ($GENERIC() *)malloc( 7 * lwork  *  sizeof($GENERIC()));
                break;
}
lwork = -1;
FORTRAN($TFD(c,z)gesdd)(
&tra,
&(integer){$SIZE(m)},
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(m)},
$P(s),
$P(U),
&(integer){$SIZE(p)},
$P(VT),
&(integer){$SIZE(s)},
&tmp_work[0],
&lwork,
rwork,
$P(iwork),
$P(info));
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc(2 * lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)gesdd)(
&tra,
&(integer){$SIZE(m)},
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(m)},
$P(s),
$P(U),
&(integer){$SIZE(p)},
$P(VT),
&(integer){$SIZE(s)},
work,
&lwork,
rwork,
$P(iwork),
$P(info));
free(work);
}
free(rwork);
',
Doc=>'

Complex version of "gesdd" in PDL::LinearAlgebra::Real.

The SVD is written


            

              
              
A = U * SIGMA * ConjugateTranspose(V)

');

pp_defc("ggsvd", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)ggsvd3)(char *jobu, char *jobv, char *jobq, integer *m, integer *n, integer *p, integer *k, integer *l, $GENERIC() *a, integer *lda, $GENERIC() *b, integer *ldb, $GENERIC() *alpha, $GENERIC() *beta, $GENERIC() *u, integer *ldu, $GENERIC() *v, integer *ldv, $GENERIC() *q, integer *ldq, $GENERIC() *work, integer *lwork, $GENERIC() *rwork, integer *iwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,m,n); int jobu(); int jobv(); int jobq(); [io]B(2,p,n); int [o]k(); int [o]l();[o]alpha(n);[o]beta(n); [o]U(2,q,q); [o]V(2,r,r); [o]Q(2,s,s); int [o]iwork(n); int [o]info(); [t]rwork(rworkn=CALC(2*$SIZE(n)));', RedoDimsCode => ' PDL_MAYBE_SIZE(PDL_Long, $PDL(jobu), tmp, $PDL(U), $SIZE(q), $SIZE(m)) PDL_MAYBE_SIZE(PDL_Long, $PDL(jobv), tmp, $PDL(V), $SIZE(r), $SIZE(p)) PDL_MAYBE_SIZE(PDL_Long, $PDL(jobq), tmp, $PDL(Q), $SIZE(s), $SIZE(n)) ', Code => generate_code ' char pjobu = \'N\'; char pjobv = \'N\'; char pjobq = \'N\'; $GENERIC() *work, twork[2]; integer lwork = -1;


            

              
              
if ($jobu())
        pjobu = \'U\';
if ($jobv())
        pjobv = \'V\';
if ($jobq())
        pjobq = \'Q\';
FORTRAN($TFD(c,z)ggsvd3)(
&pjobu,
&pjobv,
&pjobq,
&(integer){$SIZE(m)},
&(integer){$SIZE(n)},
&(integer){$SIZE(p)},
$P(k),
$P(l),
$P(A),
&(integer){$SIZE(m)},
$P(B),
&(integer){$SIZE(p)},
$P(alpha),
$P(beta),
$P(U),
&(integer){$SIZE(q)},
$P(V),
&(integer){$SIZE(r)},
$P(Q),
&(integer){$SIZE(s)},
&twork[0],
&lwork,
$P(rwork),
$P(iwork),
$P(info));
lwork = (integer) twork[0];
work = ($GENERIC() *)malloc(2*(lwork * sizeof($GENERIC())));
FORTRAN($TFD(c,z)ggsvd3)(
&pjobu,
&pjobv,
&pjobq,
&(integer){$SIZE(m)},
&(integer){$SIZE(n)},
&(integer){$SIZE(p)},
$P(k),
$P(l),
$P(A),
&(integer){$SIZE(m)},
$P(B),
&(integer){$SIZE(p)},
$P(alpha),
$P(beta),
$P(U),
&(integer){$SIZE(q)},
$P(V),
&(integer){$SIZE(r)},
$P(Q),
&(integer){$SIZE(s)},
work,
&lwork,
$P(rwork),
$P(iwork),
$P(info));
free(work);
');

pp_defc("geev", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)geev)(char *jobvl, char *jobvr, integer *n, $GENERIC() *a, integer *lda, $GENERIC() *w, $GENERIC() *vl, integer *ldvl, $GENERIC() *vr, integer *ldvr, $GENERIC() *work, integer *lwork, $GENERIC() *rwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n); int jobvl(); int jobvr(); [o]w(2,n); [o]vl(2,m,m); [o]vr(2,p,p); int [o]info(); [t]rwork(rworkn=CALC(2*$SIZE(n)));', RedoDimsCode => ' PDL_MAYBE_SIZE(PDL_Long, $PDL(jobvl), tmp, $PDL(vl), $SIZE(m), $SIZE(n)) PDL_MAYBE_SIZE(PDL_Long, $PDL(jobvr), tmp, $PDL(vr), $SIZE(p), $SIZE(n)) ', Code => generate_code ' char jvl = \'N\'; char jvr = \'N\'; $GENERIC() tmp_work[2]; integer lwork = -1;


            

              
              
if ($jobvl())
        jvl = \'V\';
if ($jobvr())
        jvr = \'V\';
FORTRAN($TFD(c,z)geev)(
&jvl,
&jvr,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(w),
$P(vl),
&(integer){$SIZE(m)},
$P(vr),
&(integer){$SIZE(p)},
&tmp_work[0],
&lwork,
$P(rwork),
$P(info));
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc(2*lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)geev)(
&jvl,
&jvr,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(w),
$P(vl),
&(integer){$SIZE(m)},
$P(vr),
&(integer){$SIZE(p)},
work,
&lwork,
$P(rwork),
$P(info));
free(work);
}
');

pp_defc("geevx", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)geevx)(char *balanc, char *jobvl, char *jobvr, char * sense, integer *n, $GENERIC() *a, integer *lda, $GENERIC() *w, $GENERIC() *vl, integer *ldvl, $GENERIC() *vr, integer *ldvr, integer *ilo, integer *ihi, $GENERIC() *scale, $GENERIC() *abnrm, $GENERIC() *rconde, $GENERIC() *rcondv, $GENERIC() *work, integer *lwork, $GENERIC() *rwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n); int jobvl(); int jobvr(); int balance(); int sense(); [o]w(2,n); [o]vl(2,m,m); [o]vr(2,p,p); int [o]ilo(); int [o]ihi(); [o]scale(n); [o]abnrm(); [o]rconde(q); [o]rcondv(r); int [o]info(); [t]rwork(rworkn=CALC(2*$SIZE(n)));', RedoDimsCode => ' PDL_MAYBE_SIZE(PDL_Long, $PDL(jobvl), tmp, $PDL(vl), $SIZE(m), $SIZE(n)) PDL_MAYBE_SIZE(PDL_Long, $PDL(jobvr), tmp, $PDL(vr), $SIZE(p), $SIZE(n)) PDL_MAYBE_SIZE(PDL_Long, $PDL(sense), tmp == 1 || tmp == 3, $PDL(rconde), $SIZE(q), $SIZE(n)) PDL_MAYBE_SIZE(PDL_Long, $PDL(sense), tmp == 2 || tmp == 3, $PDL(rcondv), $SIZE(r), $SIZE(n)) ', Code => generate_code ' char jvl = \'N\'; char jvr = \'N\'; char balanc, sens; integer lwork = -1; $GENERIC() tmp_work[2];


            

              
              
if ($jobvl())
        jvl = \'V\';
if ($jobvr())
        jvr = \'V\';
switch ($balance())
{
        case 1: balanc = \'P\';
                break;
        case 2: balanc = \'S\';
                break;
        case 3: balanc = \'B\';
                break;
        default: balanc = \'N\';
}
switch ($sense())
{
        case 1: sens = \'E\';
                break;
        case 2: sens = \'V\';
                break;
        case 3: sens = \'B\';
                break;
        default: sens = \'N\';
}
FORTRAN($TFD(c,z)geevx)(
&balanc,
&jvl,
&jvr,
&sens,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(w),
$P(vl),
&(integer){$SIZE(m)},
$P(vr),
&(integer){$SIZE(p)},
$P(ilo),
$P(ihi),
$P(scale),
$P(abnrm),
$P(rconde),
$P(rcondv),
&tmp_work[0],
&lwork,
$P(rwork),
$P(info));
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc(2 * lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)geevx)(
&balanc,
&jvl,
&jvr,
&sens,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(w),
$P(vl),
&(integer){$SIZE(m)},
$P(vr),
&(integer){$SIZE(p)},
$P(ilo),
$P(ihi),
$P(scale),
$P(abnrm),
$P(rconde),
$P(rcondv),
work,
&lwork,
$P(rwork),
$P(info));
free(work);
}
');

pp_defc("ggev", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)ggev)(char *jobvl, char *jobvr, integer *n, $GENERIC() * a, integer *lda, $GENERIC() *b, integer *ldb, $GENERIC() *alpha, $GENERIC() *beta, $GENERIC() *vl, integer *ldvl, $GENERIC() *vr, integer *ldvr, $GENERIC() *work, integer *lwork, $GENERIC() *rwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n); int jobvl();int jobvr();[io]B(2,n,n);[o]alpha(2,n);[o]beta(2,n);[o]VL(2,m,m);[o]VR(2,p,p);int [o]info(); [t]rwork(rworkn=CALC(8*$SIZE(n)));', RedoDimsCode => ' PDL_MAYBE_SIZE(PDL_Long, $PDL(jobvl), tmp, $PDL(VL), $SIZE(m), $SIZE(n)) PDL_MAYBE_SIZE(PDL_Long, $PDL(jobvr), tmp, $PDL(VR), $SIZE(p), $SIZE(n)) ', Code => generate_code ' integer lwork = -1; char pjobvl = \'N\', pjobvr = \'N\'; $GENERIC() tmp_work[2]; if ($jobvl()) pjobvl = \'V\'; if ($jobvr()) pjobvr = \'V\';


            

              
              
FORTRAN($TFD(c,z)ggev)(
&pjobvl,
&pjobvr,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(B),
&(integer){$SIZE(n)},
$P(alpha),
$P(beta),
$P(VL),
&(integer){$SIZE(m)},
$P(VR),
&(integer){$SIZE(p)},
&tmp_work[0],
&lwork,
$P(rwork),
$P(info));
lwork = (integer )tmp_work[0];
{
        $GENERIC() *work = ($GENERIC() *)malloc(2 * lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)ggev)(
&pjobvl,
&pjobvr,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(B),
&(integer){$SIZE(n)},
$P(alpha),
$P(beta),
$P(VL),
&(integer){$SIZE(m)},
$P(VR),
&(integer){$SIZE(p)},
work,
&lwork,
$P(rwork),
$P(info));
free(work);
}
');

pp_defc("ggevx", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)ggevx)(char *balanc, char *jobvl, char *jobvr, char * sense, integer *n, $GENERIC() *a, integer *lda, $GENERIC() *b, integer *ldb, $GENERIC() *alpha, $GENERIC() * beta, $GENERIC() *vl, integer *ldvl, $GENERIC() *vr, integer *ldvr, integer *ilo, integer *ihi, $GENERIC() *lscale, $GENERIC() *rscale, $GENERIC() *abnrm, $GENERIC() *bbnrm, $GENERIC() *rconde, $GENERIC() * rcondv, $GENERIC() *work, integer *lwork, $GENERIC() *rwork, integer *iwork, logical * bwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n);int balanc();int jobvl();int jobvr();int sense();[io]B(2,n,n);[o]alpha(2,n);[o]beta(2,n);[o]VL(2,m,m);[o]VR(2,p,p);int [o]ilo();int [o]ihi();[o]lscale(n);[o]rscale(n);[o]abnrm();[o]bbnrm();[o]rconde(r);[o]rcondv(s);int [o]info(); [t]rwork(rworkn=CALC(6*$SIZE(n))); int [t]bwork(bworkn); int [t]iwork(iworkn);', RedoDimsCode => ' PDL_MAYBE_SIZE(PDL_Long, $PDL(jobvl), tmp, $PDL(VL), $SIZE(m), $SIZE(n)) PDL_MAYBE_SIZE(PDL_Long, $PDL(jobvr), tmp, $PDL(VR), $SIZE(p), $SIZE(n)) PDL_MAYBE_SIZE(PDL_Long, $PDL(sense), tmp != 2, $PDL(rconde), $SIZE(r), $SIZE(n)) PDL_MAYBE_SIZE(PDL_Long, $PDL(sense), tmp != 1, $PDL(rcondv), $SIZE(s), $SIZE(n)) PDL_MAYBE_SIZE(PDL_Long, $PDL(sense), tmp != 1, $PDL(iwork), $SIZE(iworkn), $SIZE(n) + 2) PDL_MAYBE_SIZE(PDL_Long, $PDL(sense), tmp == 1 || tmp == 2 || tmp == 3, $PDL(bwork), $SIZE(bworkn), $SIZE(n)) ', Code => generate_code ' integer lwork = -1; char pjobvl = \'N\', pjobvr = \'N\'; char pbalanc, psens;


            

              
              
$GENERIC() tmp_work[2];
if ($jobvl())
        pjobvl = \'V\';
if ($jobvr())
        pjobvr = \'V\';
switch ($balanc())
{
        case 1: pbalanc = \'P\';
                break;
        case 2: pbalanc = \'S\';
                break;
        case 3: pbalanc = \'B\';
                break;
        default: pbalanc = \'N\';
}
switch ($sense())
{
        case 1: psens = \'E\';
                break;
        case 2: psens = \'V\';
                break;
        case 3: psens = \'B\';
                break;
        default: psens = \'N\';
}
FORTRAN($TFD(c,z)ggevx)(
&pbalanc,
&pjobvl,
&pjobvr,
&psens,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(B),
&(integer){$SIZE(n)},
$P(alpha),
$P(beta),
$P(VL),
&(integer){$SIZE(m)},
$P(VR),
&(integer){$SIZE(p)},
$P(ilo),
$P(ihi),
$P(lscale),
$P(rscale),
$P(abnrm),
$P(bbnrm),
$P(rconde),
$P(rcondv),
&tmp_work[0],
&lwork,
$P(rwork),
$P(iwork),
$P(bwork),
$P(info));
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc(2 * lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)ggevx)(
&pbalanc,
&pjobvl,
&pjobvr,
&psens,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(B),
&(integer){$SIZE(n)},
$P(alpha),
$P(beta),
$P(VL),
&(integer){$SIZE(m)},
$P(VR),
&(integer){$SIZE(p)},
$P(ilo),
$P(ihi),
$P(lscale),
$P(rscale),
$P(abnrm),
$P(bbnrm),
$P(rconde),
$P(rcondv),
work,
&lwork,
$P(rwork),
$P(iwork),
$P(bwork),
$P(info));
free(work);
}
');

pp_addhdr(' void fselect_func_set(SV* func); void dselect_func_set(SV* func); PDL_Long fselect_wrapper(float *p); PDL_Long dselect_wrapper(double *p); ');

pp_defc("gees", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)gees)(char *jobvs, char *sort, L_fp select, integer *n, $GENERIC() *a, integer *lda, integer *sdim, $GENERIC() *w, $GENERIC() *vs, integer *ldvs, $GENERIC() *work, integer *lwork, $GENERIC() *rwork, logical *bwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n); int jobvs(); int sort(); [o]w(2,n); [o]vs(2,p,p); int [o]sdim(); int [o]info(); [t]rwork(n); int [t]bwork(bworkn);', RedoDimsCode => ' PDL_MAYBE_SIZE(PDL_Long, $PDL(jobvs), tmp, $PDL(vs), $SIZE(p), $SIZE(n)) PDL_MAYBE_SIZE(PDL_Long, $PDL(sort), tmp, $PDL(bwork), $SIZE(bworkn), $SIZE(n)) ', OtherPars => "SV* select_func" , Code => generate_code ' char jvs = \'N\'; char psort = \'N\'; integer lwork = -1;


            

              
              
                $GENERIC() tmp_work[2];
                $GENERIC() *work;
                $TFD(f,d)select_func_set($COMP(select_func));
                if ($jobvs())
                        jvs = \'V\';
                if ($sort()){
                        psort = \'S\';
                }
             FORTRAN($TFD(c,z)gees)(
                &jvs,
                &psort,
                $TFD(f,d)select_wrapper,
                &(integer){$SIZE(n)},
                $P(A),
                &(integer){$SIZE(n)},
                $P(sdim),
                $P(w),
                $P(vs),
                &(integer){$SIZE(p)},
                &tmp_work[0],
                &lwork,
                $P(rwork),
                $P(bwork),
                $P(info));
                lwork = (integer )tmp_work[0];
                work = ($GENERIC() *) malloc(2 * lwork *  sizeof($GENERIC()));
                FORTRAN($TFD(c,z)gees)(
                &jvs,
                &psort,
                $TFD(f,d)select_wrapper,
                &(integer){$SIZE(n)},
                $P(A),
                &(integer){$SIZE(n)},
                $P(sdim),
                $P(w),
                $P(vs),
                &(integer){$SIZE(p)},
                work,
                &lwork,
                $P(rwork),
                $P(bwork),
                $P(info));
                free(work);
                ',
        Doc=>'
=for ref

Complex version of "gees" in PDL::LinearAlgebra::Real


            

              
              
select_func:
        If sort = 1, select_func is used to select eigenvalues to sort
        to the top left of the Schur form.
        If sort = 0, select_func is not referenced.
        An complex eigenvalue w is selected if
        select_func(complex(w)) is true;
        Note that a selected complex eigenvalue may no longer
        satisfy select_func(complex(w)) = 1 after ordering, since
        ordering may change the value of complex eigenvalues
        (especially if the eigenvalue is ill-conditioned); in this
        case info is set to N+2.

');

pp_defc("geesx", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)geesx)(char *jobvs, char *sort, L_fp select, char * sense, integer *n, $GENERIC() *a, integer *lda, integer *sdim, $GENERIC() *w, $GENERIC() *vs, integer *ldvs, $GENERIC() *rconde, $GENERIC() *rcondv, $GENERIC() *work, integer *lwork, $GENERIC() *rwork, logical *bwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n); int jobvs(); int sort(); int sense(); [o]w(2,n);[o]vs(2,p,p); int [o]sdim(); [o]rconde();[o]rcondv(); int [o]info(); [t]rwork(n); int [t]bwork(bworkn);', RedoDimsCode => ' PDL_MAYBE_SIZE(PDL_Long, $PDL(jobvs), tmp, $PDL(vs), $SIZE(p), $SIZE(n)) PDL_MAYBE_SIZE(PDL_Long, $PDL(sort), tmp, $PDL(bwork), $SIZE(bworkn), $SIZE(n)) ', OtherPars => "SV* select_func" , Code => generate_code ' char jvs = \'N\'; char psort = \'N\'; integer lwork = -1; char sens;


            

              
              
                $GENERIC() *work;
                $TFD(f,d)select_func_set($COMP(select_func));
                if ($jobvs())
                        jvs = \'V\';
                if ($sort())
                        psort = \'S\';
                switch ($sense())
                {
                        case 1: sens = \'E\';
                                break;
                        case 2: sens = \'V\';
                                break;
                        case 3: sens = \'B\';
                                break;
                        default: sens = \'N\';
                }
                $GENERIC() tmp_work[2];
                FORTRAN($TFD(c,z)geesx)(
                &jvs,
                &psort,
                $TFD(f,d)select_wrapper,
                &sens,
                &(integer){$SIZE(n)},
                $P(A),
                &(integer){$SIZE(n)},
                $P(sdim),
                $P(w),
                $P(vs),
                &(integer){$SIZE(p)},
                $P(rconde),
                $P(rcondv),
                &tmp_work[0],
                &lwork,
                $P(rwork),
                $P(bwork),
                $P(info));
                lwork = (integer )tmp_work[0];
                work  = ($GENERIC() * )malloc(2*lwork * sizeof ($GENERIC()));
                FORTRAN($TFD(c,z)geesx)(
                &jvs,
                &psort,
                $TFD(f,d)select_wrapper,
                &sens,
                &(integer){$SIZE(n)},
                $P(A),
                &(integer){$SIZE(n)},
                $P(sdim),
                $P(w),
                $P(vs),
                &(integer){$SIZE(p)},
                $P(rconde),
                $P(rcondv),
                work,
                &lwork,
                $P(rwork),
                $P(bwork),
                $P(info));
                free(work);
',
      Doc => '
=for ref

Complex version of "geesx" in PDL::LinearAlgebra::Real


            

              
              
select_func:
        If sort = 1, select_func is used to select eigenvalues to sort
        to the top left of the Schur form.
        If sort = 0, select_func is not referenced.
        An complex eigenvalue w is selected if
        select_func(complex(w)) is true;
        Note that a selected complex eigenvalue may no longer
        satisfy select_func(complex(w)) = 1 after ordering, since
        ordering may change the value of complex eigenvalues
        (especially if the eigenvalue is ill-conditioned); in this
        case info is set to N+2.
');

pp_addhdr(' void fgselect_func_set(SV* func); void dgselect_func_set(SV* func); PDL_Long fgselect_wrapper(float *p); PDL_Long dgselect_wrapper(double *p); ');

pp_defc("gges", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)gges)(char *jobvsl, char *jobvsr, char *sort, L_fp delctg, integer *n, $GENERIC() *a, integer *lda, $GENERIC() *b, integer *ldb, integer *sdim, $GENERIC() *alpha, $GENERIC() *beta, $GENERIC() *vsl, integer *ldvsl, $GENERIC() *vsr, integer *ldvsr, $GENERIC() *work, integer *lwork, $GENERIC() *rwork, logical *bwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n); int jobvsl();int jobvsr();int sort();[io]B(2,n,n);[o]alpha(2,n);[o]beta(2,n);[o]VSL(2,m,m);[o]VSR(2,p,p);int [o]sdim();int [o]info(); [t]rwork(rworkn=CALC(8*$SIZE(n))); int [t]bwork(bworkn);', RedoDimsCode => ' PDL_MAYBE_SIZE(PDL_Long, $PDL(jobvsl), tmp, $PDL(VSL), $SIZE(m), $SIZE(n)) PDL_MAYBE_SIZE(PDL_Long, $PDL(jobvsr), tmp, $PDL(VSR), $SIZE(p), $SIZE(n)) PDL_MAYBE_SIZE(PDL_Long, $PDL(sort), tmp, $PDL(bwork), $SIZE(bworkn), $SIZE(n)) ', OtherPars => "SV* select_func" , Code => generate_code ' integer lwork = -1; char pjobvsl = \'N\', pjobvsr = \'N\', psort = \'N\'; $GENERIC() tmp_work[2]; $TFD(f,d)gselect_func_set($COMP(select_func)); if ($jobvsl()) pjobvsl = \'V\'; if ($jobvsr()) pjobvsr = \'V\'; if ($sort()) psort = \'S\'; FORTRAN($TFD(c,z)gges)( &pjobvsl, &pjobvsr, &psort, $TFD(f,d)gselect_wrapper, &(integer){$SIZE(n)}, $P(A), &(integer){$SIZE(n)}, $P(B), &(integer){$SIZE(n)}, $P(sdim), $P(alpha), $P(beta), $P(VSL), &(integer){$SIZE(m)}, $P(VSR), &(integer){$SIZE(p)}, &tmp_work[0], &lwork, $P(rwork), $P(bwork), $P(info));


            

              
              
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc(2 * lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)gges)(
&pjobvsl,
&pjobvsr,
&psort,
$TFD(f,d)gselect_wrapper,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(B),
&(integer){$SIZE(n)},
$P(sdim),
$P(alpha),
$P(beta),
$P(VSL),
&(integer){$SIZE(m)},
$P(VSR),
&(integer){$SIZE(p)},
work,
&lwork,
$P(rwork),
$P(bwork),
$P(info));
free(work);
}
',
Doc=>'

Complex version of "ggees" in PDL::LinearAlgebra::Real


            

              
              
select_func:
        If sort = 1, select_func is used to select eigenvalues to sort
        to the top left of the Schur form.
        If sort = 0, select_func is not referenced.
        An eigenvalue w = w/beta is selected if
        select_func(complex(w), complex(beta)) is true;
        Note that a selected complex eigenvalue may no longer
        satisfy select_func(complex(w),complex(beta)) = 1 after ordering, since
        ordering may change the value of complex eigenvalues
        (especially if the eigenvalue is ill-conditioned); in this
        case info is set to N+2.

');

pp_defc("ggesx", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)ggesx)(char *jobvsl, char *jobvsr, char *sort, L_fp delctg, char *sense, integer *n, $GENERIC() *a, integer *lda, $GENERIC() *b, integer *ldb, integer *sdim, $GENERIC() *alpha, $GENERIC() *beta, $GENERIC() *vsl, integer *ldvsl, $GENERIC() *vsr, integer *ldvsr, $GENERIC() *rconde, $GENERIC() *rcondv, $GENERIC() *work, integer *lwork, $GENERIC() *rwork, integer *iwork, integer *liwork, logical *bwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n); int jobvsl();int jobvsr();int sort();int sense();[io]B(2,n,n);[o]alpha(2,n);[o]beta(2,n);[o]VSL(2,m,m);[o]VSR(2,p,p);int [o]sdim();[o]rconde(q=2);[o]rcondv(q=2);int [o]info(); [t]rwork(rworkn=CALC(8*$SIZE(n))); int [t]bwork(bworkn); int [t]iwork(iworkn=CALC($SIZE(n)+2));', RedoDimsCode => ' PDL_MAYBE_SIZE(PDL_Long, $PDL(jobvsl), tmp, $PDL(VSL), $SIZE(m), $SIZE(n)) PDL_MAYBE_SIZE(PDL_Long, $PDL(jobvsr), tmp, $PDL(VSR), $SIZE(p), $SIZE(n)) PDL_MAYBE_SIZE(PDL_Long, $PDL(sort), tmp, $PDL(bwork), $SIZE(bworkn), $SIZE(n)) ', OtherPars => "SV* select_func" , Code => generate_code ' integer lwork, maxwrk; integer minwrk = 1; static integer c__0 = 0; static integer c__1 = 1; static integer c_n1 = -1; char pjobvsl = \'N\'; char pjobvsr = \'N\'; char psort = \'N\'; char psens = \'N\'; $TFD(f,d)gselect_func_set($COMP(select_func)); if ($jobvsr()) pjobvsr = \'V\'; if ($sort()) psort = \'S\';


            

              
              
switch ($sense())
{
        case 1: psens = \'E\';
                break;
        case 2: psens = \'V\';
                break;
        case 3: psens = \'B\';
                break;
        default: psens = \'N\';
}
// Code modified from Lapack
// TODO other schur form above
// The actual updated release (clapack 09/20/2000) do not allow
// the workspace query. See release notes of Lapack
// for this feature.
minwrk = $SIZE(n)  << 1;
maxwrk = $SIZE(n)  + $SIZE(n) * FORTRAN(ilaenv)(&c__1, "ZGEQRF", " ", &(integer){$SIZE(n)}, &c__1,
&(integer){$SIZE(n)}, &c__0, (ftnlen)6, (ftnlen)1);
if ($jobvsl())
{
        integer i__1 = maxwrk;
        integer i__2 = $SIZE(n) + $SIZE(n) * FORTRAN(ilaenv)(&c__1, "ZUNGQR"
                , " ", &(integer){$SIZE(n)}, &c__1, &(integer){$SIZE(n)}, &c_n1, (ftnlen)6, (ftnlen)1);
        maxwrk = max(i__1,i__2);
        pjobvsl = \'V\';
}
lwork = max(maxwrk,minwrk);
{
$GENERIC() *work = ($GENERIC() *)malloc( 2 * lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)ggesx)(
&pjobvsl,
&pjobvsr,
&psort,
$TFD(f,d)gselect_wrapper,
&psens,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(B),
&(integer){$SIZE(n)},
$P(sdim),
$P(alpha),
$P(beta),
$P(VSL),
&(integer){$SIZE(m)},
$P(VSR),
&(integer){$SIZE(p)},
$P(rconde),
$P(rcondv),
work,
&lwork,
$P(rwork),
$P(iwork),
&(integer){$SIZE(iworkn)},
$P(bwork),
$P(info));
free(work);
}
',
Doc=>'

Complex version of "ggeesx" in PDL::LinearAlgebra::Real


            

              
              
select_func:
        If sort = 1, select_func is used to select eigenvalues to sort
        to the top left of the Schur form.
        If sort = 0, select_func is not referenced.
        An eigenvalue w = w/beta is selected if
        select_func(complex(w), complex(beta)) is true;
        Note that a selected complex eigenvalue may no longer
        satisfy select_func(complex(w),complex(beta)) = 1 after ordering, since
        ordering may change the value of complex eigenvalues
        (especially if the eigenvalue is ill-conditioned); in this
        case info is set to N+3.

');

pp_defc("heev", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)heev)(char *jobz, char *uplo, integer *n, $GENERIC() *a, integer *lda, $GENERIC() *w, $GENERIC() *work, integer *lwork, $GENERIC() *rwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n); int jobz(); int uplo(); [o]w(n); int [o]info(); [t]rwork(rworkn=CALC(3*($SIZE(n)-2)));', Code => generate_code ' char jz = \'N\'; char puplo = \'U\'; integer lwork = -1; $GENERIC() tmp_work[2]; if ($jobz()) jz = \'V\'; if ($uplo()) puplo = \'L\';


            

              
              
FORTRAN($TFD(c,z)heev)(
&jz,
&puplo,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(w),
&tmp_work[0],
&lwork,
$P(rwork),
$P(info));
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc(2*lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)heev)(
&jz,
&puplo,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(w),
work,
&lwork,
$P(rwork),
$P(info));
free(work);
}
',
Doc=>'

Complex version of "syev" in PDL::LinearAlgebra::Real for Hermitian matrix

');

pp_defc("heevd", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)heevd)(char *jobz, char *uplo, integer *n, $GENERIC() *a, integer *lda, $GENERIC() *w, $GENERIC() *work, integer *lwork, $GENERIC() *rwork, integer *lrwork, integer *iwork, integer *liwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n); int jobz(); int uplo(); [o]w(n); int [o]info()', Code => generate_code ' char jz = \'N\'; char puplo = \'U\'; integer lwork = -1; integer lrwork, liwork; integer tmpi_work; integer *iwork; $GENERIC() tmp_work[2]; $GENERIC() tmpr_work;


            

              
              
if ($jobz())
        jz = \'V\';
if ($uplo())
        puplo = \'L\';
FORTRAN($TFD(c,z)heevd)(
&jz,
&puplo,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(w),
&tmp_work[0],
&lwork,
&tmpr_work,
&lwork,
&tmpi_work,
&lwork,
$P(info));
lwork = (integer )tmp_work[0];
lrwork = (integer )tmpr_work;
liwork = (integer )tmpi_work;
iwork = (integer *)malloc(liwork *  sizeof(integer));
{
$GENERIC() *work = ($GENERIC() *)malloc(2*lwork *  sizeof($GENERIC()));
$GENERIC() *rwork = ($GENERIC() *)malloc(lrwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)heevd)(
&jz,
&puplo,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(w),
work,
&lwork,
rwork,
&lrwork,
iwork,
&liwork,
$P(info));
free(rwork);
free(work);
}
free(iwork);
',
Doc=>'

Complex version of "syevd" in PDL::LinearAlgebra::Real for Hermitian matrix

');

pp_defc("heevx", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)heevx)(char *jobz, char *range, char *uplo, integer *n, $GENERIC() *a, integer *lda, $GENERIC() *vl, $GENERIC() *vu, integer * il, integer *iu, $GENERIC() *abstol, integer *m, $GENERIC() *w, $GENERIC() *z__, integer *ldz, $GENERIC() *work, integer *lwork, $GENERIC() *rwork, integer *iwork, integer *ifail, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n); int jobz(); int range(); int uplo(); vl(); vu(); int il(); int iu(); abstol(); int [o]m(); [o]w(n); [o]z(2,p,p);int [o]ifail(n); int [o]info(); [t]rwork(rworkn=CALC(7*$SIZE(n))); int [t]iwork(iworkn=CALC(5*$SIZE(n)));', RedoDimsCode => ' PDL_MAYBE_SIZE(PDL_Long, $PDL(jobz), tmp, $PDL(z), $SIZE(p), $SIZE(n)) ', Code => generate_code ' char jz = \'N\'; char puplo = \'U\'; char prange = \'A\'; integer lwork = -1; $GENERIC() tmp_work[2]; if ($jobz()) jz = \'V\'; if ($uplo()) puplo = \'L\';


            

              
              
switch ($range())
{
        case 1: prange = \'V\';
                break;
        case 2: prange = \'I\';
                break;
        default: prange = \'A\';
}
FORTRAN($TFD(c,z)heevx)(
&jz,
&prange,
&puplo,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(vl),
$P(vu),
$P(il),
$P(iu),
$P(abstol),
$P(m),
$P(w),
$P(z),
&(integer){$SIZE(p)},
&tmp_work[0],
&lwork,
$P(rwork),
$P(iwork),
$P(ifail),
$P(info));
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc(2* lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)heevx)(
&jz,
&prange,
&puplo,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(vl),
$P(vu),
$P(il),
$P(iu),
$P(abstol),
$P(m),
$P(w),
$P(z),
&(integer){$SIZE(p)},
work,
&lwork,
$P(rwork),
$P(iwork),
$P(ifail),
$P(info));
free(work);
}
',
Doc=>'

Complex version of "syevx" in PDL::LinearAlgebra::Real for Hermitian matrix

');

pp_defc("heevr", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)heevr)(char *jobz, char *range, char *uplo, integer *n, $GENERIC() *a, integer *lda, $GENERIC() *vl, $GENERIC() *vu, integer * il, integer *iu, $GENERIC() *abstol, integer *m, $GENERIC() *w, $GENERIC() *z__, integer *ldz, integer *isuppz, $GENERIC() *work, integer *lwork, $GENERIC() *rwork, integer *lrwork, integer *iwork, integer *liwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n); int jobz(); int range(); int uplo(); vl(); vu(); int il(); int iu(); abstol(); int [o]m(); [o]w(n); [o]z(2,p,q);int [o]isuppz(r); int [o]info()', Code => generate_code ' char jz = \'N\'; char puplo = \'U\'; char prange = \'A\'; integer lwork = -1; integer liwork,lrwork; integer tmpi_work;


            

              
              
$GENERIC() tmp_work[2];
$GENERIC() tmpr_work;
if ($jobz())
        jz = \'V\';
if ($uplo())
        puplo = \'L\';
switch ($range())
{
        case 1: prange = \'V\';
                break;
        case 2: prange = \'I\';
                break;
        default: prange = \'A\';
}
FORTRAN($TFD(c,z)heevr)(
&jz,
&prange,
&puplo,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(vl),
$P(vu),
$P(il),
$P(iu),
$P(abstol),
$P(m),
$P(w),
$P(z),
&(integer){$SIZE(p)},
$P(isuppz),
&tmp_work[0],
&lwork,
&tmpr_work,
&lwork,
&tmpi_work,
&lwork,
$P(info));
lwork = (integer )tmp_work[0];
lrwork = (integer )tmpr_work;
liwork = (integer )tmpi_work;
{
$GENERIC() *work = ($GENERIC() *)malloc(2* lwork *  sizeof($GENERIC()));
$GENERIC() *rwork = ($GENERIC() *)malloc(lrwork *  sizeof($GENERIC()));
integer *iwork = (integer *)malloc(liwork *  sizeof(integer));
FORTRAN($TFD(c,z)heevr)(
&jz,
&prange,
&puplo,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(vl),
$P(vu),
$P(il),
$P(iu),
$P(abstol),
$P(m),
$P(w),
$P(z),
&(integer){$SIZE(p)},
$P(isuppz),
work,
&lwork,
rwork,
&lrwork,
iwork,
&liwork,
$P(info));
free(work);
free(iwork);
free(rwork);
}

', Doc=>'

Complex version of "syevr" in PDL::LinearAlgebra::Real for Hermitian matrix

');

pp_defc("hegv", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)hegv)(integer *itype, char *jobz, char *uplo, integer * n, $GENERIC() *a, integer *lda, $GENERIC() *b, integer *ldb, $GENERIC() *w, $GENERIC() *work, integer *lwork, $GENERIC() *rwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n);int itype();int jobz(); int uplo();[io]B(2,n,n);[o]w(n); int [o]info(); [t]rwork(rworkn=CALC(3*($SIZE(n)-2)));', Code => generate_code ' char jz = \'N\'; char puplo = \'U\'; integer lwork = -1;


            

              
              
$GENERIC() tmp_work[2];
if ($jobz())
        jz = \'V\';
if ($uplo())
        puplo = \'L\';
FORTRAN($TFD(c,z)hegv)(
$P(itype),
&jz,
&puplo,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(B),
&(integer){$SIZE(n)},
$P(w),
&tmp_work[0],
&lwork,
$P(rwork),
$P(info));
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc(2 * lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)hegv)(
$P(itype),
&jz,
&puplo,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(B),
&(integer){$SIZE(n)},
$P(w),
work,
&lwork,
$P(rwork),
$P(info));
free(work);
}
',
Doc=>'
=for ref

Complex version of "sygv" in PDL::LinearAlgebra::Real for Hermitian matrix ');

pp_defc("hegvd", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)hegvd)(integer *itype, char *jobz, char *uplo, integer * n, $GENERIC() *a, integer *lda, $GENERIC() *b, integer *ldb, $GENERIC() *w, $GENERIC() *work, integer *lwork, $GENERIC() *rwork, integer *lrwork, integer *iwork, integer *liwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n);int itype();int jobz(); int uplo();[io]B(2,n,n);[o]w(n); int [o]info()', Code => generate_code ' char jz = \'N\'; char puplo = \'U\'; integer lwork = -1; integer liwork = -1; integer lrwork = -1; integer *iwork; integer tmp_iwork; $GENERIC() tmp_work[2], tmp_rwork;


            

              
              
if ($jobz())
        jz = \'V\';
if ($uplo())
        puplo = \'L\';
FORTRAN($TFD(c,z)hegvd)(
$P(itype),
&jz,
&puplo,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(B),
&(integer){$SIZE(n)},
$P(w),
&tmp_work[0],
&lwork,
&tmp_rwork,
&lrwork,
&tmp_iwork,
&liwork,
$P(info));
lwork = (integer )tmp_work[0];
lrwork = (integer )tmp_rwork;
liwork = (integer )tmp_iwork;
iwork = (integer *)malloc(liwork *  sizeof(integer));
{
$GENERIC() *work = ($GENERIC() *)malloc(2 * lwork *  sizeof($GENERIC()));
$GENERIC() *rwork = ($GENERIC() *)malloc(lrwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)hegvd)(
$P(itype),
&jz,
&puplo,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(B),
&(integer){$SIZE(n)},
$P(w),
work,
&lwork,
rwork,
&lrwork,
iwork,
&liwork,
$P(info));
free(work);
free(rwork);
}
free(iwork);
',
Doc=>'

Complex version of "sygvd" in PDL::LinearAlgebra::Real for Hermitian matrix

');

pp_defc("hegvx", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)hegvx)(integer *itype, char *jobz, char *range, char * uplo, integer *n, $GENERIC() *a, integer *lda, $GENERIC() *b, integer *ldb, $GENERIC() *vl, $GENERIC() *vu, integer *il, integer *iu, $GENERIC() *abstol, integer *m, $GENERIC() *w, $GENERIC() *z__, integer *ldz, $GENERIC() *work, integer *lwork, $GENERIC() *rwork, integer *iwork, integer *ifail, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n);int itype();int jobz();int range(); int uplo();[io]B(2,n,n);vl();vu();int il(); int iu();abstol();int [o]m();[o]w(n); [o]Z(2,p,p);int [o]ifail(n);int [o]info(); [t]rwork(rworkn=CALC(7*$SIZE(n))); int [t]iwork(iworkn=CALC(5*$SIZE(n))); ', RedoDimsCode => ' PDL_MAYBE_SIZE(PDL_Long, $PDL(jobz), tmp, $PDL(Z), $SIZE(p), $SIZE(n)) ', Code => generate_code ' char jz = \'N\'; char puplo = \'U\'; char prange; integer lwork = -1; $GENERIC() tmp_work[2]; if ($jobz()) jz = \'V\'; if ($uplo()) puplo = \'L\';


            

              
              
switch ($range())
{
        case 1: prange = \'V\';
                break;
        case 2: prange = \'I\';
                break;
        default: prange = \'A\';
}
FORTRAN($TFD(c,z)hegvx)(
$P(itype),
&jz,
&prange,
&puplo,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(B),
&(integer){$SIZE(n)},
$P(vl),
$P(vu),
$P(il),
$P(iu),
$P(abstol),
$P(m),
$P(w),
$P(Z),
&(integer){$SIZE(p)},
&tmp_work[0],
&lwork,
$P(rwork),
$P(iwork),
$P(ifail),
$P(info));
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc( 2 * lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)hegvx)(
$P(itype),
&jz,
&prange,
&puplo,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(B),
&(integer){$SIZE(n)},
$P(vl),
$P(vu),
$P(il),
$P(iu),
$P(abstol),
$P(m),
$P(w),
$P(Z),
&(integer){$SIZE(p)},
work,
&lwork,
$P(rwork),
$P(iwork),
$P(ifail),
$P(info));
free(work);
}
',
Doc=>'

Complex version of "sygvx" in PDL::LinearAlgebra::Real for Hermitian matrix

');

pp_defc("gesv", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)gesv)(integer *n, integer *nrhs, $GENERIC() *a, integer *lda, integer *ipiv, $GENERIC() *b, integer *ldb, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n); [io]B(2,n,m); int [o]ipiv(n); int [o]info()', Code => generate_code ' FORTRAN($TFD(c,z)gesv)( &(integer){$SIZE(n)}, &(integer){$SIZE(m)}, $P(A), &(integer){$SIZE(n)}, $P(ipiv), $P(B), &(integer){$SIZE(n)}, $P(info)); '); pp_defc("gesvx", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)gesvx)(char *fact, char *trans, integer *n, integer * nrhs, $GENERIC() *a, integer *lda, $GENERIC() *af, integer *ldaf, integer *ipiv, char *equed, $GENERIC() *r__, $GENERIC() *c__, $GENERIC() *b, integer *ldb, $GENERIC() *x, integer *ldx, $GENERIC() * rcond, $GENERIC() *ferr, $GENERIC() *berr, $GENERIC() *work, $GENERIC() * rwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n); int trans(); int fact(); [io]B(2,n,m); [io]af(2,n,n); int [io]ipiv(n); int [io]equed(); [o]r(p); [o]c(q); [o]X(2,n,m); [o]rcond(); [o]ferr(m); [o]berr(m); [o]rpvgrw(); int [o]info(); [t]rwork(rworkn=CALC(4*$SIZE(n))); [t]work(rworkn);', RedoDimsCode => ' $SIZE(p) = $SIZE(n); /* Ubuntu LAPACK 3 writes to r anyway */ $SIZE(q) = $SIZE(n); /* Ubuntu LAPACK 3 writes to c anyway */ ', Code => generate_code ' char ptrans, pfact, pequed; switch ($trans()) { case 1: ptrans = \'T\'; break; case 2: ptrans = \'C\'; break; default: ptrans = \'N\'; } switch ($fact()) { case 1: pfact = \'N\'; break; case 2: pfact = \'E\'; break; default: pfact = \'F\'; } switch ($equed()) { case 1: pequed = \'R\'; break; case 2: pequed = \'C\'; break; case 3: pequed = \'B\'; break; default: pequed = \'N\'; }


            

              
              
FORTRAN($TFD(c,z)gesvx)(
&pfact,
&ptrans,
&(integer){$SIZE(n)},
&(integer){$SIZE(m)},
$P(A),
&(integer){$SIZE(n)},
$P(af),
&(integer){$SIZE(n)},
$P(ipiv),
&pequed,
$P(r),
$P(c),
$P(B),
&(integer){$SIZE(n)},
$P(X),
&(integer){$SIZE(n)},
$P(rcond),
$P(ferr),
$P(berr),
$P(work),
$P(rwork),
$P(info));
switch (pequed)
{
        case \'R\': $equed() = 1;
                  break;
        case \'C\': $equed() = 2;
                  break;
        case \'B\': $equed() = 3;
                  break;
        default: $equed()= 0;
}
$rpvgrw()=$rwork(rworkn=>0);
',
Doc => '
=for ref

Complex version of "gesvx" in PDL::LinearAlgebra::Real.


            

              
              
trans:  Specifies the form of the system of equations:
        = 0:  A * X = B     (No transpose)
        = 1:  A\' * X = B  (Transpose)
        = 2:  A**H * X = B  (Conjugate transpose)
');

pp_defc("sysv", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)sysv)(char *uplo, integer *n, integer *nrhs, $GENERIC() *a, integer *lda, integer *ipiv, $GENERIC() *b, integer *ldb, $GENERIC() *work, integer *lwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n); int uplo(); [io]B(2,n,m); int [o]ipiv(n); int [o]info()', Code => generate_code ' char puplo = \'U\'; integer lwork = -1; $GENERIC() tmp_work[2]; if ($uplo()) puplo = \'L\';


            

              
              
                FORTRAN($TFD(c,z)sysv)(
                &puplo,
                &(integer){$SIZE(n)},
                &(integer){$SIZE(m)},
                $P(A),
                &(integer){$SIZE(n)},
                $P(ipiv),
                $P(B),
                &(integer){$SIZE(n)},
                &tmp_work[0],
                &lwork,
                $P(info));
                lwork = (integer )tmp_work[0];
                {
                $GENERIC() *work = ($GENERIC() *)malloc(2*lwork *  sizeof($GENERIC()));
                FORTRAN($TFD(c,z)sysv)(
                &puplo,
                &(integer){$SIZE(n)},
                &(integer){$SIZE(m)},
                $P(A),
                &(integer){$SIZE(n)},
                $P(ipiv),
                $P(B),
                &(integer){$SIZE(n)},
                work,
                &lwork,
                $P(info));
                free(work);
                }
');

pp_defc("sysvx", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)sysvx)(char *fact, char *uplo, integer *n, integer * nrhs, $GENERIC() *a, integer *lda, $GENERIC() *af, integer *ldaf, integer *ipiv, $GENERIC() *b, integer *ldb, $GENERIC() *x, integer * ldx, $GENERIC() *rcond, $GENERIC() *ferr, $GENERIC() *berr, $GENERIC() *work, integer *lwork, $GENERIC() *rwork, integer *info); EOF HandleBad => 0, Pars => 'A(2,n,n); int uplo(); int fact(); B(2,n,m); [io]af(2,n,n); int [io]ipiv(n); [o]X(2,n,m); [o]rcond(); [o]ferr(m); [o]berr(m); int [o]info(); [t]rwork(n);', Code => generate_code ' char pfact = \'N\'; char puplo = \'U\'; integer lwork = -1; $GENERIC() tmp_work[2];


            

              
              
if($fact())
        pfact = \'F\';
if ($uplo())
        puplo = \'L\';
FORTRAN($TFD(c,z)sysvx)(
&pfact,
&puplo,
&(integer){$SIZE(n)},
&(integer){$SIZE(m)},
$P(A),
&(integer){$SIZE(n)},
$P(af),
&(integer){$SIZE(n)},
$P(ipiv),
$P(B),
&(integer){$SIZE(n)},
$P(X),
&(integer){$SIZE(n)},
$P(rcond),
$P(ferr),
$P(berr),
&tmp_work[0],
&lwork,
$P(rwork),
$P(info));
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc(2*lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)sysvx)(
&pfact,
&puplo,
&(integer){$SIZE(n)},
&(integer){$SIZE(m)},
$P(A),
&(integer){$SIZE(n)},
$P(af),
&(integer){$SIZE(n)},
$P(ipiv),
$P(B),
&(integer){$SIZE(n)},
$P(X),
&(integer){$SIZE(n)},
$P(rcond),
$P(ferr),
$P(berr),
work,
&lwork,
$P(rwork),
$P(info));
free(work);
}
');

pp_defc("hesv", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)hesv)(char *uplo, integer *n, integer *nrhs, $GENERIC() *a, integer *lda, integer *ipiv, $GENERIC() *b, integer *ldb, $GENERIC() *work, integer *lwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n); int uplo(); [io]B(2,n,m); int [o]ipiv(n); int [o]info()', Code => generate_code ' char puplo = \'U\'; integer lwork = -1; $GENERIC() tmp_work[2]; if ($uplo()) puplo = \'L\';


            

              
              
                FORTRAN($TFD(c,z)hesv)(
                &puplo,
                &(integer){$SIZE(n)},
                &(integer){$SIZE(m)},
                $P(A),
                &(integer){$SIZE(n)},
                $P(ipiv),
                $P(B),
                &(integer){$SIZE(n)},
                &tmp_work[0],
                &lwork,
                $P(info));
                lwork = (integer )tmp_work[0];
                {
                $GENERIC() *work = ($GENERIC() *)malloc(2*lwork *  sizeof($GENERIC()));
                FORTRAN($TFD(c,z)hesv)(
                &puplo,
                &(integer){$SIZE(n)},
                &(integer){$SIZE(m)},
                $P(A),
                &(integer){$SIZE(n)},
                $P(ipiv),
                $P(B),
                &(integer){$SIZE(n)},
                work,
                &lwork,
                $P(info));
             }
',
Doc=>'
=for ref

Complex version of "sysv" in PDL::LinearAlgebra::Real for Hermitian matrix ');

pp_defc("hesvx", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)hesvx)(char *fact, char *uplo, integer *n, integer * nrhs, $GENERIC() *a, integer *lda, $GENERIC() *af, integer *ldaf, integer *ipiv, $GENERIC() *b, integer *ldb, $GENERIC() *x, integer * ldx, $GENERIC() *rcond, $GENERIC() *ferr, $GENERIC() *berr, $GENERIC() *work, integer *lwork, $GENERIC() *rwork, integer *info); EOF HandleBad => 0, Pars => 'A(2,n,n); int uplo(); int fact(); B(2,n,m); [io]af(2,n,n); int [io]ipiv(n); [o]X(2,n,m); [o]rcond(); [o]ferr(m); [o]berr(m); int [o]info(); [t]rwork(n);', Code => generate_code ' char pfact = \'N\'; char puplo = \'U\'; integer lwork = -1; $GENERIC() tmp_work[2];


            

              
              
if($fact())
        pfact = \'F\';
if ($uplo())
        puplo = \'L\';
FORTRAN($TFD(c,z)hesvx)(
&pfact,
&puplo,
&(integer){$SIZE(n)},
&(integer){$SIZE(m)},
$P(A),
&(integer){$SIZE(n)},
$P(af),
&(integer){$SIZE(n)},
$P(ipiv),
$P(B),
&(integer){$SIZE(n)},
$P(X),
&(integer){$SIZE(n)},
$P(rcond),
$P(ferr),
$P(berr),
&tmp_work[0],
&lwork,
$P(rwork),
$P(info));
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc(2*lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)hesvx)(
&pfact,
&puplo,
&(integer){$SIZE(n)},
&(integer){$SIZE(m)},
$P(A),
&(integer){$SIZE(n)},
$P(af),
&(integer){$SIZE(n)},
$P(ipiv),
$P(B),
&(integer){$SIZE(n)},
$P(X),
&(integer){$SIZE(n)},
$P(rcond),
$P(ferr),
$P(berr),
work,
&lwork,
$P(rwork),
$P(info));
free(work);
}
',
Doc=>'
=for ref

Complex version of "sysvx" in PDL::LinearAlgebra::Real for Hermitian matrix ');

pp_defc("posv", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)posv)(char *uplo, integer *n, integer *nrhs, $GENERIC() *a, integer *lda, $GENERIC() *b, integer *ldb, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n); int uplo(); [io]B(2,n,m); int [o]info()', Code => generate_code ' char puplo = \'U\'; if ($uplo()) puplo = \'L\';


            

              
              
FORTRAN($TFD(c,z)posv)(
&puplo,
&(integer){$SIZE(n)},
&(integer){$SIZE(m)},
$P(A),
&(integer){$SIZE(n)},
$P(B),
&(integer){$SIZE(n)},
$P(info));
',
Doc=>'

Complex version of "posv" in PDL::LinearAlgebra::Real for Hermitian positive definite matrix

'); pp_defc("posvx", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)posvx)(char *fact, char *uplo, integer *n, integer * nrhs, $GENERIC() *a, integer *lda, $GENERIC() *af, integer *ldaf, char *equed, $GENERIC() *s, $GENERIC() *b, integer *ldb, $GENERIC() * x, integer *ldx, $GENERIC() *rcond, $GENERIC() *ferr, $GENERIC() * berr, $GENERIC() *work, $GENERIC() *rwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n); int uplo(); int fact(); [io]B(2,n,m); [io]af(2,n,n); int [io]equed(); [o]s(p); [o]X(2,n,m); [o]rcond(); [o]ferr(m); [o]berr(m); int [o]info(); [t]rwork(rworkn=CALC(2*$SIZE(n))); [t]work(workn=CALC(4*$SIZE(n)));', RedoDimsCode => ' $SIZE(p) = $SIZE(n); /* Ubuntu LAPACK 3 writes to s anyway */ ', Code => generate_code ' char pfact; char pequed = \'N\'; char puplo = \'U\';


            

              
              
switch ($fact())
{
        case 1: pfact = \'N\';
                break;
        case 2: pfact = \'E\';
                break;
        default: pfact = \'F\';
}
if ($equed())
        pequed = \'Y\';
if ($uplo())
        puplo = \'L\';
FORTRAN($TFD(c,z)posvx)(
&pfact,
&puplo,
&(integer){$SIZE(n)},
&(integer){$SIZE(m)},
$P(A),
&(integer){$SIZE(n)},
$P(af),
&(integer){$SIZE(n)},
&pequed,
$P(s),
$P(B),
&(integer){$SIZE(n)},
$P(X),
&(integer){$SIZE(n)},
$P(rcond),
$P(ferr),
$P(berr),
$P(work),
$P(rwork),
$P(info));
switch (pequed)
{
        case \'Y\': $equed() = 1;
                  break;
        default: $equed()= 0;
}
',
Doc => '
=for ref

Complex version of "posvx" in PDL::LinearAlgebra::Real for Hermitian positive definite matrix ');

pp_defc("gels", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)gels)(char *trans, integer *m, integer *n, integer * nrhs, $GENERIC() *a, integer *lda, $GENERIC() *b, integer *ldb, $GENERIC() *work, integer *lwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,m,n); int trans(); [io]B(2,p,q);int [o]info()', Code => generate_code ' char ptrans = \'N\'; integer lwork = -1; $GENERIC() tmp_work[2];


            

              
              
if($trans())
        ptrans = \'C\';
FORTRAN($TFD(c,z)gels)(
&ptrans,
&(integer){$SIZE(m)},
&(integer){$SIZE(n)},
&(integer){$SIZE(q)},
$P(A),
&(integer){$SIZE(m)},
$P(B),
&(integer){$SIZE(p)},
&tmp_work[0],
&lwork,
$P(info));
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc(2*lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)gels)(
&ptrans,
&(integer){$SIZE(m)},
&(integer){$SIZE(n)},
&(integer){$SIZE(q)},
$P(A),
&(integer){$SIZE(m)},
$P(B),
&(integer){$SIZE(p)},
work,
&lwork,
$P(info));
free(work);
}
',
Doc=>'
=for ref

Solves overdetermined or underdetermined complex linear systems involving an M-by-N matrix A, or its conjugate-transpose. Complex version of "gels" in PDL::LinearAlgebra::Real.


            

              
              
trans:  = 0: the linear system involves A;
        = 1: the linear system involves A**H.
');

pp_defc("gelsy", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)gelsy)(integer *m, integer *n, integer *nrhs, $GENERIC() *a, integer *lda, $GENERIC() *b, integer *ldb, integer * jpvt, $GENERIC() *rcond, integer *rank, $GENERIC() *work, integer * lwork, $GENERIC() *rwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,m,n); [io]B(2,p,q); rcond(); int [io]jpvt(n); int [o]rank();int [o]info(); [t]rwork(rworkn=CALC(2*$SIZE(n)));', Code => generate_code ' integer lwork = -1; $GENERIC() tmp_work[2]; FORTRAN($TFD(c,z)gelsy)( &(integer){$SIZE(m)}, &(integer){$SIZE(n)}, &(integer){$SIZE(q)}, $P(A), &(integer){$SIZE(m)}, $P(B), &(integer){$SIZE(p)}, $P(jpvt), $P(rcond), $P(rank), &tmp_work[0], &lwork, $P(rwork), $P(info));


            

              
              
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc(2 * lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)gelsy)(
&(integer){$SIZE(m)},
&(integer){$SIZE(n)},
&(integer){$SIZE(q)},
$P(A),
&(integer){$SIZE(m)},
$P(B),
&(integer){$SIZE(p)},
$P(jpvt),
$P(rcond),
$P(rank),
work,
&lwork,
$P(rwork),
$P(info));
free(work);
}
');

pp_defc("gelss", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)gelss)(integer *m, integer *n, integer *nrhs, $GENERIC() *a, integer *lda, $GENERIC() *b, integer *ldb, $GENERIC() *s, $GENERIC() *rcond, integer *rank, $GENERIC() *work, integer * lwork, $GENERIC() *rwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,m,n); [io]B(2,p,q); rcond(); [o]s(r); int [o]rank();int [o]info(); [t]rwork(rworkn=CALC(5*PDLMIN($SIZE(m),$SIZE(n))));', Code => generate_code ' integer lwork = -1; $GENERIC() tmp_work[2]; FORTRAN($TFD(c,z)gelss)( &(integer){$SIZE(m)}, &(integer){$SIZE(n)}, &(integer){$SIZE(q)}, $P(A), &(integer){$SIZE(m)}, $P(B), &(integer){$SIZE(p)}, $P(s), $P(rcond), $P(rank), &tmp_work[0], &lwork, $P(rwork), $P(info));


            

              
              
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc(2 * lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)gelss)(
&(integer){$SIZE(m)},
&(integer){$SIZE(n)},
&(integer){$SIZE(q)},
$P(A),
&(integer){$SIZE(m)},
$P(B),
&(integer){$SIZE(p)},
$P(s),
$P(rcond),
$P(rank),
work,
&lwork,
$P(rwork),
$P(info));
free(work);
}
');

pp_defc("gelsd", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)gelsd)(integer *m, integer *n, integer *nrhs, $GENERIC() *a, integer *lda, $GENERIC() *b, integer *ldb, $GENERIC() *s, $GENERIC() *rcond, integer *rank, $GENERIC() *work, integer * lwork, $GENERIC() *rwork, integer *iwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,m,n); [io]B(2,p,q); rcond(); [o]s(minmn=CALC(PDLMAX(1,PDLMIN($SIZE(m),$SIZE(n))))); int [o]rank();int [o]info(); int [t]iwork(iworkn); [t]rwork(rworkn);', RedoDimsCode => ' integer smlsiz = FORTRAN(ilaenv)(&c_nine, "CGELSD", " ", &c_zero, &c_zero, &c_zero, &c_zero, (ftnlen)6, (ftnlen)1); integer size_i = (integer) (log((double) $SIZE(minmn) / (double) (smlsiz + 1)) /log(2.)) + 1; $SIZE(iworkn) = $SIZE(minmn) * (3 * PDLMAX(size_i,0) + 11); $SIZE(rworkn) = $SIZE(minmn) * (10 + 2 * smlsiz + 8 * size_i) + 3 * smlsiz * $SIZE(q) + pow(smlsiz+1,2); ', Code => generate_code ' integer lwork = -1; $GENERIC() tmp_work[2]; FORTRAN($TFD(c,z)gelsd)( &(integer){$SIZE(m)}, &(integer){$SIZE(n)}, &(integer){$SIZE(q)}, $P(A), &(integer){$SIZE(m)}, $P(B), &(integer){$SIZE(p)}, $P(s), $P(rcond), $P(rank), &tmp_work[0], &lwork, $P(rwork), $P(iwork), $P(info));


            

              
              
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc(2 * lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)gelsd)(
&(integer){$SIZE(m)},
&(integer){$SIZE(n)},
&(integer){$SIZE(q)},
$P(A),
&(integer){$SIZE(m)},
$P(B),
&(integer){$SIZE(p)},
$P(s),
$P(rcond),
$P(rank),
work,
&lwork,
$P(rwork),
$P(iwork),
$P(info));
free(work);
}
');

pp_defc("gglse", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)gglse)(integer *m, integer *n, integer *p, $GENERIC() * a, integer *lda, $GENERIC() *b, integer *ldb, $GENERIC() *c__, $GENERIC() *d__, $GENERIC() *x, $GENERIC() *work, integer *lwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,m,n); [io]B(2,p,n);[io]c(2,m);[io]d(2,p);[o]x(2,n);int [o]info()', Code => generate_code ' integer lwork = -1; $GENERIC() tmp_work[2];


            

              
              
FORTRAN($TFD(c,z)gglse)(
&(integer){$SIZE(m)},
&(integer){$SIZE(n)},
&(integer){$SIZE(p)},
$P(A),
&(integer){$SIZE(m)},
$P(B),
&(integer){$SIZE(p)},
$P(c),
$P(d),
$P(x),
&tmp_work[0],
&lwork,
$P(info));
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc(2 * lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)gglse)(
&(integer){$SIZE(m)},
&(integer){$SIZE(n)},
&(integer){$SIZE(p)},
$P(A),
&(integer){$SIZE(m)},
$P(B),
&(integer){$SIZE(p)},
$P(c),
$P(d),
$P(x),
work,
&lwork,
$P(info));
free(work);
}

');

pp_defc("ggglm", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)ggglm)(integer *n, integer *m, integer *p, $GENERIC() * a, integer *lda, $GENERIC() *b, integer *ldb, $GENERIC() *d__, $GENERIC() *x, $GENERIC() *y, $GENERIC() *work, integer *lwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,m); [io]B(2,n,p);[io]d(2,n);[o]x(2,m);[o]y(2,p);int [o]info()', Code => generate_code ' integer lwork = -1; $GENERIC() tmp_work[2];


            

              
              
FORTRAN($TFD(c,z)ggglm)(
&(integer){$SIZE(n)},
&(integer){$SIZE(m)},
&(integer){$SIZE(p)},
$P(A),
&(integer){$SIZE(n)},
$P(B),
&(integer){$SIZE(n)},
$P(d),
$P(x),
$P(y),
&tmp_work[0],
&lwork,
$P(info));
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc(2 * lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)ggglm)(
&(integer){$SIZE(n)},
&(integer){$SIZE(m)},
&(integer){$SIZE(p)},
$P(A),
&(integer){$SIZE(n)},
$P(B),
&(integer){$SIZE(n)},
$P(d),
$P(x),
$P(y),
work,
&lwork,
$P(info));
free(work);
}

');

################################################################################ # # COMPUTATIONAL LEVEL ROUTINES # ################################################################################ # TODO IPIV = min(m,n) pp_defc("getrf", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)getrf)(integer *m, integer *n, $GENERIC() *a, integer * lda, integer *ipiv, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,m,n); int [o]ipiv(p=CALC(PDLMIN($SIZE(m),$SIZE(n)))); int [o]info()', Code => generate_code ' FORTRAN($TFD(c,z)getrf)( &(integer){$SIZE(m)}, &(integer){$SIZE(n)}, $P(A), &(integer){$SIZE(m)}, $P(ipiv), $P(info)); ');

pp_defc("getf2", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)getf2)(integer *m, integer *n, $GENERIC() *a, integer * lda, integer *ipiv, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,m,n); int [o]ipiv(p=CALC(PDLMIN($SIZE(m),$SIZE(n)))); int [o]info()', Code => generate_code ' FORTRAN($TFD(c,z)getf2)( &(integer){$SIZE(m)}, &(integer){$SIZE(n)}, $P(A), &(integer){$SIZE(m)}, $P(ipiv), $P(info)); ');

pp_defc("sytrf", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)sytrf)(char *uplo, integer *n, $GENERIC() *a, integer * lda, integer *ipiv, $GENERIC() *work, integer *lwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n); int uplo(); int [o]ipiv(n); int [o]info()', Code => generate_code ' char puplo = \'U\'; integer lwork = -1; $GENERIC() tmp_work[2]; if ($uplo()) puplo = \'L\';


            

              
              
FORTRAN($TFD(c,z)sytrf)(
&puplo,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(ipiv),
&tmp_work[0],
&lwork,
$P(info));
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc(2*lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)sytrf)(
&puplo,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(ipiv),
work,
&lwork,
$P(info));
free (work);
}
');

pp_defc("sytf2", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)sytf2)(char *uplo, integer *n, $GENERIC() *a, integer * lda, integer *ipiv, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n); int uplo(); int [o]ipiv(n); int [o]info()', Code => generate_code ' char puplo = \'U\'; if ($uplo()) puplo = \'L\';


            

              
              
FORTRAN($TFD(c,z)sytf2)(
&puplo,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(ipiv),
$P(info));
');

pp_defc("chetrf", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)hetrf)(char *uplo, integer *n, $GENERIC() *a, integer * lda, integer *ipiv, $GENERIC() *work, integer *lwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n); int uplo(); int [o]ipiv(n); int [o]info(); [t]work(workn);', RedoDimsCode => ' $SIZE(workn) = 2 * $SIZE(n) * FORTRAN(ilaenv)(&c_nine, "CHETRF", " ", &c_zero, &c_zero, &c_zero, &c_zero, (ftnlen)6, (ftnlen)1); ', Code => generate_code ' char puplo = \'U\'; if ($uplo()) puplo = \'L\'; FORTRAN($TFD(c,z)hetrf)( &puplo, &(integer){$SIZE(n)}, $P(A), &(integer){$SIZE(n)}, $P(ipiv), $P(work), &(integer){$SIZE(workn)}, $P(info)); ', Doc=>' =for ref

Complex version of "sytrf" in PDL::LinearAlgebra::Real for Hermitian matrix ');

pp_defc("hetf2", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)hetf2)(char *uplo, integer *n, $GENERIC() *a, integer * lda, integer *ipiv, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n); int uplo(); int [o]ipiv(n); int [o]info()', Code => generate_code ' char puplo = \'U\'; if ($uplo()) puplo = \'L\'; FORTRAN($TFD(c,z)hetf2)( &puplo, &(integer){$SIZE(n)}, $P(A), &(integer){$SIZE(n)}, $P(ipiv), $P(info)); ', Doc=>' =for ref

Complex version of "sytf2" in PDL::LinearAlgebra::Real for Hermitian matrix ');

pp_defc("potrf", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)potrf)(char *uplo, integer *n, $GENERIC() *a, integer * lda, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n); int uplo(); int [o]info()', Code => generate_code ' char puplo = \'U\'; if ($uplo()) puplo = \'L\';


            

              
              
FORTRAN($TFD(c,z)potrf)(
&puplo,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(info));
',
Doc=>'

Complex version of "potrf" in PDL::LinearAlgebra::Real for Hermitian positive definite matrix

');

pp_defc("potf2", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)potf2)(char *uplo, integer *n, $GENERIC() *a, integer * lda, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n); int uplo(); int [o]info()', Code => generate_code ' char puplo = \'U\'; if ($uplo()) puplo = \'L\';


            

              
              
FORTRAN($TFD(c,z)potf2)(
&puplo,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(info));
',
Doc => '

Complex version of "potf2" in PDL::LinearAlgebra::Real for Hermitian positive definite matrix

');

pp_defc("getri", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)getri)(integer *n, $GENERIC() *a, integer *lda, integer *ipiv, $GENERIC() *work, integer *lwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n); int ipiv(n); int [o]info()', Code => generate_code ' integer lwork = -1; $GENERIC() tmp_work[2];


            

              
              
FORTRAN($TFD(c,z)getri)(
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(ipiv),
&tmp_work[0],
&lwork,
$P(info));
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc(2*lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)getri)(
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(ipiv),
work,
&lwork,
$P(info));
free(work);
}
');

pp_defc("sytri", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)sytri)(char *uplo, integer *n, $GENERIC() *a, integer * lda, integer *ipiv, $GENERIC() *work, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n); int uplo(); int ipiv(n); int [o]info(); [t]work(workn=CALC(2*$SIZE(n)));', Code => generate_code ' char puplo = \'U\'; if ($uplo()) puplo = \'L\'; FORTRAN($TFD(c,z)sytri)( &puplo, &(integer){$SIZE(n)}, $P(A), &(integer){$SIZE(n)}, $P(ipiv), $P(work), $P(info)); ');

pp_defc("hetri", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)hetri)(char *uplo, integer *n, $GENERIC() *a, integer * lda, integer *ipiv, $GENERIC() *work, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n); int uplo(); int ipiv(n); int [o]info(); [t]work(workn=CALC(2*$SIZE(n)));', Code => generate_code ' char puplo = \'U\'; if ($uplo()) puplo = \'L\';


            

              
              
FORTRAN($TFD(c,z)hetri)(
&puplo,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(ipiv),
$P(work),
$P(info));
',
Doc => '
=for ref

Complex version of "sytri" in PDL::LinearAlgebra::Real for Hermitian matrix ');

pp_defc("potri", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)potri)(char *uplo, integer *n, $GENERIC() *a, integer * lda, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n); int uplo(); int [o]info()', Code => generate_code ' char puplo = \'U\'; if ($uplo()) puplo = \'L\';


            

              
              
FORTRAN($TFD(c,z)potri)(
&puplo,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(info));
');

pp_defc("trtri", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)trtri)(char *uplo, char *diag, integer *n, $GENERIC() *a, integer * lda, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n); int uplo(); int diag(); int [o]info()', Code => generate_code ' char puplo = \'U\'; char pdiag = \'N\'; if ($uplo()) puplo = \'L\'; if ($diag()) pdiag = \'U\';


            

              
              
FORTRAN($TFD(c,z)trtri)(
&puplo,
&pdiag,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(info));
');

pp_defc("trti2", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)trti2)(char *uplo, char *diag, integer *n, $GENERIC() *a, integer * lda, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n); int uplo(); int diag(); int [o]info()', Code => generate_code ' char puplo = \'U\'; char pdiag = \'N\'; if ($uplo()) puplo = \'L\'; if ($diag()) pdiag = \'U\';


            

              
              
FORTRAN($TFD(c,z)trti2)(
&puplo,
&pdiag,
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(n)},
$P(info));
');

pp_defc("getrs", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)getrs)(char *trans, integer *n, integer *nrhs, $GENERIC() *a, integer *lda, integer *ipiv, $GENERIC() *b, integer * ldb, integer *info); EOF HandleBad => 0, Pars => 'A(2,n,n); int trans(); [io]B(2,n,m); int ipiv(n); int [o]info()', Code => generate_code ' char transp = \'N\'; if($trans() == 1) transp = \'T\'; else if($trans() == 2) transp = \'C\';


            

              
              
        FORTRAN($TFD(c,z)getrs)(
        &transp,
        &(integer){$SIZE(n)},
        &(integer){$SIZE(m)},
        $P(A),
        &(integer){$SIZE(n)},
        $P(ipiv),
        $P(B),
        &(integer){$SIZE(n)},
        $P(info));
',
Doc=>'

Complex version of "getrs" in PDL::LinearAlgebra::Real


            

              
              
   Arguments
   =========
trans:   = 0:  No transpose;
         = 1:  Transpose;
         = 2:  Conjugate transpose;

');

pp_defc("sytrs", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)sytrs)(char *uplo, integer *n, integer *nrhs, $GENERIC() *a, integer *lda, integer *ipiv, $GENERIC() *b, integer * ldb, integer *info); EOF HandleBad => 0, Pars => 'A(2,n,n); int uplo();[io]B(2,n,m); int ipiv(n); int [o]info()', Code => generate_code ' char puplo = \'U\'; if($uplo()) puplo = \'L\';


            

              
              
FORTRAN($TFD(c,z)sytrs)(
&puplo,
&(integer){$SIZE(n)},
&(integer){$SIZE(m)},
$P(A),
&(integer){$SIZE(n)},
$P(ipiv),
$P(B),
&(integer){$SIZE(n)},
$P(info));
');

pp_defc("hetrs", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)hetrs)(char *uplo, integer *n, integer *nrhs, $GENERIC() *a, integer *lda, integer *ipiv, $GENERIC() *b, integer * ldb, integer *info); EOF HandleBad => 0, Pars => 'A(2,n,n); int uplo();[io]B(2,n,m); int ipiv(n); int [o]info()', Code => generate_code ' char puplo = \'U\'; if($uplo()) puplo = \'L\';


            

              
              
FORTRAN($TFD(c,z)hetrs)(
&puplo,
&(integer){$SIZE(n)},
&(integer){$SIZE(m)},
$P(A),
&(integer){$SIZE(n)},
$P(ipiv),
$P(B),
&(integer){$SIZE(n)},
$P(info));
',
Doc => '

Complex version of "sytrs" in PDL::LinearAlgebra::Real for Hermitian matrix

');

pp_defc("potrs", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)potrs)(char *uplo, integer *n, integer *nrhs, $GENERIC() *a, integer *lda, $GENERIC() *b, integer *ldb, integer * info); EOF HandleBad => 0, Pars => 'A(2,n,n); int uplo(); [io]B(2,n,m); int [o]info()', Code => generate_code ' char puplo = \'U\'; if($uplo()) puplo = \'L\';


            

              
              
FORTRAN($TFD(c,z)potrs)(
&puplo,
&(integer){$SIZE(n)},
&(integer){$SIZE(m)},
$P(A),
&(integer){$SIZE(n)},
$P(B),
&(integer){$SIZE(n)},
$P(info));
',

Doc=>'

Complex version of "potrs" in PDL::LinearAlgebra::Real for Hermitian positive definite matrix

');

pp_defc("trtrs", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)trtrs)(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, $GENERIC() *a, integer *lda, $GENERIC() *b, integer * ldb, integer *info); EOF HandleBad => 0, Pars => 'A(2,n,n); int uplo(); int trans(); int diag();[io]B(2,n,m); int [o]info()', Code => generate_code ' char puplo = \'U\'; char ptrans = \'N\'; char pdiag = \'N\'; if($uplo()) puplo = \'L\'; if($trans() == 1) ptrans = \'T\'; else if($trans() == 2) ptrans = \'C\'; if($diag()) pdiag = \'U\';


            

              
              
        FORTRAN($TFD(c,z)trtrs)(
        &puplo,
        &ptrans,
        &pdiag,
        &(integer){$SIZE(n)},
        &(integer){$SIZE(m)},
        $P(A),
        &(integer){$SIZE(n)},
        $P(B),
        &(integer){$SIZE(n)},
        $P(info));
',
Doc=>'

Complex version of "trtrs" in PDL::LinearAlgebra::Real


            

              
              
   Arguments
   =========
trans:   = 0:  No transpose;
         = 1:  Transpose;
         = 2:  Conjugate transpose;

');

pp_defc("latrs", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)latrs)(char *uplo, char *trans, char *diag, char * normin, integer *n, $GENERIC() *a, integer *lda, $GENERIC() *x, $GENERIC() *scale, $GENERIC() *cnorm, integer *info); EOF HandleBad => 0, Pars => 'A(2,n,n); int uplo(); int trans(); int diag(); int normin();[io]x(2,n); [o]scale();[io]cnorm(n);int [o]info()', Code => generate_code ' char puplo = \'U\'; char ptrans = \'N\'; char pdiag = \'N\'; char pnormin = \'N\';


            

              
              
        if($uplo())
                puplo = \'L\';
        if($trans())
                ptrans = \'T\';
        else if($trans() == 2)
                ptrans = \'C\';
        if($diag())
                pdiag = \'U\';
        if($normin())
                pnormin = \'Y\';
        FORTRAN($TFD(c,z)latrs)(
        &puplo,
        &ptrans,
        &pdiag,
        &pnormin,
        &(integer){$SIZE(n)},
        $P(A),
        &(integer){$SIZE(n)},
        $P(x),
        $P(scale),
        $P(cnorm),
        $P(info));
',
Doc=>'

Complex version of "latrs" in PDL::LinearAlgebra::Real


            

              
              
    Arguments
    =========
        trans:   = 0:  No transpose;
                 = 1:  Transpose;
                 = 2:  Conjugate transpose;
');

pp_defc("gecon", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)gecon)(char *norm, integer *n, $GENERIC() *a, integer * lda, $GENERIC() *anorm, $GENERIC() *rcond, $GENERIC() *work, $GENERIC() * rwork, integer *info); EOF HandleBad => 0, Pars => 'A(2,n,n); int norm(); anorm(); [o]rcond();int [o]info(); [t]rwork(rworkn=CALC(2*$SIZE(n))); [t]work(workn=CALC(4*$SIZE(n)));', Code => generate_code ' char pnorm = \'I\'; if($norm()) pnorm = \'O\'; FORTRAN($TFD(c,z)gecon)( &pnorm, &(integer){$SIZE(n)}, $P(A), &(integer){$SIZE(n)}, $P(anorm), $P(rcond), $P(work), $P(rwork), $P(info)); ');

pp_defc("sycon", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)sycon)(char *uplo, integer *n, $GENERIC() *a, integer * lda, integer *ipiv, $GENERIC() *anorm, $GENERIC() *rcond, $GENERIC() * work, integer *info); EOF HandleBad => 0, Pars => 'A(2,n,n); int uplo(); int ipiv(n); anorm(); [o]rcond();int [o]info(); [t]work(workn=CALC(4*$SIZE(n)));', Code => generate_code ' char puplo = \'U\'; if($uplo()) puplo = \'L\'; FORTRAN($TFD(c,z)sycon)( &puplo, &(integer){$SIZE(n)}, $P(A), &(integer){$SIZE(n)}, $P(ipiv), $P(anorm), $P(rcond), $P(work), $P(info)); ');

pp_defc("hecon", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)hecon)(char *uplo, integer *n, $GENERIC() *a, integer * lda, integer *ipiv, $GENERIC() *anorm, $GENERIC() *rcond, $GENERIC() * work, integer *info); EOF HandleBad => 0, Pars => 'A(2,n,n); int uplo(); int ipiv(n); anorm(); [o]rcond();int [o]info(); [t]work(workn=CALC(4*$SIZE(n)));', Code => generate_code ' char puplo = \'U\'; if($uplo()) puplo = \'L\'; FORTRAN($TFD(c,z)hecon)( &puplo, &(integer){$SIZE(n)}, $P(A), &(integer){$SIZE(n)}, $P(ipiv), $P(anorm), $P(rcond), $P(work), $P(info)); ', Doc => ' =for ref

Complex version of "sycon" in PDL::LinearAlgebra::Real for Hermitian matrix ');

pp_defc("pocon", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)pocon)(char *uplo, integer *n, $GENERIC() *a, integer * lda, $GENERIC() *anorm, $GENERIC() *rcond, $GENERIC() *work, $GENERIC() * rwork, integer *info); EOF HandleBad => 0, Pars => 'A(2,n,n); int uplo(); anorm(); [o]rcond();int [o]info(); [t]work(workn=CALC(4*$SIZE(n))); [t]rwork(n);', Code => generate_code ' char puplo = \'U\'; if($uplo()) puplo = \'L\'; FORTRAN($TFD(c,z)pocon)( &puplo, &(integer){$SIZE(n)}, $P(A), &(integer){$SIZE(n)}, $P(anorm), $P(rcond), $P(work), $P(rwork), $P(info)); ', Doc => ' =for ref

Complex version of "pocon" in PDL::LinearAlgebra::Real for Hermitian positive definite matrix ');

pp_defc("trcon", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)trcon)(char *norm, char *uplo, char *diag,integer *n, $GENERIC() *a, integer * lda, $GENERIC() *rcond, $GENERIC() *work, $GENERIC() *rwork, integer *info); EOF HandleBad => 0, Pars => 'A(2,n,n); int norm();int uplo();int diag(); [o]rcond();int [o]info(); [t]work(workn=CALC(4*$SIZE(n))); [t]rwork(n);', Code => generate_code ' char puplo = \'U\'; char pdiag = \'N\'; char pnorm = \'I\'; if($uplo()) puplo = \'L\'; if($diag()) pdiag = \'U\'; if($norm()) pnorm = \'O\'; FORTRAN($TFD(c,z)trcon)( &pnorm, &puplo, &pdiag, &(integer){$SIZE(n)}, $P(A), &(integer){$SIZE(n)}, $P(rcond), $P(work), $P(rwork), $P(info)); ');

pp_defc("geqp3", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)geqp3)(integer *m, integer *n, $GENERIC() *a, integer * lda, integer *jpvt, $GENERIC() *tau, $GENERIC() *work, integer *lwork, $GENERIC() *rwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,m,n); int [io]jpvt(n); [o]tau(2,k); int [o]info(); [t]rwork(rworkn=CALC(2*$SIZE(n)));', Code => generate_code ' integer lwork = -1; $GENERIC() tmp_work[2]; FORTRAN($TFD(c,z)geqp3)( &(integer){$SIZE(m)}, &(integer){$SIZE(n)}, $P(A), &(integer){$SIZE(m)}, $P(jpvt), $P(tau), &tmp_work[0], &lwork, $P(rwork), $P(info)); lwork = (integer )tmp_work[0]; { $GENERIC() *work = ($GENERIC() *)malloc(2 * lwork * sizeof($GENERIC())); FORTRAN($TFD(c,z)geqp3)( &(integer){$SIZE(m)}, &(integer){$SIZE(n)}, $P(A), &(integer){$SIZE(m)}, $P(jpvt), $P(tau), work, &lwork, $P(rwork), $P(info)); free(work); } ' );

pp_defc("geqrf", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)geqrf)(integer *m, integer *n, $GENERIC() *a, integer * lda, $GENERIC() *tau, $GENERIC() *work, integer *lwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,m,n); [o]tau(2,k); int [o]info()', Code => generate_code ' integer lwork = -1; $GENERIC() tmp_work[2]; FORTRAN($TFD(c,z)geqrf)( &(integer){$SIZE(m)}, &(integer){$SIZE(n)}, $P(A), &(integer){$SIZE(m)}, $P(tau), &tmp_work[0], &lwork, $P(info));


            

              
              
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc(2 * lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)geqrf)(
&(integer){$SIZE(m)},
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(m)},
$P(tau),
work,
&lwork,
$P(info));
free(work);
}

');

pp_defc("ungqr", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)ungqr)(integer *m, integer *n, integer *k, $GENERIC() * a, integer *lda, $GENERIC() *tau, $GENERIC() *work, integer *lwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,m,n); tau(2,k); int [o]info()', Code => generate_code ' integer lwork = -1; $GENERIC() tmp_work[2]; FORTRAN($TFD(c,z)ungqr)( &(integer){$SIZE(m)}, &(integer){$SIZE(n)}, &(integer){$SIZE(k)}, $P(A), &(integer){$SIZE(m)}, $P(tau), &tmp_work[0], &lwork, $P(info));


            

              
              
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc(2 * lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)ungqr)(
&(integer){$SIZE(m)},
&(integer){$SIZE(n)},
&(integer){$SIZE(k)},
$P(A),
&(integer){$SIZE(m)},
$P(tau),
work,
&lwork,
$P(info));
free(work);
}

', Doc=>'

Complex version of "orgqr" in PDL::LinearAlgebra::Real

');

pp_defc("unmqr", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)unmqr)(char *side, char *trans, integer *m, integer *n, integer *k, $GENERIC() *a, integer *lda, $GENERIC() *tau, $GENERIC() * c__, integer *ldc, $GENERIC() *work, integer *lwork, integer *info); EOF HandleBad => 0, Pars => 'A(2,p,k); int side(); int trans(); tau(2,k); [io]C(2,m,n);int [o]info()', Code => generate_code ' char ptrans = \'N\', pside = \'L\'; integer lwork = -1; $GENERIC() tmp_work[2]; if($trans()) ptrans = \'C\'; if($side()) pside = \'R\';


            

              
              
        FORTRAN($TFD(c,z)unmqr)(
        &pside,
        &ptrans,
        &(integer){$SIZE(m)},
        &(integer){$SIZE(n)},
        &(integer){$SIZE(k)},
        $P(A),
        &(integer){$SIZE(p)},
        $P(tau),
        $P(C),
        &(integer){$SIZE(m)},
        &tmp_work[0],
        &lwork,
        $P(info));
        lwork = (integer )tmp_work[0];
        {
        $GENERIC() *work = ($GENERIC() *)malloc(2 * lwork *  sizeof($GENERIC()));
        FORTRAN($TFD(c,z)unmqr)(
        &pside,
        &ptrans,
        &(integer){$SIZE(m)},
        &(integer){$SIZE(n)},
        &(integer){$SIZE(k)},
        $P(A),
        &(integer){$SIZE(p)},
        $P(tau),
        $P(C),
        &(integer){$SIZE(m)},
        work,
        &lwork,
        $P(info));
        free(work);
        }
',
Doc=>'
=for ref

Complex version of "ormqr" in PDL::LinearAlgebra::Real. Here trans = 1 means conjugate transpose. ');

pp_defc("gelqf", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)gelqf)(integer *m, integer *n, $GENERIC() *a, integer * lda, $GENERIC() *tau, $GENERIC() *work, integer *lwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,m,n); [o]tau(2,k); int [o]info()', Code => generate_code ' integer lwork = -1; $GENERIC() tmp_work[2]; FORTRAN($TFD(c,z)gelqf)( &(integer){$SIZE(m)}, &(integer){$SIZE(n)}, $P(A), &(integer){$SIZE(m)}, $P(tau), &tmp_work[0], &lwork, $P(info));


            

              
              
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc(2 * lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)gelqf)(
&(integer){$SIZE(m)},
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(m)},
$P(tau),
work,
&lwork,
$P(info));
free(work);
}

');

pp_defc("unglq", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)unglq)(integer *m, integer *n, integer *k, $GENERIC() * a, integer *lda, $GENERIC() *tau, $GENERIC() *work, integer *lwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,m,n); tau(2,k); int [o]info()', Code => generate_code ' integer lwork = -1; $GENERIC() tmp_work[2]; FORTRAN($TFD(c,z)unglq)( &(integer){$SIZE(m)}, &(integer){$SIZE(n)}, &(integer){$SIZE(k)}, $P(A), &(integer){$SIZE(m)}, $P(tau), &tmp_work[0], &lwork, $P(info));


            

              
              
        lwork = (integer )tmp_work[0];
        {
        $GENERIC() *work = ($GENERIC() *)malloc(2 * lwork *  sizeof($GENERIC()));
        FORTRAN($TFD(c,z)unglq)(
        &(integer){$SIZE(m)},
        &(integer){$SIZE(n)},
        &(integer){$SIZE(k)},
        $P(A),
        &(integer){$SIZE(m)},
        $P(tau),
        work,
        &lwork,
        $P(info));
        free(work);
        }
',
Doc=>'
=for ref

Complex version of "orglq" in PDL::LinearAlgebra::Real ');

pp_defc("unmlq", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)unmlq)(char *side, char *trans, integer *m, integer *n, integer *k, $GENERIC() *a, integer *lda, $GENERIC() *tau, $GENERIC() * c__, integer *ldc, $GENERIC() *work, integer *lwork, integer *info); EOF HandleBad => 0, Pars => 'A(2,k,p); int side(); int trans(); tau(2,k); [io]C(2,m,n);int [o]info()', Code => generate_code ' char ptrans = \'N\', pside = \'L\'; integer lwork = -1; $GENERIC() tmp_work[2]; if($trans()) ptrans = \'C\'; if($side()) pside = \'R\';


            

              
              
FORTRAN($TFD(c,z)unmlq)(
&pside,
&ptrans,
&(integer){$SIZE(m)},
&(integer){$SIZE(n)},
&(integer){$SIZE(k)},
$P(A),
&(integer){$SIZE(k)},
$P(tau),
$P(C),
&(integer){$SIZE(m)},
&tmp_work[0],
&lwork,
$P(info));
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc(2 * lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)unmlq)(
&pside,
&ptrans,
&(integer){$SIZE(m)},
&(integer){$SIZE(n)},
&(integer){$SIZE(k)},
$P(A),
&(integer){$SIZE(k)},
$P(tau),
$P(C),
&(integer){$SIZE(m)},
work,
&lwork,
$P(info));
free(work);
}

', Doc=>'

Complex version of "ormlq" in PDL::LinearAlgebra::Real. Here trans = 1 means conjugate transpose.

');

pp_defc("geqlf", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)geqlf)(integer *m, integer *n, $GENERIC() *a, integer * lda, $GENERIC() *tau, $GENERIC() *work, integer *lwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,m,n); [o]tau(2,k); int [o]info()', Code => generate_code ' integer lwork = -1; $GENERIC() tmp_work[2]; FORTRAN($TFD(c,z)geqlf)( &(integer){$SIZE(m)}, &(integer){$SIZE(n)}, $P(A), &(integer){$SIZE(m)}, $P(tau), &tmp_work[0], &lwork, $P(info));


            

              
              
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc(2 * lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)geqlf)(
&(integer){$SIZE(m)},
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(m)},
$P(tau),
work,
&lwork,
$P(info));
free(work);
}
');

pp_defc("ungql", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)ungql)(integer *m, integer *n, integer *k, $GENERIC() * a, integer *lda, $GENERIC() *tau, $GENERIC() *work, integer *lwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,m,n); tau(2,k); int [o]info()', Code => generate_code ' integer lwork = -1; $GENERIC() tmp_work[2]; FORTRAN($TFD(c,z)ungql)( &(integer){$SIZE(m)}, &(integer){$SIZE(n)}, &(integer){$SIZE(k)}, $P(A), &(integer){$SIZE(m)}, $P(tau), &tmp_work[0], &lwork, $P(info));


            

              
              
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc(2 * lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)ungql)(
&(integer){$SIZE(m)},
&(integer){$SIZE(n)},
&(integer){$SIZE(k)},
$P(A),
&(integer){$SIZE(m)},
$P(tau),
work,
&lwork,
$P(info));
free(work);
}

', Doc=>'

pp_defc("unmql", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)unmql)(char *side, char *trans, integer *m, integer *n, integer *k, $GENERIC() *a, integer *lda, $GENERIC() *tau, $GENERIC() * c__, integer *ldc, $GENERIC() *work, integer *lwork, integer *info); EOF HandleBad => 0, Pars => 'A(2,p,k); int side(); int trans(); tau(2,k); [io]C(2,m,n);int [o]info()', Code => generate_code ' char ptrans = \'N\', pside = \'L\'; integer lwork = -1; $GENERIC() tmp_work[2]; if($trans()) ptrans = \'C\'; if($side()) pside = \'R\';


            

              
              
        FORTRAN($TFD(c,z)unmql)(
        &pside,
        &ptrans,
        &(integer){$SIZE(m)},
        &(integer){$SIZE(n)},
        &(integer){$SIZE(k)},
        $P(A),
        &(integer){$SIZE(p)},
        $P(tau),
        $P(C),
        &(integer){$SIZE(m)},
        &tmp_work[0],
        &lwork,
        $P(info));
        lwork = (integer )tmp_work[0];
        {
        $GENERIC() *work = ($GENERIC() *)malloc(2 * lwork *  sizeof($GENERIC()));
        FORTRAN($TFD(c,z)unmql)(
        &pside,
        &ptrans,
        &(integer){$SIZE(m)},
        &(integer){$SIZE(n)},
        &(integer){$SIZE(k)},
        $P(A),
        &(integer){$SIZE(p)},
        $P(tau),
        $P(C),
        &(integer){$SIZE(m)},
        work,
        &lwork,
        $P(info));
        free(work);
        }
',
Doc=>'
=for ref

Complex version of "ormql" in PDL::LinearAlgebra::Real. Here trans = 1 means conjugate transpose. ');

pp_defc("gerqf", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)gerqf)(integer *m, integer *n, $GENERIC() *a, integer * lda, $GENERIC() *tau, $GENERIC() *work, integer *lwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,m,n); [o]tau(2,k); int [o]info()', Code => generate_code ' integer lwork = -1; $GENERIC() tmp_work[2]; FORTRAN($TFD(c,z)gerqf)( &(integer){$SIZE(m)}, &(integer){$SIZE(n)}, $P(A), &(integer){$SIZE(m)}, $P(tau), &tmp_work[0], &lwork, $P(info));


            

              
              
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc(2 * lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)gerqf)(
&(integer){$SIZE(m)},
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(m)},
$P(tau),
work,
&lwork,
$P(info));
free(work);
}

');

pp_defc("ungrq", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)ungrq)(integer *m, integer *n, integer *k, $GENERIC() * a, integer *lda, $GENERIC() *tau, $GENERIC() *work, integer *lwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,m,n); tau(2,k); int [o]info()', Code => generate_code ' integer lwork = -1; $GENERIC() tmp_work[2]; FORTRAN($TFD(c,z)ungrq)( &(integer){$SIZE(m)}, &(integer){$SIZE(n)}, &(integer){$SIZE(k)}, $P(A), &(integer){$SIZE(m)}, $P(tau), &tmp_work[0], &lwork, $P(info));


            

              
              
        lwork = (integer )tmp_work[0];
        {
        $GENERIC() *work = ($GENERIC() *)malloc(2 * lwork *  sizeof($GENERIC()));
        FORTRAN($TFD(c,z)ungrq)(
        &(integer){$SIZE(m)},
        &(integer){$SIZE(n)},
        &(integer){$SIZE(k)},
        $P(A),
        &(integer){$SIZE(m)},
        $P(tau),
        work,
        &lwork,
        $P(info));
        free(work);
        }
',
Doc=>'
=for ref

Complex version of "orgrq" in PDL::LinearAlgebra::Real. ');

pp_defc("unmrq", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)unmrq)(char *side, char *trans, integer *m, integer *n, integer *k, $GENERIC() *a, integer *lda, $GENERIC() *tau, $GENERIC() * c__, integer *ldc, $GENERIC() *work, integer *lwork, integer *info); EOF HandleBad => 0, Pars => 'A(2,k,p); int side(); int trans(); tau(2,k); [io]C(2,m,n);int [o]info()', Code => generate_code ' char ptrans = \'N\', pside = \'L\'; integer lwork = -1; $GENERIC() tmp_work[2]; if($trans()) ptrans = \'C\'; if($side()) pside = \'R\';


            

              
              
FORTRAN($TFD(c,z)unmrq)(
&pside,
&ptrans,
&(integer){$SIZE(m)},
&(integer){$SIZE(n)},
&(integer){$SIZE(k)},
$P(A),
&(integer){$SIZE(k)},
$P(tau),
$P(C),
&(integer){$SIZE(m)},
&tmp_work[0],
&lwork,
$P(info));
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc(2 * lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)unmrq)(
&pside,
&ptrans,
&(integer){$SIZE(m)},
&(integer){$SIZE(n)},
&(integer){$SIZE(k)},
$P(A),
&(integer){$SIZE(k)},
$P(tau),
$P(C),
&(integer){$SIZE(m)},
work,
&lwork,
$P(info));
free(work);
}

', Doc=>'

Complex version of "ormrq" in PDL::LinearAlgebra::Real. Here trans = 1 means conjugate transpose.

');

pp_defc("tzrzf", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)tzrzf)(integer *m, integer *n, $GENERIC() *a, integer * lda, $GENERIC() *tau, $GENERIC() *work, integer *lwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,m,n); [o]tau(2,k); int [o]info()', Code => generate_code ' integer lwork = -1; $GENERIC() tmp_work[2]; FORTRAN($TFD(c,z)tzrzf)( &(integer){$SIZE(m)}, &(integer){$SIZE(n)}, $P(A), &(integer){$SIZE(m)}, $P(tau), &tmp_work[0], &lwork, $P(info));


            

              
              
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc(2 * lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)tzrzf)(
&(integer){$SIZE(m)},
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(m)},
$P(tau),
work,
&lwork,
$P(info));
free(work);
}
');

pp_defc("unmrz", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)unmrz)(char *side, char *trans, integer *m, integer *n, integer *k, integer *l, $GENERIC() *a, integer *lda, $GENERIC() *tau, $GENERIC() * c__, integer *ldc, $GENERIC() *work, integer *lwork, integer *info); EOF HandleBad => 0, Pars => 'A(2,k,p); int side(); int trans(); tau(2,k); [io]C(2,m,n);int [o]info()', Code => generate_code ' char ptrans = \'N\', pside = \'L\'; integer lwork = -1; integer kk = $SIZE(p) - $SIZE(k); $GENERIC() tmp_work[2]; if($trans()) ptrans = \'C\'; if($side()) pside = \'R\';


            

              
              
FORTRAN($TFD(c,z)unmrz)(
&pside,
&ptrans,
&(integer){$SIZE(m)},
&(integer){$SIZE(n)},
&(integer){$SIZE(k)},
&kk,
$P(A),
&(integer){$SIZE(k)},
$P(tau),
$P(C),
&(integer){$SIZE(m)},
&tmp_work[0],
&lwork,
$P(info));
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc(2 * lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)unmrz)(
&pside,
&ptrans,
&(integer){$SIZE(m)},
&(integer){$SIZE(n)},
&(integer){$SIZE(k)},
&kk,
$P(A),
&(integer){$SIZE(k)},
$P(tau),
$P(C),
&(integer){$SIZE(m)},
work,
&lwork,
$P(info));
free(work);
}

', Doc=>' =for ref

Complex version of "ormrz" in PDL::LinearAlgebra::Real. Here trans = 1 means conjugate transpose. ');

pp_defc("gehrd", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)gehrd)(integer *n, integer *ilo, integer *ihi, $GENERIC() *a, integer *lda, $GENERIC() *tau, $GENERIC() *work, integer *lwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n); int ilo();int ihi();[o]tau(2,k); int [o]info()', Code => generate_code ' integer lwork = -1; $GENERIC() tmp_work[2]; FORTRAN($TFD(c,z)gehrd)( &(integer){$SIZE(n)}, $P(ilo), $P(ihi), $P(A), &(integer){$SIZE(n)}, $P(tau), &tmp_work[0], &lwork, $P(info));


            

              
              
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc(2*lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)gehrd)(
&(integer){$SIZE(n)},
$P(ilo),
$P(ihi),
$P(A),
&(integer){$SIZE(n)},
$P(tau),
work,
&lwork,
$P(info));
free(work);
}
');

pp_defc("unghr", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)unghr)(integer *n, integer *ilo, integer *ihi, $GENERIC() *a, integer *lda, $GENERIC() *tau, $GENERIC() *work, integer *lwork, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n); int ilo();int ihi();tau(2,k); int [o]info()', Code => generate_code ' integer lwork = -1; $GENERIC() tmp_work[2]; FORTRAN($TFD(c,z)unghr)( &(integer){$SIZE(n)}, $P(ilo), $P(ihi), $P(A), &(integer){$SIZE(n)}, $P(tau), &tmp_work[0], &lwork, $P(info));


            

              
              
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc(2*lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)unghr)(
&(integer){$SIZE(n)},
$P(ilo),
$P(ihi),
$P(A),
&(integer){$SIZE(n)},
$P(tau),
work,
&lwork,
$P(info));
free(work);
}

', Doc=>' =for ref

Complex version of "orghr" in PDL::LinearAlgebra::Real ');

pp_defc("hseqr", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)hseqr)(char *job, char *compz, integer *n, integer *ilo, integer *ihi, $GENERIC() *h__, integer *ldh, $GENERIC() *w, $GENERIC() *z__, integer *ldz, $GENERIC() *work, integer *lwork, integer *info); EOF HandleBad => 0, Pars => '[io]H(2,n,n); int job();int compz();int ilo();int ihi();[o]w(2,n); [o]Z(2,m,m); int [o]info()', Code => generate_code ' char pcompz; char pjob = \'E\'; integer lwork = -1; $GENERIC() tmp_work[2]; if($job()) pjob = \'S\';


            

              
              
switch ($compz())
{
        case 1: pcompz = \'I\';
                break;
        case 2: pcompz = \'V\';
                break;
        default: pcompz = \'N\';
}
FORTRAN($TFD(c,z)hseqr)(
&pjob,
&pcompz,
&(integer){$SIZE(n)},
$P(ilo),
$P(ihi),
$P(H),
&(integer){$SIZE(n)},
$P(w),
$P(Z),
&(integer){$SIZE(m)},
&tmp_work[0],
&lwork,
$P(info));
lwork = (integer )tmp_work[0];
{
$GENERIC() *work = ($GENERIC() *)malloc(2 * lwork *  sizeof($GENERIC()));
FORTRAN($TFD(c,z)hseqr)(
&pjob,
&pcompz,
&(integer){$SIZE(n)},
$P(ilo),
$P(ihi),
$P(H),
&(integer){$SIZE(n)},
$P(w),
$P(Z),
&(integer){$SIZE(m)},
work,
&lwork,
$P(info));
free(work);
}
');

pp_defc("trevc", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)trevc)(char *side, char *howmny, logical *select, integer *n, $GENERIC() *t, integer *ldt, $GENERIC() *vl, integer * ldvl, $GENERIC() *vr, integer *ldvr, integer *mm, integer *m, $GENERIC() *work, $GENERIC() *rwork, integer *info); EOF HandleBad => 0, Pars => 'T(2,n,n); int side();int howmny();int select(q);[o]VL(2,m,m); [o]VR(2,p,p);int [o]m(); int [o]info(); [t]work(workn=CALC(5*$SIZE(n)));', RedoDimsCode => ' PDL_MAYBE_SIZE(PDL_Long, $PDL(side), tmp != 1, $PDL(VL), $SIZE(m), $SIZE(n)) PDL_MAYBE_SIZE(PDL_Long, $PDL(side), tmp != 2, $PDL(VR), $SIZE(p), $SIZE(n)) ', Code => generate_code ' char pside,phowmny; integer mm = PDLMAX($SIZE(m),$SIZE(p)); switch ($howmny()) { case 1: phowmny = \'B\'; break; case 2: phowmny = \'S\'; break; default: phowmny = \'A\'; }


            

              
              
switch ($side())
{
        case 1: pside = \'R\';
                break;
        case 2: pside = \'L\';
                break;
        default:pside = \'B\';
}
FORTRAN($TFD(c,z)trevc)(
&pside,
&phowmny,
$P(select),
&(integer){$SIZE(n)},
$P(T),
&(integer){$SIZE(n)},
$P(VL),
&(integer){$SIZE(m)},
$P(VR),
&(integer){$SIZE(p)},
&mm,
$P(m),
$P(work) + $SIZE(n),
$P(work),
$P(info));
');

pp_defc("tgevc", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)tgevc)(char *side, char *howmny, logical *select, integer *n, $GENERIC() *a, integer *lda, $GENERIC() *b, integer *ldb, $GENERIC() *vl, integer *ldvl, $GENERIC() *vr, integer *ldvr, integer *mm, integer *m, $GENERIC() *work, $GENERIC() *rwork, integer *info); EOF HandleBad => 0, Pars => 'A(2,n,n); int side();int howmny(); B(2,n,n);int select(q);[o]VL(2,m,m); [o]VR(2,p,p);int [o]m(); int [o]info(); [t]work(workn=CALC(6*$SIZE(n)));', RedoDimsCode => ' PDL_MAYBE_SIZE(PDL_Long, $PDL(side), tmp != 1, $PDL(VL), $SIZE(m), $SIZE(n)) PDL_MAYBE_SIZE(PDL_Long, $PDL(side), tmp != 2, $PDL(VR), $SIZE(p), $SIZE(n)) ', Code => generate_code ' char pside,phowmny; integer mm = PDLMAX($SIZE(m),$SIZE(p)); switch ($howmny()) { case 1: phowmny = \'B\'; break; case 2: phowmny = \'S\'; break; default: phowmny = \'A\'; } switch ($side()) { case 1: pside = \'R\'; break; case 2: pside = \'L\'; break; default:pside = \'B\'; } FORTRAN($TFD(c,z)tgevc)( &pside, &phowmny, $P(select), &(integer){$SIZE(n)}, $P(A), &(integer){$SIZE(n)}, $P(B), &(integer){$SIZE(n)}, $P(VL), &(integer){$SIZE(m)}, $P(VR), &(integer){$SIZE(p)}, &mm, $P(m), $P(work)+2*$SIZE(n), $P(work), $P(info)); ');

pp_defc("gebal", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)gebal)(char *job, integer *n, $GENERIC() *a, integer * lda, integer *ilo, integer *ihi, $GENERIC() *scale, integer *info); EOF HandleBad => 0, Pars => '[io]A(2,n,n); int job(); int [o]ilo();int [o]ihi();[o]scale(n); int [o]info()', Code => generate_code ' char pjob; switch ($job()) { case 1: pjob = \'P\'; break; case 2: pjob = \'S\'; break; case 3: pjob = \'B\'; break; default: pjob = \'N\'; } FORTRAN($TFD(c,z)gebal)( &pjob, &(integer){$SIZE(n)}, $P(A), &(integer){$SIZE(n)}, $P(ilo), $P(ihi), $P(scale), $P(info)); ');

################################################################################# pp_defc("lange", _decl => <<'EOF', extern $GENERIC() FORTRAN($TFD(c,z)lange)(char *norm, integer *m, integer *n, $GENERIC() *a, integer *lda, $GENERIC() *work); EOF HandleBad => 0, Pars => 'A(2,n,m); int norm(); [o]b(); [t]work(workn);', RedoDimsCode => ' PDL_MAYBE_SIZE(PDL_Long, $PDL(norm), tmp == 2, $PDL(work), $SIZE(workn), $SIZE(n)) ', Code => ' char pnorm; switch ($norm()) { case 1: pnorm = \'O\'; break; case 2: pnorm = \'I\'; break; case 3: pnorm = \'F\'; break; default: pnorm = \'M\'; } $b() = FORTRAN($TFD(c,z)lange)( &pnorm, &(integer){$SIZE(n)}, &(integer){$SIZE(m)}, $P(A), &(integer){$SIZE(n)}, $P(work)); ');

pp_defc("lansy", _decl => <<'EOF', extern $GENERIC() FORTRAN($TFD(c,z)lansy)(char *norm, char *uplo, integer *n, $GENERIC() *a, integer *lda, $GENERIC() *work); EOF HandleBad => 0, Pars => 'A(2,n,n); int uplo(); int norm(); [o]b(); [t]work(workn);', RedoDimsCode => ' PDL_MAYBE_SIZE(PDL_Long, $PDL(norm), tmp == 1 || tmp == 2, $PDL(work), $SIZE(workn), $SIZE(n)) ', Code => ' char pnorm, puplo = \'U\'; switch ($norm()) { case 1: pnorm = \'O\'; break; case 2: pnorm = \'I\'; break; case 3: pnorm = \'F\'; break; default: pnorm = \'M\'; } if($uplo()) puplo = \'L\'; $b() = FORTRAN($TFD(c,z)lansy)( &pnorm, &puplo, &(integer){$SIZE(n)}, $P(A), &(integer){$SIZE(n)}, $P(work)); ');

pp_defc("lantr", _decl => <<'EOF', extern $GENERIC() FORTRAN($TFD(c,z)lantr)(char *norm, char *uplo, char *diag, integer *m, integer *n, $GENERIC() *a, integer *lda, $GENERIC() *work); EOF HandleBad => 0, Pars => 'A(2,m,n); int uplo(); int norm();int diag(); [o]b(); [t]work(workn);', RedoDimsCode => ' PDL_MAYBE_SIZE(PDL_Long, $PDL(norm), tmp == 2, $PDL(work), $SIZE(workn), $SIZE(n)) ', Code => ' char pnorm, puplo = \'U\'; char pdiag = \'N\'; switch ($norm()) { case 1: pnorm = \'O\'; break; case 2: pnorm = \'I\'; break; case 3: pnorm = \'F\'; break; default: pnorm = \'M\'; } if($uplo()) puplo = \'L\'; if($diag()) pdiag = \'U\'; $b() = FORTRAN($TFD(c,z)lantr)( &pnorm, &puplo, &pdiag, &(integer){$SIZE(m)}, &(integer){$SIZE(n)}, $P(A), &(integer){$SIZE(n)}, $P(work)); ');

################################################################################ # # BLAS ROUTINES # ################################################################################

pp_defc("gemm", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)gemm)(char *transa, char *transb, integer *m, integer * n, integer *k, $GENERIC() *alpha, $GENERIC() *a, integer *lda, $GENERIC() *b, integer *ldb, $GENERIC() *beta, $GENERIC() *c__, integer *ldc); EOF HandleBad => 0, Pars => 'A(2,m,n); int transa(); int transb(); B(2,p,q);alpha(2); beta(2); [io]C(2,r,s)', Code => ' char ptransa = \'N\'; char ptransb = \'N\'; integer kk = $transa() ? $SIZE(m) : $SIZE(n);


            

              
              
        if ($transa() == 1)
                ptransa = \'T\';
        else if ($transa() == 2)
                ptransa = \'C\';
        if ($transb())
                ptransb = \'T\';
        else if ($transb() == 2)
                ptransb = \'C\';
        FORTRAN($TFD(c,z)gemm)(
        &ptransa,
        &ptransb,
        &(integer){$SIZE(r)},
        &(integer){$SIZE(s)},
        &kk,
        $P(alpha),
        $P(A),
        &(integer){$SIZE(m)},
        $P(B),
        &(integer){$SIZE(p)},
        $P(beta),
        $P(C),
        &(integer){$SIZE(r)});
',
Doc=>'

Complex version of "gemm" in PDL::LinearAlgebra::Real.


            

              
              
   Arguments
   =========
transa:  = 0:  No transpose;
         = 1:  Transpose;
         = 2:  Conjugate transpose;
transb:  = 0:  No transpose;
         = 1:  Transpose;
         = 2:  Conjugate transpose;

');

if ($config{CBLAS}){ pp_def("rmcgemm", HandleBad => 0, Pars => 'A(2,m,n); int transa(); int transb(); B(2,p,q);alpha(2); beta(2); [io]C(2,r,s)', Code => ' int ptransa, ptransb; extern void cblas_$TFD(c,z)gemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_TRANSPOSE TransB, const int M, const int N, const int K, const void *alpha, const void *A, const int lda, const void *B, const int ldb, const void *beta, void *C, const int ldc); integer kk = $transa() ? $SIZE(n) : $SIZE(m);


            

              
              
switch($transa()){
        case 1: ptransa = CblasTrans;
                break;
        case 2: ptransa = CblasConjTrans;
                break;
        default:ptransa = CblasNoTrans;
}
switch($transb()){
        case 1: ptransb = CblasTrans;
                break;
        case 2: ptransb = CblasConjTrans;
                break;
        default:ptransb = CblasNoTrans;
}
cblas_$TFD(c,z)gemm(
CblasRowMajor,
ptransa,
ptransb,
$SIZE(s),
$SIZE(r),
kk,
$P(alpha),
$P(A),
$SIZE(m),
$P(B),
$SIZE(p),
$P(beta),
$P(C),
$SIZE(r));
',
Doc=>'

Complex version of "rmgemm" in PDL::LinearAlgebra::Real.


            

              
              
   Arguments
   =========
transa:  = 0:  No transpose;
         = 1:  Transpose;
         = 2:  Conjugate transpose;
transb:  = 0:  No transpose;
         = 1:  Transpose;
         = 2:  Conjugate transpose;

'); }

pp_defc("mmult", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)gemm)(char *transa, char *transb, integer *m, integer * n, integer *k, $GENERIC() *alpha, $GENERIC() *a, integer *lda, $GENERIC() *b, integer *ldb, $GENERIC() *beta, $GENERIC() *c__, integer *ldc); EOF HandleBad => 0, Pars => 'A(2,m,n); B(2,p,m); [o]C(2,p,n)', Code => ' char ptrans = \'N\'; $GENERIC() alpha[2] = {1,0}; $GENERIC() beta[2] = {0,0}; FORTRAN($TFD(c,z)gemm)( &ptrans, &ptrans, &(integer){$SIZE(p)}, &(integer){$SIZE(n)}, &(integer){$SIZE(m)}, &alpha[0], $P(B), &(integer){$SIZE(p)}, $P(A), &(integer){$SIZE(m)}, &beta[0], $P(C), &(integer){$SIZE(p)}); ');

if ($config{STRASSEN}){ pp_defc("smmult", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)gemmb)(char *transa, char *transb, integer *m, integer * n, integer *k, $GENERIC() *alpha, $GENERIC() *a, integer *lda, $GENERIC() *b, integer *ldb, $GENERIC() *beta, $GENERIC() *c__, integer *ldc); EOF HandleBad => 0, Pars => 'A(2,m,n); B(2,p,m); [o]C(2,p,n)', Code => ' char ptrans = \'N\'; $GENERIC() alpha[2] = {1,0}; $GENERIC() beta[2] = {0,0}; FORTRAN($TFD(c,z)gemmb)( &ptrans, &ptrans, &(integer){$SIZE(p)}, &(integer){$SIZE(n)}, &(integer){$SIZE(m)}, &alpha[0], $P(B), &(integer){$SIZE(p)}, $P(A), &(integer){$SIZE(m)}, &beta[0], $P(C), &(integer){$SIZE(p)}); '); }

pp_defc("crossprod", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)gemm)(char *transa, char *transb, integer *m, integer * n, integer *k, $GENERIC() *alpha, $GENERIC() *a, integer *lda, $GENERIC() *b, integer *ldb, $GENERIC() *beta, $GENERIC() *c__, integer *ldc); EOF HandleBad => 0, Pars => 'A(2,n,m); B(2,p,m); [o]C(2,p,n)', Code => ' char btrans = \'N\'; char atrans = \'C\'; $GENERIC() alpha[2] = {1,0}; $GENERIC() beta[2] = {0,0}; FORTRAN($TFD(c,z)gemm)( &btrans, &atrans, &(integer){$SIZE(p)}, &(integer){$SIZE(n)}, &(integer){$SIZE(m)}, &alpha[0], $P(B), &(integer){$SIZE(p)}, $P(A), &(integer){$SIZE(n)}, &beta[0], $P(C), &(integer){$SIZE(p)}); ');

pp_defc("syrk", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)syrk)(char *uplo, char *trans, integer *n, integer *k, $GENERIC() *alpha, $GENERIC() *a, integer *lda, $GENERIC() *beta, $GENERIC() *c__, integer *ldc); EOF HandleBad => 0, Pars => 'A(2,m,n); int uplo(); int trans(); alpha(2); beta(2); [io]C(2,p,p)', RedoDimsCode => '$SIZE(p) = $trans() ? $SIZE(n) : $SIZE(m);', Code => ' char puplo = \'U\'; char ptrans = \'N\'; integer kk = $trans() ? $SIZE(m) : $SIZE(n);


            

              
              
if ($uplo())
        puplo = \'L\';
if ($trans())
        ptrans = \'T\';
FORTRAN($TFD(c,z)syrk)(
&puplo,
&ptrans,
&(integer){$SIZE(p)},
&kk,
$P(alpha),
$P(A),
&(integer){$SIZE(m)},
$P(beta),
$P(C),
&(integer){$SIZE(p)});
');

if ($config{CBLAS}){ pp_def("rmcsyrk", HandleBad => 0, Pars => 'A(2,m,n); int uplo(); int trans(); alpha(2); beta(2); [io]C(2,p,p)', Code => ' int puplo = CblasUpper; int ptrans; extern void cblas_$TFD(c,z)syrk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE Trans, const int N, const int K, const void *alpha, const void *A, const int lda, const void *beta, void *C, const int ldc); integer kk = $trans() ? $SIZE(n) : $SIZE(m);


            

              
              
if ($uplo())
        puplo = CblasLower;
switch($trans()){
        case 1: ptrans = CblasTrans;
                break;
        case 2: ptrans = CblasConjTrans;
                break;
        default:ptrans = CblasNoTrans;
}
cblas_$TFD(c,z)syrk(
CblasRowMajor,
puplo,
ptrans,
$SIZE(p),
kk,
$P(alpha),
$P(A),
$SIZE(m),
$P(beta),
$P(C),
$SIZE(p));
',
Doc=>'

Complex version of "rmsyrk" in PDL::LinearAlgebra::Real

'); } pp_defc("dot", _decl => <<'EOF', extern complex $TFD(float,double) FORTRAN($TFD(c,z)dotu)(integer *n, $GENERIC() *dx, integer *incx, $GENERIC() *dy, integer *incy); EOF HandleBad => 0, Pars => 'a(2,n);b(2,n);[o]c(2)', Code => ' complex $TFD(float,double) *cptr = (void*)$P(c); *cptr = FORTRAN($TFD(c,z)dotu)( &(integer){$SIZE(n)}, $P(a), &(integer){1}, $P(b), &(integer){1}); ');

pp_defc("dotc", _decl => <<'EOF', extern $GENERIC() FORTRAN($TFD(c,z)dotc)(integer *n, $GENERIC() *dx, integer *incx, $GENERIC() *dy, integer *incy); EOF HandleBad => 0, Pars => 'a(2,n);b(2,n);[o]c(2)', Code => ' complex $TFD(float,double) *cptr = (void*)$P(c); *cptr = FORTRAN($TFD(c,z)dotc)( &(integer){$SIZE(n)}, $P(a), &(integer){1}, $P(b), &(integer){1}); ', Doc=>' =for ref

Forms the dot product of two vectors, conjugating the first vector. ');

pp_defc("axpy", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)axpy)(integer *n, $GENERIC() *da, $GENERIC() *dx, integer *incx, $GENERIC() *dy, integer *incy); EOF HandleBad => 0, Pars => 'a(2,n); alpha(2);[io]b(2,n)', Code => ' FORTRAN($TFD(c,z)axpy)( &(integer){$SIZE(n)}, $P(alpha), $P(a), &(integer){1}, $P(b), &(integer){1}); ');

pp_defc("nrm2", _decl => <<'EOF', extern $GENERIC() FORTRAN($TFD(sc,dz)nrm2)(integer *n, $GENERIC() *dx, integer *incx); EOF HandleBad => 0, Pars => 'a(2,n);[o]b()', Code => ' $b() = FORTRAN($TFD(sc,dz)nrm2)( &(integer){$SIZE(n)}, $P(a), &(integer){1}); ');

pp_defc("asum", _decl => <<'EOF', extern $GENERIC() FORTRAN($TFD(sc,dz)asum)(integer *n, $GENERIC() *dx, integer *incx); EOF HandleBad => 0, Pars => 'a(2,n);[o]b()', Code => ' $b() = FORTRAN($TFD(sc,dz)asum)( &(integer){$SIZE(n)}, $P(a), &(integer){1}); ');

pp_defc("scal", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)scal)(integer *n, $GENERIC() *sa, $GENERIC() *dx, integer *incx); EOF HandleBad => 0, Pars => '[io]a(2,n);scale(2)', Code => ' FORTRAN($TFD(c,z)scal)( &(integer){$SIZE(n)}, $P(scale), $P(a), &(integer){1}); ');

pp_defc("sscal", _decl => <<'EOF', extern int FORTRAN($TFD(cs,zd)scal)(integer *n, $GENERIC() *sa, $GENERIC() *dx, integer *incx); EOF HandleBad => 0, Pars => '[io]a(2,n);scale()', Code => ' FORTRAN($TFD(cs,zd)scal)( &(integer){$SIZE(n)}, $P(scale), $P(a), &(integer){1}); ', Doc=>'

Scales a complex vector by a real constant.

');

pp_defc("rotg", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)rotg)($GENERIC() *dx, $GENERIC() *dy, $GENERIC() *c, $GENERIC() *s); EOF HandleBad => 0, Pars => '[io]a(2);b(2);[o]c(); [o]s(2)', Code => ' FORTRAN($TFD(c,z)rotg)( $P(a), $P(b), $P(c), $P(s) ); ');

################################################################################ # # LAPACK AUXILIARY ROUTINES # ################################################################################ pp_defc("lacpy", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)lacpy)(char *uplo, integer *m, integer *n, $GENERIC() * a, integer *lda, $GENERIC() *b, integer *ldb); EOF HandleBad => 0, Pars => 'A(2,m,n); int uplo(); [o]B(2,p,n)', Code => ' char puplo; switch ($uplo()) { case 0: puplo = \'U\'; break; case 1: puplo = \'L\'; break; default: puplo = \'A\'; }


            

              
              
FORTRAN($TFD(c,z)lacpy)(
&puplo,
&(integer){$SIZE(m)},
&(integer){$SIZE(n)},
$P(A),
&(integer){$SIZE(m)},
$P(B),
&(integer){$SIZE(p)});
');

pp_defc("laswp", _decl => <<'EOF', extern int FORTRAN($TFD(c,z)laswp)(integer *n, $GENERIC() *a, integer *lda, integer *k1, integer *k2, integer *ipiv, integer *incx); EOF HandleBad => 0, Pars => '[io]A(2,m,n); int k1(); int k2(); int ipiv(p)', Code => ' FORTRAN($TFD(c,z)laswp)( &(integer){$SIZE(n)}, $P(A), &(integer){$SIZE(m)}, $P(k1), $P(k2), $P(ipiv), &(integer){1}); ');

pp_addhdr(' void cftrace(int n, void *a1, void *a2); void cdtrace(int n, void *a1, void *a2); ');

pp_defc('charpol', _decl => <<'EOF', extern int FORTRAN($TFD(c,z)gemm)(char *transa, char *transb, integer *m, integer * n, integer *k, $GENERIC() *alpha, $GENERIC() *a, integer *lda, $GENERIC() *b, integer *ldb, $GENERIC() *beta, $GENERIC() *c__, integer *ldc); EOF Pars => 'A(c=2,n,n);[o]Y(c=2,n,n);[o]out(c=2,p=CALC($SIZE(n)+1)); [t]rwork(rworkn=CALC(2*$SIZE(n)*$SIZE(n)));', Code => ' int i,j,k; $GENERIC() tr[2], b[2]; //$GENERIC() *tmp; char ptrans = \'N\'; $GENERIC() alpha[2] = {1,0}; $GENERIC() beta[2] = {0,0}; loop(n0,n1) %{ $Y(c=>0) = (n0 == n1) ? ($GENERIC()) 1.0 : ($GENERIC()) 0.0; $Y(c=>1) = ($GENERIC()) 0.0; %} $out(c=>0,p=>0) = 1; $out(c=>1,p=>0) = 0;


            

              
              
i = 0;
for (;;)
{
        i++;
        FORTRAN($TFD(c,z)gemm)(&ptrans,&ptrans,&(integer){$SIZE(n)},&(integer){$SIZE(n)},
                &(integer){$SIZE(n)},&alpha[0],$P(Y),&(integer){$SIZE(n)}, $P(A), &(integer){$SIZE(n)},
                &beta[0], $P(rwork), &(integer){$SIZE(n)});
        if (i == $SIZE(n)) break;
        // if (k+1) & 1 without the copy below => return diagonal matrix
        // with determinant (on my 5-year-old-pentium (windows)) !!!???
        // tmp = $P(Y);
        // $P(Y) = $P(rwork);
        // $P(rwork) = tmp;
        memmove($P(Y), $P(rwork), 2* $SIZE(n) * $SIZE(n) * sizeof($GENERIC()));

// loop(n1,n0,c) %{ // $Y() = $P(rwork)[((n1*$SIZE(n))+n0)*2+c]; // %}


            

              
              
        c$TFD(f,d)trace($SIZE(n), $P(Y), &tr[0]);
        loop(c) %{ b[c] = $out(p=>i) = - tr[c] / i; %}
        loop (n0,c) %{
                $Y(n1=>n0) += b[c];
        %}
}
k = $SIZE(n);
c$TFD(f,d)trace(k, $P(rwork), &tr[0]);
loop(c) %{ $out(p=>k) = - tr[c] / k; %}
if ((k+1) & 1)
{
        loop(n0,n1,c) %{
                $Y() = -$Y();
        %}
}
'
);

pp_addpm({At=>'Bot'},<<'EOD'); =head1 AUTHOR

Copyright (C) Gr�gory Vanuxem 2005-2018.

This library is free software; you can redistribute it and/or modify it under the terms of the Perl Artistic License as in the file Artistic_2 in this distribution.