C
C SPDX-License-Identifier: BSD-3-Clause
C
      SUBROUTINE MB02CV( TYPEG, STRUCG, K, N, P, Q, NB, RNK, A1, LDA1,
     $                   A2, LDA2, B, LDB, F1, LDF1, F2, LDF2, G, LDG,
     $                   CS, DWORK, LDWORK, INFO )
C
C     PURPOSE
C
C     To apply the transformations created by the SLICOT Library routine
C     MB02CU on other columns / rows of the generator, contained in the
C     arrays F1, F2 and G.
C
C     ARGUMENTS
C
C     Mode Parameters
C
C     TYPEG   CHARACTER*1
C             Specifies the type of the generator, as follows:
C             = 'D':  generator is column oriented and rank
C                     deficient;
C             = 'C':  generator is column oriented and not rank
C                     deficient;
C             = 'R':  generator is row oriented and not rank
C                     deficient.
C             Note that this parameter must be equivalent with the
C             used TYPEG in the call of MB02CU.
C
C     STRUCG  CHARACTER*1
C             Information about the structure of the generators,
C             as follows:
C             = 'T':  the trailing block of the positive generator
C                     is upper / lower triangular, and the trailing
C                     block of the negative generator is zero;
C             = 'N':  no special structure to mention.
C
C     Input/Output Parameters
C
C     K       (input)  INTEGER
C             The number of rows in A1 to be processed.  K >= 0.
C
C     N       (input)  INTEGER
C             If TYPEG = 'D'  or  TYPEG = 'C', the number of rows in F1;
C             if TYPEG = 'R', the number of columns in F1.  N >= 0.
C
C     P       (input)  INTEGER
C             The number of columns of the positive generator.  P >= K.
C
C     Q       (input)  INTEGER
C             The number of columns in B.
C             If TYPEG = 'D',        Q >= K;
C             If TYPEG = 'C' or 'R', Q >= 0.
C
C     NB      (input)  INTEGER
C             On entry, if TYPEG = 'C'  or  TYPEG = 'R', NB specifies
C             the block size to be used in the blocked parts of the
C             algorithm. NB must be equivalent with the used block size
C             in the routine MB02CU.
C
C     RNK     (input)  INTEGER
C             If TYPEG = 'D', the number of linearly independent columns
C             in the generator as returned by MB02CU.  0 <= RNK <= K.
C             If TYPEG = 'C' or 'R', the value of this parameter is
C             irrelevant.
C
C     A1      (input)  DOUBLE PRECISION array, dimension
C             (LDA1, K)
C             On entry, if TYPEG = 'D', the leading K-by-K part of this
C             array must contain the matrix A1 as returned by MB02CU.
C             If TYPEG = 'C' or 'R', this array is not referenced.
C
C     LDA1    INTEGER
C             The leading dimension of the array A1.
C             If TYPEG = 'D',                   LDA1 >= MAX(1,K);
C             if TYPEG = 'C'  or  TYPEG = 'R',  LDA1 >= 1.
C
C     A2      (input)  DOUBLE PRECISION array,
C             if TYPEG = 'D'  or  TYPEG = 'C',  dimension (LDA2, P-K);
C             if TYPEG = 'R',                   dimension (LDA2, K).
C             On entry, if TYPEG = 'D'  or  TYPEG = 'C', the leading
C             K-by-(P-K) part of this array must contain the matrix
C             A2 as returned by MB02CU.
C             On entry, if TYPEG = 'R', the leading (P-K)-by-K part of
C             this array must contain the matrix A2 as returned by
C             MB02CU.
C
C     LDA2    INTEGER
C             The leading dimension of the array A2.
C             If P = K,                  LDA2 >= 1;
C             If P > K and (TYPEG = 'D' or TYPEG = 'C'),
C                                        LDA2 >= MAX(1,K);
C             if P > K and TYPEG = 'R',  LDA2 >= P-K.
C
C     B       (input)  DOUBLE PRECISION array,
C             if TYPEG = 'D'  or  TYPEG = 'C',  dimension (LDB, Q);
C             if TYPEG = 'R',                   dimension (LDB, K).
C             On entry, if TYPEG = 'D'  or  TYPEG = 'C', the leading
C             K-by-Q part of this array must contain the matrix B as
C             returned by MB02CU.
C             On entry, if TYPEG = 'R', the leading Q-by-K part of this
C             array must contain the matrix B as returned by MB02CU.
C
C     LDB     INTEGER
C             The leading dimension of the array B.
C             If Q = 0,                  LDB >= 1;
C             If Q > 0 and (TYPEG = 'D' or TYPEG = 'C'),
C                                        LDB >= MAX(1,K);
C             if Q > 0 and TYPEG = 'R',  LDB >= Q.
C
C     F1      (input/output)  DOUBLE PRECISION array,
C             if TYPEG = 'D'  or  TYPEG = 'C',  dimension (LDF1, K);
C             if TYPEG = 'R',                   dimension (LDF1, N).
C             On entry, if TYPEG = 'D'  or  TYPEG = 'C', the leading
C             N-by-K part of this array must contain the first part
C             of the positive generator to be processed.
C             On entry, if TYPEG = 'R', the leading K-by-N part of this
C             array must contain the first part of the positive
C             generator to be processed.
C             On exit, if TYPEG = 'D'  or  TYPEG = 'C', the leading
C             N-by-K part of this array contains the first part of the
C             transformed positive generator.
C             On exit, if TYPEG = 'R', the leading K-by-N part of this
C             array contains the first part of the transformed positive
C             generator.
C
C     LDF1    INTEGER
C             The leading dimension of the array F1.
C             If TYPEG = 'D'  or  TYPEG = 'C',   LDF1 >= MAX(1,N);
C             if TYPEG = 'R',                    LDF1 >= MAX(1,K).
C
C     F2      (input/output)  DOUBLE PRECISION array,
C             if TYPEG = 'D'  or  TYPEG = 'C',  dimension (LDF2, P-K);
C             if TYPEG = 'R',                   dimension (LDF2, N).
C             On entry, if TYPEG = 'D'  or  TYPEG = 'C', the leading
C             N-by-(P-K) part of this array must contain the second part
C             of the positive generator to be processed.
C             On entry, if TYPEG = 'R', the leading (P-K)-by-N part of
C             this array must contain the second part of the positive
C             generator to be processed.
C             On exit, if TYPEG = 'D'  or  TYPEG = 'C', the leading
C             N-by-(P-K) part of this array contains the second part of
C             the transformed positive generator.
C             On exit, if TYPEG = 'R', the leading (P-K)-by-N part of
C             this array contains the second part of the transformed
C             positive generator.
C
C     LDF2    INTEGER
C             The leading dimension of the array F2.
C             If P = K,                  LDF2 >= 1;
C             If P > K and (TYPEG = 'D' or TYPEG = 'C'),
C                                        LDF2 >= MAX(1,N);
C             if P > K and TYPEG = 'R',  LDF2 >= P-K.
C
C     G       (input/output)  DOUBLE PRECISION array,
C             if TYPEG = 'D'  or  TYPEG = 'C',  dimension (LDG, Q);
C             if TYPEG = 'R',                   dimension (LDG, N).
C             On entry, if TYPEG = 'D'  or  TYPEG = 'C', the leading
C             N-by-Q part of this array must contain the negative part
C             of the generator to be processed.
C             On entry, if TYPEG = 'R', the leading Q-by-N part of this
C             array must contain the negative part of the generator to
C             be processed.
C             On exit, if TYPEG = 'D'  or  TYPEG = 'C', the leading
C             N-by-Q part of this array contains the transformed
C             negative generator.
C             On exit, if TYPEG = 'R', the leading Q-by-N part of this
C             array contains the transformed negative generator.
C
C     LDG     INTEGER
C             The leading dimension of the array G.
C             If Q = 0,                  LDG >= 1;
C             If Q > 0 and (TYPEG = 'D' or TYPEG = 'C'),
C                                        LDG >= MAX(1,N);
C             if Q > 0 and TYPEG = 'R',  LDG >= Q.
C
C     CS      (input)  DOUBLE PRECISION array, dimension (x)
C             If TYPEG = 'D' and P = K,                   x = 3*K;
C             If TYPEG = 'D' and P > K,                   x = 5*K;
C             If (TYPEG = 'C' or TYPEG = 'R') and P = K,  x = 4*K;
C             If (TYPEG = 'C' or TYPEG = 'R') and P > K,  x = 6*K.
C             On entry, the first x elements of this array must contain
C             Givens and modified hyperbolic rotation parameters, and
C             scalar factors of the Householder transformations as
C             returned by MB02CU.
C
C     Workspace
C
C     DWORK   DOUBLE PRECISION array, dimension (LDWORK)
C             On exit, if INFO = -23,  DWORK(1) returns the minimum
C             value of LDWORK.
C
C     LDWORK  INTEGER
C             The length of the array DWORK.
C             TYPEG = 'D':               LDWORK >= MAX(1,N);
C             (TYPEG = 'C' or TYPEG = 'R')  and  NB <= 0:
C                                        LDWORK >= MAX(1,N);
C             (TYPEG = 'C' or TYPEG = 'R')  and  NB >= 1:
C                                        LDWORK >= MAX(1,( N + K )*NB).
C
C     Error Indicator
C
C     INFO    INTEGER
C             = 0:  successful exit;
C             < 0:  if INFO = -i, the i-th argument had an illegal
C                   value.
C
C     NUMERICAL ASPECTS
C
C     The algorithm requires 0(N*K*( P + Q )) floating point operations.
C
C     METHOD
C
C     The Householder transformations and modified hyperbolic rotations
C     computed by SLICOT Library routine MB02CU are applied to the
C     corresponding parts of the matrices F1, F2 and G.
C
C     CONTRIBUTOR
C
C     D. Kressner, Technical Univ. Berlin, Germany, May 2001.
C
C     REVISIONS
C
C     V. Sima, Research Institute for Informatics, Bucharest, June 2001,
C     March 2004, March 2007.
C
C     KEYWORDS
C
C     Elementary matrix operations, Householder transformation, matrix
C     operations, Toeplitz matrix.
C
C     ******************************************************************
C
C     .. Parameters ..
      DOUBLE PRECISION   ZERO, ONE
      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
