diff options
Diffstat (limited to 'blas/fortran/srotmg.f')
| -rw-r--r-- | blas/fortran/srotmg.f | 208 |
1 files changed, 0 insertions, 208 deletions
diff --git a/blas/fortran/srotmg.f b/blas/fortran/srotmg.f deleted file mode 100644 index 7b3bd4272..000000000 --- a/blas/fortran/srotmg.f +++ /dev/null @@ -1,208 +0,0 @@ - SUBROUTINE SROTMG(SD1,SD2,SX1,SY1,SPARAM) -* .. Scalar Arguments .. - REAL SD1,SD2,SX1,SY1 -* .. -* .. Array Arguments .. - REAL SPARAM(5) -* .. -* -* Purpose -* ======= -* -* 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.E0 SFLAG=0.E0 SFLAG=1.E0 SFLAG=-2.E0 -* -* (SH11 SH12) (1.E0 SH12) (SH11 1.E0) (1.E0 0.E0) -* H=( ) ( ) ( ) ( ) -* (SH21 SH22), (SH21 1.E0), (-1.E0 SH22), (0.E0 1.E0). -* LOCATIONS 2-4 OF SPARAM CONTAIN SH11,SH21,SH12, AND SH22 -* RESPECTIVELY. (VALUES OF 1.E0, -1.E0, OR 0.E0 IMPLIED BY THE -* VALUE OF SPARAM(1) ARE NOT STORED IN SPARAM.) -* -* THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE -* INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE -* OF SD1 AND SD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM. -* -* -* Arguments -* ========= -* -* -* SD1 (input/output) REAL -* -* SD2 (input/output) REAL -* -* SX1 (input/output) REAL -* -* SY1 (input) REAL -* -* -* SPARAM (input/output) REAL array, dimension 5 -* SPARAM(1)=SFLAG -* SPARAM(2)=SH11 -* SPARAM(3)=SH21 -* SPARAM(4)=SH12 -* SPARAM(5)=SH22 -* -* ===================================================================== -* -* .. Local Scalars .. - REAL GAM,GAMSQ,ONE,RGAMSQ,SFLAG,SH11,SH12,SH21,SH22,SP1,SP2,SQ1, - + SQ2,STEMP,SU,TWO,ZERO - INTEGER IGO -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS -* .. -* .. Data statements .. -* - DATA ZERO,ONE,TWO/0.E0,1.E0,2.E0/ - DATA GAM,GAMSQ,RGAMSQ/4096.E0,1.67772E7,5.96046E-8/ -* .. - - IF (.NOT.SD1.LT.ZERO) GO TO 10 -* GO ZERO-H-D-AND-SX1.. - GO TO 60 - 10 CONTINUE -* CASE-SD1-NONNEGATIVE - SP2 = SD2*SY1 - IF (.NOT.SP2.EQ.ZERO) GO TO 20 - SFLAG = -TWO - GO TO 260 -* REGULAR-CASE.. - 20 CONTINUE - SP1 = SD1*SX1 - SQ2 = SP2*SY1 - SQ1 = SP1*SX1 -* - IF (.NOT.ABS(SQ1).GT.ABS(SQ2)) GO TO 40 - SH21 = -SY1/SX1 - SH12 = SP2/SP1 -* - SU = ONE - SH12*SH21 -* - IF (.NOT.SU.LE.ZERO) GO TO 30 -* GO ZERO-H-D-AND-SX1.. - GO TO 60 - 30 CONTINUE - SFLAG = ZERO - SD1 = SD1/SU - SD2 = SD2/SU - SX1 = SX1*SU -* GO SCALE-CHECK.. - GO TO 100 - 40 CONTINUE - IF (.NOT.SQ2.LT.ZERO) GO TO 50 -* GO ZERO-H-D-AND-SX1.. - GO TO 60 - 50 CONTINUE - 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 - GO TO 100 -* PROCEDURE..ZERO-H-D-AND-SX1.. - 60 CONTINUE - SFLAG = -ONE - SH11 = ZERO - SH12 = ZERO - SH21 = ZERO - SH22 = ZERO -* - SD1 = ZERO - SD2 = ZERO - SX1 = ZERO -* RETURN.. - GO TO 220 -* PROCEDURE..FIX-H.. - 70 CONTINUE - IF (.NOT.SFLAG.GE.ZERO) GO TO 90 -* - IF (.NOT.SFLAG.EQ.ZERO) GO TO 80 - SH11 = ONE - SH22 = ONE - SFLAG = -ONE - GO TO 90 - 80 CONTINUE - SH21 = -ONE - SH12 = ONE - SFLAG = -ONE - 90 CONTINUE - GO TO IGO(120,150,180,210) -* PROCEDURE..SCALE-CHECK - 100 CONTINUE - 110 CONTINUE - IF (.NOT.SD1.LE.RGAMSQ) GO TO 130 - IF (SD1.EQ.ZERO) GO TO 160 - ASSIGN 120 TO IGO -* FIX-H.. - GO TO 70 - 120 CONTINUE - SD1 = SD1*GAM**2 - SX1 = SX1/GAM - SH11 = SH11/GAM - SH12 = SH12/GAM - GO TO 110 - 130 CONTINUE - 140 CONTINUE - IF (.NOT.SD1.GE.GAMSQ) GO TO 160 - ASSIGN 150 TO IGO -* FIX-H.. - GO TO 70 - 150 CONTINUE - SD1 = SD1/GAM**2 - SX1 = SX1*GAM - SH11 = SH11*GAM - SH12 = SH12*GAM - GO TO 140 - 160 CONTINUE - 170 CONTINUE - IF (.NOT.ABS(SD2).LE.RGAMSQ) GO TO 190 - IF (SD2.EQ.ZERO) GO TO 220 - ASSIGN 180 TO IGO -* FIX-H.. - GO TO 70 - 180 CONTINUE - SD2 = SD2*GAM**2 - SH21 = SH21/GAM - SH22 = SH22/GAM - GO TO 170 - 190 CONTINUE - 200 CONTINUE - IF (.NOT.ABS(SD2).GE.GAMSQ) GO TO 220 - ASSIGN 210 TO IGO -* FIX-H.. - GO TO 70 - 210 CONTINUE - SD2 = SD2/GAM**2 - SH21 = SH21*GAM - SH22 = SH22*GAM - GO TO 200 - 220 CONTINUE - IF (SFLAG) 250,230,240 - 230 CONTINUE - SPARAM(3) = SH21 - SPARAM(4) = SH12 - GO TO 260 - 240 CONTINUE - SPARAM(2) = SH11 - SPARAM(5) = SH22 - GO TO 260 - 250 CONTINUE - SPARAM(2) = SH11 - SPARAM(3) = SH21 - SPARAM(4) = SH12 - SPARAM(5) = SH22 - 260 CONTINUE - SPARAM(1) = SFLAG - RETURN - END |