File: slags2.c

package info (click to toggle)
ruby-lapack 1.8.2-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, sid, trixie
  • size: 28,572 kB
  • sloc: ansic: 191,612; ruby: 3,937; makefile: 6
file content (90 lines) | stat: -rw-r--r-- 4,502 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
#include "rb_lapack.h"

extern VOID slags2_(logical* upper, real* a1, real* a2, real* a3, real* b1, real* b2, real* b3, real* csu, real* snu, real* csv, real* snv, real* csq, real* snq);


static VALUE
rblapack_slags2(int argc, VALUE *argv, VALUE self){
  VALUE rblapack_upper;
  logical upper; 
  VALUE rblapack_a1;
  real a1; 
  VALUE rblapack_a2;
  real a2; 
  VALUE rblapack_a3;
  real a3; 
  VALUE rblapack_b1;
  real b1; 
  VALUE rblapack_b2;
  real b2; 
  VALUE rblapack_b3;
  real b3; 
  VALUE rblapack_csu;
  real csu; 
  VALUE rblapack_snu;
  real snu; 
  VALUE rblapack_csv;
  real csv; 
  VALUE rblapack_snv;
  real snv; 
  VALUE rblapack_csq;
  real csq; 
  VALUE rblapack_snq;
  real snq; 


  VALUE rblapack_options;
  if (argc > 0 && TYPE(argv[argc-1]) == T_HASH) {
    argc--;
    rblapack_options = argv[argc];
    if (rb_hash_aref(rblapack_options, sHelp) == Qtrue) {
      printf("%s\n", "USAGE:\n  csu, snu, csv, snv, csq, snq = NumRu::Lapack.slags2( upper, a1, a2, a3, b1, b2, b3, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE SLAGS2( UPPER, A1, A2, A3, B1, B2, B3, CSU, SNU, CSV, SNV, CSQ, SNQ )\n\n*  Purpose\n*  =======\n*\n*  SLAGS2 computes 2-by-2 orthogonal matrices U, V and Q, such\n*  that if ( UPPER ) then\n*\n*            U'*A*Q = U'*( A1 A2 )*Q = ( x  0  )\n*                        ( 0  A3 )     ( x  x  )\n*  and\n*            V'*B*Q = V'*( B1 B2 )*Q = ( x  0  )\n*                        ( 0  B3 )     ( x  x  )\n*\n*  or if ( .NOT.UPPER ) then\n*\n*            U'*A*Q = U'*( A1 0  )*Q = ( x  x  )\n*                        ( A2 A3 )     ( 0  x  )\n*  and\n*            V'*B*Q = V'*( B1 0  )*Q = ( x  x  )\n*                        ( B2 B3 )     ( 0  x  )\n*\n*  The rows of the transformed A and B are parallel, where\n*\n*    U = (  CSU  SNU ), V = (  CSV SNV ), Q = (  CSQ   SNQ )\n*        ( -SNU  CSU )      ( -SNV CSV )      ( -SNQ   CSQ )\n*\n*  Z' denotes the transpose of Z.\n*\n*\n\n*  Arguments\n*  =========\n*\n*  UPPER   (input) LOGICAL\n*          = .TRUE.: the input matrices A and B are upper triangular.\n*          = .FALSE.: the input matrices A and B are lower triangular.\n*\n*  A1      (input) REAL\n*  A2      (input) REAL\n*  A3      (input) REAL\n*          On entry, A1, A2 and A3 are elements of the input 2-by-2\n*          upper (lower) triangular matrix A.\n*\n*  B1      (input) REAL\n*  B2      (input) REAL\n*  B3      (input) REAL\n*          On entry, B1, B2 and B3 are elements of the input 2-by-2\n*          upper (lower) triangular matrix B.\n*\n*  CSU     (output) REAL\n*  SNU     (output) REAL\n*          The desired orthogonal matrix U.\n*\n*  CSV     (output) REAL\n*  SNV     (output) REAL\n*          The desired orthogonal matrix V.\n*\n*  CSQ     (output) REAL\n*  SNQ     (output) REAL\n*          The desired orthogonal matrix Q.\n*\n\n*  =====================================================================\n*\n\n");
      return Qnil;
    }
    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
      printf("%s\n", "USAGE:\n  csu, snu, csv, snv, csq, snq = NumRu::Lapack.slags2( upper, a1, a2, a3, b1, b2, b3, [:usage => usage, :help => help])\n");
      return Qnil;
    } 
  } else
    rblapack_options = Qnil;
  if (argc != 7 && argc != 7)
    rb_raise(rb_eArgError,"wrong number of arguments (%d for 7)", argc);
  rblapack_upper = argv[0];
  rblapack_a1 = argv[1];
  rblapack_a2 = argv[2];
  rblapack_a3 = argv[3];
  rblapack_b1 = argv[4];
  rblapack_b2 = argv[5];
  rblapack_b3 = argv[6];
  if (argc == 7) {
  } else if (rblapack_options != Qnil) {
  } else {
  }

  upper = (rblapack_upper == Qtrue);
  a2 = (real)NUM2DBL(rblapack_a2);
  b1 = (real)NUM2DBL(rblapack_b1);
  b3 = (real)NUM2DBL(rblapack_b3);
  a1 = (real)NUM2DBL(rblapack_a1);
  b2 = (real)NUM2DBL(rblapack_b2);
  a3 = (real)NUM2DBL(rblapack_a3);

  slags2_(&upper, &a1, &a2, &a3, &b1, &b2, &b3, &csu, &snu, &csv, &snv, &csq, &snq);

  rblapack_csu = rb_float_new((double)csu);
  rblapack_snu = rb_float_new((double)snu);
  rblapack_csv = rb_float_new((double)csv);
  rblapack_snv = rb_float_new((double)snv);
  rblapack_csq = rb_float_new((double)csq);
  rblapack_snq = rb_float_new((double)snq);
  return rb_ary_new3(6, rblapack_csu, rblapack_snu, rblapack_csv, rblapack_snv, rblapack_csq, rblapack_snq);
}

void
init_lapack_slags2(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
  sHelp = sH;
  sUsage = sU;
  rblapack_ZERO = zero;

  rb_define_module_function(mLapack, "slags2", rblapack_slags2, -1);
}