C     .. Scalar Arguments ..
      CHARACTER          STRUCG, TYPEG
      INTEGER            INFO, K, LDA1, LDA2, LDB, LDF1, LDF2, LDG,
     $                   LDWORK, N, NB, P, Q, RNK
C     .. Array Arguments ..
      DOUBLE PRECISION   A1(LDA1,*), A2(LDA2,*), B(LDB,*), CS(*),
     $                   DWORK(*), F1(LDF1,*), F2(LDF2,*), G(LDG,*)
C     .. Local Scalars ..
      INTEGER            COL2, I, IB, J, JJ, LEN, NBL, POS, PST2,
     $                   WRKMIN
      DOUBLE PRECISION   ALPHA, BETA, C, S, TAU, TEMP
      LOGICAL            LRDEF, LTRI, LCOL
C     .. External Functions ..
      LOGICAL            LSAME
      EXTERNAL           LSAME
C     .. External Subroutines ..
      EXTERNAL           DAXPY, DLARF, DLARFB, DLARFT, DROT, DSCAL,
     $                   XERBLA
C     .. Intrinsic Functions ..
      INTRINSIC          MAX, MIN
C
C     .. Executable Statements ..
C
C     Decode the scalar input parameters.
C
      INFO  = 0
      COL2  = MAX( 0, P - K )
      LRDEF = LSAME( TYPEG,  'D' )
      LCOL  = LSAME( TYPEG,  'C' )
      LTRI  = LSAME( STRUCG, 'T' )
      IF ( LRDEF ) THEN
         WRKMIN = MAX( 1, N )
      ELSE
         IF ( NB.GE.1 ) THEN
            WRKMIN = MAX( 1, ( N + K )*NB )
         ELSE
            WRKMIN = MAX( 1, N )
         END IF
      END IF
