/*Translated by FOR_C, v3.4.2 (-), on 07/09/115 at 08:30:11 */ /*FOR_C Options SET: ftn=u io=c no=p op=aimnv s=dbov str=l x=f - prototypes */ #include #include "fcrt.h" #include "srotg.h" #include void /*FUNCTION*/ srotg( float *a, float *b, float *c, float *s) { float r, u, v; /* Copyright (c) 1996 California Institute of Technology, Pasadena, CA. * ALL RIGHTS RESERVED. * Based on Government Sponsored Research NAS7-03001. *>> 1994-10-20 SROTG Krogh Changes to use M77CON *>> 1994-04-19 SROTG Krogh Changed to use generic intrinsics. *>> 1985-08-02 SROTG Lawson Initial code. *--S replaces "?": ?ROTG, ?ROT * * DESIGNED BY C.L.LAWSON, JPL, 1977 SEPT 08 * * * CONSTRUCT THE GIVENS TRANSFORMATION * * ( C S ) * G = ( ) , C**2 + S**2 = 1 , * (-S C ) * * WHICH ZEROS THE SECOND ENTRY OF THE 2-VECTOR (A,B)**T . * * THE QUANTITY R = (+/-)SQRT(A**2 + B**2) OVERWRITES A IN * STORAGE. THE VALUE OF B IS OVERWRITTEN BY A VALUE Z WHICH * ALLOWS C AND S TO BE RECOVERED BY THE FOLLOWING ALGORITHM: * IF Z=1 SET C=0.E0 AND S=1.E0 * IF ABS(Z) .LT. 1 SET C=SQRT(1-Z**2) AND S=Z * IF ABS(Z) .GT. 1 SET C=1/Z AND S=SQRT(1-C**2) * * NORMALLY, THE SUBPROGRAM SROT(N,X,INCX,Y,INCY,C,S) WILL * NEXT BE CALLED TO APPLY THE TRANSFORMATION TO A 2 BY N MATRIX. * * ------------------------------------------------------------------ * */ if (fabsf( *a ) <= fabsf( *b )) goto L_10; /* *** HERE ABS(A) .GT. ABS(B) *** * */ u = *a + *a; v = *b/u; /* NOTE THAT U AND R HAVE THE SIGN OF A * */ r = sqrtf( .25e0 + SQ(v) )*u; /* NOTE THAT C IS POSITIVE * */ *c = *a/r; *s = v*(*c + *c); *b = *s; *a = r; return; /* *** HERE ABS(A) .LE. ABS(B) *** * */ L_10: if (*b == 0.e0) goto L_20; u = *b + *b; v = *a/u; /* NOTE THAT U AND R HAVE THE SIGN OF B * (R IS IMMEDIATELY STORED IN A) * */ *a = sqrtf( .25e0 + SQ(v) )*u; /* NOTE THAT S IS POSITIVE * */ *s = *b/ *a; *c = v*(*s + *s); if (*c == 0.e0) goto L_15; *b = 1.e0/ *c; return; L_15: *b = 1.e0; return; /* *** HERE A = B = 0.E0 *** * */ L_20: *c = 1.e0; *s = 0.e0; return; } /* end of function */