euslisp: srotg.c Source File

Go to the documentation of this file.
00001 /* construct givens plane rotation
00002    Ver.1.0 May 20,1988            */
00003 
00004 #include "arith.h"
00005 
00006 srotg(psa,psb,pc,ps)
00007 REAL *psa,*psb,*pc,*ps;
00008 {
00009     REAL sa,sb,c,s;
00010     REAL roe,scale,r,z;
00011 
00012     sa= *psa;
00013     sb= *psb;
00014     c= *pc;
00015     s= *ps;
00016 
00017     roe=sb;
00018     if(fabs(sa) > fabs(sb))
00019         roe=sa;
00020     scale=fabs(sa)+fabs(sb);
00021 
00022     if(scale == 0.0){
00023         c=1.0;
00024         s=0.0;
00025         r=0.0;
00026     }
00027     else{
00028         r=scale*sqrt((sa/scale)*(sa/scale)+(sb/scale)*(sb/scale));
00029         r=copysign(1.0,roe)*r;
00030         c=sa/r;
00031         s=sb/r;
00032     }
00033     z=1.0;
00034     if(fabs(sa)>fabs(sb))
00035         z=s;
00036     if((fabs(sb) >= fabs(sa)) && (c != 0.0e0))
00037         z=1.0/c;
00038     sa=r;
00039     sb=z;
00040 
00041     *psa= sa;
00042     *psb= sb;
00043     *pc= c;
00044     *ps= s;
00045 }