C
C     Check the scalar input parameters.
C
      IF ( .NOT.( LCOL .OR. LRDEF .OR. LSAME( TYPEG, 'R' ) ) ) THEN
         INFO = -1
      ELSE IF ( .NOT.( LTRI .OR. LSAME( STRUCG, 'N' ) ) ) THEN
         INFO = -2
      ELSE IF ( K.LT.0 ) THEN
         INFO = -3
      ELSE IF ( N.LT.0 ) THEN
         INFO = -4
      ELSE IF ( P.LT.K ) THEN
         INFO = -5
      ELSE IF ( Q.LT.0 .OR. ( LRDEF .AND. Q.LT.K ) ) THEN
         INFO = -6
      ELSE IF ( LRDEF .AND. ( RNK.LT.0 .OR. RNK.GT.K ) ) THEN
         INFO = -8
      ELSE IF ( ( LDA1.LT.1 ) .OR. ( LRDEF .AND. LDA1.LT.K ) ) THEN
         INFO = -10
      ELSE IF ( ( ( P.EQ.K ) .AND. LDA2.LT.1 ) .OR.
     $          ( ( P.GT.K ) .AND. ( LRDEF .OR. LCOL ) .AND.
     $            ( LDA2.LT.MAX( 1, K ) ) ) .OR.
     $          ( ( P.GT.K ) .AND. .NOT.( LRDEF .OR. LCOL ) .AND.
     $            ( LDA2.LT.( P-K ) ) ) ) THEN
         INFO = -12
      ELSE IF ( ( ( Q.EQ.0 ) .AND. LDB.LT.1 ) .OR.
     $          ( ( Q.GT.0 ) .AND. ( LRDEF .OR. LCOL ) .AND.
     $            ( LDB.LT.MAX( 1, K ) ) ) .OR.
     $          ( ( Q.GT.0 ) .AND. .NOT.( LRDEF .OR. LCOL ) .AND.
     $            ( LDB.LT.Q ) ) ) THEN
         INFO = -14
      ELSE IF ( ( LRDEF .OR. LCOL ) .AND. LDF1.LT.MAX( 1, N ) ) THEN
         INFO = -16
      ELSE IF ( (.NOT.( LRDEF .OR. LCOL ) ) .AND. LDF1.LT.MAX( 1, K ) )
     $      THEN
         INFO = -16
      ELSE IF ( ( ( P.EQ.K ) .AND. LDF2.LT.1 ) .OR.
     $          ( ( P.GT.K ) .AND. ( LRDEF .OR. LCOL ) .AND.
     $            ( LDF2.LT.MAX( 1, N ) ) ) .OR.
     $          ( ( P.GT.K ) .AND. .NOT.( LRDEF .OR. LCOL ) .AND.
     $            ( LDF2.LT.( P-K ) ) ) ) THEN
         INFO = -18
      ELSE IF ( ( ( Q.EQ.0 ) .AND. LDG.LT.1 ) .OR.
     $          ( ( Q.GT.0 ) .AND. ( LRDEF .OR. LCOL ) .AND.
     $            ( LDG.LT.MAX( 1, N ) ) ) .OR.
     $          ( ( Q.GT.0 ) .AND. .NOT.( LRDEF .OR. LCOL ) .AND.
     $            ( LDG.LT.Q ) ) ) THEN
         INFO = -20
      ELSE IF ( LDWORK.LT.WRKMIN ) THEN
         DWORK(1) = DBLE( WRKMIN )
         INFO = -23
      END IF
