Skip to content

Commit 2eaf697

Browse files
sswathymSundari Swathy Meena H
sswathym
authored and
Sundari Swathy Meena H
committed
Test development for P_X_GERQ2 API
Validate the working of P_X_GERQ2 API for all precisions with early return, incorrect inputs and extreme value testing. Incorrect cases have been tested removing the BLACS_ABORT from the source codes and validating against the expected INFO. Signed-off-by: Sundari H <[email protected]> AMD-Internal: [CPUPL-6322] Change-Id: I1ac1edca612ee1100bcc1315254741af42544bd3
1 parent dba9996 commit 2eaf697

File tree

14 files changed

+160
-21
lines changed

14 files changed

+160
-21
lines changed

‎SRC/pcgerq2.f

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -252,7 +252,6 @@ SUBROUTINE PCGERQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK,
252252
*
253253
IF( INFO.NE.0 ) THEN
254254
CALL PXERBLA( ICTXT, 'PCGERQ2', -INFO )
255-
CALL BLACS_ABORT( ICTXT, 1 )
256255
*
257256
* Capture the subroutine exit in the trace file
258257
*

‎SRC/pdgerq2.f

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -253,7 +253,6 @@ SUBROUTINE PDGERQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK,
253253
*
254254
IF( INFO.NE.0 ) THEN
255255
CALL PXERBLA( ICTXT, 'PDGERQ2', -INFO )
256-
CALL BLACS_ABORT( ICTXT, 1 )
257256
*
258257
* Capture the subroutine exit in the trace file
259258
*

‎SRC/psgerq2.f

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -252,7 +252,6 @@ SUBROUTINE PSGERQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK,
252252
*
253253
IF( INFO.NE.0 ) THEN
254254
CALL PXERBLA( ICTXT, 'PSGERQ2', -INFO )
255-
CALL BLACS_ABORT( ICTXT, 1 )
256255
*
257256
* Capture the subroutine exit in the trace file
258257
*

‎SRC/pzgerq2.f

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -252,7 +252,6 @@ SUBROUTINE PZGERQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK,
252252
*
253253
IF( INFO.NE.0 ) THEN
254254
CALL PXERBLA( ICTXT, 'PZGERQ2', -INFO )
255-
CALL BLACS_ABORT( ICTXT, 1 )
256255
*
257256
* Capture the subroutine exit in the trace file
258257
*

‎TESTING/EXT_TESTS/QR.dat

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2,8 +2,8 @@
22
'MPI machine'
33
'QR.out' output file name (if any)
44
6 device out
5-
6 number of factorizations
6-
'QR' 'QL' 'LQ' 'RQ' 'QP' 'TZ' factorizations: QR, QL, LQ, RQ, QP, TZ
5+
7 number of factorizations
6+
'QR' 'QL' 'LQ' 'RQ' 'QP' 'TZ' 'R2' factorizations: QR, QL, LQ, RQ, QP, TZ, R2
77
4 number of problems sizes
88
42 15 -3 26 30 15 values of M. The M value should be more than the MB, NB values.
99
42 0 18 25 30 35 values of N. The N value should be more than the MB, NB values.

‎TESTING/LIN/pcqrdriver.f

