diff --git a/.gitignore b/.gitignore index cd6f0ad02..858e8f7a0 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,9 @@ # ignore objects and archives, anywhere in the tree. *.[oa] +*.so +*.dll +*.dylib +*.pdb # test in INSTALL INSTALL/test* diff --git a/CBLAS/.clang-format b/CBLAS/.clang-format new file mode 100644 index 000000000..1a990a6a8 --- /dev/null +++ b/CBLAS/.clang-format @@ -0,0 +1,334 @@ +# Options we simply inherit from the LLVM base style are commented out, so the +# uncommented lines are exactly what this style changes: +# +# IndentWidth / ContinuationIndentWidth 3 +# BreakBeforeBraces Linux +# AllowShortFunctionsOnASingleLine None +# AllowShortIfStatementsOnASingleLine AllIfsAndElse +# BreakAfterReturnType Automatic +# IncludeCategories system headers, then project +# +# Generated against clang-format 22; a run of --dump-config there reproduces +# this file's settings. Older releases will not recognise every +# uncommented key (BreakAfterReturnType and the SortIncludes struct are 19+), +# but commented lines are inert, so they cost nothing. + +BasedOnStyle: LLVM + +Language: Cpp +# AlignAfterOpenBracket: true +# AccessModifierOffset: -2 +# AlignArrayOfStructures: None +# AlignConsecutiveAssignments: +# Enabled: false +# AcrossEmptyLines: false +# AcrossComments: false +# AlignCompound: false +# AlignFunctionDeclarations: false +# AlignFunctionPointers: false +# PadOperators: true +# AlignConsecutiveBitFields: +# Enabled: false +# AcrossEmptyLines: false +# AcrossComments: false +# AlignCompound: false +# AlignFunctionDeclarations: false +# AlignFunctionPointers: false +# PadOperators: false +# AlignConsecutiveDeclarations: +# Enabled: false +# AcrossEmptyLines: false +# AcrossComments: false +# AlignCompound: false +# AlignFunctionDeclarations: true +# AlignFunctionPointers: false +# PadOperators: false +# AlignConsecutiveMacros: +# Enabled: false +# AcrossEmptyLines: false +# AcrossComments: false +# AlignCompound: false +# AlignFunctionDeclarations: false +# AlignFunctionPointers: false +# PadOperators: false +# AlignConsecutiveShortCaseStatements: +# Enabled: false +# AcrossEmptyLines: false +# AcrossComments: false +# AlignCaseArrows: false +# AlignCaseColons: false +# AlignConsecutiveTableGenBreakingDAGArgColons: +# Enabled: false +# AcrossEmptyLines: false +# AcrossComments: false +# AlignCompound: false +# AlignFunctionDeclarations: false +# AlignFunctionPointers: false +# PadOperators: false +# AlignConsecutiveTableGenCondOperatorColons: +# Enabled: false +# AcrossEmptyLines: false +# AcrossComments: false +# AlignCompound: false +# AlignFunctionDeclarations: false +# AlignFunctionPointers: false +# PadOperators: false +# AlignConsecutiveTableGenDefinitionColons: +# Enabled: false +# AcrossEmptyLines: false +# AcrossComments: false +# AlignCompound: false +# AlignFunctionDeclarations: false +# AlignFunctionPointers: false +# PadOperators: false +# AlignEscapedNewlines: Right +# AlignOperands: Align +# AlignTrailingComments: +# AlignPPAndNotPP: true +# Kind: Always +# OverEmptyLines: 0 +# AllowAllArgumentsOnNextLine: true +# AllowAllParametersOfDeclarationOnNextLine: true +# AllowBreakBeforeNoexceptSpecifier: Never +# AllowBreakBeforeQtProperty: false +# AllowShortBlocksOnASingleLine: Never +# AllowShortCaseExpressionOnASingleLine: true +# AllowShortCaseLabelsOnASingleLine: false +# AllowShortCompoundRequirementOnASingleLine: true +# AllowShortEnumsOnASingleLine: true +AllowShortFunctionsOnASingleLine: None +AllowShortIfStatementsOnASingleLine: AllIfsAndElse +# AllowShortLambdasOnASingleLine: All +# AllowShortLoopsOnASingleLine: false +# AllowShortNamespacesOnASingleLine: false +# AlwaysBreakAfterDefinitionReturnType: None +# AlwaysBreakBeforeMultilineStrings: false +# AttributeMacros: +# - __capability +# BinPackArguments: true +# BinPackLongBracedList: true +# BinPackParameters: BinPack +# BitFieldColonSpacing: Both +# BracedInitializerIndentWidth: -1 +# BraceWrapping: +# AfterCaseLabel: true +# AfterClass: true +# AfterControlStatement: Always +# AfterEnum: true +# AfterExternBlock: true +# AfterFunction: true +# AfterNamespace: true +# AfterObjCDeclaration: true +# AfterStruct: true +# AfterUnion: true +# BeforeCatch: true +# BeforeElse: true +# BeforeLambdaBody: true +# BeforeWhile: false +# IndentBraces: false +# SplitEmptyFunction: true +# SplitEmptyRecord: true +# SplitEmptyNamespace: true +# BreakAdjacentStringLiterals: true +# BreakAfterAttributes: Leave +# BreakAfterJavaFieldAnnotations: false +# BreakAfterOpenBracketBracedList: false +# BreakAfterOpenBracketFunction: false +# BreakAfterOpenBracketIf: false +# BreakAfterOpenBracketLoop: false +# BreakAfterOpenBracketSwitch: false +# Definitions carry the return type on its own line: +# static inline size_t +# cblas_xerbla_trimmed_length(const char *name, size_t name_len) +# Spelled AlwaysBreakAfterReturnType before clang-format 19. +BreakAfterReturnType: Automatic +# BreakArrays: true +# BreakBeforeBinaryOperators: None +# BreakBeforeCloseBracketBracedList: false +# BreakBeforeCloseBracketFunction: false +# BreakBeforeCloseBracketIf: false +# BreakBeforeCloseBracketLoop: false +# BreakBeforeCloseBracketSwitch: false +# BreakBeforeConceptDeclarations: Always +BreakBeforeBraces: Linux +# BreakBeforeInlineASMColon: OnlyMultiline +# BreakBeforeTemplateCloser: false +# BreakBeforeTernaryOperators: true +# BreakBinaryOperations: Never +# BreakConstructorInitializers: BeforeColon +# BreakFunctionDefinitionParameters: false +# BreakInheritanceList: BeforeColon +# BreakStringLiterals: true +# BreakTemplateDeclarations: MultiLine +# ColumnLimit: 80 +# CommentPragmas: '^ IWYU pragma:' +# CompactNamespaces: false +# ConstructorInitializerIndentWidth: 4 +ContinuationIndentWidth: 3 +# Cpp11BracedListStyle: AlignFirstComment +# DerivePointerAlignment: false +# DisableFormat: false +# EmptyLineAfterAccessModifier: Never +# EmptyLineBeforeAccessModifier: LogicalBlock +# EnumTrailingComma: Leave +# ExperimentalAutoDetectBinPacking: false +# FixNamespaceComments: true +# ForEachMacros: +# - foreach +# - Q_FOREACH +# - BOOST_FOREACH +# IfMacros: +# - KJ_IF_MAYBE +IncludeCategories: + - Regex: '^<' + Priority: 1 + - Regex: 'cblas.*' + Priority: 2 + - Regex: '.*' + Priority: 3 +# IncludeIsMainRegex: '(Test)?$' +# IncludeIsMainSourceRegex: '' +# IndentAccessModifiers: false +# IndentCaseBlocks: false +# IndentCaseLabels: false +# IndentExportBlock: true +# IndentExternBlock: AfterExternBlock +# IndentGotoLabels: true +# IndentPPDirectives: None +# IndentRequiresClause: true +IndentWidth: 3 +# IndentWrappedFunctionNames: false +# InsertBraces: true +# InsertNewlineAtEOF: false +# InsertTrailingCommas: None +# IntegerLiteralSeparator: +# Binary: 0 +# BinaryMinDigitsInsert: 0 +# BinaryMaxDigitsRemove: 0 +# Decimal: 0 +# DecimalMinDigitsInsert: 0 +# DecimalMaxDigitsRemove: 0 +# Hex: 0 +# HexMinDigitsInsert: 0 +# HexMaxDigitsRemove: 0 +# BinaryMinDigits: 0 +# DecimalMinDigits: 0 +# HexMinDigits: 0 +# JavaScriptQuotes: Leave +# JavaScriptWrapImports: true +# KeepEmptyLines: +# AtEndOfFile: false +# AtStartOfBlock: true +# AtStartOfFile: true +# KeepFormFeed: false +# LambdaBodyIndentation: Signature +# LineEnding: DeriveLF +# MacroBlockBegin: '' +# MacroBlockEnd: '' +# MainIncludeChar: Quote +# MaxEmptyLinesToKeep: 1 +# NamespaceIndentation: None +# NumericLiteralCase: +# ExponentLetter: Leave +# HexDigit: Leave +# Prefix: Leave +# Suffix: Leave +# ObjCBinPackProtocolList: Auto +# ObjCBlockIndentWidth: 2 +# ObjCBreakBeforeNestedBlockParam: true +# ObjCSpaceAfterProperty: false +# ObjCSpaceBeforeProtocolList: true +# OneLineFormatOffRegex: '' +# PackConstructorInitializers: BinPack +# PenaltyBreakAssignment: 2 +# PenaltyBreakBeforeFirstCallParameter: 19 +# PenaltyBreakBeforeMemberAccess: 150 +# PenaltyBreakComment: 300 +# PenaltyBreakFirstLessLess: 120 +# PenaltyBreakOpenParenthesis: 0 +# PenaltyBreakScopeResolution: 500 +# PenaltyBreakString: 1000 +# PenaltyBreakTemplateDeclaration: 10 +# PenaltyExcessCharacter: 1000000 +# PenaltyIndentedWhitespace: 0 +# PenaltyReturnTypeOnItsOwnLine: 60 +# PointerAlignment: Right +# PPIndentWidth: -1 +# QualifierAlignment: Leave +# ReferenceAlignment: Pointer +# ReflowComments: Always +# RemoveBracesLLVM: false +# RemoveEmptyLinesInUnwrappedLines: false +# RemoveParentheses: Leave +# RemoveSemicolon: false +# RequiresClausePosition: OwnLine +# RequiresExpressionIndentation: OuterScope +# SeparateDefinitionBlocks: Leave +# ShortNamespaceLines: 1 +# SkipMacroDefinitionBody: false +# Sorting is LLVM's default and is deliberately left on; the grouping it +# produces comes from the IncludeCategories priorities above. +# SortIncludes: +# Enabled: true +# IgnoreCase: false +# IgnoreExtension: false +# SortJavaStaticImport: Before +# SortUsingDeclarations: LexicographicNumeric +# SpaceAfterCStyleCast: false +# SpaceAfterLogicalNot: false +# SpaceAfterOperatorKeyword: false +# SpaceAfterTemplateKeyword: true +# SpaceAroundPointerQualifiers: Default +# SpaceBeforeAssignmentOperators: true +# SpaceBeforeCaseColon: false +# SpaceBeforeCpp11BracedList: false +# SpaceBeforeCtorInitializerColon: true +# SpaceBeforeInheritanceColon: true +# SpaceBeforeJsonColon: false +# SpaceBeforeParens: ControlStatements +# SpaceBeforeParensOptions: +# AfterControlStatements: true +# AfterForeachMacros: true +# AfterFunctionDefinitionName: false +# AfterFunctionDeclarationName: false +# AfterIfMacros: true +# AfterNot: false +# AfterOverloadedOperator: false +# AfterPlacementOperator: true +# AfterRequiresInClause: false +# AfterRequiresInExpression: false +# BeforeNonEmptyParentheses: false +# SpaceBeforeRangeBasedForLoopColon: true +# SpaceBeforeSquareBrackets: false +# SpaceInEmptyBraces: Never +# SpacesBeforeTrailingComments: 1 +# SpacesInAngles: Never +# SpacesInContainerLiterals: true +# SpacesInLineCommentPrefix: +# Minimum: 1 +# Maximum: -1 +# SpacesInParens: Never +# SpacesInParensOptions: +# ExceptDoubleParentheses: false +# InCStyleCasts: false +# InConditionalStatements: false +# InEmptyParentheses: false +# Other: false +# SpacesInSquareBrackets: false +# Standard: Latest +# StatementAttributeLikeMacros: +# - Q_EMIT +# StatementMacros: +# - Q_UNUSED +# - QT_REQUIRE_VERSION +# TableGenBreakInsideDAGArg: DontBreak +# TabWidth: 8 +# UseTab: Never +# VerilogBreakBetweenInstancePorts: true +# WhitespaceSensitiveMacros: +# - BOOST_PP_STRINGIZE +# - CF_SWIFT_NAME +# - NS_SWIFT_NAME +# - PP_STRINGIZE +# - STRINGIZE +# WrapNamespaceBodyWithEmptyLines: Leave diff --git a/CBLAS/examples/cblas_example1_64.c b/CBLAS/examples/cblas_example1_64.c index 2dfcb7309..99c1f55f6 100644 --- a/CBLAS/examples/cblas_example1_64.c +++ b/CBLAS/examples/cblas_example1_64.c @@ -61,7 +61,7 @@ int main ( ) y, incy ); /* Print y */ for( i = 0; i < n; i++ ) - printf(" y%d = %f\n", (int) i, y[i]); + printf(" y%" PRId64 " = %f\n", i, y[i]); free(a); free(x); free(y); diff --git a/CBLAS/include/cblas.h b/CBLAS/include/cblas.h index 2013d3028..d840bc944 100644 --- a/CBLAS/include/cblas.h +++ b/CBLAS/include/cblas.h @@ -44,6 +44,21 @@ typedef enum CBLAS_SIDE {CblasLeft=141, CblasRight=142} CBLAS_SIDE; #define CBLAS_ORDER CBLAS_LAYOUT /* this for backward compatibility with CBLAS_ORDER */ +/* + * Weak symbol support for cblas_xerbla() and F77_xerbla() + * + * Must precede the cblas_64.h include below: that header declares + * cblas_xerbla_64() with CBLAS_WEAK_SYMBOL, and its own include of cblas.h is + * a no-op while we are still inside this header's include guard. + */ +#ifndef CBLAS_WEAK_SYMBOL +#ifdef HAS_ATTRIBUTE_WEAK_SUPPORT + #define CBLAS_WEAK_SYMBOL __attribute__((weak)) +#else + #define CBLAS_WEAK_SYMBOL +#endif +#endif + /* * Integer specific API */ @@ -684,11 +699,8 @@ void cblas_zher2k(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const void *B, const CBLAS_INT ldb, const double beta, void *C, const CBLAS_INT ldc); -void -#ifdef HAS_ATTRIBUTE_WEAK_SUPPORT -__attribute__((weak)) -#endif -cblas_xerbla(CBLAS_INT p, const char *rout, const char *form, ...); +void CBLAS_WEAK_SYMBOL cblas_xerbla(CBLAS_INT p, const char *rout, + const char *form, ...); #ifdef __cplusplus } diff --git a/CBLAS/include/cblas_64.h b/CBLAS/include/cblas_64.h index 064ca447a..32009bd2d 100644 --- a/CBLAS/include/cblas_64.h +++ b/CBLAS/include/cblas_64.h @@ -639,11 +639,8 @@ void cblas_zher2k_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const void *B, const int64_t ldb, const double beta, void *C, const int64_t ldc); -void -#ifdef HAS_ATTRIBUTE_WEAK_SUPPORT -__attribute__((weak)) -#endif -cblas_xerbla_64(int64_t p, const char *rout, const char *form, ...); +void CBLAS_WEAK_SYMBOL cblas_xerbla_64(int64_t p, const char *rout, + const char *form, ...); #ifdef __cplusplus } diff --git a/CBLAS/include/cblas_f77.h b/CBLAS/include/cblas_f77.h index 3c5f560de..e20ee980f 100644 --- a/CBLAS/include/cblas_f77.h +++ b/CBLAS/include/cblas_f77.h @@ -59,6 +59,17 @@ #endif #endif +/* + * Weak symbol support for cblas_xerbla() and F77_xerbla() + */ +#ifndef CBLAS_WEAK_SYMBOL +#ifdef HAS_ATTRIBUTE_WEAK_SUPPORT + #define CBLAS_WEAK_SYMBOL __attribute__((weak)) +#else + #define CBLAS_WEAK_SYMBOL +#endif +#endif + #define F77_GLOBAL_SUFFIX(a,b) F77_GLOBAL_SUFFIX_(API_SUFFIX(a),API_SUFFIX(b)) #define F77_GLOBAL_SUFFIX_(a,b) F77_GLOBAL(a,b) @@ -613,11 +624,7 @@ extern "C" { #else #define F77_xerbla(...) F77_xerbla_base(__VA_ARGS__) #endif -void -#ifdef HAS_ATTRIBUTE_WEAK_SUPPORT -__attribute__((weak)) -#endif -F77_xerbla_base(FCHAR, void * +void CBLAS_WEAK_SYMBOL F77_xerbla_base(FCHAR, void * #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN #endif diff --git a/CBLAS/include/cblas_test.h b/CBLAS/include/cblas_test.h index 8cd496bbb..74d035d78 100644 --- a/CBLAS/include/cblas_test.h +++ b/CBLAS/include/cblas_test.h @@ -22,6 +22,20 @@ #define FORTRAN_STRLEN size_t #endif +#ifndef F77_INT +#ifdef WeirdNEC + #define F77_INT int64_t +#else + #define F77_INT int32_t +#endif +#endif + +#ifdef F77_CHAR + #define FCHAR F77_CHAR +#else + #define FCHAR char * +#endif + #define TRUE 1 #define PASSED 1 #define TEST_ROW_MJR 1 diff --git a/CBLAS/include/cblas_xerbla_internal.h b/CBLAS/include/cblas_xerbla_internal.h new file mode 100644 index 000000000..09575ca90 --- /dev/null +++ b/CBLAS/include/cblas_xerbla_internal.h @@ -0,0 +1,267 @@ +#ifndef CBLAS_XERBLA_INTERNAL_H +#define CBLAS_XERBLA_INTERNAL_H + +#include +#include +#include + +#include "cblas.h" + +// Keep a bit of headroom for possible future CBLAS routines +#define CBLAS_XERBLA_MAX_ROUTINE_NAME 32u +#define CBLAS_XERBLA_API_PREFIX "cblas_" +#define CBLAS_XERBLA_API64_SUFFIX "_64" +#ifdef CBLAS_API64 +#define CBLAS_XERBLA_API_SUFFIX CBLAS_XERBLA_API64_SUFFIX +#else +#define CBLAS_XERBLA_API_SUFFIX "" +#endif + +#define CBLAS_XERBLA_ROUT_BUFFER_SIZE \ + ((sizeof(CBLAS_XERBLA_API_PREFIX) - 1) + CBLAS_XERBLA_MAX_ROUTINE_NAME + \ + (sizeof(CBLAS_XERBLA_API_SUFFIX) - 1) + 1) + +/** + * \brief Length of a Fortran-style name with trailing blanks removed. + * + * \param[in] name Character data, not necessarily NUL terminated. + * \param[in] name_len Number of characters available in \p name. + * + * \return Length up to the first NUL, excluding trailing blanks, or 0 if + * \p name is NULL. + */ +static inline size_t cblas_xerbla_trimmed_length(const char *name, + const size_t name_len) +{ + if (name == NULL) return 0; + + size_t actual_len = 0; + while (actual_len < name_len && name[actual_len] != '\0') { + actual_len++; + } + while (actual_len > 0 && name[actual_len - 1] == ' ') { + actual_len--; + } + + return actual_len; +} + +/** + * \brief Build the "cblas_"-prefixed routine name used in error messages. + * + * Lowercases \p name and drops trailing blanks and, in 64-bit API builds, a + * trailing "_64". The result is always NUL terminated, and is truncated + * rather than allowed to overflow \p rout. + * + * \param[out] rout Destination buffer, normally of size + * CBLAS_XERBLA_ROUT_BUFFER_SIZE. + * \param[in] rout_size Size of \p rout in bytes. + * \param[in] name Fortran routine name, not necessarily NUL + * terminated. + * \param[in] name_len Number of characters available in \p name. + */ +static inline void cblas_xerbla_make_rout(char *rout, const size_t rout_size, + const char *name, size_t name_len) +{ + if (rout_size == 0) return; + + name_len = cblas_xerbla_trimmed_length(name, name_len); + + static const char suffix[] = CBLAS_XERBLA_API_SUFFIX; + const size_t suffix_len = sizeof(suffix) - 1; + if (suffix_len > 0 && name_len >= suffix_len && + strncmp(name + name_len - suffix_len, suffix, suffix_len) == 0) { + name_len -= suffix_len; + } + + if (name_len > CBLAS_XERBLA_MAX_ROUTINE_NAME) { + name_len = CBLAS_XERBLA_MAX_ROUTINE_NAME; + } + + static const char prefix[] = CBLAS_XERBLA_API_PREFIX; + const size_t prefix_len = sizeof(prefix) - 1; + size_t rout_len = 0; + for (size_t i = 0; i < prefix_len && rout_len + 1 < rout_size; i++) { + rout[rout_len++] = prefix[i]; + } + for (size_t i = 0; i < name_len && rout_len + 1 < rout_size; i++) { + rout[rout_len++] = (char)tolower((unsigned char)name[i]); + } + + rout[rout_len] = '\0'; +} + +/** + * \brief Copy a routine name as it should be reported to the user. + * + * Appends the extended API suffix, so that a 64-bit build names + * cblas_dgemm_64() rather than cblas_dgemm() in its diagnostics. A name that + * already carries the suffix is copied unchanged, which keeps the call + * idempotent whatever the caller passes. The result is always NUL terminated + * and is truncated rather than allowed to overflow \p rout. + * + * \param[out] rout Destination buffer, normally of size + * CBLAS_XERBLA_ROUT_BUFFER_SIZE. + * \param[in] rout_size Size of \p rout in bytes. + * \param[in] name Routine name, e.g. "cblas_dgemm", or NULL. + */ +static inline void cblas_xerbla_apply_api_suffix(char *rout, + const size_t rout_size, + const char *name) +{ + if (rout_size == 0) return; + + if (name == NULL) { + rout[0] = '\0'; + return; + } + + static const char suffix[] = CBLAS_XERBLA_API_SUFFIX; + size_t suffix_len = sizeof(suffix) - 1; + const size_t name_len = strlen(name); + if (suffix_len > 0 && name_len >= suffix_len && + strcmp(name + name_len - suffix_len, suffix) == 0) { + suffix_len = 0; + } + + size_t rout_len = 0; + for (size_t i = 0; i < name_len && rout_len + 1 < rout_size; i++) { + rout[rout_len++] = name[i]; + } + for (size_t i = 0; i < suffix_len && rout_len + 1 < rout_size; i++) { + rout[rout_len++] = suffix[i]; + } + + rout[rout_len] = '\0'; +} + +/** + * \brief Reduce a routine name to its bare operation. + * + * Skips the "cblas_" prefix and the precision character, so that + * "cblas_dgemm" yields "gemm". + * + * \param[in] rout CBLAS routine name, or NULL. + * + * \return Pointer into \p rout past the prefix and precision character, or + * NULL if \p rout is NULL. + */ +static inline const char *cblas_xerbla_operation(const char *rout) +{ + if (rout == NULL) return NULL; + + static const char prefix[] = CBLAS_XERBLA_API_PREFIX; + const size_t prefix_len = sizeof(prefix) - 1; + if (strncmp(rout, prefix, prefix_len) == 0) { + rout += prefix_len; + } + if ((rout[0] == 's' || rout[0] == 'd' || rout[0] == 'c' || rout[0] == 'z') && + rout[1] != '\0') { + rout++; + } + + return rout; +} + +/** + * \brief Test an operation name for equality. + * + * The comparison is exact, so "gemm" does not also match "gemmtr". A trailing + * extended API suffix is tolerated, so that a name arriving already suffixed + * still selects the right remapping rather than silently selecting none. + * + * \param[in] operation Result of cblas_xerbla_operation(), or NULL. + * \param[in] expected Operation name to match. + * + * \return Nonzero when \p operation equals \p expected, ignoring any trailing + * extended API suffix. + */ +static inline int cblas_xerbla_operation_is(const char *operation, + const char *expected) +{ + if (operation == NULL) return 0; + + const size_t expected_len = strlen(expected); + if (strncmp(operation, expected, expected_len) != 0) return 0; + + return operation[expected_len] == '\0' || + strcmp(operation + expected_len, CBLAS_XERBLA_API64_SUFFIX) == 0; +} + +/** + * \brief Map a Fortran argument number onto its CBLAS position. + * + * Row-major calls reach the Fortran BLAS with arguments swapped or + * transposed, so the number XERBLA reports is not that of the CBLAS + * argument actually at fault. Column-major calls, and operations needing no + * adjustment, return \p info unchanged. + * + * \param[in] info Argument number reported by the Fortran BLAS. + * \param[in] rout CBLAS routine name, e.g. "cblas_dgemm". + * \param[in] row_major Nonzero if the call used CblasRowMajor. + * + * \return The corresponding CBLAS argument number. + */ +static inline CBLAS_INT cblas_xerbla_map_info(CBLAS_INT info, const char *rout, + const int row_major) +{ + if (!row_major) return info; + + const char *const operation = cblas_xerbla_operation(rout); + if (cblas_xerbla_operation_is(operation, "gemmtr")) { + + if (info == 11) info = 9; + else if (info == 9) info = 11; + + } else if (cblas_xerbla_operation_is(operation, "gemm")) { + + if (info == 5) info = 4; + else if (info == 4) info = 5; + else if (info == 11) info = 9; + else if (info == 9) info = 11; + + } else if (cblas_xerbla_operation_is(operation, "symm") || + cblas_xerbla_operation_is(operation, "hemm") || + cblas_xerbla_operation_is(operation, "skewsymm")) { + + if (info == 5) info = 4; + else if (info == 4) info = 5; + + } else if (cblas_xerbla_operation_is(operation, "trmm") || + cblas_xerbla_operation_is(operation, "trsm")) { + + if (info == 7) info = 6; + else if (info == 6) info = 7; + + } else if (cblas_xerbla_operation_is(operation, "gemv")) { + + if (info == 4) info = 3; + else if (info == 3) info = 4; + + } else if (cblas_xerbla_operation_is(operation, "gbmv")) { + + if (info == 4) info = 3; + else if (info == 3) info = 4; + else if (info == 6) info = 5; + else if (info == 5) info = 6; + + } else if (cblas_xerbla_operation_is(operation, "ger") || + cblas_xerbla_operation_is(operation, "geru") || + cblas_xerbla_operation_is(operation, "gerc")) { + + if (info == 3) info = 2; + else if (info == 2) info = 3; + else if (info == 8) info = 6; + else if (info == 6) info = 8; + + } else if (cblas_xerbla_operation_is(operation, "her2") || + cblas_xerbla_operation_is(operation, "hpr2")) { + + if (info == 8) info = 6; + else if (info == 6) info = 8; + } + + return info; +} + +#endif // CBLAS_XERBLA_INTERNAL_H diff --git a/CBLAS/src/cblas_cgemm.c b/CBLAS/src/cblas_cgemm.c index fe4b599a1..5950ed1f8 100644 --- a/CBLAS/src/cblas_cgemm.c +++ b/CBLAS/src/cblas_cgemm.c @@ -89,7 +89,7 @@ void API_SUFFIX(cblas_cgemm)(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE Tr else if ( TransB == CblasNoTrans ) TA='N'; else { - API_SUFFIX(cblas_xerbla)(2, "cblas_cgemm", "Illegal TransB setting, %d\n", TransB); + API_SUFFIX(cblas_xerbla)(3, "cblas_cgemm", "Illegal TransB setting, %d\n", TransB); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_cher2k.c b/CBLAS/src/cblas_cher2k.c index a4e24abfa..374e47a8e 100644 --- a/CBLAS/src/cblas_cher2k.c +++ b/CBLAS/src/cblas_cher2k.c @@ -85,8 +85,7 @@ void API_SUFFIX(cblas_cher2k)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, RowMajorStrg = 0; return; } - if( Trans == CblasTrans) TR ='N'; - else if ( Trans == CblasConjTrans ) TR='N'; + if( Trans == CblasConjTrans ) TR='N'; else if ( Trans == CblasNoTrans ) TR='C'; else { diff --git a/CBLAS/src/cblas_cherk.c b/CBLAS/src/cblas_cherk.c index 4ac61bab2..0d50a37e5 100644 --- a/CBLAS/src/cblas_cherk.c +++ b/CBLAS/src/cblas_cherk.c @@ -74,13 +74,12 @@ void API_SUFFIX(cblas_cherk)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='U'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_cherk", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_cherk", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; } - if( Trans == CblasTrans) TR ='N'; - else if ( Trans == CblasConjTrans ) TR='N'; + if( Trans == CblasConjTrans ) TR='N'; else if ( Trans == CblasNoTrans ) TR='C'; else { diff --git a/CBLAS/src/cblas_csyr2k.c b/CBLAS/src/cblas_csyr2k.c index e564a9043..62c8cd033 100644 --- a/CBLAS/src/cblas_csyr2k.c +++ b/CBLAS/src/cblas_csyr2k.c @@ -78,13 +78,12 @@ void API_SUFFIX(cblas_csyr2k)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='U'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_csyr2k", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_csyr2k", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; } if( Trans == CblasTrans) TR ='N'; - else if ( Trans == CblasConjTrans ) TR='N'; else if ( Trans == CblasNoTrans ) TR='T'; else { diff --git a/CBLAS/src/cblas_csyrk.c b/CBLAS/src/cblas_csyrk.c index 21c32d0c3..f87383ddd 100644 --- a/CBLAS/src/cblas_csyrk.c +++ b/CBLAS/src/cblas_csyrk.c @@ -76,13 +76,12 @@ void API_SUFFIX(cblas_csyrk)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='U'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_csyrk", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_csyrk", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; } if( Trans == CblasTrans) TR ='N'; - else if ( Trans == CblasConjTrans ) TR='N'; else if ( Trans == CblasNoTrans ) TR='T'; else { diff --git a/CBLAS/src/cblas_ctbmv.c b/CBLAS/src/cblas_ctbmv.c index d86697b10..697bf55e6 100644 --- a/CBLAS/src/cblas_ctbmv.c +++ b/CBLAS/src/cblas_ctbmv.c @@ -124,7 +124,7 @@ void API_SUFFIX(cblas_ctbmv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - API_SUFFIX(cblas_xerbla)(4, "cblas_ctbmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(4, "cblas_ctbmv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_dskewsyr2k.c b/CBLAS/src/cblas_dskewsyr2k.c index 62db659f8..853e5451b 100644 --- a/CBLAS/src/cblas_dskewsyr2k.c +++ b/CBLAS/src/cblas_dskewsyr2k.c @@ -79,7 +79,7 @@ void API_SUFFIX(cblas_dskewsyr2k)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Up else if ( Uplo == CblasLower ) UL='U'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_dskewsyr2k","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_dskewsyr2k","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_dsyr2k.c b/CBLAS/src/cblas_dsyr2k.c index 85e01b271..d8921af2f 100644 --- a/CBLAS/src/cblas_dsyr2k.c +++ b/CBLAS/src/cblas_dsyr2k.c @@ -78,7 +78,7 @@ void API_SUFFIX(cblas_dsyr2k)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='U'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_dsyr2k","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_dsyr2k","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_dsyrk.c b/CBLAS/src/cblas_dsyrk.c index dfca58214..059e42e52 100644 --- a/CBLAS/src/cblas_dsyrk.c +++ b/CBLAS/src/cblas_dsyrk.c @@ -76,7 +76,7 @@ void API_SUFFIX(cblas_dsyrk)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='U'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_dsyrk","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_dsyrk","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_dtbmv.c b/CBLAS/src/cblas_dtbmv.c index dea9165d9..eb4b59d7c 100644 --- a/CBLAS/src/cblas_dtbmv.c +++ b/CBLAS/src/cblas_dtbmv.c @@ -101,7 +101,7 @@ void API_SUFFIX(cblas_dtbmv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - API_SUFFIX(cblas_xerbla)(4, "cblas_dtbmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(4, "cblas_dtbmv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_sskewsyr2k.c b/CBLAS/src/cblas_sskewsyr2k.c index 4d0dcceab..8cf0ac3ff 100644 --- a/CBLAS/src/cblas_sskewsyr2k.c +++ b/CBLAS/src/cblas_sskewsyr2k.c @@ -80,7 +80,7 @@ void API_SUFFIX(cblas_sskewsyr2k)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Up else if ( Uplo == CblasLower ) UL='U'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_sskewsyr2k", + API_SUFFIX(cblas_xerbla)(2, "cblas_sskewsyr2k", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; diff --git a/CBLAS/src/cblas_ssyr2k.c b/CBLAS/src/cblas_ssyr2k.c index ca471b8fa..5b5690ba7 100644 --- a/CBLAS/src/cblas_ssyr2k.c +++ b/CBLAS/src/cblas_ssyr2k.c @@ -79,7 +79,7 @@ void API_SUFFIX(cblas_ssyr2k)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='U'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_ssyr2k", + API_SUFFIX(cblas_xerbla)(2, "cblas_ssyr2k", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; diff --git a/CBLAS/src/cblas_ssyrk.c b/CBLAS/src/cblas_ssyrk.c index bf9b98508..f9f59241c 100644 --- a/CBLAS/src/cblas_ssyrk.c +++ b/CBLAS/src/cblas_ssyrk.c @@ -77,7 +77,7 @@ void API_SUFFIX(cblas_ssyrk)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='U'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_ssyrk", + API_SUFFIX(cblas_xerbla)(2, "cblas_ssyrk", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; diff --git a/CBLAS/src/cblas_stbmv.c b/CBLAS/src/cblas_stbmv.c index 9005e747d..89d9bd2d9 100644 --- a/CBLAS/src/cblas_stbmv.c +++ b/CBLAS/src/cblas_stbmv.c @@ -101,7 +101,7 @@ void API_SUFFIX(cblas_stbmv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - API_SUFFIX(cblas_xerbla)(4, "cblas_stbmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(4, "cblas_stbmv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_xerbla.c b/CBLAS/src/cblas_xerbla.c index f353153a4..a4ceae3b9 100644 --- a/CBLAS/src/cblas_xerbla.c +++ b/CBLAS/src/cblas_xerbla.c @@ -1,72 +1,45 @@ +#include #include #include -#include -#include + #include "cblas.h" #include "cblas_f77.h" +#include "cblas_xerbla_internal.h" -void -#ifdef HAS_ATTRIBUTE_WEAK_SUPPORT -__attribute__((weak)) -#endif -API_SUFFIX(cblas_xerbla)(CBLAS_INT info, const char *rout, const char *form, ...) +/** + * \brief CBLAS error handler: report an invalid argument and terminate. + * + * Remaps \p info to the CBLAS argument position for row-major calls, writes + * the diagnostic to stderr and exits; it does not return to its caller. + * + * \param[in] info CBLAS argument number, or 0 to report only \p form. + * \param[in] rout Routine name, e.g. "cblas_dgemm". + * \param[in] form printf-style format for further detail, followed by the + * values it refers to. + */ +void CBLAS_WEAK_SYMBOL API_SUFFIX(cblas_xerbla)(CBLAS_INT info, + const char *rout, + const char *form, ...) { extern int RowMajorStrg; char empty[1] = ""; - va_list argptr; - va_start(argptr, form); + info = cblas_xerbla_map_info(info, rout, RowMajorStrg); + if (info) { + char reported[CBLAS_XERBLA_ROUT_BUFFER_SIZE]; + cblas_xerbla_apply_api_suffix(reported, sizeof(reported), rout); - if (RowMajorStrg) - { - if (strstr(rout,"gemm") != 0) - { - if (info == 5 ) info = 4; - else if (info == 4 ) info = 5; - else if (info == 11) info = 9; - else if (info == 9 ) info = 11; - } - else if (strstr(rout,"symm") != 0 || strstr(rout,"hemm") != 0) - { - if (info == 5 ) info = 4; - else if (info == 4 ) info = 5; - } - else if (strstr(rout,"trmm") != 0 || strstr(rout,"trsm") != 0) - { - if (info == 7 ) info = 6; - else if (info == 6 ) info = 7; - } - else if (strstr(rout,"gemv") != 0) - { - if (info == 4) info = 3; - else if (info == 3) info = 4; - } - else if (strstr(rout,"gbmv") != 0) - { - if (info == 4) info = 3; - else if (info == 3) info = 4; - else if (info == 6) info = 5; - else if (info == 5) info = 6; - } - else if (strstr(rout,"ger") != 0) - { - if (info == 3) info = 2; - else if (info == 2) info = 3; - else if (info == 8) info = 6; - else if (info == 6) info = 8; - } - else if ( (strstr(rout,"her2") != 0 || strstr(rout,"hpr2") != 0) - && strstr(rout,"her2k") == 0 ) - { - if (info == 8) info = 6; - else if (info == 6) info = 8; - } + fprintf(stderr, "Parameter %" CBLAS_IFMT " to routine %s was incorrect\n", + info, reported); } - if (info) - fprintf(stderr, "Parameter %" CBLAS_IFMT " to routine %s was incorrect\n", info, rout); + + va_list argptr; + va_start(argptr, form); vfprintf(stderr, form, argptr); va_end(argptr); - if (info && !info) + + if (info && !info) { F77_xerbla(empty, &info); /* Force link of our F77 error handler */ + } exit(-1); } diff --git a/CBLAS/src/cblas_zher2k.c b/CBLAS/src/cblas_zher2k.c index 31a82974c..e1ac2c64d 100644 --- a/CBLAS/src/cblas_zher2k.c +++ b/CBLAS/src/cblas_zher2k.c @@ -85,8 +85,7 @@ void API_SUFFIX(cblas_zher2k)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, RowMajorStrg = 0; return; } - if( Trans == CblasTrans) TR ='N'; - else if ( Trans == CblasConjTrans ) TR='N'; + if( Trans == CblasConjTrans ) TR='N'; else if ( Trans == CblasNoTrans ) TR='C'; else { diff --git a/CBLAS/src/cblas_zherk.c b/CBLAS/src/cblas_zherk.c index 8d9ab9e3c..9016a512a 100644 --- a/CBLAS/src/cblas_zherk.c +++ b/CBLAS/src/cblas_zherk.c @@ -74,13 +74,12 @@ void API_SUFFIX(cblas_zherk)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='U'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_zherk", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_zherk", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; } - if( Trans == CblasTrans) TR ='N'; - else if ( Trans == CblasConjTrans ) TR='N'; + if( Trans == CblasConjTrans ) TR='N'; else if ( Trans == CblasNoTrans ) TR='C'; else { diff --git a/CBLAS/src/cblas_zsyr2k.c b/CBLAS/src/cblas_zsyr2k.c index 3223229d7..3d09e3297 100644 --- a/CBLAS/src/cblas_zsyr2k.c +++ b/CBLAS/src/cblas_zsyr2k.c @@ -78,13 +78,12 @@ void API_SUFFIX(cblas_zsyr2k)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='U'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_zsyr2k", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_zsyr2k", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; } if( Trans == CblasTrans) TR ='N'; - else if ( Trans == CblasConjTrans ) TR='N'; else if ( Trans == CblasNoTrans ) TR='T'; else { diff --git a/CBLAS/src/cblas_zsyrk.c b/CBLAS/src/cblas_zsyrk.c index 4f5b6b325..885158293 100644 --- a/CBLAS/src/cblas_zsyrk.c +++ b/CBLAS/src/cblas_zsyrk.c @@ -76,13 +76,12 @@ void API_SUFFIX(cblas_zsyrk)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='U'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_zsyrk", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_zsyrk", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; } if( Trans == CblasTrans) TR ='N'; - else if ( Trans == CblasConjTrans ) TR='N'; else if ( Trans == CblasNoTrans ) TR='T'; else { diff --git a/CBLAS/src/cblas_ztbmv.c b/CBLAS/src/cblas_ztbmv.c index 3b6f17e23..af86f6062 100644 --- a/CBLAS/src/cblas_ztbmv.c +++ b/CBLAS/src/cblas_ztbmv.c @@ -124,7 +124,7 @@ void API_SUFFIX(cblas_ztbmv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - API_SUFFIX(cblas_xerbla)(4, "cblas_ztbmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(4, "cblas_ztbmv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/xerbla.c b/CBLAS/src/xerbla.c index a7ca7869a..197b2bd86 100644 --- a/CBLAS/src/xerbla.c +++ b/CBLAS/src/xerbla.c @@ -1,50 +1,60 @@ #include -#include + #include "cblas.h" #include "cblas_f77.h" +#include "cblas_xerbla_internal.h" -#define XerblaStrLen 6 -#define XerblaStrLen1 7 - -void -#ifdef HAS_ATTRIBUTE_WEAK_SUPPORT -__attribute__((weak)) -#endif -F77_xerbla_base -#ifdef F77_CHAR -(F77_CHAR F77_srname, void *vinfo -#else -(char *srname, void *vinfo -#endif +/** + * \brief XERBLA implementation linked in together with the CBLAS library. + * + * An error raised beneath a CBLAS wrapper is forwarded to cblas_xerbla() + * under the CBLAS spelling of the routine name, with the argument number + * shifted by one to account for the extra layout argument. Errors from + * direct Fortran calls are reported under the Fortran name instead. + * + * \param[in] F77_srname Routine name reported by the Fortran BLAS, blank + * padded and not NUL terminated. + * \param[in] vinfo Pointer to the Fortran argument number. + * \param[in] len Hidden Fortran length of \p F77_srname, on + * compilers that pass string lengths at the end of + * the argument list. + */ +void CBLAS_WEAK_SYMBOL F77_xerbla_base(FCHAR F77_srname, void *vinfo #ifdef BLAS_FORTRAN_STRLEN_END -, FORTRAN_STRLEN len + , + FORTRAN_STRLEN len #endif ) { -#ifdef F77_CHAR - char *srname; -#endif - - char rout[] = {'c','b','l','a','s','_','\0','\0','\0','\0','\0','\0','\0'}; - - int *info=vinfo; - int i; - extern int CBLAS_CallFromC; -#ifdef F77_CHAR - srname = F2C_STR(F77_srname, XerblaStrLen); +#ifdef BLAS_FORTRAN_STRLEN_END + const size_t srname_len = len > 0 ? (size_t)len : 0; +#else + const size_t srname_len = 6; #endif - if (CBLAS_CallFromC) - { - for(i=0; i != XerblaStrLen; i++) rout[i+6] = tolower(srname[i]); - rout[XerblaStrLen+6] = '\0'; - API_SUFFIX(cblas_xerbla)(*info+1,rout,""); - } - else - { - fprintf(stderr, "Parameter %d to routine %s was incorrect\n", - *info, srname); +#ifdef F77_CHAR + const char *srname = F2C_STR(F77_srname, srname_len); +#else + const char *srname = F77_srname; +#endif + + const F77_INT *info = (const F77_INT *)vinfo; + const CBLAS_INT cblas_info = (CBLAS_INT)*info; + + if (CBLAS_CallFromC) { + char rout[CBLAS_XERBLA_ROUT_BUFFER_SIZE]; + cblas_xerbla_make_rout(rout, sizeof(rout), srname, srname_len); + API_SUFFIX(cblas_xerbla)(cblas_info + 1, rout, ""); + } else { + const size_t display_len = + cblas_xerbla_trimmed_length(srname, srname_len); + + fprintf(stderr, "Parameter %" CBLAS_IFMT " to routine ", cblas_info); + if (display_len > 0) { + fwrite(srname, 1, display_len, stderr); + } + fputs(" was incorrect\n", stderr); } } diff --git a/CBLAS/testing/c_c2chke.c b/CBLAS/testing/c_c2chke.c index 507dbcf98..3a3651264 100644 --- a/CBLAS/testing/c_c2chke.c +++ b/CBLAS/testing/c_c2chke.c @@ -25,7 +25,7 @@ void chkxer(void) { extern char *cblas_rout; cblas_xtests++; if (cblas_lerr == 1 ) { - printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", (int) cblas_info, cblas_rout); + printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %" CBLAS_IFMT " NOT DETECTED BY %s *****\n", cblas_info, cblas_rout); cblas_ok = 0 ; cblas_xfails++; } else if (cblas_xbad) { @@ -835,14 +835,14 @@ void F77_c2chke(char *rout cblas_info = 6; RowMajorStrg = FALSE; API_SUFFIX(cblas_chpr)(CblasColMajor, CblasUpper, 0, RALPHA, X, 0, A ); chkxer(); - cblas_info = 2; RowMajorStrg = FALSE; - API_SUFFIX(cblas_chpr)(CblasColMajor, INVALID_UPLO, 0, RALPHA, X, 1, A ); + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_chpr)(CblasRowMajor, INVALID_UPLO, 0, RALPHA, X, 1, A ); chkxer(); - cblas_info = 3; RowMajorStrg = FALSE; - API_SUFFIX(cblas_chpr)(CblasColMajor, CblasUpper, INVALID, RALPHA, X, 1, A ); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_chpr)(CblasRowMajor, CblasUpper, INVALID, RALPHA, X, 1, A ); chkxer(); - cblas_info = 6; RowMajorStrg = FALSE; - API_SUFFIX(cblas_chpr)(CblasColMajor, CblasUpper, 0, RALPHA, X, 0, A ); + cblas_info = 6; RowMajorStrg = TRUE; + API_SUFFIX(cblas_chpr)(CblasRowMajor, CblasUpper, 0, RALPHA, X, 0, A ); chkxer(); } if (cblas_ok == TRUE) diff --git a/CBLAS/testing/c_c3chke.c b/CBLAS/testing/c_c3chke.c index 306dc1ce9..b146098e7 100644 --- a/CBLAS/testing/c_c3chke.c +++ b/CBLAS/testing/c_c3chke.c @@ -25,7 +25,7 @@ void chkxer(void) { extern char *cblas_rout; cblas_xtests++; if (cblas_lerr == 1 ) { - printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", (int) cblas_info, cblas_rout); + printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %" CBLAS_IFMT " NOT DETECTED BY %s *****\n", cblas_info, cblas_rout); cblas_ok = 0 ; cblas_xfails++; } else if (cblas_xbad) { @@ -221,6 +221,33 @@ void F77_c3chke(char * rout chkxer(); /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, INVALID_TRANSPOSE, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, INVALID_TRANSPOSE, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); @@ -273,15 +300,19 @@ void F77_c3chke(char * rout chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - API_SUFFIX(cblas_cgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2, - ALPHA, A, 1, B, 1, BETA, C, 1 ); + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - API_SUFFIX(cblas_cgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 11; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - API_SUFFIX(cblas_cgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); @@ -433,6 +464,23 @@ void F77_c3chke(char * rout API_SUFFIX(cblas_cgemm)( CblasColMajor, CblasTrans, CblasTrans, 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemm)( CblasRowMajor, INVALID_TRANSPOSE, CblasNoTrans, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemm)( CblasRowMajor, INVALID_TRANSPOSE, CblasTrans, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemm)( CblasRowMajor, CblasNoTrans, INVALID_TRANSPOSE, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemm)( CblasRowMajor, CblasTrans, INVALID_TRANSPOSE, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 4; RowMajorStrg = TRUE; API_SUFFIX(cblas_cgemm)( CblasRowMajor, CblasNoTrans, CblasNoTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); @@ -624,6 +672,15 @@ void F77_c3chke(char * rout API_SUFFIX(cblas_chemm)( CblasColMajor, CblasRight, CblasLower, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_chemm)( CblasRowMajor, INVALID_SIDE, CblasUpper, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_chemm)( CblasRowMajor, CblasLeft, INVALID_UPLO, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 4; RowMajorStrg = TRUE; API_SUFFIX(cblas_chemm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); @@ -800,6 +857,15 @@ void F77_c3chke(char * rout API_SUFFIX(cblas_csymm)( CblasColMajor, CblasRight, CblasLower, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csymm)( CblasRowMajor, INVALID_SIDE, CblasUpper, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csymm)( CblasRowMajor, CblasLeft, INVALID_UPLO, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 4; RowMajorStrg = TRUE; API_SUFFIX(cblas_csymm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); @@ -1032,6 +1098,23 @@ void F77_c3chke(char * rout API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, INVALID_SIDE, CblasUpper, CblasNoTrans, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasLeft, INVALID_UPLO, CblasNoTrans, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID_TRANSPOSE, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); cblas_info = 6; RowMajorStrg = TRUE; API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); @@ -1312,6 +1395,23 @@ void F77_c3chke(char * rout API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, INVALID_SIDE, CblasUpper, CblasNoTrans, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasLeft, INVALID_UPLO, CblasNoTrans, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID_TRANSPOSE, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); cblas_info = 6; RowMajorStrg = TRUE; API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); @@ -1488,6 +1588,47 @@ void F77_c3chke(char * rout API_SUFFIX(cblas_cherk)(CblasColMajor, CblasLower, CblasConjTrans, 0, INVALID, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cherk)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, 0, 0, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cherk)(CblasRowMajor, CblasUpper, CblasTrans, 0, 0, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cherk)(CblasRowMajor, CblasUpper, CblasNoTrans, INVALID, 0, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cherk)(CblasRowMajor, CblasUpper, CblasConjTrans, INVALID, 0, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cherk)(CblasRowMajor, CblasLower, CblasNoTrans, INVALID, 0, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cherk)(CblasRowMajor, CblasLower, CblasConjTrans, INVALID, 0, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cherk)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, INVALID, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cherk)(CblasRowMajor, CblasUpper, CblasConjTrans, 0, INVALID, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cherk)(CblasRowMajor, CblasLower, CblasNoTrans, 0, INVALID, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cherk)(CblasRowMajor, CblasLower, CblasConjTrans, 0, INVALID, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); cblas_info = 8; RowMajorStrg = TRUE; API_SUFFIX(cblas_cherk)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, RALPHA, A, 1, RBETA, C, 2 ); @@ -1600,6 +1741,47 @@ void F77_c3chke(char * rout API_SUFFIX(cblas_csyrk)(CblasColMajor, CblasLower, CblasTrans, 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyrk)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, 0, 0, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyrk)(CblasRowMajor, CblasUpper, CblasConjTrans, 0, 0, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyrk)(CblasRowMajor, CblasUpper, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyrk)(CblasRowMajor, CblasUpper, CblasTrans, INVALID, 0, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyrk)(CblasRowMajor, CblasLower, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyrk)(CblasRowMajor, CblasLower, CblasTrans, INVALID, 0, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyrk)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyrk)(CblasRowMajor, CblasUpper, CblasTrans, 0, INVALID, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyrk)(CblasRowMajor, CblasLower, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyrk)(CblasRowMajor, CblasLower, CblasTrans, 0, INVALID, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); cblas_info = 8; RowMajorStrg = TRUE; API_SUFFIX(cblas_csyrk)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, BETA, C, 2 ); @@ -1712,6 +1894,47 @@ void F77_c3chke(char * rout API_SUFFIX(cblas_cher2k)(CblasColMajor, CblasLower, CblasConjTrans, 0, INVALID, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cher2k)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cher2k)(CblasRowMajor, CblasUpper, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cher2k)(CblasRowMajor, CblasUpper, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cher2k)(CblasRowMajor, CblasUpper, CblasConjTrans, INVALID, 0, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cher2k)(CblasRowMajor, CblasLower, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cher2k)(CblasRowMajor, CblasLower, CblasConjTrans, INVALID, 0, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cher2k)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cher2k)(CblasRowMajor, CblasUpper, CblasConjTrans, 0, INVALID, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cher2k)(CblasRowMajor, CblasLower, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cher2k)(CblasRowMajor, CblasLower, CblasConjTrans, 0, INVALID, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); cblas_info = 8; RowMajorStrg = TRUE; API_SUFFIX(cblas_cher2k)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, B, 2, RBETA, C, 2 ); @@ -1856,6 +2079,47 @@ void F77_c3chke(char * rout API_SUFFIX(cblas_csyr2k)(CblasColMajor, CblasLower, CblasTrans, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, CblasUpper, CblasConjTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, CblasUpper, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, CblasUpper, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, CblasLower, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, CblasLower, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, CblasUpper, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, CblasLower, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, CblasLower, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 8; RowMajorStrg = TRUE; API_SUFFIX(cblas_csyr2k)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 2 ); diff --git a/CBLAS/testing/c_d2chke.c b/CBLAS/testing/c_d2chke.c index ff0088f4a..f251151b9 100644 --- a/CBLAS/testing/c_d2chke.c +++ b/CBLAS/testing/c_d2chke.c @@ -25,7 +25,7 @@ void chkxer(void) { extern char *cblas_rout; cblas_xtests++; if (cblas_lerr == 1 ) { - printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", (int) cblas_info, cblas_rout); + printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %" CBLAS_IFMT " NOT DETECTED BY %s *****\n", cblas_info, cblas_rout); cblas_ok = 0 ; cblas_xfails++; } else if (cblas_xbad) { @@ -880,14 +880,14 @@ void F77_d2chke(char *rout cblas_info = 6; RowMajorStrg = FALSE; API_SUFFIX(cblas_dspr)(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, A ); chkxer(); - cblas_info = 2; RowMajorStrg = FALSE; - API_SUFFIX(cblas_dspr)(CblasColMajor, INVALID_UPLO, 0, ALPHA, X, 1, A ); + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dspr)(CblasRowMajor, INVALID_UPLO, 0, ALPHA, X, 1, A ); chkxer(); - cblas_info = 3; RowMajorStrg = FALSE; - API_SUFFIX(cblas_dspr)(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, A ); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dspr)(CblasRowMajor, CblasUpper, INVALID, ALPHA, X, 1, A ); chkxer(); - cblas_info = 6; RowMajorStrg = FALSE; - API_SUFFIX(cblas_dspr)(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, A ); + cblas_info = 6; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dspr)(CblasRowMajor, CblasUpper, 0, ALPHA, X, 0, A ); chkxer(); } if (cblas_ok == TRUE) diff --git a/CBLAS/testing/c_d3chke.c b/CBLAS/testing/c_d3chke.c index 6e99caedf..441cd7813 100644 --- a/CBLAS/testing/c_d3chke.c +++ b/CBLAS/testing/c_d3chke.c @@ -25,7 +25,7 @@ void chkxer(void) { extern char *cblas_rout; cblas_xtests++; if (cblas_lerr == 1 ) { - printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", (int) cblas_info, cblas_rout); + printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %" CBLAS_IFMT " NOT DETECTED BY %s *****\n", cblas_info, cblas_rout); cblas_ok = 0 ; cblas_xfails++; } else if (cblas_xbad) { @@ -219,6 +219,33 @@ void F77_d3chke(char *rout chkxer(); /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, INVALID_TRANSPOSE, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, INVALID_TRANSPOSE, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); @@ -271,15 +298,19 @@ void F77_d3chke(char *rout chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - API_SUFFIX(cblas_dgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2, - ALPHA, A, 1, B, 1, BETA, C, 1 ); + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - API_SUFFIX(cblas_dgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 11; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - API_SUFFIX(cblas_dgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); @@ -431,6 +462,23 @@ void F77_d3chke(char *rout API_SUFFIX(cblas_dgemm)( CblasColMajor, CblasTrans, CblasTrans, 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemm)( CblasRowMajor, INVALID_TRANSPOSE, CblasNoTrans, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemm)( CblasRowMajor, INVALID_TRANSPOSE, CblasTrans, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemm)( CblasRowMajor, CblasNoTrans, INVALID_TRANSPOSE, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemm)( CblasRowMajor, CblasTrans, INVALID_TRANSPOSE, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 4; RowMajorStrg = TRUE; API_SUFFIX(cblas_dgemm)( CblasRowMajor, CblasNoTrans, CblasNoTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); @@ -623,6 +671,15 @@ void F77_d3chke(char *rout API_SUFFIX(cblas_dsymm)( CblasColMajor, CblasRight, CblasLower, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsymm)( CblasRowMajor, INVALID_SIDE, CblasUpper, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsymm)( CblasRowMajor, CblasLeft, INVALID_UPLO, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 4; RowMajorStrg = TRUE; API_SUFFIX(cblas_dsymm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); @@ -799,6 +856,15 @@ void F77_d3chke(char *rout API_SUFFIX(cblas_dskewsymm)( CblasColMajor, CblasRight, CblasLower, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dskewsymm)( CblasRowMajor, INVALID_SIDE, CblasUpper, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dskewsymm)( CblasRowMajor, CblasLeft, INVALID_UPLO, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 4; RowMajorStrg = TRUE; API_SUFFIX(cblas_dskewsymm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); @@ -1031,6 +1097,23 @@ void F77_d3chke(char *rout API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, INVALID_SIDE, CblasUpper, CblasNoTrans, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasLeft, INVALID_UPLO, CblasNoTrans, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID_TRANSPOSE, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); cblas_info = 6; RowMajorStrg = TRUE; API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); @@ -1312,6 +1395,23 @@ void F77_d3chke(char *rout CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, INVALID_SIDE, CblasUpper, CblasNoTrans, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasLeft, INVALID_UPLO, CblasNoTrans, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID_TRANSPOSE, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); cblas_info = 6; RowMajorStrg = TRUE; API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); @@ -1488,6 +1588,47 @@ void F77_d3chke(char *rout API_SUFFIX(cblas_dsyrk)( CblasColMajor, CblasLower, CblasTrans, 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyrk)( CblasRowMajor, INVALID_UPLO, CblasNoTrans, + 0, 0, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyrk)( CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, + 0, 0, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyrk)( CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID, 0, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyrk)( CblasRowMajor, CblasUpper, CblasTrans, + INVALID, 0, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyrk)( CblasRowMajor, CblasLower, CblasNoTrans, + INVALID, 0, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyrk)( CblasRowMajor, CblasLower, CblasTrans, + INVALID, 0, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyrk)( CblasRowMajor, CblasUpper, CblasNoTrans, + 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyrk)( CblasRowMajor, CblasUpper, CblasTrans, + 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyrk)( CblasRowMajor, CblasLower, CblasNoTrans, + 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyrk)( CblasRowMajor, CblasLower, CblasTrans, + 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); cblas_info = 8; RowMajorStrg = TRUE; API_SUFFIX(cblas_dsyrk)( CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, BETA, C, 2 ); @@ -1600,6 +1741,47 @@ void F77_d3chke(char *rout API_SUFFIX(cblas_dsyr2k)( CblasColMajor, CblasLower, CblasTrans, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, INVALID_UPLO, CblasNoTrans, + 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, + 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, CblasUpper, CblasTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, CblasLower, CblasNoTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, CblasLower, CblasTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, CblasUpper, CblasTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, CblasLower, CblasNoTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, CblasLower, CblasTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 8; RowMajorStrg = TRUE; API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 2 ); @@ -1743,6 +1925,47 @@ void F77_d3chke(char *rout API_SUFFIX(cblas_dskewsyr2k)( CblasColMajor, CblasLower, CblasTrans, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, INVALID_UPLO, CblasNoTrans, + 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, + 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, CblasUpper, CblasTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, CblasLower, CblasNoTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, CblasLower, CblasTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, CblasUpper, CblasTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, CblasLower, CblasNoTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, CblasLower, CblasTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 8; RowMajorStrg = TRUE; API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 2 ); diff --git a/CBLAS/testing/c_s2chke.c b/CBLAS/testing/c_s2chke.c index e54e5abd4..24158dac6 100644 --- a/CBLAS/testing/c_s2chke.c +++ b/CBLAS/testing/c_s2chke.c @@ -25,7 +25,7 @@ void chkxer(void) { extern char *cblas_rout; cblas_xtests++; if (cblas_lerr == 1 ) { - printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", (int) cblas_info, cblas_rout); + printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %" CBLAS_IFMT " NOT DETECTED BY %s *****\n", cblas_info, cblas_rout); cblas_ok = 0 ; cblas_xfails++; } else if (cblas_xbad) { @@ -880,14 +880,14 @@ void F77_s2chke(char *rout cblas_info = 6; RowMajorStrg = FALSE; API_SUFFIX(cblas_sspr)(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, A ); chkxer(); - cblas_info = 2; RowMajorStrg = FALSE; - API_SUFFIX(cblas_sspr)(CblasColMajor, INVALID_UPLO, 0, ALPHA, X, 1, A ); + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sspr)(CblasRowMajor, INVALID_UPLO, 0, ALPHA, X, 1, A ); chkxer(); - cblas_info = 3; RowMajorStrg = FALSE; - API_SUFFIX(cblas_sspr)(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, A ); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sspr)(CblasRowMajor, CblasUpper, INVALID, ALPHA, X, 1, A ); chkxer(); - cblas_info = 6; RowMajorStrg = FALSE; - API_SUFFIX(cblas_sspr)(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, A ); + cblas_info = 6; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sspr)(CblasRowMajor, CblasUpper, 0, ALPHA, X, 0, A ); chkxer(); } if (cblas_ok == TRUE) diff --git a/CBLAS/testing/c_s3chke.c b/CBLAS/testing/c_s3chke.c index 598029a68..7e3704fd7 100644 --- a/CBLAS/testing/c_s3chke.c +++ b/CBLAS/testing/c_s3chke.c @@ -25,7 +25,7 @@ void chkxer(void) { extern char *cblas_rout; cblas_xtests++; if (cblas_lerr == 1 ) { - printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", (int) cblas_info, cblas_rout); + printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %" CBLAS_IFMT " NOT DETECTED BY %s *****\n", cblas_info, cblas_rout); cblas_ok = 0 ; cblas_xfails++; } else if (cblas_xbad) { @@ -220,6 +220,33 @@ void F77_s3chke(char *rout chkxer(); /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, INVALID_TRANSPOSE, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, INVALID_TRANSPOSE, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); @@ -272,15 +299,19 @@ void F77_s3chke(char *rout chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - API_SUFFIX(cblas_sgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2, - ALPHA, A, 1, B, 1, BETA, C, 1 ); + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - API_SUFFIX(cblas_sgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 11; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - API_SUFFIX(cblas_sgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); @@ -432,6 +463,23 @@ void F77_s3chke(char *rout ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemm)( CblasRowMajor, INVALID_TRANSPOSE, CblasNoTrans, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemm)( CblasRowMajor, INVALID_TRANSPOSE, CblasTrans, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemm)( CblasRowMajor, CblasNoTrans, INVALID_TRANSPOSE, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemm)( CblasRowMajor, CblasTrans, INVALID_TRANSPOSE, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 4; RowMajorStrg = TRUE; API_SUFFIX(cblas_sgemm)( CblasRowMajor, CblasNoTrans, CblasNoTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); @@ -625,6 +673,15 @@ void F77_s3chke(char *rout ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssymm)( CblasRowMajor, INVALID_SIDE, CblasUpper, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssymm)( CblasRowMajor, CblasLeft, INVALID_UPLO, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 4; RowMajorStrg = TRUE; API_SUFFIX(cblas_ssymm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); @@ -802,6 +859,15 @@ void F77_s3chke(char *rout ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sskewsymm)( CblasRowMajor, INVALID_SIDE, CblasUpper, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sskewsymm)( CblasRowMajor, CblasLeft, INVALID_UPLO, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 4; RowMajorStrg = TRUE; API_SUFFIX(cblas_sskewsymm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); @@ -1035,6 +1101,23 @@ void F77_s3chke(char *rout CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_strmm)( CblasRowMajor, INVALID_SIDE, CblasUpper, CblasNoTrans, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasLeft, INVALID_UPLO, CblasNoTrans, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID_TRANSPOSE, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); cblas_info = 6; RowMajorStrg = TRUE; API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); @@ -1316,6 +1399,23 @@ void F77_s3chke(char *rout CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_strsm)( CblasRowMajor, INVALID_SIDE, CblasUpper, CblasNoTrans, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasLeft, INVALID_UPLO, CblasNoTrans, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID_TRANSPOSE, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); cblas_info = 6; RowMajorStrg = TRUE; API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); @@ -1492,6 +1592,48 @@ void F77_s3chke(char *rout API_SUFFIX(cblas_ssyrk)( CblasColMajor, CblasLower, CblasTrans, 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); chkxer(); + + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyrk)( CblasRowMajor, INVALID_UPLO, CblasNoTrans, + 0, 0, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyrk)( CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, + 0, 0, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyrk)( CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID, 0, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyrk)( CblasRowMajor, CblasUpper, CblasTrans, + INVALID, 0, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyrk)( CblasRowMajor, CblasLower, CblasNoTrans, + INVALID, 0, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyrk)( CblasRowMajor, CblasLower, CblasTrans, + INVALID, 0, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyrk)( CblasRowMajor, CblasUpper, CblasNoTrans, + 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyrk)( CblasRowMajor, CblasUpper, CblasTrans, + 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyrk)( CblasRowMajor, CblasLower, CblasNoTrans, + 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyrk)( CblasRowMajor, CblasLower, CblasTrans, + 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); cblas_info = 8; RowMajorStrg = TRUE; API_SUFFIX(cblas_ssyrk)( CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, BETA, C, 2 ); @@ -1604,6 +1746,48 @@ void F77_s3chke(char *rout API_SUFFIX(cblas_ssyr2k)( CblasColMajor, CblasLower, CblasTrans, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); + + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, INVALID_UPLO, CblasNoTrans, + 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, + 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, CblasUpper, CblasTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, CblasLower, CblasNoTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, CblasLower, CblasTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, CblasUpper, CblasTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, CblasLower, CblasNoTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, CblasLower, CblasTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 8; RowMajorStrg = TRUE; API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 2 ); @@ -1747,6 +1931,48 @@ void F77_s3chke(char *rout API_SUFFIX(cblas_sskewsyr2k)( CblasColMajor, CblasLower, CblasTrans, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); + + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, INVALID_UPLO, CblasNoTrans, + 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, + 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, CblasUpper, CblasTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, CblasLower, CblasNoTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, CblasLower, CblasTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, CblasUpper, CblasTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, CblasLower, CblasNoTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, CblasLower, CblasTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 8; RowMajorStrg = TRUE; API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 2 ); diff --git a/CBLAS/testing/c_xerbla.c b/CBLAS/testing/c_xerbla.c index 14a385215..ea9d8cb6b 100644 --- a/CBLAS/testing/c_xerbla.c +++ b/CBLAS/testing/c_xerbla.c @@ -1,17 +1,33 @@ -#include #include #include +#include #include + #include "cblas.h" #include "cblas_test.h" +#include "cblas_xerbla_internal.h" -void API_SUFFIX(cblas_xerbla)(CBLAS_INT info, const char *rout, const char *form, ...) +/** + * \brief Test-harness stand-in for the CBLAS error handler. + * + * Rather than terminating, checks the reported routine name and argument + * number against the values the calling tester put in cblas_rout and + * cblas_info, and records the outcome in cblas_ok and cblas_lerr. + * + * \param[in] info CBLAS argument number reported by the caller. + * \param[in] rout Routine name, e.g. "cblas_dgemm". + * \param[in] form Unused; kept so the signature matches the library's. + */ +void API_SUFFIX(cblas_xerbla)(CBLAS_INT info, const char *rout, + const char *form, ...) { extern CBLAS_INT cblas_lerr, cblas_info, cblas_ok; extern CBLAS_INT link_xerbla; extern CBLAS_INT cblas_xbad; extern char *cblas_rout; + (void)form; + /* Initially, c__3chke may call this routine with * global variable link_xerbla=1, and F77_xerbla will set link_xerbla=0. * This is done to fool the linker into loading these subroutines first @@ -19,121 +35,76 @@ void API_SUFFIX(cblas_xerbla)(CBLAS_INT info, const char *rout, const char *form */ if (link_xerbla) return; - if (cblas_rout != NULL && strcmp(cblas_rout, rout) != 0){ - printf("***** XERBLA WAS CALLED WITH SRNAME = <%s> INSTEAD OF <%s> *******\n", rout, cblas_rout); + /* The name is checked and reported as the user would see it, suffix and + * all, while the remapping below keys off the unsuffixed \p rout. + */ + char reported[CBLAS_XERBLA_ROUT_BUFFER_SIZE]; + cblas_xerbla_apply_api_suffix(reported, sizeof(reported), rout); + + if (cblas_rout != NULL && strcmp(cblas_rout, reported) != 0) { + printf( + "***** XERBLA WAS CALLED WITH SRNAME = <%s> INSTEAD OF <%s> *******\n", + reported, cblas_rout); cblas_ok = FALSE; cblas_xbad = 1; } - if (RowMajorStrg) - { - /* To properly check leading dimension problems in cblas__gemm, we - * need to do the following trick. When cblas__gemm is called with - * CblasRowMajor, the arguments A and B switch places in the call to - * f77__gemm. Thus when we test for bad leading dimension problems - * for A and B, lda is in position 11 instead of 9, and ldb is in - * position 9 instead of 11. - */ - if (strstr(rout,"gemm") != 0 && strstr(rout, "gemmtr") == 0) - { - if (info == 5 ) info = 4; - else if (info == 4 ) info = 5; - else if (info == 11) info = 9; - else if (info == 9 ) info = 11; - } else if (strstr(rout, "gemmtr") != 0) - { - if (info == 11) info = 9; - else if (info == 9 ) info = 11; - } + info = cblas_xerbla_map_info(info, rout, RowMajorStrg); - else if (strstr(rout,"symm") != 0 || strstr(rout,"skewsymm") != 0 || strstr(rout,"hemm") != 0) - { - if (info == 5 ) info = 4; - else if (info == 4 ) info = 5; - } - else if (strstr(rout,"trmm") != 0 || strstr(rout,"trsm") != 0) - { - if (info == 7 ) info = 6; - else if (info == 6 ) info = 7; - } - else if (strstr(rout,"gemv") != 0) - { - if (info == 4) info = 3; - else if (info == 3) info = 4; - } - else if (strstr(rout,"gbmv") != 0) - { - if (info == 4) info = 3; - else if (info == 3) info = 4; - else if (info == 6) info = 5; - else if (info == 5) info = 6; - } - else if (strstr(rout,"ger") != 0) - { - if (info == 3) info = 2; - else if (info == 2) info = 3; - else if (info == 8) info = 6; - else if (info == 6) info = 8; - } - else if ( ( strstr(rout,"her2") != 0 || strstr(rout,"hpr2") != 0 ) - && strstr(rout,"her2k") == 0 ) - { - if (info == 8) info = 6; - else if (info == 6) info = 8; - } - } - - if (info != cblas_info){ - printf("***** XERBLA WAS CALLED WITH INFO = %" CBLAS_IFMT " INSTEAD OF %d in %s *******\n",info, (int) cblas_info, rout); + if (info != cblas_info) { + printf("***** XERBLA WAS CALLED WITH INFO = %" CBLAS_IFMT + " INSTEAD OF %" CBLAS_IFMT " in %s *******\n", + info, cblas_info, reported); cblas_lerr = PASSED; cblas_ok = FALSE; - } else cblas_lerr = FAILED; + } else { + cblas_lerr = FAILED; + } } -#ifdef F77_Char -void F77_xerbla(F77_Char F77_srname, void *vinfo -#else -void F77_xerbla(char *srname, void *vinfo -#endif +/** + * \brief Test-harness XERBLA that redirects Fortran errors to cblas_xerbla(). + * + * \param[in] F77_srname Routine name reported by the Fortran BLAS, blank + * padded and not NUL terminated. + * \param[in] vinfo Pointer to the Fortran argument number. + * \param[in] len Hidden Fortran length of \p F77_srname, on + * compilers that pass string lengths at the end. + */ +void F77_xerbla(FCHAR F77_srname, void *vinfo #ifdef BLAS_FORTRAN_STRLEN_END -, FORTRAN_STRLEN srname_len + , + FORTRAN_STRLEN len #endif ) { -#ifdef F77_Char - char *srname; -#endif - - char rout[] = {'c','b','l','a','s','_','\0','\0','\0','\0','\0','\0','\0', '\0', '\0', '\0', '\0', '\0'}; - -#ifdef F77_Integer - F77_Integer *info=vinfo; - F77_Integer i; - extern F77_Integer link_xerbla; -#else - CBLAS_INT *info=vinfo; - CBLAS_INT i; - extern CBLAS_INT link_xerbla; -#endif -#ifdef F77_Char - srname = F2C_STR(F77_srname, XerblaStrLen); -#endif - /* See the comment in API_SUFFIX(cblas_xerbla)() above */ - if (link_xerbla) - { + extern CBLAS_INT link_xerbla; + if (link_xerbla) { link_xerbla = 0; return; } -#ifndef BLAS_FORTRAN_STRLEN_END - const int srname_len = 6; + +#ifdef BLAS_FORTRAN_STRLEN_END + const size_t srname_len = len > 0 ? (size_t)len : 0; +#else + const size_t srname_len = 6; #endif - for(i=0; i < srname_len; i++) rout[i+6] = tolower(srname[i]); - for(i=16; i >= 9; i--) if (rout[i] == ' ') rout[i] = '\0'; +#ifdef F77_CHAR + const char *srname = F2C_STR(F77_srname, srname_len); +#else + const char *srname = F77_srname; +#endif + + const F77_INT *info = (const F77_INT *)vinfo; + const CBLAS_INT cblas_info = (CBLAS_INT)*info; + + char rout[CBLAS_XERBLA_ROUT_BUFFER_SIZE]; + cblas_xerbla_make_rout(rout, sizeof(rout), srname, srname_len); /* We increment *info by 1 since the CBLAS interface adds one more * argument to all level 2 and 3 routines. */ - API_SUFFIX(cblas_xerbla)(*info+1,rout,""); + API_SUFFIX(cblas_xerbla)(cblas_info + 1, rout, ""); } diff --git a/CBLAS/testing/c_z2chke.c b/CBLAS/testing/c_z2chke.c index 1f9c3e4c7..fd2bd6b02 100644 --- a/CBLAS/testing/c_z2chke.c +++ b/CBLAS/testing/c_z2chke.c @@ -25,7 +25,7 @@ void chkxer(void) { extern char *cblas_rout; cblas_xtests++; if (cblas_lerr == 1 ) { - printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", (int) cblas_info, cblas_rout); + printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %" CBLAS_IFMT " NOT DETECTED BY %s *****\n", cblas_info, cblas_rout); cblas_ok = 0 ; cblas_xfails++; } else if (cblas_xbad) { @@ -836,14 +836,14 @@ void F77_z2chke(char *rout cblas_info = 6; RowMajorStrg = FALSE; API_SUFFIX(cblas_zhpr)(CblasColMajor, CblasUpper, 0, RALPHA, X, 0, A ); chkxer(); - cblas_info = 2; RowMajorStrg = FALSE; - API_SUFFIX(cblas_zhpr)(CblasColMajor, INVALID_UPLO, 0, RALPHA, X, 1, A ); + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zhpr)(CblasRowMajor, INVALID_UPLO, 0, RALPHA, X, 1, A ); chkxer(); - cblas_info = 3; RowMajorStrg = FALSE; - API_SUFFIX(cblas_zhpr)(CblasColMajor, CblasUpper, INVALID, RALPHA, X, 1, A ); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zhpr)(CblasRowMajor, CblasUpper, INVALID, RALPHA, X, 1, A ); chkxer(); - cblas_info = 6; RowMajorStrg = FALSE; - API_SUFFIX(cblas_zhpr)(CblasColMajor, CblasUpper, 0, RALPHA, X, 0, A ); + cblas_info = 6; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zhpr)(CblasRowMajor, CblasUpper, 0, RALPHA, X, 0, A ); chkxer(); } if (cblas_ok == TRUE) diff --git a/CBLAS/testing/c_z3chke.c b/CBLAS/testing/c_z3chke.c index c97d8930d..0a1037bbe 100644 --- a/CBLAS/testing/c_z3chke.c +++ b/CBLAS/testing/c_z3chke.c @@ -25,7 +25,7 @@ void chkxer(void) { extern char *cblas_rout; cblas_xtests++; if (cblas_lerr == 1 ) { - printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", (int) cblas_info, cblas_rout); + printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %" CBLAS_IFMT " NOT DETECTED BY %s *****\n", cblas_info, cblas_rout); cblas_ok = 0 ; cblas_xfails++; } else if (cblas_xbad) { @@ -221,6 +221,33 @@ void F77_z3chke(char *rout chkxer(); /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, INVALID_TRANSPOSE, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, INVALID_TRANSPOSE, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); @@ -273,15 +300,19 @@ void F77_z3chke(char *rout chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - API_SUFFIX(cblas_zgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2, - ALPHA, A, 1, B, 1, BETA, C, 1 ); + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - API_SUFFIX(cblas_zgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 11; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - API_SUFFIX(cblas_zgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); @@ -433,6 +464,23 @@ void F77_z3chke(char *rout API_SUFFIX(cblas_zgemm)( CblasColMajor, CblasTrans, CblasTrans, 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemm)( CblasRowMajor, INVALID_TRANSPOSE, CblasNoTrans, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemm)( CblasRowMajor, INVALID_TRANSPOSE, CblasTrans, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemm)( CblasRowMajor, CblasNoTrans, INVALID_TRANSPOSE, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemm)( CblasRowMajor, CblasTrans, INVALID_TRANSPOSE, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 4; RowMajorStrg = TRUE; API_SUFFIX(cblas_zgemm)( CblasRowMajor, CblasNoTrans, CblasNoTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); @@ -625,6 +673,15 @@ void F77_z3chke(char *rout API_SUFFIX(cblas_zhemm)( CblasColMajor, CblasRight, CblasLower, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zhemm)( CblasRowMajor, INVALID_SIDE, CblasUpper, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zhemm)( CblasRowMajor, CblasLeft, INVALID_UPLO, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 4; RowMajorStrg = TRUE; API_SUFFIX(cblas_zhemm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); @@ -801,6 +858,15 @@ void F77_z3chke(char *rout API_SUFFIX(cblas_zsymm)( CblasColMajor, CblasRight, CblasLower, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsymm)( CblasRowMajor, INVALID_SIDE, CblasUpper, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsymm)( CblasRowMajor, CblasLeft, INVALID_UPLO, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 4; RowMajorStrg = TRUE; API_SUFFIX(cblas_zsymm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); @@ -1033,6 +1099,23 @@ void F77_z3chke(char *rout API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, INVALID_SIDE, CblasUpper, CblasNoTrans, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasLeft, INVALID_UPLO, CblasNoTrans, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID_TRANSPOSE, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); cblas_info = 6; RowMajorStrg = TRUE; API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); @@ -1313,6 +1396,23 @@ void F77_z3chke(char *rout API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, INVALID_SIDE, CblasUpper, CblasNoTrans, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasLeft, INVALID_UPLO, CblasNoTrans, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID_TRANSPOSE, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); cblas_info = 6; RowMajorStrg = TRUE; API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); @@ -1489,6 +1589,47 @@ void F77_z3chke(char *rout API_SUFFIX(cblas_zherk)(CblasColMajor, CblasLower, CblasConjTrans, 0, INVALID, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zherk)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, 0, 0, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zherk)(CblasRowMajor, CblasUpper, CblasTrans, 0, 0, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zherk)(CblasRowMajor, CblasUpper, CblasNoTrans, INVALID, 0, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zherk)(CblasRowMajor, CblasUpper, CblasConjTrans, INVALID, 0, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zherk)(CblasRowMajor, CblasLower, CblasNoTrans, INVALID, 0, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zherk)(CblasRowMajor, CblasLower, CblasConjTrans, INVALID, 0, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zherk)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, INVALID, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zherk)(CblasRowMajor, CblasUpper, CblasConjTrans, 0, INVALID, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zherk)(CblasRowMajor, CblasLower, CblasNoTrans, 0, INVALID, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zherk)(CblasRowMajor, CblasLower, CblasConjTrans, 0, INVALID, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); cblas_info = 8; RowMajorStrg = TRUE; API_SUFFIX(cblas_zherk)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, RALPHA, A, 1, RBETA, C, 2 ); @@ -1601,6 +1742,47 @@ void F77_z3chke(char *rout API_SUFFIX(cblas_zsyrk)(CblasColMajor, CblasLower, CblasTrans, 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyrk)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, 0, 0, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyrk)(CblasRowMajor, CblasUpper, CblasConjTrans, 0, 0, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyrk)(CblasRowMajor, CblasUpper, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyrk)(CblasRowMajor, CblasUpper, CblasTrans, INVALID, 0, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyrk)(CblasRowMajor, CblasLower, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyrk)(CblasRowMajor, CblasLower, CblasTrans, INVALID, 0, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyrk)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyrk)(CblasRowMajor, CblasUpper, CblasTrans, 0, INVALID, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyrk)(CblasRowMajor, CblasLower, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyrk)(CblasRowMajor, CblasLower, CblasTrans, 0, INVALID, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); cblas_info = 8; RowMajorStrg = TRUE; API_SUFFIX(cblas_zsyrk)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, BETA, C, 2 ); @@ -1713,6 +1895,47 @@ void F77_z3chke(char *rout API_SUFFIX(cblas_zher2k)(CblasColMajor, CblasLower, CblasConjTrans, 0, INVALID, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zher2k)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zher2k)(CblasRowMajor, CblasUpper, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zher2k)(CblasRowMajor, CblasUpper, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zher2k)(CblasRowMajor, CblasUpper, CblasConjTrans, INVALID, 0, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zher2k)(CblasRowMajor, CblasLower, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zher2k)(CblasRowMajor, CblasLower, CblasConjTrans, INVALID, 0, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zher2k)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zher2k)(CblasRowMajor, CblasUpper, CblasConjTrans, 0, INVALID, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zher2k)(CblasRowMajor, CblasLower, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zher2k)(CblasRowMajor, CblasLower, CblasConjTrans, 0, INVALID, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); cblas_info = 8; RowMajorStrg = TRUE; API_SUFFIX(cblas_zher2k)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, B, 2, RBETA, C, 2 ); @@ -1857,6 +2080,47 @@ void F77_z3chke(char *rout API_SUFFIX(cblas_zsyr2k)(CblasColMajor, CblasLower, CblasTrans, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, CblasUpper, CblasConjTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, CblasUpper, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, CblasUpper, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, CblasLower, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, CblasLower, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, CblasUpper, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, CblasLower, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, CblasLower, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 8; RowMajorStrg = TRUE; API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 2 ); diff --git a/TESTING/EIG/dchkbl.f b/TESTING/EIG/dchkbl.f index bfa4d0f62..4cf312317 100644 --- a/TESTING/EIG/dchkbl.f +++ b/TESTING/EIG/dchkbl.f @@ -133,7 +133,7 @@ * DO 50 I = 1, N DO 40 J = 1, N - TEMP = MAX( A( I, J ), AIN( I, J ) ) + TEMP = MAX( ABS( A( I, J ) ), ABS( AIN( I, J ) ) ) TEMP = MAX( TEMP, SFMIN ) VMAX = MAX( VMAX, ABS( A( I, J )-AIN( I, J ) ) / TEMP ) 40 CONTINUE diff --git a/TESTING/EIG/schkbl.f b/TESTING/EIG/schkbl.f index ba8356477..8a43a1dc0 100644 --- a/TESTING/EIG/schkbl.f +++ b/TESTING/EIG/schkbl.f @@ -133,7 +133,7 @@ * DO 50 I = 1, N DO 40 J = 1, N - TEMP = MAX( A( I, J ), AIN( I, J ) ) + TEMP = MAX( ABS( A( I, J ) ), ABS( AIN( I, J ) ) ) TEMP = MAX( TEMP, SFMIN ) VMAX = MAX( VMAX, ABS( A( I, J )-AIN( I, J ) ) / TEMP ) 40 CONTINUE