Routine: PZLARFT()  File: SRC\pzlarft.f

 
 
# lines: 543
  # code: 543
  # comment: 0
  # blank:0
# Variables:47
# Callers:12
# Callings:0
# Words:254
# Keywords:168
 

 

..
     .. Array Arguments ..
     ..
  Purpose
  =======
  PZLARFT forms the triangular factor T of a complex block reflector H
  of order n, which is defined as a product of k elementary reflectors.
  If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular;
  If DIRECT = 'B', H = H(k) . . . H(2) H(1) and T is lower triangular.
  If STOREV = 'C', the vector which defines the elementary reflector
  H(i) is stored in the i-th column of the distributed matrix V, and
     H  =  I - V * T * V'
  If STOREV = 'R', the vector which defines the elementary reflector
  H(i) is stored in the i-th row of the distributed matrix V, and
     H  =  I - V' * T * V
  Notes
  =====
  Each global data object is described by an associated description
  vector.  This vector stores the information required to establish
  the mapping between an object element and its corresponding process
  and memory location.
  Let A be a generic term for any 2D block cyclicly distributed array.
  Such a global array has an associated description vector DESCA.
  In the following comments, the character _ should be read as
  "of the global array".
  NOTATION        STORED IN      EXPLANATION
  --------------- -------------- --------------------------------------
  DTYPE_A(global) DESCA( DTYPE_ )The descriptor type.  In this case,
                                 DTYPE_A = 1.
  CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating
                                 the BLACS process grid A is distribu-
                                 ted over. The context itself is glo-
                                 bal, but the handle (the integer
                                 value) may vary.
  M_A    (global) DESCA( M_ )    The number of rows in the global
                                 array A.
  N_A    (global) DESCA( N_ )    The number of columns in the global
                                 array A.
  MB_A   (global) DESCA( MB_ )   The blocking factor used to distribute
                                 the rows of the array.
  NB_A   (global) DESCA( NB_ )   The blocking factor used to distribute
                                 the columns of the array.
  RSRC_A (global) DESCA( RSRC_ ) The process row over which the first
                                 row of the array A is distributed.
  CSRC_A (global) DESCA( CSRC_ ) The process column over which the
                                 first column of the array A is
                                 distributed.
  LLD_A  (local)  DESCA( LLD_ )  The leading dimension of the local
                                 array.  LLD_A >= MAX(1,LOCr(M_A)).
  Let K be the number of rows or columns of a distributed matrix,
  and assume that its process grid has dimension p x q.
  LOCr( K ) denotes the number of elements of K that a process
  would receive if K were distributed over the p processes of its
  process column.
  Similarly, LOCc( K ) denotes the number of elements of K that a
  process would receive if K were distributed over the q processes of
  its process row.
  The values of LOCr() and LOCc() may be determined via a call to the
  ScaLAPACK tool function, NUMROC:
          LOCr( M ) = NUMROC( M, MB_A, MYROW, RSRC_A, NPROW ),
          LOCc( N ) = NUMROC( N, NB_A, MYCOL, CSRC_A, NPCOL ).
  An upper bound for these quantities may be computed by:
          LOCr( M ) <= ceil( ceil(M/MB_A)/NPROW )*MB_A
          LOCc( N ) <= ceil( ceil(N/NB_A)/NPCOL )*NB_A
  Arguments
  =========
  DIRECT  (global input) CHARACTER*1
          Specifies the order in which the elementary reflectors are
          multiplied to form the block reflector:
          = 'F': H = H(1) H(2) . . . H(k) (Forward)
          = 'B': H = H(k) . . . H(2) H(1) (Backward)
  STOREV  (global input) CHARACTER*1
          Specifies how the vectors which define the elementary
          reflectors are stored (see also Further Details):
          = 'C': columnwise
          = 'R': rowwise
  N       (global input) INTEGER
          The order of the block reflector H. N >= 0.
  K       (global input) INTEGER
          The order of the triangular factor T (= the number of
          elementary reflectors). 1 <= K <= MB_V (= NB_V).
  V       (input/output) COMPLEX*16 pointer into the local memory
          to an array of local dimension (LOCr(IV+N-1),LOCc(JV+K-1))
          if STOREV = 'C', and (LOCr(IV+K-1),LOCc(JV+N-1)) if
          STOREV = 'R'. The distributed matrix V contains the
          Householder vectors. See further details.
  IV      (global input) INTEGER
          The row index in the global array V indicating the first
          row of sub( V ).
  JV      (global input) INTEGER
          The column index in the global array V indicating the
          first column of sub( V ).
  DESCV   (global and local input) INTEGER array of dimension DLEN_.
          The array descriptor for the distributed matrix V.
  TAU     (local input) COMPLEX*16, array, dimension LOCr(IV+K-1)
          if INCV = M_V, and LOCc(JV+K-1) otherwise. This array
          contains the Householder scalars related to the Householder
          vectors.  TAU is tied to the distributed matrix V.
  T       (local output) COMPLEX*16 array, dimension (NB_V,NB_V)
          if STOREV = 'Col', and (MB_V,MB_V) otherwise. It contains
          the k-by-k triangular factor of the block reflector asso-
          ciated with V. If DIRECT = 'F', T is upper triangular;
          if DIRECT = 'B', T is lower triangular.
  WORK    (local workspace) COMPLEX*16 array,
                                          dimension (K*(K-1)/2)
  Further Details
  ===============
  The shape of the matrix V and the storage of the vectors which define
  the H(i) is best illustrated by the following example with n = 5 and
  k = 3. The elements equal to 1 are not stored; the corresponding
  array elements are modified but restored on exit. The rest of the
  array is not used.
  DIRECT = 'F' and STOREV = 'C':   DIRECT = 'F' and STOREV = 'R':
  V( IV:IV+N-1,    (  1       )    V( IV:IV+K-1,    (  1 v1 v1 v1 v1 )
     JV:JV+K-1 ) = ( v1  1    )       JV:JV+N-1 ) = (     1 v2 v2 v2 )
                   ( v1 v2  1 )                     (        1 v3 v3 )
                   ( v1 v2 v3 )
                   ( v1 v2 v3 )
  DIRECT = 'B' and STOREV = 'C':   DIRECT = 'B' and STOREV = 'R':
  V( IV:IV+N-1,    ( v1 v2 v3 )    V( IV:IV+K-1,    ( v1 v1  1       )
     JV:JV+K-1 ) = ( v1 v2 v3 )       JV:JV+N-1 ) = ( v2 v2 v2  1    )
                   (  1 v2 v3 )                     ( v3 v3 v3 v3  1 )
                   (     1 v3 )
                   (        1 )
  =====================================================================
     .. Parameters ..

 
