SUBROUTINE DROTMGF (DD1,DD2,DX1,DY1,DPARAM)

C

C     CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS

C     THE SECOND COMPONENT OF THE 2-VECTOR  (DSQRT(DD1)*DX1,DSQRT(DD2)*

C     DY2)**T.

C     WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS..

C

C     DFLAG=-1.D0     DFLAG=0.D0        DFLAG=1.D0     DFLAG=-2.D0

C

C       (DH11  DH12)    (1.D0  DH12)    (DH11  1.D0)    (1.D0  0.D0)

C     H=(          )    (          )    (          )    (          )

C       (DH21  DH22),   (DH21  1.D0),   (-1.D0 DH22),   (0.D0  1.D0).

C     LOCATIONS 2-4 OF DPARAM CONTAIN DH11, DH21, DH12, AND DH22

C     RESPECTIVELY. (VALUES OF 1.D0, -1.D0, OR 0.D0 IMPLIED BY THE

C     VALUE OF DPARAM(1) ARE NOT STORED IN DPARAM.)

C

C     THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE

C     INEXACT.  THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE

C     OF DD1 AND DD2.  ALL ACTUAL SCALING OF DATA IS DONE USING GAM.

C

      DOUBLE PRECISION GAM,ONE,RGAMSQ,DD2,DH11,DH21,DPARAM,DP2,

     1 DQ2,DU,DY1,ZERO,GAMSQ,DD1,DFLAG,DH12,DH22,DP1,DQ1,

     2 DTEMP,DX1,TWO

      DIMENSION DPARAM(5)

C

      DATA ZERO,ONE,TWO /0.D0,1.D0,2.D0/

      DATA GAM,GAMSQ,RGAMSQ/4096.D0,16777216.D0,5.9604645D-8/

      IF(.NOT. DD1 .LT. ZERO) GO TO 10

C       GO ZERO-H-D-AND-DX1..

          GO TO 60

   10 CONTINUE

C     CASE-DD1-NONNEGATIVE

      DP2=DD2*DY1

      IF(.NOT. DP2 .EQ. ZERO) GO TO 20

          DFLAG=-TWO

          GO TO 260

C     REGULAR-CASE..

   20 CONTINUE

      DP1=DD1*DX1

      DQ2=DP2*DY1

      DQ1=DP1*DX1

C

      IF(.NOT. DABS(DQ1) .GT. DABS(DQ2)) GO TO 40

          DH21=-DY1/DX1

          DH12=DP2/DP1

C

          DU=ONE-DH12*DH21

C

          IF(.NOT. DU .LE. ZERO) GO TO 30

C         GO ZERO-H-D-AND-DX1..

               GO TO 60

   30     CONTINUE

               DFLAG=ZERO

               DD1=DD1/DU

               DD2=DD2/DU

               DX1=DX1*DU

C         GO SCALE-CHECK..

               GO TO 100

   40 CONTINUE

          IF(.NOT. DQ2 .LT. ZERO) GO TO 50

C         GO ZERO-H-D-AND-DX1..

               GO TO 60

   50     CONTINUE

               DFLAG=ONE

               DH11=DP1/DP2

               DH22=DX1/DY1

               DU=ONE+DH11*DH22

               DTEMP=DD2/DU

               DD2=DD1/DU

               DD1=DTEMP

               DX1=DY1*DU

C         GO SCALE-CHECK

               GO TO 100

C     PROCEDURE..ZERO-H-D-AND-DX1..

   60 CONTINUE

          DFLAG=-ONE

          DH11=ZERO

          DH12=ZERO

          DH21=ZERO

          DH22=ZERO

C

          DD1=ZERO

          DD2=ZERO

          DX1=ZERO

C         RETURN..

          GO TO 220

C     PROCEDURE..FIX-H..

   70 CONTINUE

      IF(.NOT. DFLAG .GE. ZERO) GO TO 90

C

          IF(.NOT. DFLAG .EQ. ZERO) GO TO 80

          DH11=ONE

          DH22=ONE

          DFLAG=-ONE

          GO TO 90

   80     CONTINUE

          DH21=-ONE

          DH12=ONE

          DFLAG=-ONE

   90 CONTINUE

      GO TO IGO,(120,150,180,210)

C     PROCEDURE..SCALE-CHECK

  100 CONTINUE

  110     CONTINUE

          IF(.NOT. DD1 .LE. RGAMSQ) GO TO 130

               IF(DD1 .EQ. ZERO) GO TO 160

               ASSIGN 120 TO IGO

C              FIX-H..

               GO TO 70

  120          CONTINUE

               DD1=DD1*GAM**2

               DX1=DX1/GAM

               DH11=DH11/GAM

               DH12=DH12/GAM

          GO TO 110

  130 CONTINUE

  140     CONTINUE

          IF(.NOT. DD1 .GE. GAMSQ) GO TO 160

               ASSIGN 150 TO IGO

C              FIX-H..

               GO TO 70

  150          CONTINUE

               DD1=DD1/GAM**2

               DX1=DX1*GAM

               DH11=DH11*GAM

               DH12=DH12*GAM

          GO TO 140

  160 CONTINUE

  170     CONTINUE

          IF(.NOT. DABS(DD2) .LE. RGAMSQ) GO TO 190

               IF(DD2 .EQ. ZERO) GO TO 220

               ASSIGN 180 TO IGO

C              FIX-H..

               GO TO 70

  180          CONTINUE

               DD2=DD2*GAM**2

               DH21=DH21/GAM

               DH22=DH22/GAM

          GO TO 170

  190 CONTINUE

  200     CONTINUE

          IF(.NOT. DABS(DD2) .GE. GAMSQ) GO TO 220

               ASSIGN 210 TO IGO

C              FIX-H..

               GO TO 70

  210          CONTINUE

               DD2=DD2/GAM**2

               DH21=DH21*GAM

               DH22=DH22*GAM

          GO TO 200

  220 CONTINUE

          IF(DFLAG)250,230,240

  230     CONTINUE

               DPARAM(3)=DH21

               DPARAM(4)=DH12

               GO TO 260

  240     CONTINUE

               DPARAM(2)=DH11

               DPARAM(5)=DH22

               GO TO 260

  250     CONTINUE

               DPARAM(2)=DH11

               DPARAM(3)=DH21

               DPARAM(4)=DH12

               DPARAM(5)=DH22

  260 CONTINUE

          DPARAM(1)=DFLAG

          RETURN

      END