SUBROUTINE ZSCLQ( M, N, A, LDA, L, LDL, WORK, WORK2, INFO )
      
      IMPLICIT NONE
      
      INTEGER            M, N, LDA, LDL
      COMPLEX*16         A( LDA, * ), L( LDL, M ), WORK( M, * )
      DOUBLE PRECISION   WORK2( * )   
      COMPLEX*16         ZONE, ZZERO
      PARAMETER          ( ZONE=(1.0D+0,0.0D+0), ZZERO=(0.0D+0,0.0D+0) )
      LOGICAL            FLAG2
      INTEGER            COUNT, INFO, I, J
      
      COUNT = 0

 10   COUNT = COUNT + 1

      CALL ZRLQCQR( COUNT, M, N, A, LDA, WORK(1,1), WORK(1,M+1),
     $     WORK(1,2*M+1), WORK2, FLAG2, INFO )

      IF (INFO .EQ. -1) THEN
         INFO = COUNT
         RETURN
      ENDIF

      IF (COUNT .EQ. 1) THEN

!$OMP PARALLEL DO PRIVATE(J)
         DO I = 1, M
            DO J = 1, I-1
	       L(J, I) = ZZERO
            ENDDO
            CALL ZCOPY(M-(I-1),WORK(I,M+I),1,L(I,I),1)
         ENDDO
!$OMP END PARALLEL DO
         
      ELSE

         CALL ZTRMM('R','L','N','N',M,M,ZONE,WORK(1,M+1),M,L,LDL)

      ENDIF
      
      IF (FLAG2 .EQV. .FALSE.) GO TO 10

      RETURN

      END SUBROUTINE ZSCLQ
*
      SUBROUTINE ZRLQCQR( COUNT, M, N, Q, LDQ, WORK, WORK2, WORK3,
     $                    WORK4, FLAG2, INFO )
*     
      IMPLICIT NONE
*
*     .. Scalar Arguments ..
      INTEGER            COUNT, M, N, LDQ, INFO
      LOGICAL            FLAG2
*     ..
*     .. Array Arguments ..
      COMPLEX*16         Q( LDQ, * ), WORK( M, M ), WORK2( M, M ),
     $                   WORK3( * )
      DOUBLE PRECISION   WORK4( * )
*
*  =====================================================================
*
*     .. parameters ..
      DOUBLE PRECISION   DTWO, DONE, DZERO
      PARAMETER          ( DTWO=2.0D+0, DONE=1.0D+0, DZERO=0.0D+0 )
      COMPLEX*16         ZONE, ZZERO
      PARAMETER          ( ZONE=(1.0D+0,0.0D+0), ZZERO=(0.0D+0,0.0D+0) )
*     ..
*     .. local scalars ..
      INTEGER            IINFO, K, I, J, I0
      DOUBLE PRECISION   SHIFT, EPS, DLAMCH, TMP, OF, DZNRM2
      COMPLEX*16         ZDOTC
*     ..
*     .. external functions ..
      EXTERNAL           ZHERK, ZPOTRF, DLAMCH, DZNRM2, ZDOTC
*     ..
*     .. Executable Statements ..
*
      INFO = 0
      EPS = DLAMCH( 'Precision' )
      OF = DLAMCH( 'O' )
      I0 = 0
*
      FLAG2 = .TRUE.
      IF (COUNT .GE. 2) GO TO 10
!$OMP PARALLEL DO PRIVATE(TMP)
      DO K = 1, M
         TMP = DBLE(ZDOTC(N, Q( K, 1 ), LDQ, Q( K, 1 ), LDQ))
         IF (TMP .GT. OF .OR. TMP .EQ. DZERO) THEN
            FLAG2 = .FALSE.
         ENDIF
      END DO
!$OMP END PARALLEL DO
*
 10   IF (FLAG2) THEN

         CALL ZHERK('L','N',M,N,DONE,Q,LDQ,DZERO,WORK,M)
*
         DO I = 1, M
            WORK4(I) = SQRT(DBLE(WORK(I,I)))
            WORK4(M+I) = DONE/WORK4(I)
         ENDDO

!$OMP PARALLEL DO PRIVATE(J)
         DO I = 1, M
            DO J = I, M
               WORK(J, I) = WORK(J, I)*WORK4(M+I)*WORK4(M+J)
            END DO
         END DO
!$OMP END PARALLEL DO      
*         
         SHIFT = DZERO
*     
         DO K = 1, 2*M

!$OMP PARALLEL DO
            DO I = 1, M
               CALL ZCOPY(M+1-I,WORK(I,I),1,WORK2(I,I),1)
            ENDDO