Display dynamic version Find AutoScroll Reload FontSize: - + Hide Comments Hide Blanks Frame FullScreen MailPrint

 
001        SUBROUTINE PZLARFT( DIRECT , STOREV , N , K , V , IV , JV , DESCV , TAU ,
002       $T , WORK )
003  
004  *     -- ScaLAPACK auxiliary routine(version 1.7) --
005  *     University of Tennessee , Knoxville , Oak Ridge National Laboratory ,
006  *     and University of California , Berkeley.
007  *     May 1 , 1997
008  
009  *     .. Scalar Arguments ..
010        CHARACTER DIRECT , STOREV
011        INTEGER IV , JV , K , N
012        INTEGER BLOCK_CYCLIC_2D , CSRC_ , CTXT_ , DLEN_ , DTYPE_ ,
013       $LLD_ , MB_ , M_ , NB_ , N_ , RSRC_
014        PARAMETER( BLOCK_CYCLIC_2D = 1 , DLEN_ = 9 , DTYPE_ = 1 ,
015       $CTXT_ = 2 , M_ = 3 , N_ = 4 , MB_ = 5 , NB_ = 6 ,
016       $RSRC_ = 7 , CSRC_ = 8 , LLD_ = 9 )
017        COMPLEX*16 ONE , ZERO
018        PARAMETER( ONE =( 1.0D + 0 , 0.0D + 0 ) ,
019       $ZERO =( 0.0D + 0 , 0.0D + 0 ) )
020  *     ..
021  *     .. Local Scalars ..
022        LOGICAL FORWARD
023        INTEGER ICOFF , ICTXT , II , IIV , IROFF , IVCOL , IVROW ,
024       $ITMP0 , ITMP1 , IW , JJ , JJV , LDV , MICOL , MIROW ,
025       $MYCOL , MYROW , NP , NPCOL , NPROW , NQ
026        COMPLEX*16 VII
027  *     ..
028  *     .. External Subroutines ..
029        EXTERNAL BLACS_GRIDINFO , INFOG2L , ZCOPY , ZGEMV ,
030       $ZGSUM2D , ZLACGV , ZLASET , ZTRMV
031  *     ..
032  *     .. External Functions ..
033        LOGICAL LSAME
034        INTEGER INDXG2P , NUMROC
035        EXTERNAL INDXG2P , LSAME , NUMROC
036  *     ..
037  *     .. Intrinsic Functions ..
038        INTRINSIC MOD
039  *     ..
040  *     .. Executable Statements ..
041  
042  *     Quick return if possible
043  
044        IF( N.LE.0 .OR. K.LE.0 )
045       $    RETURN
046  
047            ICTXT = DESCV( CTXT_ )
048            CALL BLACS_GRIDINFO( ICTXT , NPROW , NPCOL , MYROW , MYCOL )
049  
050            FORWARD = LSAME( DIRECT , 'F' )
051            CALL INFOG2L( IV , JV , DESCV , NPROW , NPCOL , MYROW , MYCOL ,
052       $    IIV , JJV , IVROW , IVCOL )
053  
054            IF( LSAME( STOREV , 'C' ) .AND. MYCOL.EQ.IVCOL ) THEN
055  
056                IW = 1
057                LDV = DESCV( LLD_ )
058                IROFF = MOD( IV - 1 , DESCV( MB_ ) )
059  
060                IF( FORWARD ) THEN
061  
062  *                 DIRECT = 'Forward' , STOREV = 'Columnwise'
063  
064                    NP = NUMROC( N + IROFF , DESCV( MB_ ) , MYROW , IVROW , NPROW )
065                    IF( MYROW.EQ.IVROW ) THEN
066                        NP = NP - IROFF
067                        II = IIV + 1
068                    ELSE
069                        II = IIV
070                    END IF
071                    IF( IROFF + 1.EQ.DESCV( MB_ ) ) THEN
072                        MIROW = MOD( IVROW + 1 , NPROW )
073                    ELSE
074                        MIROW = IVROW
075                    END IF
076                    ITMP0 = 0
077  
078                    DO 10 JJ = JJV + 1 , JJV + K - 1
079  
080                        IF( MYROW.EQ.MIROW ) THEN
081                            VII = V( II + (JJ - 1)*LDV )
082                            V( II + (JJ - 1)*LDV ) = ONE
083                        END IF
084  
085  *                     T(1 : i - 1 , i) = - tau( jv + i - 1 ) *
086  *                     V(iv + i - 1 : iv + n - 1 , jv : jv + i - 2)' * V(iv + i - 1 : iv + n - 1 , jv + i - 1)
087  
088                        ITMP0 = ITMP0 + 1
089                        IF( NP - II + IIV.GT.0 ) THEN
090                            CALL ZGEMV( 'Conjugate transpose' , NP - II + IIV , ITMP0 ,
091       $                    - TAU( JJ ) , V( II + (JJV - 1)*LDV ) , LDV ,
092       $                    V( II + (JJ - 1)*LDV ) , 1 , ZERO ,
093       $                    WORK( IW ) , 1 )
094                        ELSE
095                            CALL ZLASET( 'All' , ITMP0 , 1 , ZERO , ZERO , WORK( IW ) ,
096       $                    ITMP0 )
097                        END IF
098  
099                        IW = IW + ITMP0
100                        IF( MYROW.EQ.MIROW ) THEN
101                            V( II + (JJ - 1)*LDV ) = VII
102                            II = II + 1
103                        END IF
104  
105                        IF( MOD( IV + ITMP0 , DESCV( MB_ ) ).EQ.0 )
106       $                    MIROW = MOD( MIROW + 1 , NPROW )
107  
108     10             CONTINUE
109  
110                    CALL ZGSUM2D( ICTXT , 'Columnwise' , ' ' , IW - 1 , 1 , WORK , IW - 1 ,
111       $            IVROW , MYCOL )
112  
113                    IF( MYROW.EQ.IVROW ) THEN
114  
115                        IW = 1
116                        ITMP0 = 0
117                        ITMP1 = 1
118  
119                        T( ITMP1 ) = TAU( JJV )
120  
121                        DO 20 JJ = JJV + 1 , JJV + K - 1
122  
123  *                         T(1 : j - 1 , j) = T(1 : j - 1 , 1 : j - 1) * T(1 : j - 1 , j)
124  
125                            ITMP0 = ITMP0 + 1
126                            ITMP1 = ITMP1 + DESCV( NB_ )
127                            CALL ZCOPY( ITMP0 , WORK( IW ) , 1 , T( ITMP1 ) , 1 )
128                            IW = IW + ITMP0
129  
130                            CALL ZTRMV( 'Upper' , 'No transpose' , 'Non - unit' ,
131       $                    ITMP0 , T , DESCV( NB_ ) , T( ITMP1 ) , 1 )
132                            T(ITMP1 + ITMP0) = TAU( JJ )
133  
134     20                 CONTINUE
135  
136                    END IF
137  
138                ELSE
139  
140  *                 DIRECT = 'Backward' , STOREV = 'Columnwise'
141  
142                    NP = NUMROC( N + IROFF - 1 , DESCV( MB_ ) , MYROW , IVROW , NPROW )
143                    IF( MYROW.EQ.IVROW )
144       $                NP = NP - IROFF
145                        MIROW = INDXG2P( IV + N - 2 , DESCV( MB_ ) , MYROW ,
146       $                DESCV( RSRC_ ) , NPROW )
147                        II = IIV + NP - 1
148                        ITMP0 = 0
149  
150                        DO 30 JJ = JJV + K - 2 , JJV , - 1
151  
152                            IF( MYROW.EQ.MIROW ) THEN
153                                VII = V( II + (JJ - 1)*LDV )
154                                V( II + (JJ - 1)*LDV ) = ONE
155                            END IF
156  
157  *                         T(1 : i - 1 , i) = - tau( jv + i - 1 ) *
158  *                         V(iv : iv + n - k + i - 1 , jv + i : jv + k - 1)' * V(iv : iv + n - k + i - 1 , jv + i - 1)
159  
160                            ITMP0 = ITMP0 + 1
161                            IF( II - IIV + 1.GT.0 ) THEN
162                                CALL ZGEMV( 'Conjugate transpose' , II - IIV + 1 , ITMP0 ,
163       $                        - TAU( JJ ) , V( IIV + JJ*LDV ) , LDV ,
164       $                        V( IIV + (JJ - 1)*LDV ) , 1 , ZERO ,
165       $                        WORK( IW ) , 1 )
166                            ELSE
167                                CALL ZLASET( 'All' , ITMP0 , 1 , ZERO , ZERO , WORK( IW ) ,
168       $                        ITMP0 )
169                            END IF
170  
171                            IW = IW + ITMP0
172                            IF( MYROW.EQ.MIROW ) THEN
173                                V( II + (JJ - 1)*LDV ) = VII
174                                II = II - 1
175                            END IF
176  
177                            IF( MOD( IV + N - ITMP0 - 2 , DESCV(MB_) ).EQ.0 )
178       $                        MIROW = MOD( MIROW + NPROW - 1 , NPROW )
179  
180     30                 CONTINUE
181  
182                        CALL ZGSUM2D( ICTXT , 'Columnwise' , ' ' , IW - 1 , 1 , WORK , IW - 1 ,
183       $                IVROW , MYCOL )
184  
185                        IF( MYROW.EQ.IVROW ) THEN
186  
187                            IW = 1
188                            ITMP0 = 0
189                            ITMP1 = K + 1 + (K - 1) * DESCV( NB_ )
190  
191                            T( ITMP1 - 1 ) = TAU( JJV + K - 1 )
192  
193                            DO 40 JJ = JJV + K - 2 , JJV , - 1
194  
195  *                             T(j + 1 : k , j) = T(j + 1 : k , j + 1 : k) * T(j + 1 : k , j)
196  
197                                ITMP0 = ITMP0 + 1
198                                ITMP1 = ITMP1 - DESCV( NB_ ) - 1
199                                CALL ZCOPY( ITMP0 , WORK( IW ) , 1 , T( ITMP1 ) , 1 )
200                                IW = IW + ITMP0
201  
202                                CALL ZTRMV( 'Lower' , 'No transpose' , 'Non - unit' ,
203       $                        ITMP0 , T( ITMP1 + DESCV( NB_ ) ) ,
204       $                        DESCV( NB_ ) , T( ITMP1 ) , 1 )
205                                T( ITMP1 - 1 ) = TAU( JJ )
206  
207     40                     CONTINUE
208  
209                        END IF
210  
211                    END IF
212  
213                ELSE IF( LSAME( STOREV , 'R' ) .AND. MYROW.EQ.IVROW ) THEN
214  
215                    IW = 1
216                    LDV = DESCV( LLD_ )
217                    ICOFF = MOD( JV - 1 , DESCV( NB_ ) )
218  
219                    IF( FORWARD ) THEN
220  
221  *                     DIRECT = 'Forward' , STOREV = 'Rowwise'
222  
223                        NQ = NUMROC( N + ICOFF , DESCV( NB_ ) , MYCOL , IVCOL , NPCOL )
224                        IF( MYCOL.EQ.IVCOL ) THEN
225                            NQ = NQ - ICOFF
226                            JJ = JJV + 1
227                        ELSE
228                            JJ = JJV
229                        END IF
230                        IF( ICOFF + 1.EQ.DESCV( NB_ ) ) THEN
231                            MICOL = MOD( IVCOL + 1 , NPCOL )
232                        ELSE
233                            MICOL = IVCOL
234                        END IF
235                        ITMP0 = 0
236  
237                        DO 50 II = IIV + 1 , IIV + K - 1
238  
239                            IF( MYCOL.EQ.MICOL ) THEN
240                                VII = V( II + (JJ - 1)*LDV )
241                                V( II + (JJ - 1)*LDV ) = ONE
242                            END IF
243  
244  *                         T(1 : i - 1 , i) = - tau( iv + i - 1 ) *
245  *                         V(iv + i - 1 , jv + i - 1 : jv + n - 1) * V(iv : iv + i - 2 , jv + i - 1 : jv + n - 1)'
246  
247                            ITMP0 = ITMP0 + 1
248                            IF( NQ - JJ + JJV.GT.0 ) THEN
249                                CALL ZLACGV( NQ - JJ + JJV , V( II + (JJ - 1)*LDV ) , LDV )
250                                CALL ZGEMV( 'No transpose' , ITMP0 , NQ - JJ + JJV ,
251       $                        - TAU(II) , V( IIV + (JJ - 1)*LDV ) , LDV ,
252       $                        V( II + (JJ - 1)*LDV ) , LDV , ZERO ,
253       $                        WORK( IW ) , 1 )
254                                CALL ZLACGV( NQ - JJ + JJV , V( II + (JJ - 1)*LDV ) , LDV )
255                            ELSE
256                                CALL ZLASET( 'All' , ITMP0 , 1 , ZERO , ZERO ,
257       $                        WORK( IW ) , ITMP0 )
258                            END IF
259  
260                            IW = IW + ITMP0
261                            IF( MYCOL.EQ.MICOL ) THEN
262                                V( II + (JJ - 1)*LDV ) = VII
263                                JJ = JJ + 1
264                            END IF
265  
266                            IF( MOD( JV + ITMP0 , DESCV( NB_ ) ).EQ.0 )
267       $                        MICOL = MOD( MICOL + 1 , NPCOL )
268  
269     50                 CONTINUE
270  
271                        CALL ZGSUM2D( ICTXT , 'Rowwise' , ' ' , IW - 1 , 1 , WORK , IW - 1 ,
272       $                MYROW , IVCOL )
273  
274                        IF( MYCOL.EQ.IVCOL ) THEN
275  
276                            IW = 1
277                            ITMP0 = 0
278                            ITMP1 = 1
279  
280                            T( ITMP1 ) = TAU( IIV )
281  
282                            DO 60 II = IIV + 1 , IIV + K - 1
283  
284  *                             T(1 : i - 1 , i) = T(1 : i - 1 , 1 : i - 1) * T(1 : i - 1 , i)
285  
286                                ITMP0 = ITMP0 + 1
287                                ITMP1 = ITMP1 + DESCV( MB_ )
288                                CALL ZCOPY( ITMP0 , WORK( IW ) , 1 , T( ITMP1 ) , 1 )
289                                IW = IW + ITMP0
290  
291                                CALL ZTRMV( 'Upper' , 'No transpose' , 'Non - unit' ,
292       $                        ITMP0 , T , DESCV( MB_ ) , T( ITMP1 ) , 1 )
293                                T( ITMP1 + ITMP0 ) = TAU( II )
294  
295     60                     CONTINUE
296  
297                        END IF
298  
299                    ELSE
300  
301  *                     DIRECT = 'Backward' , STOREV = 'Rowwise'
302  
303                        NQ = NUMROC( N + ICOFF - 1 , DESCV( NB_ ) , MYCOL , IVCOL , NPCOL )
304                        IF( MYCOL.EQ.IVCOL )
305       $                    NQ = NQ - ICOFF
306                            MICOL = INDXG2P( JV + N - 2 , DESCV( NB_ ) , MYCOL ,
307       $                    DESCV( CSRC_ ) , NPCOL )
308                            JJ = JJV + NQ - 1
309                            ITMP0 = 0
310  
311                            DO 70 II = IIV + K - 2 , IIV , - 1
312  
313                                IF( MYCOL.EQ.MICOL ) THEN
314                                    VII = V( II + (JJ - 1)*LDV )
315                                    V( II + (JJ - 1)*LDV ) = ONE
316                                END IF
317  
318  *                             T(i + 1 : k , i) = - tau( iv + i - 1 ) *
319  *                             V(iv + i : iv + k - 1 , jv : jv + n - k + i - 1)' * V(iv + i - 1 , jv : jv + n - k + i - 1)'
320  
321                                ITMP0 = ITMP0 + 1
322                                IF( JJ - JJV + 1.GT.0 ) THEN
323                                    CALL ZLACGV( JJ - JJV + 1 , V( II + (JJV - 1)*LDV ) , LDV )
324                                    CALL ZGEMV( 'No transpose' , ITMP0 , JJ - JJV + 1 ,
325       $                            - TAU( II ) , V( II + 1 + (JJV - 1)*LDV ) , LDV ,
326       $                            V( II + (JJV - 1)*LDV ) , LDV , ZERO ,
327       $                            WORK( IW ) , 1 )
328                                    CALL ZLACGV( JJ - JJV + 1 , V( II + (JJV - 1)*LDV ) , LDV )
329                                ELSE
330                                    CALL ZLASET( 'All' , ITMP0 , 1 , ZERO , ZERO ,
331       $                            WORK( IW ) , ITMP0 )
332                                END IF
333  
334                                IW = IW + ITMP0
335                                IF( MYCOL.EQ.MICOL ) THEN
336                                    V( II + (JJ - 1)*LDV ) = VII
337                                    JJ = JJ - 1
338                                END IF
339  
340                                IF( MOD( JV + N - ITMP0 - 2 , DESCV( NB_ ) ).EQ.0 )
341       $                            MICOL = MOD( MICOL + NPCOL - 1 , NPCOL )
342  
343     70                     CONTINUE
344  
345                            CALL ZGSUM2D( ICTXT , 'Rowwise' , ' ' , IW - 1 , 1 , WORK , IW - 1 ,
346       $                    MYROW , IVCOL )
347  
348                            IF( MYCOL.EQ.IVCOL ) THEN
349  
350                                IW = 1
351                                ITMP0 = 0
352                                ITMP1 = K + 1 + (K - 1) * DESCV( MB_ )
353  
354                                T( ITMP1 - 1 ) = TAU( IIV + K - 1 )
355  
356                                DO 80 II = IIV + K - 2 , IIV , - 1
357  
358  *                                 T(i + 1 : k , i) = T(i + 1 : k , i + 1 : k) * T(i + 1 : k , i)
359  
360                                    ITMP0 = ITMP0 + 1
361                                    ITMP1 = ITMP1 - DESCV( MB_ ) - 1
362                                    CALL ZCOPY( ITMP0 , WORK( IW ) , 1 , T( ITMP1 ) , 1 )
363                                    IW = IW + ITMP0
364  
365                                    CALL ZTRMV( 'Lower' , 'No transpose' , 'Non - unit' ,
366       $                            ITMP0 , T( ITMP1 + DESCV( MB_ ) ) ,
367       $                            DESCV( MB_ ) , T( ITMP1 ) , 1 )
368                                    T( ITMP1 - 1 ) = TAU( II )
369  
370     80                         CONTINUE
371  
372                            END IF
373  
374                        END IF
375  
376                    END IF
377  
378                    RETURN
379  
380  *                 End of PZLARFT
381  
382                END