Lines changed: 32 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@ PROGRAM PCQRDRIVER
44
* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
55
* and University of California, Berkeley.
66
* May 28, 2001
7-
* Modifications Copyright (c) 2024 Advanced Micro Devices, Inc. All rights reserved.
7+
* Modifications Copyright (c) 2024-25 Advanced Micro Devices, Inc. All rights reserved.
88
*
99
* Purpose
1010
* =======
@@ -127,7 +127,7 @@ PROGRAM PCQRDRIVER
127127
$ PCFILLPAD, PCGELQF, PCGELQRV,
128128
$ PCGEQLF, PCGEQLRV, PCGEQPF,
129129
$ PCQPPIV, PCGEQRF, PCGEQRRV,
130-
$ PCGERQF, PCGERQRV, PCTZRZRV,
130+
$ PCGERQF, PCGERQ2, PCGERQRV, PCTZRZRV,
131131
$ PCMATGEN, PCLAFCHK, PCQRINFO,
132132
$ PCTZRZF, SLBOOT, SLCOMBINE, SLTIMER
133133
* ..
@@ -229,6 +229,11 @@ PROGRAM PCQRDRIVER
229229
ROUTCHK = 'PCGERQRV'
230230
WRITE( NOUT, FMT = 9986 )
231231
$ 'RQ factorization tests.'
232+
ELSE IF( LSAMEN( 2, FACT, 'R2' ) ) THEN
233+
ROUT = 'PCGERQ2'
234+
ROUTCHK = 'PCGERQRV'
235+
WRITE( NOUT, FMT = 9986 )
236+
$ 'RQ2 factorization tests.'
232237
ELSE IF( LSAMEN( 2, FACT, 'QP' ) ) THEN
233238
ROUT = 'PCGEQPF'
234239
ROUTCHK = 'PCGEQRRV'
@@ -506,7 +511,8 @@ PROGRAM PCQRDRIVER
506511
*
507512
END IF
508513
*
509-
ELSE IF( LSAMEN( 2, FACT, 'RQ' ) ) THEN
514+
ELSE IF( LSAMEN( 2, FACT, 'RQ' ) .OR.
515+
$ LSAMEN( 2, FACT, 'R2' ) ) THEN
510516
*
511517
LTAU = MP
512518
IPW = IPTAU + LTAU + IPOSTPAD + IPREPAD
@@ -688,6 +694,13 @@ PROGRAM PCQRDRIVER
688694
CALL SLTIMER( 1 )
689695
CALL PCGERQF( M, N, MEM( IPA ), 1, 1, DESCA,
690696
$ MEM( IPTAU ), MEM( IPW ), LWORK,
697+
$ INFO )
698+
CALL SLTIMER( 1 )
699+
ELSE IF( LSAMEN( 2, FACT, 'R2' ) ) THEN
700+
API_NAME = 'PCGERQ2'
701+
CALL SLTIMER( 1 )
702+
CALL PCGERQ2( M, N, MEM( IPA ), 1, 1, DESCA,
703+
$ MEM( IPTAU ), MEM( IPW ), LWORK,
691704
$ INFO )
692705
CALL SLTIMER( 1 )
693706
ELSE IF( LSAMEN( 2, FACT, 'QP' ) ) THEN
@@ -789,6 +802,18 @@ PROGRAM PCQRDRIVER
789802
$ MEM( IPTAU ), MEM( IPW ) )
790803
CALL PCLAFCHK( 'No', 'No', M, N, MEM( IPA ),
791804
$ 1, 1, DESCA, IASEED, ANORM,
805+
$ FRESID, MEM( IPW ) )
806+
ELSE IF( LSAMEN( 2, FACT, 'R2' ) ) THEN
807+
*
808+
* Compute residual = ||A-R*Q|| / (||A||*N*eps)
809+
*
810+
* Since PCGERQ2 computes RQ factorization,
811+
* validation of PCGERQF can be used
812+
CALL PCGERQRV( M, N, MEM( IPA ), 1, 1,
813+
$ DESCA,
814+
$ MEM( IPTAU ), MEM( IPW ) )
815+
CALL PCLAFCHK( 'No', 'No', M, N, MEM( IPA ),
816+
$ 1, 1, DESCA, IASEED, ANORM,
792817
$ FRESID, MEM( IPW ) )
793818
ELSE IF( LSAMEN( 2, FACT, 'QP' ) ) THEN
794819
*
@@ -869,6 +894,8 @@ PROGRAM PCQRDRIVER
869894
$ (INFO.EQ.-1 .AND.
870895
$ LSAMEN( 2, FACT, 'RQ')) .OR.
871896
$ (INFO.EQ.-1 .AND.
897+
$ LSAMEN( 2, FACT, 'R2')) .OR.
898+
$ (INFO.EQ.-1 .AND.
872899
$ LSAMEN( 2, FACT, 'QP')) .OR.
873900
$ (INFO.EQ.-1 .AND.
874901
$ LSAMEN( 2, FACT, 'TZ' )))
@@ -882,6 +909,8 @@ PROGRAM PCQRDRIVER
882909
$ (INFO.EQ.-2 .AND.
883910
$ LSAMEN( 2, FACT, 'RQ')) .OR.
884911
$ (INFO.EQ.-2 .AND.
912+
$ LSAMEN( 2, FACT, 'R2')) .OR.
913+
$ (INFO.EQ.-2 .AND.
885914
$ LSAMEN( 2, FACT, 'QP')) .OR.
886915
$ (INFO.EQ.-2 .AND.
887916
$ LSAMEN( 2, FACT, 'TZ' )))