C
C     Return if there were illegal values.
C
      IF ( INFO.NE.0 ) THEN
         CALL XERBLA( 'MB02CV', -INFO )
         RETURN
      END IF
C
C     Quick return if possible.
C
      IF ( MIN( K, N ).EQ.0 .OR.
     $     ( ( .NOT.LRDEF ) .AND. Q.EQ.0 .AND. P.EQ.K ) ) THEN
         RETURN
      END IF
C
      IF ( LRDEF ) THEN
C
C        Deficient generator.
C
         IF ( COL2.EQ.0 ) THEN
            PST2 = 2*K
         ELSE
            PST2 = 4*K
         END IF
C
         DO 10  I = 1, RNK
C
C           Apply elementary reflectors.
C
            IF ( COL2.GT.1 ) THEN
               TAU     = A2(I,1)
               A2(I,1) = ONE
               CALL DLARF( 'Right', N, COL2, A2(I,1), LDA2, TAU, F2,
     $                     LDF2, DWORK )
               A2(I,1) = TAU
            END IF
C
            IF ( K.GT.I ) THEN
               ALPHA   = A1(I,I)
               A1(I,I) = ONE
               CALL DLARF( 'Right', N, K-I+1, A1(I,I), LDA1, CS(PST2+I),
     $                     F1(1,I), LDF1, DWORK )
               A1(I,I) = ALPHA
            END IF
