Markus Mottl avatar Markus Mottl committed 905d5c7

Added trmm, trtrs, and trtri

Comments (0)

Files changed (11)

+*.cm*
+*.annot
+._*
+examples/blas/blas
+examples/eig/eig
+examples/lin_eq_comp/lin_eq_comp
+examples/eig/eig
+examples/lin_eq/lin_eq
+examples/lin_reg/lin_reg
+examples/svd/svd
+RE:lib/.*[012345678]_[SDCZ]*\.mli?
+2008-09-21:  Added new BLAS and LAPACK functions:
+
+               * trmm
+               * trtrs
+               * trtri
+
+             Some minor API cleanups and internal improvements.
+
 2008-09-17:  Added optional jitter argument to potrf, potrs, and potri.
 
 2008-09-08:  !!! WARNING WARNING WARNING WARNING WARNING WARNING WARNING !!!
-As of now (2005-06-20), the LAPACK-documentation is out of date.  In the
-next LAPACK-release the following functions need to be revised:
+* Revise calculcation of workspace sizes
 
-  * gelsd: revise computation of workspace sizes
-  * gesdd: revise computation of workspace sizes
+  As of now (2005-06-20), the LAPACK-documentation is out of date.
+  In the next LAPACK-release the following functions need to be revised:
+
+    * gelsd
+    * gesdd
+
+* Improve performance with threads on small data
+
+  Currently all external functions that have at least linear running time
+  wrt. some parameter release the OCaml runtime lock.  This coarse-grained
+  approach may make Lacaml perform less well with some functions on small
+  amounts of data, and also in applications that link with threads,
+  but do not really use them at runtime.  This problem is especially
+  pronounced if the user has to deal with large numbers of small datasets,
+  and can lead to quite noticable slowdowns.
+
+  Solution: allow the user to explicitly request that the OCaml runtime
+  lock be kept, and also provide for default heuristics that choose to
+  keep it if some value computed from the function parameters does not
+  exceed a certain value (e.g. matrix size, etc.).
-release-4-4-1
+release-4-5-0
 name="lacaml"
-version="4.4.1"
+version="4.5.0"
 description="LACAML - BLAS/LAPACK-interface for OCaml"
 
 requires="lacaml.core"
 let mat_of_vec v =
   array2_of_genarray (reshape (genarray_of_array1 v) [| Array1.dim v; 1 |])
 
+type side = [ `L | `R ]
+type diag = [ `U | `N ]
 type norm2 = [ `O | `I ]
 type norm4 = [ `M | `O | `I | `F ]
 
 
 open Bigarray
 
+type side = [ `L | `R ]
+(** Side parameter (left or right) *)
+
+type diag = [ `U | `N ]
+(** Diagonal parameter (unit or non-unit) *)
+
 type norm2 = [ `O | `I ]
 (** Type of 1-norm ([`O]) and infinity norm ([`I]) *)
 
   -> unit = "lacaml_NPRECtrmv_stub_bc" "lacaml_NPRECtrmv_stub"
 
 let trmv
-      ?n ?(trans = `N) ?(unit_triangular = false) ?(up = true)
+      ?n ?(trans = `N) ?(diag = `N) ?(up = true)
       ?(ar = 1) ?(ac = 1) a ?ofsx ?incx x =
   let loc = "Lacaml.Impl.NPREC.trmv" in
   let n, ofsx, incx, uplo_char, trans_char, diag_char =
-    trmv_get_params loc ar ac a n ofsx incx x up trans unit_triangular in
+    trmv_get_params loc ar ac a n ofsx incx x up trans diag
+  in
   direct_trmv ar ac a n uplo_char trans_char diag_char ofsx incx x
 
 
   float (* BETA *)
   -> unit = "lacaml_NPRECsymm_stub_bc" "lacaml_NPRECsymm_stub"
 
-let symm ?m ?n ?(left = true) ?(up = true)
+let symm ?m ?n ?(side = `L) ?(up = true)
       ?(beta = 0.0) ?(cr = 1) ?(cc = 1) ?c
       ?(alpha = 1.0) ?(ar = 1) ?(ac = 1) a ?(br = 1) ?(bc = 1) b =
   let loc = "Lacaml.Impl.NPREC.symm" in
   let m, n, side_char, uplo_char, c =
