SUBROUTINE CSCLQ( M, N, A, LDA, L, LDL, WORK, WORK2, INFO )
      
      IMPLICIT NONE
      
      INTEGER            M, N, LDA, LDL
      COMPLEX            A( LDA, * ), L( LDL, M ), WORK( M, * )
      REAL               WORK2( * ) 
      COMPLEX            CONE, CZERO
      PARAMETER          ( CONE=(1.0E+0,0.0E+0), CZERO=(0.0E+0,0.0E+0) )
      LOGICAL            FLAG2
      INTEGER            COUNT, INFO, I, J
      
      COUNT = 0

 10   COUNT = COUNT + 1

      CALL CRLQCQR( 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) = CZERO
            ENDDO
            CALL CCOPY(M-(I-1),WORK(I,M+I),1,L(I,I),1)
         ENDDO
!$OMP END PARALLEL DO
         
      ELSE

         CALL CTRMM('R','L','N','N',M,M,CONE,WORK(1,M+1),M,L,LDL)

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

      RETURN

      END SUBROUTINE CSCLQ
*
      SUBROUTINE CRLQCQR( M, N, Q, LDQ, WORK, WORK2, WORK3,
     $                    WORK4, FLAG2, INFO )
*     
      IMPLICIT NONE
*
*     .. Scalar Arguments ..
      INTEGER            M, N, LDQ, INFO
      LOGICAL            FLAG2
*     ..
*     .. Array Arguments ..
      COMPLEX            Q( LDQ, * ), WORK( M, M ), WORK2( M, M ),
     $                   WORK3( * )
      REAL               WORK4( * )
*
*  =====================================================================
*
*     .. parameters ..
      REAL               STWO, SONE, SZERO
      PARAMETER          ( STWO=2.0E+0, SONE=1.0E+0, SZERO=0.0E+0 )
      COMPLEX            CONE, CZERO
      PARAMETER          ( CONE=(1.0E+0,0.0E+0), CZERO=(0.0E+0,0.0E+0) )
*     ..
*     .. local scalars ..
      INTEGER            IINFO, K, I, I0
      REAL               SHIFT, EPS, SLAMCH, SCNRM2, TMP2
*     ..
*     .. external functions ..
      EXTERNAL           CHERK, CPOTRF, SLAMCH, SCNRM2
      INTRINSIC          REAL
*     ..
*     .. Executable Statements ..
*
      INFO = 0
      EPS = SLAMCH( 'Precision' )
      I0 = 0
*
!$OMP PARALLEL DO
      DO K = 1, M
         WORK4(K) = SCNRM2( N, Q( K, 1 ), LDQ )
         CALL CSSCAL( N, SONE/WORK4(K), Q( K, 1 ), LDQ )
      END DO
!$OMP END PARALLEL DO
*      
      CALL CHERK('L','N',M,N,SONE,Q,LDQ,SZERO,WORK,M)
*
      SHIFT = SZERO
*     
      DO K = 1, 2*M

         WORK2(1:M,1:M) = WORK(1:M,1:M)

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

         IINFO=0

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

         IF (IINFO .EQ. 0) THEN
            IF (SHIFT .EQ. SZERO) THEN
               CALL CTRCON('I','L','N',M,WORK2,M,TMP2,WORK3,
     $              WORK4(M+1),IINFO)
               IF (SQRT(SQRT(SQRT(EPS))) .GT. TMP2) THEN
                  FLAG2 = .FALSE.
               ELSE
                  FLAG2 = .TRUE.
               END IF
            ELSE
               FLAG2 = .FALSE.
            END IF
*     
            CALL CTRSM('L','L','N','N',M,N,CONE,WORK2,M,Q,LDQ)

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

         IF (I0 .EQ. IINFO) THEN
            SHIFT = STWO*SHIFT
         ELSE
            I0 = IINFO
            TMP2=SHIFT-REAL(WORK2(IINFO,IINFO))
            IF (TMP2 .NE. SHIFT) THEN
               SHIFT=TMP2
            ELSE
               IF (SHIFT .EQ. SZERO) THEN
                  TMP2 = SZERO
                  DO I = 1, N
                     TMP2 = MAX(TMP2 , REAL(WORK(I,I)))
                  ENDDO
                  SHIFT=TMP2*EPS
               ELSE
                  SHIFT=(SONE+EPS)*SHIFT
               ENDIF
            ENDIF
         ENDIF

         WRITE (*,*) 'O',I0,SHIFT
      ENDDO
*
      INFO = -1
      RETURN
*
      END SUBROUTINE CRLQCQR