C
            IF ( COL2.GT.0 ) THEN
               C = CS(2*K+I*2-1)
               S = CS(2*K+I*2)
               CALL DROT( N, F1(1,I), 1, F2, 1, C, S )
            END IF
C
            IF ( Q.GT.1 ) THEN
               TAU    = B(I,1)
               B(I,1) = ONE
               CALL DLARF( 'Right', N, Q, B(I,1), LDB, TAU,
     $                     G, LDG, DWORK )
               B(I,1) = TAU
            END IF
C
C           Apply hyperbolic rotation.
C
            C = CS(I*2-1)
            S = CS(I*2)
            CALL DSCAL( N, ONE/C, F1(1,I), 1 )
            CALL DAXPY( N,  -S/C, G(1,1), 1, F1(1,I), 1 )
            CALL DSCAL( N,     C, G(1,1), 1 )
            CALL DAXPY( N,    -S, F1(1,I), 1, G(1,1), 1 )
   10    CONTINUE
C
         LEN = Q
         POS = 1
C
         DO 20 J = RNK + 1, K
C
C           Apply the reductions working on singular rows.
C
            IF ( COL2.GT.1 ) THEN
               TAU     = A2(J,1)
               A2(J,1) = ONE
               CALL DLARF( 'Right', N, COL2, A2(J,1), LDA2, TAU, F2,
     $                     LDF2, DWORK )
               A2(J,1) = TAU
            END IF
            IF ( K.GT.J ) THEN
               ALPHA   = A1(J,J)
               A1(J,J) = ONE
               CALL DLARF( 'Right', N, K-J+1, A1(J,J), LDA1, CS(PST2+J),
     $                     F1(1,J), LDF1, DWORK )
               A1(J,J) = ALPHA
            END IF
            IF ( COL2.GT.0 ) THEN
               C = CS(2*K+J*2-1)
               S = CS(2*K+J*2)
               CALL DROT( N, F1(1,J), 1, F2, 1, C, S )
            END IF
            IF ( LEN.GT.1 ) THEN
               BETA     = B(J,POS)
               B(J,POS) = ONE
               CALL DLARF( 'Right', N, LEN, B(J,POS), LDB, CS(J*2-1),
     $                     G(1,POS), LDG, DWORK )
               B(J,POS) = BETA
            END IF
            LEN = LEN - 1
            POS = POS + 1
   20    CONTINUE
C
      ELSE IF ( LCOL ) THEN
C
C        Column oriented and not deficient generator.
C
C        Apply an LQ like hyperbolic/orthogonal blocked decomposition.
C
         IF ( LTRI ) THEN
            LEN = MAX( N - K, 0 )
         ELSE
            LEN = N
         END IF
         IF ( COL2.GT.0 ) THEN
C
            NBL = MIN( COL2, NB )
            IF ( NBL.GT.0 ) THEN