-    symm_get_params loc Mat.make0 ar ac a br bc b cr cc c m n left up in
+    symm_get_params loc Mat.make0 ar ac a br bc b cr cc c m n side up in
   direct_symm side_char uplo_char m n ar ac a br bc b cr cc c alpha beta;
   c
 
+
+(* TRMM *)
+
+external direct_trmm :
+  char -> (* SIDE *)
+  char -> (* UPLO *)
+  char -> (* TRANS *)
+  char -> (* DIAG *)
+  int -> (* M *)
+  int -> (* N *)
+  int -> (* AR *)
+  int -> (* AC *)
+  mat -> (* A *)
+  int -> (* BR *)
+  int -> (* BC *)
+  mat -> (* B *)
+  float (* ALPHA *)
+  -> unit = "lacaml_NPRECtrmm_stub_bc" "lacaml_NPRECtrmm_stub"
+
+let trmm ?m ?n ?(side = `L) ?(up = true) ?(trans = `N) ?(diag = `N)
+      ?(br = 1) ?(bc = 1) ~b ?(alpha = 1.0) ?(ar = 1) ?(ac = 1) a =
+  let loc = "Lacaml.Impl.NPREC.trmm" in
+  let m, n, side_char, uplo_char, trans_char, diag_char =
+    trmm_get_params loc ar ac a br bc b m n side up trans diag
+  in
+  direct_trmm side_char uplo_char trans_char diag_char m n ar ac a br bc b alpha
+
+
 (* SYRK *)
 
 external direct_syrk :
     else getrf_get_ipiv loc ipiv n n in
   let info = direct_getri n ar ac a ipiv work lwork in
   if info <> 0 then
-    if info > 0 then xxtri_lu_err loc info
+    if info > 0 then xxtri_singular_err loc info
     else getri_err loc getri_min_lwork n a lwork info
 
 (* SYTRF *)
     else sytrf_get_ipiv loc ipiv n in
   let info = direct_sytri uplo_char n ar ac a ipiv work in
   if info <> 0 then
-    if info > 0 then sytri_fact_err loc info
+    if info > 0 then xxtri_singular_err loc info
     else xxtri_err loc n a info
 
 (* POTRF *)
   if factorize then potrf ~n ~up ~ar ~ac ?jitter a;
   let info = direct_potri uplo_char n ar ac a in
   if info <> 0 then
-    if info > 0 then xxtri_lu_err loc info
+    if info > 0 then xxtri_singular_err loc info
     else xxtri_err loc n a info
 
+(* TRTRS *)
+
+external direct_trtrs :
+  char -> (* UPLO *)
+  char -> (* TRANS *)
+  char -> (* DIAG *)
+  int -> (* N *)
+  int -> (* NRHS *)
+  int -> (* AR *)
+  int -> (* AC *)
+  mat -> (* A *)
+  int -> (* BR *)
+  int -> (* BC *)
+  mat (* B *)
+  -> int = "lacaml_NPRECtrtrs_stub_bc" "lacaml_NPRECtrtrs_stub"
+
+let trtrs
+      ?n ?(up = true) ?(trans = `N) ?(diag = `N)
+      ?(ar = 1) ?(ac = 1) a ?nrhs ?(br = 1) ?(bc = 1) b =
+  let loc = "Lacaml.Impl.NPREC.trtrs" in
+  let uplo_char = get_uplo_char up in
+  let trans_char = get_trans_char trans in
+  let diag_char = get_diag_char diag in
+  let n, nrhs = xxtrs_get_params loc ar ac a n br bc b nrhs in
+  let info =
+    direct_trtrs uplo_char trans_char diag_char n nrhs ar ac a br bc b
+  in
+  if info <> 0 then trtrs_err loc n nrhs a b info
+
+(* TRTRI *)
+
+external direct_trtri :
+  char -> (* UPLO *)
+  char -> (* DIAG *)
+  int -> (* N *)
+  int -> (* AR *)
+  int -> (* AC *)
+  mat (* A *)
+  -> int = "lacaml_NPRECtrtri_stub_bc" "lacaml_NPRECtrtri_stub"
+
+let trtri ?n ?(up = true) ?(diag = `N) ?(ar = 1) ?(ac = 1) a =
+  let loc = "Lacaml.Impl.NPREC.trtri" in
+  let n = get_n_of_a loc ar ac a n in
+  let uplo_char = get_uplo_char up in
+  let diag_char = get_diag_char diag in
+  let info = direct_trtri uplo_char diag_char n ar ac a in
+  if info <> 0 then
+    if info > 0 then xxtri_singular_err loc info
+    else trtri_err loc n a info
+
 
 (* Linear equations (simple drivers) *)
 

