Scilab [trunk]: scilab/modules/linear_algebra/examples/intdlassq.c Source File

00001 #include "stack-c.h"
00002 /*      SUBROUTINE DLASSQ( N, X, INCX, SCALE, SUMSQ )     */
00003 /*      [scale,sumsq]=dlassq(x,[ scale, [sumsq]])     */
00004 int intdlassq(fname)
00005      char* fname;
00006 { 
00007   int ierr=0,un=1,deux=2,trois=3;
00008   int mX,nX,lX,N;
00009   int mSCALE,nSCALE,lSCALE,mSUMSQ,nSUMSQ,lSUMSQ;
00010   double SUMSQ, SCALE;
00011   int NRHS;
00012 
00013   static int minlhs=1, minrhs=1, maxlhs=2, maxrhs=3;
00014   CheckRhs(minrhs,maxrhs) ;  CheckLhs(minlhs,maxlhs) ;
00015   
00016   GetRhsVar(1, "d", &mX, &nX, &lX);   /* X */
00017   N=mX*nX;
00018   NRHS=Rhs;
00019   switch ( NRHS ) {
00020   case 3:
00021     /*    dlassq(x, scale, sumsq)   */
00022     GetRhsVar(2, "d", &mSCALE, &nSCALE, &lSCALE);   /* SCALE */
00023     GetRhsVar(3, "d", &mSUMSQ, &nSUMSQ, &lSUMSQ);   /* SUMSQ */
00024     break;
00025   case 2:
00026     /*    dlassq(x, scale)   */
00027     SUMSQ=0;
00028     GetRhsVar(2, "d", &mSCALE, &nSCALE, &lSCALE);   /* SCALE */
00029     CreateVar(3, "d", &un, &un, &lSUMSQ);
00030     *stk(lSUMSQ)=SUMSQ;   /*  default  */
00031     break;
00032   case 1:
00033     /*    dlassq(x)   */
00034     SUMSQ=0;SCALE=0;
00035     CreateVar(2, "d", &un, &un, &lSCALE);
00036     CreateVar(3, "d", &un, &un, &lSUMSQ);
00037     *stk(lSUMSQ)=SUMSQ; *stk(lSCALE)=SCALE;  /*  default  */
00038     break;
00039   default:
00040     sciprint("%s: bad call to dassq",fname);
00041     Error(9999); return 0;
00042   }
00043   C2F(dlassq)(&N , stk(lX), &un, stk(lSCALE), stk(lSUMSQ));
00044   LhsVar(1) = 2;  LhsVar(2) = 3; /*  Return var #2 (SCALE) and #3 (SUMSQ) */
00045   return(0);
00046 }
00047 
00048 
00049