C
C              Blocked version.
C
               DO 50  I = 1, K - NBL + 1, NBL
                  IB = MIN( K-I+1, NBL )
                  CALL DLARFT( 'Forward', 'Rowwise', COL2, IB, A2(I,1),
     $                         LDA2, CS(4*K+I), DWORK, N+K )
                  CALL DLARFB( 'Right', 'No Transpose', 'Forward',
     $                         'Rowwise', LEN, COL2, IB, A2(I,1),
     $                         LDA2, DWORK, N+K, F2, LDF2,
     $                         DWORK(IB+1), N+K )
C
                  DO 40  J = I, I + IB - 1
                     TAU     = A2(J,1)
                     A2(J,1) = ONE
                     CALL DLARF( 'Right', LEN, MIN( COL2, J-I+1 ),
     $                           A2(J,1), LDA2, TAU, F2, LDF2, DWORK )
                     A2(J,1) = TAU
                     C = CS(2*K+J*2-1)
                     S = CS(2*K+J*2)
                     CALL DROT( LEN, F1(1,J), 1, F2, 1, C, S )
                     IF ( LTRI ) THEN
                        LEN  = LEN + 1
                        TEMP = F1(LEN,J)
                        F1(LEN,J) =  C*TEMP
                        F2(LEN,1) = -S*TEMP
C
                        DO 30  JJ = 2, COL2
                           F2(LEN,JJ) = ZERO
   30                   CONTINUE
C
                     END IF
   40             CONTINUE
C
   50          CONTINUE
C
            ELSE
               I = 1
            END IF
C
C           Unblocked version for the last or only block.
C
            DO 70  J = I, K
               IF ( COL2.GT.1 ) THEN
                  TAU     = A2(J,1)
                  A2(J,1) = ONE
                  CALL DLARF( 'Right', LEN, COL2, A2(J,1), LDA2, TAU,
     $                        F2, LDF2, DWORK )
                  A2(J,1) = TAU
               END IF
C
               C = CS(2*K+J*2-1)
               S = CS(2*K+J*2)
               CALL DROT( LEN, F1(1,J), 1, F2, 1, C, S )
               IF ( LTRI ) THEN
                  LEN = LEN + 1
                  TEMP = F1(LEN,J)
                  F1(LEN,J) =  C*TEMP
                  F2(LEN,1) = -S*TEMP
C
                  DO 60  JJ = 2, COL2
                     F2(LEN,JJ) = ZERO
   60             CONTINUE
C
               END IF
   70       CONTINUE
C
            PST2 = 5*K
         ELSE
            PST2 = 2*K
         END IF
C
         IF ( LTRI ) THEN
            LEN = N - K
         ELSE
            LEN = N
         END IF
C
         NBL = MIN( Q, NB )
         IF ( NBL.GT.0 ) THEN
C
C           Blocked version.
C
            DO 100  I = 1, K - NBL + 1, NBL
               IB = MIN( K-I+1, NBL )
               CALL DLARFT( 'Forward', 'Rowwise', Q, IB, B(I,1),
     $                      LDB, CS(PST2+I), DWORK, N+K )
               CALL DLARFB( 'Right', 'NonTranspose', 'Forward',
     $                      'Rowwise', LEN, Q, IB, B(I,1),
     $                      LDB, DWORK, N+K, G, LDG,
     $                      DWORK(IB+1), N+K )
C
               DO 90  J = I, I + IB - 1
                  TAU    = B(J,1)
                  B(J,1) = ONE
                  CALL DLARF( 'Right', LEN, J-I+1, B(J,1), LDB,
     $                         TAU, G, LDG, DWORK )
                  B(J,1) = TAU
C
C                 Apply hyperbolic rotation.
C
                  C = CS(J*2-1)
                  S = CS(J*2)
                  CALL DSCAL( LEN, ONE/C, F1(1,J), 1 )
                  CALL DAXPY( LEN,  -S/C, G, 1, F1(1,J), 1 )
                  CALL DSCAL( LEN,     C, G, 1 )
                  CALL DAXPY( LEN,    -S, F1(1,J), 1, G, 1 )
                  IF ( LTRI ) THEN
                     LEN = LEN + 1
                     G(LEN,1)  = -S/C*F1(LEN,J)
                     F1(LEN,J) = F1(LEN,J) / C