lib/impl_SDCZ.mli

 val trmv :
   ?n : int ->
   ?trans : trans3 ->
-  ?unit_triangular : bool ->
+  ?diag : diag ->
   ?up : bool ->
   ?ar : int ->
   ?ac : int ->
   ?incx : int ->
   vec
   -> unit
-(** [trmv ?n ?trans ?unit_triangular ?up ?ar ?ac a ?ofsx ?incx x]
+(** [trmv ?n ?trans ?diag ?up ?ar ?ac a ?ofsx ?incx x]
     see BLAS documentation!
     @param n default = dimension of triangular matrix [a]
     @param trans default = `N
-    @param unit_triangular default = false (not a unit triangular matrix)
+    @param diag default = false (not a unit triangular matrix)
     @param up default = true (upper triangular portion of [a] is accessed)
     @param ar default = 1
     @param ac default = 1
 val symm :
   ?m : int ->
   ?n : int ->
-  ?left : bool ->
+  ?side : side ->
   ?up : bool ->
   ?beta : float ->
   ?cr : int ->
   ?bc : int ->
   mat
   -> mat
-(** [symm ?m ?n ?left ?up ?beta ?cr ?cc ?c ?alpha ?ar ?ac a ?br ?bc b]
+(** [symm ?m ?n ?side ?up ?beta ?cr ?cc ?c ?alpha ?ar ?ac a ?br ?bc b]
     see BLAS documentation!
     @return matrix [c], which is overwritten.
     @param m default = number of rows of [c]
     @param n default = number of columns of [c]
-    @param left default = true (multiplication is [a][b])
+    @param side default = `L (left - multiplication is [a][b])
     @param up default = true (upper triangular portion of [a] is accessed)
     @param beta default = 0.0
     @param cr default = 1
     @param br default = 1
     @param bc default = 1 *)
 
+val trmm :
+  ?m : int ->
+  ?n : int ->
+  ?side : side ->
+  ?up : bool ->
+  ?trans : trans3 ->
+  ?diag : diag ->
+  ?br : int ->
+  ?bc : int ->
+  b : mat ->
+  ?alpha : float ->
+  ?ar : int ->
+  ?ac : int ->
+  mat
+  -> unit
+(** [trmm ?m ?n ?side ?up ?trans ?diag ?br ?bc ~b ?alpha ?ar ?ac a]
+    see BLAS documentation!
+    @return matrix [c], which is overwritten.
+    @param m default = number of rows of [c]
+    @param n default = number of columns of [c]
+    @param side default = `L (left - multiplication is [a][b])
+    @param up default = true (upper triangular portion of [a] is accessed)
+    @param trans default = `N
+    @param diag default = `N (non-unit)
+    @param alpha default = 1.0
+    @param ar default = 1
+    @param ac default = 1
+    @param br default = 1
+    @param bc default = 1 *)
+
 val syrk :
   ?n : int ->
   ?k : int ->
     @raise Failure if the matrix is singular.
 
     @param n default = number of columns in matrix [a]
-    @param up default = true (upper triangel stored in [a])
+    @param up default = true (upper triangle stored in [a])
     @param ar default = 1
     @param ac default = 1
     @param factorize default = true (calls potrf implicitly)
     @param jitter default = nothing
 *)
 
+val trtrs :
+  ?n : int ->
+  ?up : bool ->
+  ?trans : trans3 ->
+  ?diag : diag ->
+  ?ar : int ->
+  ?ac : int ->
+  mat ->
+  ?nrhs : int ->
+  ?br : int ->
+  ?bc : int ->
+  mat
+  -> unit
+(** [trtrs ?n ?up ?trans ?diag ?ar ?ac a ?nrhs ?br ?bc b]
+
+    @raise Failure if the matrix is singular.
+
+    @param n default = number of columns in matrix [a]
+    @param up default = true
+    @param trans default = `N
+    @param diag default = `N
+    @param ar default = 1
+    @param ac default = 1
+    @param nrhs default = available number of columns in matrix [b]
+    @param br default = 1
+    @param bc default = 1
+*)
+
+val trtri :
+  ?n : int ->
+  ?up : bool ->
+  ?diag : diag ->
+  ?ar : int ->
+  ?ac : int ->
+  mat
+  -> unit
+(** [trtri ?n ?up ?diag ?ar ?ac a]
+
+    @raise Failure if the matrix is singular.
+
+    @param n default = number of columns in matrix [a]
+    @param up default = true (upper triangle stored in [a])
+    @param diag default = `N
+    @param ar default = 1
+    @param ac default = 1
+*)
+
 
 (** Linear equations (simple drivers) *)
 

lib/impl_SDCZ_c.c

       argv[14]);
 }
 
