← Back to branch summary

~ubuntu-branches/ubuntu/karmic/scilab/karmic

« back to all changes in this revision

Viewing changes to examples/interface-lapack/intdlassq.c

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2002-03-21 16:57:43 UTC
  • Revision ID: james.westby@ubuntu.com-20020321165743-e9mv12c1tb1plztg
Tags: upstream-2.6
Import upstream version 2.6

Show diffs side-by-side

added added

removed removed

Lines of Context:
examples/interface-lapack/intdlassq.c
 
1
#include "stack-c.h"
 
2
/*      SUBROUTINE DLASSQ( N, X, INCX, SCALE, SUMSQ )     */
 
3
/*      [scale,sumsq]=dlassq(x,[ scale, [sumsq]])     */
 
4
int intdlassq(fname)
 
5
     char* fname;
 
6
{ 
 
7
  int ierr=0,un=1,deux=2,trois=3;
 
8
  int mX,nX,lX,N;
 
9
  int mSCALE,nSCALE,lSCALE,mSUMSQ,nSUMSQ,lSUMSQ;
 
10
  double SUMSQ, SCALE;
 
11
  int NRHS;
 
12
 
 
13
  static int minlhs=1, minrhs=1, maxlhs=2, maxrhs=3;
 
14
  CheckRhs(minrhs,maxrhs) ;  CheckLhs(minlhs,maxlhs) ;
 
15
  
 
16
  GetRhsVar(1, "d", &mX, &nX, &lX);   /* X */
 
17
  N=mX*nX;
 
18
  NRHS=Rhs;
 
19
  switch ( NRHS ) {
 
20
  case 3:
 
21
    /*    dlassq(x, scale, sumsq)   */
 
22
    GetRhsVar(2, "d", &mSCALE, &nSCALE, &lSCALE);   /* SCALE */
 
23
    GetRhsVar(3, "d", &mSUMSQ, &nSUMSQ, &lSUMSQ);   /* SUMSQ */
 
24
    break;
 
25
  case 2:
 
26
    /*    dlassq(x, scale)   */
 
27
    SUMSQ=0;
 
28
    GetRhsVar(2, "d", &mSCALE, &nSCALE, &lSCALE);   /* SCALE */
 
29
    CreateVar(3, "d", &un, &un, &lSUMSQ);
 
30
    *stk(lSUMSQ)=SUMSQ;   /*  default  */
 
31
    break;
 
32
  case 1:
 
33
    /*    dlassq(x)   */
 
34
    SUMSQ=0;SCALE=0;
 
35
    CreateVar(2, "d", &un, &un, &lSCALE);
 
36
    CreateVar(3, "d", &un, &un, &lSUMSQ);
 
37
    *stk(lSUMSQ)=SUMSQ; *stk(lSCALE)=SCALE;  /*  default  */
 
38
    break;
 
39
  default:
 
40
    sciprint("%s: bad call to dassq",fname);
 
41
    Error(9999); return 0;
 
42
  }
 
43
  C2F(dlassq)(&N , stk(lX), &un, stk(lSCALE), stk(lSUMSQ));
 
44
  LhsVar(1) = 2;  LhsVar(2) = 3; /*  Return var #2 (SCALE) and #3 (SUMSQ) */
 
45
  return(0);
 
46
}
 
47
 
 
48
 
 
49