C
                     DO 80  JJ = 2, Q
                        G(LEN,JJ) = ZERO
   80                CONTINUE
C
                  END IF
   90          CONTINUE
C
  100       CONTINUE
C
         ELSE
            I = 1
         END IF
C
C        Unblocked version for the last or only block.
C
         DO 120  J = I, K
            IF ( Q.GT.1 ) THEN
               TAU    = B(J,1)
               B(J,1) = ONE
               CALL DLARF( 'Right', LEN, Q, B(J,1), LDB, TAU,
     $                     G, LDG, DWORK )
               B(J,1) = TAU
            END IF
            IF ( Q.GT.0 ) THEN
C
C              Apply hyperbolic rotation.
C
               C = CS(J*2-1)
               S = CS(J*2)
               CALL DSCAL( LEN, ONE/C, F1(1,J), 1 )
               CALL DAXPY( LEN,  -S/C, G, 1, F1(1,J), 1 )
               CALL DSCAL( LEN,     C, G, 1 )
               CALL DAXPY( LEN,    -S, F1(1,J), 1, G, 1 )
               IF ( LTRI ) THEN
                  LEN = LEN + 1
                  G(LEN,1)  = -S/C*F1(LEN,J)
                  F1(LEN,J) = F1(LEN,J) / C
C
                  DO 110  JJ = 2, Q
                     G(LEN,JJ) = ZERO
  110             CONTINUE
C
               END IF
            END IF
  120    CONTINUE
C
      ELSE
C
C        Row oriented and not deficient generator.
C
         IF ( LTRI ) THEN
            LEN = MAX( N - K, 0 )
         ELSE
            LEN = N
         END IF
C
         IF ( COL2.GT.0 ) THEN
            NBL = MIN( NB, COL2 )
            IF ( NBL.GT.0 ) THEN
C
C              Blocked version.
C
               DO 150  I = 1, K - NBL + 1, NBL
                  IB = MIN( K-I+1, NBL )
                  CALL DLARFT( 'Forward', 'Columnwise', COL2, IB,
     $                         A2(1,I), LDA2, CS(4*K+I), DWORK, N+K )
                  CALL DLARFB( 'Left', 'Transpose', 'Forward',
     $                         'Columnwise', COL2, LEN, IB, A2(1,I),
     $                         LDA2, DWORK, N+K, F2, LDF2,
     $                         DWORK(IB+1), N+K )
C
                  DO 140  J = I, I + IB - 1
                     TAU     = A2(1,J)
                     A2(1,J) = ONE
                     CALL DLARF( 'Left', MIN( COL2, J-I+1 ), LEN,
     $                           A2(1,J), 1, TAU, F2, LDF2, DWORK )
                     A2(1,J) = TAU
                     C = CS(2*K+J*2-1)
                     S = CS(2*K+J*2)
                     CALL DROT( LEN, F1(J,1), LDF1, F2, LDF2, C, S )
                     IF ( LTRI ) THEN
                        LEN  = LEN + 1
                        TEMP = F1(J,LEN)
                        F1(J,LEN) =  C*TEMP
                        F2(1,LEN) = -S*TEMP
C
                        DO 130  JJ = 2, COL2
                           F2(JJ,LEN) = ZERO
  130                   CONTINUE
C
                     END IF
  140             CONTINUE
C
  150          CONTINUE
C
            ELSE
               I = 1
            END IF
C
C           Unblocked version for the last or only block.
C
            DO 170  J = I, K
               IF ( COL2.GT.1 ) THEN
                  TAU     = A2(1,J)
                  A2(1,J) = ONE
                  CALL DLARF( 'Left', COL2, LEN, A2(1,J), 1, TAU,
     $                        F2, LDF2, DWORK )
                  A2(1,J) = TAU
               END IF