+/** TRMM */
+
+extern void FUN(trmm)(
+  char *SIDE, char *UPLO, char *TRANS, char *DIAG,
+  integer *M, integer *N,
+  NUMBER *ALPHA,
+  NUMBER *A, integer *LDA,
+  NUMBER *B, integer *LDB);
+
+CAMLprim value LFUN(trmm_stub)(
+  value vSIDE, value vUPLO, value vTRANS, value vDIAG,
+  value vM, value vN,
+  value vAR, value vAC, value vA,
+  value vBR, value vBC, value vB,
+  value vALPHA)
+{
+  CAMLparam2(vA, vB);
+
+  char GET_INT(SIDE), GET_INT(UPLO), GET_INT(TRANS), GET_INT(DIAG);
+  integer GET_INT(M), GET_INT(N);
+
+  CREATE_NUMBERP(ALPHA);
+
+  MAT_PARAMS(A);
+  MAT_PARAMS(B);
+
+  INIT_NUMBER(ALPHA);
+
+  caml_enter_blocking_section();  /* Allow other threads */
+  FUN(trmm)(
+    &SIDE, &UPLO, &TRANS, &DIAG,
+    &M, &N,
+    pALPHA,
+    A_data, &rows_A,
+    B_data, &rows_B);
+  caml_leave_blocking_section();  /* Disallow other threads */
+
+  CAMLreturn(Val_unit);
+}
+
+CAMLprim value LFUN(trmm_stub_bc)(value *argv, int argn)
+{
+  return
+    LFUN(trmm_stub)(
+      argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6],
+      argv[7], argv[8], argv[9], argv[10], argv[11], argv[12]);
+}
+
 /** SYRK */
 
 extern void FUN(syrk)(
   integer *INFO);
 
 CAMLprim value LFUN(potrs_stub)(
-  value vUPLO,
-  value vN,
+  value vUPLO, value vN,
   value vNRHS,
-  value vAR,
-  value vAC,
-  value vA,
-  value vBR,
-  value vBC,
-  value vB)
+  value vAR, value vAC, value vA,
+  value vBR, value vBC, value vB)
 {
   CAMLparam2(vA, vB);
 
 CAMLprim value LFUN(potri_stub)(
   value vUPLO,
   value vN,
-  value vAR,
-  value vAC,
-  value vA)
+  value vAR, value vAC, value vA)
 {
   CAMLparam1(vA);
 
   CAMLreturn(Val_int(INFO));
 }
 
