Markus Mottl avatar Markus Mottl committed 6cd25cf

Added tbtrs

Comments (0)

Files changed (7)

+2009-06-12:  Added new function:
+
+               * tbtrs  (all numbers)
+
+             Thanks to Sam Ehrlichman <sehrlichman@janestreet.com>
+             for contributing the patch!
+
 2009-06-07:  Added workaround for OCaml performance bug wrt. bigarray
              access.  This should make OCaml code perform much faster when
              accessing or modifying bigarrays directly.
 name="lacaml"
-version="5.3.0"
+version="5.4.0"
 description="LACAML - BLAS/LAPACK-interface for OCaml"
 
 requires="lacaml.core"
     if info > 0 then xxtri_singular_err loc info
     else trtri_err loc n a info
 
+(* TBTRS *)
+
+external direct_tbtrs :
+  uplo : char ->
+  trans : char ->
+  diag : char ->
+  n : int ->
+  kd : int ->
+  nrhs : int ->
+  abr : int ->
+  abc : int ->
+  ab : mat ->
+  br : int ->
+  bc : int ->
+  b : mat ->
+  int = "lacaml_NPRECtbtrs_stub_bc" "lacaml_NPRECtbtrs_stub"
+
+let tbtrs
+    ?n ?kd ?(up = true) ?(trans = `N) ?(diag = `N)
+    ?(abr = 1) ?(abc = 1) ab ?nrhs ?(br = 1) ?(bc = 1) b =
+  let loc = "Lacaml.Impl.NPREC.tbtrs" in
+  let uplo = get_uplo_char up in
+  let trans = get_trans_char trans in
+  let diag = get_diag_char diag in
+  let n = get_dim2_mat loc ab_str ab abc n_str n in
+  let nrhs = get_nrhs_of_b loc n br bc b nrhs in
+  let kd = get_k_mat_sb loc ab_str ab abr kd_str kd in
+  let info =
+    direct_tbtrs ~uplo ~trans ~diag ~n ~kd ~nrhs ~abr ~abc ~ab ~br ~bc ~b
+  in
+  if info <> 0 then tbtrs_err loc n nrhs kd ab b info
+
 (* GEQRF *)
 
 external direct_geqrf :

lib/impl_SDCZ.mli

     @param bc default = 1
 *)
 
+val tbtrs :
+  ?n : int ->
+  ?kd : int ->
+  ?up : bool ->
+  ?trans : trans3 ->
+  ?diag : diag ->
+  ?abr : int ->
+  ?abc : int ->
+  mat ->
+  ?nrhs : int ->
+  ?br : int ->
+  ?bc : int ->
+  mat ->
+  unit
+(** [tbtrs ?n ?kd ?up ?trans ?diag ?abr ?abc ab ?nrhs ?br ?bc b]
+
+    @raise Failure if the matrix is singular.
+
+    @param n default = number of columns in matrix [ab]
+    @param kd default = number of rows in matrix [ab] - 1
+    @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 ->

lib/impl_SDCZ_c.c

   return LFUN(trtri_stub)(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]);
 }
 
+/** TBTRS */
+
+extern void FUN(tbtrs)(
+  char *UPLO, char *TRANS, char *DIAG,
+  integer *N, integer *KD, integer *NRHS,
+  NUMBER *AB, integer *LDAB,
+  NUMBER *B, integer *LDB,
+  integer *INFO);
+
+CAMLprim value LFUN(tbtrs_stub)(
+  value vUPLO, value vTRANS, value vDIAG,
+  value vN, value vKD, value vNRHS,
+  value vABR, value vABC, value vAB,
+  value vBR, value vBC, value vB)
+{
+  CAMLparam2(vAB, vB);
+
+  char GET_INT(UPLO), GET_INT(TRANS), GET_INT(DIAG);
+  integer GET_INT(N), GET_INT(KD), GET_INT(NRHS), INFO;
+
+  MAT_PARAMS(AB);
+  MAT_PARAMS(B);
+
+  caml_enter_blocking_section();  /* Allow other threads */
+  FUN(tbtrs)(
+    &UPLO, &TRANS, &DIAG,
+    &N, &KD, &NRHS,
+    AB_data, &rows_AB,
+    B_data, &rows_B,
+    &INFO);
+  caml_leave_blocking_section();  /* Disallow other threads */
+
+  CAMLreturn(Val_long(INFO));
+}
+
+CAMLprim value LFUN(tbtrs_stub_bc)(value *argv, int argn)
+{
+  return
+    LFUN(tbtrs_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]);
+}
+
 /** GEQRF */
 
 extern void FUN(geqrf)(
       else n
   | None -> dim2_rest
 
-(* A symmetric band (SB) matrix has physical size [k+1]*[n] for a
-   logical matrix of size [n]*[n].  Check and return the [k] (possibly
-   also given by the optional argument [k]). *)
+(* A symmetric band (SB) or triangular band (TB) matrix has physical size
+   [k+1]*[n] for a logical matrix of size [n]*[n].  Check and return the [k]
+   (possibly also given by the optional argument [k]). *)
 let get_k_mat_sb loc mat_name mat mat_r k_name k =
   let dim1 = Array2.dim1 mat in
   let max_k = dim1 - mat_r in
     | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) in
   invalid_arg (sprintf "%s: %s" loc msg)
 
+(* tbtrs -- auxiliary functions *)
+
+let tbtrs_err loc n nrhs kd ab b err =
+  let msg =
+    match err with
+    | -4 -> sprintf "n: valid=[0..[ got=%d" n
+    | -5 -> sprintf "kd: valid=[0..[ got=%d" kd
+    | -6 -> sprintf "nrhs: valid=[0..[ got=%d" nrhs
+    | -8 -> sprintf "dim1(ab): valid=[%d..[ got=%d" (max 1 n) (Array2.dim1 ab)
+    | -10 -> 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 =
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.