[sd1,sd2,sx1,sy1,sparam]=srotmg(sd1,sd2,sx1,sy1,sparam);

function [sd1,sd2,sx1,sy1,sparam]=srotmg(sd1,sd2,sx1,sy1,sparam);
persistent firstCall gam gamsq gt20 gt200 gt40 gt60 gt80 igo one rgamsq sflag sh11 sh12 sh21 sh22 sp1 sp2 sq1 sq2 stemp su two zero ; if isempty(firstCall),firstCall=1;end; 

if isempty(gam), gam=0; end;
if isempty(gamsq), gamsq=0; end;
if isempty(one), one=0; end;
if isempty(rgamsq), rgamsq=0; end;
if isempty(sflag), sflag=0; end;
if isempty(sh11), sh11=0; end;
if isempty(sh12), sh12=0; end;
if isempty(sh21), sh21=0; end;
if isempty(sh22), sh22=0; end;
if isempty(sp1), sp1=0; end;
if isempty(sp2), sp2=0; end;
if isempty(sq1), sq1=0; end;
if isempty(sq2), sq2=0; end;
if isempty(stemp), stemp=0; end;
if isempty(su), su=0; end;
if isempty(two), two=0; end;
if isempty(zero), zero=0; end;
if isempty(igo), igo=0; end;
if isempty(gt200), gt200=0; end;
if isempty(gt20), gt20=0; end;
if isempty(gt40), gt40=0; end;
if isempty(gt60), gt60=0; end;
if isempty(gt80), gt80=0; end;
%***BEGIN PROLOGUE  SROTMG
%***PURPOSE  Construct a modified Givens transformation.
%***LIBRARY   SLATEC (BLAS)
%***CATEGORY  D1B10
%***TYPE      SINGLE PRECISION (SROTMG-S, DROTMG-D)
%***KEYWORDS  BLAS, LINEAR ALGEBRA, MODIFIED GIVENS ROTATION, VECTOR
%***AUTHOR  Lawson, C. L., (JPL)
%           Hanson, R. J., (SNLA)
%           Kincaid, D. R., (U. of Texas)
%           Krogh, F. T., (JPL)
%***DESCRIPTION
%
%                B L A S  Subprogram
%    Description of Parameters
%
%     --Input--
%      SD1  single precision scalar
%      SD2  single precision scalar
%      SX1  single precision scalar
%      SY2  single precision scalar
%   SPARAM  S.P. 5-vector. SPARAM(1)=SFLAG defined below.
%           Locations 2-5 contain the rotation matrix.
%
%     --Output--
%      SD1  changed to represent the effect of the transformation
%      SD2  changed to represent the effect of the transformation
%      SX1  changed to represent the effect of the transformation
%      SY2  unchanged
%
%     Construct the modified Givens transformation matrix H which zeros
%     the second component of the 2-vector  (SQRT(SD1)*SX1,SQRT(SD2)*
%     SY2)**T.
%     With SPARAM(1)=SFLAG, H has one of the following forms:
%
%     SFLAG=-1.0E0     SFLAG=0.0E0        SFLAG=1.0E0     SFLAG=-2.0E0
%
%       (SH11  SH12)    (1.0E0  SH12)    (SH11  1.0E0)    (1.0E0  0.0E0)
%     H=(          )    (          )    (          )    (          )
%       (SH21  SH22),   (SH21  1.0E0),   (-1.0E0 SH22),   (0.0E0  1.0E0).
%
%     Locations 2-5 of SPARAM contain SH11, SH21, SH12, and SH22,
%     respectively.  (Values of 1.0E0, -1.0E0, or 0.0E0 implied by the
%     value of SPARAM(1) are not stored in SPARAM.)
%
%***REFERENCES  C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
%                 Krogh, Basic linear algebra subprograms for Fortran
%                 usage, Algorithm No. 539, Transactions on Mathematical
%                 Software 5, 3 (September 1979), pp. 308-323.
%***ROUTINES CALLED  (NONE)
%***REVISION HISTORY  (YYMMDD)
%   780301  DATE WRITTEN
%   861211  REVISION DATE from Version 3.2
%   891214  Prologue converted to Version 4.0 format.  (BAB)
%   920316  Prologue corrected.  (WRB)
%   920501  Reformatted the REFERENCES section.  (WRB)
%***end PROLOGUE  SROTMG
if firstCall,   zero =[0.0e0];  end;
if firstCall,  one =[1.0e0];  end;
if firstCall,  two=[2.0e0];  end;
if firstCall,   gam =[4096.0e0];  end;
if firstCall,  gamsq =[1.67772e7];  end;
if firstCall,  rgamsq=[5.96046e-8];  end;
firstCall=0;
%***FIRST EXECUTABLE STATEMENT  SROTMG
gt200=0;
gt20=0;
gt40=0;
gt60=0;
gt80=0;
while (1);
if( sd1>=zero )
%     CASE-SD1-NONNEGATIVE
sp2 = sd2.*sy1;
if( sp2==zero )
%       GO ZERO-H-D-AND-SX1..
sflag = -two;
sparam(1) = sflag;
return;
else;
%     REGULAR-CASE..
sp1 = sd1.*sx1;
sq2 = sp2.*sy1;
sq1 = sp1.*sx1;
%
if( ~(~(abs(sq1)>abs(sq2))) )
sh21 = -sy1./sx1;
sh12 = sp2./sp1;
%
su = one - sh12.*sh21;
%
if( su<=zero )
break;
end;
sflag = zero;
sd1 = sd1./su;
sd2 = sd2./su;
sx1 = sx1.*su;
%         GO SCALE-CHECK..
elseif( sq2<zero ) ;
break;
else;
sflag = one;
sh11 = sp1./sp2;
sh22 = sx1./sy1;
su = one + sh11.*sh22;
stemp = sd2./su;
sd2 = sd1./su;
sd1 = stemp;
sx1 = sy1.*su;
%         GO SCALE-CHECK
end;
end;
%     PROCEDURE..SCALE-CHECK
while( true );
if(gt80==0)
if(gt60==0)
if(gt40==0)
if(gt20==0)
if( ~(sd1<=rgamsq) )
gt40=1;
continue;
end;
if( sd1==zero )
gt60=1;
continue;
end;
igo = 300;
%              FIX-H..
%     PROCEDURE..FIX-H..
end;
gt20=0;
if( ~(~(sflag>=zero)) )
%
if( sflag==zero )
sh11 = one;
sh22 = one;
sflag = -one;
else;
sh21 = -one;
sh12 = one;
sflag = -one;
end;
end;
if( igo==300 )
sd1 = sd1.*gam.^2;
sx1 = sx1./gam;
sh11 = sh11./gam;
sh12 = sh12./gam;
continue;
elseif( igo==500 ) ;
sd1 = sd1./gam.^2;
sx1 = sx1.*gam;
sh11 = sh11.*gam;
sh12 = sh12.*gam;
elseif( igo==700 ) ;
sd2 = sd2.*gam.^2;
sh21 = sh21./gam;
sh22 = sh22./gam;
gt60=1;
continue;
elseif( igo==900 ) ;
sd2 = sd2./gam.^2;
sh21 = sh21.*gam;
sh22 = sh22.*gam;
gt80=1;
continue;
else;
continue;
end;
end;
gt40=0;
if( sd1>=gamsq )
igo = 500;
%              FIX-H..
gt20=1;
continue;
end;
end;
gt60=0;
if( abs(sd2)<=rgamsq )
if( sd2==zero )
break;
end;
igo = 700;
%              FIX-H..
gt20=1;
continue;
end;
end;
gt80=0;
if( ~(abs(sd2)>=gamsq) )
break;
end;
igo = 900;
%              FIX-H..
gt20=1;
continue;
end;
gt200=1;
end;
break;
end;
%     PROCEDURE..ZERO-H-D-AND-SX1..
if(gt200==0)
sflag = -one;
sh11 = zero;
sh12 = zero;
sh21 = zero;
sh22 = zero;
%
sd1 = zero;
sd2 = zero;
sx1 = zero;
end;
%         RETURN..
if( sflag<0 )
sparam(2) = sh11;
sparam(3) = sh21;
sparam(4) = sh12;
sparam(5) = sh22;
elseif( sflag==0 ) ;
sparam(3) = sh21;
sparam(4) = sh12;
else;
sparam(2) = sh11;
sparam(5) = sh22;
end;
sparam(1) = sflag;
end %subroutine srotmg
%DECK SS2LT