+/** TRTRS */
+
+extern void FUN(trtrs)(
+  char *UPLO, char *TRANS, char *DIAG,
+  integer *N, integer *NRHS,
+  NUMBER *A, integer *LDA,
+  NUMBER *B, integer *LDB,
+  integer *INFO);
+
+CAMLprim value LFUN(trtrs_stub)(
+  value vUPLO, value vTRANS, value vDIAG,
+  value vN, value vNRHS,
+  value vAR, value vAC, value vA,
+  value vBR, value vBC, value vB)
+{
+  CAMLparam2(vA, vB);
+
+  char GET_INT(UPLO), GET_INT(TRANS), GET_INT(DIAG);
+  integer GET_INT(N), GET_INT(NRHS), INFO;
+
+  MAT_PARAMS(A);
+  MAT_PARAMS(B);
+
+  caml_enter_blocking_section();  /* Allow other threads */
+  FUN(trtrs)(
+    &UPLO, &TRANS, &DIAG,
+    &N, &NRHS,
+    A_data, &rows_A,
+    B_data, &rows_B,
+    &INFO);
+  caml_leave_blocking_section();  /* Disallow other threads */
+
+  CAMLreturn(Val_int(INFO));
+}
+
+CAMLprim value LFUN(trtrs_stub_bc)(value *argv, int argn)
+{
+  return
+    LFUN(trtrs_stub)(
+      argv[0], argv[1], argv[2], argv[3], argv[4], argv[5],
+      argv[6], argv[7], argv[8], argv[9], argv[10]);
+}
+
+/** TRTRI */
+
+extern void FUN(trtri)(
+  char *UPLO, char *DIAG,
+  integer *N,
+  NUMBER *A, integer *LDA,
+  integer *INFO);
+
+CAMLprim value LFUN(trtri_stub)(
+  value vUPLO, value vDIAG,
+  value vN,
+  value vAR, value vAC, value vA)
+{
+  CAMLparam1(vA);
+
+  char GET_INT(UPLO), GET_INT(DIAG);
+  integer GET_INT(N), INFO;
+
+  MAT_PARAMS(A);
+
+  caml_enter_blocking_section();  /* Allow other threads */
+  FUN(trtri)(&UPLO, &DIAG, &N, A_data, &rows_A, &INFO);
+  caml_leave_blocking_section();  /* Disallow other threads */
+
+  CAMLreturn(Val_int(INFO));
+}
+
+CAMLprim value LFUN(trtri_stub_bc)(value *argv, int argn)
+{
+  return LFUN(trtri_stub)(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]);
+}
+
+
 /* Linear Equations (simple drivers)
 ************************************************************************/
 
 let get_trans_char = function `N -> 'N' | `T -> 'T' | `C -> 'C'
 
 (* Char indicating which side of the matrix B matrix A should be on *)
-let get_side_char left = if left then 'L' else 'R'
+let get_side_char = function `L -> 'L' | `R -> 'R'
+
+(* Char indicating whether a diagonal is unit or non-unit *)
+let get_diag_char = function `U -> 'U' | `N -> 'N'
 
 (* Char indicating whether/how the left/right singular vectors
    should be computed *)
 let job_char_true = get_job_char true
 let job_char_false = get_job_char false
 
+(* Name information *)
+let a_str = "a"
+let b_str = "b"
+let c_str = "c"
+let k_str = "k"
+let m_str = "m"
+let n_str = "n"
+let s_str = "s"
+let u_str = "u"
+let um_str = "um"
+let un_str = "un"
+let vm_str = "vm"
+let vn_str = "vn"
+let vt_str = "vt"
+let x_str = "x"
+let y_str = "y"
+
 (* Get a work array *)
 let get_work loc vec_create work min_lwork opt_lwork lwork_str =
   match work with
         loc n_name mat_name dim2_rest n)
 
 let check_dim_mat loc mat_name r c mat m n =
-  check_dim1_mat loc mat_name mat r "m" m;
-  check_dim2_mat loc mat_name mat c "n" n
+  check_dim1_mat loc mat_name mat r m_str m;
+  check_dim2_mat loc mat_name mat c n_str n
 
 let get_mat loc mat_name mat_create r c mat m n =
   match mat with
 
 (* Makes sure that [mat] is a square matrix and [n] is within range *)
 let get_n_of_square mat_name loc r c mat n =
-  let n_str = "n" in
   let n = get_dim2_mat loc mat_name mat c n_str n in
   check_dim1_mat loc mat_name mat r n_str n;
   n
 
-let get_n_of_a loc ar ac a n = get_n_of_square "a" loc ar ac a n
+let get_n_of_a loc ar ac a n = get_n_of_square a_str loc ar ac a n
 
 let get_nrhs_of_b loc n br bc b nrhs =
-  let b_str = "b" in
   let nrhs = get_dim2_mat loc b_str b bc "nrhs" nrhs in
-  check_dim1_mat loc b_str b br "n" n;
+  check_dim1_mat loc b_str b br n_str n;
   nrhs
 
 
   | None -> vec_create min_dim
 
 let gelsX_get_params loc ar ac a m n nrhs br bc b =
-  let m = get_dim1_mat loc "a" a ar "m" m in
-  let n = get_dim2_mat loc "a" a ac "n" n in
-  let nrhs = get_dim2_mat loc "b" b bc "nrhs" nrhs in
-  check_dim1_mat loc "b" b br "m" (max m n);
+  let m = get_dim1_mat loc a_str a ar m_str m in
+  let n = get_dim2_mat loc a_str a ac n_str n in
+  let nrhs = get_dim2_mat loc b_str b bc "nrhs" nrhs in
+  check_dim1_mat loc b_str b br m_str (max m n);
   m, n, nrhs
 
 
   | None -> 1, 1, mat_create n n, job_char_true, true
   | Some None -> 1, 1, mat_empty, job_char_false, false
   | Some (Some mat) ->
-      let n_str = "n" in
       check_dim1_mat loc mat_name mat r n_str n;
       check_dim2_mat loc mat_name mat c n_str n;
       r, c, mat, job_char_true, true
 (* g?mv -- auxiliary functions *)
 
 let gXmv_get_params loc vec_create ar ac a m n ofsx incx x ofsy incy y trans =
-  let a_str = "a" in
-  let x_str = "x" in
-  let m = get_dim1_mat loc a_str a ar "m" m in
-  let n = get_dim2_mat loc a_str a ac "n" n in
+  let m = get_dim1_mat loc a_str a ar m_str m in
+  let n = get_dim2_mat loc a_str a ac n_str n in
   let ofsx, incx = get_vec_geom loc x_str ofsx incx in
-  let ofsy, incy = get_vec_geom loc "y" ofsy incy in
+  let ofsy, incy = get_vec_geom loc y_str ofsy incy in
   let lx, ly, trans_char =
     let trans_char = get_trans_char trans in
     if trans = `N then n, m, trans_char else m, n, trans_char in
   check_vec loc x_str x (ofsx + (lx - 1) * abs incx);
