Changed XERBLA Error Message

XERBLA gives out DGESVD error message since DGESDD internally uses DGESVD.
Corrected it by returning only info without XERBLA error message in DGESVD.

Author: varajago

src/lapack/dec/svd/ext/flamec/lapack_dgesvd.c

@@ -5,7 +5,7 @@
  the command line, as in cc *.o -lf2c -lm Source for libf2c is in
  /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */
 /*
- * Modifications Copyright (c) 2021-2024 Advanced Micro Devices, Inc.  All
+ * Modifications Copyright (c) 2021-2025 Advanced Micro Devices, Inc.  All
  * rights reserved.
  */
 #include "FLAME.h"
@@ -1646,8 +1646,6 @@ int lapack_dgesvd(char *jobu, char *jobvt, integer *m, integer *n,
   }
 #endif
   if (*info != 0) {
-    i__2 = -(*info);
-    xerbla_("DGESVD", &i__2, (ftnlen)6);
     return 0;
   } else if (lquery) {
     return 0;

src/map/lapack2flamec/FLA_gesdd.c

@@ -38,6 +38,14 @@
   At this moment, this routine is redirected to GESVD.
 */
 
+extern void xerbla_(const char *srname, const integer *info, ftnlen srname_len);
+extern int lapack_sgesvd(char *jobu, char *jobvt, integer *m, integer *n, real *a, integer *lda,
+                         real *s, real *u, integer *ldu, real *vt, integer *ldvt, real *work,
+                         integer *lwork, integer *info);
+extern int lapack_dgesvd(char *jobu, char *jobvt, integer *m, integer *n, doublereal *a,
+                         integer *lda, doublereal *s, doublereal *u, integer *ldu, doublereal *vt,
+                         integer *ldvt, doublereal *work, integer *lwork, integer *info);
+
 #define LAPACK_gesdd_real(prefix)                                                   \
     void F77_##prefix##gesdd(                                                       \
         char *jobz, integer *m, integer *n, PREFIX2LAPACK_TYPEDEF(prefix) * buff_A, \
@@ -55,10 +63,10 @@
         PREFIX2LAPACK_TYPEDEF(prefix) * buff_w, integer * lwork,                    \
         PREFIX2LAPACK_REALDEF(prefix) * buff_r, integer * buff_i, integer * info)
 
-#define LAPACK_gesdd_real_body(prefix)                                                     \
-                                                                                           \
-    F77_##prefix##gesvd(jobu, jobv, m, n, buff_A, ldim_A, buff_s, buff_U, ldim_U, buff_Vh, \
-                        ldim_Vh, buff_w, lwork, info);
+#define LAPACK_gesdd_real_body(prefix)                                                        \
+                                                                                              \
+    lapack_##prefix##gesvd(jobu, jobv, m, n, buff_A, ldim_A, buff_s, buff_U, ldim_U, buff_Vh, \
+                           ldim_Vh, buff_w, lwork, info);
 
 #define LAPACK_gesdd_complex_body(prefix)                                                  \
     char jobu[1], jobv[1];                                                                 \
@@ -158,11 +166,13 @@ LAPACK_gesdd_real(d)
     if(*m < FLA_SVD_SMALL_SIZE_THRESH2 && *n < FLA_SVD_SMALL_SIZE_THRESH2)
     {
         /* Path for small sizes making use of optimized DGESVD */
+        integer i__1;
         char jobu[1], jobv[1];
         doublereal anrm;
         extern doublereal dlange_(char *norm, integer *m, integer *n,
                                   doublereal *a, integer *lda, doublereal *work);
 
+        *info = 0;
         if(lsame_(jobz, "O", 1, 1))
         {
             if(*m >= *n)
@@ -211,6 +221,8 @@ LAPACK_gesdd_real(d)
         {
             /* If the info is set to a negative value, it means that the
              * input parameters are invalid, so return. */
+            i__1 = -(*info);
+            xerbla_("DGESDD", &i__1, (ftnlen)6);
             AOCL_DTL_TRACE_LOG_EXIT
             return;
         }
@@ -232,6 +244,16 @@ LAPACK_gesdd_real(d)
                 *info += 1;
             }
         }
+
+        if(*info < 0)
+        {
+            /* If the info is set to a negative value, it means that the
+             * input parameters are invalid, so return. */
+            i__1 = -(*info);
+            xerbla_("DGESDD", &i__1, (ftnlen)6);
+            AOCL_DTL_TRACE_LOG_EXIT
+            return;
+        }
     }
     else
     {

src/map/lapack2flamec/FLA_gesvd.c

@@ -9,7 +9,7 @@
 */
 
 /*
-    Copyright (c) 2021-2024 Advanced Micro Devices, Inc. All rights reserved.
+    Copyright (c) 2021-2025 Advanced Micro Devices, Inc. All rights reserved.
 */
 
 #include "FLAME.h"
@@ -35,6 +35,7 @@
   Note that the routine returns V**T, not V.
 */
 
+extern void xerbla_(const char *srname, const integer *info, ftnlen srname_len);
 extern int lapack_sgesvd(char *jobu, char *jobvt, integer *m, integer *n, real *a, integer *lda,
                          real *s, real *u, integer *ldu, real *vt, integer *ldvt, real *work,
                          integer *lwork, integer *info);
@@ -181,11 +182,20 @@ LAPACK_gesvd_real(d)
                       *jobu, *jobv, *m, *n, *ldim_A, *ldim_U, *ldim_Vh);
 #if FLA_ENABLE_AMD_OPT
     {
+        integer i__1;
         /* Initialize global context data */
         aocl_fla_init();
 
         lapack_dgesvd(jobu, jobv, m, n, buff_A, ldim_A, buff_s, buff_U, ldim_U, buff_Vh, ldim_Vh,
                       buff_w, lwork, info);
+
+        if(*info < 0)
+        {
+            /* If the info is set to a negative value, it means that the
+             * input parameters are invalid, so return. */
+            i__1 = -(*info);
+            xerbla_("DGESVD", &i__1, (ftnlen)6);
+        }
     }
     AOCL_DTL_TRACE_LOG_EXIT
     return;