Go to the documentation of this file.00001
00002
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 }