-  let y = get_vec loc "y" y ofsy incy ly vec_create in
+  let y = get_vec loc y_str y ofsy incy ly vec_create in
   m, n, ofsx, incx, ofsy, incy, y, trans_char
 
 (* symv -- auxiliary functions *)
 let symv_get_params loc vec_create ar ac a n ofsx incx x ofsy incy y up =
-  let a_str = "a" in
-  let x_str = "x" in
-  let y_str = "y" in
-  let n_str = "n" in
   let n = get_dim1_mat loc a_str a ar n_str n in
   check_dim2_mat loc a_str a ac n_str n;
   let ofsx, incx = get_vec_geom loc x_str ofsx incx in
 
 (* trmv -- auxiliary functions *)
 let trmv_get_params loc ar ac a n ofsx incx x up trans unit_triangular =
-  let a_str = "a" in
-  let x_str = "x" in
-  let n_str = "n" in
   let n = get_dim1_mat loc a_str a ar n_str n in
   check_dim2_mat loc a_str a ac n_str n;
   let trans_char = get_trans_char trans in
 
 (* gemm -- auxiliary functions *)
 
-let get_c loc mat_create cr cc c m n = get_mat loc "c" mat_create cr cc c m n
+let get_c loc mat_create cr cc c m n = get_mat loc c_str mat_create cr cc c m n
 
 let get_rows_mat_tr loc mat_str mat mat_r mat_c transp dim_str dim =
   match transp with
         loc k1 k2)
   else k1
 
-let gemm_get_params loc mat_create ar ac a tra br bc b cr trb cc c m n k =
-  let a_str = "a" in
-  let b_str = "b" in
-  let m = get_rows_mat_tr loc a_str a ar ac tra "m" m in
-  let n = get_cols_mat_tr loc b_str b br bc trb "n" n in
-  let k = get_inner_dim loc a_str a ar ac tra b_str b br bc trb "k" k in
-  let tra_char, trb_char = get_trans_char tra, get_trans_char trb in
+let gemm_get_params loc mat_create ar ac a transa br bc b cr transb cc c m n k =
+  let m = get_rows_mat_tr loc a_str a ar ac transa m_str m in
+  let n = get_cols_mat_tr loc b_str b br bc transb n_str n in
+  let k = get_inner_dim loc a_str a ar ac transa b_str b br bc transb k_str k in
+  let transa_char = get_trans_char transa in
+  let transb_char = get_trans_char transb in
   let c = get_c loc mat_create cr cc c m n in