C
               C = CS(2*K+J*2-1)
               S = CS(2*K+J*2)
               CALL DROT( LEN, F1(J,1), LDF1, F2, LDF2, C, S )
               IF ( LTRI ) THEN
                  LEN  = LEN + 1
                  TEMP = F1(J,LEN)
                  F1(J,LEN) =  C*TEMP
                  F2(1,LEN) = -S*TEMP
C
                  DO 160  JJ = 2, COL2
                     F2(JJ,LEN) = ZERO
  160             CONTINUE
C
               END IF
  170       CONTINUE
C
            PST2 = 5*K
         ELSE
            PST2 = 2*K
         END IF
C
         IF ( LTRI ) THEN
            LEN = N - K
         ELSE
            LEN = N
         END IF
C
         NBL = MIN( Q, NB )
         IF ( NBL.GT.0 ) THEN
C
C           Blocked version.
C
            DO 200  I = 1, K - NBL + 1, NBL
               IB = MIN( K-I+1, NBL )
               CALL DLARFT( 'Forward', 'Columnwise', Q, IB, B(1,I),
     $                      LDB, CS(PST2+I), DWORK, N+K )
               CALL DLARFB( 'Left', 'Transpose', 'Forward',
     $                      'Columnwise', Q, LEN, IB, B(1,I),
     $                      LDB, DWORK, N+K, G, LDG,
     $                      DWORK(IB+1), N+K )
C
               DO 190  J = I, I + IB - 1
                  TAU    = B(1,J)
                  B(1,J) = ONE
                  CALL DLARF( 'Left', J-I+1, LEN, B(1,J), 1,
     $                         TAU, G, LDG, DWORK )
                  B(1,J) = TAU
C
C                 Apply hyperbolic rotation.
C
                  C = CS(J*2-1)
                  S = CS(J*2)
                  CALL DSCAL( LEN, ONE/C, F1(J,1), LDF1 )
                  CALL DAXPY( LEN,  -S/C, G, LDG, F1(J,1), LDF1 )
                  CALL DSCAL( LEN,     C, G, LDG )
                  CALL DAXPY( LEN,    -S, F1(J,1), LDF1, G, LDG )
                  IF ( LTRI ) THEN
                     LEN = LEN + 1
                     G(1,LEN)  = -S/C*F1(J,LEN)
                     F1(J,LEN) = F1(J,LEN) / C
C
                     DO 180  JJ = 2, Q
                        G(JJ,LEN) = ZERO
  180                CONTINUE
C
                  END IF
  190          CONTINUE
C
  200       CONTINUE
C
         ELSE
            I = 1
         END IF
C
C        Unblocked version for the last or only block.
C
         DO 220  J = I, K
            IF ( Q.GT.1 ) THEN
               TAU    = B(1,J)
               B(1,J) = ONE
               CALL DLARF( 'Left', Q, LEN, B(1,J), 1, TAU,
     $                     G, LDG, DWORK )
               B(1,J) = TAU
            END IF
            IF ( Q.GT.0 ) THEN
C
C              Apply hyperbolic rotation.
C
               C = CS(J*2-1)
               S = CS(J*2)
               CALL DSCAL( LEN, ONE/C, F1(J,1), LDF1 )
               CALL DAXPY( LEN,  -S/C, G, LDG, F1(J,1), LDF1 )
               CALL DSCAL( LEN,     C, G, LDG )
               CALL DAXPY( LEN,    -S, F1(J,1), LDF1, G, LDG )
               IF ( LTRI ) THEN
                  LEN = LEN + 1
                  G(1,LEN)  = -S/C*F1(J,LEN)
                  F1(J,LEN) = F1(J,LEN) / C
C
                  DO 210  JJ = 2, Q
                     G(JJ,LEN) = ZERO
  210             CONTINUE
C
               END IF
            END IF
  220    CONTINUE
C
      END IF
C
C *** Last line of MB02CV ***
      END
