Skip to content

Commit 9a1f28c

Browse files
christoph-conradschristoph-conrads
committed
xGGQRCS: remove debugging code
1 parent 230243e commit 9a1f28c

File tree

4 files changed

+16
-93
lines changed

4 files changed

+16
-93
lines changed

‎SRC/cggqrcs.f

+4-24
Original file line numberDiff line numberDiff line change
@@ -372,9 +372,8 @@ RECURSIVE SUBROUTINE CGGQRCS( JOBU1, JOBU2, JOBX, M, N, P, L,
372372
LOGICAL WANTU1, WANTU2, WANTX, LQUERY
373373
INTEGER I, J, K, K1, LMAX, IG, IG11, IG21, IG22,
374374
$ IVT, IVT12, LDG, LDX, LDVT, LWKMIN, LWKOPT
375-
REAL BASE, NAN, NORMA, NORMB, NORMG, TOL, ULP, UNFL,
375+
REAL BASE, NORMA, NORMB, NORMG, TOL, ULP, UNFL,
376376
$ THETA, IOTA, W
377-
COMPLEX CNAN
378377
* ..
379378
* .. External Functions ..
380379
LOGICAL LSAME
@@ -451,10 +450,6 @@ RECURSIVE SUBROUTINE CGGQRCS( JOBU1, JOBU2, JOBX, M, N, P, L,
451450
*
452451
* Initialize variables
453452
*
454-
* Computing 0.0 / 0.0 directly causes compiler errors
455-
NAN = 1.0E0
456-
NAN = 0.0 / (NAN - 1.0E0)
457-
CNAN = CMPLX( NAN, NAN )
458453
*
459454
SWAPPED = .FALSE.
460455
L = 0
@@ -467,9 +462,9 @@ RECURSIVE SUBROUTINE CGGQRCS( JOBU1, JOBU2, JOBX, M, N, P, L,
467462
IG22 = LDG * M + M + 1
468463
IVT = LDG * N + 2
469464
IVT12 = IVT + LDVT * M
470-
THETA = NAN
471-
IOTA = NAN
472-
W = NAN
465+
THETA = -1
466+
IOTA = -1
467+
W = -1
473468
*
474469
* Compute workspace
475470
*
@@ -555,11 +550,6 @@ RECURSIVE SUBROUTINE CGGQRCS( JOBU1, JOBU2, JOBX, M, N, P, L,
555550
CALL CLACPY( 'A', M, N, A, LDA, WORK( IG11 ), LDG )
556551
CALL CLACPY( 'A', P, N, B, LDB, WORK( IG21 ), LDG )
557552
*
558-
* DEBUG
559-
*
560-
CALL CLASET( 'A', M, N, CNAN, CNAN, A, LDA )
561-
CALL CLASET( 'A', P, N, CNAN, CNAN, B, LDB )
562-
*
563553
* Compute the Frobenius norm of matrix G
564554
*
565555
NORMG = NORMB * SQRT( 1.0E0 + ( ( W * NORMA ) / NORMB )**2 )
@@ -633,11 +623,6 @@ RECURSIVE SUBROUTINE CGGQRCS( JOBU1, JOBU2, JOBX, M, N, P, L,
633623
RETURN
634624
END IF
635625
*
636-
* DEBUG
637-
*
638-
ALPHA( 1:N ) = CNAN
639-
BETA( 1:N ) = CNAN
640-
*
641626
* Compute the CS decomposition of Q1( :, 1:L )
642627
*
643628
K = MIN( M, P, L, M + P - L )
@@ -653,11 +638,6 @@ RECURSIVE SUBROUTINE CGGQRCS( JOBU1, JOBU2, JOBX, M, N, P, L,
653638
RETURN
654639
END IF
655640
*
656-
* DEBUG
657-
*
658-
WORK( 1:LDG*N ) = CNAN
659-
RWORK( 1:2*N ) = NAN
660-
*
661641
* Compute X = V^T R1( 1:L, : ) and adjust for matrix scaling
662642
*
663643
IF( WANTX ) THEN

‎SRC/dggqrcs.f

+4-22
Original file line numberDiff line numberDiff line change
@@ -349,7 +349,7 @@ RECURSIVE SUBROUTINE DGGQRCS( JOBU1, JOBU2, JOBX, M, N, P, L,
349349
LOGICAL WANTU1, WANTU2, WANTX, LQUERY
350350
INTEGER I, J, K, K1, LMAX, IG, IG11, IG21, IG22,
351351
$ IVT, IVT12, LDG, LDX, LDVT, LWKMIN, LWKOPT
352-
DOUBLE PRECISION BASE, NAN, NORMA, NORMB, NORMG, TOL, ULP, UNFL,
352+
DOUBLE PRECISION BASE, NORMA, NORMB, NORMG, TOL, ULP, UNFL,
353353
$ THETA, IOTA, W
354354
* ..
355355
* .. External Functions ..
@@ -426,10 +426,6 @@ RECURSIVE SUBROUTINE DGGQRCS( JOBU1, JOBU2, JOBX, M, N, P, L,
426426
END IF
427427
*
428428
* Initialize variables
429-
*
430-
* Computing 0.0 / 0.0 directly causes compiler errors
431-
NAN = 1.0D0
432-
NAN = 0.0 / (NAN - 1.0D0)
433429
*
434430
SWAPPED = .FALSE.
435431
L = 0
@@ -442,9 +438,9 @@ RECURSIVE SUBROUTINE DGGQRCS( JOBU1, JOBU2, JOBX, M, N, P, L,
442438
IG22 = LDG * M + M + 1
443439
IVT = LDG * N + 2
444440
IVT12 = IVT + LDVT * M
445-
THETA = NAN
446-
IOTA = NAN
447-
W = NAN
441+
THETA = -1
442+
IOTA = -1
443+
W = -1
448444
*
449445
* Compute workspace
450446
*
@@ -516,11 +512,6 @@ RECURSIVE SUBROUTINE DGGQRCS( JOBU1, JOBU2, JOBX, M, N, P, L,
516512
CALL DLACPY( 'A', M, N, A, LDA, WORK( IG11 ), LDG )
517513
CALL DLACPY( 'A', P, N, B, LDB, WORK( IG21 ), LDG )
518514
*
519-
* DEBUG
520-
*
521-
CALL DLASET( 'A', M, N, NAN, NAN, A, LDA )
522-
CALL DLASET( 'A', P, N, NAN, NAN, B, LDB )
523-
*
524515
* Compute the Frobenius norm of matrix G
525516
*
526517
NORMG = NORMB * SQRT( 1.0D0 + ( ( W * NORMA ) / NORMB )**2 )
@@ -592,11 +583,6 @@ RECURSIVE SUBROUTINE DGGQRCS( JOBU1, JOBU2, JOBX, M, N, P, L,
592583
RETURN
593584
END IF
594585
*
595-
* DEBUG
596-
*
597-
ALPHA( 1:N ) = NAN
598-
BETA( 1:N ) = NAN
599-
*
600586
* Compute the CS decomposition of Q1( :, 1:L )
601587
*
602588
K = MIN( M, P, L, M + P - L )
@@ -611,10 +597,6 @@ RECURSIVE SUBROUTINE DGGQRCS( JOBU1, JOBU2, JOBX, M, N, P, L,
611597
RETURN
612598
END IF
613599
*
614-
* DEBUG
615-
*
616-
WORK( 1:LDG*N ) = NAN
617-
*
618600
* Compute X = V^T R1( 1:L, : ) and adjust for matrix scaling
619601
*
620602
IF( WANTX ) THEN

‎SRC/sggqrcs.f

+4-22
Original file line numberDiff line numberDiff line change
@@ -349,7 +349,7 @@ RECURSIVE SUBROUTINE SGGQRCS( JOBU1, JOBU2, JOBX, M, N, P, L,
349349
LOGICAL WANTU1, WANTU2, WANTX, LQUERY
350350
INTEGER I, J, K, K1, LMAX, IG, IG11, IG21, IG22,
351351
$ IVT, IVT12, LDG, LDX, LDVT, LWKMIN, LWKOPT
352-
REAL BASE, NAN, NORMA, NORMB, NORMG, TOL, ULP, UNFL,
352+
REAL BASE, NORMA, NORMB, NORMG, TOL, ULP, UNFL,
353353
$ THETA, IOTA, W
354354
* ..
355355
* .. External Functions ..
@@ -426,10 +426,6 @@ RECURSIVE SUBROUTINE SGGQRCS( JOBU1, JOBU2, JOBX, M, N, P, L,
426426
END IF
427427
*
428428
* Initialize variables
429-
*
430-
* Computing 0.0 / 0.0 directly causes compiler errors
431-
NAN = 1.0E0
432-
NAN = 0.0 / (NAN - 1.0E0)
433429
*
434430
SWAPPED = .FALSE.
435431
L = 0
@@ -442,9 +438,9 @@ RECURSIVE SUBROUTINE SGGQRCS( JOBU1, JOBU2, JOBX, M, N, P, L,
442438
IG22 = LDG * M + M + 1
443439
IVT = LDG * N + 2
444440
IVT12 = IVT + LDVT * M
445-
THETA = NAN
446-
IOTA = NAN
447-
W = NAN
441+
THETA = -1
442+
IOTA = -1
443+
W = -1
448444
*
449445
* Compute workspace
450446
*
@@ -516,11 +512,6 @@ RECURSIVE SUBROUTINE SGGQRCS( JOBU1, JOBU2, JOBX, M, N, P, L,
516512
CALL SLACPY( 'A', M, N, A, LDA, WORK( IG11 ), LDG )
517513
CALL SLACPY( 'A', P, N, B, LDB, WORK( IG21 ), LDG )
518514
*
519-
* DEBUG
520-
*
521-
CALL SLASET( 'A', M, N, NAN, NAN, A, LDA )
522-
CALL SLASET( 'A', P, N, NAN, NAN, B, LDB )
523-
*
524515
* Compute the Frobenius norm of matrix G
525516
*
526517
NORMG = NORMB * SQRT( 1.0E0 + ( ( W * NORMA ) / NORMB )**2 )
@@ -592,11 +583,6 @@ RECURSIVE SUBROUTINE SGGQRCS( JOBU1, JOBU2, JOBX, M, N, P, L,
592583
RETURN
593584
END IF
594585
*
595-
* DEBUG
596-
*
597-
ALPHA( 1:N ) = NAN
598-
BETA( 1:N ) = NAN
599-
*
600586
* Compute the CS decomposition of Q1( :, 1:L )
601587
*
602588
K = MIN( M, P, L, M + P - L )
@@ -611,10 +597,6 @@ RECURSIVE SUBROUTINE SGGQRCS( JOBU1, JOBU2, JOBX, M, N, P, L,
611597
RETURN
612598
END IF
613599
*
614-
* DEBUG
615-
*
616-
WORK( 1:LDG*N ) = NAN
617-
*
618600
* Compute X = V^T R1( 1:L, : ) and adjust for matrix scaling
619601
*
620602
IF( WANTX ) THEN

‎SRC/zggqrcs.f

+4-25
Original file line numberDiff line numberDiff line change
@@ -372,9 +372,8 @@ RECURSIVE SUBROUTINE ZGGQRCS( JOBU1, JOBU2, JOBX, M, N, P, L,
372372
LOGICAL WANTU1, WANTU2, WANTX, LQUERY
373373
INTEGER I, J, K, K1, LMAX, IG, IG11, IG21, IG22,
374374
$ IVT, IVT12, LDG, LDX, LDVT, LWKMIN, LWKOPT
375-
DOUBLE PRECISION BASE, NAN, NORMA, NORMB, NORMG, TOL, ULP, UNFL,
375+
DOUBLE PRECISION BASE, NORMA, NORMB, NORMG, TOL, ULP, UNFL,
376376
$ THETA, IOTA, W
377-
COMPLEX*16 ZNAN
378377
* ..
379378
* .. External Functions ..
380379
LOGICAL LSAME
@@ -450,11 +449,6 @@ RECURSIVE SUBROUTINE ZGGQRCS( JOBU1, JOBU2, JOBX, M, N, P, L,
450449
END IF
451450
*
452451
* Initialize variables
453-
*
454-
* Computing 0.0 / 0.0 directly causes compiler errors
455-
NAN = 1.0D0
456-
NAN = 0.0 / (NAN - 1.0D0)
457-
ZNAN = DCMPLX( NAN, NAN )
458452
*
459453
SWAPPED = .FALSE.
460454
L = 0
@@ -467,9 +461,9 @@ RECURSIVE SUBROUTINE ZGGQRCS( JOBU1, JOBU2, JOBX, M, N, P, L,
467461
IG22 = LDG * M + M + 1
468462
IVT = LDG * N + 2
469463
IVT12 = IVT + LDVT * M
470-
THETA = NAN
471-
IOTA = NAN
472-
W = NAN
464+
THETA = -1
465+
IOTA = -1
466+
W = -1
473467
*
474468
* Compute workspace
475469
*
@@ -555,11 +549,6 @@ RECURSIVE SUBROUTINE ZGGQRCS( JOBU1, JOBU2, JOBX, M, N, P, L,
555549
CALL ZLACPY( 'A', M, N, A, LDA, WORK( IG11 ), LDG )
556550
CALL ZLACPY( 'A', P, N, B, LDB, WORK( IG21 ), LDG )
557551
*
558-
* DEBUG
559-
*
560-
CALL ZLASET( 'A', M, N, ZNAN, ZNAN, A, LDA )
561-
CALL ZLASET( 'A', P, N, ZNAN, ZNAN, B, LDB )
562-
*
563552
* Compute the Frobenius norm of matrix G
564553
*
565554
NORMG = NORMB * SQRT( 1.0D0 + ( ( W * NORMA ) / NORMB )**2 )
@@ -633,11 +622,6 @@ RECURSIVE SUBROUTINE ZGGQRCS( JOBU1, JOBU2, JOBX, M, N, P, L,
633622
RETURN
634623
END IF
635624
*
636-
* DEBUG
637-
*
638-
ALPHA( 1:N ) = ZNAN
639-
BETA( 1:N ) = ZNAN
640-
*
641625
* Compute the CS decomposition of Q1( :, 1:L )
642626
*
643627
K = MIN( M, P, L, M + P - L )
@@ -653,11 +637,6 @@ RECURSIVE SUBROUTINE ZGGQRCS( JOBU1, JOBU2, JOBX, M, N, P, L,
653637
RETURN
654638
END IF
655639
*
656-
* DEBUG
657-
*
658-
WORK( 1:LDG*N ) = ZNAN
659-
RWORK( 1:2*N ) = NAN
660-
*
661640
* Compute X = V^T R1( 1:L, : ) and adjust for matrix scaling
662641
*
663642
IF( WANTX ) THEN

0 commit comments

Comments
 (0)