-  m, n, k, tra_char, trb_char, c
+  m, n, k, transa_char, transb_char, c
 
 (* symm -- auxiliary functions *)
 
 let check_mat_square loc mat_str mat mat_r mat_c n =
-  let n_str = "n" in
   check_dim1_mat loc mat_str mat mat_r n_str n;
   check_dim2_mat loc mat_str mat mat_c n_str n
 
-let symm_get_params loc mat_create ar ac a br bc b cr cc c m n left up =
-  let a_str = "a" in
-  let b_str = "b" in
-  let m = get_dim1_mat loc b_str b br "m" m in
-  let n = get_dim2_mat loc b_str b bc "n" n in
-  if left then check_mat_square loc a_str a ar ac m
+let symm_get_params loc mat_create ar ac a br bc b cr cc c m n side up =
+  let m = get_dim1_mat loc b_str b br m_str m in
+  let n = get_dim2_mat loc b_str b bc n_str n in
+  if side = `L then check_mat_square loc a_str a ar ac m
   else check_mat_square loc a_str a ar ac n;
-  let side_char = get_side_char left in
+  let side_char = get_side_char side in
   let uplo_char = get_uplo_char up in
   let c = get_c loc mat_create cr cc c m n in
   m, n, side_char, uplo_char, c
 
+(* trmm -- auxiliary functions *)
+
+let trmm_get_params loc ar ac a br bc b m n side up transa diag =
+  let m = get_dim1_mat loc b_str b br m_str m in
+  let n = get_dim2_mat loc b_str b bc n_str n in
+  if side = `L then check_mat_square loc a_str a ar ac m
+  else check_mat_square loc a_str a ar ac n;
+  let side_char = get_side_char side in
+  let uplo_char = get_uplo_char up in
+  let transa_char = get_trans_char transa in
+  let diag_char = get_diag_char diag in
+  m, n, side_char, uplo_char, transa_char, diag_char
+
 (* syrk -- auxiliary functions *)
 
 let syrk_get_params loc mat_create ar ac a cr cc c n k up trans =
-  let a_str = "a" in
-  let n = get_rows_mat_tr loc a_str a ar ac trans "n" n in
-  let k = get_cols_mat_tr loc a_str a ar ac trans "k" k in
+  let n = get_rows_mat_tr loc a_str a ar ac trans n_str n in
+  let k = get_cols_mat_tr loc a_str a ar ac trans k_str k in
   let trans_char = get_trans_char trans in
   let uplo_char = get_uplo_char up in
   let c = get_c loc mat_create cr cc c n n in
 (* ?lange -- auxiliary functions *)
 
 let xlange_get_params loc m n ar ac a =
-  let m = get_dim1_mat loc "a" a ar "m" m in
-  let n = get_dim2_mat loc "a" a ac "n" n in
+  let m = get_dim1_mat loc a_str a ar m_str m in
+  let n = get_dim2_mat loc a_str a ac n_str n in
   m, n
 
 (* ??trs -- auxiliary functions *)
 
 (* ??tri -- auxiliary functions *)
 
-let xxtri_lu_err loc err =
-  failwith (sprintf "%s: U(%i,%i)=0 in the LU factorization" loc err err)
+let xxtri_singular_err loc err =
+  failwith (sprintf "%s: singular on index %i" loc err)
 
 let xxtri_err loc n a err =
   let msg =
       ipiv
 
 let getrf_get_params loc m n ar ac a =
-  let m = get_dim1_mat loc "a" a ar "m" m in
-  let n = get_dim2_mat loc "a" a ac "n" n in
+  let m = get_dim1_mat loc a_str a ar m_str m in
+  let n = get_dim2_mat loc a_str a ac n_str n in
   m, n
 
 (* sytrf -- auxiliary functions *)
     | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) in
   invalid_arg (sprintf "%s: %s" loc msg)
 