‎TESTING/LIN/pcqrinfo.f

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,7 @@ SUBROUTINE PCQRINFO( SUMMRY, NOUT, NFACT, FACTOR, LDFACT, NMAT,
88
* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
99
* and University of California, Berkeley.
1010
* May 1, 1997
11+
* Modifications Copyright (c) 2024-25 Advanced Micro Devices, Inc. All rights reserved.
1112
*
1213
* .. Scalar Arguments ..
1314
INTEGER IAM, LDFACT, LDMBVAL, LDMVAL, LDNBVAL, LDNVAL,
@@ -299,6 +300,9 @@ SUBROUTINE PCQRINFO( SUMMRY, NOUT, NFACT, FACTOR, LDFACT, NMAT,
299300
ELSE IF( LSAMEN( 2, FACTOR( K ), 'TZ' ) ) THEN
300301
WORK( I ) = 6
301302
I = I + 1
303+
ELSE IF( LSAMEN( 2, FACTOR( K ), 'R2' ) ) THEN
304+
WORK( I ) = 7
305+
I = I + 1
302306
END IF
303307
20 CONTINUE
304308
*
@@ -449,6 +453,8 @@ SUBROUTINE PCQRINFO( SUMMRY, NOUT, NFACT, FACTOR, LDFACT, NMAT,
449453
FACTOR( K ) = 'QP'
450454
ELSE IF( WORK( K ).EQ.6 ) THEN
451455
FACTOR( K ) = 'TZ'
456+
ELSE IF( WORK( K ).EQ.7 ) THEN
457+
FACTOR( K ) = 'R2'
452458
END IF
453459
30 CONTINUE
454460
*

‎TESTING/LIN/pdqrdriver.f

Lines changed: 33 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@ PROGRAM PDQRDRIVER
44
* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
55
* and University of California, Berkeley.
66
* May 28, 2001
7-
* Modifications Copyright (c) 2024 Advanced Micro Devices, Inc. All rights reserved.
7+
* Modifications Copyright (c) 2024-25 Advanced Micro Devices, Inc. All rights reserved.
88
*
99
* Purpose
1010
* =======
@@ -127,7 +127,7 @@ PROGRAM PDQRDRIVER
127127
$ PDFILLPAD, PDGELQF, PDGELQRV,
128128
$ PDGEQLF, PDGEQLRV, PDGEQPF,
129129
$ PDQPPIV, PDGEQRF, PDGEQRRV,
130-
$ PDGERQF, PDGERQRV, PDTZRZRV,
130+
$ PDGERQF, PDGERQ2, PDGERQRV, PDTZRZRV,
131131
$ PDMATGEN, PDLAFCHK, PDQRINFO,
132132
$ PDTZRZF, SLBOOT, SLCOMBINE, SLTIMER
133133
* ..
@@ -229,6 +229,11 @@ PROGRAM PDQRDRIVER
229229
ROUTCHK = 'PDGERQRV'
230230
WRITE( NOUT, FMT = 9986 )
231231
$ 'RQ factorization tests.'
232+
ELSE IF( LSAMEN( 2, FACT, 'R2' ) ) THEN
233+
ROUT = 'PDGERQ2'
234+
ROUTCHK = 'PDGERQRV'
235+
WRITE( NOUT, FMT = 9986 )
236+
$ 'RQ2 factorization tests.'
232237
ELSE IF( LSAMEN( 2, FACT, 'QP' ) ) THEN
233238
ROUT = 'PDGEQPF'
234239
ROUTCHK = 'PDGEQRRV'
@@ -506,7 +511,8 @@ PROGRAM PDQRDRIVER
506511
*
507512
END IF
508513
*
509-
ELSE IF( LSAMEN( 2, FACT, 'RQ' ) ) THEN
514+
ELSE IF( LSAMEN( 2, FACT, 'RQ' ) .OR.
515+
$ LSAMEN( 2, FACT, 'R2' ) ) THEN
510516
*
511517
LTAU = MP
512518
IPW = IPTAU + LTAU + IPOSTPAD + IPREPAD
@@ -678,6 +684,13 @@ PROGRAM PDQRDRIVER
678684
CALL SLTIMER( 1 )
679685
CALL PDGERQF( M, N, MEM( IPA ), 1, 1, DESCA,
680686
$ MEM( IPTAU ), MEM( IPW ), LWORK,
687+
$ INFO )
688+
CALL SLTIMER( 1 )
689+
ELSE IF( LSAMEN( 2, FACT, 'R2' ) ) THEN
690+
API_NAME = 'PDGERQ2'
691+
CALL SLTIMER( 1 )
692+
CALL PDGERQ2( M, N, MEM( IPA ), 1, 1, DESCA,
693+
$ MEM( IPTAU ), MEM( IPW ), LWORK,
681694
$ INFO )
682695
CALL SLTIMER( 1 )
683696
ELSE IF( LSAMEN( 2, FACT, 'QP' ) ) THEN
@@ -775,6 +788,19 @@ PROGRAM PDQRDRIVER
775788
CALL PDLAFCHK( 'No', 'No', M, N,
776789
$ MEM( IPA ), 1,
777790
$ 1, DESCA, IASEED, ANORM, FRESID,
791+
$ MEM( IPW ) )
792+
ELSE IF( LSAMEN( 2, FACT, 'R2' ) ) THEN
793+
*
794+
* Compute residual = ||A-R*Q|| / (||A||*N*eps)
795+
*
796+
* Since PDGERQ2 computes RQ factorization,
797+
* validation of PDGERQF can be used
798+
CALL PDGERQRV( M, N, MEM( IPA ), 1, 1,
799+
$ DESCA,
800+
$ MEM( IPTAU ), MEM( IPW ) )
801+
CALL PDLAFCHK( 'No', 'No', M, N,
802+
$ MEM( IPA ), 1,
803+
$ 1, DESCA, IASEED, ANORM, FRESID,
778804
$ MEM( IPW ) )
779805
ELSE IF( LSAMEN( 2, FACT, 'QP' ) ) THEN
780806
*
@@ -860,6 +886,8 @@ PROGRAM PDQRDRIVER
860886
$ (INFO.EQ.-1 .AND.
861887
$ LSAMEN( 2, FACT, 'RQ')) .OR.
862888
$ (INFO.EQ.-1 .AND.
889+
$ LSAMEN( 2, FACT, 'R2')) .OR.
890+
$ (INFO.EQ.-1 .AND.
863891
$ LSAMEN( 2, FACT, 'QP')) .OR.
864892
$ (INFO.EQ.-1 .AND.
865893
$ LSAMEN( 2, FACT, 'TZ' )))
@@ -873,6 +901,8 @@ PROGRAM PDQRDRIVER
873901
$ (INFO.EQ.-2 .AND.
874902
$ LSAMEN( 2, FACT, 'RQ')) .OR.
875903
$ (INFO.EQ.-2 .AND.
904+
$ LSAMEN( 2, FACT, 'R2')) .OR.
905+
$ (INFO.EQ.-2 .AND.
876906
$ LSAMEN( 2, FACT, 'QP')) .OR.
877907
$ (INFO.EQ.-2 .AND.
878908
$ LSAMEN( 2, FACT, 'TZ' )))

‎TESTING/LIN/pdqrinfo.f

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,7 @@ SUBROUTINE PDQRINFO( SUMMRY, NOUT, NFACT, FACTOR, LDFACT, NMAT,
88
* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
99
* and University of California, Berkeley.
1010
* May 1, 1997
11+
* Modifications Copyright (c) 2024-25 Advanced Micro Devices, Inc. All rights reserved.
1112
*
1213
* .. Scalar Arguments ..
1314
INTEGER IAM, LDFACT, LDMBVAL, LDMVAL, LDNBVAL, LDNVAL,
@@ -299,6 +300,9 @@ SUBROUTINE PDQRINFO( SUMMRY, NOUT, NFACT, FACTOR, LDFACT, NMAT,
299300
ELSE IF( LSAMEN( 2, FACTOR( K ), 'TZ' ) ) THEN
300301
WORK( I ) = 6
301302
I = I + 1
303+
ELSE IF( LSAMEN( 2, FACTOR( K ), 'R2' ) ) THEN
304+
WORK( I ) = 7
305+
I = I + 1
302306
END IF
303307
20 CONTINUE
304308
*
@@ -449,6 +453,8 @@ SUBROUTINE PDQRINFO( SUMMRY, NOUT, NFACT, FACTOR, LDFACT, NMAT,
449453
FACTOR( K ) = 'QP'
450454
ELSE IF( WORK( K ).EQ.6 ) THEN
451455
FACTOR( K ) = 'TZ'
456+
ELSE IF( WORK( K ).EQ.7 ) THEN
457+
FACTOR( K ) = 'R2'
452458
END IF
453459
30 CONTINUE
454460
*

‎TESTING/LIN/psqrdriver.f

Lines changed: 34 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@ PROGRAM PSQRDRIVER
44
* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
55
* and University of California, Berkeley.
66
* May 28, 2001
7-
* Modifications Copyright (c) 2024 Advanced Micro Devices, Inc. All rights reserved.
7+
* Modifications Copyright (c) 2024-25 Advanced Micro Devices, Inc. All rights reserved.
88
*
99
* Purpose
1010
* =======
@@ -127,7 +127,7 @@ PROGRAM PSQRDRIVER
127127
$ PSFILLPAD, PSGELQF, PSGELQRV,
128128
$ PSGEQLF, PSGEQLRV, PSGEQPF,
129129
$ PSQPPIV, PSGEQRF, PSGEQRRV,
130-
$ PSGERQF, PSGERQRV, PSTZRZRV,
130+
$ PSGERQF, PSGERQ2, PSGERQRV, PSTZRZRV,
131131
$ PSMATGEN, PSLAFCHK, PSQRINFO,
132132
$ PSTZRZF, SLBOOT, SLCOMBINE, SLTIMER
133133
* ..
@@ -229,6 +229,11 @@ PROGRAM PSQRDRIVER
229229
ROUTCHK = 'PSGERQRV'
230230
WRITE( NOUT, FMT = 9986 )
231231
$ 'RQ factorization tests.'
232+
ELSE IF( LSAMEN( 2, FACT, 'R2' ) ) THEN
233+
ROUT = 'PSGERQ2'
234+
ROUTCHK = 'PSGERQRV'
235+
WRITE( NOUT, FMT = 9986 )
236+
$ 'RQ2 factorization tests.'
232237
ELSE IF( LSAMEN( 2, FACT, 'QP' ) ) THEN
233238
ROUT = 'PSGEQPF'
234239
ROUTCHK = 'PSGEQRRV'
@@ -506,7 +511,8 @@ PROGRAM PSQRDRIVER
506511
*
507512
END IF
508513
*
509-
ELSE IF( LSAMEN( 2, FACT, 'RQ' ) ) THEN
514+
ELSE IF( LSAMEN( 2, FACT, 'RQ' ) .OR.
515+
$ LSAMEN( 2, FACT, 'R2' ) ) THEN
510516
*
511517
LTAU = MP
512518
IPW = IPTAU + LTAU + IPOSTPAD + IPREPAD
@@ -678,6 +684,13 @@ PROGRAM PSQRDRIVER
678684
CALL SLTIMER( 1 )
679685
CALL PSGERQF( M, N, MEM( IPA ), 1, 1, DESCA,
680686
$ MEM( IPTAU ), MEM( IPW ), LWORK,
687+
$ INFO )
688+
CALL SLTIMER( 1 )
689+
ELSE IF( LSAMEN( 2, FACT, 'R2' ) ) THEN
690+
API_NAME = 'PSGERQ2'
691+
CALL SLTIMER( 1 )
692+
CALL PSGERQ2( M, N, MEM( IPA ), 1, 1, DESCA,
693+
$ MEM( IPTAU ), MEM( IPW ), LWORK,
681694
$ INFO )
682695
CALL SLTIMER( 1 )
683696
ELSE IF( LSAMEN( 2, FACT, 'QP' ) ) THEN
@@ -688,7 +701,7 @@ PROGRAM PSQRDRIVER
688701
$ MEM( IPW ), LWORK, INFO )
689702
CALL SLTIMER( 1 )
690703
ELSE IF( LSAMEN( 2, FACT, 'TZ' ) ) THEN
691-
API_NAME = 'PDTZRZF'
704+
API_NAME = 'PSTZRZF'
692705
CALL SLTIMER( 1 )
693706
#ifdef ENABLE_DRIVER_CHECK
694707
IF( N.GE.M )
@@ -777,6 +790,19 @@ PROGRAM PSQRDRIVER
777790
CALL PSLAFCHK( 'No', 'No', M, N,
778791
$ MEM( IPA ), 1,
779792
$ 1, DESCA, IASEED, ANORM, FRESID,
793+
$ MEM( IPW ) )
794+
ELSE IF( LSAMEN( 2, FACT, 'R2' ) ) THEN
795+
*
796+
* Compute residual = ||A-R*Q|| / (||A||*N*eps)
797+
*
798+
* Since PSGERQ2 computes RQ factorization,
799+
* validation of PSGERQF can be used
800+
CALL PSGERQRV( M, N, MEM( IPA ), 1, 1,
801+
$ DESCA,
802+
$ MEM( IPTAU ), MEM( IPW ) )
803+
CALL PSLAFCHK( 'No', 'No', M, N,
804+
$ MEM( IPA ), 1,
805+
$ 1, DESCA, IASEED, ANORM, FRESID,
780806
$ MEM( IPW ) )
781807
ELSE IF( LSAMEN( 2, FACT, 'QP' ) ) THEN
782808
*
@@ -861,6 +887,8 @@ PROGRAM PSQRDRIVER
861887
$ (INFO.EQ.-1 .AND.
862888
$ LSAMEN( 2, FACT, 'RQ')) .OR.
863889
$ (INFO.EQ.-1 .AND.
890+
$ LSAMEN( 2, FACT, 'R2')) .OR.
891+
$ (INFO.EQ.-1 .AND.
864892
$ LSAMEN( 2, FACT, 'QP')) .OR.
865893
$ (INFO.EQ.-1 .AND.
866894
$ LSAMEN( 2, FACT, 'TZ' )))
@@ -874,6 +902,8 @@ PROGRAM PSQRDRIVER
874902
$ (INFO.EQ.-2 .AND.
875903
$ LSAMEN( 2, FACT, 'RQ')) .OR.
876904
$ (INFO.EQ.-2 .AND.
905+
$ LSAMEN( 2, FACT, 'R2')) .OR.
906+
$ (INFO.EQ.-2 .AND.
877907
$ LSAMEN( 2, FACT, 'QP')) .OR.
878908
$ (INFO.EQ.-2 .AND.
879909
$ LSAMEN( 2, FACT, 'TZ' )))

0 commit comments

Comments
 (0)