!$OMP END PARALLEL DO  

            IF (SHIFT .NE. DZERO) THEN
               DO I = 1, M
                  WORK2(I,I) = WORK2(I,I) + SHIFT
               ENDDO
            ENDIF

            IINFO=0

            CALL ZPOTRF('L',M,WORK2,M,IINFO)

            IF (IINFO .EQ. 0) THEN
               IF (SHIFT .EQ. DZERO) THEN
                  CALL ZTRCON('I','L','N',M,WORK2,M,TMP,WORK3,
     $                 WORK4(M+1),IINFO)
                  IF (SQRT(SQRT(SQRT(EPS))) .GT. TMP) THEN
                     FLAG2 = .FALSE.
                  ELSE
                     FLAG2 = .TRUE.
                  END IF
               ELSE
                  FLAG2 = .FALSE.
               END IF
*     
!$OMP PARALLEL DO PRIVATE(J)
               DO I = 1, M
                  DO J = I, M
                     WORK2( J, I ) = WORK2( J, I )*WORK4(J)
                  END DO
               END DO
!$OMP END PARALLEL DO
      
               CALL ZTRSM('L','L','N','N',M,N,ZONE,WORK2,M,Q,LDQ)

               RETURN
*
            ENDIF

            IF (I0 .EQ. IINFO) THEN
               SHIFT = DTWO*SHIFT
            ELSE
               I0 = IINFO
               TMP=SHIFT-DBLE(WORK2(IINFO,IINFO))
               IF (TMP .NE. SHIFT) THEN
                  SHIFT=TMP
               ELSE
                  IF (SHIFT .EQ. DZERO) THEN
                     SHIFT=EPS
                  ELSE
                     SHIFT=(DONE+EPS)*SHIFT
                  ENDIF
               ENDIF
            ENDIF
            
            WRITE (*,*) 'O',I0,SHIFT
         ENDDO
*     
         INFO = -1
         RETURN

      ELSE
         
!$OMP PARALLEL DO
         DO K = 1, M
            WORK4(K) = DZNRM2( N, Q( K, 1 ), LDQ )
            CALL ZDSCAL( N, DONE/WORK4(K), Q( K, 1 ), LDQ )
         END DO
!$OMP END PARALLEL DO
*      
         CALL ZHERK('L','N',M,N,DONE,Q,LDQ,DZERO,WORK,M)
*
         SHIFT = DZERO
*     
         DO K = 1, 2*M

!$OMP PARALLEL DO
            DO I = 1, M
               CALL ZCOPY(M+1-I,WORK(I,I),1,WORK2(I,I),1)
            ENDDO
!$OMP END PARALLEL DO  

            IF (SHIFT .NE. DZERO) THEN
               DO I = 1, M
                  WORK2(I,I) = WORK2(I,I) + SHIFT
               ENDDO
            ENDIF

            IINFO=0

            CALL ZPOTRF('L',M,WORK2,M,IINFO)

            IF (IINFO .EQ. 0) THEN
               IF (SHIFT .EQ. DZERO) THEN
                  CALL ZTRCON('I','L','N',M,WORK2,M,TMP,WORK3,
     $                 WORK4(M+1),IINFO)
                  IF (SQRT(SQRT(SQRT(EPS))) .GT. TMP) THEN
                     FLAG2 = .FALSE.
                  ELSE
                     FLAG2 = .TRUE.
                  END IF
               ELSE
                  FLAG2 = .FALSE.
               END IF
*     
               CALL ZTRSM('L','L','N','N',M,N,ZONE,WORK2,M,Q,LDQ)

!$OMP PARALLEL DO PRIVATE(J)
               DO I = 1, M
                  DO J = I, M
                     WORK2( J, I ) = WORK2( J, I )*WORK4(J)
                  END DO
               END DO
!$OMP END PARALLEL DO
      
               RETURN
*
            ENDIF

            IF (I0 .EQ. IINFO) THEN
               SHIFT = DTWO*SHIFT
            ELSE
               I0 = IINFO
               TMP=SHIFT-DBLE(WORK2(IINFO,IINFO))
               IF (TMP .NE. SHIFT) THEN
                  SHIFT=TMP
               ELSE
                  IF (SHIFT .EQ. DZERO) THEN
                     SHIFT=EPS
                  ELSE
                     SHIFT=(DONE+EPS)*SHIFT
                  ENDIF
               ENDIF
            ENDIF
            
            WRITE (*,*) 'O',I0,SHIFT
         ENDDO
*     
         INFO = -1
         RETURN

      ENDIF
*
      END SUBROUTINE ZRLQCQR