+(* trtrs -- auxiliary functions *)
+
+let trtrs_err loc n nrhs a b err =
+  let msg =
+    match err with
+    | -4 -> sprintf "n: valid=[0..[ got=%d" n
+    | -5 -> sprintf "nrhs: valid=[0..[ got=%d" nrhs
+    | -7 -> sprintf "dim1(a): valid=[%d..[ got=%d" (max 1 n) (Array2.dim1 a)
+    | -9 -> sprintf "dim1(b): valid=[%d..[ got=%d" (max 1 n) (Array2.dim1 b)
+    | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) in
+  invalid_arg (sprintf "%s: %s" loc msg)
+
 (* getri -- auxiliary functions *)
 
 let getri_err loc getri_min_lwork n a lwork err =
     | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) in
   invalid_arg (sprintf "%s: %s" loc msg)
 
-(* sytri -- auxiliary functions *)
+(* trtri -- auxiliary functions *)
 
-let sytri_fact_err loc err =
-  failwith (sprintf "%s: D(%i,%i)=0 in the factorization" loc err err)
-
-(* potri -- auxiliary functions *)
-
-let potri_err loc n a err =
+let trtri_err loc n a err =
   let msg =
     match err with
-    | -2 -> sprintf "n: valid=[0..[ got=%d" n
-    | -4 -> sprintf "dim1(a): valid=[%d..[ got=%d" (max 1 n) (Array2.dim1 a)
+    | -3 -> sprintf "n: valid=[0..[ got=%d" n
+    | -5 -> sprintf "dim1(a): valid=[%d..[ got=%d" (max 1 n) (Array2.dim1 a)
     | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) in
   invalid_arg (sprintf "%s: %s" loc msg)
 
 
 let gesvd_get_params
     loc vec_create mat_create jobu jobvt m n ar ac a s ur uc u vtr vtc vt =
-  let m = get_dim1_mat loc "a" a ar "m" m in
-  let n = get_dim2_mat loc "a" a ac "n" n in
-  let s = get_vec loc "s" s 1 1 (min m n) vec_create in
+  let m = get_dim1_mat loc a_str a ar m_str m in
+  let n = get_dim2_mat loc a_str a ac n_str n in
+  let s = get_vec loc s_str s 1 1 (min m n) vec_create in
   let um, un =
     match jobu with
     | `A -> m, m
   let u =
     match u with
     | Some u ->
-        check_dim1_mat loc "u" u ur "um" um;
-        check_dim2_mat loc "u" u uc "un" un;
+        check_dim1_mat loc u_str u ur um_str um;
+        check_dim2_mat loc u_str u uc un_str un;
         u
     | None -> mat_create um un in
   let vm, vn =
   let vt =
     match vt with
     | Some vt ->
-        check_dim1_mat loc "vt" vt vtr "vm" vm;
-        check_dim2_mat loc "vt" vt vtc "vn" vn;
+        check_dim1_mat loc vt_str vt vtr vm_str vm;
+        check_dim2_mat loc vt_str vt vtc vn_str vn;
         vt
     | None -> mat_create vm vn in
   let jobu_c = get_s_d_job_char jobu in
 
 let gesdd_get_params
       loc vec_create mat_create jobz m n ar ac a s ur uc u vtr vtc vt =
-  let m = get_dim1_mat loc "a" a ar "m" m in
-  let n = get_dim2_mat loc "a" a ac "n" n in
+  let m = get_dim1_mat loc a_str a ar m_str m in
+  let n = get_dim2_mat loc a_str a ac n_str n in
   let min_m_n = min m n in
-  let s = get_vec loc "s" s 1 1 min_m_n vec_create in
+  let s = get_vec loc s_str s 1 1 min_m_n vec_create in
   let um, un, vm, vn =
     match jobz with
     | `A -> m, m, n, n
   let u =
     match u with
     | Some u ->
-        check_dim1_mat loc "u" u ur "um" um;
-        check_dim2_mat loc "u" u uc "un" un;
+        check_dim1_mat loc u_str u ur um_str um;
+        check_dim2_mat loc u_str u uc un_str un;
         u
     | None -> mat_create um un in
   let vt =
     match vt with
     | Some vt ->
-        check_dim1_mat loc "vt" vt vtr "vm" vm;
-        check_dim2_mat loc "vt" vt vtc "vn" vn;
+        check_dim1_mat loc vt_str vt vtr vm_str vm;
+        check_dim2_mat loc vt_str vt vtc vn_str vn;
         vt
     | None -> mat_create vm vn in
   let jobz_c = get_s_d_job_char jobz in
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.