diff --git a/.appveyor.yml b/.appveyor.yml new file mode 100644 index 0000000000..21260c3b0d --- /dev/null +++ b/.appveyor.yml @@ -0,0 +1,42 @@ +image: +- Visual Studio 2017 + +configuration: Release +clone_depth: 3 + +matrix: + fast_finish: false + +skip_commits: +# Add [av skip] to commit messages + message: /\[av skip\]/ + +environment: + global: + CONDA_INSTALL_LOCN: C:\\Miniconda37-x64 + CTEST_OUTPUT_ON_FAILURE: 1 + matrix: + - BUILD_DEFAULT_API: "ON" + BUILD_INDEX64_EXT_API: "OFF" + - BUILD_DEFAULT_API: "OFF" + BUILD_INDEX64_EXT_API: "ON" + +install: + - call %CONDA_INSTALL_LOCN%\Scripts\activate.bat +# - conda config --set auto_update_conda false + - conda install -c conda-forge --yes --quiet flang flang-rt_win-64 cmake ninja + - call "C:\Program Files (x86)\Microsoft Visual Studio\2017\Community\VC\Auxiliary\Build\vcvarsall.bat" amd64 + - set "LIB=%CONDA_INSTALL_LOCN%\Library\lib;%LIB%" + - set "CPATH=%CONDA_INSTALL_LOCN%\Library\include;%CPATH%" + +before_build: + - ps: if (-Not (Test-Path .\build)) { mkdir build } + - cd build + - cmake -G "Ninja" -DCMAKE_Fortran_COMPILER=flang -DCMAKE_BUILD_TYPE=Release -DBUILD_TESTING=ON -DCBLAS=ON -DLAPACKE=ON -DLAPACKE_WITH_TMG=ON -DBUILD_DEFAULT_API=%BUILD_DEFAULT_API% -DBUILD_INDEX64_EXT_API=%BUILD_INDEX64_EXT_API% .. +# - cmake -G "NMake Makefiles JOM" -DCMAKE_Fortran_COMPILER=flang -DCMAKE_BUILD_TYPE=Release -DBUILD_TESTING=ON .. + +build_script: + - cmake --build . + +test_script: + - ctest -j2 --output-on-failure diff --git a/.github/ISSUE_TEMPLATE/bug_report.md b/.github/ISSUE_TEMPLATE/bug_report.md new file mode 100644 index 0000000000..d6e526d806 --- /dev/null +++ b/.github/ISSUE_TEMPLATE/bug_report.md @@ -0,0 +1,14 @@ +--- +name: Bug report +about: Create a report to help us improve +title: '' +labels: 'Type: Bug' +assignees: '' + +--- +**Description** + +**Checklist** + +- [ ] I've included a minimal example to reproduce the issue +- [ ] I'd be willing to make a PR to solve this issue \ No newline at end of file diff --git a/.github/ISSUE_TEMPLATE/feature_request.md b/.github/ISSUE_TEMPLATE/feature_request.md new file mode 100644 index 0000000000..5a2b3b4a28 --- /dev/null +++ b/.github/ISSUE_TEMPLATE/feature_request.md @@ -0,0 +1,8 @@ +--- +name: Feature request +about: Request a feature +title: '' +labels: 'Type: Feature request' +assignees: '' + +--- \ No newline at end of file diff --git a/.github/ISSUE_TEMPLATE/help_wanted.md b/.github/ISSUE_TEMPLATE/help_wanted.md new file mode 100644 index 0000000000..c575127f1c --- /dev/null +++ b/.github/ISSUE_TEMPLATE/help_wanted.md @@ -0,0 +1,8 @@ +--- +name: Question +about: Ask a question related to the use of the package +title: '' +labels: 'Type: Question' +assignees: '' + +--- \ No newline at end of file diff --git a/.github/PULL_REQUEST_TEMPLATE.md b/.github/PULL_REQUEST_TEMPLATE.md new file mode 100644 index 0000000000..073bc486e2 --- /dev/null +++ b/.github/PULL_REQUEST_TEMPLATE.md @@ -0,0 +1,6 @@ +**Description** + +**Checklist** + +- [ ] The documentation has been updated. +- [ ] If the PR solves a specific issue, it is set to be closed on merge. \ No newline at end of file diff --git a/.github/SECURITY.md b/.github/SECURITY.md new file mode 100644 index 0000000000..b5b57624a7 --- /dev/null +++ b/.github/SECURITY.md @@ -0,0 +1,13 @@ +# Security Policy + +## Supported Versions + +Security updates are applied only to the latest release. + +## Reporting a Vulnerability + +If you have discovered a security vulnerability in this project, please report it privately. **Do not disclose it as a public issue.** This gives us time to work with you to fix the issue before public exposure, reducing the chance that the exploit will be used before a patch is released. + +Please disclose it at [security advisory](https://github.com/Reference-LAPACK/lapack/security/advisories/new). + +This project is maintained by a team of volunteers on a reasonable-effort basis. As such, please give us at least 90 days to work on a fix before public exposure. diff --git a/.github/julia/build_tarballs.jl b/.github/julia/build_tarballs.jl new file mode 100644 index 0000000000..1a003ce345 --- /dev/null +++ b/.github/julia/build_tarballs.jl @@ -0,0 +1,65 @@ +using BinaryBuilder, Pkg + +haskey(ENV, "BLAS_LAPACK_RELEASE") || error("The environment variable BLAS_LAPACK_RELEASE is not defined.") +haskey(ENV, "BLAS_LAPACK_COMMIT") || error("The environment variable BLAS_LAPACK_COMMIT is not defined.") +haskey(ENV, "BLAS_LAPACK_URL") || error("The environment variable BLAS_LAPACK_URL is not defined.") + +name = "blas_lapack" +version = VersionNumber(ENV["BLAS_LAPACK_RELEASE"]) + +# Collection of sources required to complete build +sources = [ + GitSource(ENV["BLAS_LAPACK_URL"], ENV["BLAS_LAPACK_COMMIT"]) +] + +# Bash recipe for building across all platforms +script = raw""" +cd ${WORKSPACE}/srcdir/lapack + +# FortranCInterface_VERIFY fails on macOS, but it's not actually needed for the current build +sed -i 's/FortranCInterface_VERIFY/# FortranCInterface_VERIFY/g' ./CBLAS/CMakeLists.txt +sed -i 's/FortranCInterface_VERIFY/# FortranCInterface_VERIFY/g' ./LAPACKE/include/CMakeLists.txt + +mkdir build && cd build +cmake .. \ + -DCBLAS=ON \ + -DLAPACKE=ON \ + -DCMAKE_INSTALL_PREFIX="$prefix" \ + -DCMAKE_FIND_ROOT_PATH="$prefix" \ + -DCMAKE_TOOLCHAIN_FILE="${CMAKE_TARGET_TOOLCHAIN}" \ + -DCMAKE_BUILD_TYPE=Release \ + -DBUILD_SHARED_LIBS=OFF \ + -DBUILD_INDEX64_EXT_API=OFF \ + -DTEST_FORTRAN_COMPILER=OFF \ + -DLAPACKE_WITH_TMG=OFF + +make -j${nproc} +make install + +install_license $WORKSPACE/srcdir/lapack/LICENSE +""" + +# These are the platforms we will build for by default, unless further +# platforms are passed in on the command line +platforms = supported_platforms() +platforms = expand_gfortran_versions(platforms) + +# The products that we will ensure are always built +products = [ + FileProduct("lib/libblas.a", :libblas_a), + FileProduct("lib/libcblas.a", :libcblas_a), + FileProduct("lib/liblapack.a", :liblapack_a), + FileProduct("lib/liblapacke.a", :liblapacke_a), + # LibraryProduct("libblas", :libblas), + # LibraryProduct("libcblas", :libcblas), + # LibraryProduct("liblapack", :liblapack), + # LibraryProduct("liblapacke", :liblapacke), +] + +# Dependencies that must be installed before this package can be built +dependencies = [ + Dependency(PackageSpec(name="CompilerSupportLibraries_jll", uuid="e66e0078-7015-5450-92f7-15fbd957f2ae")), +] + +# Build the tarballs, and possibly a `build.jl` as well. +build_tarballs(ARGS, name, version, sources, script, platforms, products, dependencies; julia_compat="1.6") diff --git a/.github/julia/generate_binaries.jl b/.github/julia/generate_binaries.jl new file mode 100644 index 0000000000..4ecb643a3a --- /dev/null +++ b/.github/julia/generate_binaries.jl @@ -0,0 +1,90 @@ +# Version +haskey(ENV, "BLAS_LAPACK_RELEASE") || error("The environment variable BLAS_LAPACK_RELEASE is not defined.") +version = VersionNumber(ENV["BLAS_LAPACK_RELEASE"]) +version2 = ENV["BLAS_LAPACK_RELEASE"] +package = "blas_lapack" + +platforms = [ + ("aarch64-apple-darwin-libgfortran5" , "lib", "dylib"), +# ("aarch64-linux-gnu-libgfortran3" , "lib", "so" ), +# ("aarch64-linux-gnu-libgfortran4" , "lib", "so" ), + ("aarch64-linux-gnu-libgfortran5" , "lib", "so" ), +# ("aarch64-linux-musl-libgfortran3" , "lib", "so" ), +# ("aarch64-linux-musl-libgfortran4" , "lib", "so" ), +# ("aarch64-linux-musl-libgfortran5" , "lib", "so" ), +# ("powerpc64le-linux-gnu-libgfortran3" , "lib", "so" ), +# ("powerpc64le-linux-gnu-libgfortran4" , "lib", "so" ), +# ("powerpc64le-linux-gnu-libgfortran5" , "lib", "so" ), +# ("x86_64-apple-darwin-libgfortran3" , "lib", "dylib"), +# ("x86_64-apple-darwin-libgfortran4" , "lib", "dylib"), + ("x86_64-apple-darwin-libgfortran5" , "lib", "dylib"), +# ("x86_64-linux-gnu-libgfortran3" , "lib", "so" ), +# ("x86_64-linux-gnu-libgfortran4" , "lib", "so" ), + ("x86_64-linux-gnu-libgfortran5" , "lib", "so" ), +# ("x86_64-linux-musl-libgfortran3" , "lib", "so" ), +# ("x86_64-linux-musl-libgfortran4" , "lib", "so" ), +# ("x86_64-linux-musl-libgfortran5" , "lib", "so" ), +# ("x86_64-unknown-freebsd-libgfortran3", "lib", "so" ), +# ("x86_64-unknown-freebsd-libgfortran4", "lib", "so" ), +# ("x86_64-unknown-freebsd-libgfortran5", "lib", "so" ), +# ("x86_64-w64-mingw32-libgfortran3" , "bin", "dll" ), +# ("x86_64-w64-mingw32-libgfortran4" , "bin", "dll" ), + ("x86_64-w64-mingw32-libgfortran5" , "bin", "dll" ), +] + + +for (platform, libdir, ext) in platforms + + tarball_name = "$package.v$version.$platform.tar.gz" + + if isfile("products/$(tarball_name)") + # Unzip the tarball generated by BinaryBuilder.jl + isdir("products/$platform") && rm("products/$platform", recursive=true) + mkdir("products/$platform") + run(`tar -xzf products/$(tarball_name) -C products/$platform`) + + if isfile("products/$platform/deps.tar.gz") + # Unzip the tarball of the dependencies + run(`tar -xzf products/$platform/deps.tar.gz -C products/$platform`) + + # Copy the license of each dependency + for folder in readdir("products/$platform/deps/licenses") + cp("products/$platform/deps/licenses/$folder", "products/$platform/share/licenses/$folder") + end + rm("products/$platform/deps/licenses", recursive=true) + + # Copy the shared library of each dependency + for file in readdir("products/$platform/deps") + cp("products/$platform/deps/$file", "products/$platform/$libdir/$file") + end + + # Remove the folder used to unzip the tarball of the dependencies + rm("products/$platform/deps", recursive=true) + rm("products/$platform/deps.tar.gz", recursive=true) + end + + # Create the archives *_binaries + isfile("$(package)_binaries.$version2.$platform.tar.gz") && rm("$(package)_binaries.$version2.$platform.tar.gz") + isfile("$(package)_binaries.$version2.$platform.zip") && rm("$(package)_binaries.$version2.$platform.zip") + cd("products/$platform") + + # Create a folder with the version number of the package + mkdir("$(package)_binaries.$version2") + for folder in ("include", "share", "lib") + cp(folder, "$(package)_binaries.$version2/$folder") + end + + cd("$(package)_binaries.$version2") + if ext == "dll" + run(`zip -r --symlinks ../../../$(package)_binaries.$version2.$platform.zip include share lib`) + else + run(`tar -czf ../../../$(package)_binaries.$version2.$platform.tar.gz include share lib`) + end + cd("../../..") + + # Remove the folder used to unzip the tarball generated by BinaryBuilder.jl + rm("products/$platform", recursive=true) + else + @warn("The tarball for the platform $platform was not generated!") + end +end diff --git a/.github/workflows/compilers.yml b/.github/workflows/compilers.yml new file mode 100644 index 0000000000..db0f0e54cc --- /dev/null +++ b/.github/workflows/compilers.yml @@ -0,0 +1,486 @@ +name: Compilers + +# Build and test BLAS, CBLAS, LAPACK, and LAPACKE with a variety of compilers: +# GFortran, NAG Fortran Compiler, LLVM Flang, Intel oneAPI compilers and the +# Arm Toolchain for Linux. Each of them is exercised against static and against +# shared libraries, always in Release mode. +# +# The NAG Fortran Compiler is licence managed and its key is tied to the +# platform it was issued for, so each of its configurations reads a repository +# secret of its own: NAG_KUSARI_KEY_LINUX_X86_64, NAG_KUSARI_KEY_LINUX_ARM64 +# and NAG_KUSARI_KEY_MACOS_ARM64. A configuration whose secret is not set is +# skipped. + +on: + push: + branches: + - master + paths: + - .github/workflows/compilers.yml + - codecov.yml + - lapack_testing.py + - '**CMakeLists.txt' + - 'BLAS/**' + - 'CBLAS/**' + - 'CMAKE/**' + - 'INSTALL/**' + - 'LAPACKE/**' + - 'SRC/**' + - 'TESTING/**' + - '!**README' + - '!**Makefile' + - '!**md' + pull_request: + paths: + - .github/workflows/compilers.yml + - codecov.yml + - lapack_testing.py + - '**CMakeLists.txt' + - 'BLAS/**' + - 'CBLAS/**' + - 'CMAKE/**' + - 'INSTALL/**' + - 'LAPACKE/**' + - 'SRC/**' + - 'TESTING/**' + - '!**README' + - '!**Makefile' + - '!**md' + +permissions: + contents: read + +defaults: + run: + shell: bash + +jobs: + default-test-install: + name: ${{ matrix.toolchain.os }}-${{ matrix.toolchain.FC }} (${{ matrix.lib_type }}) + runs-on: ${{ matrix.toolchain.os }} + + # CODECOV_TOKEN is stored as a secret of the 'codecov' environment. Nothing + # is being deployed here, so do not record a deployment for it. + environment: + name: codecov + deployment: false + + env: + FC: ${{ matrix.toolchain.FC }} + CC: ${{ matrix.toolchain.CC }} + FFLAGS: ${{ matrix.toolchain.FFLAGS }} + CFLAGS: ${{ matrix.toolchain.CFLAGS }} + + strategy: + fail-fast: false + matrix: + lib_type: [ static, shared ] + toolchain: + - FC: gfortran + CC: gcc + os: ubuntu-26.04 + CFLAGS: "-Wall -pedantic" + FFLAGS: "-Wall -pedantic -Wno-unused-dummy-argument -Wno-unused-variable -Wno-unused-label" + - FC: gfortran + CC: gcc + os: ubuntu-26.04-arm + CFLAGS: "-Wall -pedantic" + FFLAGS: "-Wall -pedantic -Wno-unused-dummy-argument -Wno-unused-variable -Wno-unused-label" + - FC: gfortran + CC: gcc + os: windows-2025 + CFLAGS: "-Wall -pedantic" + FFLAGS: "-Wall -pedantic -Wno-unused-dummy-argument -Wno-unused-variable -Wno-unused-label" + - FC: gfortran-14 + CC: gcc-14 + os: macos-26 + CFLAGS: "-Wall -pedantic" + FFLAGS: "-Wall -pedantic -Wno-unused-dummy-argument -Wno-unused-variable -Wno-unused-label" + - FC: flang + CC: clang + os: ubuntu-26.04 + CFLAGS: "-Wall -pedantic" + FFLAGS: "-Wall -pedantic" + - FC: flang + CC: clang + os: ubuntu-26.04-arm + CFLAGS: "-Wall -pedantic" + FFLAGS: "-Wall -pedantic" + - FC: nagfor + CC: gcc + os: ubuntu-26.04 + CFLAGS: "-Wall -pedantic" + FFLAGS: "" + nag_url: https://support.nag.com/downloads/impl/npl6a72na_amd64.tgz + nag_secret: NAG_KUSARI_KEY_LINUX_X86_64 + - FC: ifx + CC: icx + os: ubuntu-24.04 + CFLAGS: "-Wall -pedantic" + FFLAGS: "-Wall -pedantic -warn nounused" + - FC: nagfor + CC: gcc + os: ubuntu-26.04-arm + CFLAGS: "-Wall -pedantic" + FFLAGS: "" + nag_url: https://support.nag.com/downloads/impl/npla872na_arm64linux.tgz + nag_secret: NAG_KUSARI_KEY_LINUX_ARM64 + - FC: armflang + CC: armclang + os: ubuntu-24.04-arm + CFLAGS: "-Wall -pedantic" + FFLAGS: "-Wall -pedantic" + - FC: nagfor + CC: gcc + name: mac_arm64 / nagfor + AppleClang + os: macos-26 + CFLAGS: "-Wall -pedantic" + FFLAGS: "" + nag_url: https://support.nag.com/downloads/impl/npma872na_macarm64.dmg + nag_secret: NAG_KUSARI_KEY_MACOS_ARM64 + - FC: flang + CC: cl + os: windows-2025-vs2026 + CFLAGS: "/W3" + FFLAGS: "-Wall -pedantic" + - FC: ifx + CC: icx + os: windows-2025-vs2026 + CFLAGS: "/W3" + FFLAGS: "/warn:nounused" + + steps: + - name: Checkout LAPACK + uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1 + + - name: Install the NAG Fortran Compiler + if: ${{ matrix.toolchain.FC == 'nagfor' }} + env: + # The secrets context cannot be reached from the matrix, but it can be + # indexed with a name taken from it. The guard keeps the index away + # from an undefined name for the non-NAG toolchains. + NAG_KUSARI_KEY: ${{ matrix.toolchain.nag_secret && secrets[matrix.toolchain.nag_secret] || '' }} + NAG_KUSARI_SECRET: ${{ matrix.toolchain.nag_secret }} + NAG_URL: ${{ matrix.toolchain.nag_url }} + run: | + # Repository secrets are not exposed to pull requests from forks, so + # the compiler cannot be licensed there. Skip instead of failing the + # run of a contributor who cannot do anything about it. + if [ -z "${NAG_KUSARI_KEY}" ]; then + echo "::warning title=NAG Fortran Compiler skipped::" \ + "The ${NAG_KUSARI_SECRET} secret is not available (pull requests" \ + "from forks cannot read repository secrets), so the compiler" \ + "cannot be licensed for this platform." + echo "SKIP_TOOLCHAIN=true" >> "$GITHUB_ENV" + exit 0 + fi + + # Kusari looks for the licence key in a file of its own; anywhere + # outside its handful of default locations has to be named explicitly + # through NAG_KUSARI_FILE. + key_file="${RUNNER_TEMP}/nag.key" + printf '%s\n' "${NAG_KUSARI_KEY}" > "${key_file}" + chmod 600 "${key_file}" + export NAG_KUSARI_FILE="${key_file}" + echo "NAG_KUSARI_FILE=${key_file}" >> "$GITHUB_ENV" + + # Linux is shipped as a tarball, macOS as a disk image; both unpack to + # the same distribution layout. + case "${NAG_URL}" in + *.dmg) + curl -fsSL -o "${RUNNER_TEMP}/nagfor.dmg" "${NAG_URL}" + dist="${RUNNER_TEMP}/nag-mount" + hdiutil attach "${RUNNER_TEMP}/nagfor.dmg" \ + -nobrowse -readonly -mountpoint "${dist}" + ;; + *) + curl -fsSL -o "${RUNNER_TEMP}/nagfor.tgz" "${NAG_URL}" + tar xzf "${RUNNER_TEMP}/nagfor.tgz" -C "${RUNNER_TEMP}" + # The directory carries the platform in its name + # (NAG_Fortran-amd64, NAG_Fortran-arm64linux, ...), so look it up + # rather than assuming one. + dist=$(find "${RUNNER_TEMP}" -maxdepth 1 -type d -name 'NAG_Fortran-*' \ + | head -n 1) + ;; + esac + if [ -z "${dist}" ] || [ ! -f "${dist}/INSTALLU.sh" ]; then + echo "::error::No NAG Fortran Compiler distribution found in ${RUNNER_TEMP}." + exit 1 + fi + + # INSTALLU.sh is the unattended installer. It takes both target + # directories from the environment, they have to be absolute and they + # have to differ from each other. /usr/local/lib/NAG_Fortran is the + # compiler's own default library directory on every platform here, + # which keeps the installed nagfor a plain binary rather than a -Qpath + # wrapper script. + cd "${dist}" + sudo env \ + INSTALL_TO_BINDIR=/usr/local/bin \ + INSTALL_TO_LIBDIR=/usr/local/lib/NAG_Fortran \ + ./INSTALLU.sh + + nagfor -version + + # Confirm the key is usable rather than merely present. -xlicinfo + # reports the licence status but exits with status 2 whether or not a + # licence was found, so it cannot be used as a bare command: what + # counts is its output, which reports a failure as a line starting + # with 'Error:'. + licence_info=$(nagfor -xlicinfo 2>&1) || true + printf '%s\n' "${licence_info}" + if printf '%s\n' "${licence_info}" | grep -q '^Error:'; then + echo "::error title=NAG Fortran Compiler licence invalid::" \ + "nagfor found no usable licence in ${NAG_KUSARI_FILE}; check that" \ + "the ${NAG_KUSARI_SECRET} secret holds a key for this platform." + exit 1 + fi + + - name: Install flang 21 and clang 21 + if: ${{ matrix.toolchain.FC == 'flang' && runner.os == 'Linux' }} + run: | + sudo apt-get update + sudo apt-get install -y flang-21 clang-21 + sudo update-alternatives --install /usr/bin/clang clang /usr/bin/clang-21 100 + sudo update-alternatives --install /usr/bin/flang flang /usr/bin/flang-21 100 + sudo update-alternatives --install /usr/bin/clang++ clang++ /usr/bin/clang++-21 100 + flang --version + clang --version + + - name: Install the Intel oneAPI compilers + if: ${{ matrix.toolchain.FC == 'ifx' && runner.os == 'Linux' }} + run: | + # ifx and icx are not in the Ubuntu archive; Intel ships them from its + # own APT repository. + curl -fsSL https://apt.repos.intel.com/intel-gpg-keys/GPG-PUB-KEY-INTEL-SW-PRODUCTS.PUB \ + | gpg --dearmor \ + | sudo tee /usr/share/keyrings/oneapi-archive-keyring.gpg > /dev/null + echo "deb [signed-by=/usr/share/keyrings/oneapi-archive-keyring.gpg]" \ + "https://apt.repos.intel.com/oneapi all main" \ + | sudo tee /etc/apt/sources.list.d/oneAPI.list > /dev/null + sudo apt-get update + sudo apt-get install -y \ + intel-oneapi-compiler-fortran intel-oneapi-compiler-dpcpp-cpp + + # setvars.sh only changes the shell that sources it, and every step + # runs in a shell of its own, so announce it through TOOLCHAIN_SETUP + # and let the steps below source it themselves. + echo "TOOLCHAIN_SETUP=/opt/intel/oneapi/setvars.sh" >> "$GITHUB_ENV" + + source /opt/intel/oneapi/setvars.sh + ifx --version + icx --version + + - name: Install the Arm Toolchain for Linux + if: ${{ matrix.toolchain.FC == 'armflang' }} + env: + ARM_REPO: https://developer.arm.com/packages/arm-toolchains/ubuntu + run: | + # armclang and armflang come from Arm's own APT repository, whose + # configuration package carries both the sources list and the signing + # key. Its version moves independently of the toolchain, so look the + # file up instead of pinning it. + deb=$(curl -fsSL "${ARM_REPO}/dists/noble/main/binary-arm64/Packages" \ + | awk '/^Package: arm-toolchains-repository$/ { found = 1 } + found && /^Filename:/ { print $2; exit }') + if [ -z "${deb}" ]; then + echo "::error::Could not find the arm-toolchains-repository package." + exit 1 + fi + curl -fsSL -o "${RUNNER_TEMP}/arm-repo.deb" "${ARM_REPO}/${deb}" + sudo apt-get install -y "${RUNNER_TEMP}/arm-repo.deb" + sudo apt-get update + sudo apt-get install -y arm-toolchain-for-linux + + # The package ships a modulefile generator rather than an environment + # script, so set up what that module would: its bin directory, plus + # the library paths the compilers and the built shared libraries need. + prefix=/opt/arm/arm-toolchain-for-linux + libs="${prefix}/lib:${prefix}/lib/aarch64-unknown-linux-gnu" + echo "${prefix}/bin" >> "$GITHUB_PATH" + echo "CPATH=${prefix}/include${CPATH:+:${CPATH}}" >> "$GITHUB_ENV" + echo "LIBRARY_PATH=${libs}${LIBRARY_PATH:+:${LIBRARY_PATH}}" >> "$GITHUB_ENV" + echo "LD_LIBRARY_PATH=${libs}${LD_LIBRARY_PATH:+:${LD_LIBRARY_PATH}}" >> "$GITHUB_ENV" + + "${prefix}/bin/armflang" --version + "${prefix}/bin/armclang" --version + + - name: Install flang (Windows) + if: ${{ matrix.toolchain.FC == 'flang' && runner.os == 'Windows' }} + shell: cmd + env: + FLANG_VERSION: 22.1.8 + run: | + call "%CONDA%\Scripts\conda.exe" install -y -q -c conda-forge ^ + flang=%FLANG_VERSION% flang-rt_win-64=%FLANG_VERSION% || exit /b 1 + + echo %CONDA%\Library\bin>> %GITHUB_PATH% + echo LIB=%CONDA%\Library\lib>> %GITHUB_ENV% + echo INCLUDE=%CONDA%\Library\include>> %GITHUB_ENV% + + "%CONDA%\Library\bin\flang.exe" --version || exit /b 1 + + - name: Install the Intel oneAPI compilers (Windows) + if: ${{ matrix.toolchain.FC == 'ifx' && runner.os == 'Windows' }} + shell: cmd + env: + ONEAPI_VERSION: 2026.1.1 + run: | + call "%CONDA%\Scripts\conda.exe" install -y -q ^ + -c https://software.repos.intel.com/python/conda/ ^ + ifx_impl_win-64=%ONEAPI_VERSION% ^ + dpcpp_impl_win-64=%ONEAPI_VERSION% || exit /b 1 + + echo ONEAPI_PATH=%CONDA%\Library\bin>> %GITHUB_ENV% + echo ONEAPI_LIB=%CONDA%\Library\lib;%CONDA%\compiler\lib>> %GITHUB_ENV% + echo ONEAPI_INCLUDE=%CONDA%\opt\compiler\include;%CONDA%\opt\compiler\include\intel64;%CONDA%\Library\include>> %GITHUB_ENV% + + "%CONDA%\Library\bin\ifx.exe" --version || exit /b 1 + "%CONDA%\Library\bin\icx.exe" --version || exit /b 1 + + - name: Write the Windows toolchain setup script + if: ${{ runner.os == 'Windows' }} + shell: cmd + run: | + set "VSWHERE=%ProgramFiles(x86)%\Microsoft Visual Studio\Installer\vswhere.exe" + for /f "usebackq tokens=*" %%i in (`"%VSWHERE%" -latest -products * -requires Microsoft.VisualStudio.Component.VC.Tools.x86.x64 -find VC\Auxiliary\Build\vcvars64.bat`) do set "VCVARS=%%i" + if not defined VCVARS ( + echo ::error::Could not locate vcvars64.bat via vswhere. + exit /b 1 + ) + echo Using %VCVARS% + + set "SETUP=%RUNNER_TEMP%\toolchain.bat" + > "%SETUP%" echo @echo off + >>"%SETUP%" echo call "%VCVARS%" ^|^| exit /b 1 + >>"%SETUP%" echo if defined ONEAPI_PATH set "PATH=%%ONEAPI_PATH%%;%%PATH%%" + >>"%SETUP%" echo if defined ONEAPI_LIB set "LIB=%%ONEAPI_LIB%%;%%LIB%%" + >>"%SETUP%" echo if defined ONEAPI_INCLUDE set "INCLUDE=%%ONEAPI_INCLUDE%%;%%INCLUDE%%" + type "%SETUP%" + echo TOOLCHAIN_SETUP=%SETUP%>> %GITHUB_ENV% + + - name: Configure CMake + if: ${{ runner.os != 'Windows' && env.SKIP_TOOLCHAIN != 'true' }} + run: | + [ -z "${TOOLCHAIN_SETUP-}" ] || source "${TOOLCHAIN_SETUP}" + + extra=() + if [ "${RUNNER_OS}" = "macOS" ] && [ "${{ matrix.lib_type }}" = shared ]; then + # Symbol resolution in the test suite needs flat namespaces on macOS + extra+=(-D USE_FLAT_NAMESPACE:BOOL=ON) + fi + + cmake -B build -G Ninja \ + -D CMAKE_BUILD_TYPE=Release \ + -D CMAKE_Fortran_COMPILER="${FC}" \ + -D CMAKE_C_COMPILER="${CC}" \ + -D CMAKE_INSTALL_PREFIX=${{ github.workspace }}/lapack_install \ + -D CBLAS:BOOL=ON \ + -D LAPACKE:BOOL=ON \ + -D BUILD_TESTING:BOOL=ON \ + -D LAPACKE_WITH_TMG:BOOL=ON \ + -D BUILD_SHARED_LIBS:BOOL=${{ matrix.lib_type == 'shared' && 'ON' || 'OFF' }} \ + "${extra[@]}" + + - name: Build + if: ${{ runner.os != 'Windows' && env.SKIP_TOOLCHAIN != 'true' }} + run: | + [ -z "${TOOLCHAIN_SETUP-}" ] || source "${TOOLCHAIN_SETUP}" + cmake --build build + + - name: Test + if: ${{ runner.os != 'Windows' && env.SKIP_TOOLCHAIN != 'true' }} + working-directory: ${{ github.workspace }}/build + run: | + [ -z "${TOOLCHAIN_SETUP-}" ] || source "${TOOLCHAIN_SETUP}" + ctest -C Release --schedule-random -j2 --output-on-failure --timeout 1800 + + - name: Configure CMake (Windows) + if: ${{ runner.os == 'Windows' }} + shell: cmd + run: | + call "%TOOLCHAIN_SETUP%" || exit /b 1 + cmake -B build -G Ninja ^ + -D CMAKE_BUILD_TYPE=Release ^ + -D CMAKE_Fortran_COMPILER=%FC% ^ + -D CMAKE_C_COMPILER=%CC% ^ + -D CMAKE_INSTALL_PREFIX=${{ github.workspace }}\lapack_install ^ + -D CBLAS:BOOL=ON ^ + -D LAPACKE:BOOL=ON ^ + -D BUILD_TESTING:BOOL=ON ^ + -D LAPACKE_WITH_TMG:BOOL=ON ^ + -D BUILD_SHARED_LIBS:BOOL=${{ matrix.lib_type == 'shared' && 'ON' || 'OFF' }} + + - name: Build (Windows) + if: ${{ runner.os == 'Windows' }} + shell: cmd + run: | + call "%TOOLCHAIN_SETUP%" || exit /b 1 + cmake --build build + + - name: Test (Windows) + if: ${{ runner.os == 'Windows' }} + shell: cmd + working-directory: ${{ github.workspace }}\build + run: | + call "%TOOLCHAIN_SETUP%" || exit /b 1 + ctest -C Release --schedule-random -j2 --output-on-failure --timeout 1800 + + - name: Upload test results + id: upload-test-results + # Uploaded even when the tests failed; that is when the results are + # needed most. The test summary below links to the artifact. + if: ${{ !cancelled() && env.SKIP_TOOLCHAIN != 'true' }} + uses: actions/upload-artifact@043fb46d1a93c77aae656e7c1c64a875d1fc6a0a # v7.0.1 + with: + name: test-results-${{ matrix.toolchain.FC }}-${{ matrix.toolchain.os }}-${{ matrix.lib_type }} + path: | + build/TESTING/testing_results.txt + build/lapack_testing_junit.xml + if-no-files-found: warn + retention-days: 14 + + - name: Upload test results to Codecov + # Like the artifact above, uploaded even when the tests failed: a failing + # test is exactly what the test analytics report is for. + if: ${{ !cancelled() && env.SKIP_TOOLCHAIN != 'true' }} + continue-on-error: ${{ secrets.CODECOV_TOKEN == '' }} + uses: codecov/codecov-action@fb8b3582c8e4def4969c97caa2f19720cb33a72f # v7.0.0 + with: + token: ${{ secrets.CODECOV_TOKEN }} + # The uploader defaults to coverage; this is a test analytics report. + report_type: test_results + files: build/lapack_testing_junit.xml + # The report is named above, so there is nothing to search the tree for. + disable_search: true + flags: tests-${{ matrix.toolchain.os }}-${{ matrix.toolchain.FC }}-${{ matrix.lib_type }} + name: ${{ matrix.toolchain.os }}-${{ matrix.toolchain.FC }} (${{ matrix.lib_type }}) + fail_ci_if_error: true + verbose: true + + - name: Write test summary + if: ${{ !cancelled() && env.SKIP_TOOLCHAIN != 'true' }} + env: + ARTIFACT_URL: ${{ steps.upload-test-results.outputs.artifact-url }} + run: | + cd build 2>/dev/null || exit 0 + python3 lapack_testing.py -d TESTING --merge-apis --markdown summary.md || true + if [ -f summary.md ]; then + cat summary.md >> "$GITHUB_STEP_SUMMARY" + if [ -n "$ARTIFACT_URL" ]; then + printf '\nThe raw output of every test run (`testing_results.txt`) and a JUnit XML report are in the [test-results artifact](%s).\n' "$ARTIFACT_URL" >> "$GITHUB_STEP_SUMMARY" + fi + fi + + - name: Install + if: ${{ runner.os != 'Windows' && env.SKIP_TOOLCHAIN != 'true' }} + run: | + [ -z "${TOOLCHAIN_SETUP-}" ] || source "${TOOLCHAIN_SETUP}" + cmake --build build --target install -j2 + + - name: Install (Windows) + if: ${{ runner.os == 'Windows' }} + shell: cmd + run: | + call "%TOOLCHAIN_SETUP%" || exit /b 1 + cmake --build build --target install -j2 diff --git a/.github/workflows/makefile.yml b/.github/workflows/makefile.yml new file mode 100644 index 0000000000..7b60849d84 --- /dev/null +++ b/.github/workflows/makefile.yml @@ -0,0 +1,94 @@ +name: Makefile + +# This workflow builds and installs LAPACK using the Makefile build system. +# Only GFortran is tested. + +on: + push: + branches: + - master + paths: + - .github/workflows/makefile.yml + - '**Makefile' + - 'BLAS/**' + - 'CBLAS/**' + - 'INSTALL/**' + - 'LAPACKE/**' + - 'SRC/**' + - 'TESTING/**' + - '!**README' + - '!**CMakeLists.txt' + - '!**md' + pull_request: + paths: + - .github/workflows/makefile.yml + - '**Makefile' + - 'BLAS/**' + - 'CBLAS/**' + - 'INSTALL/**' + - 'LAPACKE/**' + - 'SRC/**' + - 'TESTING/**' + - '!**README' + - '!**CMakeLists.txt' + - '!**md' + +permissions: + contents: read + +env: + CFLAGS: "-O3 -flto -Wall -pedantic-errors" + FFLAGS: "-O2 -flto -Wall -Wno-unused-dummy-argument -Wno-unused-variable -Wno-unused-label -Wmaybe-uninitialized -Werror=conversion -pedantic -fimplicit-none -frecursive -fopenmp -fcheck=all" + LDFLAGS: "" + AR: "ar" + ARFLAGS: "cr" + RANLIB: "ranlib" + +defaults: + run: + shell: bash + +jobs: + build-install: + name: ${{ matrix.toolchain.os }}-${{ matrix.toolchain.FC }} + runs-on: ${{ matrix.toolchain.os }} + + env: + FC: ${{ matrix.toolchain.FC }} + CC: ${{ matrix.toolchain.CC }} + + strategy: + fail-fast: false + matrix: + toolchain: + - FC: gfortran + CC: gcc + os: ubuntu-26.04 + - FC: gfortran + CC: gcc + os: ubuntu-26.04-arm + - FC: gfortran-14 + CC: gcc-14 + os: macos-26 + + steps: + - name: Checkout LAPACK + uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1 + + - name: Set configurations + run: | + echo "SHELL = /bin/sh" >> make.inc + echo "FFLAGS_DRV = ${{env.FFLAGS}}" >> make.inc + echo "TIMER = INT_ETIME" >> make.inc + echo "BLASLIB = ${{github.workspace}}/librefblas.a" >> make.inc + echo "CBLASLIB = ${{github.workspace}}/libcblas.a" >> make.inc + echo "LAPACKLIB = ${{github.workspace}}/liblapack.a" >> make.inc + echo "TMGLIB = ${{github.workspace}}/libtmglib.a" >> make.inc + echo "LAPACKELIB = ${{github.workspace}}/liblapacke.a" >> make.inc + echo "DOCSDIR = ${{github.workspace}}/DOCS" >> make.inc + + - name: Build + run: make -s -j2 all + + - name: Install + run: make -j2 lapack_install diff --git a/.github/workflows/release.yml b/.github/workflows/release.yml new file mode 100644 index 0000000000..e5b213dbad --- /dev/null +++ b/.github/workflows/release.yml @@ -0,0 +1,239 @@ +name: Release + +on: + push: + # Sequence of patterns matched against refs/tags + tags: + - 'v*' # Push events to matching v*, i.e. v1.0, v2023.11.15 + +jobs: + build-linux-x64: + name: blas / lapack -- Linux (x86_64) -- Release ${{ github.ref_name }} + runs-on: ubuntu-24.04 + steps: + - name: Checkout lapack + uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1 + + - name: Install Julia + uses: julia-actions/setup-julia@fa02766e078afaaf09b14210362cee14137e6a32 # v3.0.2 + with: + version: "1.7" + arch: x64 + + - name: Set the environment variables BINARYBUILDER_AUTOMATIC_APPLE, BLAS_LAPACK_RELEASE, BLAS_LAPACK_COMMIT + shell: bash + run: | + echo "BINARYBUILDER_AUTOMATIC_APPLE=true" >> $GITHUB_ENV + echo "BLAS_LAPACK_RELEASE=${{ github.ref_name }}" >> $GITHUB_ENV + echo "BLAS_LAPACK_COMMIT=${{ github.sha }}" >> $GITHUB_ENV + echo "BLAS_LAPACK_URL=https://github.com/${{ github.repository }}.git" >> $GITHUB_ENV + + - name: Cross-compilation of blas / lapack -- x86_64-linux-gnu-libgfortran5 + run: | + julia --color=no -e 'using Pkg; Pkg.add("BinaryBuilder")' + julia --color=no .github/julia/build_tarballs.jl x86_64-linux-gnu-libgfortran5 --verbose + + - name: Archive artifact + run: julia --color=no .github/julia/generate_binaries.jl + + - name: Upload artifact + uses: actions/upload-artifact@043fb46d1a93c77aae656e7c1c64a875d1fc6a0a # v7.0.1 + with: + name: blas_lapack_binaries.${{ github.ref_name }}.x86_64-linux-gnu-libgfortran5.tar.gz + path: ./blas_lapack_binaries.${{ github.ref_name }}.x86_64-linux-gnu-libgfortran5.tar.gz + + build-linux-aarch64: + name: blas / lapack -- Linux (aarch64) -- Release ${{ github.ref_name }} + runs-on: ubuntu-24.04 + steps: + - name: Checkout lapack + uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1 + + - name: Install Julia + uses: julia-actions/setup-julia@fa02766e078afaaf09b14210362cee14137e6a32 # v3.0.2 + with: + version: "1.7" + arch: x64 + + - name: Set the environment variables BINARYBUILDER_AUTOMATIC_APPLE, BLAS_LAPACK_RELEASE, BLAS_LAPACK_COMMIT + shell: bash + run: | + echo "BINARYBUILDER_AUTOMATIC_APPLE=true" >> $GITHUB_ENV + echo "BLAS_LAPACK_RELEASE=${{ github.ref_name }}" >> $GITHUB_ENV + echo "BLAS_LAPACK_COMMIT=${{ github.sha }}" >> $GITHUB_ENV + echo "BLAS_LAPACK_URL=https://github.com/${{ github.repository }}.git" >> $GITHUB_ENV + + - name: Cross-compilation of blas / lapack -- aarch64-linux-gnu-libgfortran5 + run: | + julia --color=no -e 'using Pkg; Pkg.add("BinaryBuilder")' + julia --color=no .github/julia/build_tarballs.jl aarch64-linux-gnu-libgfortran5 --verbose + + - name: Archive artifact + run: julia --color=no .github/julia/generate_binaries.jl + + - name: Upload artifact + uses: actions/upload-artifact@043fb46d1a93c77aae656e7c1c64a875d1fc6a0a # v7.0.1 + with: + name: blas_lapack_binaries.${{ github.ref_name }}.aarch64-linux-gnu-libgfortran5.tar.gz + path: ./blas_lapack_binaries.${{ github.ref_name }}.aarch64-linux-gnu-libgfortran5.tar.gz + + build-windows-x64: + name: blas / lapack -- Windows (x86_64) -- Release ${{ github.ref_name }} + runs-on: ubuntu-24.04 + steps: + - name: Checkout lapack + uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1 + + - name: Install Julia + uses: julia-actions/setup-julia@fa02766e078afaaf09b14210362cee14137e6a32 # v3.0.2 + with: + version: "1.7" + arch: x64 + + - name: Set the environment variables BINARYBUILDER_AUTOMATIC_APPLE, BLAS_LAPACK_RELEASE, BLAS_LAPACK_COMMIT + shell: bash + run: | + echo "BINARYBUILDER_AUTOMATIC_APPLE=true" >> $GITHUB_ENV + echo "BLAS_LAPACK_RELEASE=${{ github.ref_name }}" >> $GITHUB_ENV + echo "BLAS_LAPACK_COMMIT=${{ github.sha }}" >> $GITHUB_ENV + echo "BLAS_LAPACK_URL=https://github.com/${{ github.repository }}.git" >> $GITHUB_ENV + + - name: Cross-compilation of blas / lapack -- x86_64-w64-mingw32-libgfortran5 + run: | + julia --color=no -e 'using Pkg; Pkg.add("BinaryBuilder")' + julia --color=no .github/julia/build_tarballs.jl x86_64-w64-mingw32-libgfortran5 --verbose + - name: Archive artifact + run: julia --color=no .github/julia/generate_binaries.jl + + - name: Upload artifact + uses: actions/upload-artifact@043fb46d1a93c77aae656e7c1c64a875d1fc6a0a # v7.0.1 + with: + name: blas_lapack_binaries.${{ github.ref_name }}.x86_64-w64-mingw32-libgfortran5.zip + path: ./blas_lapack_binaries.${{ github.ref_name }}.x86_64-w64-mingw32-libgfortran5.zip + + build-mac-x64: + name: blas / lapack -- macOS (x86_64) -- Release ${{ github.ref_name }} + runs-on: ubuntu-24.04 + steps: + - name: Checkout lapack + uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1 + + - name: Install Julia + uses: julia-actions/setup-julia@fa02766e078afaaf09b14210362cee14137e6a32 # v3.0.2 + with: + version: "1.7" + arch: x64 + + - name: Set the environment variables BINARYBUILDER_AUTOMATIC_APPLE, BLAS_LAPACK_RELEASE, BLAS_LAPACK_COMMIT + shell: bash + run: | + echo "BINARYBUILDER_AUTOMATIC_APPLE=true" >> $GITHUB_ENV + echo "BLAS_LAPACK_RELEASE=${{ github.ref_name }}" >> $GITHUB_ENV + echo "BLAS_LAPACK_COMMIT=${{ github.sha }}" >> $GITHUB_ENV + echo "BLAS_LAPACK_URL=https://github.com/${{ github.repository }}.git" >> $GITHUB_ENV + + - name: Cross-compilation of blas / lapack -- x86_64-apple-darwin-libgfortran5 + run: | + julia --color=no -e 'using Pkg; Pkg.add("BinaryBuilder")' + julia --color=no .github/julia/build_tarballs.jl x86_64-apple-darwin-libgfortran5 --verbose + + - name: Archive artifact + run: julia --color=no .github/julia/generate_binaries.jl + + - name: Upload artifact + uses: actions/upload-artifact@043fb46d1a93c77aae656e7c1c64a875d1fc6a0a # v7.0.1 + with: + name: blas_lapack_binaries.${{ github.ref_name }}.x86_64-apple-darwin-libgfortran5.tar.gz + path: ./blas_lapack_binaries.${{ github.ref_name }}.x86_64-apple-darwin-libgfortran5.tar.gz + + build-mac-aarch64: + name: blas / lapack -- macOS (aarch64) -- Release ${{ github.ref_name }} + runs-on: ubuntu-24.04 + steps: + - name: Checkout lapack + uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1 + + - name: Install Julia + uses: julia-actions/setup-julia@fa02766e078afaaf09b14210362cee14137e6a32 # v3.0.2 + with: + version: "1.7" + arch: x64 + + - name: Set the environment variables BINARYBUILDER_AUTOMATIC_APPLE, BLAS_LAPACK_RELEASE, BLAS_LAPACK_COMMIT + shell: bash + run: | + echo "BINARYBUILDER_AUTOMATIC_APPLE=true" >> $GITHUB_ENV + echo "BLAS_LAPACK_RELEASE=${{ github.ref_name }}" >> $GITHUB_ENV + echo "BLAS_LAPACK_COMMIT=${{ github.sha }}" >> $GITHUB_ENV + echo "BLAS_LAPACK_URL=https://github.com/${{ github.repository }}.git" >> $GITHUB_ENV + + - name: Cross-compilation of blas / lapack -- aarch64-apple-darwin-libgfortran5 + run: | + julia --color=no -e 'using Pkg; Pkg.add("BinaryBuilder")' + julia --color=no .github/julia/build_tarballs.jl aarch64-apple-darwin-libgfortran5 --verbose + + - name: Archive artifact + run: julia --color=no .github/julia/generate_binaries.jl + + - name: Upload artifact + uses: actions/upload-artifact@043fb46d1a93c77aae656e7c1c64a875d1fc6a0a # v7.0.1 + with: + name: blas_lapack_binaries.${{ github.ref_name }}.aarch64-apple-darwin-libgfortran5.tar.gz + path: ./blas_lapack_binaries.${{ github.ref_name }}.aarch64-apple-darwin-libgfortran5.tar.gz + + release: + name: Create Release and Upload Binaries + needs: [build-windows-x64, build-linux-x64, build-linux-aarch64, build-mac-x64, build-mac-aarch64] + runs-on: ubuntu-24.04 + steps: + - name: Checkout lapack + uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1 + + - name: Download artifacts + uses: actions/download-artifact@3e5f45b2cfb9172054b4087a40e8e0b5a5461e7c # v8.0.1 + with: + path: . + + - name: Create GitHub Release + run: | + gh release create ${{ github.ref_name }} \ + --title "${{ github.ref_name }}" \ + --notes "" \ + --verify-tag + env: + GH_TOKEN: ${{ secrets.GITHUB_TOKEN }} + + - name: Upload Linux (x86_64) artifact + run: | + gh release upload ${{ github.ref_name }} \ + blas_lapack_binaries.${{ github.ref_name }}.x86_64-linux-gnu-libgfortran5.tar.gz/blas_lapack_binaries.${{ github.ref_name }}.x86_64-linux-gnu-libgfortran5.tar.gz#blas_lapack.${{ github.ref_name }}.linux.x86_64.tar.gz + env: + GH_TOKEN: ${{ secrets.GITHUB_TOKEN }} + + - name: Upload Linux (aarch64) artifact + run: | + gh release upload ${{ github.ref_name }} \ + blas_lapack_binaries.${{ github.ref_name }}.aarch64-linux-gnu-libgfortran5.tar.gz/blas_lapack_binaries.${{ github.ref_name }}.aarch64-linux-gnu-libgfortran5.tar.gz#blas_lapack.${{ github.ref_name }}.linux.aarch64.tar.gz + env: + GH_TOKEN: ${{ secrets.GITHUB_TOKEN }} + + - name: Upload Mac (x86_64) artifact + run: | + gh release upload ${{ github.ref_name }} \ + blas_lapack_binaries.${{ github.ref_name }}.x86_64-apple-darwin-libgfortran5.tar.gz/blas_lapack_binaries.${{ github.ref_name }}.x86_64-apple-darwin-libgfortran5.tar.gz#blas_lapack.${{ github.ref_name }}.mac.x86_64.tar.gz + env: + GH_TOKEN: ${{ secrets.GITHUB_TOKEN }} + + - name: Upload Mac (aarch64) artifact + run: | + gh release upload ${{ github.ref_name }} \ + blas_lapack_binaries.${{ github.ref_name }}.aarch64-apple-darwin-libgfortran5.tar.gz/blas_lapack_binaries.${{ github.ref_name }}.aarch64-apple-darwin-libgfortran5.tar.gz#blas_lapack.${{ github.ref_name }}.mac.aarch64.tar.gz + env: + GH_TOKEN: ${{ secrets.GITHUB_TOKEN }} + + - name: Upload Windows (x86_64) artifact + run: | + gh release upload ${{ github.ref_name }} \ + blas_lapack_binaries.${{ github.ref_name }}.x86_64-w64-mingw32-libgfortran5.zip/blas_lapack_binaries.${{ github.ref_name }}.x86_64-w64-mingw32-libgfortran5.zip#blas_lapack.${{ github.ref_name }}.windows.x86_64.zip + env: + GH_TOKEN: ${{ secrets.GITHUB_TOKEN }} diff --git a/.github/workflows/scorecard.yml b/.github/workflows/scorecard.yml new file mode 100644 index 0000000000..b21fbc6db6 --- /dev/null +++ b/.github/workflows/scorecard.yml @@ -0,0 +1,72 @@ +# This workflow uses actions that are not certified by GitHub. They are provided +# by a third-party and are governed by separate terms of service, privacy +# policy, and support documentation. + +name: Scorecard supply-chain security +on: + # For Branch-Protection check. Only the default branch is supported. See + # https://github.com/ossf/scorecard/blob/main/docs/checks.md#branch-protection + branch_protection_rule: + # To guarantee Maintained check is occasionally updated. See + # https://github.com/ossf/scorecard/blob/main/docs/checks.md#maintained + schedule: + - cron: '40 17 * * 2' + push: + branches: [ "master" ] + +# Declare default permissions as read only. +permissions: read-all + +jobs: + analysis: + name: Scorecard analysis + runs-on: ubuntu-24.04 + permissions: + # Needed to upload the results to code-scanning dashboard. + security-events: write + # Needed to publish results and get a badge (see publish_results below). + id-token: write + # Uncomment the permissions below if installing in a private repository. + # contents: read + # actions: read + + steps: + - name: "Checkout code" + uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1 + with: + persist-credentials: false + + - name: "Run analysis" + uses: ossf/scorecard-action@2d1146689b8cda280b9bc96326124645441f03bc # v2.4.4 + with: + results_file: results.sarif + results_format: sarif + # (Optional) "write" PAT token. Uncomment the `repo_token` line below if: + # - you want to enable the Branch-Protection check on a *public* repository, or + # - you are installing Scorecard on a *private* repository + # To create the PAT, follow the steps in https://github.com/ossf/scorecard-action#authentication-with-pat. + # repo_token: ${{ secrets.SCORECARD_TOKEN }} + + # Public repositories: + # - Publish results to OpenSSF REST API for easy access by consumers + # - Allows the repository to include the Scorecard badge. + # - See https://github.com/ossf/scorecard-action#publishing-results. + # For private repositories: + # - `publish_results` will always be set to `false`, regardless + # of the value entered here. + publish_results: true + + # Upload the results as artifacts (optional). Commenting out will disable uploads of run results in SARIF + # format to the repository Actions tab. + - name: "Upload artifact" + uses: actions/upload-artifact@043fb46d1a93c77aae656e7c1c64a875d1fc6a0a # v7.0.1 + with: + name: SARIF file + path: results.sarif + retention-days: 5 + + # Upload the results to GitHub's code scanning dashboard. + - name: "Upload to code-scanning" + uses: github/codeql-action/upload-sarif@42947a340483f03ba47bb1a039b2c519aab3df85 # v3.37.8 + with: + sarif_file: results.sarif diff --git a/.github/workflows/special.yml b/.github/workflows/special.yml new file mode 100644 index 0000000000..0dc7bad0d3 --- /dev/null +++ b/.github/workflows/special.yml @@ -0,0 +1,575 @@ +name: Special Build Configurations + +# This workflow builds and tests LAPACK with special configurations that are not +# covered by the compilers workflow: OpenMP, extended API only, +# CBLAS and LAPACKE without a Fortran compiler, memory checking with Valgrind, +# and gcov coverage. + +on: + push: + branches: + - master + paths: + - .github/workflows/special.yml + - codecov.yml + - lapack_testing.py + - '**CMakeLists.txt' + - 'BLAS/**' + - 'CBLAS/**' + - 'CMAKE/**' + - 'INSTALL/**' + - 'LAPACKE/**' + - 'SRC/**' + - 'TESTING/**' + - '!**README' + - '!**Makefile' + - '!**md' + pull_request: + paths: + - .github/workflows/special.yml + - codecov.yml + - lapack_testing.py + - '**CMakeLists.txt' + - 'BLAS/**' + - 'CBLAS/**' + - 'CMAKE/**' + - 'INSTALL/**' + - 'LAPACKE/**' + - 'SRC/**' + - 'TESTING/**' + - '!**README' + - '!**Makefile' + - '!**md' + +permissions: + contents: read + +env: + CFLAGS: "-Wall -pedantic" + FFLAGS: "-Wall -Wno-unused-dummy-argument -Wno-unused-variable -Wno-unused-label -Werror=conversion -fimplicit-none -frecursive -fcheck=all" + +defaults: + run: + shell: bash + +jobs: + openmp-build: + name: openmp-${{ matrix.toolchain.os }}-${{ matrix.toolchain.FC }} (${{ matrix.lib_type }}) + runs-on: ${{ matrix.toolchain.os }} + + # CODECOV_TOKEN is stored as a secret of the 'codecov' environment. Nothing + # is being deployed here, so do not record a deployment for it. + environment: + name: codecov + deployment: false + + env: + FFLAGS: "-Wall -Wno-unused-dummy-argument -Wno-unused-variable -Wno-unused-label -Werror=conversion -fimplicit-none -frecursive -fcheck=all -fopenmp" + FC: ${{ matrix.toolchain.FC }} + CC: ${{ matrix.toolchain.CC }} + + strategy: + fail-fast: false + matrix: + lib_type: [ static, shared ] + toolchain: + - FC: gfortran + CC: gcc + os: ubuntu-26.04 + - FC: gfortran + CC: gcc + os: ubuntu-26.04-arm + - FC: gfortran + CC: gcc + os: windows-2025 + - FC: gfortran-14 + CC: gcc-14 + os: macos-26 + + steps: + - name: Checkout LAPACK + uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1 + + - name: Configure CMake + run: > + cmake -B build -G Ninja + -D CMAKE_BUILD_TYPE=Release + -D CMAKE_Fortran_COMPILER="${FC}" + -D CMAKE_C_COMPILER="${CC}" + -D CMAKE_INSTALL_PREFIX=${{github.workspace}}/lapack_install + -D CBLAS:BOOL=ON + -D LAPACKE:BOOL=ON + -D BUILD_TESTING:BOOL=ON + -D LAPACKE_WITH_TMG:BOOL=ON + -D BUILD_SHARED_LIBS:BOOL=${{ matrix.lib_type == 'shared' && 'ON' || 'OFF' }} + + - name: Build + run: cmake --build build -j2 + + - name: Test with OpenMP + working-directory: ${{github.workspace}}/build + run: ctest --schedule-random -j1 --output-on-failure --timeout 100 + + - name: Upload test results + id: upload-test-results + # Uploaded even when the tests failed; that is when the results + # are needed most. The test summary below links to the artifact. + if: ${{ !cancelled() }} + uses: actions/upload-artifact@043fb46d1a93c77aae656e7c1c64a875d1fc6a0a # v7.0.1 + with: + name: test-results-openmp-${{ matrix.toolchain.os }}-${{ matrix.lib_type }} + path: | + build/TESTING/testing_results.txt + build/lapack_testing_junit.xml + if-no-files-found: warn + retention-days: 14 + + - name: Upload test results to Codecov + # Like the artifact above, uploaded even when the tests failed: a failing + # test is exactly what the test analytics report is for. + if: ${{ !cancelled() }} + continue-on-error: ${{ secrets.CODECOV_TOKEN == '' }} + uses: codecov/codecov-action@fb8b3582c8e4def4969c97caa2f19720cb33a72f # v7.0.0 + with: + token: ${{ secrets.CODECOV_TOKEN }} + # The uploader defaults to coverage; this is a test analytics report. + report_type: test_results + files: build/lapack_testing_junit.xml + # The report is named above, so there is nothing to search the tree for. + disable_search: true + flags: tests-openmp-${{ matrix.toolchain.os }}-${{ matrix.lib_type }} + name: openmp-${{ matrix.toolchain.os }}-${{ matrix.toolchain.FC }} (${{ matrix.lib_type }}) + fail_ci_if_error: true + verbose: true + + - name: Write test summary + if: ${{ !cancelled() }} + env: + ARTIFACT_URL: ${{ steps.upload-test-results.outputs.artifact-url }} + run: | + cd build 2>/dev/null || exit 0 + python3 lapack_testing.py -d TESTING --merge-apis --markdown summary.md || true + if [ -f summary.md ]; then + cat summary.md >> "$GITHUB_STEP_SUMMARY" + if [ -n "$ARTIFACT_URL" ]; then + printf '\nThe raw output of every test run (`testing_results.txt`) and a JUnit XML report are in the [test-results artifact](%s).\n' "$ARTIFACT_URL" >> "$GITHUB_STEP_SUMMARY" + fi + fi + + - name: Install + run: cmake --build build --target install -j2 + + test-extended-api-only: + name: extended-api-only (${{ matrix.lib_type }}) + runs-on: ubuntu-24.04 + + # CODECOV_TOKEN is stored as a secret of the 'codecov' environment. Nothing + # is being deployed here, so do not record a deployment for it. + environment: + name: codecov + deployment: false + + strategy: + fail-fast: false + matrix: + lib_type: [ static, shared ] + + steps: + - name: Checkout LAPACK + uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1 + + - name: Configure CMake + run: > + cmake -B build -G Ninja + -D CMAKE_BUILD_TYPE=Release + -D CMAKE_INSTALL_PREFIX=${{github.workspace}}/lapack_install + -D CBLAS:BOOL=ON + -D LAPACKE:BOOL=ON + -D BUILD_TESTING:BOOL=ON + -D LAPACKE_WITH_TMG:BOOL=ON + -D BUILD_SHARED_LIBS:BOOL=${{ matrix.lib_type == 'shared' && 'ON' || 'OFF' }} + -D BUILD_DEFAULT_API:BOOL=OFF + -D BUILD_INDEX64_EXT_API:BOOL=ON + + - name: Build + run: cmake --build build -j2 + + - name: Test + working-directory: ${{github.workspace}}/build + run: ctest --schedule-random -j2 --output-on-failure --timeout 100 + + - name: Upload test results + id: upload-test-results + if: ${{ !cancelled() }} + uses: actions/upload-artifact@043fb46d1a93c77aae656e7c1c64a875d1fc6a0a # v7.0.1 + with: + name: test-results-extended-api-${{ matrix.lib_type }} + path: | + build/TESTING/testing_results.txt + build/lapack_testing_junit.xml + if-no-files-found: warn + retention-days: 14 + + - name: Upload test results to Codecov + # Like the artifact above, uploaded even when the tests failed: a failing + # test is exactly what the test analytics report is for. + if: ${{ !cancelled() }} + continue-on-error: ${{ secrets.CODECOV_TOKEN == '' }} + uses: codecov/codecov-action@fb8b3582c8e4def4969c97caa2f19720cb33a72f # v7.0.0 + with: + token: ${{ secrets.CODECOV_TOKEN }} + # The uploader defaults to coverage; this is a test analytics report. + report_type: test_results + files: build/lapack_testing_junit.xml + # The report is named above, so there is nothing to search the tree for. + disable_search: true + flags: tests-extended-api-${{ matrix.lib_type }} + name: extended-api-only (${{ matrix.lib_type }}) + fail_ci_if_error: true + verbose: true + + - name: Write test summary + if: ${{ !cancelled() }} + env: + ARTIFACT_URL: ${{ steps.upload-test-results.outputs.artifact-url }} + run: | + cd build 2>/dev/null || exit 0 + python3 lapack_testing.py -d TESTING --merge-apis --markdown summary.md || true + if [ -f summary.md ]; then + cat summary.md >> "$GITHUB_STEP_SUMMARY" + if [ -n "$ARTIFACT_URL" ]; then + printf '\nThe raw output of every test run (`testing_results.txt`) and a JUnit XML report are in the [test-results artifact](%s).\n' "$ARTIFACT_URL" >> "$GITHUB_STEP_SUMMARY" + fi + fi + + - name: Install + run: cmake --build build --target install -j2 + + cblas-lapacke-without-fortran-compiler: + name: cblas + lapacke (${{ matrix.lib_type }}) + runs-on: ubuntu-24.04 + + strategy: + fail-fast: true + matrix: + lib_type: [ static, shared ] + + steps: + - name: Checkout LAPACK + uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1 + + - name: Install LAPACK and BLAS, remove gfortran + run: | + sudo apt update + sudo apt install -y liblapack-dev libblas-dev + sudo apt purge gfortran + + - name: Configure CMake + run: > + cmake -B build -G Ninja + -D CMAKE_BUILD_TYPE=Release + -D CMAKE_INSTALL_PREFIX=${{github.workspace}}/lapack_install + -D CBLAS:BOOL=ON + -D LAPACKE:BOOL=ON + -D USE_OPTIMIZED_BLAS:BOOL=ON + -D USE_OPTIMIZED_LAPACK:BOOL=ON + -D BUILD_TESTING:BOOL=OFF + -D LAPACKE_WITH_TMG:BOOL=OFF + -D BUILD_SHARED_LIBS:BOOL=${{ matrix.lib_type == 'shared' && 'ON' || 'OFF' }} + + - name: Build + run: cmake --build build -j2 + + - name: Install + run: cmake --build build --target install -j2 + + memory-check: + name: valgrind memory check + runs-on: ubuntu-24.04 + + steps: + - name: Checkout LAPACK + uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1 + + - name: Install APT packages + run: | + sudo apt update + sudo apt install -y valgrind + + - name: Configure CMake + run: > + cmake -B build -G Ninja + -D CMAKE_BUILD_TYPE=Debug + -D CBLAS:BOOL=ON + -D LAPACKE:BOOL=ON + -D BUILD_TESTING:BOOL=ON + -D LAPACKE_WITH_TMG:BOOL=ON + -D BUILD_SHARED_LIBS:BOOL=ON + -D LAPACK_TESTING_USE_PYTHON:BOOL=OFF + + - name: Build + run: cmake --build build -j2 + + - name: Test + working-directory: ${{github.workspace}}/build + run: | + ctest --output-on-failure --schedule-random -j2 -T memcheck > memcheck.out 2>&1 || true + cat memcheck.out + + - name: Upload valgrind logs + id: upload-valgrind-logs + if: ${{ !cancelled() }} + uses: actions/upload-artifact@043fb46d1a93c77aae656e7c1c64a875d1fc6a0a # v7.0.1 + with: + name: valgrind-logs + path: | + build/memcheck.out + build/Testing/Temporary/MemoryChecker.*.log + build/Testing/Temporary/LastDynamicAnalysis_*.log + build/Testing/*/DynamicAnalysis.xml + if-no-files-found: warn + retention-days: 14 + + - name: Check memory checking results + working-directory: ${{github.workspace}}/build + run: | + shopt -s nullglob + logs=( Testing/Temporary/MemoryChecker.*.log ) + if [ ${#logs[@]} -eq 0 ]; then + echo "::error::No MemoryChecker logs found; valgrind did not run" + exit 1 + fi + # A systematic problem makes nearly every test report a defect, so + # only the first few logs are echoed here; the artifact has them all. + max_dump=5 + dumped=0 + failed=() + for f in "${logs[@]}"; do + if tail -n 1 "$f" | grep -q "ERROR SUMMARY: 0 errors"; then + continue + fi + failed+=( "$f" ) + if [ "$dumped" -lt "$max_dump" ]; then + echo "::group::$f" + cat "$f" + echo "::endgroup::" + dumped=$(( dumped + 1 )) + fi + done + if [ ${#failed[@]} -eq 0 ]; then + echo "All ${#logs[@]} logs reported no valgrind errors" + exit 0 + fi + echo "::error::Memory check failed in ${#failed[@]} of ${#logs[@]} tests" + printf '%s\n' "${failed[@]}" + if [ ${#failed[@]} -gt "$max_dump" ]; then + echo "Only the first $max_dump logs are shown above;" \ + "every log is in the valgrind-logs artifact." + fi + exit 1 + + - name: Write memory check summary + if: ${{ !cancelled() }} + env: + ARTIFACT_URL: ${{ steps.upload-valgrind-logs.outputs.artifact-url }} + run: | + cd build 2>/dev/null || exit 0 + [ -f memcheck.out ] || exit 0 + defects=$(sed -n '/^Memory checking results:/,$p' memcheck.out | tail -n +2) || true + { + echo '## valgrind memory check' + echo + if [ -n "$defects" ]; then + echo 'Defects reported by CTest:' + echo + echo "$defects" | sed 's/^/- /' + else + echo 'No defects reported.' + fi + if [ -n "$ARTIFACT_URL" ]; then + printf '\nThe full valgrind output for every test is in the [valgrind-logs artifact](%s).\n' "$ARTIFACT_URL" + fi + } >> "$GITHUB_STEP_SUMMARY" + + coverage: + name: gcov coverage + runs-on: ubuntu-24.04 + + # CODECOV_TOKEN is stored as a secret of the 'codecov' environment. Nothing + # is being deployed here, so do not record a deployment for it. + environment: + name: codecov + deployment: false + + env: + FFLAGS: "-Wall -pedantic -Wno-unused-dummy-argument -Wno-unused-variable -Wno-unused-label -fopenmp" + + steps: + - name: Checkout LAPACK + uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1 + with: + # Codecov cannot determine which commit a report belongs to from a + # depth-1 clone of a pull request merge commit. + fetch-depth: 2 + + - name: Configure CMake + run: > + cmake -B build -G Ninja + -D CMAKE_BUILD_TYPE=Coverage + -D CMAKE_INSTALL_PREFIX=${{github.workspace}}/lapack_install + -D CBLAS:BOOL=ON + -D LAPACKE:BOOL=ON + -D BUILD_TESTING:BOOL=ON + -D LAPACKE_WITH_TMG:BOOL=ON + -D BUILD_SHARED_LIBS:BOOL=ON + -D BUILD_INDEX64_EXT_API:BOOL=OFF + + - name: Build + run: cmake --build build -j2 + + - name: Test + working-directory: ${{github.workspace}}/build + run: ctest --schedule-random -j2 --output-on-failure --timeout 1800 + + - name: Coverage + if: ${{ !cancelled() }} + run: cmake --build build --target coverage + + - name: Summarize coverage + # The coverage target discards gcov's output, so an entirely empty report + # is indistinguishable from a good one unless we look at the numbers. + # Print them, per component, and fail if any component measured nothing: + # each is uploaded under its own Codecov flag, and a flag without data + # would quietly disappear from the report. + if: ${{ !cancelled() }} + run: | + gcda=$(find build -name '*.gcda' | wc -l) + reports=$(find build -name '*.gcov' | wc -l) + echo "counter files (.gcda): ${gcda}" + echo "gcov reports (.gcov): ${reports}" + if [ "${gcda}" -eq 0 ] || [ "${reports}" -eq 0 ]; then + echo "::error::No coverage data was recorded; the report would be empty." + exit 1 + fi + status=0 + summary="" + # gcov writes its report next to the object it belongs to, so the + # reports of a component are those below its own build directory. + # These are the directories the uploads below use as well. + for component in BLAS:build/BLAS CBLAS:build/CBLAS LAPACK:build/SRC \ + LAPACKE:build/LAPACKE TESTING:build/TESTING; do + name=${component%%:*} + dir=${component#*:} + if [ ! -d "${dir}" ]; then + echo "::error::${name}: ${dir} does not exist; its Codecov flag would be empty." + status=1 + continue + fi + files=$(find "${dir}" -name '*.gcov' | wc -l) + # In a gcov report an executed line is prefixed with its execution + # count and an unexecuted one with '#####' or '====='; everything + # else ('-') is not executable. gcov -b additionally emits one + # 'branch N ...' record per branch outcome, taken either a number + # of times or never; a branch outcome counts as covered when it was + # taken at least once. + set -- $(find "${dir}" -name '*.gcov' -exec cat {} + | awk ' + /^ *[0-9]+[*]?:/ { hit++; next } + /^ *(#####|=====):/ { miss++; next } + /^branch +[0-9]+ taken/ { btotal++; if ($4 + 0 > 0) bhit++; next } + /^branch +[0-9]+ never/ { btotal++ } + END { printf "%d %d %d %d\n", hit + 0, hit + miss + 0, bhit + 0, btotal + 0 }') + hit=$1 + total=$2 + bhit=$3 + btotal=$4 + if [ "${hit}" -eq 0 ]; then + echo "::error::${name}: not a single line was executed; its Codecov flag would be empty." + status=1 + percent="n/a" + else + percent=$(awk -v h="${hit}" -v t="${total}" 'BEGIN { printf "%.2f%%", 100 * h / t }') + fi + # A component with no branches at all is possible in principle, so + # report n/a rather than dividing by zero. + if [ "${btotal}" -eq 0 ]; then + bpercent="n/a" + else + bpercent=$(awk -v h="${bhit}" -v t="${btotal}" 'BEGIN { printf "%.2f%%", 100 * h / t }') + fi + echo "${name}: ${hit} of ${total} lines executed (${percent}), ${bhit} of ${btotal} branches taken (${bpercent}) across ${files} files" + summary="${summary}| ${name} | ${percent} | ${hit} | ${total} | ${bpercent} | ${bhit} | ${btotal} | ${files} |"$'\n' + done + printf '## Coverage\n\n| Component | Lines | Executed | Executable | Branches | Taken | Total | Files |\n| --- | --: | --: | --: | --: | --: | --: | --: |\n%s' \ + "${summary}" >> "$GITHUB_STEP_SUMMARY" + exit ${status} + + # Each component is uploaded on its own, so that Codecov reports the + # coverage of BLAS, CBLAS, LAPACK and LAPACKE under a flag of its own + # rather than as a single number for the whole library. The flags are + # declared in codecov.yml. + - name: Upload BLAS coverage report to Codecov + if: ${{ !cancelled() }} + continue-on-error: ${{ secrets.CODECOV_TOKEN == '' }} + uses: codecov/codecov-action@fb8b3582c8e4def4969c97caa2f19720cb33a72f # v7.0.0 + with: + token: ${{ secrets.CODECOV_TOKEN }} + directory: build/BLAS + flags: blas + name: BLAS + # The .gcov files already exist, so there is no need for the uploader + # to run gcov a second time itself. + plugins: noop + fail_ci_if_error: true + verbose: true + + - name: Upload CBLAS coverage report to Codecov + if: ${{ !cancelled() }} + continue-on-error: ${{ secrets.CODECOV_TOKEN == '' }} + uses: codecov/codecov-action@fb8b3582c8e4def4969c97caa2f19720cb33a72f # v7.0.0 + with: + token: ${{ secrets.CODECOV_TOKEN }} + directory: build/CBLAS + flags: cblas + name: CBLAS + plugins: noop + fail_ci_if_error: true + verbose: true + + - name: Upload LAPACK coverage report to Codecov + if: ${{ !cancelled() }} + continue-on-error: ${{ secrets.CODECOV_TOKEN == '' }} + uses: codecov/codecov-action@fb8b3582c8e4def4969c97caa2f19720cb33a72f # v7.0.0 + with: + token: ${{ secrets.CODECOV_TOKEN }} + directory: build/SRC + flags: lapack + name: LAPACK + plugins: noop + fail_ci_if_error: true + verbose: true + + - name: Upload LAPACK testing coverage report to Codecov + if: ${{ !cancelled() }} + continue-on-error: ${{ secrets.CODECOV_TOKEN == '' }} + uses: codecov/codecov-action@fb8b3582c8e4def4969c97caa2f19720cb33a72f # v7.0.0 + with: + token: ${{ secrets.CODECOV_TOKEN }} + directory: build/TESTING + flags: lapack + name: LAPACK testing + plugins: noop + fail_ci_if_error: true + verbose: true + + - name: Upload LAPACKE coverage report to Codecov + if: ${{ !cancelled() }} + continue-on-error: ${{ secrets.CODECOV_TOKEN == '' }} + uses: codecov/codecov-action@fb8b3582c8e4def4969c97caa2f19720cb33a72f # v7.0.0 + with: + token: ${{ secrets.CODECOV_TOKEN }} + directory: build/LAPACKE + flags: lapacke + name: LAPACKE + plugins: noop + fail_ci_if_error: true + verbose: true diff --git a/.gitignore b/.gitignore index 4ac90962e3..a2fdec0111 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* @@ -23,10 +27,13 @@ CBLAS/examples/cblas_ex1 CBLAS/examples/cblas_ex2 # LAPACK testing +/lapack_testing_junit.xml TESTING/LIN/xlintst* TESTING/EIG/xeigtst* +TESTING/EIG/xdmd* TESTING/*.out TESTING/*.txt +!TESTING/CMakeLists.txt TESTING/x* # LAPACKE example @@ -35,3 +42,13 @@ LAPACKE/example/xexample* # SED SRC/*-e LAPACKE/src/*-e +build* + +# DOCS documentation +DOCS/man +DOCS/explore-html +output_err + +# Mod files from compilation in SRC +SRC/la_constants.mod +SRC/la_xisnan.mod diff --git a/.travis.yml b/.travis.yml index 68cfa607aa..71d5bd8437 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,38 +1,50 @@ -language: cpp +language: c +dist: xenial +group: travis_latest + +git: + depth: 3 + quiet: true addons: apt: - sources: - - george-edison55-precise-backports # cmake packages: - - cmake - - cmake-data - - gfortran - -os: - - linux - - osx + - gfortran -env: - - CMAKE_BUILD_TYPE=Release - - CMAKE_BUILD_TYPE=Coverage - -install: - - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; - then - for pkg in gcc cmake; do - if brew list -1 | grep -q "^${pkg}\$"; then - brew outdated $pkg || brew upgrade $pkg; - else - brew install $pkg; - fi - done - fi +matrix: + include: + - os: linux + name: "CMake Release Test on Linux" + env: CMAKE_BUILD_TYPE=Release + - os: linux + name: "Makefile Test on Linux" + script: + - rm -f make.inc + - cp make.inc.example make.inc + - make FFLAGS="-fimplicit-none -frecursive -fcheck=all" -s -j2 all + - make -j2 lapack_install + - os: linux + name: "CMake Coverage Test on Linux" + env: CMAKE_BUILD_TYPE=Coverage + - os: osx + name: "CMake Release Test on macOS Big Sur" + osx_image: xcode12.3 + env: CMAKE_BUILD_TYPE=Release + - os: osx + osx_image: xcode12.3 + name: "Makefile Test on on macOS Big Sur" + script: + - rm -f make.inc + - cp make.inc.example make.inc + - make FFLAGS="-fimplicit-none -frecursive -fcheck=all" -s -j2 all + - make -j2 lapack_install -script: +before_script: - export PR=https://api.github.com/repos/$TRAVIS_REPO_SLUG/pulls/$TRAVIS_PULL_REQUEST - export BRANCH=$(if [ "$TRAVIS_PULL_REQUEST" == "false" ]; then echo $TRAVIS_BRANCH; else echo `curl -s $PR | jq -r .head.ref`; fi) - echo "TRAVIS_BRANCH=$TRAVIS_BRANCH, PR=$PR, BRANCH=$BRANCH" + +script: - export SRC_DIR=$(pwd) - export BLD_DIR=${SRC_DIR}/lapack-travis-bld - export INST_DIR=${SRC_DIR}/../lapack-travis-install @@ -47,6 +59,9 @@ script: -DLAPACKE:BOOL=ON -DBUILD_TESTING=ON -DLAPACKE_WITH_TMG:BOOL=ON + -DBUILD_SHARED_LIBS:BOOL=ON + -DCMAKE_Fortran_FLAGS:STRING="-fimplicit-none -frecursive -fcheck=all" + -DCMAKE_C_FLAGS=${CMAKE_C_FLAGS} ${SRC_DIR} - ctest -D ExperimentalStart - ctest -D ExperimentalConfigure diff --git a/BLAS/CMakeLists.txt b/BLAS/CMakeLists.txt index e122b2b33e..a33f38f253 100644 --- a/BLAS/CMakeLists.txt +++ b/BLAS/CMakeLists.txt @@ -1,9 +1,16 @@ +enable_language(Fortran) + +# Check for any necessary platform specific compiler flags +include(CheckLAPACKCompilerFlags) +CheckLAPACKCompilerFlags() + add_subdirectory(SRC) if(BUILD_TESTING) add_subdirectory(TESTING) endif() -configure_file(${CMAKE_CURRENT_SOURCE_DIR}/blas.pc.in ${CMAKE_CURRENT_BINARY_DIR}/blas.pc @ONLY) +configure_file(${CMAKE_CURRENT_SOURCE_DIR}/blas.pc.in ${CMAKE_CURRENT_BINARY_DIR}/${BLASLIB}.pc @ONLY) install(FILES - ${CMAKE_CURRENT_BINARY_DIR}/blas.pc + ${CMAKE_CURRENT_BINARY_DIR}/${BLASLIB}.pc DESTINATION ${PKG_CONFIG_DIR} + COMPONENT Development ) diff --git a/BLAS/Makefile b/BLAS/Makefile index f9c4b534c8..088ea5d500 100644 --- a/BLAS/Makefile +++ b/BLAS/Makefile @@ -1,13 +1,18 @@ -include ../make.inc +TOPSRCDIR = .. +include $(TOPSRCDIR)/make.inc +.PHONY: all all: blas +.PHONY: blas blas: $(MAKE) -C SRC +.PHONY: blas_testing blas_testing: blas $(MAKE) -C TESTING run +.PHONY: clean cleanobj cleanlib cleanexe cleantest clean: $(MAKE) -C SRC clean $(MAKE) -C TESTING clean diff --git a/BLAS/SRC/CMakeLists.txt b/BLAS/SRC/CMakeLists.txt index 41c4804324..aa725c971a 100644 --- a/BLAS/SRC/CMakeLists.txt +++ b/BLAS/SRC/CMakeLists.txt @@ -28,21 +28,34 @@ #--------------------------------------------------------- # Level 1 BLAS #--------------------------------------------------------- -set(SBLAS1 isamax.f sasum.f saxpy.f scopy.f sdot.f snrm2.f - srot.f srotg.f sscal.f sswap.f sdsdot.f srotmg.f srotm.f) -set(CBLAS1 scabs1.f scasum.f scnrm2.f icamax.f caxpy.f ccopy.f - cdotc.f cdotu.f csscal.f crotg.f cscal.f cswap.f csrot.f) +set(LAPACK_INSTALL_EXPORT_NAME ${BLASLIB}-targets) -set(DBLAS1 idamax.f dasum.f daxpy.f dcopy.f ddot.f dnrm2.f - drot.f drotg.f dscal.f dsdot.f dswap.f drotmg.f drotm.f) +set(SBLAS1 + isamax.f sasum.f saxpy.f saxpby.f scopy.f sdot.f snrm2.f90 srot.f srotg.f90 + sscal.f sswap.f sdsdot.f srotmg.f srotm.f) -set(ZBLAS1 dcabs1.f dzasum.f dznrm2.f izamax.f zaxpy.f zcopy.f - zdotc.f zdotu.f zdscal.f zrotg.f zscal.f zswap.f zdrot.f) +set(CBLAS1 + scabs1.f scasum.f scnrm2.f90 icamax.f90 caxpy.f caxpby.f ccopy.f cdotc.f + cdotu.f csscal.f crotg.f90 cscal.f cswap.f csrot.f) -set(CB1AUX isamax.f sasum.f saxpy.f scopy.f snrm2.f sscal.f) +set(DBLAS1 + idamax.f dasum.f daxpy.f daxpby.f dcopy.f ddot.f dnrm2.f90 drot.f drotg.f90 + dscal.f dsdot.f dswap.f drotmg.f drotm.f) -set(ZB1AUX idamax.f dasum.f daxpy.f dcopy.f dnrm2.f dscal.f) +set(DB1AUX sscal.f isamax.f) + +set(ZBLAS1 + dcabs1.f dzasum.f dznrm2.f90 izamax.f90 zaxpy.f zaxpby.f zcopy.f zdotc.f + zdotu.f zdscal.f zrotg.f90 zscal.f zswap.f zdrot.f) + +set(CB1AUX + isamax.f idamax.f sasum.f saxpy.f scopy.f sdot.f sgemm.f sgemv.f snrm2.f90 + srot.f sscal.f sswap.f) + +set(ZB1AUX + icamax.f90 idamax.f cgemm.f cherk.f cscal.f ctrsm.f dasum.f daxpy.f dcopy.f + ddot.f dgemm.f dgemv.f dnrm2.f90 drot.f dscal.f dswap.f scabs1.f) #--------------------------------------------------------------------- # Auxiliary routines needed by both the Level 2 and Level 3 BLAS @@ -52,34 +65,40 @@ set(ALLBLAS lsame.f xerbla.f xerbla_array.f) #--------------------------------------------------------- # Level 2 BLAS #--------------------------------------------------------- -set(SBLAS2 sgemv.f sgbmv.f ssymv.f ssbmv.f sspmv.f - strmv.f stbmv.f stpmv.f strsv.f stbsv.f stpsv.f - sger.f ssyr.f sspr.f ssyr2.f sspr2.f) +set(SBLAS2 + sgemv.f sgbmv.f ssymv.f ssbmv.f sspmv.f strmv.f stbmv.f stpmv.f strsv.f + stbsv.f stpsv.f sger.f ssyr.f sspr.f ssyr2.f sspr2.f sskewsymv.f sskewsyr2.f) -set(CBLAS2 cgemv.f cgbmv.f chemv.f chbmv.f chpmv.f - ctrmv.f ctbmv.f ctpmv.f ctrsv.f ctbsv.f ctpsv.f - cgerc.f cgeru.f cher.f chpr.f cher2.f chpr2.f) +set(CBLAS2 + cgemv.f cgbmv.f chemv.f chbmv.f chpmv.f ctrmv.f ctbmv.f ctpmv.f ctrsv.f + ctbsv.f ctpsv.f cgerc.f cgeru.f cher.f chpr.f cher2.f chpr2.f) -set(DBLAS2 dgemv.f dgbmv.f dsymv.f dsbmv.f dspmv.f - dtrmv.f dtbmv.f dtpmv.f dtrsv.f dtbsv.f dtpsv.f - dger.f dsyr.f dspr.f dsyr2.f dspr2.f) +set(DBLAS2 + dgemv.f dgbmv.f dsymv.f dsbmv.f dspmv.f dtrmv.f dtbmv.f dtpmv.f dtrsv.f + dtbsv.f dtpsv.f dger.f dsyr.f dspr.f dsyr2.f dspr2.f dskewsymv.f dskewsyr2.f) -set(ZBLAS2 zgemv.f zgbmv.f zhemv.f zhbmv.f zhpmv.f - ztrmv.f ztbmv.f ztpmv.f ztrsv.f ztbsv.f ztpsv.f - zgerc.f zgeru.f zher.f zhpr.f zher2.f zhpr2.f) +set(ZBLAS2 + zgemv.f zgbmv.f zhemv.f zhbmv.f zhpmv.f ztrmv.f ztbmv.f ztpmv.f ztrsv.f + ztbsv.f ztpsv.f zgerc.f zgeru.f zher.f zhpr.f zher2.f zhpr2.f) #--------------------------------------------------------- # Level 3 BLAS #--------------------------------------------------------- -set(SBLAS3 sgemm.f ssymm.f ssyrk.f ssyr2k.f strmm.f strsm.f) +set(SBLAS3 + sgemm.f ssymm.f ssyrk.f ssyr2k.f strmm.f strsm.f sgemmtr.f sskewsymm.f + sskewsyr2k.f) -set(CBLAS3 cgemm.f csymm.f csyrk.f csyr2k.f ctrmm.f ctrsm.f - chemm.f cherk.f cher2k.f) +set(CBLAS3 + cgemm.f csymm.f csyrk.f csyr2k.f ctrmm.f ctrsm.f chemm.f cherk.f cher2k.f + cgemmtr.f) -set(DBLAS3 dgemm.f dsymm.f dsyrk.f dsyr2k.f dtrmm.f dtrsm.f) +set(DBLAS3 + dgemm.f dsymm.f dsyrk.f dsyr2k.f dtrmm.f dtrsm.f dgemmtr.f dskewsymm.f + dskewsyr2k.f) -set(ZBLAS3 zgemm.f zsymm.f zsyrk.f zsyr2k.f ztrmm.f ztrsm.f - zhemm.f zherk.f zher2k.f) +set(ZBLAS3 + zgemm.f zsymm.f zsyrk.f zsyr2k.f ztrmm.f ztrsm.f zhemm.f zherk.f zher2k.f + zgemmtr.f) set(SOURCES) @@ -87,7 +106,8 @@ if(BUILD_SINGLE) list(APPEND SOURCES ${SBLAS1} ${ALLBLAS} ${SBLAS2} ${SBLAS3}) endif() if(BUILD_DOUBLE) - list(APPEND SOURCES ${DBLAS1} ${ALLBLAS} ${DBLAS2} ${DBLAS3}) + list(APPEND SOURCES + ${DBLAS1} ${DB1AUX} ${ALLBLAS} ${DBLAS2} ${DBLAS3} ${SBLAS3}) endif() if(BUILD_COMPLEX) list(APPEND SOURCES ${CBLAS1} ${CB1AUX} ${ALLBLAS} ${CBLAS2} ${CBLAS3}) @@ -97,10 +117,45 @@ if(BUILD_COMPLEX16) endif() list(REMOVE_DUPLICATES SOURCES) -add_library(blas ${SOURCES}) +if(BUILD_DEFAULT_API) + add_library(${BLASLIB}_obj OBJECT ${SOURCES}) + lapack_add_coverage(${BLASLIB}_obj) +endif() + +if(BUILD_INDEX64_EXT_API) + include(ExtendedAPIHelpers) + generate_64bit_suffixed_sources(${BLASLIB} SOURCES SOURCES_64) + + add_library(${BLASLIB}_64_obj OBJECT ${SOURCES_64}) + target_compile_options(${BLASLIB}_64_obj PRIVATE ${FOPT_ILP64}) +endif() + +add_library(${BLASLIB} + $<$: $> + $<$: $>) + +# For flang, use C linker instead of Fortran linker to avoid macOS-specific flags +# that CMake adds (tested CMake 4.2). +if(CMAKE_Fortran_COMPILER_ID STREQUAL "LLVMFlang") + set_target_properties (${BLASLIB} PROPERTIES LINKER_LANGUAGE C) +endif() + set_target_properties( - blas PROPERTIES + ${BLASLIB} PROPERTIES VERSION ${LAPACK_VERSION} SOVERSION ${LAPACK_MAJOR_VERSION} ) -lapack_install_library(blas) +lapack_add_coverage(${BLASLIB}) +lapack_install_library(${BLASLIB}) + +add_library(BLAS::BLAS ALIAS ${BLASLIB}) +install(EXPORT ${BLASLIB}-targets + FILE ${BLASLIB}-targets.cmake + NAMESPACE BLAS:: + DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/${LAPACKLIB}-${LAPACK_VERSION} + COMPONENT Development +) + +if( TEST_FORTRAN_COMPILER ) + add_dependencies( ${BLASLIB} run_test_zcomplexabs run_test_zcomplexdiv run_test_zcomplexmult run_test_zminMax ) +endif() diff --git a/BLAS/SRC/icamax.f b/BLAS/SRC/DEPRECATED/icamax.f similarity index 93% rename from BLAS/SRC/icamax.f rename to BLAS/SRC/DEPRECATED/icamax.f index 763172f685..b65cbf8cf3 100644 --- a/BLAS/SRC/icamax.f +++ b/BLAS/SRC/DEPRECATED/icamax.f @@ -43,7 +43,7 @@ *> \param[in] INCX *> \verbatim *> INCX is INTEGER -*> storage spacing between elements of SX +*> storage spacing between elements of CX *> \endverbatim * * Authors: @@ -54,9 +54,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup aux_blas +*> \ingroup iamax * *> \par Further Details: * ===================== @@ -71,10 +69,9 @@ * ===================================================================== INTEGER FUNCTION ICAMAX(N,CX,INCX) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,N @@ -124,4 +121,7 @@ INTEGER FUNCTION ICAMAX(N,CX,INCX) END DO END IF RETURN +* +* End of ICAMAX +* END diff --git a/BLAS/SRC/izamax.f b/BLAS/SRC/DEPRECATED/izamax.f similarity index 93% rename from BLAS/SRC/izamax.f rename to BLAS/SRC/DEPRECATED/izamax.f index 291a128ea0..0fe4125070 100644 --- a/BLAS/SRC/izamax.f +++ b/BLAS/SRC/DEPRECATED/izamax.f @@ -43,7 +43,7 @@ *> \param[in] INCX *> \verbatim *> INCX is INTEGER -*> storage spacing between elements of SX +*> storage spacing between elements of ZX *> \endverbatim * * Authors: @@ -54,9 +54,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup aux_blas +*> \ingroup iamax * *> \par Further Details: * ===================== @@ -71,10 +69,9 @@ * ===================================================================== INTEGER FUNCTION IZAMAX(N,ZX,INCX) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,N @@ -124,4 +121,7 @@ INTEGER FUNCTION IZAMAX(N,ZX,INCX) END DO END IF RETURN +* +* End of IZAMAX +* END diff --git a/BLAS/SRC/Makefile b/BLAS/SRC/Makefile index a436365aa3..1a0816c83d 100644 --- a/BLAS/SRC/Makefile +++ b/BLAS/SRC/Makefile @@ -1,5 +1,3 @@ -include ../../make.inc - ####################################################################### # This is the makefile to create a library for the BLAS. # The files are grouped as follows: @@ -55,25 +53,35 @@ include ../../make.inc # ####################################################################### +TOPSRCDIR = ../.. +include $(TOPSRCDIR)/make.inc + +.SUFFIXES: .F .f90 .o +.F.o: + $(FC) $(FFLAGS) -c -o $@ $< +.f90.o: + $(FC) $(FFLAGS) -c -o $@ $< + +.PHONY: all all: $(BLASLIB) #--------------------------------------------------------- # Comment out the next 6 definitions if you already have # the Level 1 BLAS. #--------------------------------------------------------- -SBLAS1 = isamax.o sasum.o saxpy.o scopy.o sdot.o snrm2.o \ +SBLAS1 = isamax.o sasum.o saxpy.o saxpby.o scopy.o sdot.o snrm2.o \ srot.o srotg.o sscal.o sswap.o sdsdot.o srotmg.o srotm.o $(SBLAS1): $(FRC) -CBLAS1 = scabs1.o scasum.o scnrm2.o icamax.o caxpy.o ccopy.o \ +CBLAS1 = scabs1.o scasum.o scnrm2.o icamax.o caxpy.o caxpby.o ccopy.o \ cdotc.o cdotu.o csscal.o crotg.o cscal.o cswap.o csrot.o $(CBLAS1): $(FRC) -DBLAS1 = idamax.o dasum.o daxpy.o dcopy.o ddot.o dnrm2.o \ +DBLAS1 = idamax.o dasum.o daxpy.o daxpby.o dcopy.o ddot.o dnrm2.o \ drot.o drotg.o dscal.o dsdot.o dswap.o drotmg.o drotm.o $(DBLAS1): $(FRC) -ZBLAS1 = dcabs1.o dzasum.o dznrm2.o izamax.o zaxpy.o zcopy.o \ +ZBLAS1 = dcabs1.o dzasum.o dznrm2.o izamax.o zaxpy.o zaxpby.o zcopy.o \ zdotc.o zdotu.o zdscal.o zrotg.o zscal.o zswap.o zdrot.o $(ZBLAS1): $(FRC) @@ -97,7 +105,8 @@ $(ALLBLAS): $(FRC) #--------------------------------------------------------- SBLAS2 = sgemv.o sgbmv.o ssymv.o ssbmv.o sspmv.o \ strmv.o stbmv.o stpmv.o strsv.o stbsv.o stpsv.o \ - sger.o ssyr.o sspr.o ssyr2.o sspr2.o + sger.o ssyr.o sspr.o ssyr2.o sspr2.o \ + sskewsymv.o sskewsyr2.o $(SBLAS2): $(FRC) CBLAS2 = cgemv.o cgbmv.o chemv.o chbmv.o chpmv.o \ @@ -107,7 +116,8 @@ $(CBLAS2): $(FRC) DBLAS2 = dgemv.o dgbmv.o dsymv.o dsbmv.o dspmv.o \ dtrmv.o dtbmv.o dtpmv.o dtrsv.o dtbsv.o dtpsv.o \ - dger.o dsyr.o dspr.o dsyr2.o dspr2.o + dger.o dsyr.o dspr.o dsyr2.o dspr2.o \ + dskewsymv.o dskewsyr2.o $(DBLAS2): $(FRC) ZBLAS2 = zgemv.o zgbmv.o zhemv.o zhbmv.o zhpmv.o \ @@ -119,18 +129,20 @@ $(ZBLAS2): $(FRC) # Comment out the next 4 definitions if you already have # the Level 3 BLAS. #--------------------------------------------------------- -SBLAS3 = sgemm.o ssymm.o ssyrk.o ssyr2k.o strmm.o strsm.o +SBLAS3 = sgemm.o ssymm.o ssyrk.o ssyr2k.o strmm.o strsm.o sgemmtr.o \ + sskewsymm.o sskewsyr2k.o $(SBLAS3): $(FRC) CBLAS3 = cgemm.o csymm.o csyrk.o csyr2k.o ctrmm.o ctrsm.o \ - chemm.o cherk.o cher2k.o + chemm.o cherk.o cher2k.o cgemmtr.o $(CBLAS3): $(FRC) -DBLAS3 = dgemm.o dsymm.o dsyrk.o dsyr2k.o dtrmm.o dtrsm.o +DBLAS3 = dgemm.o dsymm.o dsyrk.o dsyr2k.o dtrmm.o dtrsm.o dgemmtr.o \ + dskewsymm.o dskewsyr2k.o $(DBLAS3): $(FRC) ZBLAS3 = zgemm.o zsymm.o zsyrk.o zsyr2k.o ztrmm.o ztrsm.o \ - zhemm.o zherk.o zher2k.o + zhemm.o zherk.o zher2k.o zgemmtr.o $(ZBLAS3): $(FRC) ALLOBJ = $(SBLAS1) $(SBLAS2) $(SBLAS3) $(DBLAS1) $(DBLAS2) $(DBLAS3) \ @@ -138,33 +150,32 @@ ALLOBJ = $(SBLAS1) $(SBLAS2) $(SBLAS3) $(DBLAS1) $(DBLAS2) $(DBLAS3) \ $(ZBLAS2) $(ZBLAS3) $(ALLBLAS) $(BLASLIB): $(ALLOBJ) - $(ARCH) $(ARCHFLAGS) $@ $^ + $(AR) $(ARFLAGS) $@ $^ $(RANLIB) $@ +.PHONY: single double complex complex16 single: $(SBLAS1) $(ALLBLAS) $(SBLAS2) $(SBLAS3) - $(ARCH) $(ARCHFLAGS) $(BLASLIB) $^ + $(AR) $(ARFLAGS) $(BLASLIB) $^ $(RANLIB) $(BLASLIB) double: $(DBLAS1) $(ALLBLAS) $(DBLAS2) $(DBLAS3) - $(ARCH) $(ARCHFLAGS) $(BLASLIB) $^ + $(AR) $(ARFLAGS) $(BLASLIB) $^ $(RANLIB) $(BLASLIB) complex: $(CBLAS1) $(CB1AUX) $(ALLBLAS) $(CBLAS2) $(CBLAS3) - $(ARCH) $(ARCHFLAGS) $(BLASLIB) $^ + $(AR) $(ARFLAGS) $(BLASLIB) $^ $(RANLIB) $(BLASLIB) complex16: $(ZBLAS1) $(ZB1AUX) $(ALLBLAS) $(ZBLAS2) $(ZBLAS3) - $(ARCH) $(ARCHFLAGS) $(BLASLIB) $^ + $(AR) $(ARFLAGS) $(BLASLIB) $^ $(RANLIB) $(BLASLIB) FRC: @FRC=$(FRC) +.PHONY: clean cleanobj cleanlib clean: cleanobj cleanlib cleanobj: rm -f *.o cleanlib: #rm -f $(BLASLIB) # May point to a system lib, e.g. -lblas - -.f.o: - $(FORTRAN) $(OPTS) -c -o $@ $< diff --git a/BLAS/SRC/caxpby.f b/BLAS/SRC/caxpby.f new file mode 100644 index 0000000000..3ae8486a95 --- /dev/null +++ b/BLAS/SRC/caxpby.f @@ -0,0 +1,144 @@ +*> \brief \b CAXPBY +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE CAXPBY(N,CA,CX,INCX,CB,CY,INCY) +* +* .. Scalar Arguments .. +* COMPLEX CA,CB +* INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. +* COMPLEX CX(*),CY(*) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> CAXPBY constant times a vector plus constant times a vector. +*> +*> Y = ALPHA * X + BETA * Y +*> +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> number of elements in input vector(s) +*> \endverbatim +*> +*> \param[in] CA +*> \verbatim +*> CA is COMPLEX +*> On entry, CA specifies the scalar alpha. +*> \endverbatim +*> +*> \param[in] CX +*> \verbatim +*> CX is COMPLEX array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) +*> \endverbatim +*> +*> \param[in] INCX +*> \verbatim +*> INCX is INTEGER +*> storage spacing between elements of CX +*> \endverbatim +*> +*> \param[in] CB +*> \verbatim +*> CB is COMPLEX +*> On entry, CB specifies the scalar beta. +*> \endverbatim +*> +*> \param[in,out] CY +*> \verbatim +*> CY is COMPLEX array, dimension ( 1 + ( N - 1 )*abs( INCY ) ) +*> \endverbatim +*> +*> \param[in] INCY +*> \verbatim +*> INCY is INTEGER +*> storage spacing between elements of CY +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +*> \author Martin Koehler, MPI Magdeburg +* +*> \ingroup axpby +* +* ===================================================================== + SUBROUTINE CAXPBY(N,CA,CX,INCX,CB,CY,INCY) + IMPLICIT NONE +* +* -- Reference BLAS level1 routine -- +* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + COMPLEX CA, CB + INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. + COMPLEX CX(*),CY(*) +* .. +* .. External Subroutines .. + EXTERNAL CSCAL +* +* ===================================================================== +* +* .. Local Scalars .. + INTEGER I,IX,IY +* .. + IF (N.LE.0) RETURN + + IF (CA .EQ. (0.0,0.0) .AND. CB.NE.(0.0,0.0)) THEN + CALL CSCAL(N,CB, CY, INCY) + RETURN + END IF + + IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN +* +* code for both increments equal to 1 +* + DO I = 1,N + CY(I) = CB*CY(I) + CA*CX(I) + END DO + ELSE +* +* code for unequal increments or equal increments +* not equal to 1 +* + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO I = 1,N + CY(IY) = CB*CY(IY) + CA*CX(IX) + IX = IX + INCX + IY = IY + INCY + END DO + END IF +* + RETURN +* +* End of CAXBPY +* + END diff --git a/BLAS/SRC/caxpy.f b/BLAS/SRC/caxpy.f index 3655523b0f..6879a14bca 100644 --- a/BLAS/SRC/caxpy.f +++ b/BLAS/SRC/caxpy.f @@ -72,9 +72,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level1 +*> \ingroup axpy * *> \par Further Details: * ===================== @@ -87,11 +85,11 @@ *> * ===================================================================== SUBROUTINE CAXPY(N,CA,CX,INCX,CY,INCY) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX CA @@ -105,13 +103,16 @@ SUBROUTINE CAXPY(N,CA,CX,INCX,CY,INCY) * * .. Local Scalars .. INTEGER I,IX,IY + COMPLEX CDUM +* .. +* .. Statement Functions .. + REAL CABS1 * .. -* .. External Functions .. - REAL SCABS1 - EXTERNAL SCABS1 +* .. Statement Function definitions .. + CABS1(CDUM) = ABS(REAL(CDUM)) + ABS(AIMAG(CDUM)) * .. IF (N.LE.0) RETURN - IF (SCABS1(CA).EQ.0.0E+0) RETURN + IF (CABS1(CA).EQ.0.0E+0) RETURN IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN * * code for both increments equal to 1 @@ -136,4 +137,7 @@ SUBROUTINE CAXPY(N,CA,CX,INCX,CY,INCY) END IF * RETURN +* +* End of CAXPY +* END diff --git a/BLAS/SRC/ccopy.f b/BLAS/SRC/ccopy.f index 4f3d9f01c6..7d8c04dc16 100644 --- a/BLAS/SRC/ccopy.f +++ b/BLAS/SRC/ccopy.f @@ -65,9 +65,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level1 +*> \ingroup copy * *> \par Further Details: * ===================== @@ -80,11 +78,11 @@ *> * ===================================================================== SUBROUTINE CCOPY(N,CX,INCX,CY,INCY) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,INCY,N @@ -122,4 +120,7 @@ SUBROUTINE CCOPY(N,CX,INCX,CY,INCY) END DO END IF RETURN +* +* End of CCOPY +* END diff --git a/BLAS/SRC/cdotc.f b/BLAS/SRC/cdotc.f index 743d9065af..bc38c7af46 100644 --- a/BLAS/SRC/cdotc.f +++ b/BLAS/SRC/cdotc.f @@ -39,7 +39,7 @@ *> *> \param[in] CX *> \verbatim -*> CX is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) +*> CX is COMPLEX array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) *> \endverbatim *> *> \param[in] INCX @@ -50,7 +50,7 @@ *> *> \param[in] CY *> \verbatim -*> CY is REAL array, dimension ( 1 + ( N - 1 )*abs( INCY ) ) +*> CY is COMPLEX array, dimension ( 1 + ( N - 1 )*abs( INCY ) ) *> \endverbatim *> *> \param[in] INCY @@ -67,9 +67,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level1 +*> \ingroup dot * *> \par Further Details: * ===================== @@ -82,11 +80,11 @@ *> * ===================================================================== COMPLEX FUNCTION CDOTC(N,CX,INCX,CY,INCY) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,INCY,N @@ -131,4 +129,7 @@ COMPLEX FUNCTION CDOTC(N,CX,INCX,CY,INCY) END IF CDOTC = CTEMP RETURN +* +* End of CDOTC +* END diff --git a/BLAS/SRC/cdotu.f b/BLAS/SRC/cdotu.f index e1494ed01f..aa57e32031 100644 --- a/BLAS/SRC/cdotu.f +++ b/BLAS/SRC/cdotu.f @@ -39,7 +39,7 @@ *> *> \param[in] CX *> \verbatim -*> CX is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) +*> CX is COMPLEX array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) *> \endverbatim *> *> \param[in] INCX @@ -50,7 +50,7 @@ *> *> \param[in] CY *> \verbatim -*> CY is REAL array, dimension ( 1 + ( N - 1 )*abs( INCY ) ) +*> CY is COMPLEX array, dimension ( 1 + ( N - 1 )*abs( INCY ) ) *> \endverbatim *> *> \param[in] INCY @@ -67,9 +67,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level1 +*> \ingroup dot * *> \par Further Details: * ===================== @@ -82,11 +80,11 @@ *> * ===================================================================== COMPLEX FUNCTION CDOTU(N,CX,INCX,CY,INCY) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,INCY,N @@ -128,4 +126,7 @@ COMPLEX FUNCTION CDOTU(N,CX,INCX,CY,INCY) END IF CDOTU = CTEMP RETURN +* +* End of CDOTU +* END diff --git a/BLAS/SRC/cgbmv.f b/BLAS/SRC/cgbmv.f index 3cf351969d..238bf87e2d 100644 --- a/BLAS/SRC/cgbmv.f +++ b/BLAS/SRC/cgbmv.f @@ -148,6 +148,8 @@ *> ( 1 + ( n - 1 )*abs( INCY ) ) otherwise. *> Before entry, the incremented array Y must contain the *> vector y. On exit, Y is overwritten by the updated vector y. +*> If either m or n is zero, then Y not referenced and the function +*> performs a quick return. *> \endverbatim *> *> \param[in] INCY @@ -165,9 +167,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level2 +*> \ingroup gbmv * *> \par Further Details: * ===================== @@ -185,12 +185,13 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) + SUBROUTINE CGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX, + + BETA,Y,INCY) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX ALPHA,BETA @@ -385,6 +386,6 @@ SUBROUTINE CGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) * RETURN * -* End of CGBMV . +* End of CGBMV * END diff --git a/BLAS/SRC/cgemm.f b/BLAS/SRC/cgemm.f index ba1d714457..7d62b66f69 100644 --- a/BLAS/SRC/cgemm.f +++ b/BLAS/SRC/cgemm.f @@ -35,6 +35,16 @@ *> *> alpha and beta are scalars, and A, B and C are matrices, with op( A ) *> an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. +*> +*> Note: if alpha and/or beta is zero, some parts of the matrix-matrix +*> operations are not performed. This results in the following NaN/Inf +*> propagation quirks: +*> +*> 1. If alpha is zero, NaNs or Infs in A or B do not affect the result. +*> 2. If both alpha and beta are zero, then a zero matrix is returned in C, +*> irrespective of any NaNs or Infs in A, B or C. +*> 3. If only beta is zero, alpha*op( A )*op( B ) is returned, irrespective +*> of any NaNs or Infs in C. *> \endverbatim * * Arguments: @@ -92,7 +102,9 @@ *> \param[in] ALPHA *> \verbatim *> ALPHA is COMPLEX -*> On entry, ALPHA specifies the scalar alpha. +*> On entry, ALPHA specifies the scalar alpha. If ALPHA is zero the +*> values in A and B do not affect the result. This also means that +*> NaN/Inf propagation from A and B is inhibited if ALPHA is zero. *> \endverbatim *> *> \param[in] A @@ -102,7 +114,10 @@ *> Before entry with TRANSA = 'N' or 'n', the leading m by k *> part of the array A must contain the matrix A, otherwise *> the leading k by m part of the array A must contain the -*> matrix A. +*> matrix A, except if ALPHA is zero. +*> If ALPHA is zero, none of the values in A affect the result, even +*> if they are NaN/Inf. This also implies that if ALPHA is zero, +*> the matrix elements of A need not be initialized by the caller. *> \endverbatim *> *> \param[in] LDA @@ -121,7 +136,10 @@ *> Before entry with TRANSB = 'N' or 'n', the leading k by n *> part of the array B must contain the matrix B, otherwise *> the leading n by k part of the array B must contain the -*> matrix B. +*> matrix B, except if ALPHA is zero. +*> If ALPHA is zero, none of the values in B affect the result, even +*> if they are NaN/Inf. This also implies that if ALPHA is zero, +*> the matrix elements of B need not be initialized by the caller. *> \endverbatim *> *> \param[in] LDB @@ -136,16 +154,19 @@ *> \param[in] BETA *> \verbatim *> BETA is COMPLEX -*> On entry, BETA specifies the scalar beta. When BETA is -*> supplied as zero then C need not be set on input. +*> On entry, BETA specifies the scalar beta. If BETA is zero the +*> values in C do not affect the result. This also means that +*> NaN/Inf propagation from C is inhibited if BETA is zero. *> \endverbatim *> *> \param[in,out] C *> \verbatim *> C is COMPLEX array, dimension ( LDC, N ) *> Before entry, the leading m by n part of the array C must -*> contain the matrix C, except when beta is zero, in which -*> case C need not be set on entry. +*> contain the matrix C, except if beta is zero. +*> If beta is zero, none of the values in C affect the result, even +*> if they are NaN/Inf. This also implies that if beta is zero, +*> the matrix elements of C need not be initialized by the caller. *> On exit, the array C is overwritten by the m by n matrix *> ( alpha*op( A )*op( B ) + beta*C ). *> \endverbatim @@ -166,9 +187,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level3 +*> \ingroup gemm * *> \par Further Details: * ===================== @@ -185,12 +204,13 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) + SUBROUTINE CGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB, + + BETA,C,LDC) + IMPLICIT NONE * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX ALPHA,BETA @@ -215,7 +235,7 @@ SUBROUTINE CGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * .. * .. Local Scalars .. COMPLEX TEMP - INTEGER I,INFO,J,L,NCOLA,NROWA,NROWB + INTEGER I,INFO,J,L,NROWA,NROWB LOGICAL CONJA,CONJB,NOTA,NOTB * .. * .. Parameters .. @@ -228,8 +248,7 @@ SUBROUTINE CGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * Set NOTA and NOTB as true if A and B respectively are not * conjugated or transposed, set CONJA and CONJB as true if A and * B respectively are to be transposed but not conjugated and set -* NROWA, NCOLA and NROWB as the number of rows and columns of A -* and the number of rows of B respectively. +* NROWA and NROWB as the number of rows of A and B respectively. * NOTA = LSAME(TRANSA,'N') NOTB = LSAME(TRANSB,'N') @@ -237,10 +256,8 @@ SUBROUTINE CGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) CONJB = LSAME(TRANSB,'C') IF (NOTA) THEN NROWA = M - NCOLA = K ELSE NROWA = K - NCOLA = M END IF IF (NOTB) THEN NROWB = K @@ -478,6 +495,6 @@ SUBROUTINE CGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * RETURN * -* End of CGEMM . +* End of CGEMM * END diff --git a/BLAS/SRC/cgemmtr.f b/BLAS/SRC/cgemmtr.f new file mode 100644 index 0000000000..a5f552960d --- /dev/null +++ b/BLAS/SRC/cgemmtr.f @@ -0,0 +1,569 @@ +*> \brief \b CGEMMTR +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE CGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB,BETA, +* C,LDC) +* +* .. Scalar Arguments .. +* COMPLEX ALPHA,BETA +* INTEGER K,LDA,LDB,LDC,N +* CHARACTER TRANSA,TRANSB, UPLO +* .. +* .. Array Arguments .. +* COMPLEX A(LDA,*),B(LDB,*),C(LDC,*) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> CGEMMTR performs one of the matrix-matrix operations +*> +*> C := alpha*op( A )*op( B ) + beta*C, +*> +*> where op( X ) is one of +*> +*> op( X ) = X or op( X ) = X**T, +*> +*> alpha and beta are scalars, and A, B and C are matrices, with op( A ) +*> an n by k matrix, op( B ) a k by n matrix and C an n by n matrix. +*> Thereby, the routine only accesses and updates the upper or lower +*> triangular part of the result matrix C. This behaviour can be used if +*> the resulting matrix C is known to be Hermitian or symmetric. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] UPLO +*> \verbatim +*> UPLO is CHARACTER*1 +*> On entry, UPLO specifies whether the lower or the upper +*> triangular part of C is access and updated. +*> +*> UPLO = 'L' or 'l', the lower triangular part of C is used. +*> +*> UPLO = 'U' or 'u', the upper triangular part of C is used. +*> \endverbatim +* +*> \param[in] TRANSA +*> \verbatim +*> TRANSA is CHARACTER*1 +*> On entry, TRANSA specifies the form of op( A ) to be used in +*> the matrix multiplication as follows: +*> +*> TRANSA = 'N' or 'n', op( A ) = A. +*> +*> TRANSA = 'T' or 't', op( A ) = A**T. +*> +*> TRANSA = 'C' or 'c', op( A ) = A**H. +*> \endverbatim +*> +*> \param[in] TRANSB +*> \verbatim +*> TRANSB is CHARACTER*1 +*> On entry, TRANSB specifies the form of op( B ) to be used in +*> the matrix multiplication as follows: +*> +*> TRANSB = 'N' or 'n', op( B ) = B. +*> +*> TRANSB = 'T' or 't', op( B ) = B**T. +*> +*> TRANSB = 'C' or 'c', op( B ) = B**H. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> On entry, N specifies the number of rows and columns of +*> the matrix C, the number of columns of op(B) and the number +*> of rows of op(A). N must be at least zero. +*> \endverbatim +*> +*> \param[in] K +*> \verbatim +*> K is INTEGER +*> On entry, K specifies the number of columns of the matrix +*> op( A ) and the number of rows of the matrix op( B ). K must +*> be at least zero. +*> \endverbatim +*> +*> \param[in] ALPHA +*> \verbatim +*> ALPHA is COMPLEX. +*> On entry, ALPHA specifies the scalar alpha. +*> \endverbatim +*> +*> \param[in] A +*> \verbatim +*> A is COMPLEX array, dimension ( LDA, ka ), where ka is +*> k when TRANSA = 'N' or 'n', and is n otherwise. +*> Before entry with TRANSA = 'N' or 'n', the leading n by k +*> part of the array A must contain the matrix A, otherwise +*> the leading k by m part of the array A must contain the +*> matrix A. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> On entry, LDA specifies the first dimension of A as declared +*> in the calling (sub) program. When TRANSA = 'N' or 'n' then +*> LDA must be at least max( 1, n ), otherwise LDA must be at +*> least max( 1, k ). +*> \endverbatim +*> +*> \param[in] B +*> \verbatim +*> B is COMPLEX array, dimension ( LDB, kb ), where kb is +*> n when TRANSB = 'N' or 'n', and is k otherwise. +*> Before entry with TRANSB = 'N' or 'n', the leading k by n +*> part of the array B must contain the matrix B, otherwise +*> the leading n by k part of the array B must contain the +*> matrix B. +*> \endverbatim +*> +*> \param[in] LDB +*> \verbatim +*> LDB is INTEGER +*> On entry, LDB specifies the first dimension of B as declared +*> in the calling (sub) program. When TRANSB = 'N' or 'n' then +*> LDB must be at least max( 1, k ), otherwise LDB must be at +*> least max( 1, n ). +*> \endverbatim +*> +*> \param[in] BETA +*> \verbatim +*> BETA is COMPLEX. +*> On entry, BETA specifies the scalar beta. When BETA is +*> supplied as zero then C need not be set on input. +*> \endverbatim +*> +*> \param[in,out] C +*> \verbatim +*> C is COMPLEX array, dimension ( LDC, N ) +*> Before entry, the leading n by n part of the array C must +*> contain the matrix C, except when beta is zero, in which +*> case C need not be set on entry. +*> On exit, the upper or lower triangular part of the matrix +*> C is overwritten by the n by n matrix +*> ( alpha*op( A )*op( B ) + beta*C ). +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> On entry, LDC specifies the first dimension of C as declared +*> in the calling (sub) program. LDC must be at least +*> max( 1, n ). +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Martin Koehler +* +*> \ingroup gemmtr +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> Level 3 Blas routine. +*> +*> -- Written on 19-July-2023. +*> Martin Koehler, MPI Magdeburg +*> \endverbatim +*> +* ===================================================================== + SUBROUTINE CGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB, + + BETA,C,LDC) + IMPLICIT NONE +* +* -- Reference BLAS level3 routine -- +* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + COMPLEX ALPHA,BETA + INTEGER K,LDA,LDB,LDC,N + CHARACTER TRANSA,TRANSB,UPLO +* .. +* .. Array Arguments .. + COMPLEX A(LDA,*),B(LDB,*),C(LDC,*) +* .. +* +* ===================================================================== +* +* .. External Functions .. + LOGICAL LSAME + EXTERNAL LSAME +* .. +* .. External Subroutines .. + EXTERNAL XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC CONJG,MAX +* .. +* .. Local Scalars .. + COMPLEX TEMP + INTEGER I,INFO,J,L,NROWA,NROWB,ISTART, ISTOP + LOGICAL CONJA,CONJB,NOTA,NOTB,UPPER +* .. +* .. Parameters .. + COMPLEX ONE + PARAMETER (ONE= (1.0E+0,0.0E+0)) + COMPLEX ZERO + PARAMETER (ZERO= (0.0E+0,0.0E+0)) +* .. +* +* Set NOTA and NOTB as true if A and B respectively are not +* conjugated or transposed, set CONJA and CONJB as true if A and +* B respectively are to be transposed but not conjugated and set +* NROWA and NROWB as the number of rows of A and B respectively. +* + NOTA = LSAME(TRANSA,'N') + NOTB = LSAME(TRANSB,'N') + CONJA = LSAME(TRANSA,'C') + CONJB = LSAME(TRANSB,'C') + IF (NOTA) THEN + NROWA = N + ELSE + NROWA = K + END IF + IF (NOTB) THEN + NROWB = K + ELSE + NROWB = N + END IF + UPPER = LSAME(UPLO, 'U') + +* +* Test the input parameters. +* + INFO = 0 + IF ((.NOT. UPPER) .AND. (.NOT. LSAME(UPLO, 'L'))) THEN + INFO = 1 + ELSE IF ((.NOT.NOTA) .AND. (.NOT.CONJA) .AND. + + (.NOT.LSAME(TRANSA,'T'))) THEN + INFO = 2 + ELSE IF ((.NOT.NOTB) .AND. (.NOT.CONJB) .AND. + + (.NOT.LSAME(TRANSB,'T'))) THEN + INFO = 3 + ELSE IF (N.LT.0) THEN + INFO = 4 + ELSE IF (K.LT.0) THEN + INFO = 5 + ELSE IF (LDA.LT.MAX(1,NROWA)) THEN + INFO = 8 + ELSE IF (LDB.LT.MAX(1,NROWB)) THEN + INFO = 10 + ELSE IF (LDC.LT.MAX(1,N)) THEN + INFO = 13 + END IF + IF (INFO.NE.0) THEN + CALL XERBLA('CGEMMTR',INFO) + RETURN + END IF +* +* Quick return if possible. +* + IF (N.EQ.0) RETURN +* +* And when alpha.eq.zero. +* + IF (ALPHA.EQ.ZERO) THEN + IF (BETA.EQ.ZERO) THEN + DO 20 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 10 I = ISTART, ISTOP + C(I,J) = ZERO + 10 CONTINUE + 20 CONTINUE + ELSE + DO 40 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + DO 30 I = ISTART, ISTOP + C(I,J) = BETA*C(I,J) + 30 CONTINUE + 40 CONTINUE + END IF + RETURN + END IF +* +* Start the operations. +* + IF (NOTB) THEN + IF (NOTA) THEN +* +* Form C := alpha*A*B + beta*C. +* + DO 90 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + IF (BETA.EQ.ZERO) THEN + DO 50 I = ISTART, ISTOP + C(I,J) = ZERO + 50 CONTINUE + ELSE IF (BETA.NE.ONE) THEN + DO 60 I = ISTART, ISTOP + C(I,J) = BETA*C(I,J) + 60 CONTINUE + END IF + DO 80 L = 1,K + TEMP = ALPHA*B(L,J) + DO 70 I = ISTART, ISTOP + C(I,J) = C(I,J) + TEMP*A(I,L) + 70 CONTINUE + 80 CONTINUE + 90 CONTINUE + ELSE IF (CONJA) THEN +* +* Form C := alpha*A**H*B + beta*C. +* + DO 120 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 110 I = ISTART, ISTOP + TEMP = ZERO + DO 100 L = 1,K + TEMP = TEMP + CONJG(A(L,I))*B(L,J) + 100 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP + ELSE + C(I,J) = ALPHA*TEMP + BETA*C(I,J) + END IF + 110 CONTINUE + 120 CONTINUE + ELSE +* +* Form C := alpha*A**T*B + beta*C +* + DO 150 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 140 I = ISTART, ISTOP + TEMP = ZERO + DO 130 L = 1,K + TEMP = TEMP + A(L,I)*B(L,J) + 130 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP + ELSE + C(I,J) = ALPHA*TEMP + BETA*C(I,J) + END IF + 140 CONTINUE + 150 CONTINUE + END IF + ELSE IF (NOTA) THEN + IF (CONJB) THEN +* +* Form C := alpha*A*B**H + beta*C. +* + DO 200 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + IF (BETA.EQ.ZERO) THEN + DO 160 I = ISTART,ISTOP + C(I,J) = ZERO + 160 CONTINUE + ELSE IF (BETA.NE.ONE) THEN + DO 170 I = ISTART, ISTOP + C(I,J) = BETA*C(I,J) + 170 CONTINUE + END IF + DO 190 L = 1,K + TEMP = ALPHA*CONJG(B(J,L)) + DO 180 I = ISTART, ISTOP + C(I,J) = C(I,J) + TEMP*A(I,L) + 180 CONTINUE + 190 CONTINUE + 200 CONTINUE + ELSE +* +* Form C := alpha*A*B**T + beta*C +* + DO 250 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + IF (BETA.EQ.ZERO) THEN + DO 210 I = ISTART, ISTOP + C(I,J) = ZERO + 210 CONTINUE + ELSE IF (BETA.NE.ONE) THEN + DO 220 I = ISTART, ISTOP + C(I,J) = BETA*C(I,J) + 220 CONTINUE + END IF + DO 240 L = 1,K + TEMP = ALPHA*B(J,L) + DO 230 I = ISTART, ISTOP + C(I,J) = C(I,J) + TEMP*A(I,L) + 230 CONTINUE + 240 CONTINUE + 250 CONTINUE + END IF + ELSE IF (CONJA) THEN + IF (CONJB) THEN +* +* Form C := alpha*A**H*B**H + beta*C. +* + DO 280 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 270 I = ISTART, ISTOP + TEMP = ZERO + DO 260 L = 1,K + TEMP = TEMP + CONJG(A(L,I))*CONJG(B(J,L)) + 260 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP + ELSE + C(I,J) = ALPHA*TEMP + BETA*C(I,J) + END IF + 270 CONTINUE + 280 CONTINUE + ELSE +* +* Form C := alpha*A**H*B**T + beta*C +* + DO 310 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 300 I = ISTART, ISTOP + TEMP = ZERO + DO 290 L = 1,K + TEMP = TEMP + CONJG(A(L,I))*B(J,L) + 290 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP + ELSE + C(I,J) = ALPHA*TEMP + BETA*C(I,J) + END IF + 300 CONTINUE + 310 CONTINUE + END IF + ELSE + IF (CONJB) THEN +* +* Form C := alpha*A**T*B**H + beta*C +* + DO 340 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 330 I = ISTART, ISTOP + TEMP = ZERO + DO 320 L = 1,K + TEMP = TEMP + A(L,I)*CONJG(B(J,L)) + 320 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP + ELSE + C(I,J) = ALPHA*TEMP + BETA*C(I,J) + END IF + 330 CONTINUE + 340 CONTINUE + ELSE +* +* Form C := alpha*A**T*B**T + beta*C +* + DO 370 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 360 I = ISTART, ISTOP + TEMP = ZERO + DO 350 L = 1,K + TEMP = TEMP + A(L,I)*B(J,L) + 350 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP + ELSE + C(I,J) = ALPHA*TEMP + BETA*C(I,J) + END IF + 360 CONTINUE + 370 CONTINUE + END IF + END IF +* + RETURN +* +* End of CGEMMTR +* + END diff --git a/BLAS/SRC/cgemv.f b/BLAS/SRC/cgemv.f index 99bcdcd1ab..cb1232bc4d 100644 --- a/BLAS/SRC/cgemv.f +++ b/BLAS/SRC/cgemv.f @@ -119,6 +119,8 @@ *> Before entry with BETA non-zero, the incremented array Y *> must contain the vector y. On exit, Y is overwritten by the *> updated vector y. +*> If either m or n is zero, then Y not referenced and the function +*> performs a quick return. *> \endverbatim *> *> \param[in] INCY @@ -136,9 +138,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level2 +*> \ingroup gemv * *> \par Further Details: * ===================== @@ -157,11 +157,11 @@ *> * ===================================================================== SUBROUTINE CGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX ALPHA,BETA @@ -345,6 +345,6 @@ SUBROUTINE CGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) * RETURN * -* End of CGEMV . +* End of CGEMV * END diff --git a/BLAS/SRC/cgerc.f b/BLAS/SRC/cgerc.f index f3f96a6a49..3df05a5c5e 100644 --- a/BLAS/SRC/cgerc.f +++ b/BLAS/SRC/cgerc.f @@ -109,9 +109,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level2 +*> \ingroup ger * *> \par Further Details: * ===================== @@ -129,11 +127,11 @@ *> * ===================================================================== SUBROUTINE CGERC(M,N,ALPHA,X,INCX,Y,INCY,A,LDA) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX ALPHA @@ -222,6 +220,6 @@ SUBROUTINE CGERC(M,N,ALPHA,X,INCX,Y,INCY,A,LDA) * RETURN * -* End of CGERC . +* End of CGERC * END diff --git a/BLAS/SRC/cgeru.f b/BLAS/SRC/cgeru.f index f8342b5bc2..065397831a 100644 --- a/BLAS/SRC/cgeru.f +++ b/BLAS/SRC/cgeru.f @@ -109,9 +109,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level2 +*> \ingroup ger * *> \par Further Details: * ===================== @@ -129,11 +127,11 @@ *> * ===================================================================== SUBROUTINE CGERU(M,N,ALPHA,X,INCX,Y,INCY,A,LDA) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX ALPHA @@ -222,6 +220,6 @@ SUBROUTINE CGERU(M,N,ALPHA,X,INCX,Y,INCY,A,LDA) * RETURN * -* End of CGERU . +* End of CGERU * END diff --git a/BLAS/SRC/chbmv.f b/BLAS/SRC/chbmv.f index e25e6e2a72..25113ecb2b 100644 --- a/BLAS/SRC/chbmv.f +++ b/BLAS/SRC/chbmv.f @@ -165,9 +165,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level2 +*> \ingroup hbmv * *> \par Further Details: * ===================== @@ -186,11 +184,11 @@ *> * ===================================================================== SUBROUTINE CHBMV(UPLO,N,K,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX ALPHA,BETA @@ -375,6 +373,6 @@ SUBROUTINE CHBMV(UPLO,N,K,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) * RETURN * -* End of CHBMV . +* End of CHBMV * END diff --git a/BLAS/SRC/chemm.f b/BLAS/SRC/chemm.f index 8cf94fa2b2..bc65e5323b 100644 --- a/BLAS/SRC/chemm.f +++ b/BLAS/SRC/chemm.f @@ -170,9 +170,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level3 +*> \ingroup hemm * *> \par Further Details: * ===================== @@ -190,11 +188,11 @@ *> * ===================================================================== SUBROUTINE CHEMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC) + IMPLICIT NONE * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX ALPHA,BETA @@ -241,9 +239,11 @@ SUBROUTINE CHEMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * Test the input parameters. * INFO = 0 - IF ((.NOT.LSAME(SIDE,'L')) .AND. (.NOT.LSAME(SIDE,'R'))) THEN + IF ((.NOT.LSAME(SIDE,'L')) .AND. + + (.NOT.LSAME(SIDE,'R'))) THEN INFO = 1 - ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN + ELSE IF ((.NOT.UPPER) .AND. + + (.NOT.LSAME(UPLO,'L'))) THEN INFO = 2 ELSE IF (M.LT.0) THEN INFO = 3 @@ -366,6 +366,6 @@ SUBROUTINE CHEMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * RETURN * -* End of CHEMM . +* End of CHEMM * END diff --git a/BLAS/SRC/chemv.f b/BLAS/SRC/chemv.f index be0f405c14..fbc4eca8f8 100644 --- a/BLAS/SRC/chemv.f +++ b/BLAS/SRC/chemv.f @@ -132,9 +132,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level2 +*> \ingroup hemv * *> \par Further Details: * ===================== @@ -153,11 +151,11 @@ *> * ===================================================================== SUBROUTINE CHEMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX ALPHA,BETA @@ -332,6 +330,6 @@ SUBROUTINE CHEMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) * RETURN * -* End of CHEMV . +* End of CHEMV * END diff --git a/BLAS/SRC/cher.f b/BLAS/SRC/cher.f index fde0c85511..63b630e7bd 100644 --- a/BLAS/SRC/cher.f +++ b/BLAS/SRC/cher.f @@ -114,9 +114,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level2 +*> \ingroup her * *> \par Further Details: * ===================== @@ -134,11 +132,11 @@ *> * ===================================================================== SUBROUTINE CHER(UPLO,N,ALPHA,X,INCX,A,LDA) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. REAL ALPHA @@ -273,6 +271,6 @@ SUBROUTINE CHER(UPLO,N,ALPHA,X,INCX,A,LDA) * RETURN * -* End of CHER . +* End of CHER * END diff --git a/BLAS/SRC/cher2.f b/BLAS/SRC/cher2.f index ca12834fc5..d6770a295e 100644 --- a/BLAS/SRC/cher2.f +++ b/BLAS/SRC/cher2.f @@ -129,9 +129,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level2 +*> \ingroup her2 * *> \par Further Details: * ===================== @@ -149,11 +147,11 @@ *> * ===================================================================== SUBROUTINE CHER2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX ALPHA @@ -312,6 +310,6 @@ SUBROUTINE CHER2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA) * RETURN * -* End of CHER2 . +* End of CHER2 * END diff --git a/BLAS/SRC/cher2k.f b/BLAS/SRC/cher2k.f index fb9925d5dc..8cffc18211 100644 --- a/BLAS/SRC/cher2k.f +++ b/BLAS/SRC/cher2k.f @@ -173,9 +173,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level3 +*> \ingroup her2k * *> \par Further Details: * ===================== @@ -196,11 +194,11 @@ *> * ===================================================================== SUBROUTINE CHER2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) + IMPLICIT NONE * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX ALPHA @@ -437,6 +435,6 @@ SUBROUTINE CHER2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * RETURN * -* End of CHER2K. +* End of CHER2K * END diff --git a/BLAS/SRC/cherk.f b/BLAS/SRC/cherk.f index 79f40783c7..aad09b7dab 100644 --- a/BLAS/SRC/cherk.f +++ b/BLAS/SRC/cherk.f @@ -149,9 +149,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level3 +*> \ingroup herk * *> \par Further Details: * ===================== @@ -172,11 +170,11 @@ *> * ===================================================================== SUBROUTINE CHERK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC) + IMPLICIT NONE * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. REAL ALPHA,BETA @@ -355,7 +353,7 @@ SUBROUTINE CHERK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC) 200 CONTINUE RTEMP = ZERO DO 210 L = 1,K - RTEMP = RTEMP + CONJG(A(L,J))*A(L,J) + RTEMP = RTEMP + REAL(CONJG(A(L,J))*A(L,J)) 210 CONTINUE IF (BETA.EQ.ZERO) THEN C(J,J) = ALPHA*RTEMP @@ -367,7 +365,7 @@ SUBROUTINE CHERK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC) DO 260 J = 1,N RTEMP = ZERO DO 230 L = 1,K - RTEMP = RTEMP + CONJG(A(L,J))*A(L,J) + RTEMP = RTEMP + REAL(CONJG(A(L,J))*A(L,J)) 230 CONTINUE IF (BETA.EQ.ZERO) THEN C(J,J) = ALPHA*RTEMP @@ -391,6 +389,6 @@ SUBROUTINE CHERK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC) * RETURN * -* End of CHERK . +* End of CHERK * END diff --git a/BLAS/SRC/chpmv.f b/BLAS/SRC/chpmv.f index bc0026ae65..241906a8d8 100644 --- a/BLAS/SRC/chpmv.f +++ b/BLAS/SRC/chpmv.f @@ -127,9 +127,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level2 +*> \ingroup hpmv * *> \par Further Details: * ===================== @@ -148,11 +146,11 @@ *> * ===================================================================== SUBROUTINE CHPMV(UPLO,N,ALPHA,AP,X,INCX,BETA,Y,INCY) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX ALPHA,BETA @@ -333,6 +331,6 @@ SUBROUTINE CHPMV(UPLO,N,ALPHA,AP,X,INCX,BETA,Y,INCY) * RETURN * -* End of CHPMV . +* End of CHPMV * END diff --git a/BLAS/SRC/chpr.f b/BLAS/SRC/chpr.f index 25df894974..3d197f5142 100644 --- a/BLAS/SRC/chpr.f +++ b/BLAS/SRC/chpr.f @@ -109,9 +109,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level2 +*> \ingroup hpr * *> \par Further Details: * ===================== @@ -129,11 +127,11 @@ *> * ===================================================================== SUBROUTINE CHPR(UPLO,N,ALPHA,X,INCX,AP) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. REAL ALPHA @@ -274,6 +272,6 @@ SUBROUTINE CHPR(UPLO,N,ALPHA,X,INCX,AP) * RETURN * -* End of CHPR . +* End of CHPR * END diff --git a/BLAS/SRC/chpr2.f b/BLAS/SRC/chpr2.f index 66ef2f290b..13e9d51848 100644 --- a/BLAS/SRC/chpr2.f +++ b/BLAS/SRC/chpr2.f @@ -124,9 +124,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level2 +*> \ingroup hpr2 * *> \par Further Details: * ===================== @@ -144,11 +142,11 @@ *> * ===================================================================== SUBROUTINE CHPR2(UPLO,N,ALPHA,X,INCX,Y,INCY,AP) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX ALPHA @@ -313,6 +311,6 @@ SUBROUTINE CHPR2(UPLO,N,ALPHA,X,INCX,Y,INCY,AP) * RETURN * -* End of CHPR2 . +* End of CHPR2 * END diff --git a/BLAS/SRC/crotg.f b/BLAS/SRC/crotg.f deleted file mode 100644 index 43159682fe..0000000000 --- a/BLAS/SRC/crotg.f +++ /dev/null @@ -1,97 +0,0 @@ -*> \brief \b CROTG -* -* =========== DOCUMENTATION =========== -* -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ -* -* Definition: -* =========== -* -* SUBROUTINE CROTG(CA,CB,C,S) -* -* .. Scalar Arguments .. -* COMPLEX CA,CB,S -* REAL C -* .. -* -* -*> \par Purpose: -* ============= -*> -*> \verbatim -*> -*> CROTG determines a complex Givens rotation. -*> \endverbatim -* -* Arguments: -* ========== -* -*> \param[in] CA -*> \verbatim -*> CA is COMPLEX -*> \endverbatim -*> -*> \param[in] CB -*> \verbatim -*> CB is COMPLEX -*> \endverbatim -*> -*> \param[out] C -*> \verbatim -*> C is REAL -*> \endverbatim -*> -*> \param[out] S -*> \verbatim -*> S is COMPLEX -*> \endverbatim -* -* Authors: -* ======== -* -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. -* -*> \date December 2016 -* -*> \ingroup complex_blas_level1 -* -* ===================================================================== - SUBROUTINE CROTG(CA,CB,C,S) -* -* -- Reference BLAS level1 routine (version 3.7.0) -- -* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 -* -* .. Scalar Arguments .. - COMPLEX CA,CB,S - REAL C -* .. -* -* ===================================================================== -* -* .. Local Scalars .. - COMPLEX ALPHA - REAL NORM,SCALE -* .. -* .. Intrinsic Functions .. - INTRINSIC CABS,CONJG,SQRT -* .. - IF (CABS(CA).EQ.0.) THEN - C = 0. - S = (1.,0.) - CA = CB - ELSE - SCALE = CABS(CA) + CABS(CB) - NORM = SCALE*SQRT((CABS(CA/SCALE))**2+ (CABS(CB/SCALE))**2) - ALPHA = CA/CABS(CA) - C = CABS(CA)/NORM - S = ALPHA*CONJG(CB)/NORM - CA = ALPHA*NORM - END IF - RETURN - END diff --git a/BLAS/SRC/crotg.f90 b/BLAS/SRC/crotg.f90 new file mode 100644 index 0000000000..08f6cb1bf7 --- /dev/null +++ b/BLAS/SRC/crotg.f90 @@ -0,0 +1,277 @@ +!> \brief \b CROTG generates a Givens rotation with real cosine and complex sine. +! +! =========== DOCUMENTATION =========== +! +! Online html documentation available at +! http://www.netlib.org/lapack/explore-html/ +! +!> \par Purpose: +! ============= +!> +!> \verbatim +!> +!> CROTG constructs a plane rotation +!> [ c s ] [ a ] = [ r ] +!> [ -conjg(s) c ] [ b ] [ 0 ] +!> where c is real, s is complex, and c**2 + conjg(s)*s = 1. +!> +!> The computation uses the formulas +!> |x| = sqrt( Re(x)**2 + Im(x)**2 ) +!> sgn(x) = x / |x| if x /= 0 +!> = 1 if x = 0 +!> c = |a| / sqrt(|a|**2 + |b|**2) +!> s = sgn(a) * conjg(b) / sqrt(|a|**2 + |b|**2) +!> r = sgn(a)*sqrt(|a|**2 + |b|**2) +!> When a and b are real and r /= 0, the formulas simplify to +!> c = a / r +!> s = b / r +!> the same as in SROTG when |a| > |b|. When |b| >= |a|, the +!> sign of c and s will be different from those computed by SROTG +!> if the signs of a and b are not the same. +!> +!> \endverbatim +!> +!> @see lartg, @see lartgp +! +! Arguments: +! ========== +! +!> \param[in,out] A +!> \verbatim +!> A is COMPLEX +!> On entry, the scalar a. +!> On exit, the scalar r. +!> \endverbatim +!> +!> \param[in] B +!> \verbatim +!> B is COMPLEX +!> The scalar b. +!> \endverbatim +!> +!> \param[out] C +!> \verbatim +!> C is REAL +!> The scalar c. +!> \endverbatim +!> +!> \param[out] S +!> \verbatim +!> S is COMPLEX +!> The scalar s. +!> \endverbatim +! +! Authors: +! ======== +! +!> \author Weslley Pereira, University of Colorado Denver, USA +! +!> \date December 2021 +! +!> \ingroup rotg +! +!> \par Further Details: +! ===================== +!> +!> \verbatim +!> +!> Based on the algorithm from +!> +!> Anderson E. (2017) +!> Algorithm 978: Safe Scaling in the Level 1 BLAS +!> ACM Trans Math Softw 44:1--28 +!> https://doi.org/10.1145/3061665 +!> +!> \endverbatim +! +! ===================================================================== +subroutine CROTG( a, b, c, s ) + implicit none + integer, parameter :: wp = kind(1.e0) +! +! -- Reference BLAS level1 routine -- +! -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +! -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +! +! .. Constants .. + real(wp), parameter :: zero = 0.0_wp + real(wp), parameter :: one = 1.0_wp + complex(wp), parameter :: czero = 0.0_wp +! .. +! .. Scaling constants .. + real(wp), parameter :: safmin = real(radix(0._wp),wp)**max( & + minexponent(0._wp)-1, & + 1-maxexponent(0._wp) & + ) + real(wp), parameter :: safmax = real(radix(0._wp),wp)**max( & + 1-minexponent(0._wp), & + maxexponent(0._wp)-1 & + ) + real(wp), parameter :: rtmin = sqrt( safmin ) +! .. +! .. Scalar Arguments .. + real(wp) :: c + complex(wp) :: a, b, s +! .. +! .. Local Scalars .. + real(wp) :: d, f1, f2, g1, g2, h2, u, v, w, rtmax + complex(wp) :: f, fs, g, gs, r, t +! .. +! .. Intrinsic Functions .. + intrinsic :: abs, aimag, conjg, max, min, real, sqrt +! .. +! .. Statement Functions .. + real(wp) :: ABSSQ +! .. +! .. Statement Function definitions .. + ABSSQ( t ) = real( t )**2 + aimag( t )**2 +! .. +! .. Executable Statements .. +! + f = a + g = b + if( g == czero ) then + c = one + s = czero + r = f + else if( f == czero ) then + c = zero + if( real(g) == zero ) then + r = abs(aimag(g)) + s = conjg( g ) / r + elseif( aimag(g) == zero ) then + r = abs(real(g)) + s = conjg( g ) / r + else + g1 = max( abs(real(g)), abs(aimag(g)) ) + rtmax = sqrt( safmax/2 ) + if( g1 > rtmin .and. g1 < rtmax ) then +! +! Use unscaled algorithm +! +! The following two lines can be replaced by `d = abs( g )`. +! This algorithm do not use the intrinsic complex abs. + g2 = ABSSQ( g ) + d = sqrt( g2 ) + s = conjg( g ) / d + r = d + else +! +! Use scaled algorithm +! + u = min( safmax, max( safmin, g1 ) ) + gs = g / u +! The following two lines can be replaced by `d = abs( gs )`. +! This algorithm do not use the intrinsic complex abs. + g2 = ABSSQ( gs ) + d = sqrt( g2 ) + s = conjg( gs ) / d + r = d*u + end if + end if + else + f1 = max( abs(real(f)), abs(aimag(f)) ) + g1 = max( abs(real(g)), abs(aimag(g)) ) + rtmax = sqrt( safmax/4 ) + if( f1 > rtmin .and. f1 < rtmax .and. & + g1 > rtmin .and. g1 < rtmax ) then +! +! Use unscaled algorithm +! + f2 = ABSSQ( f ) + g2 = ABSSQ( g ) + h2 = f2 + g2 + ! safmin <= f2 <= h2 <= safmax + if( f2 >= h2 * safmin ) then + ! safmin <= f2/h2 <= 1, and h2/f2 is finite + c = sqrt( f2 / h2 ) + r = f / c + rtmax = rtmax * 2 + if( f2 > rtmin .and. h2 < rtmax ) then + ! safmin <= sqrt( f2*h2 ) <= safmax + s = conjg( g ) * ( f / sqrt( f2*h2 ) ) + else + s = conjg( g ) * ( r / h2 ) + end if + else + ! f2/h2 <= safmin may be subnormal, and h2/f2 may overflow. + ! Moreover, + ! safmin <= f2*f2 * safmax < f2 * h2 < h2*h2 * safmin <= safmax, + ! sqrt(safmin) <= sqrt(f2 * h2) <= sqrt(safmax). + ! Also, + ! g2 >> f2, which means that h2 = g2. + d = sqrt( f2 * h2 ) + c = f2 / d + if( c >= safmin ) then + r = f / c + else + ! f2 / sqrt(f2 * h2) < safmin, then + ! sqrt(safmin) <= f2 * sqrt(safmax) <= h2 / sqrt(f2 * h2) <= h2 * (safmin / f2) <= h2 <= safmax + r = f * ( h2 / d ) + end if + s = conjg( g ) * ( f / d ) + end if + else +! +! Use scaled algorithm +! + u = min( safmax, max( safmin, f1, g1 ) ) + gs = g / u + g2 = ABSSQ( gs ) + if( f1 / u < rtmin ) then +! +! f is not well-scaled when scaled by g1. +! Use a different scaling for f. +! + v = min( safmax, max( safmin, f1 ) ) + w = v / u + fs = f / v + f2 = ABSSQ( fs ) + h2 = f2*w**2 + g2 + else +! +! Otherwise use the same scaling for f and g. +! + w = one + fs = f / u + f2 = ABSSQ( fs ) + h2 = f2 + g2 + end if + ! safmin <= f2 <= h2 <= safmax + if( f2 >= h2 * safmin ) then + ! safmin <= f2/h2 <= 1, and h2/f2 is finite + c = sqrt( f2 / h2 ) + r = fs / c + rtmax = rtmax * 2 + if( f2 > rtmin .and. h2 < rtmax ) then + ! safmin <= sqrt( f2*h2 ) <= safmax + s = conjg( gs ) * ( fs / sqrt( f2*h2 ) ) + else + s = conjg( gs ) * ( r / h2 ) + end if + else + ! f2/h2 <= safmin may be subnormal, and h2/f2 may overflow. + ! Moreover, + ! safmin <= f2*f2 * safmax < f2 * h2 < h2*h2 * safmin <= safmax, + ! sqrt(safmin) <= sqrt(f2 * h2) <= sqrt(safmax). + ! Also, + ! g2 >> f2, which means that h2 = g2. + d = sqrt( f2 * h2 ) + c = f2 / d + if( c >= safmin ) then + r = fs / c + else + ! f2 / sqrt(f2 * h2) < safmin, then + ! sqrt(safmin) <= f2 * sqrt(safmax) <= h2 / sqrt(f2 * h2) <= h2 * (safmin / f2) <= h2 <= safmax + r = fs * ( h2 / d ) + end if + s = conjg( gs ) * ( fs / d ) + end if + ! Rescale c and r + c = c * w + r = r * u + end if + end if + a = r + return +end subroutine diff --git a/BLAS/SRC/cscal.f b/BLAS/SRC/cscal.f index 2d9d5c4e14..9f61933a85 100644 --- a/BLAS/SRC/cscal.f +++ b/BLAS/SRC/cscal.f @@ -61,9 +61,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level1 +*> \ingroup scal * *> \par Further Details: * ===================== @@ -77,11 +75,11 @@ *> * ===================================================================== SUBROUTINE CSCAL(N,CA,CX,INCX) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX CA @@ -96,7 +94,11 @@ SUBROUTINE CSCAL(N,CA,CX,INCX) * .. Local Scalars .. INTEGER I,NINCX * .. - IF (N.LE.0 .OR. INCX.LE.0) RETURN +* .. Parameters .. + COMPLEX ONE + PARAMETER (ONE= (1.0E+0,0.0E+0)) +* .. + IF (N.LE.0 .OR. INCX.LE.0 .OR. CA.EQ.ONE) RETURN IF (INCX.EQ.1) THEN * * code for increment equal to 1 @@ -114,4 +116,7 @@ SUBROUTINE CSCAL(N,CA,CX,INCX) END DO END IF RETURN +* +* End of CSCAL +* END diff --git a/BLAS/SRC/csrot.f b/BLAS/SRC/csrot.f index aa8564e7fe..795448e6b0 100644 --- a/BLAS/SRC/csrot.f +++ b/BLAS/SRC/csrot.f @@ -91,17 +91,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level1 +*> \ingroup rot * * ===================================================================== SUBROUTINE CSROT( N, CX, INCX, CY, INCY, C, S ) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX, INCY, N @@ -150,4 +148,7 @@ SUBROUTINE CSROT( N, CX, INCX, CY, INCY, C, S ) END DO END IF RETURN +* +* End of CSROT +* END diff --git a/BLAS/SRC/csscal.f b/BLAS/SRC/csscal.f index 07c5ba10e2..b78c0acfa5 100644 --- a/BLAS/SRC/csscal.f +++ b/BLAS/SRC/csscal.f @@ -61,9 +61,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level1 +*> \ingroup scal * *> \par Further Details: * ===================== @@ -77,11 +75,11 @@ *> * ===================================================================== SUBROUTINE CSSCAL(N,SA,CX,INCX) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. REAL SA @@ -96,10 +94,14 @@ SUBROUTINE CSSCAL(N,SA,CX,INCX) * .. Local Scalars .. INTEGER I,NINCX * .. +* .. Parameters .. + REAL ONE + PARAMETER (ONE=1.0E+0) +* .. * .. Intrinsic Functions .. INTRINSIC AIMAG,CMPLX,REAL * .. - IF (N.LE.0 .OR. INCX.LE.0) RETURN + IF (N.LE.0 .OR. INCX.LE.0 .OR. SA.EQ.ONE) RETURN IF (INCX.EQ.1) THEN * * code for increment equal to 1 @@ -117,4 +119,7 @@ SUBROUTINE CSSCAL(N,SA,CX,INCX) END DO END IF RETURN +* +* End of CSSCAL +* END diff --git a/BLAS/SRC/cswap.f b/BLAS/SRC/cswap.f index 3adbaf7eb4..fcd3e60658 100644 --- a/BLAS/SRC/cswap.f +++ b/BLAS/SRC/cswap.f @@ -65,9 +65,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level1 +*> \ingroup swap * *> \par Further Details: * ===================== @@ -80,11 +78,11 @@ *> * ===================================================================== SUBROUTINE CSWAP(N,CX,INCX,CY,INCY) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,INCY,N @@ -126,4 +124,7 @@ SUBROUTINE CSWAP(N,CX,INCX,CY,INCY) END DO END IF RETURN +* +* End of CSWAP +* END diff --git a/BLAS/SRC/csymm.f b/BLAS/SRC/csymm.f index 8f05264101..96251885db 100644 --- a/BLAS/SRC/csymm.f +++ b/BLAS/SRC/csymm.f @@ -168,9 +168,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level3 +*> \ingroup hemm * *> \par Further Details: * ===================== @@ -188,11 +186,11 @@ *> * ===================================================================== SUBROUTINE CSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC) + IMPLICIT NONE * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX ALPHA,BETA @@ -239,9 +237,11 @@ SUBROUTINE CSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * Test the input parameters. * INFO = 0 - IF ((.NOT.LSAME(SIDE,'L')) .AND. (.NOT.LSAME(SIDE,'R'))) THEN + IF ((.NOT.LSAME(SIDE,'L')) .AND. + + (.NOT.LSAME(SIDE,'R'))) THEN INFO = 1 - ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN + ELSE IF ((.NOT.UPPER) .AND. + + (.NOT.LSAME(UPLO,'L'))) THEN INFO = 2 ELSE IF (M.LT.0) THEN INFO = 3 @@ -364,6 +364,6 @@ SUBROUTINE CSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * RETURN * -* End of CSYMM . +* End of CSYMM * END diff --git a/BLAS/SRC/csyr2k.f b/BLAS/SRC/csyr2k.f index b321d092df..c688b8d361 100644 --- a/BLAS/SRC/csyr2k.f +++ b/BLAS/SRC/csyr2k.f @@ -167,9 +167,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level3 +*> \ingroup her2k * *> \par Further Details: * ===================== @@ -187,11 +185,11 @@ *> * ===================================================================== SUBROUTINE CSYR2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) + IMPLICIT NONE * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX ALPHA,BETA @@ -391,6 +389,6 @@ SUBROUTINE CSYR2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * RETURN * -* End of CSYR2K. +* End of CSYR2K * END diff --git a/BLAS/SRC/csyrk.f b/BLAS/SRC/csyrk.f index c25384ac5f..ec6ced98ae 100644 --- a/BLAS/SRC/csyrk.f +++ b/BLAS/SRC/csyrk.f @@ -146,9 +146,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level3 +*> \ingroup herk * *> \par Further Details: * ===================== @@ -166,11 +164,11 @@ *> * ===================================================================== SUBROUTINE CSYRK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC) + IMPLICIT NONE * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX ALPHA,BETA @@ -358,6 +356,6 @@ SUBROUTINE CSYRK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC) * RETURN * -* End of CSYRK . +* End of CSYRK * END diff --git a/BLAS/SRC/ctbmv.f b/BLAS/SRC/ctbmv.f index 205ab9c4e2..ac5ac6a87a 100644 --- a/BLAS/SRC/ctbmv.f +++ b/BLAS/SRC/ctbmv.f @@ -164,9 +164,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level2 +*> \ingroup tbmv * *> \par Further Details: * ===================== @@ -185,11 +183,11 @@ *> * ===================================================================== SUBROUTINE CTBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,K,LDA,N @@ -200,10 +198,6 @@ SUBROUTINE CTBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) * .. * * ===================================================================== -* -* .. Parameters .. - COMPLEX ZERO - PARAMETER (ZERO= (0.0E+0,0.0E+0)) * .. * .. Local Scalars .. COMPLEX TEMP @@ -226,10 +220,12 @@ SUBROUTINE CTBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) INFO = 0 IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN INFO = 1 - ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND. + ELSE IF (.NOT.LSAME(TRANS,'N') .AND. + + .NOT.LSAME(TRANS,'T') .AND. + .NOT.LSAME(TRANS,'C')) THEN INFO = 2 - ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN + ELSE IF (.NOT.LSAME(DIAG,'U') .AND. + + .NOT.LSAME(DIAG,'N')) THEN INFO = 3 ELSE IF (N.LT.0) THEN INFO = 4 @@ -272,28 +268,24 @@ SUBROUTINE CTBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) KPLUS1 = K + 1 IF (INCX.EQ.1) THEN DO 20 J = 1,N - IF (X(J).NE.ZERO) THEN - TEMP = X(J) - L = KPLUS1 - J - DO 10 I = MAX(1,J-K),J - 1 - X(I) = X(I) + TEMP*A(L+I,J) - 10 CONTINUE - IF (NOUNIT) X(J) = X(J)*A(KPLUS1,J) - END IF + TEMP = X(J) + L = KPLUS1 - J + DO 10 I = MAX(1,J-K),J - 1 + X(I) = X(I) + TEMP*A(L+I,J) + 10 CONTINUE + IF (NOUNIT) X(J) = X(J)*A(KPLUS1,J) 20 CONTINUE ELSE JX = KX DO 40 J = 1,N - IF (X(JX).NE.ZERO) THEN - TEMP = X(JX) - IX = KX - L = KPLUS1 - J - DO 30 I = MAX(1,J-K),J - 1 - X(IX) = X(IX) + TEMP*A(L+I,J) - IX = IX + INCX - 30 CONTINUE - IF (NOUNIT) X(JX) = X(JX)*A(KPLUS1,J) - END IF + TEMP = X(JX) + IX = KX + L = KPLUS1 - J + DO 30 I = MAX(1,J-K),J - 1 + X(IX) = X(IX) + TEMP*A(L+I,J) + IX = IX + INCX + 30 CONTINUE + IF (NOUNIT) X(JX) = X(JX)*A(KPLUS1,J) JX = JX + INCX IF (J.GT.K) KX = KX + INCX 40 CONTINUE @@ -301,29 +293,25 @@ SUBROUTINE CTBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) ELSE IF (INCX.EQ.1) THEN DO 60 J = N,1,-1 - IF (X(J).NE.ZERO) THEN - TEMP = X(J) - L = 1 - J - DO 50 I = MIN(N,J+K),J + 1,-1 - X(I) = X(I) + TEMP*A(L+I,J) - 50 CONTINUE - IF (NOUNIT) X(J) = X(J)*A(1,J) - END IF + TEMP = X(J) + L = 1 - J + DO 50 I = MIN(N,J+K),J + 1,-1 + X(I) = X(I) + TEMP*A(L+I,J) + 50 CONTINUE + IF (NOUNIT) X(J) = X(J)*A(1,J) 60 CONTINUE ELSE KX = KX + (N-1)*INCX JX = KX DO 80 J = N,1,-1 - IF (X(JX).NE.ZERO) THEN - TEMP = X(JX) - IX = KX - L = 1 - J - DO 70 I = MIN(N,J+K),J + 1,-1 - X(IX) = X(IX) + TEMP*A(L+I,J) - IX = IX - INCX - 70 CONTINUE - IF (NOUNIT) X(JX) = X(JX)*A(1,J) - END IF + TEMP = X(JX) + IX = KX + L = 1 - J + DO 70 I = MIN(N,J+K),J + 1,-1 + X(IX) = X(IX) + TEMP*A(L+I,J) + IX = IX - INCX + 70 CONTINUE + IF (NOUNIT) X(JX) = X(JX)*A(1,J) JX = JX - INCX IF ((N-J).GE.K) KX = KX - INCX 80 CONTINUE @@ -424,6 +412,6 @@ SUBROUTINE CTBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) * RETURN * -* End of CTBMV . +* End of CTBMV * END diff --git a/BLAS/SRC/ctbsv.f b/BLAS/SRC/ctbsv.f index 16050f1677..309bef7d59 100644 --- a/BLAS/SRC/ctbsv.f +++ b/BLAS/SRC/ctbsv.f @@ -168,9 +168,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level2 +*> \ingroup tbsv * *> \par Further Details: * ===================== @@ -188,11 +186,11 @@ *> * ===================================================================== SUBROUTINE CTBSV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,K,LDA,N @@ -203,10 +201,6 @@ SUBROUTINE CTBSV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) * .. * * ===================================================================== -* -* .. Parameters .. - COMPLEX ZERO - PARAMETER (ZERO= (0.0E+0,0.0E+0)) * .. * .. Local Scalars .. COMPLEX TEMP @@ -229,10 +223,12 @@ SUBROUTINE CTBSV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) INFO = 0 IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN INFO = 1 - ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND. + ELSE IF (.NOT.LSAME(TRANS,'N') .AND. + + .NOT.LSAME(TRANS,'T') .AND. + .NOT.LSAME(TRANS,'C')) THEN INFO = 2 - ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN + ELSE IF (.NOT.LSAME(DIAG,'U') .AND. + + .NOT.LSAME(DIAG,'N')) THEN INFO = 3 ELSE IF (N.LT.0) THEN INFO = 4 @@ -275,59 +271,51 @@ SUBROUTINE CTBSV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) KPLUS1 = K + 1 IF (INCX.EQ.1) THEN DO 20 J = N,1,-1 - IF (X(J).NE.ZERO) THEN - L = KPLUS1 - J - IF (NOUNIT) X(J) = X(J)/A(KPLUS1,J) - TEMP = X(J) - DO 10 I = J - 1,MAX(1,J-K),-1 - X(I) = X(I) - TEMP*A(L+I,J) - 10 CONTINUE - END IF + L = KPLUS1 - J + IF (NOUNIT) X(J) = X(J)/A(KPLUS1,J) + TEMP = X(J) + DO 10 I = J - 1,MAX(1,J-K),-1 + X(I) = X(I) - TEMP*A(L+I,J) + 10 CONTINUE 20 CONTINUE ELSE KX = KX + (N-1)*INCX JX = KX DO 40 J = N,1,-1 KX = KX - INCX - IF (X(JX).NE.ZERO) THEN - IX = KX - L = KPLUS1 - J - IF (NOUNIT) X(JX) = X(JX)/A(KPLUS1,J) - TEMP = X(JX) - DO 30 I = J - 1,MAX(1,J-K),-1 - X(IX) = X(IX) - TEMP*A(L+I,J) - IX = IX - INCX - 30 CONTINUE - END IF + IX = KX + L = KPLUS1 - J + IF (NOUNIT) X(JX) = X(JX)/A(KPLUS1,J) + TEMP = X(JX) + DO 30 I = J - 1,MAX(1,J-K),-1 + X(IX) = X(IX) - TEMP*A(L+I,J) + IX = IX - INCX + 30 CONTINUE JX = JX - INCX 40 CONTINUE END IF ELSE IF (INCX.EQ.1) THEN DO 60 J = 1,N - IF (X(J).NE.ZERO) THEN - L = 1 - J - IF (NOUNIT) X(J) = X(J)/A(1,J) - TEMP = X(J) - DO 50 I = J + 1,MIN(N,J+K) - X(I) = X(I) - TEMP*A(L+I,J) - 50 CONTINUE - END IF + L = 1 - J + IF (NOUNIT) X(J) = X(J)/A(1,J) + TEMP = X(J) + DO 50 I = J + 1,MIN(N,J+K) + X(I) = X(I) - TEMP*A(L+I,J) + 50 CONTINUE 60 CONTINUE ELSE JX = KX DO 80 J = 1,N KX = KX + INCX - IF (X(JX).NE.ZERO) THEN - IX = KX - L = 1 - J - IF (NOUNIT) X(JX) = X(JX)/A(1,J) - TEMP = X(JX) - DO 70 I = J + 1,MIN(N,J+K) - X(IX) = X(IX) - TEMP*A(L+I,J) - IX = IX + INCX - 70 CONTINUE - END IF + IX = KX + L = 1 - J + IF (NOUNIT) X(JX) = X(JX)/A(1,J) + TEMP = X(JX) + DO 70 I = J + 1,MIN(N,J+K) + X(IX) = X(IX) - TEMP*A(L+I,J) + IX = IX + INCX + 70 CONTINUE JX = JX + INCX 80 CONTINUE END IF @@ -427,6 +415,6 @@ SUBROUTINE CTBSV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) * RETURN * -* End of CTBSV . +* End of CTBSV * END diff --git a/BLAS/SRC/ctpmv.f b/BLAS/SRC/ctpmv.f index e699791528..4583044336 100644 --- a/BLAS/SRC/ctpmv.f +++ b/BLAS/SRC/ctpmv.f @@ -120,9 +120,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level2 +*> \ingroup tpmv * *> \par Further Details: * ===================== @@ -141,11 +139,11 @@ *> * ===================================================================== SUBROUTINE CTPMV(UPLO,TRANS,DIAG,N,AP,X,INCX) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,N @@ -156,10 +154,6 @@ SUBROUTINE CTPMV(UPLO,TRANS,DIAG,N,AP,X,INCX) * .. * * ===================================================================== -* -* .. Parameters .. - COMPLEX ZERO - PARAMETER (ZERO= (0.0E+0,0.0E+0)) * .. * .. Local Scalars .. COMPLEX TEMP @@ -182,10 +176,12 @@ SUBROUTINE CTPMV(UPLO,TRANS,DIAG,N,AP,X,INCX) INFO = 0 IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN INFO = 1 - ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND. + ELSE IF (.NOT.LSAME(TRANS,'N') .AND. + + .NOT.LSAME(TRANS,'T') .AND. + .NOT.LSAME(TRANS,'C')) THEN INFO = 2 - ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN + ELSE IF (.NOT.LSAME(DIAG,'U') .AND. + + .NOT.LSAME(DIAG,'N')) THEN INFO = 3 ELSE IF (N.LT.0) THEN INFO = 4 @@ -224,29 +220,25 @@ SUBROUTINE CTPMV(UPLO,TRANS,DIAG,N,AP,X,INCX) KK = 1 IF (INCX.EQ.1) THEN DO 20 J = 1,N - IF (X(J).NE.ZERO) THEN - TEMP = X(J) - K = KK - DO 10 I = 1,J - 1 - X(I) = X(I) + TEMP*AP(K) - K = K + 1 - 10 CONTINUE - IF (NOUNIT) X(J) = X(J)*AP(KK+J-1) - END IF + TEMP = X(J) + K = KK + DO 10 I = 1,J - 1 + X(I) = X(I) + TEMP*AP(K) + K = K + 1 + 10 CONTINUE + IF (NOUNIT) X(J) = X(J)*AP(KK+J-1) KK = KK + J 20 CONTINUE ELSE JX = KX DO 40 J = 1,N - IF (X(JX).NE.ZERO) THEN - TEMP = X(JX) - IX = KX - DO 30 K = KK,KK + J - 2 - X(IX) = X(IX) + TEMP*AP(K) - IX = IX + INCX - 30 CONTINUE - IF (NOUNIT) X(JX) = X(JX)*AP(KK+J-1) - END IF + TEMP = X(JX) + IX = KX + DO 30 K = KK,KK + J - 2 + X(IX) = X(IX) + TEMP*AP(K) + IX = IX + INCX + 30 CONTINUE + IF (NOUNIT) X(JX) = X(JX)*AP(KK+J-1) JX = JX + INCX KK = KK + J 40 CONTINUE @@ -255,30 +247,26 @@ SUBROUTINE CTPMV(UPLO,TRANS,DIAG,N,AP,X,INCX) KK = (N* (N+1))/2 IF (INCX.EQ.1) THEN DO 60 J = N,1,-1 - IF (X(J).NE.ZERO) THEN - TEMP = X(J) - K = KK - DO 50 I = N,J + 1,-1 - X(I) = X(I) + TEMP*AP(K) - K = K - 1 - 50 CONTINUE - IF (NOUNIT) X(J) = X(J)*AP(KK-N+J) - END IF + TEMP = X(J) + K = KK + DO 50 I = N,J + 1,-1 + X(I) = X(I) + TEMP*AP(K) + K = K - 1 + 50 CONTINUE + IF (NOUNIT) X(J) = X(J)*AP(KK-N+J) KK = KK - (N-J+1) 60 CONTINUE ELSE KX = KX + (N-1)*INCX JX = KX DO 80 J = N,1,-1 - IF (X(JX).NE.ZERO) THEN - TEMP = X(JX) - IX = KX - DO 70 K = KK,KK - (N- (J+1)),-1 - X(IX) = X(IX) + TEMP*AP(K) - IX = IX - INCX - 70 CONTINUE - IF (NOUNIT) X(JX) = X(JX)*AP(KK-N+J) - END IF + TEMP = X(JX) + IX = KX + DO 70 K = KK,KK - (N- (J+1)),-1 + X(IX) = X(IX) + TEMP*AP(K) + IX = IX - INCX + 70 CONTINUE + IF (NOUNIT) X(JX) = X(JX)*AP(KK-N+J) JX = JX - INCX KK = KK - (N-J+1) 80 CONTINUE @@ -383,6 +371,6 @@ SUBROUTINE CTPMV(UPLO,TRANS,DIAG,N,AP,X,INCX) * RETURN * -* End of CTPMV . +* End of CTPMV * END diff --git a/BLAS/SRC/ctpsv.f b/BLAS/SRC/ctpsv.f index 2335ef502e..5f94f00539 100644 --- a/BLAS/SRC/ctpsv.f +++ b/BLAS/SRC/ctpsv.f @@ -123,9 +123,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level2 +*> \ingroup tpsv * *> \par Further Details: * ===================== @@ -143,11 +141,11 @@ *> * ===================================================================== SUBROUTINE CTPSV(UPLO,TRANS,DIAG,N,AP,X,INCX) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,N @@ -158,10 +156,6 @@ SUBROUTINE CTPSV(UPLO,TRANS,DIAG,N,AP,X,INCX) * .. * * ===================================================================== -* -* .. Parameters .. - COMPLEX ZERO - PARAMETER (ZERO= (0.0E+0,0.0E+0)) * .. * .. Local Scalars .. COMPLEX TEMP @@ -184,10 +178,12 @@ SUBROUTINE CTPSV(UPLO,TRANS,DIAG,N,AP,X,INCX) INFO = 0 IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN INFO = 1 - ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND. + ELSE IF (.NOT.LSAME(TRANS,'N') .AND. + + .NOT.LSAME(TRANS,'T') .AND. + .NOT.LSAME(TRANS,'C')) THEN INFO = 2 - ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN + ELSE IF (.NOT.LSAME(DIAG,'U') .AND. + + .NOT.LSAME(DIAG,'N')) THEN INFO = 3 ELSE IF (N.LT.0) THEN INFO = 4 @@ -226,29 +222,25 @@ SUBROUTINE CTPSV(UPLO,TRANS,DIAG,N,AP,X,INCX) KK = (N* (N+1))/2 IF (INCX.EQ.1) THEN DO 20 J = N,1,-1 - IF (X(J).NE.ZERO) THEN - IF (NOUNIT) X(J) = X(J)/AP(KK) - TEMP = X(J) - K = KK - 1 - DO 10 I = J - 1,1,-1 - X(I) = X(I) - TEMP*AP(K) - K = K - 1 - 10 CONTINUE - END IF + IF (NOUNIT) X(J) = X(J)/AP(KK) + TEMP = X(J) + K = KK - 1 + DO 10 I = J - 1,1,-1 + X(I) = X(I) - TEMP*AP(K) + K = K - 1 + 10 CONTINUE KK = KK - J 20 CONTINUE ELSE JX = KX + (N-1)*INCX DO 40 J = N,1,-1 - IF (X(JX).NE.ZERO) THEN - IF (NOUNIT) X(JX) = X(JX)/AP(KK) - TEMP = X(JX) - IX = JX - DO 30 K = KK - 1,KK - J + 1,-1 - IX = IX - INCX - X(IX) = X(IX) - TEMP*AP(K) - 30 CONTINUE - END IF + IF (NOUNIT) X(JX) = X(JX)/AP(KK) + TEMP = X(JX) + IX = JX + DO 30 K = KK - 1,KK - J + 1,-1 + IX = IX - INCX + X(IX) = X(IX) - TEMP*AP(K) + 30 CONTINUE JX = JX - INCX KK = KK - J 40 CONTINUE @@ -257,29 +249,25 @@ SUBROUTINE CTPSV(UPLO,TRANS,DIAG,N,AP,X,INCX) KK = 1 IF (INCX.EQ.1) THEN DO 60 J = 1,N - IF (X(J).NE.ZERO) THEN - IF (NOUNIT) X(J) = X(J)/AP(KK) - TEMP = X(J) - K = KK + 1 - DO 50 I = J + 1,N - X(I) = X(I) - TEMP*AP(K) - K = K + 1 - 50 CONTINUE - END IF + IF (NOUNIT) X(J) = X(J)/AP(KK) + TEMP = X(J) + K = KK + 1 + DO 50 I = J + 1,N + X(I) = X(I) - TEMP*AP(K) + K = K + 1 + 50 CONTINUE KK = KK + (N-J+1) 60 CONTINUE ELSE JX = KX DO 80 J = 1,N - IF (X(JX).NE.ZERO) THEN - IF (NOUNIT) X(JX) = X(JX)/AP(KK) - TEMP = X(JX) - IX = JX - DO 70 K = KK + 1,KK + N - J - IX = IX + INCX - X(IX) = X(IX) - TEMP*AP(K) - 70 CONTINUE - END IF + IF (NOUNIT) X(JX) = X(JX)/AP(KK) + TEMP = X(JX) + IX = JX + DO 70 K = KK + 1,KK + N - J + IX = IX + INCX + X(IX) = X(IX) - TEMP*AP(K) + 70 CONTINUE JX = JX + INCX KK = KK + (N-J+1) 80 CONTINUE @@ -385,6 +373,6 @@ SUBROUTINE CTPSV(UPLO,TRANS,DIAG,N,AP,X,INCX) * RETURN * -* End of CTPSV . +* End of CTPSV * END diff --git a/BLAS/SRC/ctrmm.f b/BLAS/SRC/ctrmm.f index 6f79d066da..ea34854c5c 100644 --- a/BLAS/SRC/ctrmm.f +++ b/BLAS/SRC/ctrmm.f @@ -156,9 +156,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level3 +*> \ingroup trmm * *> \par Further Details: * ===================== @@ -176,11 +174,11 @@ *> * ===================================================================== SUBROUTINE CTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) + IMPLICIT NONE * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX ALPHA @@ -236,7 +234,8 @@ SUBROUTINE CTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) + (.NOT.LSAME(TRANSA,'T')) .AND. + (.NOT.LSAME(TRANSA,'C'))) THEN INFO = 3 - ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN + ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. + + (.NOT.LSAME(DIAG,'N'))) THEN INFO = 4 ELSE IF (M.LT.0) THEN INFO = 5 @@ -277,27 +276,23 @@ SUBROUTINE CTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) IF (UPPER) THEN DO 50 J = 1,N DO 40 K = 1,M - IF (B(K,J).NE.ZERO) THEN - TEMP = ALPHA*B(K,J) - DO 30 I = 1,K - 1 - B(I,J) = B(I,J) + TEMP*A(I,K) - 30 CONTINUE - IF (NOUNIT) TEMP = TEMP*A(K,K) - B(K,J) = TEMP - END IF + TEMP = ALPHA*B(K,J) + DO 30 I = 1,K - 1 + B(I,J) = B(I,J) + TEMP*A(I,K) + 30 CONTINUE + IF (NOUNIT) TEMP = TEMP*A(K,K) + B(K,J) = TEMP 40 CONTINUE 50 CONTINUE ELSE DO 80 J = 1,N DO 70 K = M,1,-1 - IF (B(K,J).NE.ZERO) THEN - TEMP = ALPHA*B(K,J) - B(K,J) = TEMP - IF (NOUNIT) B(K,J) = B(K,J)*A(K,K) - DO 60 I = K + 1,M - B(I,J) = B(I,J) + TEMP*A(I,K) - 60 CONTINUE - END IF + TEMP = ALPHA*B(K,J) + B(K,J) = TEMP + IF (NOUNIT) B(K,J) = B(K,J)*A(K,K) + DO 60 I = K + 1,M + B(I,J) = B(I,J) + TEMP*A(I,K) + 60 CONTINUE 70 CONTINUE 80 CONTINUE END IF @@ -356,12 +351,10 @@ SUBROUTINE CTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) B(I,J) = TEMP*B(I,J) 170 CONTINUE DO 190 K = 1,J - 1 - IF (A(K,J).NE.ZERO) THEN - TEMP = ALPHA*A(K,J) - DO 180 I = 1,M - B(I,J) = B(I,J) + TEMP*B(I,K) - 180 CONTINUE - END IF + TEMP = ALPHA*A(K,J) + DO 180 I = 1,M + B(I,J) = B(I,J) + TEMP*B(I,K) + 180 CONTINUE 190 CONTINUE 200 CONTINUE ELSE @@ -372,12 +365,10 @@ SUBROUTINE CTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) B(I,J) = TEMP*B(I,J) 210 CONTINUE DO 230 K = J + 1,N - IF (A(K,J).NE.ZERO) THEN - TEMP = ALPHA*A(K,J) - DO 220 I = 1,M - B(I,J) = B(I,J) + TEMP*B(I,K) - 220 CONTINUE - END IF + TEMP = ALPHA*A(K,J) + DO 220 I = 1,M + B(I,J) = B(I,J) + TEMP*B(I,K) + 220 CONTINUE 230 CONTINUE 240 CONTINUE END IF @@ -388,16 +379,14 @@ SUBROUTINE CTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) IF (UPPER) THEN DO 280 K = 1,N DO 260 J = 1,K - 1 - IF (A(J,K).NE.ZERO) THEN - IF (NOCONJ) THEN - TEMP = ALPHA*A(J,K) - ELSE - TEMP = ALPHA*CONJG(A(J,K)) - END IF - DO 250 I = 1,M - B(I,J) = B(I,J) + TEMP*B(I,K) - 250 CONTINUE + IF (NOCONJ) THEN + TEMP = ALPHA*A(J,K) + ELSE + TEMP = ALPHA*CONJG(A(J,K)) END IF + DO 250 I = 1,M + B(I,J) = B(I,J) + TEMP*B(I,K) + 250 CONTINUE 260 CONTINUE TEMP = ALPHA IF (NOUNIT) THEN @@ -416,16 +405,14 @@ SUBROUTINE CTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) ELSE DO 320 K = N,1,-1 DO 300 J = K + 1,N - IF (A(J,K).NE.ZERO) THEN - IF (NOCONJ) THEN - TEMP = ALPHA*A(J,K) - ELSE - TEMP = ALPHA*CONJG(A(J,K)) - END IF - DO 290 I = 1,M - B(I,J) = B(I,J) + TEMP*B(I,K) - 290 CONTINUE + IF (NOCONJ) THEN + TEMP = ALPHA*A(J,K) + ELSE + TEMP = ALPHA*CONJG(A(J,K)) END IF + DO 290 I = 1,M + B(I,J) = B(I,J) + TEMP*B(I,K) + 290 CONTINUE 300 CONTINUE TEMP = ALPHA IF (NOUNIT) THEN @@ -447,6 +434,6 @@ SUBROUTINE CTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) * RETURN * -* End of CTRMM . +* End of CTRMM * END diff --git a/BLAS/SRC/ctrmv.f b/BLAS/SRC/ctrmv.f index 1eec65be1a..475bf68a41 100644 --- a/BLAS/SRC/ctrmv.f +++ b/BLAS/SRC/ctrmv.f @@ -125,9 +125,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level2 +*> \ingroup trmv * *> \par Further Details: * ===================== @@ -146,11 +144,11 @@ *> * ===================================================================== SUBROUTINE CTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,LDA,N @@ -161,10 +159,6 @@ SUBROUTINE CTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) * .. * * ===================================================================== -* -* .. Parameters .. - COMPLEX ZERO - PARAMETER (ZERO= (0.0E+0,0.0E+0)) * .. * .. Local Scalars .. COMPLEX TEMP @@ -187,10 +181,12 @@ SUBROUTINE CTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) INFO = 0 IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN INFO = 1 - ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND. + ELSE IF (.NOT.LSAME(TRANS,'N') .AND. + + .NOT.LSAME(TRANS,'T') .AND. + .NOT.LSAME(TRANS,'C')) THEN INFO = 2 - ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN + ELSE IF (.NOT.LSAME(DIAG,'U') .AND. + + .NOT.LSAME(DIAG,'N')) THEN INFO = 3 ELSE IF (N.LT.0) THEN INFO = 4 @@ -230,53 +226,45 @@ SUBROUTINE CTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) IF (LSAME(UPLO,'U')) THEN IF (INCX.EQ.1) THEN DO 20 J = 1,N - IF (X(J).NE.ZERO) THEN - TEMP = X(J) - DO 10 I = 1,J - 1 - X(I) = X(I) + TEMP*A(I,J) - 10 CONTINUE - IF (NOUNIT) X(J) = X(J)*A(J,J) - END IF + TEMP = X(J) + DO 10 I = 1,J - 1 + X(I) = X(I) + TEMP*A(I,J) + 10 CONTINUE + IF (NOUNIT) X(J) = X(J)*A(J,J) 20 CONTINUE ELSE JX = KX DO 40 J = 1,N - IF (X(JX).NE.ZERO) THEN - TEMP = X(JX) - IX = KX - DO 30 I = 1,J - 1 - X(IX) = X(IX) + TEMP*A(I,J) - IX = IX + INCX - 30 CONTINUE - IF (NOUNIT) X(JX) = X(JX)*A(J,J) - END IF + TEMP = X(JX) + IX = KX + DO 30 I = 1,J - 1 + X(IX) = X(IX) + TEMP*A(I,J) + IX = IX + INCX + 30 CONTINUE + IF (NOUNIT) X(JX) = X(JX)*A(J,J) JX = JX + INCX 40 CONTINUE END IF ELSE IF (INCX.EQ.1) THEN DO 60 J = N,1,-1 - IF (X(J).NE.ZERO) THEN - TEMP = X(J) - DO 50 I = N,J + 1,-1 - X(I) = X(I) + TEMP*A(I,J) - 50 CONTINUE - IF (NOUNIT) X(J) = X(J)*A(J,J) - END IF + TEMP = X(J) + DO 50 I = N,J + 1,-1 + X(I) = X(I) + TEMP*A(I,J) + 50 CONTINUE + IF (NOUNIT) X(J) = X(J)*A(J,J) 60 CONTINUE ELSE KX = KX + (N-1)*INCX JX = KX DO 80 J = N,1,-1 - IF (X(JX).NE.ZERO) THEN - TEMP = X(JX) - IX = KX - DO 70 I = N,J + 1,-1 - X(IX) = X(IX) + TEMP*A(I,J) - IX = IX - INCX - 70 CONTINUE - IF (NOUNIT) X(JX) = X(JX)*A(J,J) - END IF + TEMP = X(JX) + IX = KX + DO 70 I = N,J + 1,-1 + X(IX) = X(IX) + TEMP*A(I,J) + IX = IX - INCX + 70 CONTINUE + IF (NOUNIT) X(JX) = X(JX)*A(J,J) JX = JX - INCX 80 CONTINUE END IF @@ -368,6 +356,6 @@ SUBROUTINE CTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) * RETURN * -* End of CTRMV . +* End of CTRMV * END diff --git a/BLAS/SRC/ctrsm.f b/BLAS/SRC/ctrsm.f index 2c2aff020c..64e2e1f50c 100644 --- a/BLAS/SRC/ctrsm.f +++ b/BLAS/SRC/ctrsm.f @@ -159,9 +159,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level3 +*> \ingroup trsm * *> \par Further Details: * ===================== @@ -179,11 +177,11 @@ *> * ===================================================================== SUBROUTINE CTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) + IMPLICIT NONE * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX ALPHA @@ -212,8 +210,6 @@ SUBROUTINE CTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) LOGICAL LSIDE,NOCONJ,NOUNIT,UPPER * .. * .. Parameters .. - COMPLEX ONE - PARAMETER (ONE= (1.0E+0,0.0E+0)) COMPLEX ZERO PARAMETER (ZERO= (0.0E+0,0.0E+0)) * .. @@ -239,7 +235,8 @@ SUBROUTINE CTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) + (.NOT.LSAME(TRANSA,'T')) .AND. + (.NOT.LSAME(TRANSA,'C'))) THEN INFO = 3 - ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN + ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. + + (.NOT.LSAME(DIAG,'N'))) THEN INFO = 4 ELSE IF (M.LT.0) THEN INFO = 5 @@ -279,34 +276,26 @@ SUBROUTINE CTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) * IF (UPPER) THEN DO 60 J = 1,N - IF (ALPHA.NE.ONE) THEN - DO 30 I = 1,M - B(I,J) = ALPHA*B(I,J) - 30 CONTINUE - END IF - DO 50 K = M,1,-1 - IF (B(K,J).NE.ZERO) THEN - IF (NOUNIT) B(K,J) = B(K,J)/A(K,K) - DO 40 I = 1,K - 1 - B(I,J) = B(I,J) - B(K,J)*A(I,K) - 40 CONTINUE - END IF + DO 30 I = 1,M + B(I,J) = ALPHA*B(I,J) + 30 CONTINUE + DO 50 K = M,1,-1 + IF (NOUNIT) B(K,J) = B(K,J)/A(K,K) + DO 40 I = 1,K - 1 + B(I,J) = B(I,J) - B(K,J)*A(I,K) + 40 CONTINUE 50 CONTINUE 60 CONTINUE - ELSE - DO 100 J = 1,N - IF (ALPHA.NE.ONE) THEN - DO 70 I = 1,M - B(I,J) = ALPHA*B(I,J) - 70 CONTINUE - END IF - DO 90 K = 1,M - IF (B(K,J).NE.ZERO) THEN - IF (NOUNIT) B(K,J) = B(K,J)/A(K,K) - DO 80 I = K + 1,M - B(I,J) = B(I,J) - B(K,J)*A(I,K) - 80 CONTINUE - END IF + ELSE + DO 100 J = 1,N + DO 70 I = 1,M + B(I,J) = ALPHA*B(I,J) + 70 CONTINUE + DO 90 K = 1,M + IF (NOUNIT) B(K,J) = B(K,J)/A(K,K) + DO 80 I = K + 1,M + B(I,J) = B(I,J) - B(K,J)*A(I,K) + 80 CONTINUE 90 CONTINUE 100 CONTINUE END IF @@ -360,43 +349,33 @@ SUBROUTINE CTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) * IF (UPPER) THEN DO 230 J = 1,N - IF (ALPHA.NE.ONE) THEN - DO 190 I = 1,M - B(I,J) = ALPHA*B(I,J) - 190 CONTINUE - END IF + DO 190 I = 1,M + B(I,J) = ALPHA*B(I,J) + 190 CONTINUE DO 210 K = 1,J - 1 - IF (A(K,J).NE.ZERO) THEN - DO 200 I = 1,M - B(I,J) = B(I,J) - A(K,J)*B(I,K) - 200 CONTINUE - END IF + DO 200 I = 1,M + B(I,J) = B(I,J) - A(K,J)*B(I,K) + 200 CONTINUE 210 CONTINUE IF (NOUNIT) THEN - TEMP = ONE/A(J,J) DO 220 I = 1,M - B(I,J) = TEMP*B(I,J) + B(I,J) = B(I,J)/A(J,J) 220 CONTINUE END IF 230 CONTINUE ELSE DO 280 J = N,1,-1 - IF (ALPHA.NE.ONE) THEN - DO 240 I = 1,M - B(I,J) = ALPHA*B(I,J) - 240 CONTINUE - END IF + DO 240 I = 1,M + B(I,J) = ALPHA*B(I,J) + 240 CONTINUE DO 260 K = J + 1,N - IF (A(K,J).NE.ZERO) THEN - DO 250 I = 1,M - B(I,J) = B(I,J) - A(K,J)*B(I,K) - 250 CONTINUE - END IF + DO 250 I = 1,M + B(I,J) = B(I,J) - A(K,J)*B(I,K) + 250 CONTINUE 260 CONTINUE IF (NOUNIT) THEN - TEMP = ONE/A(J,J) DO 270 I = 1,M - B(I,J) = TEMP*B(I,J) + B(I,J) = B(I,J)/A(J,J) 270 CONTINUE END IF 280 CONTINUE @@ -410,61 +389,55 @@ SUBROUTINE CTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) DO 330 K = N,1,-1 IF (NOUNIT) THEN IF (NOCONJ) THEN - TEMP = ONE/A(K,K) + DO 290 I = 1,M + B(I,K) = B(I,K)/A(K,K) + 290 CONTINUE ELSE - TEMP = ONE/CONJG(A(K,K)) + DO 390 I = 1,M + B(I,K) = B(I,K)/CONJG(A(K,K)) + 390 CONTINUE END IF - DO 290 I = 1,M - B(I,K) = TEMP*B(I,K) - 290 CONTINUE END IF DO 310 J = 1,K - 1 - IF (A(J,K).NE.ZERO) THEN - IF (NOCONJ) THEN - TEMP = A(J,K) - ELSE - TEMP = CONJG(A(J,K)) - END IF - DO 300 I = 1,M - B(I,J) = B(I,J) - TEMP*B(I,K) - 300 CONTINUE + IF (NOCONJ) THEN + TEMP = A(J,K) + ELSE + TEMP = CONJG(A(J,K)) END IF + DO 300 I = 1,M + B(I,J) = B(I,J) - TEMP*B(I,K) + 300 CONTINUE 310 CONTINUE - IF (ALPHA.NE.ONE) THEN - DO 320 I = 1,M - B(I,K) = ALPHA*B(I,K) - 320 CONTINUE - END IF + DO 320 I = 1,M + B(I,K) = ALPHA*B(I,K) + 320 CONTINUE 330 CONTINUE ELSE DO 380 K = 1,N IF (NOUNIT) THEN IF (NOCONJ) THEN - TEMP = ONE/A(K,K) + DO 340 I = 1,M + B(I,K) = B(I,K)/A(K,K) + 340 CONTINUE ELSE - TEMP = ONE/CONJG(A(K,K)) + DO 400 I = 1,M + B(I,K) = B(I,K)/CONJG(A(K,K)) + 400 CONTINUE END IF - DO 340 I = 1,M - B(I,K) = TEMP*B(I,K) - 340 CONTINUE END IF DO 360 J = K + 1,N - IF (A(J,K).NE.ZERO) THEN - IF (NOCONJ) THEN - TEMP = A(J,K) - ELSE - TEMP = CONJG(A(J,K)) - END IF - DO 350 I = 1,M - B(I,J) = B(I,J) - TEMP*B(I,K) - 350 CONTINUE + IF (NOCONJ) THEN + TEMP = A(J,K) + ELSE + TEMP = CONJG(A(J,K)) END IF + DO 350 I = 1,M + B(I,J) = B(I,J) - TEMP*B(I,K) + 350 CONTINUE 360 CONTINUE - IF (ALPHA.NE.ONE) THEN - DO 370 I = 1,M - B(I,K) = ALPHA*B(I,K) - 370 CONTINUE - END IF + DO 370 I = 1,M + B(I,K) = ALPHA*B(I,K) + 370 CONTINUE 380 CONTINUE END IF END IF @@ -472,6 +445,6 @@ SUBROUTINE CTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) * RETURN * -* End of CTRSM . +* End of CTRSM * END diff --git a/BLAS/SRC/ctrsv.f b/BLAS/SRC/ctrsv.f index 81c08240f4..43303fc958 100644 --- a/BLAS/SRC/ctrsv.f +++ b/BLAS/SRC/ctrsv.f @@ -128,9 +128,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex_blas_level2 +*> \ingroup trsv * *> \par Further Details: * ===================== @@ -148,11 +146,11 @@ *> * ===================================================================== SUBROUTINE CTRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,LDA,N @@ -163,10 +161,6 @@ SUBROUTINE CTRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) * .. * * ===================================================================== -* -* .. Parameters .. - COMPLEX ZERO - PARAMETER (ZERO= (0.0E+0,0.0E+0)) * .. * .. Local Scalars .. COMPLEX TEMP @@ -189,10 +183,12 @@ SUBROUTINE CTRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) INFO = 0 IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN INFO = 1 - ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND. + ELSE IF (.NOT.LSAME(TRANS,'N') .AND. + + .NOT.LSAME(TRANS,'T') .AND. + .NOT.LSAME(TRANS,'C')) THEN INFO = 2 - ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN + ELSE IF (.NOT.LSAME(DIAG,'U') .AND. + + .NOT.LSAME(DIAG,'N')) THEN INFO = 3 ELSE IF (N.LT.0) THEN INFO = 4 @@ -232,52 +228,44 @@ SUBROUTINE CTRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) IF (LSAME(UPLO,'U')) THEN IF (INCX.EQ.1) THEN DO 20 J = N,1,-1 - IF (X(J).NE.ZERO) THEN - IF (NOUNIT) X(J) = X(J)/A(J,J) - TEMP = X(J) - DO 10 I = J - 1,1,-1 - X(I) = X(I) - TEMP*A(I,J) - 10 CONTINUE - END IF + IF (NOUNIT) X(J) = X(J)/A(J,J) + TEMP = X(J) + DO 10 I = J - 1,1,-1 + X(I) = X(I) - TEMP*A(I,J) + 10 CONTINUE 20 CONTINUE ELSE JX = KX + (N-1)*INCX DO 40 J = N,1,-1 - IF (X(JX).NE.ZERO) THEN - IF (NOUNIT) X(JX) = X(JX)/A(J,J) - TEMP = X(JX) - IX = JX - DO 30 I = J - 1,1,-1 - IX = IX - INCX - X(IX) = X(IX) - TEMP*A(I,J) - 30 CONTINUE - END IF + IF (NOUNIT) X(JX) = X(JX)/A(J,J) + TEMP = X(JX) + IX = JX + DO 30 I = J - 1,1,-1 + IX = IX - INCX + X(IX) = X(IX) - TEMP*A(I,J) + 30 CONTINUE JX = JX - INCX 40 CONTINUE END IF ELSE IF (INCX.EQ.1) THEN DO 60 J = 1,N - IF (X(J).NE.ZERO) THEN - IF (NOUNIT) X(J) = X(J)/A(J,J) - TEMP = X(J) - DO 50 I = J + 1,N - X(I) = X(I) - TEMP*A(I,J) - 50 CONTINUE - END IF + IF (NOUNIT) X(J) = X(J)/A(J,J) + TEMP = X(J) + DO 50 I = J + 1,N + X(I) = X(I) - TEMP*A(I,J) + 50 CONTINUE 60 CONTINUE ELSE JX = KX DO 80 J = 1,N - IF (X(JX).NE.ZERO) THEN - IF (NOUNIT) X(JX) = X(JX)/A(J,J) - TEMP = X(JX) - IX = JX - DO 70 I = J + 1,N - IX = IX + INCX - X(IX) = X(IX) - TEMP*A(I,J) - 70 CONTINUE - END IF + IF (NOUNIT) X(JX) = X(JX)/A(J,J) + TEMP = X(JX) + IX = JX + DO 70 I = J + 1,N + IX = IX + INCX + X(IX) = X(IX) - TEMP*A(I,J) + 70 CONTINUE JX = JX + INCX 80 CONTINUE END IF @@ -370,6 +358,6 @@ SUBROUTINE CTRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) * RETURN * -* End of CTRSV . +* End of CTRSV * END diff --git a/BLAS/SRC/dasum.f b/BLAS/SRC/dasum.f index cc5977f770..3a1c399a1f 100644 --- a/BLAS/SRC/dasum.f +++ b/BLAS/SRC/dasum.f @@ -54,9 +54,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level1 +*> \ingroup asum * *> \par Further Details: * ===================== @@ -70,11 +68,11 @@ *> * ===================================================================== DOUBLE PRECISION FUNCTION DASUM(N,DX,INCX) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,N @@ -128,4 +126,7 @@ DOUBLE PRECISION FUNCTION DASUM(N,DX,INCX) END IF DASUM = DTEMP RETURN +* +* End of DASUM +* END diff --git a/BLAS/SRC/daxpby.f b/BLAS/SRC/daxpby.f new file mode 100644 index 0000000000..e42bece7b7 --- /dev/null +++ b/BLAS/SRC/daxpby.f @@ -0,0 +1,149 @@ +*> \brief \b DAXPBY +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE DAXPBY(N,DA,DX,INCX,DB,DY,INCY) +* +* .. Scalar Arguments .. +* DOUBLE PRECISION DA,DB +* INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. +* DOUBLE PRECISION DX(*),DY(*) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> DAXPBY constant times a vector plus constant times a vector. +*> +*> Y = ALPHA * X + BETA * Y +*> +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> number of elements in input vector(s) +*> \endverbatim +*> +*> \param[in] DA +*> \verbatim +*> DA is DOUBLE PRECISION +*> On entry, DA specifies the scalar alpha. +*> \endverbatim +*> +*> \param[in] DX +*> \verbatim +*> DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) +*> \endverbatim +*> +*> \param[in] INCX +*> \verbatim +*> INCX is INTEGER +*> storage spacing between elements of DX +*> \endverbatim +*> +*> \param[in] DB +*> \verbatim +*> DB is DOUBLE PRECISION +*> On entry, DB specifies the scalar beta. +*> \endverbatim +*> +*> \param[in,out] DY +*> \verbatim +*> DY is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCY ) ) +*> \endverbatim +*> +*> \param[in] INCY +*> \verbatim +*> INCY is INTEGER +*> storage spacing between elements of DY +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +*> \author Martin Koehler, MPI Magdeburg +* +*> \ingroup axpby +* +* ===================================================================== + SUBROUTINE DAXPBY(N,DA,DX,INCX,DB,DY,INCY) + IMPLICIT NONE +* +* -- Reference BLAS level1 routine -- +* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + DOUBLE PRECISION DA,DB + INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. + DOUBLE PRECISION DX(*),DY(*) +* .. +* .. External Subroutines + EXTERNAL DSCAL +* +* ===================================================================== +* +* .. Local Scalars .. + INTEGER I,IX,IY,M,MP1 +* .. +* .. Intrinsic Functions .. + INTRINSIC MOD +* .. + IF (N.LE.0) RETURN + +* Scale if DA.EQ.0 + IF (DA.EQ.0.0D0 .AND. DB.NE.0.0D0) THEN + CALL DSCAL(N, DB, DY, INCY) + RETURN + END IF + + IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN +* +* code for both increments equal to 1 +* +* +* + DO I = 1,N + DY(I) = DB*DY(I) + DA*DX(I) + END DO + ELSE +* +* code for unequal increments or equal increments +* not equal to 1 +* + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO I = 1,N + DY(IY) = DB*DY(IY) + DA*DX(IX) + IX = IX + INCX + IY = IY + INCY + END DO + END IF + RETURN +* +* End of DAXPBY +* + END diff --git a/BLAS/SRC/daxpy.f b/BLAS/SRC/daxpy.f index cb94fc1e0a..3385e30b6a 100644 --- a/BLAS/SRC/daxpy.f +++ b/BLAS/SRC/daxpy.f @@ -73,9 +73,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level1 +*> \ingroup axpy * *> \par Further Details: * ===================== @@ -88,11 +86,11 @@ *> * ===================================================================== SUBROUTINE DAXPY(N,DA,DX,INCX,DY,INCY) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION DA @@ -149,4 +147,7 @@ SUBROUTINE DAXPY(N,DA,DX,INCX,DY,INCY) END DO END IF RETURN +* +* End of DAXPY +* END diff --git a/BLAS/SRC/dcabs1.f b/BLAS/SRC/dcabs1.f index d6d850ed0f..9014cd6bfe 100644 --- a/BLAS/SRC/dcabs1.f +++ b/BLAS/SRC/dcabs1.f @@ -40,17 +40,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level1 +*> \ingroup abs1 * * ===================================================================== DOUBLE PRECISION FUNCTION DCABS1(Z) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 Z @@ -63,4 +61,7 @@ DOUBLE PRECISION FUNCTION DCABS1(Z) * DCABS1 = ABS(DBLE(Z)) + ABS(DIMAG(Z)) RETURN +* +* End of DCABS1 +* END diff --git a/BLAS/SRC/dcopy.f b/BLAS/SRC/dcopy.f index 27bc08582b..284caac1bc 100644 --- a/BLAS/SRC/dcopy.f +++ b/BLAS/SRC/dcopy.f @@ -66,9 +66,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level1 +*> \ingroup copy * *> \par Further Details: * ===================== @@ -81,11 +79,11 @@ *> * ===================================================================== SUBROUTINE DCOPY(N,DX,INCX,DY,INCY) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,INCY,N @@ -143,4 +141,7 @@ SUBROUTINE DCOPY(N,DX,INCX,DY,INCY) END DO END IF RETURN +* +* End of DCOPY +* END diff --git a/BLAS/SRC/ddot.f b/BLAS/SRC/ddot.f index 3d18695aab..467123fa30 100644 --- a/BLAS/SRC/ddot.f +++ b/BLAS/SRC/ddot.f @@ -66,9 +66,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level1 +*> \ingroup dot * *> \par Further Details: * ===================== @@ -81,11 +79,11 @@ *> * ===================================================================== DOUBLE PRECISION FUNCTION DDOT(N,DX,INCX,DY,INCY) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,INCY,N @@ -145,4 +143,7 @@ DOUBLE PRECISION FUNCTION DDOT(N,DX,INCX,DY,INCY) END IF DDOT = DTEMP RETURN +* +* End of DDOT +* END diff --git a/BLAS/SRC/dgbmv.f b/BLAS/SRC/dgbmv.f index 29fb54343b..c54d5bde1f 100644 --- a/BLAS/SRC/dgbmv.f +++ b/BLAS/SRC/dgbmv.f @@ -146,6 +146,8 @@ *> ( 1 + ( n - 1 )*abs( INCY ) ) otherwise. *> Before entry, the incremented array Y must contain the *> vector y. On exit, Y is overwritten by the updated vector y. +*> If either m or n is zero, then Y not referenced and the function +*> performs a quick return. *> \endverbatim *> *> \param[in] INCY @@ -163,9 +165,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level2 +*> \ingroup gbmv * *> \par Further Details: * ===================== @@ -183,12 +183,13 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) + SUBROUTINE DGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX, + + BETA,Y,INCY) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA,BETA @@ -365,6 +366,6 @@ SUBROUTINE DGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) * RETURN * -* End of DGBMV . +* End of DGBMV * END diff --git a/BLAS/SRC/dgemm.f b/BLAS/SRC/dgemm.f index 3a60ca4e73..e8b15794d7 100644 --- a/BLAS/SRC/dgemm.f +++ b/BLAS/SRC/dgemm.f @@ -35,6 +35,16 @@ *> *> alpha and beta are scalars, and A, B and C are matrices, with op( A ) *> an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. +*> +*> Note: if alpha and/or beta is zero, some parts of the matrix-matrix +*> operations are not performed. This results in the following NaN/Inf +*> propagation quirks: +*> +*> 1. If alpha is zero, NaNs or Infs in A or B do not affect the result. +*> 2. If both alpha and beta are zero, then a zero matrix is returned in C, +*> irrespective of any NaNs or Infs in A, B or C. +*> 3. If only beta is zero, alpha*op( A )*op( B ) is returned, irrespective +*> of any NaNs or Infs in C. *> \endverbatim * * Arguments: @@ -51,6 +61,9 @@ *> TRANSA = 'T' or 't', op( A ) = A**T. *> *> TRANSA = 'C' or 'c', op( A ) = A**T. +*> +*> Note: TRANSA = 'C' is supported for the sake of API consistency +*> between all ?GEMM variants. *> \endverbatim *> *> \param[in] TRANSB @@ -64,6 +77,9 @@ *> TRANSB = 'T' or 't', op( B ) = B**T. *> *> TRANSB = 'C' or 'c', op( B ) = B**T. +*> +*> Note: TRANSB = 'C' is supported for the sake of API consistency +*> between all ?GEMM variants. *> \endverbatim *> *> \param[in] M @@ -92,7 +108,9 @@ *> \param[in] ALPHA *> \verbatim *> ALPHA is DOUBLE PRECISION. -*> On entry, ALPHA specifies the scalar alpha. +*> On entry, ALPHA specifies the scalar alpha. If ALPHA is zero the +*> values in A and B do not affect the result. This also means that +*> NaN/Inf propagation from A and B is inhibited if ALPHA is zero. *> \endverbatim *> *> \param[in] A @@ -102,7 +120,10 @@ *> Before entry with TRANSA = 'N' or 'n', the leading m by k *> part of the array A must contain the matrix A, otherwise *> the leading k by m part of the array A must contain the -*> matrix A. +*> matrix A, except if ALPHA is zero. +*> If ALPHA is zero, none of the values in A affect the result, even +*> if they are NaN/Inf. This also implies that if ALPHA is zero, +*> the matrix elements of A need not be initialized by the caller. *> \endverbatim *> *> \param[in] LDA @@ -121,7 +142,10 @@ *> Before entry with TRANSB = 'N' or 'n', the leading k by n *> part of the array B must contain the matrix B, otherwise *> the leading n by k part of the array B must contain the -*> matrix B. +*> matrix B, except if ALPHA is zero. +*> If ALPHA is zero, none of the values in B affect the result, even +*> if they are NaN/Inf. This also implies that if ALPHA is zero, +*> the matrix elements of B need not be initialized by the caller. *> \endverbatim *> *> \param[in] LDB @@ -136,16 +160,19 @@ *> \param[in] BETA *> \verbatim *> BETA is DOUBLE PRECISION. -*> On entry, BETA specifies the scalar beta. When BETA is -*> supplied as zero then C need not be set on input. +*> On entry, BETA specifies the scalar beta. If BETA is zero the +*> values in C do not affect the result. This also means that +*> NaN/Inf propagation from C is inhibited if BETA is zero. *> \endverbatim *> *> \param[in,out] C *> \verbatim *> C is DOUBLE PRECISION array, dimension ( LDC, N ) *> Before entry, the leading m by n part of the array C must -*> contain the matrix C, except when beta is zero, in which -*> case C need not be set on entry. +*> contain the matrix C, except if beta is zero. +*> If beta is zero, none of the values in C affect the result, even +*> if they are NaN/Inf. This also implies that if beta is zero, +*> the matrix elements of C need not be initialized by the caller. *> On exit, the array C is overwritten by the m by n matrix *> ( alpha*op( A )*op( B ) + beta*C ). *> \endverbatim @@ -166,9 +193,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level3 +*> \ingroup gemm * *> \par Further Details: * ===================== @@ -185,12 +210,13 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) + SUBROUTINE DGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB, + + BETA,C,LDC) + IMPLICIT NONE * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA,BETA @@ -215,7 +241,7 @@ SUBROUTINE DGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * .. * .. Local Scalars .. DOUBLE PRECISION TEMP - INTEGER I,INFO,J,L,NCOLA,NROWA,NROWB + INTEGER I,INFO,J,L,NROWA,NROWB LOGICAL NOTA,NOTB * .. * .. Parameters .. @@ -224,17 +250,15 @@ SUBROUTINE DGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * .. * * Set NOTA and NOTB as true if A and B respectively are not -* transposed and set NROWA, NCOLA and NROWB as the number of rows -* and columns of A and the number of rows of B respectively. +* transposed and set NROWA and NROWB as the number of rows of A +* and B respectively. * NOTA = LSAME(TRANSA,'N') NOTB = LSAME(TRANSB,'N') IF (NOTA) THEN NROWA = M - NCOLA = K ELSE NROWA = K - NCOLA = M END IF IF (NOTB) THEN NROWB = K @@ -379,6 +403,6 @@ SUBROUTINE DGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * RETURN * -* End of DGEMM . +* End of DGEMM * END diff --git a/BLAS/SRC/dgemmtr.f b/BLAS/SRC/dgemmtr.f new file mode 100644 index 0000000000..e729ce0533 --- /dev/null +++ b/BLAS/SRC/dgemmtr.f @@ -0,0 +1,431 @@ +*> \brief \b DGEMMTR +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE DGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB,BETA, +* C,LDC) +* +* .. Scalar Arguments .. +* DOUBLE PRECISION ALPHA,BETA +* INTEGER K,LDA,LDB,LDC,N +* CHARACTER TRANSA,TRANSB, UPLO +* .. +* .. Array Arguments .. +* DOUBLE PRECISION A(LDA,*),B(LDB,*),C(LDC,*) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> DGEMMTR performs one of the matrix-matrix operations +*> +*> C := alpha*op( A )*op( B ) + beta*C, +*> +*> where op( X ) is one of +*> +*> op( X ) = X or op( X ) = X**T, +*> +*> alpha and beta are scalars, and A, B and C are matrices, with op( A ) +*> an n by k matrix, op( B ) a k by n matrix and C an n by n matrix. +*> Thereby, the routine only accesses and updates the upper or lower +*> triangular part of the result matrix C. This behaviour can be used if +*> the resulting matrix C is known to be symmetric. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] UPLO +*> \verbatim +*> UPLO is CHARACTER*1 +*> On entry, UPLO specifies whether the lower or the upper +*> triangular part of C is access and updated. +*> +*> UPLO = 'L' or 'l', the lower triangular part of C is used. +*> +*> UPLO = 'U' or 'u', the upper triangular part of C is used. +*> \endverbatim +* +*> \param[in] TRANSA +*> \verbatim +*> TRANSA is CHARACTER*1 +*> On entry, TRANSA specifies the form of op( A ) to be used in +*> the matrix multiplication as follows: +*> +*> TRANSA = 'N' or 'n', op( A ) = A. +*> +*> TRANSA = 'T' or 't', op( A ) = A**T. +*> +*> TRANSA = 'C' or 'c', op( A ) = A**T. +*> \endverbatim +*> +*> \param[in] TRANSB +*> \verbatim +*> TRANSB is CHARACTER*1 +*> On entry, TRANSB specifies the form of op( B ) to be used in +*> the matrix multiplication as follows: +*> +*> TRANSB = 'N' or 'n', op( B ) = B. +*> +*> TRANSB = 'T' or 't', op( B ) = B**T. +*> +*> TRANSB = 'C' or 'c', op( B ) = B**T. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> On entry, N specifies the number of rows and columns of +*> the matrix C, the number of columns of op(B) and the number +*> of rows of op(A). N must be at least zero. +*> \endverbatim +*> +*> \param[in] K +*> \verbatim +*> K is INTEGER +*> On entry, K specifies the number of columns of the matrix +*> op( A ) and the number of rows of the matrix op( B ). K must +*> be at least zero. +*> \endverbatim +*> +*> \param[in] ALPHA +*> \verbatim +*> ALPHA is DOUBLE PRECISION. +*> On entry, ALPHA specifies the scalar alpha. +*> \endverbatim +*> +*> \param[in] A +*> \verbatim +*> A is DOUBLE PRECISION array, dimension ( LDA, ka ), where ka is +*> k when TRANSA = 'N' or 'n', and is n otherwise. +*> Before entry with TRANSA = 'N' or 'n', the leading n by k +*> part of the array A must contain the matrix A, otherwise +*> the leading k by m part of the array A must contain the +*> matrix A. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> On entry, LDA specifies the first dimension of A as declared +*> in the calling (sub) program. When TRANSA = 'N' or 'n' then +*> LDA must be at least max( 1, n ), otherwise LDA must be at +*> least max( 1, k ). +*> \endverbatim +*> +*> \param[in] B +*> \verbatim +*> B is DOUBLE PRECISION array, dimension ( LDB, kb ), where kb is +*> n when TRANSB = 'N' or 'n', and is k otherwise. +*> Before entry with TRANSB = 'N' or 'n', the leading k by n +*> part of the array B must contain the matrix B, otherwise +*> the leading n by k part of the array B must contain the +*> matrix B. +*> \endverbatim +*> +*> \param[in] LDB +*> \verbatim +*> LDB is INTEGER +*> On entry, LDB specifies the first dimension of B as declared +*> in the calling (sub) program. When TRANSB = 'N' or 'n' then +*> LDB must be at least max( 1, k ), otherwise LDB must be at +*> least max( 1, n ). +*> \endverbatim +*> +*> \param[in] BETA +*> \verbatim +*> BETA is DOUBLE PRECISION. +*> On entry, BETA specifies the scalar beta. When BETA is +*> supplied as zero then C need not be set on input. +*> \endverbatim +*> +*> \param[in,out] C +*> \verbatim +*> C is DOUBLE PRECISION array, dimension ( LDC, N ) +*> Before entry, the leading n by n part of the array C must +*> contain the matrix C, except when beta is zero, in which +*> case C need not be set on entry. +*> On exit, the upper or lower triangular part of the matrix +*> C is overwritten by the n by n matrix +*> ( alpha*op( A )*op( B ) + beta*C ). +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> On entry, LDC specifies the first dimension of C as declared +*> in the calling (sub) program. LDC must be at least +*> max( 1, n ). +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Martin Koehler +* +*> \ingroup gemmtr +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> Level 3 Blas routine. +*> +*> -- Written on 19-July-2023. +*> Martin Koehler, MPI Magdeburg +*> \endverbatim +*> +* ===================================================================== + SUBROUTINE DGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB, + + BETA,C,LDC) + IMPLICIT NONE +* +* -- Reference BLAS level3 routine -- +* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + DOUBLE PRECISION ALPHA,BETA + INTEGER K,LDA,LDB,LDC,N + CHARACTER TRANSA,TRANSB,UPLO +* .. +* .. Array Arguments .. + DOUBLE PRECISION A(LDA,*),B(LDB,*),C(LDC,*) +* .. +* +* ===================================================================== +* +* .. External Functions .. + LOGICAL LSAME + EXTERNAL LSAME +* .. +* .. External Subroutines .. + EXTERNAL XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. +* .. Local Scalars .. + DOUBLE PRECISION TEMP + INTEGER I,INFO,J,L,NROWA,NROWB, ISTART, ISTOP + LOGICAL NOTA,NOTB, UPPER +* .. +* .. Parameters .. + DOUBLE PRECISION ONE,ZERO + PARAMETER (ONE=1.0D+0,ZERO=0.0D+0) +* .. +* +* Set NOTA and NOTB as true if A and B respectively are not +* transposed and set NROWA and NROWB as the number of rows of A +* and B respectively. +* + NOTA = LSAME(TRANSA,'N') + NOTB = LSAME(TRANSB,'N') + IF (NOTA) THEN + NROWA = N + ELSE + NROWA = K + END IF + IF (NOTB) THEN + NROWB = K + ELSE + NROWB = N + END IF + UPPER = LSAME(UPLO, 'U') +* +* Test the input parameters. +* + INFO = 0 + IF ((.NOT. UPPER) .AND. (.NOT. LSAME(UPLO, 'L'))) THEN + INFO = 1 + ELSE IF ((.NOT.NOTA) .AND. (.NOT.LSAME(TRANSA,'C')) .AND. + + (.NOT.LSAME(TRANSA,'T'))) THEN + INFO = 2 + ELSE IF ((.NOT.NOTB) .AND. (.NOT.LSAME(TRANSB,'C')) .AND. + + (.NOT.LSAME(TRANSB,'T'))) THEN + INFO = 3 + ELSE IF (N.LT.0) THEN + INFO = 4 + ELSE IF (K.LT.0) THEN + INFO = 5 + ELSE IF (LDA.LT.MAX(1,NROWA)) THEN + INFO = 8 + ELSE IF (LDB.LT.MAX(1,NROWB)) THEN + INFO = 10 + ELSE IF (LDC.LT.MAX(1,N)) THEN + INFO = 13 + END IF + IF (INFO.NE.0) THEN + CALL XERBLA('DGEMMTR',INFO) + RETURN + END IF +* +* Quick return if possible. +* + IF (N.EQ.0) RETURN +* +* And if alpha.eq.zero. +* + IF (ALPHA.EQ.ZERO) THEN + IF (BETA.EQ.ZERO) THEN + DO 20 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 10 I = ISTART, ISTOP + C(I,J) = ZERO + 10 CONTINUE + 20 CONTINUE + ELSE + DO 40 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 30 I = ISTART, ISTOP + C(I,J) = BETA*C(I,J) + 30 CONTINUE + 40 CONTINUE + END IF + RETURN + END IF +* +* Start the operations. +* + IF (NOTB) THEN + IF (NOTA) THEN +* +* Form C := alpha*A*B + beta*C. +* + DO 90 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + IF (BETA.EQ.ZERO) THEN + DO 50 I = ISTART, ISTOP + C(I,J) = ZERO + 50 CONTINUE + ELSE IF (BETA.NE.ONE) THEN + DO 60 I = ISTART, ISTOP + C(I,J) = BETA*C(I,J) + 60 CONTINUE + END IF + DO 80 L = 1,K + TEMP = ALPHA*B(L,J) + DO 70 I = ISTART, ISTOP + C(I,J) = C(I,J) + TEMP*A(I,L) + 70 CONTINUE + 80 CONTINUE + 90 CONTINUE + ELSE +* +* Form C := alpha*A**T*B + beta*C +* + DO 120 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 110 I = ISTART, ISTOP + TEMP = ZERO + DO 100 L = 1,K + TEMP = TEMP + A(L,I)*B(L,J) + 100 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP + ELSE + C(I,J) = ALPHA*TEMP + BETA*C(I,J) + END IF + 110 CONTINUE + 120 CONTINUE + END IF + ELSE + IF (NOTA) THEN +* +* Form C := alpha*A*B**T + beta*C +* + DO 170 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + IF (BETA.EQ.ZERO) THEN + DO 130 I = ISTART,ISTOP + C(I,J) = ZERO + 130 CONTINUE + ELSE IF (BETA.NE.ONE) THEN + DO 140 I = ISTART,ISTOP + C(I,J) = BETA*C(I,J) + 140 CONTINUE + END IF + DO 160 L = 1,K + TEMP = ALPHA*B(J,L) + DO 150 I = ISTART,ISTOP + C(I,J) = C(I,J) + TEMP*A(I,L) + 150 CONTINUE + 160 CONTINUE + 170 CONTINUE + ELSE +* +* Form C := alpha*A**T*B**T + beta*C +* + DO 200 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 190 I = ISTART, ISTOP + TEMP = ZERO + DO 180 L = 1,K + TEMP = TEMP + A(L,I)*B(J,L) + 180 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP + ELSE + C(I,J) = ALPHA*TEMP + BETA*C(I,J) + END IF + 190 CONTINUE + 200 CONTINUE + END IF + END IF +* + RETURN +* +* End of DGEMMTR +* + END diff --git a/BLAS/SRC/dgemv.f b/BLAS/SRC/dgemv.f index 08e395b1cd..f6defb8c29 100644 --- a/BLAS/SRC/dgemv.f +++ b/BLAS/SRC/dgemv.f @@ -117,6 +117,8 @@ *> Before entry with BETA non-zero, the incremented array Y *> must contain the vector y. On exit, Y is overwritten by the *> updated vector y. +*> If either m or n is zero, then Y not referenced and the function +*> performs a quick return. *> \endverbatim *> *> \param[in] INCY @@ -134,9 +136,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level2 +*> \ingroup gemv * *> \par Further Details: * ===================== @@ -155,11 +155,11 @@ *> * ===================================================================== SUBROUTINE DGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA,BETA @@ -325,6 +325,6 @@ SUBROUTINE DGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) * RETURN * -* End of DGEMV . +* End of DGEMV * END diff --git a/BLAS/SRC/dger.f b/BLAS/SRC/dger.f index bdc8ef4349..24a6d86bb2 100644 --- a/BLAS/SRC/dger.f +++ b/BLAS/SRC/dger.f @@ -109,9 +109,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level2 +*> \ingroup ger * *> \par Further Details: * ===================== @@ -129,11 +127,11 @@ *> * ===================================================================== SUBROUTINE DGER(M,N,ALPHA,X,INCX,Y,INCY,A,LDA) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA @@ -222,6 +220,6 @@ SUBROUTINE DGER(M,N,ALPHA,X,INCX,Y,INCY,A,LDA) * RETURN * -* End of DGER . +* End of DGER * END diff --git a/BLAS/SRC/dnrm2.f b/BLAS/SRC/dnrm2.f deleted file mode 100644 index 30552e1d1d..0000000000 --- a/BLAS/SRC/dnrm2.f +++ /dev/null @@ -1,132 +0,0 @@ -*> \brief \b DNRM2 -* -* =========== DOCUMENTATION =========== -* -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ -* -* Definition: -* =========== -* -* DOUBLE PRECISION FUNCTION DNRM2(N,X,INCX) -* -* .. Scalar Arguments .. -* INTEGER INCX,N -* .. -* .. Array Arguments .. -* DOUBLE PRECISION X(*) -* .. -* -* -*> \par Purpose: -* ============= -*> -*> \verbatim -*> -*> DNRM2 returns the euclidean norm of a vector via the function -*> name, so that -*> -*> DNRM2 := sqrt( x'*x ) -*> \endverbatim -* -* Arguments: -* ========== -* -*> \param[in] N -*> \verbatim -*> N is INTEGER -*> number of elements in input vector(s) -*> \endverbatim -*> -*> \param[in] X -*> \verbatim -*> X is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) -*> \endverbatim -*> -*> \param[in] INCX -*> \verbatim -*> INCX is INTEGER -*> storage spacing between elements of DX -*> \endverbatim -* -* Authors: -* ======== -* -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. -* -*> \date December 2016 -* -*> \ingroup double_blas_level1 -* -*> \par Further Details: -* ===================== -*> -*> \verbatim -*> -*> -- This version written on 25-October-1982. -*> Modified on 14-October-1993 to inline the call to DLASSQ. -*> Sven Hammarling, Nag Ltd. -*> \endverbatim -*> -* ===================================================================== - DOUBLE PRECISION FUNCTION DNRM2(N,X,INCX) -* -* -- Reference BLAS level1 routine (version 3.7.0) -- -* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 -* -* .. Scalar Arguments .. - INTEGER INCX,N -* .. -* .. Array Arguments .. - DOUBLE PRECISION X(*) -* .. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE,ZERO - PARAMETER (ONE=1.0D+0,ZERO=0.0D+0) -* .. -* .. Local Scalars .. - DOUBLE PRECISION ABSXI,NORM,SCALE,SSQ - INTEGER IX -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS,SQRT -* .. - IF (N.LT.1 .OR. INCX.LT.1) THEN - NORM = ZERO - ELSE IF (N.EQ.1) THEN - NORM = ABS(X(1)) - ELSE - SCALE = ZERO - SSQ = ONE -* The following loop is equivalent to this call to the LAPACK -* auxiliary routine: -* CALL DLASSQ( N, X, INCX, SCALE, SSQ ) -* - DO 10 IX = 1,1 + (N-1)*INCX,INCX - IF (X(IX).NE.ZERO) THEN - ABSXI = ABS(X(IX)) - IF (SCALE.LT.ABSXI) THEN - SSQ = ONE + SSQ* (SCALE/ABSXI)**2 - SCALE = ABSXI - ELSE - SSQ = SSQ + (ABSXI/SCALE)**2 - END IF - END IF - 10 CONTINUE - NORM = SCALE*SQRT(SSQ) - END IF -* - DNRM2 = NORM - RETURN -* -* End of DNRM2. -* - END diff --git a/BLAS/SRC/dnrm2.f90 b/BLAS/SRC/dnrm2.f90 new file mode 100644 index 0000000000..638687c81b --- /dev/null +++ b/BLAS/SRC/dnrm2.f90 @@ -0,0 +1,200 @@ +!> \brief \b DNRM2 +! +! =========== DOCUMENTATION =========== +! +! Online html documentation available at +! http://www.netlib.org/lapack/explore-html/ +! +! Definition: +! =========== +! +! DOUBLE PRECISION FUNCTION DNRM2(N,X,INCX) +! +! .. Scalar Arguments .. +! INTEGER INCX,N +! .. +! .. Array Arguments .. +! DOUBLE PRECISION X(*) +! .. +! +! +!> \par Purpose: +! ============= +!> +!> \verbatim +!> +!> DNRM2 returns the euclidean norm of a vector via the function +!> name, so that +!> +!> DNRM2 := sqrt( x'*x ) +!> \endverbatim +! +! Arguments: +! ========== +! +!> \param[in] N +!> \verbatim +!> N is INTEGER +!> number of elements in input vector(s) +!> \endverbatim +!> +!> \param[in] X +!> \verbatim +!> X is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) +!> \endverbatim +!> +!> \param[in] INCX +!> \verbatim +!> INCX is INTEGER, storage spacing between elements of X +!> If INCX > 0, X(1+(i-1)*INCX) = x(i) for 1 <= i <= n +!> If INCX < 0, X(1-(n-i)*INCX) = x(i) for 1 <= i <= n +!> If INCX = 0, x isn't a vector so there is no need to call +!> this subroutine. If you call it anyway, it will count x(1) +!> in the vector norm N times. +!> \endverbatim +! +! Authors: +! ======== +! +!> \author Edward Anderson, Lockheed Martin +! +!> \date August 2016 +! +!> \ingroup nrm2 +! +!> \par Contributors: +! ================== +!> +!> Weslley Pereira, University of Colorado Denver, USA +! +!> \par Further Details: +! ===================== +!> +!> \verbatim +!> +!> Anderson E. (2017) +!> Algorithm 978: Safe Scaling in the Level 1 BLAS +!> ACM Trans Math Softw 44:1--28 +!> https://doi.org/10.1145/3061665 +!> +!> Blue, James L. (1978) +!> A Portable Fortran Program to Find the Euclidean Norm of a Vector +!> ACM Trans Math Softw 4:15--23 +!> https://doi.org/10.1145/355769.355771 +!> +!> \endverbatim +!> +! ===================================================================== +function DNRM2( n, x, incx ) + implicit none + integer, parameter :: wp = kind(1.d0) + real(wp) :: DNRM2 +! +! -- Reference BLAS level1 routine -- +! -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +! -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +! March 2021 +! +! .. Constants .. + real(wp), parameter :: zero = 0.0_wp + real(wp), parameter :: one = 1.0_wp + real(wp), parameter :: maxN = huge(0.0_wp) +! .. +! .. Blue's scaling constants .. + real(wp), parameter :: tsml = real(radix(0._wp), wp)**ceiling( & + (minexponent(0._wp) - 1) * 0.5_wp) + real(wp), parameter :: tbig = real(radix(0._wp), wp)**floor( & + (maxexponent(0._wp) - digits(0._wp) + 1) * 0.5_wp) + real(wp), parameter :: ssml = real(radix(0._wp), wp)**( - floor( & + (minexponent(0._wp) - digits(0._wp)) * 0.5_wp)) + real(wp), parameter :: sbig = real(radix(0._wp), wp)**( - ceiling( & + (maxexponent(0._wp) + digits(0._wp) - 1) * 0.5_wp)) +! .. +! .. Scalar Arguments .. + integer :: incx, n +! .. +! .. Array Arguments .. + real(wp) :: x(*) +! .. +! .. Local Scalars .. + integer :: i, ix + logical :: notbig + real(wp) :: abig, amed, asml, ax, scl, sumsq, ymax, ymin +! +! Quick return if possible +! + DNRM2 = zero + if( n <= 0 ) return +! + scl = one + sumsq = zero +! +! Compute the sum of squares in 3 accumulators: +! abig -- sums of squares scaled down to avoid overflow +! asml -- sums of squares scaled up to avoid underflow +! amed -- sums of squares that do not require scaling +! The thresholds and multipliers are +! tbig -- values bigger than this are scaled down by sbig +! tsml -- values smaller than this are scaled up by ssml +! + notbig = .true. + asml = zero + amed = zero + abig = zero + ix = 1 + if( incx < 0 ) ix = 1 - (n-1)*incx + do i = 1, n + ax = abs(x(ix)) + if (ax > tbig) then + abig = abig + (ax*sbig)**2 + notbig = .false. + else if (ax < tsml) then + if (notbig) asml = asml + (ax*ssml)**2 + else + amed = amed + ax**2 + end if + ix = ix + incx + end do +! +! Combine abig and amed or amed and asml if more than one +! accumulator was used. +! + if (abig > zero) then +! +! Combine abig and amed if abig > 0. +! + if ( (amed > zero) .or. (amed > maxN) .or. (amed /= amed) ) then + abig = abig + (amed*sbig)*sbig + end if + scl = one / sbig + sumsq = abig + else if (asml > zero) then +! +! Combine amed and asml if asml > 0. +! + if ( (amed > zero) .or. (amed > maxN) .or. (amed /= amed) ) then + amed = sqrt(amed) + asml = sqrt(asml) / ssml + if (asml > amed) then + ymin = amed + ymax = asml + else + ymin = asml + ymax = amed + end if + scl = one + sumsq = ymax**2*( one + (ymin/ymax)**2 ) + else + scl = one / ssml + sumsq = asml + end if + else +! +! Otherwise all values are mid-range +! + scl = one + sumsq = amed + end if + DNRM2 = scl*sqrt( sumsq ) + return +end function diff --git a/BLAS/SRC/drot.f b/BLAS/SRC/drot.f index 0d33ea76c8..973a0c759b 100644 --- a/BLAS/SRC/drot.f +++ b/BLAS/SRC/drot.f @@ -76,9 +76,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level1 +*> \ingroup rot * *> \par Further Details: * ===================== @@ -91,11 +89,11 @@ *> * ===================================================================== SUBROUTINE DROT(N,DX,INCX,DY,INCY,C,S) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION C,S @@ -139,4 +137,7 @@ SUBROUTINE DROT(N,DX,INCX,DY,INCY,C,S) END DO END IF RETURN +* +* End of DROT +* END diff --git a/BLAS/SRC/drotg.f b/BLAS/SRC/drotg.f deleted file mode 100644 index f0ff85e543..0000000000 --- a/BLAS/SRC/drotg.f +++ /dev/null @@ -1,109 +0,0 @@ -*> \brief \b DROTG -* -* =========== DOCUMENTATION =========== -* -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ -* -* Definition: -* =========== -* -* SUBROUTINE DROTG(DA,DB,C,S) -* -* .. Scalar Arguments .. -* DOUBLE PRECISION C,DA,DB,S -* .. -* -* -*> \par Purpose: -* ============= -*> -*> \verbatim -*> -*> DROTG construct givens plane rotation. -*> \endverbatim -* -* Arguments: -* ========== -* -*> \param[in] DA -*> \verbatim -*> DA is DOUBLE PRECISION -*> \endverbatim -*> -*> \param[in] DB -*> \verbatim -*> DB is DOUBLE PRECISION -*> \endverbatim -*> -*> \param[out] C -*> \verbatim -*> C is DOUBLE PRECISION -*> \endverbatim -*> -*> \param[out] S -*> \verbatim -*> S is DOUBLE PRECISION -*> \endverbatim -* -* Authors: -* ======== -* -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. -* -*> \date December 2016 -* -*> \ingroup double_blas_level1 -* -*> \par Further Details: -* ===================== -*> -*> \verbatim -*> -*> jack dongarra, linpack, 3/11/78. -*> \endverbatim -*> -* ===================================================================== - SUBROUTINE DROTG(DA,DB,C,S) -* -* -- Reference BLAS level1 routine (version 3.7.0) -- -* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 -* -* .. Scalar Arguments .. - DOUBLE PRECISION C,DA,DB,S -* .. -* -* ===================================================================== -* -* .. Local Scalars .. - DOUBLE PRECISION R,ROE,SCALE,Z -* .. -* .. Intrinsic Functions .. - INTRINSIC DABS,DSIGN,DSQRT -* .. - ROE = DB - IF (DABS(DA).GT.DABS(DB)) ROE = DA - SCALE = DABS(DA) + DABS(DB) - IF (SCALE.EQ.0.0d0) THEN - C = 1.0d0 - S = 0.0d0 - R = 0.0d0 - Z = 0.0d0 - ELSE - R = SCALE*DSQRT((DA/SCALE)**2+ (DB/SCALE)**2) - R = DSIGN(1.0d0,ROE)*R - C = DA/R - S = DB/R - Z = 1.0d0 - IF (DABS(DA).GT.DABS(DB)) Z = S - IF (DABS(DB).GE.DABS(DA) .AND. C.NE.0.0d0) Z = 1.0d0/C - END IF - DA = R - DB = Z - RETURN - END diff --git a/BLAS/SRC/drotg.f90 b/BLAS/SRC/drotg.f90 new file mode 100644 index 0000000000..b1abba914b --- /dev/null +++ b/BLAS/SRC/drotg.f90 @@ -0,0 +1,151 @@ +!> \brief \b DROTG +! +! =========== DOCUMENTATION =========== +! +! Online html documentation available at +! http://www.netlib.org/lapack/explore-html/ +! +!> \par Purpose: +! ============= +!> +!> \verbatim +!> +!> DROTG constructs a plane rotation +!> [ c s ] [ a ] = [ r ] +!> [ -s c ] [ b ] [ 0 ] +!> satisfying c**2 + s**2 = 1. +!> +!> The computation uses the formulas +!> sigma = sgn(a) if |a| > |b| +!> = sgn(b) if |b| >= |a| +!> r = sigma*sqrt( a**2 + b**2 ) +!> c = 1; s = 0 if r = 0 +!> c = a/r; s = b/r if r != 0 +!> The subroutine also computes +!> z = s if |a| > |b|, +!> = 1/c if |b| >= |a| and c != 0 +!> = 1 if c = 0 +!> This allows c and s to be reconstructed from z as follows: +!> If z = 1, set c = 0, s = 1. +!> If |z| < 1, set c = sqrt(1 - z**2) and s = z. +!> If |z| > 1, set c = 1/z and s = sqrt( 1 - c**2). +!> +!> \endverbatim +!> +!> @see lartg, @see lartgp +! +! Arguments: +! ========== +! +!> \param[in,out] A +!> \verbatim +!> A is DOUBLE PRECISION +!> On entry, the scalar a. +!> On exit, the scalar r. +!> \endverbatim +!> +!> \param[in,out] B +!> \verbatim +!> B is DOUBLE PRECISION +!> On entry, the scalar b. +!> On exit, the scalar z. +!> \endverbatim +!> +!> \param[out] C +!> \verbatim +!> C is DOUBLE PRECISION +!> The scalar c. +!> \endverbatim +!> +!> \param[out] S +!> \verbatim +!> S is DOUBLE PRECISION +!> The scalar s. +!> \endverbatim +! +! Authors: +! ======== +! +!> \author Edward Anderson, Lockheed Martin +! +!> \par Contributors: +! ================== +!> +!> Weslley Pereira, University of Colorado Denver, USA +! +!> \ingroup rotg +! +!> \par Further Details: +! ===================== +!> +!> \verbatim +!> +!> Anderson E. (2017) +!> Algorithm 978: Safe Scaling in the Level 1 BLAS +!> ACM Trans Math Softw 44:1--28 +!> https://doi.org/10.1145/3061665 +!> +!> \endverbatim +! +! ===================================================================== +subroutine DROTG( a, b, c, s ) + implicit none + integer, parameter :: wp = kind(1.d0) +! +! -- Reference BLAS level1 routine -- +! -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +! -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +! +! .. Constants .. + real(wp), parameter :: zero = 0.0_wp + real(wp), parameter :: one = 1.0_wp +! .. +! .. Scaling constants .. + real(wp), parameter :: safmin = real(radix(0._wp),wp)**max( & + minexponent(0._wp)-1, & + 1-maxexponent(0._wp) & + ) + real(wp), parameter :: safmax = real(radix(0._wp),wp)**max( & + 1-minexponent(0._wp), & + maxexponent(0._wp)-1 & + ) +! .. +! .. Scalar Arguments .. + real(wp) :: a, b, c, s +! .. +! .. Local Scalars .. + real(wp) :: anorm, bnorm, scl, sigma, r, z +! .. + anorm = abs(a) + bnorm = abs(b) + if( bnorm == zero ) then + c = one + s = zero + b = zero + else if( anorm == zero ) then + c = zero + s = one + a = b + b = one + else + scl = min( safmax, max( safmin, anorm, bnorm ) ) + if( anorm > bnorm ) then + sigma = sign(one,a) + else + sigma = sign(one,b) + end if + r = sigma*( scl*sqrt((a/scl)**2 + (b/scl)**2) ) + c = a/r + s = b/r + if( anorm > bnorm ) then + z = s + else if( c /= zero ) then + z = one/c + else + z = one + end if + a = r + b = z + end if + return +end subroutine diff --git a/BLAS/SRC/drotm.f b/BLAS/SRC/drotm.f index b1190f5c91..1eb7d89509 100644 --- a/BLAS/SRC/drotm.f +++ b/BLAS/SRC/drotm.f @@ -38,6 +38,10 @@ *> H=( ) ( ) ( ) ( ) *> (DH21 DH22), (DH21 1.D0), (-1.D0 DH22), (0.D0 1.D0). *> SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM. +*> +*> IF DFLAG IS NOT ONE OF THE LISTED ABOVE, THE BEHAVIOR IS UNDEFINED. +*> NANS IN DFLAG MAY NOT PROPAGATE TO THE OUTPUT. +*> *> \endverbatim * * Arguments: @@ -89,17 +93,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level1 +*> \ingroup rotm * * ===================================================================== SUBROUTINE DROTM(N,DX,INCX,DY,INCY,DPARAM) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,INCY,N @@ -197,4 +199,7 @@ SUBROUTINE DROTM(N,DX,INCX,DY,INCY,DPARAM) END IF END IF RETURN +* +* End of DROTM +* END diff --git a/BLAS/SRC/drotmg.f b/BLAS/SRC/drotmg.f index 4510fa7838..bf23a8501c 100644 --- a/BLAS/SRC/drotmg.f +++ b/BLAS/SRC/drotmg.f @@ -24,14 +24,18 @@ *> \verbatim *> *> CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS -*> THE SECOND COMPONENT OF THE 2-VECTOR (DSQRT(DD1)*DX1,DSQRT(DD2)*> DY2)**T. -*> WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. +*> THE SECOND COMPONENT OF THE 2-VECTOR +*> (DSQRT(DD1)*DX1,DSQRT(DD2)*DY2)**T +*> WITH DPARAM(1)=DFLAG. *> -*> DFLAG=-1.D0 DFLAG=0.D0 DFLAG=1.D0 DFLAG=-2.D0 +*> H HAS ONE OF THE FOLLOWING FORMS: +*> +*> DFLAG=-1.D0 DFLAG=0.D0 DFLAG=1.D0 DFLAG=-2.D0 *> *> (DH11 DH12) (1.D0 DH12) (DH11 1.D0) (1.D0 0.D0) *> H=( ) ( ) ( ) ( ) *> (DH21 DH22), (DH21 1.D0), (-1.D0 DH22), (0.D0 1.D0). +*> *> LOCATIONS 2-4 OF DPARAM CONTAIN DH11, DH21, DH12, AND DH22 *> RESPECTIVELY. (VALUES OF 1.D0, -1.D0, OR 0.D0 IMPLIED BY THE *> VALUE OF DPARAM(1) ARE NOT STORED IN DPARAM.) @@ -83,17 +87,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level1 +*> \ingroup rotmg * * ===================================================================== SUBROUTINE DROTMG(DD1,DD2,DX1,DY1,DPARAM) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION DD1,DD2,DX1,DY1 @@ -152,6 +154,19 @@ SUBROUTINE DROTMG(DD1,DD2,DX1,DY1,DPARAM) DD1 = DD1/DU DD2 = DD2/DU DX1 = DX1*DU + ELSE +* This code path if here for safety. We do not expect this +* condition to ever hold except in edge cases with rounding +* errors. See DOI: 10.1145/355841.355847 + DFLAG = -ONE + DH11 = ZERO + DH12 = ZERO + DH21 = ZERO + DH22 = ZERO +* + DD1 = ZERO + DD2 = ZERO + DX1 = ZERO END IF ELSE @@ -185,7 +200,7 @@ SUBROUTINE DROTMG(DD1,DD2,DX1,DY1,DPARAM) DH11 = ONE DH22 = ONE DFLAG = -ONE - ELSE + ELSE IF (DFLAG.EQ.ONE) THEN DH21 = -ONE DH12 = ONE DFLAG = -ONE @@ -210,7 +225,7 @@ SUBROUTINE DROTMG(DD1,DD2,DX1,DY1,DPARAM) DH11 = ONE DH22 = ONE DFLAG = -ONE - ELSE + ELSE IF (DFLAG.EQ.ONE) THEN DH21 = -ONE DH12 = ONE DFLAG = -ONE @@ -244,8 +259,7 @@ SUBROUTINE DROTMG(DD1,DD2,DX1,DY1,DPARAM) DPARAM(1) = DFLAG RETURN +* +* End of DROTMG +* END - - - - diff --git a/BLAS/SRC/dsbmv.f b/BLAS/SRC/dsbmv.f index 0f7c694068..9b3f76faa6 100644 --- a/BLAS/SRC/dsbmv.f +++ b/BLAS/SRC/dsbmv.f @@ -162,9 +162,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level2 +*> \ingroup hbmv * *> \par Further Details: * ===================== @@ -183,11 +181,11 @@ *> * ===================================================================== SUBROUTINE DSBMV(UPLO,N,K,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA,BETA @@ -370,6 +368,6 @@ SUBROUTINE DSBMV(UPLO,N,K,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) * RETURN * -* End of DSBMV . +* End of DSBMV * END diff --git a/BLAS/SRC/dscal.f b/BLAS/SRC/dscal.f index e0a92de6ba..24437f5d14 100644 --- a/BLAS/SRC/dscal.f +++ b/BLAS/SRC/dscal.f @@ -62,9 +62,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level1 +*> \ingroup scal * *> \par Further Details: * ===================== @@ -78,11 +76,11 @@ *> * ===================================================================== SUBROUTINE DSCAL(N,DA,DX,INCX) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION DA @@ -96,11 +94,14 @@ SUBROUTINE DSCAL(N,DA,DX,INCX) * * .. Local Scalars .. INTEGER I,M,MP1,NINCX +* .. Parameters .. + DOUBLE PRECISION ONE + PARAMETER (ONE=1.0D+0) * .. * .. Intrinsic Functions .. INTRINSIC MOD * .. - IF (N.LE.0 .OR. INCX.LE.0) RETURN + IF (N.LE.0 .OR. INCX.LE.0 .OR. DA.EQ.ONE) RETURN IF (INCX.EQ.1) THEN * * code for increment equal to 1 @@ -133,4 +134,7 @@ SUBROUTINE DSCAL(N,DA,DX,INCX) END DO END IF RETURN +* +* End of DSCAL +* END diff --git a/BLAS/SRC/dsdot.f b/BLAS/SRC/dsdot.f index f9cb498025..78983b2929 100644 --- a/BLAS/SRC/dsdot.f +++ b/BLAS/SRC/dsdot.f @@ -84,9 +84,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level1 +*> \ingroup dot * *> \par Further Details: * ===================== @@ -118,11 +116,11 @@ *> * ===================================================================== DOUBLE PRECISION FUNCTION DSDOT(N,SX,INCX,SY,INCY) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,INCY,N @@ -169,4 +167,7 @@ DOUBLE PRECISION FUNCTION DSDOT(N,SX,INCX,SY,INCY) END DO END IF RETURN +* +* End of DSDOT +* END diff --git a/BLAS/SRC/dskewsymm.f b/BLAS/SRC/dskewsymm.f new file mode 100644 index 0000000000..12d862215f --- /dev/null +++ b/BLAS/SRC/dskewsymm.f @@ -0,0 +1,365 @@ +*> \brief \b DSKEWSYMM +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE DSKEWSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC) +* +* .. Scalar Arguments .. +* DOUBLE PRECISION ALPHA,BETA +* INTEGER LDA,LDB,LDC,M,N +* CHARACTER SIDE,UPLO +* .. +* .. Array Arguments .. +* DOUBLE PRECISION A(LDA,*),B(LDB,*),C(LDC,*) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> DSKEWSYMM performs one of the matrix-matrix operations +*> +*> C := alpha*A*B + beta*C, +*> +*> or +*> +*> C := alpha*B*A + beta*C, +*> +*> where alpha and beta are scalars, A is a skew-symmetric matrix and B and +*> C are m by n matrices. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] SIDE +*> \verbatim +*> SIDE is CHARACTER*1 +*> On entry, SIDE specifies whether the skew-symmetric matrix A +*> appears on the left or right in the operation as follows: +*> +*> SIDE = 'L' or 'l' C := alpha*A*B + beta*C, +*> +*> SIDE = 'R' or 'r' C := alpha*B*A + beta*C, +*> \endverbatim +*> +*> \param[in] UPLO +*> \verbatim +*> UPLO is CHARACTER*1 +*> On entry, UPLO specifies whether the upper or lower +*> triangular part of the skew-symmetric matrix A is to be +*> referenced as follows: +*> +*> UPLO = 'U' or 'u' Only the upper triangular part of the +*> skew-symmetric matrix is to be referenced. +*> +*> UPLO = 'L' or 'l' Only the lower triangular part of the +*> skew-symmetric matrix is to be referenced. +*> \endverbatim +*> +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> On entry, M specifies the number of rows of the matrix C. +*> M must be at least zero. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> On entry, N specifies the number of columns of the matrix C. +*> N must be at least zero. +*> \endverbatim +*> +*> \param[in] ALPHA +*> \verbatim +*> ALPHA is DOUBLE PRECISION +*> On entry, ALPHA specifies the scalar alpha. +*> \endverbatim +*> +*> \param[in] A +*> \verbatim +*> A is DOUBLE PRECISION array, dimension ( LDA, ka ), where ka is +*> m when SIDE = 'L' or 'l' and is n otherwise. +*> Before entry with SIDE = 'L' or 'l', the m by m part of +*> the array A must contain the skew-symmetric matrix, such that +*> when UPLO = 'U' or 'u', the strictly m by m upper triangular +*> part of the array A must contain the upper triangular part +*> of the skew-symmetric matrix and the leading lower triangular +*> part of A is not referenced, and when UPLO = 'L' or 'l', +*> the strictly m by m lower triangular part of the array A +*> must contain the lower triangular part of the skew-symmetric +*> matrix and the leading upper triangular part of A is not +*> referenced. +*> Before entry with SIDE = 'R' or 'r', the n by n part of +*> the array A must contain the skew-symmetric matrix, such that +*> when UPLO = 'U' or 'u', the strictly n by n upper triangular +*> part of the array A must contain the upper triangular part +*> of the skew-symmetric matrix and the leading lower triangular +*> part of A is not referenced, and when UPLO = 'L' or 'l', +*> the strictly n by n lower triangular part of the array A +*> must contain the lower triangular part of the skew-symmetric +*> matrix and the leading upper triangular part of A is not +*> referenced. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> On entry, LDA specifies the first dimension of A as declared +*> in the calling (sub) program. When SIDE = 'L' or 'l' then +*> LDA must be at least max( 1, m ), otherwise LDA must be at +*> least max( 1, n ). +*> \endverbatim +*> +*> \param[in] B +*> \verbatim +*> B is DOUBLE PRECISION array, dimension ( LDB, N ) +*> Before entry, the leading m by n part of the array B must +*> contain the matrix B. +*> \endverbatim +*> +*> \param[in] LDB +*> \verbatim +*> LDB is INTEGER +*> On entry, LDB specifies the first dimension of B as declared +*> in the calling (sub) program. LDB must be at least +*> max( 1, m ). +*> \endverbatim +*> +*> \param[in] BETA +*> \verbatim +*> BETA is DOUBLE PRECISION. +*> On entry, BETA specifies the scalar beta. When BETA is +*> supplied as zero then C need not be set on input. +*> \endverbatim +*> +*> \param[in,out] C +*> \verbatim +*> C is DOUBLE PRECISION array, dimension ( LDC, N ) +*> Before entry, the leading m by n part of the array C must +*> contain the matrix C, except when beta is zero, in which +*> case C need not be set on entry. +*> On exit, the array C is overwritten by the m by n updated +*> matrix. +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> On entry, LDC specifies the first dimension of C as declared +*> in the calling (sub) program. LDC must be at least +*> max( 1, m ). +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup skewhemm +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> Level 3 Blas routine. +*> Derived from subroutine dsymm. +*> +*> -- Written on 6-Jul-2025. +*> Shuo Zheng, China. +*> \endverbatim +*> +* ===================================================================== + SUBROUTINE DSKEWSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B, + + LDB,BETA,C,LDC) + IMPLICIT NONE +* +* -- Reference BLAS level3 routine -- +* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + DOUBLE PRECISION ALPHA,BETA + INTEGER LDA,LDB,LDC,M,N + CHARACTER SIDE,UPLO +* .. +* .. Array Arguments .. + DOUBLE PRECISION A(LDA,*),B(LDB,*),C(LDC,*) +* .. +* +* ===================================================================== +* +* .. External Functions .. + LOGICAL LSAME + EXTERNAL LSAME +* .. +* .. External Subroutines .. + EXTERNAL XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. +* .. Local Scalars .. + DOUBLE PRECISION TEMP1,TEMP2 + INTEGER I,INFO,J,K,NROWA + LOGICAL UPPER +* .. +* .. Parameters .. + DOUBLE PRECISION ONE,ZERO + PARAMETER (ONE=1.0D+0,ZERO=0.0D+0) +* .. +* +* Set NROWA as the number of rows of A. +* + IF (LSAME(SIDE,'L')) THEN + NROWA = M + ELSE + NROWA = N + END IF + UPPER = LSAME(UPLO,'U') +* +* Test the input parameters. +* + INFO = 0 + IF ((.NOT.LSAME(SIDE,'L')) .AND. + + (.NOT.LSAME(SIDE,'R'))) THEN + INFO = 1 + ELSE IF ((.NOT.UPPER) .AND. + + (.NOT.LSAME(UPLO,'L'))) THEN + INFO = 2 + ELSE IF (M.LT.0) THEN + INFO = 3 + ELSE IF (N.LT.0) THEN + INFO = 4 + ELSE IF (LDA.LT.MAX(1,NROWA)) THEN + INFO = 7 + ELSE IF (LDB.LT.MAX(1,M)) THEN + INFO = 9 + ELSE IF (LDC.LT.MAX(1,M)) THEN + INFO = 12 + END IF + IF (INFO.NE.0) THEN + CALL XERBLA('DSKEWSYMM ',INFO) + RETURN + END IF +* +* Quick return if possible. +* + IF ((M.EQ.0) .OR. (N.EQ.0) .OR. + + ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN +* +* And when alpha.eq.zero. +* + IF (ALPHA.EQ.ZERO) THEN + IF (BETA.EQ.ZERO) THEN + DO 20 J = 1,N + DO 10 I = 1,M + C(I,J) = ZERO + 10 CONTINUE + 20 CONTINUE + ELSE + DO 40 J = 1,N + DO 30 I = 1,M + C(I,J) = BETA*C(I,J) + 30 CONTINUE + 40 CONTINUE + END IF + RETURN + END IF +* +* Start the operations. +* + IF (LSAME(SIDE,'L')) THEN +* +* Form C := alpha*A*B + beta*C. +* + IF (UPPER) THEN + DO 70 J = 1,N + DO 60 I = 1,M + TEMP1 = ALPHA*B(I,J) + TEMP2 = ZERO + DO 50 K = 1,I - 1 + C(K,J) = C(K,J) + TEMP1*A(K,I) + TEMP2 = TEMP2 - B(K,J)*A(K,I) + 50 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP2 + ELSE + C(I,J) = BETA*C(I,J) + + + ALPHA*TEMP2 + END IF + 60 CONTINUE + 70 CONTINUE + ELSE + DO 100 J = 1,N + DO 90 I = M,1,-1 + TEMP1 = ALPHA*B(I,J) + TEMP2 = ZERO + DO 80 K = I + 1,M + C(K,J) = C(K,J) + TEMP1*A(K,I) + TEMP2 = TEMP2 - B(K,J)*A(K,I) + 80 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP2 + ELSE + C(I,J) = BETA*C(I,J) + + + ALPHA*TEMP2 + END IF + 90 CONTINUE + 100 CONTINUE + END IF + ELSE +* +* Form C := alpha*B*A + beta*C. +* + DO 170 J = 1,N + IF (BETA.EQ.ZERO) THEN + DO 110 I = 1,M + C(I,J) = ZERO + 110 CONTINUE + ELSE + DO 120 I = 1,M + C(I,J) = BETA*C(I,J) + 120 CONTINUE + END IF + DO 140 K = 1,J - 1 + IF (UPPER) THEN + TEMP1 = ALPHA*A(K,J) + ELSE + TEMP1 = -ALPHA*A(J,K) + END IF + DO 130 I = 1,M + C(I,J) = C(I,J) + TEMP1*B(I,K) + 130 CONTINUE + 140 CONTINUE + DO 160 K = J + 1,N + IF (UPPER) THEN + TEMP1 = -ALPHA*A(J,K) + ELSE + TEMP1 = ALPHA*A(K,J) + END IF + DO 150 I = 1,M + C(I,J) = C(I,J) + TEMP1*B(I,K) + 150 CONTINUE + 160 CONTINUE + 170 CONTINUE + END IF +* + RETURN +* +* End of DSKEWSYMM +* + END diff --git a/BLAS/SRC/dskewsymv.f b/BLAS/SRC/dskewsymv.f new file mode 100644 index 0000000000..2e9cf92f74 --- /dev/null +++ b/BLAS/SRC/dskewsymv.f @@ -0,0 +1,327 @@ +*> \brief \b DSKEWSYMV +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE DSKEWSYMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) +* +* .. Scalar Arguments .. +* DOUBLE PRECISION ALPHA,BETA +* INTEGER INCX,INCY,LDA,N +* CHARACTER UPLO +* .. +* .. Array Arguments .. +* DOUBLE PRECISION A(LDA,*),X(*),Y(*) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> DSKEWSYMV performs the matrix-vector operation +*> +*> y := alpha*A*x + beta*y, +*> +*> where alpha and beta are scalars, x and y are n element vectors and +*> A is an n by n skew-symmetric matrix. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] UPLO +*> \verbatim +*> UPLO is CHARACTER*1 +*> On entry, UPLO specifies whether the upper or lower +*> triangular part of the array A is to be referenced as +*> follows: +*> +*> UPLO = 'U' or 'u' Only the upper triangular part of A +*> is to be referenced. +*> +*> UPLO = 'L' or 'l' Only the lower triangular part of A +*> is to be referenced. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> On entry, N specifies the order of the matrix A. +*> N must be at least zero. +*> \endverbatim +*> +*> \param[in] ALPHA +*> \verbatim +*> ALPHA is DOUBLE PRECISION +*> On entry, ALPHA specifies the scalar alpha. +*> \endverbatim +*> +*> \param[in] A +*> \verbatim +*> A is DOUBLE PRECISION array, dimension ( LDA, N ) +*> Before entry with UPLO = 'U' or 'u', the strictly n by n +*> upper triangular part of the array A must contain the upper +*> triangular part of the skew-symmetric matrix and the leading +*> lower triangular part of A is not referenced. +*> Before entry with UPLO = 'L' or 'l', the strictly n by n +*> lower triangular part of the array A must contain the lower +*> triangular part of the skew-symmetric matrix and the leading +*> upper triangular part of A is not referenced. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> On entry, LDA specifies the first dimension of A as declared +*> in the calling (sub) program. LDA must be at least +*> max( 1, n ). +*> \endverbatim +*> +*> \param[in] X +*> \verbatim +*> X is DOUBLE PRECISION array, dimension at least +*> ( 1 + ( n - 1 )*abs( INCX ) ). +*> Before entry, the incremented array X must contain the n +*> element vector x. +*> \endverbatim +*> +*> \param[in] INCX +*> \verbatim +*> INCX is INTEGER +*> On entry, INCX specifies the increment for the elements of +*> X. INCX must not be zero. +*> \endverbatim +*> +*> \param[in] BETA +*> \verbatim +*> BETA is DOUBLE PRECISION. +*> On entry, BETA specifies the scalar beta. When BETA is +*> supplied as zero then Y need not be set on input. +*> \endverbatim +*> +*> \param[in,out] Y +*> \verbatim +*> Y is DOUBLE PRECISION array, dimension at least +*> ( 1 + ( n - 1 )*abs( INCY ) ). +*> Before entry, the incremented array Y must contain the n +*> element vector y. On exit, Y is overwritten by the updated +*> vector y. +*> \endverbatim +*> +*> \param[in] INCY +*> \verbatim +*> INCY is INTEGER +*> On entry, INCY specifies the increment for the elements of +*> Y. INCY must not be zero. +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup skewhemv +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> Level 2 Blas routine. +*> The vector and matrix arguments are not referenced when N = 0, or M = 0 +*> Derived from subroutine dsymv. +*> +*> -- Written on 6-Jul-2025. +*> Shuo Zheng, China. +*> \endverbatim +*> +* ===================================================================== + SUBROUTINE DSKEWSYMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) + IMPLICIT NONE +* +* -- Reference BLAS level2 routine -- +* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + DOUBLE PRECISION ALPHA,BETA + INTEGER INCX,INCY,LDA,N + CHARACTER UPLO +* .. +* .. Array Arguments .. + DOUBLE PRECISION A(LDA,*),X(*),Y(*) +* .. +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ONE,ZERO + PARAMETER (ONE=1.0D+0,ZERO=0.0D+0) +* .. +* .. Local Scalars .. + DOUBLE PRECISION TEMP1,TEMP2 + INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY +* .. +* .. External Functions .. + LOGICAL LSAME + EXTERNAL LSAME +* .. +* .. External Subroutines .. + EXTERNAL XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. +* +* Test the input parameters. +* + INFO = 0 + IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN + INFO = 1 + ELSE IF (N.LT.0) THEN + INFO = 2 + ELSE IF (LDA.LT.MAX(1,N)) THEN + INFO = 5 + ELSE IF (INCX.EQ.0) THEN + INFO = 7 + ELSE IF (INCY.EQ.0) THEN + INFO = 10 + END IF + IF (INFO.NE.0) THEN + CALL XERBLA('DSKEWSYMV ',INFO) + RETURN + END IF +* +* Quick return if possible. +* + IF ((N.EQ.0) .OR. ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN +* +* Set up the start points in X and Y. +* + IF (INCX.GT.0) THEN + KX = 1 + ELSE + KX = 1 - (N-1)*INCX + END IF + IF (INCY.GT.0) THEN + KY = 1 + ELSE + KY = 1 - (N-1)*INCY + END IF +* +* Start the operations. In this version the elements of A are +* accessed sequentially with one pass through the triangular part +* of A. +* +* First form y := beta*y. +* + IF (BETA.NE.ONE) THEN + IF (INCY.EQ.1) THEN + IF (BETA.EQ.ZERO) THEN + DO 10 I = 1,N + Y(I) = ZERO + 10 CONTINUE + ELSE + DO 20 I = 1,N + Y(I) = BETA*Y(I) + 20 CONTINUE + END IF + ELSE + IY = KY + IF (BETA.EQ.ZERO) THEN + DO 30 I = 1,N + Y(IY) = ZERO + IY = IY + INCY + 30 CONTINUE + ELSE + DO 40 I = 1,N + Y(IY) = BETA*Y(IY) + IY = IY + INCY + 40 CONTINUE + END IF + END IF + END IF + IF (ALPHA.EQ.ZERO) RETURN + IF (LSAME(UPLO,'U')) THEN +* +* Form y when A is stored in upper triangle. +* + IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN + DO 60 J = 1,N + TEMP1 = ALPHA*X(J) + TEMP2 = ZERO + DO 50 I = 1,J - 1 + Y(I) = Y(I) + TEMP1*A(I,J) + TEMP2 = TEMP2 - A(I,J)*X(I) + 50 CONTINUE + Y(J) = Y(J) + ALPHA*TEMP2 + 60 CONTINUE + ELSE + JX = KX + JY = KY + DO 80 J = 1,N + TEMP1 = ALPHA*X(JX) + TEMP2 = ZERO + IX = KX + IY = KY + DO 70 I = 1,J - 1 + Y(IY) = Y(IY) + TEMP1*A(I,J) + TEMP2 = TEMP2 - A(I,J)*X(IX) + IX = IX + INCX + IY = IY + INCY + 70 CONTINUE + Y(JY) = Y(JY) + ALPHA*TEMP2 + JX = JX + INCX + JY = JY + INCY + 80 CONTINUE + END IF + ELSE +* +* Form y when A is stored in lower triangle. +* + IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN + DO 100 J = 1,N + TEMP1 = ALPHA*X(J) + TEMP2 = ZERO + DO 90 I = J + 1,N + Y(I) = Y(I) + TEMP1*A(I,J) + TEMP2 = TEMP2 - A(I,J)*X(I) + 90 CONTINUE + Y(J) = Y(J) + ALPHA*TEMP2 + 100 CONTINUE + ELSE + JX = KX + JY = KY + DO 120 J = 1,N + TEMP1 = ALPHA*X(JX) + TEMP2 = ZERO + IX = JX + IY = JY + DO 110 I = J + 1,N + IX = IX + INCX + IY = IY + INCY + Y(IY) = Y(IY) + TEMP1*A(I,J) + TEMP2 = TEMP2 - A(I,J)*X(IX) + 110 CONTINUE + Y(JY) = Y(JY) + ALPHA*TEMP2 + JX = JX + INCX + JY = JY + INCY + 120 CONTINUE + END IF + END IF +* + RETURN +* +* End of DSKEWSYMV +* + END diff --git a/BLAS/SRC/dskewsyr2.f b/BLAS/SRC/dskewsyr2.f new file mode 100644 index 0000000000..b555fac7a0 --- /dev/null +++ b/BLAS/SRC/dskewsyr2.f @@ -0,0 +1,294 @@ +*> \brief \b DSKEWSYR2 +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE DSKEWSYR2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA) +* +* .. Scalar Arguments .. +* DOUBLE PRECISION ALPHA +* INTEGER INCX,INCY,LDA,N +* CHARACTER UPLO +* .. +* .. Array Arguments .. +* DOUBLE PRECISION A(LDA,*),X(*),Y(*) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> DSKEWSYR2 performs the skew-symmetric rank 2 operation +*> +*> A := -alpha*x*y**T + alpha*y*x**T + A, +*> +*> where alpha is a scalar, x and y are n element vectors and A is an n +*> by n skew-symmetric matrix. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] UPLO +*> \verbatim +*> UPLO is CHARACTER*1 +*> On entry, UPLO specifies whether the upper or lower +*> triangular part of the array A is to be referenced as +*> follows: +*> +*> UPLO = 'U' or 'u' Only the upper triangular part of A +*> is to be referenced. +*> +*> UPLO = 'L' or 'l' Only the lower triangular part of A +*> is to be referenced. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> On entry, N specifies the order of the matrix A. +*> N must be at least zero. +*> \endverbatim +*> +*> \param[in] ALPHA +*> \verbatim +*> ALPHA is DOUBLE PRECISION +*> On entry, ALPHA specifies the scalar alpha. +*> \endverbatim +*> +*> \param[in] X +*> \verbatim +*> X is DOUBLE PRECISION array, dimension at least +*> ( 1 + ( n - 1 )*abs( INCX ) ). +*> Before entry, the incremented array X must contain the n +*> element vector x. +*> \endverbatim +*> +*> \param[in] INCX +*> \verbatim +*> INCX is INTEGER +*> On entry, INCX specifies the increment for the elements of +*> X. INCX must not be zero. +*> \endverbatim +*> +*> \param[in] Y +*> \verbatim +*> Y is DOUBLE PRECISION array, dimension at least +*> ( 1 + ( n - 1 )*abs( INCY ) ). +*> Before entry, the incremented array Y must contain the n +*> element vector y. +*> \endverbatim +*> +*> \param[in] INCY +*> \verbatim +*> INCY is INTEGER +*> On entry, INCY specifies the increment for the elements of +*> Y. INCY must not be zero. +*> \endverbatim +*> +*> \param[in,out] A +*> \verbatim +*> A is DOUBLE PRECISION array, dimension ( LDA, N ) +*> Before entry with UPLO = 'U' or 'u', the strictly n by n +*> upper triangular part of the array A must contain the upper +*> triangular part of the skew-symmetric matrix and the leading +*> lower triangular part of A is not referenced. On exit, the +*> upper triangular part of the array A is overwritten by the +*> upper triangular part of the updated matrix. +*> Before entry with UPLO = 'L' or 'l', the strictly n by n +*> lower triangular part of the array A must contain the lower +*> triangular part of the skew-symmetric matrix and the leading +*> upper triangular part of A is not referenced. On exit, the +*> lower triangular part of the array A is overwritten by the +*> lower triangular part of the updated matrix. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> On entry, LDA specifies the first dimension of A as declared +*> in the calling (sub) program. LDA must be at least +*> max( 1, n ). +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup skewher2 +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> Level 2 Blas routine. +*> Derived from subroutine dsyr2. +*> +*> -- Written on 6-Jul-2025. +*> Shuo Zheng, China. +*> \endverbatim +*> +* ===================================================================== + SUBROUTINE DSKEWSYR2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA) + IMPLICIT NONE +* +* -- Reference BLAS level2 routine -- +* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + DOUBLE PRECISION ALPHA + INTEGER INCX,INCY,LDA,N + CHARACTER UPLO +* .. +* .. Array Arguments .. + DOUBLE PRECISION A(LDA,*),X(*),Y(*) +* .. +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ZERO + PARAMETER (ZERO=0.0D+0) +* .. +* .. Local Scalars .. + DOUBLE PRECISION TEMP1,TEMP2 + INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY +* .. +* .. External Functions .. + LOGICAL LSAME + EXTERNAL LSAME +* .. +* .. External Subroutines .. + EXTERNAL XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. +* +* Test the input parameters. +* + INFO = 0 + IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN + INFO = 1 + ELSE IF (N.LT.0) THEN + INFO = 2 + ELSE IF (INCX.EQ.0) THEN + INFO = 5 + ELSE IF (INCY.EQ.0) THEN + INFO = 7 + ELSE IF (LDA.LT.MAX(1,N)) THEN + INFO = 9 + END IF + IF (INFO.NE.0) THEN + CALL XERBLA('DSKEWSYR2 ',INFO) + RETURN + END IF +* +* Quick return if possible. +* + IF ((N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN +* +* Set up the start points in X and Y if the increments are not both +* unity. +* + IF ((INCX.NE.1) .OR. (INCY.NE.1)) THEN + IF (INCX.GT.0) THEN + KX = 1 + ELSE + KX = 1 - (N-1)*INCX + END IF + IF (INCY.GT.0) THEN + KY = 1 + ELSE + KY = 1 - (N-1)*INCY + END IF + JX = KX + JY = KY + END IF +* +* Start the operations. In this version the elements of A are +* accessed sequentially with one pass through the triangular part +* of A. +* + IF (LSAME(UPLO,'U')) THEN +* +* Form A when A is stored in the upper triangle. +* + IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN + DO 20 J = 1,N + IF ((X(J).NE.ZERO) .OR. (Y(J).NE.ZERO)) THEN + TEMP1 = ALPHA*Y(J) + TEMP2 = ALPHA*X(J) + DO 10 I = 1,J-1 + A(I,J) = A(I,J) - X(I)*TEMP1 + Y(I)*TEMP2 + 10 CONTINUE + END IF + 20 CONTINUE + ELSE + DO 40 J = 1,N + IF ((X(JX).NE.ZERO) .OR. (Y(JY).NE.ZERO)) THEN + TEMP1 = ALPHA*Y(JY) + TEMP2 = ALPHA*X(JX) + IX = KX + IY = KY + DO 30 I = 1,J-1 + A(I,J) = A(I,J) - X(IX)*TEMP1 + Y(IY)*TEMP2 + IX = IX + INCX + IY = IY + INCY + 30 CONTINUE + END IF + JX = JX + INCX + JY = JY + INCY + 40 CONTINUE + END IF + ELSE +* +* Form A when A is stored in the lower triangle. +* + IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN + DO 60 J = 1,N + IF ((X(J).NE.ZERO) .OR. (Y(J).NE.ZERO)) THEN + TEMP1 = ALPHA*Y(J) + TEMP2 = ALPHA*X(J) + DO 50 I = J+1,N + A(I,J) = A(I,J) - X(I)*TEMP1 + Y(I)*TEMP2 + 50 CONTINUE + END IF + 60 CONTINUE + ELSE + DO 80 J = 1,N + IF ((X(JX).NE.ZERO) .OR. (Y(JY).NE.ZERO)) THEN + TEMP1 = ALPHA*Y(JY) + TEMP2 = ALPHA*X(JX) + IX = JX + INCX + IY = JY + INCY + DO 70 I = J+1,N + A(I,J) = A(I,J) - X(IX)*TEMP1 + Y(IY)*TEMP2 + IX = IX + INCX + IY = IY + INCY + 70 CONTINUE + END IF + JX = JX + INCX + JY = JY + INCY + 80 CONTINUE + END IF + END IF +* + RETURN +* +* End of DSKEWSYR2 +* + END diff --git a/BLAS/SRC/dskewsyr2k.f b/BLAS/SRC/dskewsyr2k.f new file mode 100644 index 0000000000..286c1bdd84 --- /dev/null +++ b/BLAS/SRC/dskewsyr2k.f @@ -0,0 +1,395 @@ +*> \brief \b DSKEWSYR2K +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE DSKEWSYR2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) +* +* .. Scalar Arguments .. +* DOUBLE PRECISION ALPHA,BETA +* INTEGER K,LDA,LDB,LDC,N +* CHARACTER TRANS,UPLO +* .. +* .. Array Arguments .. +* DOUBLE PRECISION A(LDA,*),B(LDB,*),C(LDC,*) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> DSKEWSYR2K performs one of the skew-symmetric rank 2k operations +*> +*> C := -alpha*A*B**T + alpha*B*A**T + beta*C, +*> +*> or +*> +*> C := -alpha*A**T*B + alpha*B**T*A + beta*C, +*> +*> where alpha and beta are scalars, C is an n by n skew-symmetric matrix +*> and A and B are n by k matrices in the first case and k by n +*> matrices in the second case. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] UPLO +*> \verbatim +*> UPLO is CHARACTER*1 +*> On entry, UPLO specifies whether the upper or lower +*> triangular part of the array C is to be referenced as +*> follows: +*> +*> UPLO = 'U' or 'u' Only the upper triangular part of C +*> is to be referenced. +*> +*> UPLO = 'L' or 'l' Only the lower triangular part of C +*> is to be referenced. +*> \endverbatim +*> +*> \param[in] TRANS +*> \verbatim +*> TRANS is CHARACTER*1 +*> On entry, TRANS specifies the operation to be performed as +*> follows: +*> +*> TRANS = 'N' or 'n' C := -alpha*A*B**T + alpha*B*A**T + +*> beta*C. +*> +*> TRANS = 'T' or 't' C := -alpha*A**T*B + alpha*B**T*A + +*> beta*C. +*> +*> TRANS = 'C' or 'c' C := -alpha*A**T*B + alpha*B**T*A + +*> beta*C. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> On entry, N specifies the order of the matrix C. N must be +*> at least zero. +*> \endverbatim +*> +*> \param[in] K +*> \verbatim +*> K is INTEGER +*> On entry with TRANS = 'N' or 'n', K specifies the number +*> of columns of the matrices A and B, and on entry with +*> TRANS = 'T' or 't' or 'C' or 'c', K specifies the number +*> of rows of the matrices A and B. K must be at least zero. +*> \endverbatim +*> +*> \param[in] ALPHA +*> \verbatim +*> ALPHA is DOUBLE PRECISION. +*> On entry, ALPHA specifies the scalar alpha. +*> \endverbatim +*> +*> \param[in] A +*> \verbatim +*> A is DOUBLE PRECISION array, dimension ( LDA, ka ), where ka is +*> k when TRANS = 'N' or 'n', and is n otherwise. +*> Before entry with TRANS = 'N' or 'n', the leading n by k +*> part of the array A must contain the matrix A, otherwise +*> the leading k by n part of the array A must contain the +*> matrix A. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> On entry, LDA specifies the first dimension of A as declared +*> in the calling (sub) program. When TRANS = 'N' or 'n' +*> then LDA must be at least max( 1, n ), otherwise LDA must +*> be at least max( 1, k ). +*> \endverbatim +*> +*> \param[in] B +*> \verbatim +*> B is DOUBLE PRECISION array, dimension ( LDB, kb ), where kb is +*> k when TRANS = 'N' or 'n', and is n otherwise. +*> Before entry with TRANS = 'N' or 'n', the leading n by k +*> part of the array B must contain the matrix B, otherwise +*> the leading k by n part of the array B must contain the +*> matrix B. +*> \endverbatim +*> +*> \param[in] LDB +*> \verbatim +*> LDB is INTEGER +*> On entry, LDB specifies the first dimension of B as declared +*> in the calling (sub) program. When TRANS = 'N' or 'n' +*> then LDB must be at least max( 1, n ), otherwise LDB must +*> be at least max( 1, k ). +*> \endverbatim +*> +*> \param[in] BETA +*> \verbatim +*> BETA is DOUBLE PRECISION. +*> On entry, BETA specifies the scalar beta. +*> \endverbatim +*> +*> \param[in,out] C +*> \verbatim +*> C is DOUBLE PRECISION array, dimension ( LDC, N ) +*> Before entry with UPLO = 'U' or 'u', the strictly n by n +*> upper triangular part of the array C must contain the upper +*> triangular part of the skew-symmetric matrix and the leading +*> lower triangular part of C is not referenced. On exit, the +*> upper triangular part of the array C is overwritten by the +*> upper triangular part of the updated matrix. +*> Before entry with UPLO = 'L' or 'l', the strictly n by n +*> lower triangular part of the array C must contain the lower +*> triangular part of the skew-symmetric matrix and the leading +*> upper triangular part of C is not referenced. On exit, the +*> lower triangular part of the array C is overwritten by the +*> lower triangular part of the updated matrix. +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> On entry, LDC specifies the first dimension of C as declared +*> in the calling (sub) program. LDC must be at least +*> max( 1, n ). +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup skewher2k +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> Level 3 Blas routine. +*> Derived from subroutine dsyr2k. +*> +*> -- Written on 6-Jul-2025. +*> Shuo Zheng, China. +*> \endverbatim +*> +* ===================================================================== + SUBROUTINE DSKEWSYR2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B, + + LDB,BETA,C,LDC) + IMPLICIT NONE +* +* -- Reference BLAS level3 routine -- +* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + DOUBLE PRECISION ALPHA,BETA + INTEGER K,LDA,LDB,LDC,N + CHARACTER TRANS,UPLO +* .. +* .. Array Arguments .. + DOUBLE PRECISION A(LDA,*),B(LDB,*),C(LDC,*) +* .. +* +* ===================================================================== +* +* .. External Functions .. + LOGICAL LSAME + EXTERNAL LSAME +* .. +* .. External Subroutines .. + EXTERNAL XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. +* .. Local Scalars .. + DOUBLE PRECISION TEMP1,TEMP2 + INTEGER I,INFO,J,L,NROWA + LOGICAL UPPER +* .. +* .. Parameters .. + DOUBLE PRECISION ONE,ZERO + PARAMETER (ONE=1.0D+0,ZERO=0.0D+0) +* .. +* +* Test the input parameters. +* + IF (LSAME(TRANS,'N')) THEN + NROWA = N + ELSE + NROWA = K + END IF + UPPER = LSAME(UPLO,'U') +* + INFO = 0 + IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN + INFO = 1 + ELSE IF ((.NOT.LSAME(TRANS,'N')) .AND. + + (.NOT.LSAME(TRANS,'T')) .AND. + + (.NOT.LSAME(TRANS,'C'))) THEN + INFO = 2 + ELSE IF (N.LT.0) THEN + INFO = 3 + ELSE IF (K.LT.0) THEN + INFO = 4 + ELSE IF (LDA.LT.MAX(1,NROWA)) THEN + INFO = 7 + ELSE IF (LDB.LT.MAX(1,NROWA)) THEN + INFO = 9 + ELSE IF (LDC.LT.MAX(1,N)) THEN + INFO = 12 + END IF + IF (INFO.NE.0) THEN + CALL XERBLA('DSKEWSYR2K',INFO) + RETURN + END IF +* +* Quick return if possible. +* + IF ((N.EQ.0) .OR. (((ALPHA.EQ.ZERO).OR. + + (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN +* +* And when alpha.eq.zero. +* + IF (ALPHA.EQ.ZERO) THEN + IF (UPPER) THEN + IF (BETA.EQ.ZERO) THEN + DO 20 J = 1,N + DO 10 I = 1,J-1 + C(I,J) = ZERO + 10 CONTINUE + 20 CONTINUE + ELSE + DO 40 J = 1,N + DO 30 I = 1,J-1 + C(I,J) = BETA*C(I,J) + 30 CONTINUE + 40 CONTINUE + END IF + ELSE + IF (BETA.EQ.ZERO) THEN + DO 60 J = 1,N + DO 50 I = J+1,N + C(I,J) = ZERO + 50 CONTINUE + 60 CONTINUE + ELSE + DO 80 J = 1,N + DO 70 I = J+1,N + C(I,J) = BETA*C(I,J) + 70 CONTINUE + 80 CONTINUE + END IF + END IF + RETURN + END IF +* +* Start the operations. +* + IF (LSAME(TRANS,'N')) THEN +* +* Form C := alpha*A*B**T + alpha*B*A**T + C. +* + IF (UPPER) THEN + DO 130 J = 1,N + IF (BETA.EQ.ZERO) THEN + DO 90 I = 1,J-1 + C(I,J) = ZERO + 90 CONTINUE + ELSE IF (BETA.NE.ONE) THEN + DO 100 I = 1,J-1 + C(I,J) = BETA*C(I,J) + 100 CONTINUE + END IF + DO 120 L = 1,K + IF ((A(J,L).NE.ZERO) .OR. (B(J,L).NE.ZERO)) THEN + TEMP1 = ALPHA*B(J,L) + TEMP2 = ALPHA*A(J,L) + DO 110 I = 1,J-1 + C(I,J) = C(I,J) - A(I,L)*TEMP1 + + + B(I,L)*TEMP2 + 110 CONTINUE + END IF + 120 CONTINUE + 130 CONTINUE + ELSE + DO 180 J = 1,N + IF (BETA.EQ.ZERO) THEN + DO 140 I = J+1,N + C(I,J) = ZERO + 140 CONTINUE + ELSE IF (BETA.NE.ONE) THEN + DO 150 I = J+1,N + C(I,J) = BETA*C(I,J) + 150 CONTINUE + END IF + DO 170 L = 1,K + IF ((A(J,L).NE.ZERO) .OR. (B(J,L).NE.ZERO)) THEN + TEMP1 = ALPHA*B(J,L) + TEMP2 = ALPHA*A(J,L) + DO 160 I = J+1,N + C(I,J) = C(I,J) - A(I,L)*TEMP1 + + + B(I,L)*TEMP2 + 160 CONTINUE + END IF + 170 CONTINUE + 180 CONTINUE + END IF + ELSE +* +* Form C := alpha*A**T*B + alpha*B**T*A + C. +* + IF (UPPER) THEN + DO 210 J = 1,N + DO 200 I = 1,J-1 + TEMP1 = ZERO + TEMP2 = ZERO + DO 190 L = 1,K + TEMP1 = TEMP1 + A(L,I)*B(L,J) + TEMP2 = TEMP2 + B(L,I)*A(L,J) + 190 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = -ALPHA*TEMP1 + ALPHA*TEMP2 + ELSE + C(I,J) = BETA*C(I,J) - ALPHA*TEMP1 + + + ALPHA*TEMP2 + END IF + 200 CONTINUE + 210 CONTINUE + ELSE + DO 240 J = 1,N + DO 230 I = J+1,N + TEMP1 = ZERO + TEMP2 = ZERO + DO 220 L = 1,K + TEMP1 = TEMP1 + A(L,I)*B(L,J) + TEMP2 = TEMP2 + B(L,I)*A(L,J) + 220 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = -ALPHA*TEMP1 + ALPHA*TEMP2 + ELSE + C(I,J) = BETA*C(I,J) - ALPHA*TEMP1 + + + ALPHA*TEMP2 + END IF + 230 CONTINUE + 240 CONTINUE + END IF + END IF +* + RETURN +* +* End of DSKEWSYR2K +* + END diff --git a/BLAS/SRC/dspmv.f b/BLAS/SRC/dspmv.f index 6e26c0f4f8..42331e9f9a 100644 --- a/BLAS/SRC/dspmv.f +++ b/BLAS/SRC/dspmv.f @@ -125,9 +125,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level2 +*> \ingroup hpmv * *> \par Further Details: * ===================== @@ -146,11 +144,11 @@ *> * ===================================================================== SUBROUTINE DSPMV(UPLO,N,ALPHA,AP,X,INCX,BETA,Y,INCY) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA,BETA @@ -326,6 +324,6 @@ SUBROUTINE DSPMV(UPLO,N,ALPHA,AP,X,INCX,BETA,Y,INCY) * RETURN * -* End of DSPMV . +* End of DSPMV * END diff --git a/BLAS/SRC/dspr.f b/BLAS/SRC/dspr.f index f9d709e2d9..50a164697d 100644 --- a/BLAS/SRC/dspr.f +++ b/BLAS/SRC/dspr.f @@ -106,9 +106,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level2 +*> \ingroup hpr * *> \par Further Details: * ===================== @@ -126,11 +124,11 @@ *> * ===================================================================== SUBROUTINE DSPR(UPLO,N,ALPHA,X,INCX,AP) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA @@ -256,6 +254,6 @@ SUBROUTINE DSPR(UPLO,N,ALPHA,X,INCX,AP) * RETURN * -* End of DSPR . +* End of DSPR * END diff --git a/BLAS/SRC/dspr2.f b/BLAS/SRC/dspr2.f index 175d8e84c5..a946802504 100644 --- a/BLAS/SRC/dspr2.f +++ b/BLAS/SRC/dspr2.f @@ -121,9 +121,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level2 +*> \ingroup hpr2 * *> \par Further Details: * ===================== @@ -141,11 +139,11 @@ *> * ===================================================================== SUBROUTINE DSPR2(UPLO,N,ALPHA,X,INCX,Y,INCY,AP) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA @@ -291,6 +289,6 @@ SUBROUTINE DSPR2(UPLO,N,ALPHA,X,INCX,Y,INCY,AP) * RETURN * -* End of DSPR2 . +* End of DSPR2 * END diff --git a/BLAS/SRC/dswap.f b/BLAS/SRC/dswap.f index 94dfea3bb9..720f944a25 100644 --- a/BLAS/SRC/dswap.f +++ b/BLAS/SRC/dswap.f @@ -66,9 +66,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level1 +*> \ingroup swap * *> \par Further Details: * ===================== @@ -81,11 +79,11 @@ *> * ===================================================================== SUBROUTINE DSWAP(N,DX,INCX,DY,INCY) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,INCY,N @@ -150,4 +148,7 @@ SUBROUTINE DSWAP(N,DX,INCX,DY,INCY) END DO END IF RETURN +* +* End of DSWAP +* END diff --git a/BLAS/SRC/dsymm.f b/BLAS/SRC/dsymm.f index 622d2469f1..7bb289c868 100644 --- a/BLAS/SRC/dsymm.f +++ b/BLAS/SRC/dsymm.f @@ -168,9 +168,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level3 +*> \ingroup hemm * *> \par Further Details: * ===================== @@ -188,11 +186,11 @@ *> * ===================================================================== SUBROUTINE DSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC) + IMPLICIT NONE * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA,BETA @@ -237,7 +235,8 @@ SUBROUTINE DSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * Test the input parameters. * INFO = 0 - IF ((.NOT.LSAME(SIDE,'L')) .AND. (.NOT.LSAME(SIDE,'R'))) THEN + IF ((.NOT.LSAME(SIDE,'L')) .AND. + + (.NOT.LSAME(SIDE,'R'))) THEN INFO = 1 ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN INFO = 2 @@ -362,6 +361,6 @@ SUBROUTINE DSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * RETURN * -* End of DSYMM . +* End of DSYMM * END diff --git a/BLAS/SRC/dsymv.f b/BLAS/SRC/dsymv.f index 4bf973f10a..bfead2aedb 100644 --- a/BLAS/SRC/dsymv.f +++ b/BLAS/SRC/dsymv.f @@ -130,9 +130,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level2 +*> \ingroup hemv * *> \par Further Details: * ===================== @@ -151,11 +149,11 @@ *> * ===================================================================== SUBROUTINE DSYMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA,BETA @@ -328,6 +326,6 @@ SUBROUTINE DSYMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) * RETURN * -* End of DSYMV . +* End of DSYMV * END diff --git a/BLAS/SRC/dsyr.f b/BLAS/SRC/dsyr.f index 7fe256fa56..9d89db9643 100644 --- a/BLAS/SRC/dsyr.f +++ b/BLAS/SRC/dsyr.f @@ -111,9 +111,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level2 +*> \ingroup her * *> \par Further Details: * ===================== @@ -131,11 +129,11 @@ *> * ===================================================================== SUBROUTINE DSYR(UPLO,N,ALPHA,X,INCX,A,LDA) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA @@ -258,6 +256,6 @@ SUBROUTINE DSYR(UPLO,N,ALPHA,X,INCX,A,LDA) * RETURN * -* End of DSYR . +* End of DSYR * END diff --git a/BLAS/SRC/dsyr2.f b/BLAS/SRC/dsyr2.f index 8970c4dcfd..3eab4fd6a1 100644 --- a/BLAS/SRC/dsyr2.f +++ b/BLAS/SRC/dsyr2.f @@ -126,9 +126,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level2 +*> \ingroup her2 * *> \par Further Details: * ===================== @@ -146,11 +144,11 @@ *> * ===================================================================== SUBROUTINE DSYR2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA @@ -293,6 +291,6 @@ SUBROUTINE DSYR2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA) * RETURN * -* End of DSYR2 . +* End of DSYR2 * END diff --git a/BLAS/SRC/dsyr2k.f b/BLAS/SRC/dsyr2k.f index f3a5940c7f..2e1a48984a 100644 --- a/BLAS/SRC/dsyr2k.f +++ b/BLAS/SRC/dsyr2k.f @@ -170,9 +170,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level3 +*> \ingroup her2k * *> \par Further Details: * ===================== @@ -191,11 +189,11 @@ *> * ===================================================================== SUBROUTINE DSYR2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) + IMPLICIT NONE * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA,BETA @@ -394,6 +392,6 @@ SUBROUTINE DSYR2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * RETURN * -* End of DSYR2K. +* End of DSYR2K * END diff --git a/BLAS/SRC/dsyrk.f b/BLAS/SRC/dsyrk.f index 4be4d8d3c4..c6ca791e14 100644 --- a/BLAS/SRC/dsyrk.f +++ b/BLAS/SRC/dsyrk.f @@ -148,9 +148,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level3 +*> \ingroup herk * *> \par Further Details: * ===================== @@ -168,11 +166,11 @@ *> * ===================================================================== SUBROUTINE DSYRK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC) + IMPLICIT NONE * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA,BETA @@ -359,6 +357,6 @@ SUBROUTINE DSYRK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC) * RETURN * -* End of DSYRK . +* End of DSYRK * END diff --git a/BLAS/SRC/dtbmv.f b/BLAS/SRC/dtbmv.f index e27d50f2c2..3598228912 100644 --- a/BLAS/SRC/dtbmv.f +++ b/BLAS/SRC/dtbmv.f @@ -164,9 +164,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level2 +*> \ingroup tbmv * *> \par Further Details: * ===================== @@ -185,11 +183,11 @@ *> * ===================================================================== SUBROUTINE DTBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,K,LDA,N @@ -200,10 +198,6 @@ SUBROUTINE DTBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) * .. * * ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO - PARAMETER (ZERO=0.0D+0) * .. * .. Local Scalars .. DOUBLE PRECISION TEMP @@ -226,10 +220,12 @@ SUBROUTINE DTBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) INFO = 0 IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN INFO = 1 - ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND. + ELSE IF (.NOT.LSAME(TRANS,'N') .AND. + + .NOT.LSAME(TRANS,'T') .AND. + .NOT.LSAME(TRANS,'C')) THEN INFO = 2 - ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN + ELSE IF (.NOT.LSAME(DIAG,'U') .AND. + + .NOT.LSAME(DIAG,'N')) THEN INFO = 3 ELSE IF (N.LT.0) THEN INFO = 4 @@ -271,28 +267,24 @@ SUBROUTINE DTBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) KPLUS1 = K + 1 IF (INCX.EQ.1) THEN DO 20 J = 1,N - IF (X(J).NE.ZERO) THEN - TEMP = X(J) - L = KPLUS1 - J - DO 10 I = MAX(1,J-K),J - 1 - X(I) = X(I) + TEMP*A(L+I,J) - 10 CONTINUE - IF (NOUNIT) X(J) = X(J)*A(KPLUS1,J) - END IF + TEMP = X(J) + L = KPLUS1 - J + DO 10 I = MAX(1,J-K),J - 1 + X(I) = X(I) + TEMP*A(L+I,J) + 10 CONTINUE + IF (NOUNIT) X(J) = X(J)*A(KPLUS1,J) 20 CONTINUE ELSE JX = KX DO 40 J = 1,N - IF (X(JX).NE.ZERO) THEN - TEMP = X(JX) - IX = KX - L = KPLUS1 - J - DO 30 I = MAX(1,J-K),J - 1 - X(IX) = X(IX) + TEMP*A(L+I,J) - IX = IX + INCX - 30 CONTINUE - IF (NOUNIT) X(JX) = X(JX)*A(KPLUS1,J) - END IF + TEMP = X(JX) + IX = KX + L = KPLUS1 - J + DO 30 I = MAX(1,J-K),J - 1 + X(IX) = X(IX) + TEMP*A(L+I,J) + IX = IX + INCX + 30 CONTINUE + IF (NOUNIT) X(JX) = X(JX)*A(KPLUS1,J) JX = JX + INCX IF (J.GT.K) KX = KX + INCX 40 CONTINUE @@ -300,29 +292,25 @@ SUBROUTINE DTBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) ELSE IF (INCX.EQ.1) THEN DO 60 J = N,1,-1 - IF (X(J).NE.ZERO) THEN - TEMP = X(J) - L = 1 - J - DO 50 I = MIN(N,J+K),J + 1,-1 - X(I) = X(I) + TEMP*A(L+I,J) - 50 CONTINUE - IF (NOUNIT) X(J) = X(J)*A(1,J) - END IF + TEMP = X(J) + L = 1 - J + DO 50 I = MIN(N,J+K),J + 1,-1 + X(I) = X(I) + TEMP*A(L+I,J) + 50 CONTINUE + IF (NOUNIT) X(J) = X(J)*A(1,J) 60 CONTINUE ELSE KX = KX + (N-1)*INCX JX = KX DO 80 J = N,1,-1 - IF (X(JX).NE.ZERO) THEN - TEMP = X(JX) - IX = KX - L = 1 - J - DO 70 I = MIN(N,J+K),J + 1,-1 - X(IX) = X(IX) + TEMP*A(L+I,J) - IX = IX - INCX - 70 CONTINUE - IF (NOUNIT) X(JX) = X(JX)*A(1,J) - END IF + TEMP = X(JX) + IX = KX + L = 1 - J + DO 70 I = MIN(N,J+K),J + 1,-1 + X(IX) = X(IX) + TEMP*A(L+I,J) + IX = IX - INCX + 70 CONTINUE + IF (NOUNIT) X(JX) = X(JX)*A(1,J) JX = JX - INCX IF ((N-J).GE.K) KX = KX - INCX 80 CONTINUE @@ -393,6 +381,6 @@ SUBROUTINE DTBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) * RETURN * -* End of DTBMV . +* End of DTBMV * END diff --git a/BLAS/SRC/dtbsv.f b/BLAS/SRC/dtbsv.f index d8c6f144ce..bea7e8b3ed 100644 --- a/BLAS/SRC/dtbsv.f +++ b/BLAS/SRC/dtbsv.f @@ -168,9 +168,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level2 +*> \ingroup tbsv * *> \par Further Details: * ===================== @@ -188,11 +186,11 @@ *> * ===================================================================== SUBROUTINE DTBSV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,K,LDA,N @@ -203,10 +201,6 @@ SUBROUTINE DTBSV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) * .. * * ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO - PARAMETER (ZERO=0.0D+0) * .. * .. Local Scalars .. DOUBLE PRECISION TEMP @@ -229,10 +223,12 @@ SUBROUTINE DTBSV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) INFO = 0 IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN INFO = 1 - ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND. + ELSE IF (.NOT.LSAME(TRANS,'N') .AND. + + .NOT.LSAME(TRANS,'T') .AND. + .NOT.LSAME(TRANS,'C')) THEN INFO = 2 - ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN + ELSE IF (.NOT.LSAME(DIAG,'U') .AND. + + .NOT.LSAME(DIAG,'N')) THEN INFO = 3 ELSE IF (N.LT.0) THEN INFO = 4 @@ -274,59 +270,51 @@ SUBROUTINE DTBSV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) KPLUS1 = K + 1 IF (INCX.EQ.1) THEN DO 20 J = N,1,-1 - IF (X(J).NE.ZERO) THEN - L = KPLUS1 - J - IF (NOUNIT) X(J) = X(J)/A(KPLUS1,J) - TEMP = X(J) - DO 10 I = J - 1,MAX(1,J-K),-1 - X(I) = X(I) - TEMP*A(L+I,J) - 10 CONTINUE - END IF + L = KPLUS1 - J + IF (NOUNIT) X(J) = X(J)/A(KPLUS1,J) + TEMP = X(J) + DO 10 I = J - 1,MAX(1,J-K),-1 + X(I) = X(I) - TEMP*A(L+I,J) + 10 CONTINUE 20 CONTINUE ELSE KX = KX + (N-1)*INCX JX = KX DO 40 J = N,1,-1 KX = KX - INCX - IF (X(JX).NE.ZERO) THEN - IX = KX - L = KPLUS1 - J - IF (NOUNIT) X(JX) = X(JX)/A(KPLUS1,J) - TEMP = X(JX) - DO 30 I = J - 1,MAX(1,J-K),-1 - X(IX) = X(IX) - TEMP*A(L+I,J) - IX = IX - INCX - 30 CONTINUE - END IF + IX = KX + L = KPLUS1 - J + IF (NOUNIT) X(JX) = X(JX)/A(KPLUS1,J) + TEMP = X(JX) + DO 30 I = J - 1,MAX(1,J-K),-1 + X(IX) = X(IX) - TEMP*A(L+I,J) + IX = IX - INCX + 30 CONTINUE JX = JX - INCX 40 CONTINUE END IF ELSE IF (INCX.EQ.1) THEN DO 60 J = 1,N - IF (X(J).NE.ZERO) THEN - L = 1 - J - IF (NOUNIT) X(J) = X(J)/A(1,J) - TEMP = X(J) - DO 50 I = J + 1,MIN(N,J+K) - X(I) = X(I) - TEMP*A(L+I,J) - 50 CONTINUE - END IF + L = 1 - J + IF (NOUNIT) X(J) = X(J)/A(1,J) + TEMP = X(J) + DO 50 I = J + 1,MIN(N,J+K) + X(I) = X(I) - TEMP*A(L+I,J) + 50 CONTINUE 60 CONTINUE ELSE JX = KX DO 80 J = 1,N KX = KX + INCX - IF (X(JX).NE.ZERO) THEN - IX = KX - L = 1 - J - IF (NOUNIT) X(JX) = X(JX)/A(1,J) - TEMP = X(JX) - DO 70 I = J + 1,MIN(N,J+K) - X(IX) = X(IX) - TEMP*A(L+I,J) - IX = IX + INCX - 70 CONTINUE - END IF + IX = KX + L = 1 - J + IF (NOUNIT) X(JX) = X(JX)/A(1,J) + TEMP = X(JX) + DO 70 I = J + 1,MIN(N,J+K) + X(IX) = X(IX) - TEMP*A(L+I,J) + IX = IX + INCX + 70 CONTINUE JX = JX + INCX 80 CONTINUE END IF @@ -396,6 +384,6 @@ SUBROUTINE DTBSV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) * RETURN * -* End of DTBSV . +* End of DTBSV * END diff --git a/BLAS/SRC/dtpmv.f b/BLAS/SRC/dtpmv.f index bad91f32e2..d9877f4667 100644 --- a/BLAS/SRC/dtpmv.f +++ b/BLAS/SRC/dtpmv.f @@ -120,9 +120,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level2 +*> \ingroup tpmv * *> \par Further Details: * ===================== @@ -141,11 +139,11 @@ *> * ===================================================================== SUBROUTINE DTPMV(UPLO,TRANS,DIAG,N,AP,X,INCX) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,N @@ -156,10 +154,6 @@ SUBROUTINE DTPMV(UPLO,TRANS,DIAG,N,AP,X,INCX) * .. * * ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO - PARAMETER (ZERO=0.0D+0) * .. * .. Local Scalars .. DOUBLE PRECISION TEMP @@ -179,10 +173,12 @@ SUBROUTINE DTPMV(UPLO,TRANS,DIAG,N,AP,X,INCX) INFO = 0 IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN INFO = 1 - ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND. + ELSE IF (.NOT.LSAME(TRANS,'N') .AND. + + .NOT.LSAME(TRANS,'T') .AND. + .NOT.LSAME(TRANS,'C')) THEN INFO = 2 - ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN + ELSE IF (.NOT.LSAME(DIAG,'U') .AND. + + .NOT.LSAME(DIAG,'N')) THEN INFO = 3 ELSE IF (N.LT.0) THEN INFO = 4 @@ -220,29 +216,25 @@ SUBROUTINE DTPMV(UPLO,TRANS,DIAG,N,AP,X,INCX) KK = 1 IF (INCX.EQ.1) THEN DO 20 J = 1,N - IF (X(J).NE.ZERO) THEN - TEMP = X(J) - K = KK - DO 10 I = 1,J - 1 - X(I) = X(I) + TEMP*AP(K) - K = K + 1 - 10 CONTINUE - IF (NOUNIT) X(J) = X(J)*AP(KK+J-1) - END IF + TEMP = X(J) + K = KK + DO 10 I = 1,J - 1 + X(I) = X(I) + TEMP*AP(K) + K = K + 1 + 10 CONTINUE + IF (NOUNIT) X(J) = X(J)*AP(KK+J-1) KK = KK + J 20 CONTINUE ELSE JX = KX DO 40 J = 1,N - IF (X(JX).NE.ZERO) THEN - TEMP = X(JX) - IX = KX - DO 30 K = KK,KK + J - 2 - X(IX) = X(IX) + TEMP*AP(K) - IX = IX + INCX - 30 CONTINUE - IF (NOUNIT) X(JX) = X(JX)*AP(KK+J-1) - END IF + TEMP = X(JX) + IX = KX + DO 30 K = KK,KK + J - 2 + X(IX) = X(IX) + TEMP*AP(K) + IX = IX + INCX + 30 CONTINUE + IF (NOUNIT) X(JX) = X(JX)*AP(KK+J-1) JX = JX + INCX KK = KK + J 40 CONTINUE @@ -251,30 +243,26 @@ SUBROUTINE DTPMV(UPLO,TRANS,DIAG,N,AP,X,INCX) KK = (N* (N+1))/2 IF (INCX.EQ.1) THEN DO 60 J = N,1,-1 - IF (X(J).NE.ZERO) THEN - TEMP = X(J) - K = KK - DO 50 I = N,J + 1,-1 - X(I) = X(I) + TEMP*AP(K) - K = K - 1 - 50 CONTINUE - IF (NOUNIT) X(J) = X(J)*AP(KK-N+J) - END IF + TEMP = X(J) + K = KK + DO 50 I = N,J + 1,-1 + X(I) = X(I) + TEMP*AP(K) + K = K - 1 + 50 CONTINUE + IF (NOUNIT) X(J) = X(J)*AP(KK-N+J) KK = KK - (N-J+1) 60 CONTINUE ELSE KX = KX + (N-1)*INCX JX = KX DO 80 J = N,1,-1 - IF (X(JX).NE.ZERO) THEN - TEMP = X(JX) - IX = KX - DO 70 K = KK,KK - (N- (J+1)),-1 - X(IX) = X(IX) + TEMP*AP(K) - IX = IX - INCX - 70 CONTINUE - IF (NOUNIT) X(JX) = X(JX)*AP(KK-N+J) - END IF + TEMP = X(JX) + IX = KX + DO 70 K = KK,KK - (N- (J+1)),-1 + X(IX) = X(IX) + TEMP*AP(K) + IX = IX - INCX + 70 CONTINUE + IF (NOUNIT) X(JX) = X(JX)*AP(KK-N+J) JX = JX - INCX KK = KK - (N-J+1) 80 CONTINUE @@ -347,6 +335,6 @@ SUBROUTINE DTPMV(UPLO,TRANS,DIAG,N,AP,X,INCX) * RETURN * -* End of DTPMV . +* End of DTPMV * END diff --git a/BLAS/SRC/dtpsv.f b/BLAS/SRC/dtpsv.f index abcd0770c9..224ec2314b 100644 --- a/BLAS/SRC/dtpsv.f +++ b/BLAS/SRC/dtpsv.f @@ -123,9 +123,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level2 +*> \ingroup tpsv * *> \par Further Details: * ===================== @@ -143,11 +141,11 @@ *> * ===================================================================== SUBROUTINE DTPSV(UPLO,TRANS,DIAG,N,AP,X,INCX) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,N @@ -158,10 +156,6 @@ SUBROUTINE DTPSV(UPLO,TRANS,DIAG,N,AP,X,INCX) * .. * * ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO - PARAMETER (ZERO=0.0D+0) * .. * .. Local Scalars .. DOUBLE PRECISION TEMP @@ -181,10 +175,12 @@ SUBROUTINE DTPSV(UPLO,TRANS,DIAG,N,AP,X,INCX) INFO = 0 IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN INFO = 1 - ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND. + ELSE IF (.NOT.LSAME(TRANS,'N') .AND. + + .NOT.LSAME(TRANS,'T') .AND. + .NOT.LSAME(TRANS,'C')) THEN INFO = 2 - ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN + ELSE IF (.NOT.LSAME(DIAG,'U') .AND. + + .NOT.LSAME(DIAG,'N')) THEN INFO = 3 ELSE IF (N.LT.0) THEN INFO = 4 @@ -222,29 +218,25 @@ SUBROUTINE DTPSV(UPLO,TRANS,DIAG,N,AP,X,INCX) KK = (N* (N+1))/2 IF (INCX.EQ.1) THEN DO 20 J = N,1,-1 - IF (X(J).NE.ZERO) THEN - IF (NOUNIT) X(J) = X(J)/AP(KK) - TEMP = X(J) - K = KK - 1 - DO 10 I = J - 1,1,-1 - X(I) = X(I) - TEMP*AP(K) - K = K - 1 - 10 CONTINUE - END IF + IF (NOUNIT) X(J) = X(J)/AP(KK) + TEMP = X(J) + K = KK - 1 + DO 10 I = J - 1,1,-1 + X(I) = X(I) - TEMP*AP(K) + K = K - 1 + 10 CONTINUE KK = KK - J 20 CONTINUE ELSE JX = KX + (N-1)*INCX DO 40 J = N,1,-1 - IF (X(JX).NE.ZERO) THEN - IF (NOUNIT) X(JX) = X(JX)/AP(KK) - TEMP = X(JX) - IX = JX - DO 30 K = KK - 1,KK - J + 1,-1 - IX = IX - INCX - X(IX) = X(IX) - TEMP*AP(K) - 30 CONTINUE - END IF + IF (NOUNIT) X(JX) = X(JX)/AP(KK) + TEMP = X(JX) + IX = JX + DO 30 K = KK - 1,KK - J + 1,-1 + IX = IX - INCX + X(IX) = X(IX) - TEMP*AP(K) + 30 CONTINUE JX = JX - INCX KK = KK - J 40 CONTINUE @@ -253,29 +245,25 @@ SUBROUTINE DTPSV(UPLO,TRANS,DIAG,N,AP,X,INCX) KK = 1 IF (INCX.EQ.1) THEN DO 60 J = 1,N - IF (X(J).NE.ZERO) THEN - IF (NOUNIT) X(J) = X(J)/AP(KK) - TEMP = X(J) - K = KK + 1 - DO 50 I = J + 1,N - X(I) = X(I) - TEMP*AP(K) - K = K + 1 - 50 CONTINUE - END IF + IF (NOUNIT) X(J) = X(J)/AP(KK) + TEMP = X(J) + K = KK + 1 + DO 50 I = J + 1,N + X(I) = X(I) - TEMP*AP(K) + K = K + 1 + 50 CONTINUE KK = KK + (N-J+1) 60 CONTINUE ELSE JX = KX DO 80 J = 1,N - IF (X(JX).NE.ZERO) THEN - IF (NOUNIT) X(JX) = X(JX)/AP(KK) - TEMP = X(JX) - IX = JX - DO 70 K = KK + 1,KK + N - J - IX = IX + INCX - X(IX) = X(IX) - TEMP*AP(K) - 70 CONTINUE - END IF + IF (NOUNIT) X(JX) = X(JX)/AP(KK) + TEMP = X(JX) + IX = JX + DO 70 K = KK + 1,KK + N - J + IX = IX + INCX + X(IX) = X(IX) - TEMP*AP(K) + 70 CONTINUE JX = JX + INCX KK = KK + (N-J+1) 80 CONTINUE @@ -349,6 +337,6 @@ SUBROUTINE DTPSV(UPLO,TRANS,DIAG,N,AP,X,INCX) * RETURN * -* End of DTPSV . +* End of DTPSV * END diff --git a/BLAS/SRC/dtrmm.f b/BLAS/SRC/dtrmm.f index 0241c4d146..df89f3ef6a 100644 --- a/BLAS/SRC/dtrmm.f +++ b/BLAS/SRC/dtrmm.f @@ -156,9 +156,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level3 +*> \ingroup trmm * *> \par Further Details: * ===================== @@ -176,11 +174,11 @@ *> * ===================================================================== SUBROUTINE DTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) + IMPLICIT NONE * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA @@ -233,7 +231,8 @@ SUBROUTINE DTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) + (.NOT.LSAME(TRANSA,'T')) .AND. + (.NOT.LSAME(TRANSA,'C'))) THEN INFO = 3 - ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN + ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. + + (.NOT.LSAME(DIAG,'N'))) THEN INFO = 4 ELSE IF (M.LT.0) THEN INFO = 5 @@ -274,27 +273,23 @@ SUBROUTINE DTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) IF (UPPER) THEN DO 50 J = 1,N DO 40 K = 1,M - IF (B(K,J).NE.ZERO) THEN - TEMP = ALPHA*B(K,J) - DO 30 I = 1,K - 1 - B(I,J) = B(I,J) + TEMP*A(I,K) - 30 CONTINUE - IF (NOUNIT) TEMP = TEMP*A(K,K) - B(K,J) = TEMP - END IF + TEMP = ALPHA*B(K,J) + DO 30 I = 1,K - 1 + B(I,J) = B(I,J) + TEMP*A(I,K) + 30 CONTINUE + IF (NOUNIT) TEMP = TEMP*A(K,K) + B(K,J) = TEMP 40 CONTINUE 50 CONTINUE ELSE DO 80 J = 1,N DO 70 K = M,1,-1 - IF (B(K,J).NE.ZERO) THEN - TEMP = ALPHA*B(K,J) - B(K,J) = TEMP - IF (NOUNIT) B(K,J) = B(K,J)*A(K,K) - DO 60 I = K + 1,M - B(I,J) = B(I,J) + TEMP*A(I,K) - 60 CONTINUE - END IF + TEMP = ALPHA*B(K,J) + B(K,J) = TEMP + IF (NOUNIT) B(K,J) = B(K,J)*A(K,K) + DO 60 I = K + 1,M + B(I,J) = B(I,J) + TEMP*A(I,K) + 60 CONTINUE 70 CONTINUE 80 CONTINUE END IF @@ -339,12 +334,10 @@ SUBROUTINE DTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) B(I,J) = TEMP*B(I,J) 150 CONTINUE DO 170 K = 1,J - 1 - IF (A(K,J).NE.ZERO) THEN - TEMP = ALPHA*A(K,J) - DO 160 I = 1,M - B(I,J) = B(I,J) + TEMP*B(I,K) - 160 CONTINUE - END IF + TEMP = ALPHA*A(K,J) + DO 160 I = 1,M + B(I,J) = B(I,J) + TEMP*B(I,K) + 160 CONTINUE 170 CONTINUE 180 CONTINUE ELSE @@ -355,12 +348,10 @@ SUBROUTINE DTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) B(I,J) = TEMP*B(I,J) 190 CONTINUE DO 210 K = J + 1,N - IF (A(K,J).NE.ZERO) THEN - TEMP = ALPHA*A(K,J) - DO 200 I = 1,M - B(I,J) = B(I,J) + TEMP*B(I,K) - 200 CONTINUE - END IF + TEMP = ALPHA*A(K,J) + DO 200 I = 1,M + B(I,J) = B(I,J) + TEMP*B(I,K) + 200 CONTINUE 210 CONTINUE 220 CONTINUE END IF @@ -371,12 +362,10 @@ SUBROUTINE DTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) IF (UPPER) THEN DO 260 K = 1,N DO 240 J = 1,K - 1 - IF (A(J,K).NE.ZERO) THEN - TEMP = ALPHA*A(J,K) - DO 230 I = 1,M - B(I,J) = B(I,J) + TEMP*B(I,K) - 230 CONTINUE - END IF + TEMP = ALPHA*A(J,K) + DO 230 I = 1,M + B(I,J) = B(I,J) + TEMP*B(I,K) + 230 CONTINUE 240 CONTINUE TEMP = ALPHA IF (NOUNIT) TEMP = TEMP*A(K,K) @@ -389,12 +378,10 @@ SUBROUTINE DTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) ELSE DO 300 K = N,1,-1 DO 280 J = K + 1,N - IF (A(J,K).NE.ZERO) THEN - TEMP = ALPHA*A(J,K) - DO 270 I = 1,M - B(I,J) = B(I,J) + TEMP*B(I,K) - 270 CONTINUE - END IF + TEMP = ALPHA*A(J,K) + DO 270 I = 1,M + B(I,J) = B(I,J) + TEMP*B(I,K) + 270 CONTINUE 280 CONTINUE TEMP = ALPHA IF (NOUNIT) TEMP = TEMP*A(K,K) @@ -410,6 +397,6 @@ SUBROUTINE DTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) * RETURN * -* End of DTRMM . +* End of DTRMM * END diff --git a/BLAS/SRC/dtrmv.f b/BLAS/SRC/dtrmv.f index 11c12ac724..d3042d9c7c 100644 --- a/BLAS/SRC/dtrmv.f +++ b/BLAS/SRC/dtrmv.f @@ -125,9 +125,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level2 +*> \ingroup trmv * *> \par Further Details: * ===================== @@ -146,11 +144,11 @@ *> * ===================================================================== SUBROUTINE DTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,LDA,N @@ -161,10 +159,6 @@ SUBROUTINE DTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) * .. * * ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO - PARAMETER (ZERO=0.0D+0) * .. * .. Local Scalars .. DOUBLE PRECISION TEMP @@ -187,10 +181,12 @@ SUBROUTINE DTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) INFO = 0 IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN INFO = 1 - ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND. + ELSE IF (.NOT.LSAME(TRANS,'N') .AND. + + .NOT.LSAME(TRANS,'T') .AND. + .NOT.LSAME(TRANS,'C')) THEN INFO = 2 - ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN + ELSE IF (.NOT.LSAME(DIAG,'U') .AND. + + .NOT.LSAME(DIAG,'N')) THEN INFO = 3 ELSE IF (N.LT.0) THEN INFO = 4 @@ -229,53 +225,45 @@ SUBROUTINE DTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) IF (LSAME(UPLO,'U')) THEN IF (INCX.EQ.1) THEN DO 20 J = 1,N - IF (X(J).NE.ZERO) THEN - TEMP = X(J) - DO 10 I = 1,J - 1 - X(I) = X(I) + TEMP*A(I,J) - 10 CONTINUE - IF (NOUNIT) X(J) = X(J)*A(J,J) - END IF + TEMP = X(J) + DO 10 I = 1,J - 1 + X(I) = X(I) + TEMP*A(I,J) + 10 CONTINUE + IF (NOUNIT) X(J) = X(J)*A(J,J) 20 CONTINUE ELSE JX = KX DO 40 J = 1,N - IF (X(JX).NE.ZERO) THEN - TEMP = X(JX) - IX = KX - DO 30 I = 1,J - 1 - X(IX) = X(IX) + TEMP*A(I,J) - IX = IX + INCX - 30 CONTINUE - IF (NOUNIT) X(JX) = X(JX)*A(J,J) - END IF + TEMP = X(JX) + IX = KX + DO 30 I = 1,J - 1 + X(IX) = X(IX) + TEMP*A(I,J) + IX = IX + INCX + 30 CONTINUE + IF (NOUNIT) X(JX) = X(JX)*A(J,J) JX = JX + INCX 40 CONTINUE END IF ELSE IF (INCX.EQ.1) THEN DO 60 J = N,1,-1 - IF (X(J).NE.ZERO) THEN - TEMP = X(J) - DO 50 I = N,J + 1,-1 - X(I) = X(I) + TEMP*A(I,J) - 50 CONTINUE - IF (NOUNIT) X(J) = X(J)*A(J,J) - END IF + TEMP = X(J) + DO 50 I = N,J + 1,-1 + X(I) = X(I) + TEMP*A(I,J) + 50 CONTINUE + IF (NOUNIT) X(J) = X(J)*A(J,J) 60 CONTINUE ELSE KX = KX + (N-1)*INCX JX = KX DO 80 J = N,1,-1 - IF (X(JX).NE.ZERO) THEN - TEMP = X(JX) - IX = KX - DO 70 I = N,J + 1,-1 - X(IX) = X(IX) + TEMP*A(I,J) - IX = IX - INCX - 70 CONTINUE - IF (NOUNIT) X(JX) = X(JX)*A(J,J) - END IF + TEMP = X(JX) + IX = KX + DO 70 I = N,J + 1,-1 + X(IX) = X(IX) + TEMP*A(I,J) + IX = IX - INCX + 70 CONTINUE + IF (NOUNIT) X(JX) = X(JX)*A(J,J) JX = JX - INCX 80 CONTINUE END IF @@ -337,6 +325,6 @@ SUBROUTINE DTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) * RETURN * -* End of DTRMV . +* End of DTRMV * END diff --git a/BLAS/SRC/dtrsm.f b/BLAS/SRC/dtrsm.f index 5a92bcafd0..6f30e0d42c 100644 --- a/BLAS/SRC/dtrsm.f +++ b/BLAS/SRC/dtrsm.f @@ -159,9 +159,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level3 +*> \ingroup trsm * *> \par Further Details: * ===================== @@ -180,11 +178,11 @@ *> * ===================================================================== SUBROUTINE DTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) + IMPLICIT NONE * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA @@ -213,8 +211,8 @@ SUBROUTINE DTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) LOGICAL LSIDE,NOUNIT,UPPER * .. * .. Parameters .. - DOUBLE PRECISION ONE,ZERO - PARAMETER (ONE=1.0D+0,ZERO=0.0D+0) + DOUBLE PRECISION ZERO + PARAMETER (ZERO=0.0D+0) * .. * * Test the input parameters. @@ -237,7 +235,8 @@ SUBROUTINE DTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) + (.NOT.LSAME(TRANSA,'T')) .AND. + (.NOT.LSAME(TRANSA,'C'))) THEN INFO = 3 - ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN + ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. + + (.NOT.LSAME(DIAG,'N'))) THEN INFO = 4 ELSE IF (M.LT.0) THEN INFO = 5 @@ -277,34 +276,26 @@ SUBROUTINE DTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) * IF (UPPER) THEN DO 60 J = 1,N - IF (ALPHA.NE.ONE) THEN - DO 30 I = 1,M - B(I,J) = ALPHA*B(I,J) - 30 CONTINUE - END IF - DO 50 K = M,1,-1 - IF (B(K,J).NE.ZERO) THEN - IF (NOUNIT) B(K,J) = B(K,J)/A(K,K) - DO 40 I = 1,K - 1 - B(I,J) = B(I,J) - B(K,J)*A(I,K) - 40 CONTINUE - END IF + DO 30 I = 1,M + B(I,J) = ALPHA*B(I,J) + 30 CONTINUE + DO 50 K = M,1,-1 + IF (NOUNIT) B(K,J) = B(K,J)/A(K,K) + DO 40 I = 1,K - 1 + B(I,J) = B(I,J) - B(K,J)*A(I,K) + 40 CONTINUE 50 CONTINUE 60 CONTINUE ELSE DO 100 J = 1,N - IF (ALPHA.NE.ONE) THEN - DO 70 I = 1,M - B(I,J) = ALPHA*B(I,J) - 70 CONTINUE - END IF - DO 90 K = 1,M - IF (B(K,J).NE.ZERO) THEN - IF (NOUNIT) B(K,J) = B(K,J)/A(K,K) - DO 80 I = K + 1,M - B(I,J) = B(I,J) - B(K,J)*A(I,K) - 80 CONTINUE - END IF + DO 70 I = 1,M + B(I,J) = ALPHA*B(I,J) + 70 CONTINUE + DO 90 K = 1,M + IF (NOUNIT) B(K,J) = B(K,J)/A(K,K) + DO 80 I = K + 1,M + B(I,J) = B(I,J) - B(K,J)*A(I,K) + 80 CONTINUE 90 CONTINUE 100 CONTINUE END IF @@ -343,43 +334,33 @@ SUBROUTINE DTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) * IF (UPPER) THEN DO 210 J = 1,N - IF (ALPHA.NE.ONE) THEN - DO 170 I = 1,M - B(I,J) = ALPHA*B(I,J) - 170 CONTINUE - END IF + DO 170 I = 1,M + B(I,J) = ALPHA*B(I,J) + 170 CONTINUE DO 190 K = 1,J - 1 - IF (A(K,J).NE.ZERO) THEN - DO 180 I = 1,M - B(I,J) = B(I,J) - A(K,J)*B(I,K) - 180 CONTINUE - END IF + DO 180 I = 1,M + B(I,J) = B(I,J) - A(K,J)*B(I,K) + 180 CONTINUE 190 CONTINUE IF (NOUNIT) THEN - TEMP = ONE/A(J,J) DO 200 I = 1,M - B(I,J) = TEMP*B(I,J) + B(I,J) = B(I,J)/A(J,J) 200 CONTINUE END IF 210 CONTINUE ELSE DO 260 J = N,1,-1 - IF (ALPHA.NE.ONE) THEN - DO 220 I = 1,M - B(I,J) = ALPHA*B(I,J) - 220 CONTINUE - END IF + DO 220 I = 1,M + B(I,J) = ALPHA*B(I,J) + 220 CONTINUE DO 240 K = J + 1,N - IF (A(K,J).NE.ZERO) THEN - DO 230 I = 1,M - B(I,J) = B(I,J) - A(K,J)*B(I,K) - 230 CONTINUE - END IF + DO 230 I = 1,M + B(I,J) = B(I,J) - A(K,J)*B(I,K) + 230 CONTINUE 240 CONTINUE IF (NOUNIT) THEN - TEMP = ONE/A(J,J) DO 250 I = 1,M - B(I,J) = TEMP*B(I,J) + B(I,J) = B(I,J)/A(J,J) 250 CONTINUE END IF 260 CONTINUE @@ -391,46 +372,34 @@ SUBROUTINE DTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) IF (UPPER) THEN DO 310 K = N,1,-1 IF (NOUNIT) THEN - TEMP = ONE/A(K,K) DO 270 I = 1,M - B(I,K) = TEMP*B(I,K) + B(I,K) = B(I,K)/A(K,K) 270 CONTINUE END IF DO 290 J = 1,K - 1 - IF (A(J,K).NE.ZERO) THEN - TEMP = A(J,K) - DO 280 I = 1,M - B(I,J) = B(I,J) - TEMP*B(I,K) - 280 CONTINUE - END IF + DO 280 I = 1,M + B(I,J) = B(I,J) - A(J,K)*B(I,K) + 280 CONTINUE 290 CONTINUE - IF (ALPHA.NE.ONE) THEN - DO 300 I = 1,M - B(I,K) = ALPHA*B(I,K) - 300 CONTINUE - END IF + DO 300 I = 1,M + B(I,K) = ALPHA*B(I,K) + 300 CONTINUE 310 CONTINUE ELSE DO 360 K = 1,N IF (NOUNIT) THEN - TEMP = ONE/A(K,K) DO 320 I = 1,M - B(I,K) = TEMP*B(I,K) + B(I,K) = B(I,K)/A(K,K) 320 CONTINUE END IF DO 340 J = K + 1,N - IF (A(J,K).NE.ZERO) THEN - TEMP = A(J,K) - DO 330 I = 1,M - B(I,J) = B(I,J) - TEMP*B(I,K) - 330 CONTINUE - END IF + DO 330 I = 1,M + B(I,J) = B(I,J) - A(J,K)*B(I,K) + 330 CONTINUE 340 CONTINUE - IF (ALPHA.NE.ONE) THEN - DO 350 I = 1,M - B(I,K) = ALPHA*B(I,K) - 350 CONTINUE - END IF + DO 350 I = 1,M + B(I,K) = ALPHA*B(I,K) + 350 CONTINUE 360 CONTINUE END IF END IF @@ -438,6 +407,6 @@ SUBROUTINE DTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) * RETURN * -* End of DTRSM . +* End of DTRSM * END diff --git a/BLAS/SRC/dtrsv.f b/BLAS/SRC/dtrsv.f index 331f1d4311..4a393d2c9d 100644 --- a/BLAS/SRC/dtrsv.f +++ b/BLAS/SRC/dtrsv.f @@ -136,17 +136,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level1 +*> \ingroup trsv * * ===================================================================== SUBROUTINE DTRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,LDA,N @@ -157,10 +155,6 @@ SUBROUTINE DTRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) * .. * * ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO - PARAMETER (ZERO=0.0D+0) * .. * .. Local Scalars .. DOUBLE PRECISION TEMP @@ -183,10 +177,12 @@ SUBROUTINE DTRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) INFO = 0 IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN INFO = 1 - ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND. + ELSE IF (.NOT.LSAME(TRANS,'N') .AND. + + .NOT.LSAME(TRANS,'T') .AND. + .NOT.LSAME(TRANS,'C')) THEN INFO = 2 - ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN + ELSE IF (.NOT.LSAME(DIAG,'U') .AND. + + .NOT.LSAME(DIAG,'N')) THEN INFO = 3 ELSE IF (N.LT.0) THEN INFO = 4 @@ -225,52 +221,44 @@ SUBROUTINE DTRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) IF (LSAME(UPLO,'U')) THEN IF (INCX.EQ.1) THEN DO 20 J = N,1,-1 - IF (X(J).NE.ZERO) THEN - IF (NOUNIT) X(J) = X(J)/A(J,J) - TEMP = X(J) - DO 10 I = J - 1,1,-1 - X(I) = X(I) - TEMP*A(I,J) - 10 CONTINUE - END IF + IF (NOUNIT) X(J) = X(J)/A(J,J) + TEMP = X(J) + DO 10 I = J - 1,1,-1 + X(I) = X(I) - TEMP*A(I,J) + 10 CONTINUE 20 CONTINUE ELSE JX = KX + (N-1)*INCX DO 40 J = N,1,-1 - IF (X(JX).NE.ZERO) THEN - IF (NOUNIT) X(JX) = X(JX)/A(J,J) - TEMP = X(JX) - IX = JX - DO 30 I = J - 1,1,-1 - IX = IX - INCX - X(IX) = X(IX) - TEMP*A(I,J) - 30 CONTINUE - END IF + IF (NOUNIT) X(JX) = X(JX)/A(J,J) + TEMP = X(JX) + IX = JX + DO 30 I = J - 1,1,-1 + IX = IX - INCX + X(IX) = X(IX) - TEMP*A(I,J) + 30 CONTINUE JX = JX - INCX 40 CONTINUE END IF ELSE IF (INCX.EQ.1) THEN DO 60 J = 1,N - IF (X(J).NE.ZERO) THEN - IF (NOUNIT) X(J) = X(J)/A(J,J) - TEMP = X(J) - DO 50 I = J + 1,N - X(I) = X(I) - TEMP*A(I,J) - 50 CONTINUE - END IF + IF (NOUNIT) X(J) = X(J)/A(J,J) + TEMP = X(J) + DO 50 I = J + 1,N + X(I) = X(I) - TEMP*A(I,J) + 50 CONTINUE 60 CONTINUE ELSE JX = KX DO 80 J = 1,N - IF (X(JX).NE.ZERO) THEN - IF (NOUNIT) X(JX) = X(JX)/A(J,J) - TEMP = X(JX) - IX = JX - DO 70 I = J + 1,N - IX = IX + INCX - X(IX) = X(IX) - TEMP*A(I,J) - 70 CONTINUE - END IF + IF (NOUNIT) X(JX) = X(JX)/A(J,J) + TEMP = X(JX) + IX = JX + DO 70 I = J + 1,N + IX = IX + INCX + X(IX) = X(IX) - TEMP*A(I,J) + 70 CONTINUE JX = JX + INCX 80 CONTINUE END IF @@ -333,6 +321,6 @@ SUBROUTINE DTRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) * RETURN * -* End of DTRSV . +* End of DTRSV * END diff --git a/BLAS/SRC/dzasum.f b/BLAS/SRC/dzasum.f index 5c80382f72..9cf841c197 100644 --- a/BLAS/SRC/dzasum.f +++ b/BLAS/SRC/dzasum.f @@ -24,7 +24,7 @@ *> \verbatim *> *> DZASUM takes the sum of the (|Re(.)| + |Im(.)|)'s of a complex vector and -*> returns a single precision result. +*> returns a double precision result. *> \endverbatim * * Arguments: @@ -55,9 +55,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup double_blas_level1 +*> \ingroup asum * *> \par Further Details: * ===================== @@ -71,11 +69,11 @@ *> * ===================================================================== DOUBLE PRECISION FUNCTION DZASUM(N,ZX,INCX) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,N @@ -115,4 +113,7 @@ DOUBLE PRECISION FUNCTION DZASUM(N,ZX,INCX) END IF DZASUM = STEMP RETURN +* +* End of DZASUM +* END diff --git a/BLAS/SRC/dznrm2.f b/BLAS/SRC/dznrm2.f deleted file mode 100644 index e5a71d98f6..0000000000 --- a/BLAS/SRC/dznrm2.f +++ /dev/null @@ -1,140 +0,0 @@ -*> \brief \b DZNRM2 -* -* =========== DOCUMENTATION =========== -* -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ -* -* Definition: -* =========== -* -* DOUBLE PRECISION FUNCTION DZNRM2(N,X,INCX) -* -* .. Scalar Arguments .. -* INTEGER INCX,N -* .. -* .. Array Arguments .. -* COMPLEX*16 X(*) -* .. -* -* -*> \par Purpose: -* ============= -*> -*> \verbatim -*> -*> DZNRM2 returns the euclidean norm of a vector via the function -*> name, so that -*> -*> DZNRM2 := sqrt( x**H*x ) -*> \endverbatim -* -* Arguments: -* ========== -* -*> \param[in] N -*> \verbatim -*> N is INTEGER -*> number of elements in input vector(s) -*> \endverbatim -*> -*> \param[in] X -*> \verbatim -*> X is COMPLEX*16 array, dimension (N) -*> complex vector with N elements -*> \endverbatim -*> -*> \param[in] INCX -*> \verbatim -*> INCX is INTEGER -*> storage spacing between elements of X -*> \endverbatim -* -* Authors: -* ======== -* -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. -* -*> \date December 2016 -* -*> \ingroup double_blas_level1 -* -*> \par Further Details: -* ===================== -*> -*> \verbatim -*> -*> -- This version written on 25-October-1982. -*> Modified on 14-October-1993 to inline the call to ZLASSQ. -*> Sven Hammarling, Nag Ltd. -*> \endverbatim -*> -* ===================================================================== - DOUBLE PRECISION FUNCTION DZNRM2(N,X,INCX) -* -* -- Reference BLAS level1 routine (version 3.7.0) -- -* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 -* -* .. Scalar Arguments .. - INTEGER INCX,N -* .. -* .. Array Arguments .. - COMPLEX*16 X(*) -* .. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE,ZERO - PARAMETER (ONE=1.0D+0,ZERO=0.0D+0) -* .. -* .. Local Scalars .. - DOUBLE PRECISION NORM,SCALE,SSQ,TEMP - INTEGER IX -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS,DBLE,DIMAG,SQRT -* .. - IF (N.LT.1 .OR. INCX.LT.1) THEN - NORM = ZERO - ELSE - SCALE = ZERO - SSQ = ONE -* The following loop is equivalent to this call to the LAPACK -* auxiliary routine: -* CALL ZLASSQ( N, X, INCX, SCALE, SSQ ) -* - DO 10 IX = 1,1 + (N-1)*INCX,INCX - IF (DBLE(X(IX)).NE.ZERO) THEN - TEMP = ABS(DBLE(X(IX))) - IF (SCALE.LT.TEMP) THEN - SSQ = ONE + SSQ* (SCALE/TEMP)**2 - SCALE = TEMP - ELSE - SSQ = SSQ + (TEMP/SCALE)**2 - END IF - END IF - IF (DIMAG(X(IX)).NE.ZERO) THEN - TEMP = ABS(DIMAG(X(IX))) - IF (SCALE.LT.TEMP) THEN - SSQ = ONE + SSQ* (SCALE/TEMP)**2 - SCALE = TEMP - ELSE - SSQ = SSQ + (TEMP/SCALE)**2 - END IF - END IF - 10 CONTINUE - NORM = SCALE*SQRT(SSQ) - END IF -* - DZNRM2 = NORM - RETURN -* -* End of DZNRM2. -* - END diff --git a/BLAS/SRC/dznrm2.f90 b/BLAS/SRC/dznrm2.f90 new file mode 100644 index 0000000000..68aa6d496f --- /dev/null +++ b/BLAS/SRC/dznrm2.f90 @@ -0,0 +1,210 @@ +!> \brief \b DZNRM2 +! +! =========== DOCUMENTATION =========== +! +! Online html documentation available at +! http://www.netlib.org/lapack/explore-html/ +! +! Definition: +! =========== +! +! DOUBLE PRECISION FUNCTION DZNRM2(N,X,INCX) +! +! .. Scalar Arguments .. +! INTEGER INCX,N +! .. +! .. Array Arguments .. +! DOUBLE COMPLEX X(*) +! .. +! +! +!> \par Purpose: +! ============= +!> +!> \verbatim +!> +!> DZNRM2 returns the euclidean norm of a vector via the function +!> name, so that +!> +!> DZNRM2 := sqrt( x**H*x ) +!> \endverbatim +! +! Arguments: +! ========== +! +!> \param[in] N +!> \verbatim +!> N is INTEGER +!> number of elements in input vector(s) +!> \endverbatim +!> +!> \param[in] X +!> \verbatim +!> X is COMPLEX*16 array, dimension (N) +!> complex vector with N elements +!> \endverbatim +!> +!> \param[in] INCX +!> \verbatim +!> INCX is INTEGER, storage spacing between elements of X +!> If INCX > 0, X(1+(i-1)*INCX) = x(i) for 1 <= i <= n +!> If INCX < 0, X(1-(n-i)*INCX) = x(i) for 1 <= i <= n +!> If INCX = 0, x isn't a vector so there is no need to call +!> this subroutine. If you call it anyway, it will count x(1) +!> in the vector norm N times. +!> \endverbatim +! +! Authors: +! ======== +! +!> \author Edward Anderson, Lockheed Martin +! +!> \date August 2016 +! +!> \ingroup nrm2 +! +!> \par Contributors: +! ================== +!> +!> Weslley Pereira, University of Colorado Denver, USA +! +!> \par Further Details: +! ===================== +!> +!> \verbatim +!> +!> Anderson E. (2017) +!> Algorithm 978: Safe Scaling in the Level 1 BLAS +!> ACM Trans Math Softw 44:1--28 +!> https://doi.org/10.1145/3061665 +!> +!> Blue, James L. (1978) +!> A Portable Fortran Program to Find the Euclidean Norm of a Vector +!> ACM Trans Math Softw 4:15--23 +!> https://doi.org/10.1145/355769.355771 +!> +!> \endverbatim +!> +! ===================================================================== +function DZNRM2( n, x, incx ) + implicit none + integer, parameter :: wp = kind(1.d0) + real(wp) :: DZNRM2 +! +! -- Reference BLAS level1 routine -- +! -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +! -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +! March 2021 +! +! .. Constants .. + real(wp), parameter :: zero = 0.0_wp + real(wp), parameter :: one = 1.0_wp + real(wp), parameter :: maxN = huge(0.0_wp) +! .. +! .. Blue's scaling constants .. + real(wp), parameter :: tsml = real(radix(0._wp), wp)**ceiling( & + (minexponent(0._wp) - 1) * 0.5_wp) + real(wp), parameter :: tbig = real(radix(0._wp), wp)**floor( & + (maxexponent(0._wp) - digits(0._wp) + 1) * 0.5_wp) + real(wp), parameter :: ssml = real(radix(0._wp), wp)**( - floor( & + (minexponent(0._wp) - digits(0._wp)) * 0.5_wp)) + real(wp), parameter :: sbig = real(radix(0._wp), wp)**( - ceiling( & + (maxexponent(0._wp) + digits(0._wp) - 1) * 0.5_wp)) +! .. +! .. Scalar Arguments .. + integer :: incx, n +! .. +! .. Array Arguments .. + complex(wp) :: x(*) +! .. +! .. Local Scalars .. + integer :: i, ix + logical :: notbig + real(wp) :: abig, amed, asml, ax, scl, sumsq, ymax, ymin +! +! Quick return if possible +! + DZNRM2 = zero + if( n <= 0 ) return +! + scl = one + sumsq = zero +! +! Compute the sum of squares in 3 accumulators: +! abig -- sums of squares scaled down to avoid overflow +! asml -- sums of squares scaled up to avoid underflow +! amed -- sums of squares that do not require scaling +! The thresholds and multipliers are +! tbig -- values bigger than this are scaled down by sbig +! tsml -- values smaller than this are scaled up by ssml +! + notbig = .true. + asml = zero + amed = zero + abig = zero + ix = 1 + if( incx < 0 ) ix = 1 - (n-1)*incx + do i = 1, n + ax = abs(real(x(ix))) + if (ax > tbig) then + abig = abig + (ax*sbig)**2 + notbig = .false. + else if (ax < tsml) then + if (notbig) asml = asml + (ax*ssml)**2 + else + amed = amed + ax**2 + end if + ax = abs(aimag(x(ix))) + if (ax > tbig) then + abig = abig + (ax*sbig)**2 + notbig = .false. + else if (ax < tsml) then + if (notbig) asml = asml + (ax*ssml)**2 + else + amed = amed + ax**2 + end if + ix = ix + incx + end do +! +! Combine abig and amed or amed and asml if more than one +! accumulator was used. +! + if (abig > zero) then +! +! Combine abig and amed if abig > 0. +! + if ( (amed > zero) .or. (amed > maxN) .or. (amed /= amed) ) then + abig = abig + (amed*sbig)*sbig + end if + scl = one / sbig + sumsq = abig + else if (asml > zero) then +! +! Combine amed and asml if asml > 0. +! + if ( (amed > zero) .or. (amed > maxN) .or. (amed /= amed) ) then + amed = sqrt(amed) + asml = sqrt(asml) / ssml + if (asml > amed) then + ymin = amed + ymax = asml + else + ymin = asml + ymax = amed + end if + scl = one + sumsq = ymax**2*( one + (ymin/ymax)**2 ) + else + scl = one / ssml + sumsq = asml + end if + else +! +! Otherwise all values are mid-range +! + scl = one + sumsq = amed + end if + DZNRM2 = scl*sqrt( sumsq ) + return +end function diff --git a/BLAS/SRC/icamax.f90 b/BLAS/SRC/icamax.f90 new file mode 100644 index 0000000000..9be0d9fdaa --- /dev/null +++ b/BLAS/SRC/icamax.f90 @@ -0,0 +1,193 @@ +!> \brief \b ICAMAX +! +! =========== DOCUMENTATION =========== +! +! Online html documentation available at +! http://www.netlib.org/lapack/explore-html/ +! +! Definition: +! =========== +! +! INTEGER FUNCTION ICAMAX(N,X,INCX) +! +! .. Scalar Arguments .. +! INTEGER INCX,N +! .. +! .. Array Arguments .. +! COMPLEX X(*) +! .. +! +! +!> \par Purpose: +! ============= +!> +!> \verbatim +!> +!> ICAMAX finds the index of the first element having maximum |Re(.)| + |Im(.)| +!> \endverbatim +! +! Arguments: +! ========== +! +!> \param[in] N +!> \verbatim +!> N is INTEGER +!> number of elements in input vector(s) +!> \endverbatim +!> +!> \param[in] X +!> \verbatim +!> X is COMPLEX array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) +!> \endverbatim +!> +!> \param[in] INCX +!> \verbatim +!> INCX is INTEGER +!> storage spacing between elements of X +!> \endverbatim +! +! Authors: +! ======== +! +!> James Demmel, University of California Berkeley, USA +!> Weslley Pereira, National Renewable Energy Laboratory, USA +! +!> \ingroup iamax +! +!> \par Further Details: +! ===================== +!> +!> \verbatim +!> +!> James Demmel et al. Proposed Consistent Exception Handling for the BLAS and +!> LAPACK, 2022 (https://arxiv.org/abs/2207.09281). +!> +!> \endverbatim +!> +! ===================================================================== +integer function icamax(n, x, incx) + implicit none + integer, parameter :: wp = kind(1.e0) +! +! -- Reference BLAS level1 routine -- +! -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +! -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +! +! .. Constants .. + real(wp), parameter :: hugeval = huge(0.0_wp) +! +! .. Scalar Arguments .. + integer :: n, incx +! +! .. Array Arguments .. + complex(wp) :: x(*) +! .. +! .. Local Scalars .. + integer :: i, j, ix, jx + real(wp) :: val, smax + logical :: scaledsmax +! .. +! .. Intrinsic Functions .. + intrinsic :: abs, aimag, huge, real +! +! Quick return if possible +! + icamax = 0 + if (n < 1 .or. incx < 1) return +! + icamax = 1 + if (n == 1) return +! + icamax = 0 + scaledsmax = .false. + smax = -1 +! +! scaledsmax = .true. indicates that x(icamax) is finite but +! abs(real(x(icamax))) + abs(aimag(x(icamax))) overflows +! + if (incx == 1) then + ! code for increment equal to 1 + do i = 1, n + if (x(i) /= x(i)) then + ! return when first NaN found + icamax = i + return + elseif (abs(real(x(i))) > hugeval .or. abs(aimag(x(i))) > hugeval) then + ! keep looking for first NaN + do j = i+1, n + if (x(j) /= x(j)) then + ! return when first NaN found + icamax = j + return + endif + enddo + ! record location of first Inf + icamax = i + return + else ! still no Inf found yet + if (.not. scaledsmax) then + ! no abs(real(x(i))) + abs(aimag(x(i))) = Inf yet + val = abs(real(x(i))) + abs(aimag(x(i))) + if (val > hugeval) then + scaledsmax = .true. + smax = 0.25*abs(real(x(i))) + 0.25*abs(aimag(x(i))) + icamax = i + elseif (val > smax) then ! everything finite so far + smax = val + icamax = i + endif + else ! scaledsmax + val = 0.25*abs(real(x(i))) + 0.25*abs(aimag(x(i))) + if (val > smax) then + smax = val + icamax = i + endif + endif + endif + end do + else + ! code for increment not equal to 1 + ix = 1 + do i = 1, n + if (x(ix) /= x(ix)) then + ! return when first NaN found + icamax = i + return + elseif (abs(real(x(ix))) > hugeval .or. abs(aimag(x(ix))) > hugeval) then + ! keep looking for first NaN + jx = ix + incx + do j = i+1, n + if (x(jx) /= x(jx)) then + ! return when first NaN found + icamax = j + return + endif + jx = jx + incx + enddo + ! record location of first Inf + icamax = i + return + else ! still no Inf found yet + if (.not. scaledsmax) then + ! no abs(real(x(ix))) + abs(aimag(x(ix))) = Inf yet + val = abs(real(x(ix))) + abs(aimag(x(ix))) + if (val > hugeval) then + scaledsmax = .true. + smax = 0.25*abs(real(x(ix))) + 0.25*abs(aimag(x(ix))) + icamax = i + elseif (val > smax) then ! everything finite so far + smax = val + icamax = i + endif + else ! scaledsmax + val = 0.25*abs(real(x(ix))) + 0.25*abs(aimag(x(ix))) + if (val > smax) then + smax = val + icamax = i + endif + endif + endif + ix = ix + incx + end do + endif +end diff --git a/BLAS/SRC/idamax.f b/BLAS/SRC/idamax.f index 17041680a4..35042300d7 100644 --- a/BLAS/SRC/idamax.f +++ b/BLAS/SRC/idamax.f @@ -43,7 +43,7 @@ *> \param[in] INCX *> \verbatim *> INCX is INTEGER -*> storage spacing between elements of SX +*> storage spacing between elements of DX *> \endverbatim * * Authors: @@ -54,9 +54,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup aux_blas +*> \ingroup iamax * *> \par Further Details: * ===================== @@ -70,11 +68,11 @@ *> * ===================================================================== INTEGER FUNCTION IDAMAX(N,DX,INCX) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,N @@ -123,4 +121,7 @@ INTEGER FUNCTION IDAMAX(N,DX,INCX) END DO END IF RETURN +* +* End of IDAMAX +* END diff --git a/BLAS/SRC/isamax.f b/BLAS/SRC/isamax.f index f68763ceda..6104adbf50 100644 --- a/BLAS/SRC/isamax.f +++ b/BLAS/SRC/isamax.f @@ -54,9 +54,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup aux_blas +*> \ingroup iamax * *> \par Further Details: * ===================== @@ -70,11 +68,11 @@ *> * ===================================================================== INTEGER FUNCTION ISAMAX(N,SX,INCX) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,N @@ -123,4 +121,7 @@ INTEGER FUNCTION ISAMAX(N,SX,INCX) END DO END IF RETURN +* +* End of ISAMAX +* END diff --git a/BLAS/SRC/izamax.f90 b/BLAS/SRC/izamax.f90 new file mode 100644 index 0000000000..35b81d741c --- /dev/null +++ b/BLAS/SRC/izamax.f90 @@ -0,0 +1,193 @@ +!> \brief \b IZAMAX +! +! =========== DOCUMENTATION =========== +! +! Online html documentation available at +! http://www.netlib.org/lapack/explore-html/ +! +! Definition: +! =========== +! +! INTEGER FUNCTION IZAMAX(N,X,INCX) +! +! .. Scalar Arguments .. +! INTEGER INCX,N +! .. +! .. Array Arguments .. +! DOUBLE COMPLEX X(*) +! .. +! +! +!> \par Purpose: +! ============= +!> +!> \verbatim +!> +!> IZAMAX finds the index of the first element having maximum |Re(.)| + |Im(.)| +!> \endverbatim +! +! Arguments: +! ========== +! +!> \param[in] N +!> \verbatim +!> N is INTEGER +!> number of elements in input vector(s) +!> \endverbatim +!> +!> \param[in] X +!> \verbatim +!> X is DOUBLE COMPLEX array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) +!> \endverbatim +!> +!> \param[in] INCX +!> \verbatim +!> INCX is INTEGER +!> storage spacing between elements of X +!> \endverbatim +! +! Authors: +! ======== +! +!> James Demmel, University of California Berkeley, USA +!> Weslley Pereira, National Renewable Energy Laboratory, USA +! +!> \ingroup iamax +! +!> \par Further Details: +! ===================== +!> +!> \verbatim +!> +!> James Demmel et al. Proposed Consistent Exception Handling for the BLAS and +!> LAPACK, 2022 (https://arxiv.org/abs/2207.09281). +!> +!> \endverbatim +!> +! ===================================================================== +integer function izamax(n, x, incx) + implicit none + integer, parameter :: wp = kind(1.d0) +! +! -- Reference BLAS level1 routine -- +! -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +! -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +! +! .. Constants .. + real(wp), parameter :: hugeval = huge(0.0_wp) +! +! .. Scalar Arguments .. + integer :: n, incx +! +! .. Array Arguments .. + complex(wp) :: x(*) +! .. +! .. Local Scalars .. + integer :: i, j, ix, jx + real(wp) :: val, smax + logical :: scaledsmax +! .. +! .. Intrinsic Functions .. + intrinsic :: abs, dimag, huge, real +! +! Quick return if possible +! + izamax = 0 + if (n < 1 .or. incx < 1) return +! + izamax = 1 + if (n == 1) return +! + izamax = 0 + scaledsmax = .false. + smax = -1 +! +! scaledsmax = .true. indicates that x(izamax) is finite but +! abs(real(x(izamax))) + abs(dimag(x(izamax))) overflows +! + if (incx == 1) then + ! code for increment equal to 1 + do i = 1, n + if (x(i) /= x(i)) then + ! return when first NaN found + izamax = i + return + elseif (abs(real(x(i))) > hugeval .or. abs(dimag(x(i))) > hugeval) then + ! keep looking for first NaN + do j = i+1, n + if (x(j) /= x(j)) then + ! return when first NaN found + izamax = j + return + endif + enddo + ! record location of first Inf + izamax = i + return + else ! still no Inf found yet + if (.not. scaledsmax) then + ! no abs(real(x(i))) + abs(dimag(x(i))) = Inf yet + val = abs(real(x(i))) + abs(dimag(x(i))) + if (val > hugeval) then + scaledsmax = .true. + smax = 0.25*abs(real(x(i))) + 0.25*abs(dimag(x(i))) + izamax = i + elseif (val > smax) then ! everything finite so far + smax = val + izamax = i + endif + else ! scaledsmax + val = 0.25*abs(real(x(i))) + 0.25*abs(dimag(x(i))) + if (val > smax) then + smax = val + izamax = i + endif + endif + endif + end do + else + ! code for increment not equal to 1 + ix = 1 + do i = 1, n + if (x(ix) /= x(ix)) then + ! return when first NaN found + izamax = i + return + elseif (abs(real(x(ix))) > hugeval .or. abs(dimag(x(ix))) > hugeval) then + ! keep looking for first NaN + jx = ix + incx + do j = i+1, n + if (x(jx) /= x(jx)) then + ! return when first NaN found + izamax = j + return + endif + jx = jx + incx + enddo + ! record location of first Inf + izamax = i + return + else ! still no Inf found yet + if (.not. scaledsmax) then + ! no abs(real(x(ix))) + abs(dimag(x(ix))) = Inf yet + val = abs(real(x(ix))) + abs(dimag(x(ix))) + if (val > hugeval) then + scaledsmax = .true. + smax = 0.25*abs(real(x(ix))) + 0.25*abs(dimag(x(ix))) + izamax = i + elseif (val > smax) then ! everything finite so far + smax = val + izamax = i + endif + else ! scaledsmax + val = 0.25*abs(real(x(ix))) + 0.25*abs(dimag(x(ix))) + if (val > smax) then + smax = val + izamax = i + endif + endif + endif + ix = ix + incx + end do + endif +end diff --git a/BLAS/SRC/lsame.f b/BLAS/SRC/lsame.f index d819478696..10246991e4 100644 --- a/BLAS/SRC/lsame.f +++ b/BLAS/SRC/lsame.f @@ -46,17 +46,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup aux_blas +*> \ingroup lsame * * ===================================================================== LOGICAL FUNCTION LSAME(CA,CB) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.1) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER CA,CB diff --git a/BLAS/SRC/sasum.f b/BLAS/SRC/sasum.f index 0afe77c621..8b3136898a 100644 --- a/BLAS/SRC/sasum.f +++ b/BLAS/SRC/sasum.f @@ -55,9 +55,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level1 +*> \ingroup asum * *> \par Further Details: * ===================== @@ -71,11 +69,11 @@ *> * ===================================================================== REAL FUNCTION SASUM(N,SX,INCX) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,N @@ -129,4 +127,7 @@ REAL FUNCTION SASUM(N,SX,INCX) END IF SASUM = STEMP RETURN +* +* End of SASUM +* END diff --git a/BLAS/SRC/saxpby.f b/BLAS/SRC/saxpby.f new file mode 100644 index 0000000000..d1da056f43 --- /dev/null +++ b/BLAS/SRC/saxpby.f @@ -0,0 +1,148 @@ +*> \brief \b SAXPBY +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE SAXPBY(N,SA,SX,INCX,SB,SY,INCY) +* +* .. Scalar Arguments .. +* REAL SA,SB +* INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. +* REAL SX(*),SY(*) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> SAXPBY constant times a vector plus constant times a vector. +*> +*> Y = ALPHA * X + BETA * Y +*> +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> number of elements in input vector(s) +*> \endverbatim +*> +*> \param[in] SA +*> \verbatim +*> SA is REAL +*> On entry, SA specifies the scalar alpha. +*> \endverbatim +*> +*> \param[in] SX +*> \verbatim +*> SX is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) +*> \endverbatim +*> +*> \param[in] INCX +*> \verbatim +*> INCX is INTEGER +*> storage spacing between elements of SX +*> \endverbatim +*> +*> \param[in] SB +*> \verbatim +*> SB is REAL +*> On entry, SB specifies the scalar beta. +*> \endverbatim +*> +*> \param[in,out] SY +*> \verbatim +*> SY is REAL array, dimension ( 1 + ( N - 1 )*abs( INCY ) ) +*> \endverbatim +*> +*> \param[in] INCY +*> \verbatim +*> INCY is INTEGER +*> storage spacing between elements of SY +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +*> \author Martin Koehler, MPI Magdeburg +* +*> \ingroup axpby +* +* ===================================================================== + SUBROUTINE SAXPBY(N,SA,SX,INCX,SB,SY,INCY) + IMPLICIT NONE +* +* -- Reference BLAS level1 routine -- +* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + REAL SA,SB + INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. + REAL SX(*),SY(*) +* .. +* .. External Subroutines .. + EXTERNAL SSCAL +* +* ===================================================================== +* +* .. Local Scalars .. + INTEGER I,IX,IY,M,MP1 +* .. +* .. Intrinsic Functions .. + INTRINSIC MOD +* .. + IF (N.LE.0) RETURN + +* Scale if SA.EQ.0 + IF (SA.EQ.0.0E0 .AND. SB.NE.0.0E0) THEN + CALL SSCAL(N, SB, SY, INCY) + RETURN + END IF + + + IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN +* +* code for both increments equal to 1 +* + DO I = 1,N + SY(I) = SB*SY(I) + SA*SX(I) + END DO + ELSE +* +* code for unequal increments or equal increments +* not equal to 1 +* + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO I = 1,N + SY(IY) = SB*SY(IY) + SA*SX(IX) + IX = IX + INCX + IY = IY + INCY + END DO + END IF + RETURN +* +* End of SAXPBY +* + END diff --git a/BLAS/SRC/saxpy.f b/BLAS/SRC/saxpy.f index c7e599d83f..52296e5b37 100644 --- a/BLAS/SRC/saxpy.f +++ b/BLAS/SRC/saxpy.f @@ -73,9 +73,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level1 +*> \ingroup axpy * *> \par Further Details: * ===================== @@ -88,11 +86,11 @@ *> * ===================================================================== SUBROUTINE SAXPY(N,SA,SX,INCX,SY,INCY) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. REAL SA @@ -149,4 +147,7 @@ SUBROUTINE SAXPY(N,SA,SX,INCX,SY,INCY) END DO END IF RETURN +* +* End of SAXPY +* END diff --git a/BLAS/SRC/scabs1.f b/BLAS/SRC/scabs1.f index 81fc0aab17..f6e6cbb7cc 100644 --- a/BLAS/SRC/scabs1.f +++ b/BLAS/SRC/scabs1.f @@ -39,17 +39,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level1 +*> \ingroup abs1 * * ===================================================================== REAL FUNCTION SCABS1(Z) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX Z @@ -62,4 +60,7 @@ REAL FUNCTION SCABS1(Z) * .. SCABS1 = ABS(REAL(Z)) + ABS(AIMAG(Z)) RETURN +* +* End of SCABS1 +* END diff --git a/BLAS/SRC/scasum.f b/BLAS/SRC/scasum.f index 0e9c137d2b..054859ff37 100644 --- a/BLAS/SRC/scasum.f +++ b/BLAS/SRC/scasum.f @@ -55,9 +55,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level1 +*> \ingroup asum * *> \par Further Details: * ===================== @@ -71,11 +69,11 @@ *> * ===================================================================== REAL FUNCTION SCASUM(N,CX,INCX) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,N @@ -114,4 +112,7 @@ REAL FUNCTION SCASUM(N,CX,INCX) END IF SCASUM = STEMP RETURN +* +* End of SCASUM +* END diff --git a/BLAS/SRC/scnrm2.f b/BLAS/SRC/scnrm2.f deleted file mode 100644 index d2e6faed40..0000000000 --- a/BLAS/SRC/scnrm2.f +++ /dev/null @@ -1,140 +0,0 @@ -*> \brief \b SCNRM2 -* -* =========== DOCUMENTATION =========== -* -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ -* -* Definition: -* =========== -* -* REAL FUNCTION SCNRM2(N,X,INCX) -* -* .. Scalar Arguments .. -* INTEGER INCX,N -* .. -* .. Array Arguments .. -* COMPLEX X(*) -* .. -* -* -*> \par Purpose: -* ============= -*> -*> \verbatim -*> -*> SCNRM2 returns the euclidean norm of a vector via the function -*> name, so that -*> -*> SCNRM2 := sqrt( x**H*x ) -*> \endverbatim -* -* Arguments: -* ========== -* -*> \param[in] N -*> \verbatim -*> N is INTEGER -*> number of elements in input vector(s) -*> \endverbatim -*> -*> \param[in] X -*> \verbatim -*> X is COMPLEX array, dimension (N) -*> complex vector with N elements -*> \endverbatim -*> -*> \param[in] INCX -*> \verbatim -*> INCX is INTEGER -*> storage spacing between elements of X -*> \endverbatim -* -* Authors: -* ======== -* -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. -* -*> \date December 2016 -* -*> \ingroup single_blas_level1 -* -*> \par Further Details: -* ===================== -*> -*> \verbatim -*> -*> -- This version written on 25-October-1982. -*> Modified on 14-October-1993 to inline the call to CLASSQ. -*> Sven Hammarling, Nag Ltd. -*> \endverbatim -*> -* ===================================================================== - REAL FUNCTION SCNRM2(N,X,INCX) -* -* -- Reference BLAS level1 routine (version 3.7.0) -- -* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 -* -* .. Scalar Arguments .. - INTEGER INCX,N -* .. -* .. Array Arguments .. - COMPLEX X(*) -* .. -* -* ===================================================================== -* -* .. Parameters .. - REAL ONE,ZERO - PARAMETER (ONE=1.0E+0,ZERO=0.0E+0) -* .. -* .. Local Scalars .. - REAL NORM,SCALE,SSQ,TEMP - INTEGER IX -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS,AIMAG,REAL,SQRT -* .. - IF (N.LT.1 .OR. INCX.LT.1) THEN - NORM = ZERO - ELSE - SCALE = ZERO - SSQ = ONE -* The following loop is equivalent to this call to the LAPACK -* auxiliary routine: -* CALL CLASSQ( N, X, INCX, SCALE, SSQ ) -* - DO 10 IX = 1,1 + (N-1)*INCX,INCX - IF (REAL(X(IX)).NE.ZERO) THEN - TEMP = ABS(REAL(X(IX))) - IF (SCALE.LT.TEMP) THEN - SSQ = ONE + SSQ* (SCALE/TEMP)**2 - SCALE = TEMP - ELSE - SSQ = SSQ + (TEMP/SCALE)**2 - END IF - END IF - IF (AIMAG(X(IX)).NE.ZERO) THEN - TEMP = ABS(AIMAG(X(IX))) - IF (SCALE.LT.TEMP) THEN - SSQ = ONE + SSQ* (SCALE/TEMP)**2 - SCALE = TEMP - ELSE - SSQ = SSQ + (TEMP/SCALE)**2 - END IF - END IF - 10 CONTINUE - NORM = SCALE*SQRT(SSQ) - END IF -* - SCNRM2 = NORM - RETURN -* -* End of SCNRM2. -* - END diff --git a/BLAS/SRC/scnrm2.f90 b/BLAS/SRC/scnrm2.f90 new file mode 100644 index 0000000000..1885d7bf71 --- /dev/null +++ b/BLAS/SRC/scnrm2.f90 @@ -0,0 +1,210 @@ +!> \brief \b SCNRM2 +! +! =========== DOCUMENTATION =========== +! +! Online html documentation available at +! http://www.netlib.org/lapack/explore-html/ +! +! Definition: +! =========== +! +! REAL FUNCTION SCNRM2(N,X,INCX) +! +! .. Scalar Arguments .. +! INTEGER INCX,N +! .. +! .. Array Arguments .. +! COMPLEX X(*) +! .. +! +! +!> \par Purpose: +! ============= +!> +!> \verbatim +!> +!> SCNRM2 returns the euclidean norm of a vector via the function +!> name, so that +!> +!> SCNRM2 := sqrt( x**H*x ) +!> \endverbatim +! +! Arguments: +! ========== +! +!> \param[in] N +!> \verbatim +!> N is INTEGER +!> number of elements in input vector(s) +!> \endverbatim +!> +!> \param[in] X +!> \verbatim +!> X is COMPLEX array, dimension (N) +!> complex vector with N elements +!> \endverbatim +!> +!> \param[in] INCX +!> \verbatim +!> INCX is INTEGER, storage spacing between elements of X +!> If INCX > 0, X(1+(i-1)*INCX) = x(i) for 1 <= i <= n +!> If INCX < 0, X(1-(n-i)*INCX) = x(i) for 1 <= i <= n +!> If INCX = 0, x isn't a vector so there is no need to call +!> this subroutine. If you call it anyway, it will count x(1) +!> in the vector norm N times. +!> \endverbatim +! +! Authors: +! ======== +! +!> \author Edward Anderson, Lockheed Martin +! +!> \date August 2016 +! +!> \ingroup nrm2 +! +!> \par Contributors: +! ================== +!> +!> Weslley Pereira, University of Colorado Denver, USA +! +!> \par Further Details: +! ===================== +!> +!> \verbatim +!> +!> Anderson E. (2017) +!> Algorithm 978: Safe Scaling in the Level 1 BLAS +!> ACM Trans Math Softw 44:1--28 +!> https://doi.org/10.1145/3061665 +!> +!> Blue, James L. (1978) +!> A Portable Fortran Program to Find the Euclidean Norm of a Vector +!> ACM Trans Math Softw 4:15--23 +!> https://doi.org/10.1145/355769.355771 +!> +!> \endverbatim +!> +! ===================================================================== +function SCNRM2( n, x, incx ) + implicit none + integer, parameter :: wp = kind(1.e0) + real(wp) :: SCNRM2 +! +! -- Reference BLAS level1 routine -- +! -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +! -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +! March 2021 +! +! .. Constants .. + real(wp), parameter :: zero = 0.0_wp + real(wp), parameter :: one = 1.0_wp + real(wp), parameter :: maxN = huge(0.0_wp) +! .. +! .. Blue's scaling constants .. + real(wp), parameter :: tsml = real(radix(0._wp), wp)**ceiling( & + (minexponent(0._wp) - 1) * 0.5_wp) + real(wp), parameter :: tbig = real(radix(0._wp), wp)**floor( & + (maxexponent(0._wp) - digits(0._wp) + 1) * 0.5_wp) + real(wp), parameter :: ssml = real(radix(0._wp), wp)**( - floor( & + (minexponent(0._wp) - digits(0._wp)) * 0.5_wp)) + real(wp), parameter :: sbig = real(radix(0._wp), wp)**( - ceiling( & + (maxexponent(0._wp) + digits(0._wp) - 1) * 0.5_wp)) +! .. +! .. Scalar Arguments .. + integer :: incx, n +! .. +! .. Array Arguments .. + complex(wp) :: x(*) +! .. +! .. Local Scalars .. + integer :: i, ix + logical :: notbig + real(wp) :: abig, amed, asml, ax, scl, sumsq, ymax, ymin +! +! Quick return if possible +! + SCNRM2 = zero + if( n <= 0 ) return +! + scl = one + sumsq = zero +! +! Compute the sum of squares in 3 accumulators: +! abig -- sums of squares scaled down to avoid overflow +! asml -- sums of squares scaled up to avoid underflow +! amed -- sums of squares that do not require scaling +! The thresholds and multipliers are +! tbig -- values bigger than this are scaled down by sbig +! tsml -- values smaller than this are scaled up by ssml +! + notbig = .true. + asml = zero + amed = zero + abig = zero + ix = 1 + if( incx < 0 ) ix = 1 - (n-1)*incx + do i = 1, n + ax = abs(real(x(ix))) + if (ax > tbig) then + abig = abig + (ax*sbig)**2 + notbig = .false. + else if (ax < tsml) then + if (notbig) asml = asml + (ax*ssml)**2 + else + amed = amed + ax**2 + end if + ax = abs(aimag(x(ix))) + if (ax > tbig) then + abig = abig + (ax*sbig)**2 + notbig = .false. + else if (ax < tsml) then + if (notbig) asml = asml + (ax*ssml)**2 + else + amed = amed + ax**2 + end if + ix = ix + incx + end do +! +! Combine abig and amed or amed and asml if more than one +! accumulator was used. +! + if (abig > zero) then +! +! Combine abig and amed if abig > 0. +! + if ( (amed > zero) .or. (amed > maxN) .or. (amed /= amed) ) then + abig = abig + (amed*sbig)*sbig + end if + scl = one / sbig + sumsq = abig + else if (asml > zero) then +! +! Combine amed and asml if asml > 0. +! + if ( (amed > zero) .or. (amed > maxN) .or. (amed /= amed) ) then + amed = sqrt(amed) + asml = sqrt(asml) / ssml + if (asml > amed) then + ymin = amed + ymax = asml + else + ymin = asml + ymax = amed + end if + scl = one + sumsq = ymax**2*( one + (ymin/ymax)**2 ) + else + scl = one / ssml + sumsq = asml + end if + else +! +! Otherwise all values are mid-range +! + scl = one + sumsq = amed + end if + SCNRM2 = scl*sqrt( sumsq ) + return +end function diff --git a/BLAS/SRC/scopy.f b/BLAS/SRC/scopy.f index 6bb6d3b56a..76503a20f3 100644 --- a/BLAS/SRC/scopy.f +++ b/BLAS/SRC/scopy.f @@ -66,9 +66,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level1 +*> \ingroup copy * *> \par Further Details: * ===================== @@ -81,11 +79,11 @@ *> * ===================================================================== SUBROUTINE SCOPY(N,SX,INCX,SY,INCY) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,INCY,N @@ -143,4 +141,7 @@ SUBROUTINE SCOPY(N,SX,INCX,SY,INCY) END DO END IF RETURN +* +* End of SCOPY +* END diff --git a/BLAS/SRC/sdot.f b/BLAS/SRC/sdot.f index dc67ed64cc..2271ff03b1 100644 --- a/BLAS/SRC/sdot.f +++ b/BLAS/SRC/sdot.f @@ -66,9 +66,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level1 +*> \ingroup dot * *> \par Further Details: * ===================== @@ -81,11 +79,11 @@ *> * ===================================================================== REAL FUNCTION SDOT(N,SX,INCX,SY,INCY) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,INCY,N @@ -145,4 +143,7 @@ REAL FUNCTION SDOT(N,SX,INCX,SY,INCY) END IF SDOT = STEMP RETURN +* +* End of SDOT +* END diff --git a/BLAS/SRC/sdsdot.f b/BLAS/SRC/sdsdot.f index f110386308..4271c2be98 100644 --- a/BLAS/SRC/sdsdot.f +++ b/BLAS/SRC/sdsdot.f @@ -23,13 +23,13 @@ *> *> \verbatim *> -* Compute the inner product of two vectors with extended -* precision accumulation. -* -* Returns S.P. result with dot product accumulated in D.P. -* SDSDOT = SB + sum for I = 0 to N-1 of SX(LX+I*INCX)*SY(LY+I*INCY), -* where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is -* defined in a similar way using INCY. +*> Compute the inner product of two vectors with extended +*> precision accumulation. +*> +*> Returns S.P. result with dot product accumulated in D.P. +*> SDSDOT = SB + sum for I = 0 to N-1 of SX(LX+I*INCX)*SY(LY+I*INCY), +*> where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is +*> defined in a similar way using INCY. *> \endverbatim * * Arguments: @@ -77,7 +77,12 @@ *> \author Lawson, C. L., (JPL), Hanson, R. J., (SNLA), *> \author Kincaid, D. R., (U. of Texas), Krogh, F. T., (JPL) * -*> \ingroup complex_blas_level1 +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup dot * *> \par Further Details: * ===================== @@ -102,72 +107,14 @@ *> 920501 Reformatted the REFERENCES section. (WRB) *> 070118 Reformat to LAPACK coding style *> \endverbatim -* -* ===================================================================== -* -* .. Local Scalars .. -* DOUBLE PRECISION DSDOT -* INTEGER I,KX,KY,NS -* .. -* .. Intrinsic Functions .. -* INTRINSIC DBLE -* .. -* DSDOT = SB -* IF (N.LE.0) THEN -* SDSDOT = DSDOT -* RETURN -* END IF -* IF (INCX.EQ.INCY .AND. INCX.GT.0) THEN -* -* Code for equal and positive increments. -* -* NS = N*INCX -* DO I = 1,NS,INCX -* DSDOT = DSDOT + DBLE(SX(I))*DBLE(SY(I)) -* END DO -* ELSE -* -* Code for unequal or nonpositive increments. -* -* KX = 1 -* KY = 1 -* IF (INCX.LT.0) KX = 1 + (1-N)*INCX -* IF (INCY.LT.0) KY = 1 + (1-N)*INCY -* DO I = 1,N -* DSDOT = DSDOT + DBLE(SX(KX))*DBLE(SY(KY)) -* KX = KX + INCX -* KY = KY + INCY -* END DO -* END IF -* SDSDOT = DSDOT -* RETURN -* END -* -*> \par Purpose: -* ============= *> -*> \verbatim -*> \endverbatim -* -* Authors: -* ======== -* -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. -* -*> \date December 2016 -* -*> \ingroup single_blas_level1 -* * ===================================================================== REAL FUNCTION SDSDOT(N,SB,SX,INCX,SY,INCY) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. REAL SB @@ -175,71 +122,6 @@ REAL FUNCTION SDSDOT(N,SB,SX,INCX,SY,INCY) * .. * .. Array Arguments .. REAL SX(*),SY(*) -* .. -* -* PURPOSE -* ======= -* -* Compute the inner product of two vectors with extended -* precision accumulation. -* -* Returns S.P. result with dot product accumulated in D.P. -* SDSDOT = SB + sum for I = 0 to N-1 of SX(LX+I*INCX)*SY(LY+I*INCY), -* where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is -* defined in a similar way using INCY. -* -* AUTHOR -* ====== -* Lawson, C. L., (JPL), Hanson, R. J., (SNLA), -* Kincaid, D. R., (U. of Texas), Krogh, F. T., (JPL) -* -* ARGUMENTS -* ========= -* -* N (input) INTEGER -* number of elements in input vector(s) -* -* SB (input) REAL -* single precision scalar to be added to inner product -* -* SX (input) REAL array, dimension (N) -* single precision vector with N elements -* -* INCX (input) INTEGER -* storage spacing between elements of SX -* -* SY (input) REAL array, dimension (N) -* single precision vector with N elements -* -* INCY (input) INTEGER -* storage spacing between elements of SY -* -* SDSDOT (output) REAL -* single precision dot product (SB if N .LE. 0) -* -* Further Details -* =============== -* -* REFERENCES -* -* C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T. -* Krogh, Basic linear algebra subprograms for Fortran -* usage, Algorithm No. 539, Transactions on Mathematical -* Software 5, 3 (September 1979), pp. 308-323. -* -* REVISION HISTORY (YYMMDD) -* -* 791001 DATE WRITTEN -* 890531 Changed all specific intrinsics to generic. (WRB) -* 890831 Modified array declarations. (WRB) -* 890831 REVISION DATE from Version 3.2 -* 891214 Prologue converted to Version 4.0 format. (BAB) -* 920310 Corrected definition of LX in DESCRIPTION. (WRB) -* 920501 Reformatted the REFERENCES section. (WRB) -* 070118 Reformat to LAPACK coding style -* -* ===================================================================== -* * .. Local Scalars .. DOUBLE PRECISION DSDOT INTEGER I,KX,KY,NS @@ -249,7 +131,7 @@ REAL FUNCTION SDSDOT(N,SB,SX,INCX,SY,INCY) * .. DSDOT = SB IF (N.LE.0) THEN - SDSDOT = DSDOT + SDSDOT = REAL(DSDOT) RETURN END IF IF (INCX.EQ.INCY .AND. INCX.GT.0) THEN @@ -274,6 +156,9 @@ REAL FUNCTION SDSDOT(N,SB,SX,INCX,SY,INCY) KY = KY + INCY END DO END IF - SDSDOT = DSDOT + SDSDOT = REAL(DSDOT) RETURN +* +* End of SDSDOT +* END diff --git a/BLAS/SRC/sgbmv.f b/BLAS/SRC/sgbmv.f index df13b588f7..942cd29a7d 100644 --- a/BLAS/SRC/sgbmv.f +++ b/BLAS/SRC/sgbmv.f @@ -146,6 +146,8 @@ *> ( 1 + ( n - 1 )*abs( INCY ) ) otherwise. *> Before entry, the incremented array Y must contain the *> vector y. On exit, Y is overwritten by the updated vector y. +*> If either m or n is zero, then Y not referenced and the function +*> performs a quick return. *> \endverbatim *> *> \param[in] INCY @@ -163,9 +165,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level2 +*> \ingroup gbmv * *> \par Further Details: * ===================== @@ -183,12 +183,13 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE SGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) + SUBROUTINE SGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX, + + BETA,Y,INCY) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. REAL ALPHA,BETA @@ -365,6 +366,6 @@ SUBROUTINE SGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) * RETURN * -* End of SGBMV . +* End of SGBMV * END diff --git a/BLAS/SRC/sgemm.f b/BLAS/SRC/sgemm.f index ca2fb175d3..c88cae7d46 100644 --- a/BLAS/SRC/sgemm.f +++ b/BLAS/SRC/sgemm.f @@ -35,6 +35,16 @@ *> *> alpha and beta are scalars, and A, B and C are matrices, with op( A ) *> an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. +*> +*> Note: if alpha and/or beta is zero, some parts of the matrix-matrix +*> operations are not performed. This results in the following NaN/Inf +*> propagation quirks: +*> +*> 1. If alpha is zero, NaNs or Infs in A or B do not affect the result. +*> 2. If both alpha and beta are zero, then a zero matrix is returned in C, +*> irrespective of any NaNs or Infs in A, B or C. +*> 3. If only beta is zero, alpha*op( A )*op( B ) is returned, irrespective +*> of any NaNs or Infs in C. *> \endverbatim * * Arguments: @@ -51,6 +61,9 @@ *> TRANSA = 'T' or 't', op( A ) = A**T. *> *> TRANSA = 'C' or 'c', op( A ) = A**T. +*> +*> Note: TRANSA = 'C' is supported for the sake of API consistency +*> between all ?GEMM variants. *> \endverbatim *> *> \param[in] TRANSB @@ -64,6 +77,9 @@ *> TRANSB = 'T' or 't', op( B ) = B**T. *> *> TRANSB = 'C' or 'c', op( B ) = B**T. +*> +*> Note: TRANSB = 'C' is supported for the sake of API consistency +*> between all ?GEMM variants. *> \endverbatim *> *> \param[in] M @@ -92,7 +108,9 @@ *> \param[in] ALPHA *> \verbatim *> ALPHA is REAL -*> On entry, ALPHA specifies the scalar alpha. +*> On entry, ALPHA specifies the scalar alpha. If ALPHA is zero the +*> values in A and B do not affect the result. This also means that +*> NaN/Inf propagation from A and B is inhibited if ALPHA is zero. *> \endverbatim *> *> \param[in] A @@ -102,7 +120,10 @@ *> Before entry with TRANSA = 'N' or 'n', the leading m by k *> part of the array A must contain the matrix A, otherwise *> the leading k by m part of the array A must contain the -*> matrix A. +*> matrix A, except if ALPHA is zero. +*> If ALPHA is zero, none of the values in A affect the result, even +*> if they are NaN/Inf. This also implies that if ALPHA is zero, +*> the matrix elements of A need not be initialized by the caller. *> \endverbatim *> *> \param[in] LDA @@ -121,7 +142,10 @@ *> Before entry with TRANSB = 'N' or 'n', the leading k by n *> part of the array B must contain the matrix B, otherwise *> the leading n by k part of the array B must contain the -*> matrix B. +*> matrix B, except if ALPHA is zero. +*> If ALPHA is zero, none of the values in B affect the result, even +*> if they are NaN/Inf. This also implies that if ALPHA is zero, +*> the matrix elements of B need not be initialized by the caller. *> \endverbatim *> *> \param[in] LDB @@ -136,16 +160,19 @@ *> \param[in] BETA *> \verbatim *> BETA is REAL -*> On entry, BETA specifies the scalar beta. When BETA is -*> supplied as zero then C need not be set on input. +*> On entry, BETA specifies the scalar beta. If BETA is zero the +*> values in C do not affect the result. This also means that +*> NaN/Inf propagation from C is inhibited if BETA is zero. *> \endverbatim *> *> \param[in,out] C *> \verbatim *> C is REAL array, dimension ( LDC, N ) *> Before entry, the leading m by n part of the array C must -*> contain the matrix C, except when beta is zero, in which -*> case C need not be set on entry. +*> contain the matrix C, except if beta is zero. +*> If beta is zero, none of the values in C affect the result, even +*> if they are NaN/Inf. This also implies that if beta is zero, +*> the matrix elements of C need not be initialized by the caller. *> On exit, the array C is overwritten by the m by n matrix *> ( alpha*op( A )*op( B ) + beta*C ). *> \endverbatim @@ -166,9 +193,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level3 +*> \ingroup gemm * *> \par Further Details: * ===================== @@ -185,12 +210,13 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE SGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) + SUBROUTINE SGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB, + + BETA,C,LDC) + IMPLICIT NONE * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. REAL ALPHA,BETA @@ -215,7 +241,7 @@ SUBROUTINE SGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * .. * .. Local Scalars .. REAL TEMP - INTEGER I,INFO,J,L,NCOLA,NROWA,NROWB + INTEGER I,INFO,J,L,NROWA,NROWB LOGICAL NOTA,NOTB * .. * .. Parameters .. @@ -224,17 +250,15 @@ SUBROUTINE SGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * .. * * Set NOTA and NOTB as true if A and B respectively are not -* transposed and set NROWA, NCOLA and NROWB as the number of rows -* and columns of A and the number of rows of B respectively. +* transposed and set NROWA and NROWB as the number of rows of A +* and B respectively. * NOTA = LSAME(TRANSA,'N') NOTB = LSAME(TRANSB,'N') IF (NOTA) THEN NROWA = M - NCOLA = K ELSE NROWA = K - NCOLA = M END IF IF (NOTB) THEN NROWB = K @@ -379,6 +403,6 @@ SUBROUTINE SGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * RETURN * -* End of SGEMM . +* End of SGEMM * END diff --git a/BLAS/SRC/sgemmtr.f b/BLAS/SRC/sgemmtr.f new file mode 100644 index 0000000000..257ff8bde2 --- /dev/null +++ b/BLAS/SRC/sgemmtr.f @@ -0,0 +1,431 @@ +*> \brief \b SGEMMTR +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE SGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB,BETA, +* C,LDC) +* +* .. Scalar Arguments .. +* REAL ALPHA,BETA +* INTEGER K,LDA,LDB,LDC,N +* CHARACTER TRANSA,TRANSB, UPLO +* .. +* .. Array Arguments .. +* REAL A(LDA,*),B(LDB,*),C(LDC,*) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> SGEMMTR performs one of the matrix-matrix operations +*> +*> C := alpha*op( A )*op( B ) + beta*C, +*> +*> where op( X ) is one of +*> +*> op( X ) = X or op( X ) = X**T, +*> +*> alpha and beta are scalars, and A, B and C are matrices, with op( A ) +*> an n by k matrix, op( B ) a k by n matrix and C an n by n matrix. +*> Thereby, the routine only accesses and updates the upper or lower +*> triangular part of the result matrix C. This behaviour can be used if +*> the resulting matrix C is known to be symmetric. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] UPLO +*> \verbatim +*> UPLO is CHARACTER*1 +*> On entry, UPLO specifies whether the lower or the upper +*> triangular part of C is access and updated. +*> +*> UPLO = 'L' or 'l', the lower triangular part of C is used. +*> +*> UPLO = 'U' or 'u', the upper triangular part of C is used. +*> \endverbatim +* +*> \param[in] TRANSA +*> \verbatim +*> TRANSA is CHARACTER*1 +*> On entry, TRANSA specifies the form of op( A ) to be used in +*> the matrix multiplication as follows: +*> +*> TRANSA = 'N' or 'n', op( A ) = A. +*> +*> TRANSA = 'T' or 't', op( A ) = A**T. +*> +*> TRANSA = 'C' or 'c', op( A ) = A**T. +*> \endverbatim +*> +*> \param[in] TRANSB +*> \verbatim +*> TRANSB is CHARACTER*1 +*> On entry, TRANSB specifies the form of op( B ) to be used in +*> the matrix multiplication as follows: +*> +*> TRANSB = 'N' or 'n', op( B ) = B. +*> +*> TRANSB = 'T' or 't', op( B ) = B**T. +*> +*> TRANSB = 'C' or 'c', op( B ) = B**T. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> On entry, N specifies the number of rows and columns of +*> the matrix C, the number of columns of op(B) and the number +*> of rows of op(A). N must be at least zero. +*> \endverbatim +*> +*> \param[in] K +*> \verbatim +*> K is INTEGER +*> On entry, K specifies the number of columns of the matrix +*> op( A ) and the number of rows of the matrix op( B ). K must +*> be at least zero. +*> \endverbatim +*> +*> \param[in] ALPHA +*> \verbatim +*> ALPHA is REAL. +*> On entry, ALPHA specifies the scalar alpha. +*> \endverbatim +*> +*> \param[in] A +*> \verbatim +*> A is REAL array, dimension ( LDA, ka ), where ka is +*> k when TRANSA = 'N' or 'n', and is n otherwise. +*> Before entry with TRANSA = 'N' or 'n', the leading n by k +*> part of the array A must contain the matrix A, otherwise +*> the leading k by m part of the array A must contain the +*> matrix A. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> On entry, LDA specifies the first dimension of A as declared +*> in the calling (sub) program. When TRANSA = 'N' or 'n' then +*> LDA must be at least max( 1, n ), otherwise LDA must be at +*> least max( 1, k ). +*> \endverbatim +*> +*> \param[in] B +*> \verbatim +*> B is REAL array, dimension ( LDB, kb ), where kb is +*> n when TRANSB = 'N' or 'n', and is k otherwise. +*> Before entry with TRANSB = 'N' or 'n', the leading k by n +*> part of the array B must contain the matrix B, otherwise +*> the leading n by k part of the array B must contain the +*> matrix B. +*> \endverbatim +*> +*> \param[in] LDB +*> \verbatim +*> LDB is INTEGER +*> On entry, LDB specifies the first dimension of B as declared +*> in the calling (sub) program. When TRANSB = 'N' or 'n' then +*> LDB must be at least max( 1, k ), otherwise LDB must be at +*> least max( 1, n ). +*> \endverbatim +*> +*> \param[in] BETA +*> \verbatim +*> BETA is REAL. +*> On entry, BETA specifies the scalar beta. When BETA is +*> supplied as zero then C need not be set on input. +*> \endverbatim +*> +*> \param[in,out] C +*> \verbatim +*> C is REAL array, dimension ( LDC, N ) +*> Before entry, the leading n by n part of the array C must +*> contain the matrix C, except when beta is zero, in which +*> case C need not be set on entry. +*> On exit, the upper or lower triangular part of the matrix +*> C is overwritten by the n by n matrix +*> ( alpha*op( A )*op( B ) + beta*C ). +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> On entry, LDC specifies the first dimension of C as declared +*> in the calling (sub) program. LDC must be at least +*> max( 1, n ). +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Martin Koehler +* +*> \ingroup gemmtr +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> Level 3 Blas routine. +*> +*> -- Written on 19-July-2023. +*> Martin Koehler, MPI Magdeburg +*> \endverbatim +*> +* ===================================================================== + SUBROUTINE SGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB, + + BETA,C,LDC) + IMPLICIT NONE +* +* -- Reference BLAS level3 routine -- +* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + REAL ALPHA,BETA + INTEGER K,LDA,LDB,LDC,N + CHARACTER TRANSA,TRANSB,UPLO +* .. +* .. Array Arguments .. + REAL A(LDA,*),B(LDB,*),C(LDC,*) +* .. +* +* ===================================================================== +* +* .. External Functions .. + LOGICAL LSAME + EXTERNAL LSAME +* .. +* .. External Subroutines .. + EXTERNAL XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. +* .. Local Scalars .. + REAL TEMP + INTEGER I,INFO,J,L,NROWA,NROWB, ISTART, ISTOP + LOGICAL NOTA,NOTB, UPPER +* .. +* .. Parameters .. + REAL ONE,ZERO + PARAMETER (ONE=1.0D+0,ZERO=0.0D+0) +* .. +* +* Set NOTA and NOTB as true if A and B respectively are not +* transposed and set NROWA and NROWB as the number of rows of A +* and B respectively. +* + NOTA = LSAME(TRANSA,'N') + NOTB = LSAME(TRANSB,'N') + IF (NOTA) THEN + NROWA = N + ELSE + NROWA = K + END IF + IF (NOTB) THEN + NROWB = K + ELSE + NROWB = N + END IF + UPPER = LSAME(UPLO, 'U') +* +* Test the input parameters. +* + INFO = 0 + IF ((.NOT. UPPER) .AND. (.NOT. LSAME(UPLO, 'L'))) THEN + INFO = 1 + ELSE IF ((.NOT.NOTA) .AND. (.NOT.LSAME(TRANSA,'C')) .AND. + + (.NOT.LSAME(TRANSA,'T'))) THEN + INFO = 2 + ELSE IF ((.NOT.NOTB) .AND. (.NOT.LSAME(TRANSB,'C')) .AND. + + (.NOT.LSAME(TRANSB,'T'))) THEN + INFO = 3 + ELSE IF (N.LT.0) THEN + INFO = 4 + ELSE IF (K.LT.0) THEN + INFO = 5 + ELSE IF (LDA.LT.MAX(1,NROWA)) THEN + INFO = 8 + ELSE IF (LDB.LT.MAX(1,NROWB)) THEN + INFO = 10 + ELSE IF (LDC.LT.MAX(1,N)) THEN + INFO = 13 + END IF + IF (INFO.NE.0) THEN + CALL XERBLA('SGEMMTR',INFO) + RETURN + END IF +* +* Quick return if possible. +* + IF (N.EQ.0) RETURN +* +* And if alpha.eq.zero. +* + IF (ALPHA.EQ.ZERO) THEN + IF (BETA.EQ.ZERO) THEN + DO 20 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 10 I = ISTART, ISTOP + C(I,J) = ZERO + 10 CONTINUE + 20 CONTINUE + ELSE + DO 40 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 30 I = ISTART, ISTOP + C(I,J) = BETA*C(I,J) + 30 CONTINUE + 40 CONTINUE + END IF + RETURN + END IF +* +* Start the operations. +* + IF (NOTB) THEN + IF (NOTA) THEN +* +* Form C := alpha*A*B + beta*C. +* + DO 90 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + IF (BETA.EQ.ZERO) THEN + DO 50 I = ISTART, ISTOP + C(I,J) = ZERO + 50 CONTINUE + ELSE IF (BETA.NE.ONE) THEN + DO 60 I = ISTART, ISTOP + C(I,J) = BETA*C(I,J) + 60 CONTINUE + END IF + DO 80 L = 1,K + TEMP = ALPHA*B(L,J) + DO 70 I = ISTART, ISTOP + C(I,J) = C(I,J) + TEMP*A(I,L) + 70 CONTINUE + 80 CONTINUE + 90 CONTINUE + ELSE +* +* Form C := alpha*A**T*B + beta*C +* + DO 120 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 110 I = ISTART, ISTOP + TEMP = ZERO + DO 100 L = 1,K + TEMP = TEMP + A(L,I)*B(L,J) + 100 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP + ELSE + C(I,J) = ALPHA*TEMP + BETA*C(I,J) + END IF + 110 CONTINUE + 120 CONTINUE + END IF + ELSE + IF (NOTA) THEN +* +* Form C := alpha*A*B**T + beta*C +* + DO 170 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + IF (BETA.EQ.ZERO) THEN + DO 130 I = ISTART,ISTOP + C(I,J) = ZERO + 130 CONTINUE + ELSE IF (BETA.NE.ONE) THEN + DO 140 I = ISTART,ISTOP + C(I,J) = BETA*C(I,J) + 140 CONTINUE + END IF + DO 160 L = 1,K + TEMP = ALPHA*B(J,L) + DO 150 I = ISTART,ISTOP + C(I,J) = C(I,J) + TEMP*A(I,L) + 150 CONTINUE + 160 CONTINUE + 170 CONTINUE + ELSE +* +* Form C := alpha*A**T*B**T + beta*C +* + DO 200 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 190 I = ISTART, ISTOP + TEMP = ZERO + DO 180 L = 1,K + TEMP = TEMP + A(L,I)*B(J,L) + 180 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP + ELSE + C(I,J) = ALPHA*TEMP + BETA*C(I,J) + END IF + 190 CONTINUE + 200 CONTINUE + END IF + END IF +* + RETURN +* +* End of SGEMMTR +* + END diff --git a/BLAS/SRC/sgemv.f b/BLAS/SRC/sgemv.f index a76913860f..07efa04307 100644 --- a/BLAS/SRC/sgemv.f +++ b/BLAS/SRC/sgemv.f @@ -117,6 +117,8 @@ *> Before entry with BETA non-zero, the incremented array Y *> must contain the vector y. On exit, Y is overwritten by the *> updated vector y. +*> If either m or n is zero, then Y not referenced and the function +*> performs a quick return. *> \endverbatim *> *> \param[in] INCY @@ -134,9 +136,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level2 +*> \ingroup gemv * *> \par Further Details: * ===================== @@ -155,11 +155,11 @@ *> * ===================================================================== SUBROUTINE SGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. REAL ALPHA,BETA @@ -325,6 +325,6 @@ SUBROUTINE SGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) * RETURN * -* End of SGEMV . +* End of SGEMV * END diff --git a/BLAS/SRC/sger.f b/BLAS/SRC/sger.f index 7dbff21d32..befc1e3390 100644 --- a/BLAS/SRC/sger.f +++ b/BLAS/SRC/sger.f @@ -109,9 +109,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level2 +*> \ingroup ger * *> \par Further Details: * ===================== @@ -129,11 +127,11 @@ *> * ===================================================================== SUBROUTINE SGER(M,N,ALPHA,X,INCX,Y,INCY,A,LDA) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. REAL ALPHA @@ -222,6 +220,6 @@ SUBROUTINE SGER(M,N,ALPHA,X,INCX,Y,INCY,A,LDA) * RETURN * -* End of SGER . +* End of SGER * END diff --git a/BLAS/SRC/snrm2.f b/BLAS/SRC/snrm2.f deleted file mode 100644 index 17027a754c..0000000000 --- a/BLAS/SRC/snrm2.f +++ /dev/null @@ -1,132 +0,0 @@ -*> \brief \b SNRM2 -* -* =========== DOCUMENTATION =========== -* -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ -* -* Definition: -* =========== -* -* REAL FUNCTION SNRM2(N,X,INCX) -* -* .. Scalar Arguments .. -* INTEGER INCX,N -* .. -* .. Array Arguments .. -* REAL X(*) -* .. -* -* -*> \par Purpose: -* ============= -*> -*> \verbatim -*> -*> SNRM2 returns the euclidean norm of a vector via the function -*> name, so that -*> -*> SNRM2 := sqrt( x'*x ). -*> \endverbatim -* -* Arguments: -* ========== -* -*> \param[in] N -*> \verbatim -*> N is INTEGER -*> number of elements in input vector(s) -*> \endverbatim -*> -*> \param[in] X -*> \verbatim -*> X is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) -*> \endverbatim -*> -*> \param[in] INCX -*> \verbatim -*> INCX is INTEGER -*> storage spacing between elements of SX -*> \endverbatim -* -* Authors: -* ======== -* -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. -* -*> \date December 2016 -* -*> \ingroup single_blas_level1 -* -*> \par Further Details: -* ===================== -*> -*> \verbatim -*> -*> -- This version written on 25-October-1982. -*> Modified on 14-October-1993 to inline the call to SLASSQ. -*> Sven Hammarling, Nag Ltd. -*> \endverbatim -*> -* ===================================================================== - REAL FUNCTION SNRM2(N,X,INCX) -* -* -- Reference BLAS level1 routine (version 3.7.0) -- -* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 -* -* .. Scalar Arguments .. - INTEGER INCX,N -* .. -* .. Array Arguments .. - REAL X(*) -* .. -* -* ===================================================================== -* -* .. Parameters .. - REAL ONE,ZERO - PARAMETER (ONE=1.0E+0,ZERO=0.0E+0) -* .. -* .. Local Scalars .. - REAL ABSXI,NORM,SCALE,SSQ - INTEGER IX -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS,SQRT -* .. - IF (N.LT.1 .OR. INCX.LT.1) THEN - NORM = ZERO - ELSE IF (N.EQ.1) THEN - NORM = ABS(X(1)) - ELSE - SCALE = ZERO - SSQ = ONE -* The following loop is equivalent to this call to the LAPACK -* auxiliary routine: -* CALL SLASSQ( N, X, INCX, SCALE, SSQ ) -* - DO 10 IX = 1,1 + (N-1)*INCX,INCX - IF (X(IX).NE.ZERO) THEN - ABSXI = ABS(X(IX)) - IF (SCALE.LT.ABSXI) THEN - SSQ = ONE + SSQ* (SCALE/ABSXI)**2 - SCALE = ABSXI - ELSE - SSQ = SSQ + (ABSXI/SCALE)**2 - END IF - END IF - 10 CONTINUE - NORM = SCALE*SQRT(SSQ) - END IF -* - SNRM2 = NORM - RETURN -* -* End of SNRM2. -* - END diff --git a/BLAS/SRC/snrm2.f90 b/BLAS/SRC/snrm2.f90 new file mode 100644 index 0000000000..1e849f19b6 --- /dev/null +++ b/BLAS/SRC/snrm2.f90 @@ -0,0 +1,200 @@ +!> \brief \b SNRM2 +! +! =========== DOCUMENTATION =========== +! +! Online html documentation available at +! http://www.netlib.org/lapack/explore-html/ +! +! Definition: +! =========== +! +! REAL FUNCTION SNRM2(N,X,INCX) +! +! .. Scalar Arguments .. +! INTEGER INCX,N +! .. +! .. Array Arguments .. +! REAL X(*) +! .. +! +! +!> \par Purpose: +! ============= +!> +!> \verbatim +!> +!> SNRM2 returns the euclidean norm of a vector via the function +!> name, so that +!> +!> SNRM2 := sqrt( x'*x ). +!> \endverbatim +! +! Arguments: +! ========== +! +!> \param[in] N +!> \verbatim +!> N is INTEGER +!> number of elements in input vector(s) +!> \endverbatim +!> +!> \param[in] X +!> \verbatim +!> X is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) +!> \endverbatim +!> +!> \param[in] INCX +!> \verbatim +!> INCX is INTEGER, storage spacing between elements of X +!> If INCX > 0, X(1+(i-1)*INCX) = x(i) for 1 <= i <= n +!> If INCX < 0, X(1-(n-i)*INCX) = x(i) for 1 <= i <= n +!> If INCX = 0, x isn't a vector so there is no need to call +!> this subroutine. If you call it anyway, it will count x(1) +!> in the vector norm N times. +!> \endverbatim +! +! Authors: +! ======== +! +!> \author Edward Anderson, Lockheed Martin +! +!> \date August 2016 +! +!> \ingroup nrm2 +! +!> \par Contributors: +! ================== +!> +!> Weslley Pereira, University of Colorado Denver, USA +! +!> \par Further Details: +! ===================== +!> +!> \verbatim +!> +!> Anderson E. (2017) +!> Algorithm 978: Safe Scaling in the Level 1 BLAS +!> ACM Trans Math Softw 44:1--28 +!> https://doi.org/10.1145/3061665 +!> +!> Blue, James L. (1978) +!> A Portable Fortran Program to Find the Euclidean Norm of a Vector +!> ACM Trans Math Softw 4:15--23 +!> https://doi.org/10.1145/355769.355771 +!> +!> \endverbatim +!> +! ===================================================================== +function SNRM2( n, x, incx ) + implicit none + integer, parameter :: wp = kind(1.e0) + real(wp) :: SNRM2 +! +! -- Reference BLAS level1 routine -- +! -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +! -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +! March 2021 +! +! .. Constants .. + real(wp), parameter :: zero = 0.0_wp + real(wp), parameter :: one = 1.0_wp + real(wp), parameter :: maxN = huge(0.0_wp) +! .. +! .. Blue's scaling constants .. + real(wp), parameter :: tsml = real(radix(0._wp), wp)**ceiling( & + (minexponent(0._wp) - 1) * 0.5_wp) + real(wp), parameter :: tbig = real(radix(0._wp), wp)**floor( & + (maxexponent(0._wp) - digits(0._wp) + 1) * 0.5_wp) + real(wp), parameter :: ssml = real(radix(0._wp), wp)**( - floor( & + (minexponent(0._wp) - digits(0._wp)) * 0.5_wp)) + real(wp), parameter :: sbig = real(radix(0._wp), wp)**( - ceiling( & + (maxexponent(0._wp) + digits(0._wp) - 1) * 0.5_wp)) +! .. +! .. Scalar Arguments .. + integer :: incx, n +! .. +! .. Array Arguments .. + real(wp) :: x(*) +! .. +! .. Local Scalars .. + integer :: i, ix + logical :: notbig + real(wp) :: abig, amed, asml, ax, scl, sumsq, ymax, ymin +! +! Quick return if possible +! + SNRM2 = zero + if( n <= 0 ) return +! + scl = one + sumsq = zero +! +! Compute the sum of squares in 3 accumulators: +! abig -- sums of squares scaled down to avoid overflow +! asml -- sums of squares scaled up to avoid underflow +! amed -- sums of squares that do not require scaling +! The thresholds and multipliers are +! tbig -- values bigger than this are scaled down by sbig +! tsml -- values smaller than this are scaled up by ssml +! + notbig = .true. + asml = zero + amed = zero + abig = zero + ix = 1 + if( incx < 0 ) ix = 1 - (n-1)*incx + do i = 1, n + ax = abs(x(ix)) + if (ax > tbig) then + abig = abig + (ax*sbig)**2 + notbig = .false. + else if (ax < tsml) then + if (notbig) asml = asml + (ax*ssml)**2 + else + amed = amed + ax**2 + end if + ix = ix + incx + end do +! +! Combine abig and amed or amed and asml if more than one +! accumulator was used. +! + if (abig > zero) then +! +! Combine abig and amed if abig > 0. +! + if ( (amed > zero) .or. (amed > maxN) .or. (amed /= amed) ) then + abig = abig + (amed*sbig)*sbig + end if + scl = one / sbig + sumsq = abig + else if (asml > zero) then +! +! Combine amed and asml if asml > 0. +! + if ( (amed > zero) .or. (amed > maxN) .or. (amed /= amed) ) then + amed = sqrt(amed) + asml = sqrt(asml) / ssml + if (asml > amed) then + ymin = amed + ymax = asml + else + ymin = asml + ymax = amed + end if + scl = one + sumsq = ymax**2*( one + (ymin/ymax)**2 ) + else + scl = one / ssml + sumsq = asml + end if + else +! +! Otherwise all values are mid-range +! + scl = one + sumsq = amed + end if + SNRM2 = scl*sqrt( sumsq ) + return +end function diff --git a/BLAS/SRC/srot.f b/BLAS/SRC/srot.f index 71235cd9d6..2a778906f1 100644 --- a/BLAS/SRC/srot.f +++ b/BLAS/SRC/srot.f @@ -76,9 +76,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level1 +*> \ingroup rot * *> \par Further Details: * ===================== @@ -91,11 +89,11 @@ *> * ===================================================================== SUBROUTINE SROT(N,SX,INCX,SY,INCY,C,S) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. REAL C,S @@ -139,4 +137,7 @@ SUBROUTINE SROT(N,SX,INCX,SY,INCY,C,S) END DO END IF RETURN +* +* End of SROT +* END diff --git a/BLAS/SRC/srotg.f b/BLAS/SRC/srotg.f deleted file mode 100644 index 471fc54d91..0000000000 --- a/BLAS/SRC/srotg.f +++ /dev/null @@ -1,109 +0,0 @@ -*> \brief \b SROTG -* -* =========== DOCUMENTATION =========== -* -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ -* -* Definition: -* =========== -* -* SUBROUTINE SROTG(SA,SB,C,S) -* -* .. Scalar Arguments .. -* REAL C,S,SA,SB -* .. -* -* -*> \par Purpose: -* ============= -*> -*> \verbatim -*> -*> SROTG construct givens plane rotation. -*> \endverbatim -* -* Arguments: -* ========== -* -*> \param[in] SA -*> \verbatim -*> SA is REAL -*> \endverbatim -*> -*> \param[in] SB -*> \verbatim -*> SB is REAL -*> \endverbatim -*> -*> \param[out] C -*> \verbatim -*> C is REAL -*> \endverbatim -*> -*> \param[out] S -*> \verbatim -*> S is REAL -*> \endverbatim -* -* Authors: -* ======== -* -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. -* -*> \date December 2016 -* -*> \ingroup single_blas_level1 -* -*> \par Further Details: -* ===================== -*> -*> \verbatim -*> -*> jack dongarra, linpack, 3/11/78. -*> \endverbatim -*> -* ===================================================================== - SUBROUTINE SROTG(SA,SB,C,S) -* -* -- Reference BLAS level1 routine (version 3.7.0) -- -* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 -* -* .. Scalar Arguments .. - REAL C,S,SA,SB -* .. -* -* ===================================================================== -* -* .. Local Scalars .. - REAL R,ROE,SCALE,Z -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS,SIGN,SQRT -* .. - ROE = SB - IF (ABS(SA).GT.ABS(SB)) ROE = SA - SCALE = ABS(SA) + ABS(SB) - IF (SCALE.EQ.0.0) THEN - C = 1.0 - S = 0.0 - R = 0.0 - Z = 0.0 - ELSE - R = SCALE*SQRT((SA/SCALE)**2+ (SB/SCALE)**2) - R = SIGN(1.0,ROE)*R - C = SA/R - S = SB/R - Z = 1.0 - IF (ABS(SA).GT.ABS(SB)) Z = S - IF (ABS(SB).GE.ABS(SA) .AND. C.NE.0.0) Z = 1.0/C - END IF - SA = R - SB = Z - RETURN - END diff --git a/BLAS/SRC/srotg.f90 b/BLAS/SRC/srotg.f90 new file mode 100644 index 0000000000..93b2e2b54e --- /dev/null +++ b/BLAS/SRC/srotg.f90 @@ -0,0 +1,151 @@ +!> \brief \b SROTG +! +! =========== DOCUMENTATION =========== +! +! Online html documentation available at +! http://www.netlib.org/lapack/explore-html/ +! +!> \par Purpose: +! ============= +!> +!> \verbatim +!> +!> SROTG constructs a plane rotation +!> [ c s ] [ a ] = [ r ] +!> [ -s c ] [ b ] [ 0 ] +!> satisfying c**2 + s**2 = 1. +!> +!> The computation uses the formulas +!> sigma = sgn(a) if |a| > |b| +!> = sgn(b) if |b| >= |a| +!> r = sigma*sqrt( a**2 + b**2 ) +!> c = 1; s = 0 if r = 0 +!> c = a/r; s = b/r if r != 0 +!> The subroutine also computes +!> z = s if |a| > |b|, +!> = 1/c if |b| >= |a| and c != 0 +!> = 1 if c = 0 +!> This allows c and s to be reconstructed from z as follows: +!> If z = 1, set c = 0, s = 1. +!> If |z| < 1, set c = sqrt(1 - z**2) and s = z. +!> If |z| > 1, set c = 1/z and s = sqrt( 1 - c**2). +!> +!> \endverbatim +!> +!> @see lartg, @see lartgp +! +! Arguments: +! ========== +! +!> \param[in,out] A +!> \verbatim +!> A is REAL +!> On entry, the scalar a. +!> On exit, the scalar r. +!> \endverbatim +!> +!> \param[in,out] B +!> \verbatim +!> B is REAL +!> On entry, the scalar b. +!> On exit, the scalar z. +!> \endverbatim +!> +!> \param[out] C +!> \verbatim +!> C is REAL +!> The scalar c. +!> \endverbatim +!> +!> \param[out] S +!> \verbatim +!> S is REAL +!> The scalar s. +!> \endverbatim +! +! Authors: +! ======== +! +!> \author Edward Anderson, Lockheed Martin +! +!> \par Contributors: +! ================== +!> +!> Weslley Pereira, University of Colorado Denver, USA +! +!> \ingroup rotg +! +!> \par Further Details: +! ===================== +!> +!> \verbatim +!> +!> Anderson E. (2017) +!> Algorithm 978: Safe Scaling in the Level 1 BLAS +!> ACM Trans Math Softw 44:1--28 +!> https://doi.org/10.1145/3061665 +!> +!> \endverbatim +! +! ===================================================================== +subroutine SROTG( a, b, c, s ) + implicit none + integer, parameter :: wp = kind(1.e0) +! +! -- Reference BLAS level1 routine -- +! -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +! -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +! +! .. Constants .. + real(wp), parameter :: zero = 0.0_wp + real(wp), parameter :: one = 1.0_wp +! .. +! .. Scaling constants .. + real(wp), parameter :: safmin = real(radix(0._wp),wp)**max( & + minexponent(0._wp)-1, & + 1-maxexponent(0._wp) & + ) + real(wp), parameter :: safmax = real(radix(0._wp),wp)**max( & + 1-minexponent(0._wp), & + maxexponent(0._wp)-1 & + ) +! .. +! .. Scalar Arguments .. + real(wp) :: a, b, c, s +! .. +! .. Local Scalars .. + real(wp) :: anorm, bnorm, scl, sigma, r, z +! .. + anorm = abs(a) + bnorm = abs(b) + if( bnorm == zero ) then + c = one + s = zero + b = zero + else if( anorm == zero ) then + c = zero + s = one + a = b + b = one + else + scl = min( safmax, max( safmin, anorm, bnorm ) ) + if( anorm > bnorm ) then + sigma = sign(one,a) + else + sigma = sign(one,b) + end if + r = sigma*( scl*sqrt((a/scl)**2 + (b/scl)**2) ) + c = a/r + s = b/r + if( anorm > bnorm ) then + z = s + else if( c /= zero ) then + z = one/c + else + z = one + end if + a = r + b = z + end if + return +end subroutine diff --git a/BLAS/SRC/srotm.f b/BLAS/SRC/srotm.f index 6074ec6fab..f5c2e3c9cd 100644 --- a/BLAS/SRC/srotm.f +++ b/BLAS/SRC/srotm.f @@ -39,6 +39,9 @@ *> (SH21 SH22), (SH21 1.E0), (-1.E0 SH22), (0.E0 1.E0). *> SEE SROTMG FOR A DESCRIPTION OF DATA STORAGE IN SPARAM. *> +*> IF SFLAG IS NOT ONE OF THE LISTED ABOVE, THE BEHAVIOR IS UNDEFINED. +*> NANS IN SFLAG MAY NOT PROPAGATE TO THE OUTPUT. +*> *> \endverbatim * * Arguments: @@ -90,17 +93,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level1 +*> \ingroup rotm * * ===================================================================== SUBROUTINE SROTM(N,SX,INCX,SY,INCY,SPARAM) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,INCY,N @@ -198,4 +199,7 @@ SUBROUTINE SROTM(N,SX,INCX,SY,INCY,SPARAM) END IF END IF RETURN +* +* End of SROTM +* END diff --git a/BLAS/SRC/srotmg.f b/BLAS/SRC/srotmg.f index f167241b29..0a956db8c4 100644 --- a/BLAS/SRC/srotmg.f +++ b/BLAS/SRC/srotmg.f @@ -24,15 +24,19 @@ *> \verbatim *> *> CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS -*> THE SECOND COMPONENT OF THE 2-VECTOR (SQRT(SD1)*SX1,SQRT(SD2)*> SY2)**T. -*> WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS.. +*> THE SECOND COMPONENT OF THE 2-VECTOR +*> (SQRT(SD1)*SX1,SQRT(SD2)*SY2)**T +*> WITH SPARAM(1)=SFLAG. *> -*> SFLAG=-1.E0 SFLAG=0.E0 SFLAG=1.E0 SFLAG=-2.E0 +*> H HAS ONE OF THE FOLLOWING FORMS: +*> +*> SFLAG=-1.E0 SFLAG=0.E0 SFLAG=1.E0 SFLAG=-2.E0 *> *> (SH11 SH12) (1.E0 SH12) (SH11 1.E0) (1.E0 0.E0) *> H=( ) ( ) ( ) ( ) *> (SH21 SH22), (SH21 1.E0), (-1.E0 SH22), (0.E0 1.E0). -*> LOCATIONS 2-4 OF SPARAM CONTAIN SH11,SH21,SH12, AND SH22 +*> +*> LOCATIONS 2-4 OF SPARAM CONTAIN SH11, SH21, SH12, AND SH22 *> RESPECTIVELY. (VALUES OF 1.E0, -1.E0, OR 0.E0 IMPLIED BY THE *> VALUE OF SPARAM(1) ARE NOT STORED IN SPARAM.) *> @@ -83,17 +87,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level1 +*> \ingroup rotmg * * ===================================================================== SUBROUTINE SROTMG(SD1,SD2,SX1,SY1,SPARAM) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. REAL SD1,SD2,SX1,SY1 @@ -152,6 +154,19 @@ SUBROUTINE SROTMG(SD1,SD2,SX1,SY1,SPARAM) SD1 = SD1/SU SD2 = SD2/SU SX1 = SX1*SU + ELSE +* This code path if here for safety. We do not expect this +* condition to ever hold except in edge cases with rounding +* errors. See DOI: 10.1145/355841.355847 + SFLAG = -ONE + SH11 = ZERO + SH12 = ZERO + SH21 = ZERO + SH22 = ZERO +* + SD1 = ZERO + SD2 = ZERO + SX1 = ZERO END IF ELSE @@ -178,14 +193,14 @@ SUBROUTINE SROTMG(SD1,SD2,SX1,SY1,SPARAM) END IF END IF -* PROCESURE..SCALE-CHECK +* PROCEDURE..SCALE-CHECK IF (SD1.NE.ZERO) THEN DO WHILE ((SD1.LE.RGAMSQ) .OR. (SD1.GE.GAMSQ)) IF (SFLAG.EQ.ZERO) THEN SH11 = ONE SH22 = ONE SFLAG = -ONE - ELSE + ELSE IF (SFLAG.EQ.ONE) THEN SH21 = -ONE SH12 = ONE SFLAG = -ONE @@ -210,7 +225,7 @@ SUBROUTINE SROTMG(SD1,SD2,SX1,SY1,SPARAM) SH11 = ONE SH22 = ONE SFLAG = -ONE - ELSE + ELSE IF (SFLAG.EQ.ONE) THEN SH21 = -ONE SH12 = ONE SFLAG = -ONE @@ -244,8 +259,7 @@ SUBROUTINE SROTMG(SD1,SD2,SX1,SY1,SPARAM) SPARAM(1) = SFLAG RETURN +* +* End of SROTMG +* END - - - - diff --git a/BLAS/SRC/ssbmv.f b/BLAS/SRC/ssbmv.f index f0e2100523..487a610626 100644 --- a/BLAS/SRC/ssbmv.f +++ b/BLAS/SRC/ssbmv.f @@ -162,9 +162,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level2 +*> \ingroup hbmv * *> \par Further Details: * ===================== @@ -183,11 +181,11 @@ *> * ===================================================================== SUBROUTINE SSBMV(UPLO,N,K,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. REAL ALPHA,BETA @@ -370,6 +368,6 @@ SUBROUTINE SSBMV(UPLO,N,K,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) * RETURN * -* End of SSBMV . +* End of SSBMV * END diff --git a/BLAS/SRC/sscal.f b/BLAS/SRC/sscal.f index 1a81109e1c..1079418637 100644 --- a/BLAS/SRC/sscal.f +++ b/BLAS/SRC/sscal.f @@ -62,9 +62,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level1 +*> \ingroup scal * *> \par Further Details: * ===================== @@ -78,11 +76,11 @@ *> * ===================================================================== SUBROUTINE SSCAL(N,SA,SX,INCX) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. REAL SA @@ -97,10 +95,14 @@ SUBROUTINE SSCAL(N,SA,SX,INCX) * .. Local Scalars .. INTEGER I,M,MP1,NINCX * .. +* .. Parameters .. + REAL ONE + PARAMETER (ONE=1.0E+0) +* .. * .. Intrinsic Functions .. INTRINSIC MOD * .. - IF (N.LE.0 .OR. INCX.LE.0) RETURN + IF (N.LE.0 .OR. INCX.LE.0 .OR. SA.EQ.ONE) RETURN IF (INCX.EQ.1) THEN * * code for increment equal to 1 @@ -133,4 +135,7 @@ SUBROUTINE SSCAL(N,SA,SX,INCX) END DO END IF RETURN +* +* End of SSCAL +* END diff --git a/BLAS/SRC/sskewsymm.f b/BLAS/SRC/sskewsymm.f new file mode 100644 index 0000000000..1ecc4b967d --- /dev/null +++ b/BLAS/SRC/sskewsymm.f @@ -0,0 +1,365 @@ +*> \brief \b SSKEWSYMM +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE SSKEWSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC) +* +* .. Scalar Arguments .. +* REAL ALPHA,BETA +* INTEGER LDA,LDB,LDC,M,N +* CHARACTER SIDE,UPLO +* .. +* .. Array Arguments .. +* REAL A(LDA,*),B(LDB,*),C(LDC,*) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> SSKEWSYMM performs one of the matrix-matrix operations +*> +*> C := alpha*A*B + beta*C, +*> +*> or +*> +*> C := alpha*B*A + beta*C, +*> +*> where alpha and beta are scalars, A is a skew-symmetric matrix and B and +*> C are m by n matrices. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] SIDE +*> \verbatim +*> SIDE is CHARACTER*1 +*> On entry, SIDE specifies whether the skew-symmetric matrix A +*> appears on the left or right in the operation as follows: +*> +*> SIDE = 'L' or 'l' C := alpha*A*B + beta*C, +*> +*> SIDE = 'R' or 'r' C := alpha*B*A + beta*C, +*> \endverbatim +*> +*> \param[in] UPLO +*> \verbatim +*> UPLO is CHARACTER*1 +*> On entry, UPLO specifies whether the upper or lower +*> triangular part of the skew-symmetric matrix A is to be +*> referenced as follows: +*> +*> UPLO = 'U' or 'u' Only the upper triangular part of the +*> skew-symmetric matrix is to be referenced. +*> +*> UPLO = 'L' or 'l' Only the lower triangular part of the +*> skew-symmetric matrix is to be referenced. +*> \endverbatim +*> +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> On entry, M specifies the number of rows of the matrix C. +*> M must be at least zero. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> On entry, N specifies the number of columns of the matrix C. +*> N must be at least zero. +*> \endverbatim +*> +*> \param[in] ALPHA +*> \verbatim +*> ALPHA is REAL +*> On entry, ALPHA specifies the scalar alpha. +*> \endverbatim +*> +*> \param[in] A +*> \verbatim +*> A is REAL array, dimension ( LDA, ka ), where ka is +*> m when SIDE = 'L' or 'l' and is n otherwise. +*> Before entry with SIDE = 'L' or 'l', the m by m part of +*> the array A must contain the skew-symmetric matrix, such that +*> when UPLO = 'U' or 'u', the strictly m by m upper triangular +*> part of the array A must contain the upper triangular part +*> of the skew-symmetric matrix and the leading lower triangular +*> part of A is not referenced, and when UPLO = 'L' or 'l', +*> the strictly m by m lower triangular part of the array A +*> must contain the lower triangular part of the skew-symmetric +*> matrix and the leading upper triangular part of A is not +*> referenced. +*> Before entry with SIDE = 'R' or 'r', the n by n part of +*> the array A must contain the skew-symmetric matrix, such that +*> when UPLO = 'U' or 'u', the strictly n by n upper triangular +*> part of the array A must contain the upper triangular part +*> of the skew-symmetric matrix and the leading lower triangular +*> part of A is not referenced, and when UPLO = 'L' or 'l', +*> the strictly n by n lower triangular part of the array A +*> must contain the lower triangular part of the skew-symmetric +*> matrix and the leading upper triangular part of A is not +*> referenced. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> On entry, LDA specifies the first dimension of A as declared +*> in the calling (sub) program. When SIDE = 'L' or 'l' then +*> LDA must be at least max( 1, m ), otherwise LDA must be at +*> least max( 1, n ). +*> \endverbatim +*> +*> \param[in] B +*> \verbatim +*> B is REAL array, dimension ( LDB, N ) +*> Before entry, the leading m by n part of the array B must +*> contain the matrix B. +*> \endverbatim +*> +*> \param[in] LDB +*> \verbatim +*> LDB is INTEGER +*> On entry, LDB specifies the first dimension of B as declared +*> in the calling (sub) program. LDB must be at least +*> max( 1, m ). +*> \endverbatim +*> +*> \param[in] BETA +*> \verbatim +*> BETA is REAL +*> On entry, BETA specifies the scalar beta. When BETA is +*> supplied as zero then C need not be set on input. +*> \endverbatim +*> +*> \param[in,out] C +*> \verbatim +*> C is REAL array, dimension ( LDC, N ) +*> Before entry, the leading m by n part of the array C must +*> contain the matrix C, except when beta is zero, in which +*> case C need not be set on entry. +*> On exit, the array C is overwritten by the m by n updated +*> matrix. +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> On entry, LDC specifies the first dimension of C as declared +*> in the calling (sub) program. LDC must be at least +*> max( 1, m ). +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup skewhemm +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> Level 3 Blas routine. +*> Derived from subroutine ssymm. +*> +*> -- Written on 6-Jul-2025. +*> Shuo Zheng, China. +*> \endverbatim +*> +* ===================================================================== + SUBROUTINE SSKEWSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B, + + LDB,BETA,C,LDC) + IMPLICIT NONE +* +* -- Reference BLAS level3 routine -- +* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + REAL ALPHA,BETA + INTEGER LDA,LDB,LDC,M,N + CHARACTER SIDE,UPLO +* .. +* .. Array Arguments .. + REAL A(LDA,*),B(LDB,*),C(LDC,*) +* .. +* +* ===================================================================== +* +* .. External Functions .. + LOGICAL LSAME + EXTERNAL LSAME +* .. +* .. External Subroutines .. + EXTERNAL XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. +* .. Local Scalars .. + REAL TEMP1,TEMP2 + INTEGER I,INFO,J,K,NROWA + LOGICAL UPPER +* .. +* .. Parameters .. + REAL ONE,ZERO + PARAMETER (ONE=1.0E+0,ZERO=0.0E+0) +* .. +* +* Set NROWA as the number of rows of A. +* + IF (LSAME(SIDE,'L')) THEN + NROWA = M + ELSE + NROWA = N + END IF + UPPER = LSAME(UPLO,'U') +* +* Test the input parameters. +* + INFO = 0 + IF ((.NOT.LSAME(SIDE,'L')) .AND. + + (.NOT.LSAME(SIDE,'R'))) THEN + INFO = 1 + ELSE IF ((.NOT.UPPER) .AND. + + (.NOT.LSAME(UPLO,'L'))) THEN + INFO = 2 + ELSE IF (M.LT.0) THEN + INFO = 3 + ELSE IF (N.LT.0) THEN + INFO = 4 + ELSE IF (LDA.LT.MAX(1,NROWA)) THEN + INFO = 7 + ELSE IF (LDB.LT.MAX(1,M)) THEN + INFO = 9 + ELSE IF (LDC.LT.MAX(1,M)) THEN + INFO = 12 + END IF + IF (INFO.NE.0) THEN + CALL XERBLA('SSKEWSYMM ',INFO) + RETURN + END IF +* +* Quick return if possible. +* + IF ((M.EQ.0) .OR. (N.EQ.0) .OR. + + ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN +* +* And when alpha.eq.zero. +* + IF (ALPHA.EQ.ZERO) THEN + IF (BETA.EQ.ZERO) THEN + DO 20 J = 1,N + DO 10 I = 1,M + C(I,J) = ZERO + 10 CONTINUE + 20 CONTINUE + ELSE + DO 40 J = 1,N + DO 30 I = 1,M + C(I,J) = BETA*C(I,J) + 30 CONTINUE + 40 CONTINUE + END IF + RETURN + END IF +* +* Start the operations. +* + IF (LSAME(SIDE,'L')) THEN +* +* Form C := alpha*A*B + beta*C. +* + IF (UPPER) THEN + DO 70 J = 1,N + DO 60 I = 1,M + TEMP1 = ALPHA*B(I,J) + TEMP2 = ZERO + DO 50 K = 1,I - 1 + C(K,J) = C(K,J) + TEMP1*A(K,I) + TEMP2 = TEMP2 - B(K,J)*A(K,I) + 50 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP2 + ELSE + C(I,J) = BETA*C(I,J) + + + ALPHA*TEMP2 + END IF + 60 CONTINUE + 70 CONTINUE + ELSE + DO 100 J = 1,N + DO 90 I = M,1,-1 + TEMP1 = ALPHA*B(I,J) + TEMP2 = ZERO + DO 80 K = I + 1,M + C(K,J) = C(K,J) + TEMP1*A(K,I) + TEMP2 = TEMP2 - B(K,J)*A(K,I) + 80 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP2 + ELSE + C(I,J) = BETA*C(I,J) + + + ALPHA*TEMP2 + END IF + 90 CONTINUE + 100 CONTINUE + END IF + ELSE +* +* Form C := alpha*B*A + beta*C. +* + DO 170 J = 1,N + IF (BETA.EQ.ZERO) THEN + DO 110 I = 1,M + C(I,J) = ZERO + 110 CONTINUE + ELSE + DO 120 I = 1,M + C(I,J) = BETA*C(I,J) + 120 CONTINUE + END IF + DO 140 K = 1,J - 1 + IF (UPPER) THEN + TEMP1 = ALPHA*A(K,J) + ELSE + TEMP1 = -ALPHA*A(J,K) + END IF + DO 130 I = 1,M + C(I,J) = C(I,J) + TEMP1*B(I,K) + 130 CONTINUE + 140 CONTINUE + DO 160 K = J + 1,N + IF (UPPER) THEN + TEMP1 = -ALPHA*A(J,K) + ELSE + TEMP1 = ALPHA*A(K,J) + END IF + DO 150 I = 1,M + C(I,J) = C(I,J) + TEMP1*B(I,K) + 150 CONTINUE + 160 CONTINUE + 170 CONTINUE + END IF +* + RETURN +* +* End of SSKEWSYMM +* + END diff --git a/BLAS/SRC/sskewsymv.f b/BLAS/SRC/sskewsymv.f new file mode 100644 index 0000000000..564cf1e152 --- /dev/null +++ b/BLAS/SRC/sskewsymv.f @@ -0,0 +1,327 @@ +*> \brief \b SSKEWSYMV +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE SSKEWSYMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) +* +* .. Scalar Arguments .. +* REAL ALPHA,BETA +* INTEGER INCX,INCY,LDA,N +* CHARACTER UPLO +* .. +* .. Array Arguments .. +* REAL A(LDA,*),X(*),Y(*) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> SSKEWSYMV performs the matrix-vector operation +*> +*> y := alpha*A*x + beta*y, +*> +*> where alpha and beta are scalars, x and y are n element vectors and +*> A is an n by n skew-symmetric matrix. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] UPLO +*> \verbatim +*> UPLO is CHARACTER*1 +*> On entry, UPLO specifies whether the upper or lower +*> triangular part of the array A is to be referenced as +*> follows: +*> +*> UPLO = 'U' or 'u' Only the upper triangular part of A +*> is to be referenced. +*> +*> UPLO = 'L' or 'l' Only the lower triangular part of A +*> is to be referenced. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> On entry, N specifies the order of the matrix A. +*> N must be at least zero. +*> \endverbatim +*> +*> \param[in] ALPHA +*> \verbatim +*> ALPHA is REAL +*> On entry, ALPHA specifies the scalar alpha. +*> \endverbatim +*> +*> \param[in] A +*> \verbatim +*> A is REAL array, dimension ( LDA, N ) +*> Before entry with UPLO = 'U' or 'u', the strictly n by n +*> upper triangular part of the array A must contain the upper +*> triangular part of the skew-symmetric matrix and the leading +*> lower triangular part of A is not referenced. +*> Before entry with UPLO = 'L' or 'l', the strictly n by n +*> lower triangular part of the array A must contain the lower +*> triangular part of the skew-symmetric matrix and the leading +*> upper triangular part of A is not referenced. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> On entry, LDA specifies the first dimension of A as declared +*> in the calling (sub) program. LDA must be at least +*> max( 1, n ). +*> \endverbatim +*> +*> \param[in] X +*> \verbatim +*> X is REAL array, dimension at least +*> ( 1 + ( n - 1 )*abs( INCX ) ). +*> Before entry, the incremented array X must contain the n +*> element vector x. +*> \endverbatim +*> +*> \param[in] INCX +*> \verbatim +*> INCX is INTEGER +*> On entry, INCX specifies the increment for the elements of +*> X. INCX must not be zero. +*> \endverbatim +*> +*> \param[in] BETA +*> \verbatim +*> BETA is REAL +*> On entry, BETA specifies the scalar beta. When BETA is +*> supplied as zero then Y need not be set on input. +*> \endverbatim +*> +*> \param[in,out] Y +*> \verbatim +*> Y is REAL array, dimension at least +*> ( 1 + ( n - 1 )*abs( INCY ) ). +*> Before entry, the incremented array Y must contain the n +*> element vector y. On exit, Y is overwritten by the updated +*> vector y. +*> \endverbatim +*> +*> \param[in] INCY +*> \verbatim +*> INCY is INTEGER +*> On entry, INCY specifies the increment for the elements of +*> Y. INCY must not be zero. +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup skewhemv +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> Level 2 Blas routine. +*> The vector and matrix arguments are not referenced when N = 0, or M = 0 +*> Derived from subroutine ssymv. +*> +*> -- Written on 6-Jul-2025. +*> Shuo Zheng, China. +*> \endverbatim +*> +* ===================================================================== + SUBROUTINE SSKEWSYMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) + IMPLICIT NONE +* +* -- Reference BLAS level2 routine -- +* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + REAL ALPHA,BETA + INTEGER INCX,INCY,LDA,N + CHARACTER UPLO +* .. +* .. Array Arguments .. + REAL A(LDA,*),X(*),Y(*) +* .. +* +* ===================================================================== +* +* .. Parameters .. + REAL ONE,ZERO + PARAMETER (ONE=1.0E+0,ZERO=0.0E+0) +* .. +* .. Local Scalars .. + REAL TEMP1,TEMP2 + INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY +* .. +* .. External Functions .. + LOGICAL LSAME + EXTERNAL LSAME +* .. +* .. External Subroutines .. + EXTERNAL XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. +* +* Test the input parameters. +* + INFO = 0 + IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN + INFO = 1 + ELSE IF (N.LT.0) THEN + INFO = 2 + ELSE IF (LDA.LT.MAX(1,N)) THEN + INFO = 5 + ELSE IF (INCX.EQ.0) THEN + INFO = 7 + ELSE IF (INCY.EQ.0) THEN + INFO = 10 + END IF + IF (INFO.NE.0) THEN + CALL XERBLA('SSKEWSYMV ',INFO) + RETURN + END IF +* +* Quick return if possible. +* + IF ((N.EQ.0) .OR. ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN +* +* Set up the start points in X and Y. +* + IF (INCX.GT.0) THEN + KX = 1 + ELSE + KX = 1 - (N-1)*INCX + END IF + IF (INCY.GT.0) THEN + KY = 1 + ELSE + KY = 1 - (N-1)*INCY + END IF +* +* Start the operations. In this version the elements of A are +* accessed sequentially with one pass through the triangular part +* of A. +* +* First form y := beta*y. +* + IF (BETA.NE.ONE) THEN + IF (INCY.EQ.1) THEN + IF (BETA.EQ.ZERO) THEN + DO 10 I = 1,N + Y(I) = ZERO + 10 CONTINUE + ELSE + DO 20 I = 1,N + Y(I) = BETA*Y(I) + 20 CONTINUE + END IF + ELSE + IY = KY + IF (BETA.EQ.ZERO) THEN + DO 30 I = 1,N + Y(IY) = ZERO + IY = IY + INCY + 30 CONTINUE + ELSE + DO 40 I = 1,N + Y(IY) = BETA*Y(IY) + IY = IY + INCY + 40 CONTINUE + END IF + END IF + END IF + IF (ALPHA.EQ.ZERO) RETURN + IF (LSAME(UPLO,'U')) THEN +* +* Form y when A is stored in upper triangle. +* + IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN + DO 60 J = 1,N + TEMP1 = ALPHA*X(J) + TEMP2 = ZERO + DO 50 I = 1,J - 1 + Y(I) = Y(I) + TEMP1*A(I,J) + TEMP2 = TEMP2 - A(I,J)*X(I) + 50 CONTINUE + Y(J) = Y(J) + ALPHA*TEMP2 + 60 CONTINUE + ELSE + JX = KX + JY = KY + DO 80 J = 1,N + TEMP1 = ALPHA*X(JX) + TEMP2 = ZERO + IX = KX + IY = KY + DO 70 I = 1,J - 1 + Y(IY) = Y(IY) + TEMP1*A(I,J) + TEMP2 = TEMP2 - A(I,J)*X(IX) + IX = IX + INCX + IY = IY + INCY + 70 CONTINUE + Y(JY) = Y(JY) + ALPHA*TEMP2 + JX = JX + INCX + JY = JY + INCY + 80 CONTINUE + END IF + ELSE +* +* Form y when A is stored in lower triangle. +* + IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN + DO 100 J = 1,N + TEMP1 = ALPHA*X(J) + TEMP2 = ZERO + DO 90 I = J + 1,N + Y(I) = Y(I) + TEMP1*A(I,J) + TEMP2 = TEMP2 - A(I,J)*X(I) + 90 CONTINUE + Y(J) = Y(J) + ALPHA*TEMP2 + 100 CONTINUE + ELSE + JX = KX + JY = KY + DO 120 J = 1,N + TEMP1 = ALPHA*X(JX) + TEMP2 = ZERO + IX = JX + IY = JY + DO 110 I = J + 1,N + IX = IX + INCX + IY = IY + INCY + Y(IY) = Y(IY) + TEMP1*A(I,J) + TEMP2 = TEMP2 - A(I,J)*X(IX) + 110 CONTINUE + Y(JY) = Y(JY) + ALPHA*TEMP2 + JX = JX + INCX + JY = JY + INCY + 120 CONTINUE + END IF + END IF +* + RETURN +* +* End of SSKEWSYMV +* + END diff --git a/BLAS/SRC/sskewsyr2.f b/BLAS/SRC/sskewsyr2.f new file mode 100644 index 0000000000..8d96834caf --- /dev/null +++ b/BLAS/SRC/sskewsyr2.f @@ -0,0 +1,294 @@ +*> \brief \b SSKEWSYR2 +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE SSKEWSYR2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA) +* +* .. Scalar Arguments .. +* REAL ALPHA +* INTEGER INCX,INCY,LDA,N +* CHARACTER UPLO +* .. +* .. Array Arguments .. +* REAL A(LDA,*),X(*),Y(*) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> SSKEWSYR2 performs the skew-symmetric rank 2 operation +*> +*> A := -alpha*x*y**T + alpha*y*x**T + A, +*> +*> where alpha is a scalar, x and y are n element vectors and A is an n +*> by n skew-symmetric matrix. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] UPLO +*> \verbatim +*> UPLO is CHARACTER*1 +*> On entry, UPLO specifies whether the upper or lower +*> triangular part of the array A is to be referenced as +*> follows: +*> +*> UPLO = 'U' or 'u' Only the upper triangular part of A +*> is to be referenced. +*> +*> UPLO = 'L' or 'l' Only the lower triangular part of A +*> is to be referenced. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> On entry, N specifies the order of the matrix A. +*> N must be at least zero. +*> \endverbatim +*> +*> \param[in] ALPHA +*> \verbatim +*> ALPHA is REAL +*> On entry, ALPHA specifies the scalar alpha. +*> \endverbatim +*> +*> \param[in] X +*> \verbatim +*> X is REAL array, dimension at least +*> ( 1 + ( n - 1 )*abs( INCX ) ). +*> Before entry, the incremented array X must contain the n +*> element vector x. +*> \endverbatim +*> +*> \param[in] INCX +*> \verbatim +*> INCX is INTEGER +*> On entry, INCX specifies the increment for the elements of +*> X. INCX must not be zero. +*> \endverbatim +*> +*> \param[in] Y +*> \verbatim +*> Y is REAL array, dimension at least +*> ( 1 + ( n - 1 )*abs( INCY ) ). +*> Before entry, the incremented array Y must contain the n +*> element vector y. +*> \endverbatim +*> +*> \param[in] INCY +*> \verbatim +*> INCY is INTEGER +*> On entry, INCY specifies the increment for the elements of +*> Y. INCY must not be zero. +*> \endverbatim +*> +*> \param[in,out] A +*> \verbatim +*> A is REAL array, dimension ( LDA, N ) +*> Before entry with UPLO = 'U' or 'u', the strictly n by n +*> upper triangular part of the array A must contain the upper +*> triangular part of the skew-symmetric matrix and the leading +*> lower triangular part of A is not referenced. On exit, the +*> upper triangular part of the array A is overwritten by the +*> upper triangular part of the updated matrix. +*> Before entry with UPLO = 'L' or 'l', the strictly n by n +*> lower triangular part of the array A must contain the lower +*> triangular part of the skew-symmetric matrix and the leading +*> upper triangular part of A is not referenced. On exit, the +*> lower triangular part of the array A is overwritten by the +*> lower triangular part of the updated matrix. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> On entry, LDA specifies the first dimension of A as declared +*> in the calling (sub) program. LDA must be at least +*> max( 1, n ). +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup skewher2 +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> Level 2 Blas routine. +*> Derived from subroutine ssyr2. +*> +*> -- Written on 6-Jul-2025. +*> Shuo Zheng, China. +*> \endverbatim +*> +* ===================================================================== + SUBROUTINE SSKEWSYR2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA) + IMPLICIT NONE +* +* -- Reference BLAS level2 routine -- +* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + REAL ALPHA + INTEGER INCX,INCY,LDA,N + CHARACTER UPLO +* .. +* .. Array Arguments .. + REAL A(LDA,*),X(*),Y(*) +* .. +* +* ===================================================================== +* +* .. Parameters .. + REAL ZERO + PARAMETER (ZERO=0.0E+0) +* .. +* .. Local Scalars .. + REAL TEMP1,TEMP2 + INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY +* .. +* .. External Functions .. + LOGICAL LSAME + EXTERNAL LSAME +* .. +* .. External Subroutines .. + EXTERNAL XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. +* +* Test the input parameters. +* + INFO = 0 + IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN + INFO = 1 + ELSE IF (N.LT.0) THEN + INFO = 2 + ELSE IF (INCX.EQ.0) THEN + INFO = 5 + ELSE IF (INCY.EQ.0) THEN + INFO = 7 + ELSE IF (LDA.LT.MAX(1,N)) THEN + INFO = 9 + END IF + IF (INFO.NE.0) THEN + CALL XERBLA('SSKEWSYR2 ',INFO) + RETURN + END IF +* +* Quick return if possible. +* + IF ((N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN +* +* Set up the start points in X and Y if the increments are not both +* unity. +* + IF ((INCX.NE.1) .OR. (INCY.NE.1)) THEN + IF (INCX.GT.0) THEN + KX = 1 + ELSE + KX = 1 - (N-1)*INCX + END IF + IF (INCY.GT.0) THEN + KY = 1 + ELSE + KY = 1 - (N-1)*INCY + END IF + JX = KX + JY = KY + END IF +* +* Start the operations. In this version the elements of A are +* accessed sequentially with one pass through the triangular part +* of A. +* + IF (LSAME(UPLO,'U')) THEN +* +* Form A when A is stored in the upper triangle. +* + IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN + DO 20 J = 1,N + IF ((X(J).NE.ZERO) .OR. (Y(J).NE.ZERO)) THEN + TEMP1 = ALPHA*Y(J) + TEMP2 = ALPHA*X(J) + DO 10 I = 1,J-1 + A(I,J) = A(I,J) - X(I)*TEMP1 + Y(I)*TEMP2 + 10 CONTINUE + END IF + 20 CONTINUE + ELSE + DO 40 J = 1,N + IF ((X(JX).NE.ZERO) .OR. (Y(JY).NE.ZERO)) THEN + TEMP1 = ALPHA*Y(JY) + TEMP2 = ALPHA*X(JX) + IX = KX + IY = KY + DO 30 I = 1,J-1 + A(I,J) = A(I,J) - X(IX)*TEMP1 + Y(IY)*TEMP2 + IX = IX + INCX + IY = IY + INCY + 30 CONTINUE + END IF + JX = JX + INCX + JY = JY + INCY + 40 CONTINUE + END IF + ELSE +* +* Form A when A is stored in the lower triangle. +* + IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN + DO 60 J = 1,N + IF ((X(J).NE.ZERO) .OR. (Y(J).NE.ZERO)) THEN + TEMP1 = ALPHA*Y(J) + TEMP2 = ALPHA*X(J) + DO 50 I = J+1,N + A(I,J) = A(I,J) - X(I)*TEMP1 + Y(I)*TEMP2 + 50 CONTINUE + END IF + 60 CONTINUE + ELSE + DO 80 J = 1,N + IF ((X(JX).NE.ZERO) .OR. (Y(JY).NE.ZERO)) THEN + TEMP1 = ALPHA*Y(JY) + TEMP2 = ALPHA*X(JX) + IX = JX + INCX + IY = JY + INCY + DO 70 I = J+1,N + A(I,J) = A(I,J) - X(IX)*TEMP1 + Y(IY)*TEMP2 + IX = IX + INCX + IY = IY + INCY + 70 CONTINUE + END IF + JX = JX + INCX + JY = JY + INCY + 80 CONTINUE + END IF + END IF +* + RETURN +* +* End of SSKEWSYR2 +* + END diff --git a/BLAS/SRC/sskewsyr2k.f b/BLAS/SRC/sskewsyr2k.f new file mode 100644 index 0000000000..58081743fe --- /dev/null +++ b/BLAS/SRC/sskewsyr2k.f @@ -0,0 +1,395 @@ +*> \brief \b SSKEWSYR2K +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE SSKEWSYR2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) +* +* .. Scalar Arguments .. +* REAL ALPHA,BETA +* INTEGER K,LDA,LDB,LDC,N +* CHARACTER TRANS,UPLO +* .. +* .. Array Arguments .. +* REAL A(LDA,*),B(LDB,*),C(LDC,*) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> SSKEWSYR2K performs one of the skew-symmetric rank 2k operations +*> +*> C := -alpha*A*B**T + alpha*B*A**T + beta*C, +*> +*> or +*> +*> C := -alpha*A**T*B + alpha*B**T*A + beta*C, +*> +*> where alpha and beta are scalars, C is an n by n skew-symmetric matrix +*> and A and B are n by k matrices in the first case and k by n +*> matrices in the second case. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] UPLO +*> \verbatim +*> UPLO is CHARACTER*1 +*> On entry, UPLO specifies whether the upper or lower +*> triangular part of the array C is to be referenced as +*> follows: +*> +*> UPLO = 'U' or 'u' Only the upper triangular part of C +*> is to be referenced. +*> +*> UPLO = 'L' or 'l' Only the lower triangular part of C +*> is to be referenced. +*> \endverbatim +*> +*> \param[in] TRANS +*> \verbatim +*> TRANS is CHARACTER*1 +*> On entry, TRANS specifies the operation to be performed as +*> follows: +*> +*> TRANS = 'N' or 'n' C := -alpha*A*B**T + alpha*B*A**T + +*> beta*C. +*> +*> TRANS = 'T' or 't' C := -alpha*A**T*B + alpha*B**T*A + +*> beta*C. +*> +*> TRANS = 'C' or 'c' C := -alpha*A**T*B + alpha*B**T*A + +*> beta*C. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> On entry, N specifies the order of the matrix C. N must be +*> at least zero. +*> \endverbatim +*> +*> \param[in] K +*> \verbatim +*> K is INTEGER +*> On entry with TRANS = 'N' or 'n', K specifies the number +*> of columns of the matrices A and B, and on entry with +*> TRANS = 'T' or 't' or 'C' or 'c', K specifies the number +*> of rows of the matrices A and B. K must be at least zero. +*> \endverbatim +*> +*> \param[in] ALPHA +*> \verbatim +*> ALPHA is REAL +*> On entry, ALPHA specifies the scalar alpha. +*> \endverbatim +*> +*> \param[in] A +*> \verbatim +*> A is REAL array, dimension ( LDA, ka ), where ka is +*> k when TRANS = 'N' or 'n', and is n otherwise. +*> Before entry with TRANS = 'N' or 'n', the leading n by k +*> part of the array A must contain the matrix A, otherwise +*> the leading k by n part of the array A must contain the +*> matrix A. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> On entry, LDA specifies the first dimension of A as declared +*> in the calling (sub) program. When TRANS = 'N' or 'n' +*> then LDA must be at least max( 1, n ), otherwise LDA must +*> be at least max( 1, k ). +*> \endverbatim +*> +*> \param[in] B +*> \verbatim +*> B is REAL array, dimension ( LDB, kb ), where kb is +*> k when TRANS = 'N' or 'n', and is n otherwise. +*> Before entry with TRANS = 'N' or 'n', the leading n by k +*> part of the array B must contain the matrix B, otherwise +*> the leading k by n part of the array B must contain the +*> matrix B. +*> \endverbatim +*> +*> \param[in] LDB +*> \verbatim +*> LDB is INTEGER +*> On entry, LDB specifies the first dimension of B as declared +*> in the calling (sub) program. When TRANS = 'N' or 'n' +*> then LDB must be at least max( 1, n ), otherwise LDB must +*> be at least max( 1, k ). +*> \endverbatim +*> +*> \param[in] BETA +*> \verbatim +*> BETA is REAL +*> On entry, BETA specifies the scalar beta. +*> \endverbatim +*> +*> \param[in,out] C +*> \verbatim +*> C is REAL array, dimension ( LDC, N ) +*> Before entry with UPLO = 'U' or 'u', the strictly n by n +*> upper triangular part of the array C must contain the upper +*> triangular part of the skew-symmetric matrix and the leading +*> lower triangular part of C is not referenced. On exit, the +*> upper triangular part of the array C is overwritten by the +*> upper triangular part of the updated matrix. +*> Before entry with UPLO = 'L' or 'l', the strictly n by n +*> lower triangular part of the array C must contain the lower +*> triangular part of the skew-symmetric matrix and the leading +*> upper triangular part of C is not referenced. On exit, the +*> lower triangular part of the array C is overwritten by the +*> lower triangular part of the updated matrix. +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> On entry, LDC specifies the first dimension of C as declared +*> in the calling (sub) program. LDC must be at least +*> max( 1, n ). +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup skewher2k +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> Level 3 Blas routine. +*> Derived from subroutine ssyr2k. +*> +*> -- Written on 6-Jul-2025. +*> Shuo Zheng, China. +*> \endverbatim +*> +* ===================================================================== + SUBROUTINE SSKEWSYR2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B, + + LDB,BETA,C,LDC) + IMPLICIT NONE +* +* -- Reference BLAS level3 routine -- +* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + REAL ALPHA,BETA + INTEGER K,LDA,LDB,LDC,N + CHARACTER TRANS,UPLO +* .. +* .. Array Arguments .. + REAL A(LDA,*),B(LDB,*),C(LDC,*) +* .. +* +* ===================================================================== +* +* .. External Functions .. + LOGICAL LSAME + EXTERNAL LSAME +* .. +* .. External Subroutines .. + EXTERNAL XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. +* .. Local Scalars .. + REAL TEMP1,TEMP2 + INTEGER I,INFO,J,L,NROWA + LOGICAL UPPER +* .. +* .. Parameters .. + REAL ONE,ZERO + PARAMETER (ONE=1.0E+0,ZERO=0.0E+0) +* .. +* +* Test the input parameters. +* + IF (LSAME(TRANS,'N')) THEN + NROWA = N + ELSE + NROWA = K + END IF + UPPER = LSAME(UPLO,'U') +* + INFO = 0 + IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN + INFO = 1 + ELSE IF ((.NOT.LSAME(TRANS,'N')) .AND. + + (.NOT.LSAME(TRANS,'T')) .AND. + + (.NOT.LSAME(TRANS,'C'))) THEN + INFO = 2 + ELSE IF (N.LT.0) THEN + INFO = 3 + ELSE IF (K.LT.0) THEN + INFO = 4 + ELSE IF (LDA.LT.MAX(1,NROWA)) THEN + INFO = 7 + ELSE IF (LDB.LT.MAX(1,NROWA)) THEN + INFO = 9 + ELSE IF (LDC.LT.MAX(1,N)) THEN + INFO = 12 + END IF + IF (INFO.NE.0) THEN + CALL XERBLA('SSKEWSYR2K',INFO) + RETURN + END IF +* +* Quick return if possible. +* + IF ((N.EQ.0) .OR. (((ALPHA.EQ.ZERO).OR. + + (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN +* +* And when alpha.eq.zero. +* + IF (ALPHA.EQ.ZERO) THEN + IF (UPPER) THEN + IF (BETA.EQ.ZERO) THEN + DO 20 J = 1,N + DO 10 I = 1,J-1 + C(I,J) = ZERO + 10 CONTINUE + 20 CONTINUE + ELSE + DO 40 J = 1,N + DO 30 I = 1,J-1 + C(I,J) = BETA*C(I,J) + 30 CONTINUE + 40 CONTINUE + END IF + ELSE + IF (BETA.EQ.ZERO) THEN + DO 60 J = 1,N + DO 50 I = J+1,N + C(I,J) = ZERO + 50 CONTINUE + 60 CONTINUE + ELSE + DO 80 J = 1,N + DO 70 I = J+1,N + C(I,J) = BETA*C(I,J) + 70 CONTINUE + 80 CONTINUE + END IF + END IF + RETURN + END IF +* +* Start the operations. +* + IF (LSAME(TRANS,'N')) THEN +* +* Form C := alpha*A*B**T + alpha*B*A**T + C. +* + IF (UPPER) THEN + DO 130 J = 1,N + IF (BETA.EQ.ZERO) THEN + DO 90 I = 1,J-1 + C(I,J) = ZERO + 90 CONTINUE + ELSE IF (BETA.NE.ONE) THEN + DO 100 I = 1,J-1 + C(I,J) = BETA*C(I,J) + 100 CONTINUE + END IF + DO 120 L = 1,K + IF ((A(J,L).NE.ZERO) .OR. (B(J,L).NE.ZERO)) THEN + TEMP1 = ALPHA*B(J,L) + TEMP2 = ALPHA*A(J,L) + DO 110 I = 1,J-1 + C(I,J) = C(I,J) - A(I,L)*TEMP1 + + + B(I,L)*TEMP2 + 110 CONTINUE + END IF + 120 CONTINUE + 130 CONTINUE + ELSE + DO 180 J = 1,N + IF (BETA.EQ.ZERO) THEN + DO 140 I = J+1,N + C(I,J) = ZERO + 140 CONTINUE + ELSE IF (BETA.NE.ONE) THEN + DO 150 I = J+1,N + C(I,J) = BETA*C(I,J) + 150 CONTINUE + END IF + DO 170 L = 1,K + IF ((A(J,L).NE.ZERO) .OR. (B(J,L).NE.ZERO)) THEN + TEMP1 = ALPHA*B(J,L) + TEMP2 = ALPHA*A(J,L) + DO 160 I = J+1,N + C(I,J) = C(I,J) - A(I,L)*TEMP1 + + + B(I,L)*TEMP2 + 160 CONTINUE + END IF + 170 CONTINUE + 180 CONTINUE + END IF + ELSE +* +* Form C := alpha*A**T*B + alpha*B**T*A + C. +* + IF (UPPER) THEN + DO 210 J = 1,N + DO 200 I = 1,J-1 + TEMP1 = ZERO + TEMP2 = ZERO + DO 190 L = 1,K + TEMP1 = TEMP1 + A(L,I)*B(L,J) + TEMP2 = TEMP2 + B(L,I)*A(L,J) + 190 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = -ALPHA*TEMP1 + ALPHA*TEMP2 + ELSE + C(I,J) = BETA*C(I,J) - ALPHA*TEMP1 + + + ALPHA*TEMP2 + END IF + 200 CONTINUE + 210 CONTINUE + ELSE + DO 240 J = 1,N + DO 230 I = J+1,N + TEMP1 = ZERO + TEMP2 = ZERO + DO 220 L = 1,K + TEMP1 = TEMP1 + A(L,I)*B(L,J) + TEMP2 = TEMP2 + B(L,I)*A(L,J) + 220 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = -ALPHA*TEMP1 + ALPHA*TEMP2 + ELSE + C(I,J) = BETA*C(I,J) - ALPHA*TEMP1 + + + ALPHA*TEMP2 + END IF + 230 CONTINUE + 240 CONTINUE + END IF + END IF +* + RETURN +* +* End of SSKEWSYR2K +* + END diff --git a/BLAS/SRC/sspmv.f b/BLAS/SRC/sspmv.f index 39fe2776ac..22a9ce25cf 100644 --- a/BLAS/SRC/sspmv.f +++ b/BLAS/SRC/sspmv.f @@ -125,9 +125,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level2 +*> \ingroup hpmv * *> \par Further Details: * ===================== @@ -146,11 +144,11 @@ *> * ===================================================================== SUBROUTINE SSPMV(UPLO,N,ALPHA,AP,X,INCX,BETA,Y,INCY) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. REAL ALPHA,BETA @@ -326,6 +324,6 @@ SUBROUTINE SSPMV(UPLO,N,ALPHA,AP,X,INCX,BETA,Y,INCY) * RETURN * -* End of SSPMV . +* End of SSPMV * END diff --git a/BLAS/SRC/sspr.f b/BLAS/SRC/sspr.f index 79df3c28bf..9c6d961ea3 100644 --- a/BLAS/SRC/sspr.f +++ b/BLAS/SRC/sspr.f @@ -106,9 +106,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level2 +*> \ingroup hpr * *> \par Further Details: * ===================== @@ -126,11 +124,11 @@ *> * ===================================================================== SUBROUTINE SSPR(UPLO,N,ALPHA,X,INCX,AP) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. REAL ALPHA @@ -256,6 +254,6 @@ SUBROUTINE SSPR(UPLO,N,ALPHA,X,INCX,AP) * RETURN * -* End of SSPR . +* End of SSPR * END diff --git a/BLAS/SRC/sspr2.f b/BLAS/SRC/sspr2.f index da33c6cdca..31adc3e817 100644 --- a/BLAS/SRC/sspr2.f +++ b/BLAS/SRC/sspr2.f @@ -121,9 +121,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level2 +*> \ingroup hpr2 * *> \par Further Details: * ===================== @@ -141,11 +139,11 @@ *> * ===================================================================== SUBROUTINE SSPR2(UPLO,N,ALPHA,X,INCX,Y,INCY,AP) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. REAL ALPHA @@ -291,6 +289,6 @@ SUBROUTINE SSPR2(UPLO,N,ALPHA,X,INCX,Y,INCY,AP) * RETURN * -* End of SSPR2 . +* End of SSPR2 * END diff --git a/BLAS/SRC/sswap.f b/BLAS/SRC/sswap.f index fb88cb27b7..29136e5492 100644 --- a/BLAS/SRC/sswap.f +++ b/BLAS/SRC/sswap.f @@ -66,9 +66,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level1 +*> \ingroup swap * *> \par Further Details: * ===================== @@ -81,11 +79,11 @@ *> * ===================================================================== SUBROUTINE SSWAP(N,SX,INCX,SY,INCY) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,INCY,N @@ -150,4 +148,7 @@ SUBROUTINE SSWAP(N,SX,INCX,SY,INCY) END DO END IF RETURN +* +* End of SSWAP +* END diff --git a/BLAS/SRC/ssymm.f b/BLAS/SRC/ssymm.f index 6263c17565..4a26cf42ba 100644 --- a/BLAS/SRC/ssymm.f +++ b/BLAS/SRC/ssymm.f @@ -168,9 +168,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level3 +*> \ingroup hemm * *> \par Further Details: * ===================== @@ -188,11 +186,11 @@ *> * ===================================================================== SUBROUTINE SSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC) + IMPLICIT NONE * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. REAL ALPHA,BETA @@ -237,9 +235,11 @@ SUBROUTINE SSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * Test the input parameters. * INFO = 0 - IF ((.NOT.LSAME(SIDE,'L')) .AND. (.NOT.LSAME(SIDE,'R'))) THEN + IF ((.NOT.LSAME(SIDE,'L')) .AND. + + (.NOT.LSAME(SIDE,'R'))) THEN INFO = 1 - ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN + ELSE IF ((.NOT.UPPER) .AND. + + (.NOT.LSAME(UPLO,'L'))) THEN INFO = 2 ELSE IF (M.LT.0) THEN INFO = 3 @@ -362,6 +362,6 @@ SUBROUTINE SSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * RETURN * -* End of SSYMM . +* End of SSYMM * END diff --git a/BLAS/SRC/ssymv.f b/BLAS/SRC/ssymv.f index d3c4c38ca8..23020d8374 100644 --- a/BLAS/SRC/ssymv.f +++ b/BLAS/SRC/ssymv.f @@ -130,9 +130,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level2 +*> \ingroup hemv * *> \par Further Details: * ===================== @@ -151,11 +149,11 @@ *> * ===================================================================== SUBROUTINE SSYMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. REAL ALPHA,BETA @@ -328,6 +326,6 @@ SUBROUTINE SSYMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) * RETURN * -* End of SSYMV . +* End of SSYMV * END diff --git a/BLAS/SRC/ssyr.f b/BLAS/SRC/ssyr.f index bdc39449ed..0f4edfcdbd 100644 --- a/BLAS/SRC/ssyr.f +++ b/BLAS/SRC/ssyr.f @@ -111,9 +111,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level2 +*> \ingroup her * *> \par Further Details: * ===================== @@ -131,11 +129,11 @@ *> * ===================================================================== SUBROUTINE SSYR(UPLO,N,ALPHA,X,INCX,A,LDA) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. REAL ALPHA @@ -258,6 +256,6 @@ SUBROUTINE SSYR(UPLO,N,ALPHA,X,INCX,A,LDA) * RETURN * -* End of SSYR . +* End of SSYR * END diff --git a/BLAS/SRC/ssyr2.f b/BLAS/SRC/ssyr2.f index d2dcf8d72e..b184d79dcc 100644 --- a/BLAS/SRC/ssyr2.f +++ b/BLAS/SRC/ssyr2.f @@ -126,9 +126,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level2 +*> \ingroup her2 * *> \par Further Details: * ===================== @@ -146,11 +144,11 @@ *> * ===================================================================== SUBROUTINE SSYR2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. REAL ALPHA @@ -293,6 +291,6 @@ SUBROUTINE SSYR2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA) * RETURN * -* End of SSYR2 . +* End of SSYR2 * END diff --git a/BLAS/SRC/ssyr2k.f b/BLAS/SRC/ssyr2k.f index b271fdcd77..859f56d81e 100644 --- a/BLAS/SRC/ssyr2k.f +++ b/BLAS/SRC/ssyr2k.f @@ -170,9 +170,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level3 +*> \ingroup her2k * *> \par Further Details: * ===================== @@ -191,11 +189,11 @@ *> * ===================================================================== SUBROUTINE SSYR2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) + IMPLICIT NONE * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. REAL ALPHA,BETA @@ -394,6 +392,6 @@ SUBROUTINE SSYR2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * RETURN * -* End of SSYR2K. +* End of SSYR2K * END diff --git a/BLAS/SRC/ssyrk.f b/BLAS/SRC/ssyrk.f index abaddf99d1..9bb69668a3 100644 --- a/BLAS/SRC/ssyrk.f +++ b/BLAS/SRC/ssyrk.f @@ -148,9 +148,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level3 +*> \ingroup herk * *> \par Further Details: * ===================== @@ -168,11 +166,11 @@ *> * ===================================================================== SUBROUTINE SSYRK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC) + IMPLICIT NONE * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. REAL ALPHA,BETA @@ -359,6 +357,6 @@ SUBROUTINE SSYRK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC) * RETURN * -* End of SSYRK . +* End of SSYRK * END diff --git a/BLAS/SRC/stbmv.f b/BLAS/SRC/stbmv.f index a714f2059d..9c0735383c 100644 --- a/BLAS/SRC/stbmv.f +++ b/BLAS/SRC/stbmv.f @@ -164,9 +164,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level2 +*> \ingroup tbmv * *> \par Further Details: * ===================== @@ -185,11 +183,11 @@ *> * ===================================================================== SUBROUTINE STBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,K,LDA,N @@ -200,10 +198,6 @@ SUBROUTINE STBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) * .. * * ===================================================================== -* -* .. Parameters .. - REAL ZERO - PARAMETER (ZERO=0.0E+0) * .. * .. Local Scalars .. REAL TEMP @@ -226,10 +220,12 @@ SUBROUTINE STBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) INFO = 0 IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN INFO = 1 - ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND. + ELSE IF (.NOT.LSAME(TRANS,'N') .AND. + + .NOT.LSAME(TRANS,'T') .AND. + .NOT.LSAME(TRANS,'C')) THEN INFO = 2 - ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN + ELSE IF (.NOT.LSAME(DIAG,'U') .AND. + + .NOT.LSAME(DIAG,'N')) THEN INFO = 3 ELSE IF (N.LT.0) THEN INFO = 4 @@ -271,28 +267,24 @@ SUBROUTINE STBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) KPLUS1 = K + 1 IF (INCX.EQ.1) THEN DO 20 J = 1,N - IF (X(J).NE.ZERO) THEN - TEMP = X(J) - L = KPLUS1 - J - DO 10 I = MAX(1,J-K),J - 1 - X(I) = X(I) + TEMP*A(L+I,J) - 10 CONTINUE - IF (NOUNIT) X(J) = X(J)*A(KPLUS1,J) - END IF + TEMP = X(J) + L = KPLUS1 - J + DO 10 I = MAX(1,J-K),J - 1 + X(I) = X(I) + TEMP*A(L+I,J) + 10 CONTINUE + IF (NOUNIT) X(J) = X(J)*A(KPLUS1,J) 20 CONTINUE ELSE JX = KX DO 40 J = 1,N - IF (X(JX).NE.ZERO) THEN - TEMP = X(JX) - IX = KX - L = KPLUS1 - J - DO 30 I = MAX(1,J-K),J - 1 - X(IX) = X(IX) + TEMP*A(L+I,J) - IX = IX + INCX - 30 CONTINUE - IF (NOUNIT) X(JX) = X(JX)*A(KPLUS1,J) - END IF + TEMP = X(JX) + IX = KX + L = KPLUS1 - J + DO 30 I = MAX(1,J-K),J - 1 + X(IX) = X(IX) + TEMP*A(L+I,J) + IX = IX + INCX + 30 CONTINUE + IF (NOUNIT) X(JX) = X(JX)*A(KPLUS1,J) JX = JX + INCX IF (J.GT.K) KX = KX + INCX 40 CONTINUE @@ -300,29 +292,25 @@ SUBROUTINE STBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) ELSE IF (INCX.EQ.1) THEN DO 60 J = N,1,-1 - IF (X(J).NE.ZERO) THEN - TEMP = X(J) - L = 1 - J - DO 50 I = MIN(N,J+K),J + 1,-1 - X(I) = X(I) + TEMP*A(L+I,J) - 50 CONTINUE - IF (NOUNIT) X(J) = X(J)*A(1,J) - END IF + TEMP = X(J) + L = 1 - J + DO 50 I = MIN(N,J+K),J + 1,-1 + X(I) = X(I) + TEMP*A(L+I,J) + 50 CONTINUE + IF (NOUNIT) X(J) = X(J)*A(1,J) 60 CONTINUE ELSE KX = KX + (N-1)*INCX JX = KX DO 80 J = N,1,-1 - IF (X(JX).NE.ZERO) THEN - TEMP = X(JX) - IX = KX - L = 1 - J - DO 70 I = MIN(N,J+K),J + 1,-1 - X(IX) = X(IX) + TEMP*A(L+I,J) - IX = IX - INCX - 70 CONTINUE - IF (NOUNIT) X(JX) = X(JX)*A(1,J) - END IF + TEMP = X(JX) + IX = KX + L = 1 - J + DO 70 I = MIN(N,J+K),J + 1,-1 + X(IX) = X(IX) + TEMP*A(L+I,J) + IX = IX - INCX + 70 CONTINUE + IF (NOUNIT) X(JX) = X(JX)*A(1,J) JX = JX - INCX IF ((N-J).GE.K) KX = KX - INCX 80 CONTINUE @@ -393,6 +381,6 @@ SUBROUTINE STBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) * RETURN * -* End of STBMV . +* End of STBMV * END diff --git a/BLAS/SRC/stbsv.f b/BLAS/SRC/stbsv.f index 721b80494f..af40e2878f 100644 --- a/BLAS/SRC/stbsv.f +++ b/BLAS/SRC/stbsv.f @@ -168,9 +168,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level2 +*> \ingroup tbsv * *> \par Further Details: * ===================== @@ -188,11 +186,11 @@ *> * ===================================================================== SUBROUTINE STBSV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,K,LDA,N @@ -203,10 +201,6 @@ SUBROUTINE STBSV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) * .. * * ===================================================================== -* -* .. Parameters .. - REAL ZERO - PARAMETER (ZERO=0.0E+0) * .. * .. Local Scalars .. REAL TEMP @@ -229,10 +223,12 @@ SUBROUTINE STBSV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) INFO = 0 IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN INFO = 1 - ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND. + ELSE IF (.NOT.LSAME(TRANS,'N') .AND. + + .NOT.LSAME(TRANS,'T') .AND. + .NOT.LSAME(TRANS,'C')) THEN INFO = 2 - ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN + ELSE IF (.NOT.LSAME(DIAG,'U') .AND. + + .NOT.LSAME(DIAG,'N')) THEN INFO = 3 ELSE IF (N.LT.0) THEN INFO = 4 @@ -274,59 +270,51 @@ SUBROUTINE STBSV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) KPLUS1 = K + 1 IF (INCX.EQ.1) THEN DO 20 J = N,1,-1 - IF (X(J).NE.ZERO) THEN - L = KPLUS1 - J - IF (NOUNIT) X(J) = X(J)/A(KPLUS1,J) - TEMP = X(J) - DO 10 I = J - 1,MAX(1,J-K),-1 - X(I) = X(I) - TEMP*A(L+I,J) - 10 CONTINUE - END IF + L = KPLUS1 - J + IF (NOUNIT) X(J) = X(J)/A(KPLUS1,J) + TEMP = X(J) + DO 10 I = J - 1,MAX(1,J-K),-1 + X(I) = X(I) - TEMP*A(L+I,J) + 10 CONTINUE 20 CONTINUE ELSE KX = KX + (N-1)*INCX JX = KX DO 40 J = N,1,-1 KX = KX - INCX - IF (X(JX).NE.ZERO) THEN - IX = KX - L = KPLUS1 - J - IF (NOUNIT) X(JX) = X(JX)/A(KPLUS1,J) - TEMP = X(JX) - DO 30 I = J - 1,MAX(1,J-K),-1 - X(IX) = X(IX) - TEMP*A(L+I,J) - IX = IX - INCX - 30 CONTINUE - END IF + IX = KX + L = KPLUS1 - J + IF (NOUNIT) X(JX) = X(JX)/A(KPLUS1,J) + TEMP = X(JX) + DO 30 I = J - 1,MAX(1,J-K),-1 + X(IX) = X(IX) - TEMP*A(L+I,J) + IX = IX - INCX + 30 CONTINUE JX = JX - INCX 40 CONTINUE END IF ELSE IF (INCX.EQ.1) THEN DO 60 J = 1,N - IF (X(J).NE.ZERO) THEN - L = 1 - J - IF (NOUNIT) X(J) = X(J)/A(1,J) - TEMP = X(J) - DO 50 I = J + 1,MIN(N,J+K) - X(I) = X(I) - TEMP*A(L+I,J) - 50 CONTINUE - END IF + L = 1 - J + IF (NOUNIT) X(J) = X(J)/A(1,J) + TEMP = X(J) + DO 50 I = J + 1,MIN(N,J+K) + X(I) = X(I) - TEMP*A(L+I,J) + 50 CONTINUE 60 CONTINUE ELSE JX = KX DO 80 J = 1,N KX = KX + INCX - IF (X(JX).NE.ZERO) THEN - IX = KX - L = 1 - J - IF (NOUNIT) X(JX) = X(JX)/A(1,J) - TEMP = X(JX) - DO 70 I = J + 1,MIN(N,J+K) - X(IX) = X(IX) - TEMP*A(L+I,J) - IX = IX + INCX - 70 CONTINUE - END IF + IX = KX + L = 1 - J + IF (NOUNIT) X(JX) = X(JX)/A(1,J) + TEMP = X(JX) + DO 70 I = J + 1,MIN(N,J+K) + X(IX) = X(IX) - TEMP*A(L+I,J) + IX = IX + INCX + 70 CONTINUE JX = JX + INCX 80 CONTINUE END IF @@ -396,6 +384,6 @@ SUBROUTINE STBSV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) * RETURN * -* End of STBSV . +* End of STBSV * END diff --git a/BLAS/SRC/stpmv.f b/BLAS/SRC/stpmv.f index 833f808bdf..b9312e1b32 100644 --- a/BLAS/SRC/stpmv.f +++ b/BLAS/SRC/stpmv.f @@ -120,9 +120,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level2 +*> \ingroup tpmv * *> \par Further Details: * ===================== @@ -141,11 +139,11 @@ *> * ===================================================================== SUBROUTINE STPMV(UPLO,TRANS,DIAG,N,AP,X,INCX) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,N @@ -156,10 +154,6 @@ SUBROUTINE STPMV(UPLO,TRANS,DIAG,N,AP,X,INCX) * .. * * ===================================================================== -* -* .. Parameters .. - REAL ZERO - PARAMETER (ZERO=0.0E+0) * .. * .. Local Scalars .. REAL TEMP @@ -179,10 +173,12 @@ SUBROUTINE STPMV(UPLO,TRANS,DIAG,N,AP,X,INCX) INFO = 0 IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN INFO = 1 - ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND. + ELSE IF (.NOT.LSAME(TRANS,'N') .AND. + + .NOT.LSAME(TRANS,'T') .AND. + .NOT.LSAME(TRANS,'C')) THEN INFO = 2 - ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN + ELSE IF (.NOT.LSAME(DIAG,'U') .AND. + + .NOT.LSAME(DIAG,'N')) THEN INFO = 3 ELSE IF (N.LT.0) THEN INFO = 4 @@ -220,29 +216,25 @@ SUBROUTINE STPMV(UPLO,TRANS,DIAG,N,AP,X,INCX) KK = 1 IF (INCX.EQ.1) THEN DO 20 J = 1,N - IF (X(J).NE.ZERO) THEN - TEMP = X(J) - K = KK - DO 10 I = 1,J - 1 - X(I) = X(I) + TEMP*AP(K) - K = K + 1 - 10 CONTINUE - IF (NOUNIT) X(J) = X(J)*AP(KK+J-1) - END IF + TEMP = X(J) + K = KK + DO 10 I = 1,J - 1 + X(I) = X(I) + TEMP*AP(K) + K = K + 1 + 10 CONTINUE + IF (NOUNIT) X(J) = X(J)*AP(KK+J-1) KK = KK + J 20 CONTINUE ELSE JX = KX DO 40 J = 1,N - IF (X(JX).NE.ZERO) THEN - TEMP = X(JX) - IX = KX - DO 30 K = KK,KK + J - 2 - X(IX) = X(IX) + TEMP*AP(K) - IX = IX + INCX - 30 CONTINUE - IF (NOUNIT) X(JX) = X(JX)*AP(KK+J-1) - END IF + TEMP = X(JX) + IX = KX + DO 30 K = KK,KK + J - 2 + X(IX) = X(IX) + TEMP*AP(K) + IX = IX + INCX + 30 CONTINUE + IF (NOUNIT) X(JX) = X(JX)*AP(KK+J-1) JX = JX + INCX KK = KK + J 40 CONTINUE @@ -251,30 +243,26 @@ SUBROUTINE STPMV(UPLO,TRANS,DIAG,N,AP,X,INCX) KK = (N* (N+1))/2 IF (INCX.EQ.1) THEN DO 60 J = N,1,-1 - IF (X(J).NE.ZERO) THEN - TEMP = X(J) - K = KK - DO 50 I = N,J + 1,-1 - X(I) = X(I) + TEMP*AP(K) - K = K - 1 - 50 CONTINUE - IF (NOUNIT) X(J) = X(J)*AP(KK-N+J) - END IF + TEMP = X(J) + K = KK + DO 50 I = N,J + 1,-1 + X(I) = X(I) + TEMP*AP(K) + K = K - 1 + 50 CONTINUE + IF (NOUNIT) X(J) = X(J)*AP(KK-N+J) KK = KK - (N-J+1) 60 CONTINUE ELSE KX = KX + (N-1)*INCX JX = KX DO 80 J = N,1,-1 - IF (X(JX).NE.ZERO) THEN - TEMP = X(JX) - IX = KX - DO 70 K = KK,KK - (N- (J+1)),-1 - X(IX) = X(IX) + TEMP*AP(K) - IX = IX - INCX - 70 CONTINUE - IF (NOUNIT) X(JX) = X(JX)*AP(KK-N+J) - END IF + TEMP = X(JX) + IX = KX + DO 70 K = KK,KK - (N- (J+1)),-1 + X(IX) = X(IX) + TEMP*AP(K) + IX = IX - INCX + 70 CONTINUE + IF (NOUNIT) X(JX) = X(JX)*AP(KK-N+J) JX = JX - INCX KK = KK - (N-J+1) 80 CONTINUE @@ -347,6 +335,6 @@ SUBROUTINE STPMV(UPLO,TRANS,DIAG,N,AP,X,INCX) * RETURN * -* End of STPMV . +* End of STPMV * END diff --git a/BLAS/SRC/stpsv.f b/BLAS/SRC/stpsv.f index fe1f40780c..2dfc39d951 100644 --- a/BLAS/SRC/stpsv.f +++ b/BLAS/SRC/stpsv.f @@ -123,9 +123,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level2 +*> \ingroup tpsv * *> \par Further Details: * ===================== @@ -143,11 +141,11 @@ *> * ===================================================================== SUBROUTINE STPSV(UPLO,TRANS,DIAG,N,AP,X,INCX) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,N @@ -158,10 +156,6 @@ SUBROUTINE STPSV(UPLO,TRANS,DIAG,N,AP,X,INCX) * .. * * ===================================================================== -* -* .. Parameters .. - REAL ZERO - PARAMETER (ZERO=0.0E+0) * .. * .. Local Scalars .. REAL TEMP @@ -181,10 +175,12 @@ SUBROUTINE STPSV(UPLO,TRANS,DIAG,N,AP,X,INCX) INFO = 0 IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN INFO = 1 - ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND. + ELSE IF (.NOT.LSAME(TRANS,'N') .AND. + + .NOT.LSAME(TRANS,'T') .AND. + .NOT.LSAME(TRANS,'C')) THEN INFO = 2 - ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN + ELSE IF (.NOT.LSAME(DIAG,'U') .AND. + + .NOT.LSAME(DIAG,'N')) THEN INFO = 3 ELSE IF (N.LT.0) THEN INFO = 4 @@ -222,29 +218,25 @@ SUBROUTINE STPSV(UPLO,TRANS,DIAG,N,AP,X,INCX) KK = (N* (N+1))/2 IF (INCX.EQ.1) THEN DO 20 J = N,1,-1 - IF (X(J).NE.ZERO) THEN - IF (NOUNIT) X(J) = X(J)/AP(KK) - TEMP = X(J) - K = KK - 1 - DO 10 I = J - 1,1,-1 - X(I) = X(I) - TEMP*AP(K) - K = K - 1 - 10 CONTINUE - END IF + IF (NOUNIT) X(J) = X(J)/AP(KK) + TEMP = X(J) + K = KK - 1 + DO 10 I = J - 1,1,-1 + X(I) = X(I) - TEMP*AP(K) + K = K - 1 + 10 CONTINUE KK = KK - J 20 CONTINUE ELSE JX = KX + (N-1)*INCX DO 40 J = N,1,-1 - IF (X(JX).NE.ZERO) THEN - IF (NOUNIT) X(JX) = X(JX)/AP(KK) - TEMP = X(JX) - IX = JX - DO 30 K = KK - 1,KK - J + 1,-1 - IX = IX - INCX - X(IX) = X(IX) - TEMP*AP(K) - 30 CONTINUE - END IF + IF (NOUNIT) X(JX) = X(JX)/AP(KK) + TEMP = X(JX) + IX = JX + DO 30 K = KK - 1,KK - J + 1,-1 + IX = IX - INCX + X(IX) = X(IX) - TEMP*AP(K) + 30 CONTINUE JX = JX - INCX KK = KK - J 40 CONTINUE @@ -253,29 +245,25 @@ SUBROUTINE STPSV(UPLO,TRANS,DIAG,N,AP,X,INCX) KK = 1 IF (INCX.EQ.1) THEN DO 60 J = 1,N - IF (X(J).NE.ZERO) THEN - IF (NOUNIT) X(J) = X(J)/AP(KK) - TEMP = X(J) - K = KK + 1 - DO 50 I = J + 1,N - X(I) = X(I) - TEMP*AP(K) - K = K + 1 - 50 CONTINUE - END IF + IF (NOUNIT) X(J) = X(J)/AP(KK) + TEMP = X(J) + K = KK + 1 + DO 50 I = J + 1,N + X(I) = X(I) - TEMP*AP(K) + K = K + 1 + 50 CONTINUE KK = KK + (N-J+1) 60 CONTINUE ELSE JX = KX DO 80 J = 1,N - IF (X(JX).NE.ZERO) THEN - IF (NOUNIT) X(JX) = X(JX)/AP(KK) - TEMP = X(JX) - IX = JX - DO 70 K = KK + 1,KK + N - J - IX = IX + INCX - X(IX) = X(IX) - TEMP*AP(K) - 70 CONTINUE - END IF + IF (NOUNIT) X(JX) = X(JX)/AP(KK) + TEMP = X(JX) + IX = JX + DO 70 K = KK + 1,KK + N - J + IX = IX + INCX + X(IX) = X(IX) - TEMP*AP(K) + 70 CONTINUE JX = JX + INCX KK = KK + (N-J+1) 80 CONTINUE @@ -349,6 +337,6 @@ SUBROUTINE STPSV(UPLO,TRANS,DIAG,N,AP,X,INCX) * RETURN * -* End of STPSV . +* End of STPSV * END diff --git a/BLAS/SRC/strmm.f b/BLAS/SRC/strmm.f index e11330ae3d..e0f90d51dc 100644 --- a/BLAS/SRC/strmm.f +++ b/BLAS/SRC/strmm.f @@ -156,9 +156,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level3 +*> \ingroup trmm * *> \par Further Details: * ===================== @@ -176,11 +174,11 @@ *> * ===================================================================== SUBROUTINE STRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) + IMPLICIT NONE * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. REAL ALPHA @@ -233,7 +231,8 @@ SUBROUTINE STRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) + (.NOT.LSAME(TRANSA,'T')) .AND. + (.NOT.LSAME(TRANSA,'C'))) THEN INFO = 3 - ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN + ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. + + (.NOT.LSAME(DIAG,'N'))) THEN INFO = 4 ELSE IF (M.LT.0) THEN INFO = 5 @@ -274,27 +273,23 @@ SUBROUTINE STRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) IF (UPPER) THEN DO 50 J = 1,N DO 40 K = 1,M - IF (B(K,J).NE.ZERO) THEN - TEMP = ALPHA*B(K,J) - DO 30 I = 1,K - 1 - B(I,J) = B(I,J) + TEMP*A(I,K) - 30 CONTINUE - IF (NOUNIT) TEMP = TEMP*A(K,K) - B(K,J) = TEMP - END IF + TEMP = ALPHA*B(K,J) + DO 30 I = 1,K - 1 + B(I,J) = B(I,J) + TEMP*A(I,K) + 30 CONTINUE + IF (NOUNIT) TEMP = TEMP*A(K,K) + B(K,J) = TEMP 40 CONTINUE 50 CONTINUE ELSE DO 80 J = 1,N DO 70 K = M,1,-1 - IF (B(K,J).NE.ZERO) THEN - TEMP = ALPHA*B(K,J) - B(K,J) = TEMP - IF (NOUNIT) B(K,J) = B(K,J)*A(K,K) - DO 60 I = K + 1,M - B(I,J) = B(I,J) + TEMP*A(I,K) - 60 CONTINUE - END IF + TEMP = ALPHA*B(K,J) + B(K,J) = TEMP + IF (NOUNIT) B(K,J) = B(K,J)*A(K,K) + DO 60 I = K + 1,M + B(I,J) = B(I,J) + TEMP*A(I,K) + 60 CONTINUE 70 CONTINUE 80 CONTINUE END IF @@ -339,12 +334,10 @@ SUBROUTINE STRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) B(I,J) = TEMP*B(I,J) 150 CONTINUE DO 170 K = 1,J - 1 - IF (A(K,J).NE.ZERO) THEN - TEMP = ALPHA*A(K,J) - DO 160 I = 1,M - B(I,J) = B(I,J) + TEMP*B(I,K) - 160 CONTINUE - END IF + TEMP = ALPHA*A(K,J) + DO 160 I = 1,M + B(I,J) = B(I,J) + TEMP*B(I,K) + 160 CONTINUE 170 CONTINUE 180 CONTINUE ELSE @@ -355,12 +348,10 @@ SUBROUTINE STRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) B(I,J) = TEMP*B(I,J) 190 CONTINUE DO 210 K = J + 1,N - IF (A(K,J).NE.ZERO) THEN - TEMP = ALPHA*A(K,J) - DO 200 I = 1,M - B(I,J) = B(I,J) + TEMP*B(I,K) - 200 CONTINUE - END IF + TEMP = ALPHA*A(K,J) + DO 200 I = 1,M + B(I,J) = B(I,J) + TEMP*B(I,K) + 200 CONTINUE 210 CONTINUE 220 CONTINUE END IF @@ -371,12 +362,10 @@ SUBROUTINE STRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) IF (UPPER) THEN DO 260 K = 1,N DO 240 J = 1,K - 1 - IF (A(J,K).NE.ZERO) THEN - TEMP = ALPHA*A(J,K) - DO 230 I = 1,M - B(I,J) = B(I,J) + TEMP*B(I,K) - 230 CONTINUE - END IF + TEMP = ALPHA*A(J,K) + DO 230 I = 1,M + B(I,J) = B(I,J) + TEMP*B(I,K) + 230 CONTINUE 240 CONTINUE TEMP = ALPHA IF (NOUNIT) TEMP = TEMP*A(K,K) @@ -389,12 +378,10 @@ SUBROUTINE STRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) ELSE DO 300 K = N,1,-1 DO 280 J = K + 1,N - IF (A(J,K).NE.ZERO) THEN - TEMP = ALPHA*A(J,K) - DO 270 I = 1,M - B(I,J) = B(I,J) + TEMP*B(I,K) - 270 CONTINUE - END IF + TEMP = ALPHA*A(J,K) + DO 270 I = 1,M + B(I,J) = B(I,J) + TEMP*B(I,K) + 270 CONTINUE 280 CONTINUE TEMP = ALPHA IF (NOUNIT) TEMP = TEMP*A(K,K) @@ -410,6 +397,6 @@ SUBROUTINE STRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) * RETURN * -* End of STRMM . +* End of STRMM * END diff --git a/BLAS/SRC/strmv.f b/BLAS/SRC/strmv.f index e9f681e89d..ba1a1175dd 100644 --- a/BLAS/SRC/strmv.f +++ b/BLAS/SRC/strmv.f @@ -125,9 +125,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level2 +*> \ingroup trmv * *> \par Further Details: * ===================== @@ -146,11 +144,11 @@ *> * ===================================================================== SUBROUTINE STRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,LDA,N @@ -161,10 +159,6 @@ SUBROUTINE STRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) * .. * * ===================================================================== -* -* .. Parameters .. - REAL ZERO - PARAMETER (ZERO=0.0E+0) * .. * .. Local Scalars .. REAL TEMP @@ -187,10 +181,12 @@ SUBROUTINE STRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) INFO = 0 IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN INFO = 1 - ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND. + ELSE IF (.NOT.LSAME(TRANS,'N') .AND. + + .NOT.LSAME(TRANS,'T') .AND. + .NOT.LSAME(TRANS,'C')) THEN INFO = 2 - ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN + ELSE IF (.NOT.LSAME(DIAG,'U') .AND. + + .NOT.LSAME(DIAG,'N')) THEN INFO = 3 ELSE IF (N.LT.0) THEN INFO = 4 @@ -229,53 +225,45 @@ SUBROUTINE STRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) IF (LSAME(UPLO,'U')) THEN IF (INCX.EQ.1) THEN DO 20 J = 1,N - IF (X(J).NE.ZERO) THEN - TEMP = X(J) - DO 10 I = 1,J - 1 - X(I) = X(I) + TEMP*A(I,J) - 10 CONTINUE - IF (NOUNIT) X(J) = X(J)*A(J,J) - END IF + TEMP = X(J) + DO 10 I = 1,J - 1 + X(I) = X(I) + TEMP*A(I,J) + 10 CONTINUE + IF (NOUNIT) X(J) = X(J)*A(J,J) 20 CONTINUE ELSE JX = KX DO 40 J = 1,N - IF (X(JX).NE.ZERO) THEN - TEMP = X(JX) - IX = KX - DO 30 I = 1,J - 1 - X(IX) = X(IX) + TEMP*A(I,J) - IX = IX + INCX - 30 CONTINUE - IF (NOUNIT) X(JX) = X(JX)*A(J,J) - END IF + TEMP = X(JX) + IX = KX + DO 30 I = 1,J - 1 + X(IX) = X(IX) + TEMP*A(I,J) + IX = IX + INCX + 30 CONTINUE + IF (NOUNIT) X(JX) = X(JX)*A(J,J) JX = JX + INCX 40 CONTINUE END IF ELSE IF (INCX.EQ.1) THEN DO 60 J = N,1,-1 - IF (X(J).NE.ZERO) THEN - TEMP = X(J) - DO 50 I = N,J + 1,-1 - X(I) = X(I) + TEMP*A(I,J) - 50 CONTINUE - IF (NOUNIT) X(J) = X(J)*A(J,J) - END IF + TEMP = X(J) + DO 50 I = N,J + 1,-1 + X(I) = X(I) + TEMP*A(I,J) + 50 CONTINUE + IF (NOUNIT) X(J) = X(J)*A(J,J) 60 CONTINUE ELSE KX = KX + (N-1)*INCX JX = KX DO 80 J = N,1,-1 - IF (X(JX).NE.ZERO) THEN - TEMP = X(JX) - IX = KX - DO 70 I = N,J + 1,-1 - X(IX) = X(IX) + TEMP*A(I,J) - IX = IX - INCX - 70 CONTINUE - IF (NOUNIT) X(JX) = X(JX)*A(J,J) - END IF + TEMP = X(JX) + IX = KX + DO 70 I = N,J + 1,-1 + X(IX) = X(IX) + TEMP*A(I,J) + IX = IX - INCX + 70 CONTINUE + IF (NOUNIT) X(JX) = X(JX)*A(J,J) JX = JX - INCX 80 CONTINUE END IF @@ -337,6 +325,6 @@ SUBROUTINE STRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) * RETURN * -* End of STRMV . +* End of STRMV * END diff --git a/BLAS/SRC/strsm.f b/BLAS/SRC/strsm.f index aa805f6b6c..d75ea4a83a 100644 --- a/BLAS/SRC/strsm.f +++ b/BLAS/SRC/strsm.f @@ -159,9 +159,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level3 +*> \ingroup trsm * *> \par Further Details: * ===================== @@ -180,11 +178,11 @@ *> * ===================================================================== SUBROUTINE STRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) + IMPLICIT NONE * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. REAL ALPHA @@ -213,8 +211,8 @@ SUBROUTINE STRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) LOGICAL LSIDE,NOUNIT,UPPER * .. * .. Parameters .. - REAL ONE,ZERO - PARAMETER (ONE=1.0E+0,ZERO=0.0E+0) + REAL ZERO + PARAMETER (ZERO=0.0E+0) * .. * * Test the input parameters. @@ -237,7 +235,8 @@ SUBROUTINE STRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) + (.NOT.LSAME(TRANSA,'T')) .AND. + (.NOT.LSAME(TRANSA,'C'))) THEN INFO = 3 - ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN + ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. + + (.NOT.LSAME(DIAG,'N'))) THEN INFO = 4 ELSE IF (M.LT.0) THEN INFO = 5 @@ -277,35 +276,27 @@ SUBROUTINE STRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) * IF (UPPER) THEN DO 60 J = 1,N - IF (ALPHA.NE.ONE) THEN - DO 30 I = 1,M - B(I,J) = ALPHA*B(I,J) - 30 CONTINUE - END IF + DO 30 I = 1,M + B(I,J) = ALPHA*B(I,J) + 30 CONTINUE DO 50 K = M,1,-1 - IF (B(K,J).NE.ZERO) THEN - IF (NOUNIT) B(K,J) = B(K,J)/A(K,K) - DO 40 I = 1,K - 1 - B(I,J) = B(I,J) - B(K,J)*A(I,K) - 40 CONTINUE - END IF + IF (NOUNIT) B(K,J) = B(K,J)/A(K,K) + DO 40 I = 1,K - 1 + B(I,J) = B(I,J) - B(K,J)*A(I,K) + 40 CONTINUE 50 CONTINUE 60 CONTINUE ELSE DO 100 J = 1,N - IF (ALPHA.NE.ONE) THEN - DO 70 I = 1,M - B(I,J) = ALPHA*B(I,J) - 70 CONTINUE - END IF + DO 70 I = 1,M + B(I,J) = ALPHA*B(I,J) + 70 CONTINUE DO 90 K = 1,M - IF (B(K,J).NE.ZERO) THEN - IF (NOUNIT) B(K,J) = B(K,J)/A(K,K) - DO 80 I = K + 1,M - B(I,J) = B(I,J) - B(K,J)*A(I,K) - 80 CONTINUE - END IF - 90 CONTINUE + IF (NOUNIT) B(K,J) = B(K,J)/A(K,K) + DO 80 I = K + 1,M + B(I,J) = B(I,J) - B(K,J)*A(I,K) + 80 CONTINUE + 90 CONTINUE 100 CONTINUE END IF ELSE @@ -343,43 +334,33 @@ SUBROUTINE STRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) * IF (UPPER) THEN DO 210 J = 1,N - IF (ALPHA.NE.ONE) THEN - DO 170 I = 1,M - B(I,J) = ALPHA*B(I,J) - 170 CONTINUE - END IF + DO 170 I = 1,M + B(I,J) = ALPHA*B(I,J) + 170 CONTINUE DO 190 K = 1,J - 1 - IF (A(K,J).NE.ZERO) THEN - DO 180 I = 1,M - B(I,J) = B(I,J) - A(K,J)*B(I,K) - 180 CONTINUE - END IF + DO 180 I = 1,M + B(I,J) = B(I,J) - A(K,J)*B(I,K) + 180 CONTINUE 190 CONTINUE IF (NOUNIT) THEN - TEMP = ONE/A(J,J) DO 200 I = 1,M - B(I,J) = TEMP*B(I,J) + B(I,J) = B(I,J)/A(J,J) 200 CONTINUE END IF 210 CONTINUE ELSE DO 260 J = N,1,-1 - IF (ALPHA.NE.ONE) THEN - DO 220 I = 1,M - B(I,J) = ALPHA*B(I,J) - 220 CONTINUE - END IF + DO 220 I = 1,M + B(I,J) = ALPHA*B(I,J) + 220 CONTINUE DO 240 K = J + 1,N - IF (A(K,J).NE.ZERO) THEN - DO 230 I = 1,M - B(I,J) = B(I,J) - A(K,J)*B(I,K) - 230 CONTINUE - END IF + DO 230 I = 1,M + B(I,J) = B(I,J) - A(K,J)*B(I,K) + 230 CONTINUE 240 CONTINUE IF (NOUNIT) THEN - TEMP = ONE/A(J,J) DO 250 I = 1,M - B(I,J) = TEMP*B(I,J) + B(I,J) = B(I,J)/A(J,J) 250 CONTINUE END IF 260 CONTINUE @@ -391,46 +372,34 @@ SUBROUTINE STRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) IF (UPPER) THEN DO 310 K = N,1,-1 IF (NOUNIT) THEN - TEMP = ONE/A(K,K) DO 270 I = 1,M - B(I,K) = TEMP*B(I,K) + B(I,K) = B(I,K)/A(K,K) 270 CONTINUE END IF DO 290 J = 1,K - 1 - IF (A(J,K).NE.ZERO) THEN - TEMP = A(J,K) - DO 280 I = 1,M - B(I,J) = B(I,J) - TEMP*B(I,K) - 280 CONTINUE - END IF + DO 280 I = 1,M + B(I,J) = B(I,J) - A(J,K)*B(I,K) + 280 CONTINUE 290 CONTINUE - IF (ALPHA.NE.ONE) THEN - DO 300 I = 1,M - B(I,K) = ALPHA*B(I,K) - 300 CONTINUE - END IF + DO 300 I = 1,M + B(I,K) = ALPHA*B(I,K) + 300 CONTINUE 310 CONTINUE ELSE DO 360 K = 1,N IF (NOUNIT) THEN - TEMP = ONE/A(K,K) DO 320 I = 1,M - B(I,K) = TEMP*B(I,K) + B(I,K) = B(I,K)/A(K,K) 320 CONTINUE END IF DO 340 J = K + 1,N - IF (A(J,K).NE.ZERO) THEN - TEMP = A(J,K) - DO 330 I = 1,M - B(I,J) = B(I,J) - TEMP*B(I,K) - 330 CONTINUE - END IF + DO 330 I = 1,M + B(I,J) = B(I,J) - A(J,K)*B(I,K) + 330 CONTINUE 340 CONTINUE - IF (ALPHA.NE.ONE) THEN - DO 350 I = 1,M - B(I,K) = ALPHA*B(I,K) - 350 CONTINUE - END IF + DO 350 I = 1,M + B(I,K) = ALPHA*B(I,K) + 350 CONTINUE 360 CONTINUE END IF END IF @@ -438,6 +407,6 @@ SUBROUTINE STRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) * RETURN * -* End of STRSM . +* End of STRSM * END diff --git a/BLAS/SRC/strsv.f b/BLAS/SRC/strsv.f index d9e41e7633..eec721dba0 100644 --- a/BLAS/SRC/strsv.f +++ b/BLAS/SRC/strsv.f @@ -128,9 +128,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup single_blas_level2 +*> \ingroup trsv * *> \par Further Details: * ===================== @@ -148,11 +146,11 @@ *> * ===================================================================== SUBROUTINE STRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,LDA,N @@ -163,10 +161,6 @@ SUBROUTINE STRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) * .. * * ===================================================================== -* -* .. Parameters .. - REAL ZERO - PARAMETER (ZERO=0.0E+0) * .. * .. Local Scalars .. REAL TEMP @@ -189,10 +183,12 @@ SUBROUTINE STRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) INFO = 0 IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN INFO = 1 - ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND. + ELSE IF (.NOT.LSAME(TRANS,'N') .AND. + + .NOT.LSAME(TRANS,'T') .AND. + .NOT.LSAME(TRANS,'C')) THEN INFO = 2 - ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN + ELSE IF (.NOT.LSAME(DIAG,'U') .AND. + + .NOT.LSAME(DIAG,'N')) THEN INFO = 3 ELSE IF (N.LT.0) THEN INFO = 4 @@ -231,52 +227,44 @@ SUBROUTINE STRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) IF (LSAME(UPLO,'U')) THEN IF (INCX.EQ.1) THEN DO 20 J = N,1,-1 - IF (X(J).NE.ZERO) THEN - IF (NOUNIT) X(J) = X(J)/A(J,J) - TEMP = X(J) - DO 10 I = J - 1,1,-1 - X(I) = X(I) - TEMP*A(I,J) - 10 CONTINUE - END IF + IF (NOUNIT) X(J) = X(J)/A(J,J) + TEMP = X(J) + DO 10 I = J - 1,1,-1 + X(I) = X(I) - TEMP*A(I,J) + 10 CONTINUE 20 CONTINUE ELSE JX = KX + (N-1)*INCX DO 40 J = N,1,-1 - IF (X(JX).NE.ZERO) THEN - IF (NOUNIT) X(JX) = X(JX)/A(J,J) - TEMP = X(JX) - IX = JX - DO 30 I = J - 1,1,-1 - IX = IX - INCX - X(IX) = X(IX) - TEMP*A(I,J) - 30 CONTINUE - END IF + IF (NOUNIT) X(JX) = X(JX)/A(J,J) + TEMP = X(JX) + IX = JX + DO 30 I = J - 1,1,-1 + IX = IX - INCX + X(IX) = X(IX) - TEMP*A(I,J) + 30 CONTINUE JX = JX - INCX 40 CONTINUE END IF ELSE IF (INCX.EQ.1) THEN DO 60 J = 1,N - IF (X(J).NE.ZERO) THEN - IF (NOUNIT) X(J) = X(J)/A(J,J) - TEMP = X(J) - DO 50 I = J + 1,N - X(I) = X(I) - TEMP*A(I,J) - 50 CONTINUE - END IF + IF (NOUNIT) X(J) = X(J)/A(J,J) + TEMP = X(J) + DO 50 I = J + 1,N + X(I) = X(I) - TEMP*A(I,J) + 50 CONTINUE 60 CONTINUE ELSE JX = KX DO 80 J = 1,N - IF (X(JX).NE.ZERO) THEN - IF (NOUNIT) X(JX) = X(JX)/A(J,J) - TEMP = X(JX) - IX = JX - DO 70 I = J + 1,N - IX = IX + INCX - X(IX) = X(IX) - TEMP*A(I,J) - 70 CONTINUE - END IF + IF (NOUNIT) X(JX) = X(JX)/A(J,J) + TEMP = X(JX) + IX = JX + DO 70 I = J + 1,N + IX = IX + INCX + X(IX) = X(IX) - TEMP*A(I,J) + 70 CONTINUE JX = JX + INCX 80 CONTINUE END IF @@ -339,6 +327,6 @@ SUBROUTINE STRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) * RETURN * -* End of STRSV . +* End of STRSV * END diff --git a/BLAS/SRC/xerbla.f b/BLAS/SRC/xerbla.f index bbe6cceb2b..622f91959b 100644 --- a/BLAS/SRC/xerbla.f +++ b/BLAS/SRC/xerbla.f @@ -53,17 +53,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup aux_blas +*> \ingroup xerbla * * ===================================================================== SUBROUTINE XERBLA( SRNAME, INFO ) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER*(*) SRNAME diff --git a/BLAS/SRC/xerbla_array.f b/BLAS/SRC/xerbla_array.f index df4e627381..3faee74f24 100644 --- a/BLAS/SRC/xerbla_array.f +++ b/BLAS/SRC/xerbla_array.f @@ -73,17 +73,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup aux_blas +*> \ingroup xerbla_array * * ===================================================================== SUBROUTINE XERBLA_ARRAY(SRNAME_ARRAY, SRNAME_LEN, INFO) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER SRNAME_LEN, INFO @@ -108,7 +106,7 @@ SUBROUTINE XERBLA_ARRAY(SRNAME_ARRAY, SRNAME_LEN, INFO) EXTERNAL XERBLA * .. * .. Executable Statements .. - SRNAME = '' + SRNAME = ' ' DO I = 1, MIN( SRNAME_LEN, LEN( SRNAME ) ) SRNAME( I:I ) = SRNAME_ARRAY( I ) END DO @@ -116,4 +114,7 @@ SUBROUTINE XERBLA_ARRAY(SRNAME_ARRAY, SRNAME_LEN, INFO) CALL XERBLA( SRNAME, INFO ) RETURN +* +* End of XERBLA_ARRAY +* END diff --git a/BLAS/SRC/zaxpby.f b/BLAS/SRC/zaxpby.f new file mode 100644 index 0000000000..c0d166256f --- /dev/null +++ b/BLAS/SRC/zaxpby.f @@ -0,0 +1,145 @@ +*> \brief \b ZAXPBY +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE ZAXPBY(N,ZA,ZX,INCX,ZB,ZY,INCY) +* +* .. Scalar Arguments .. +* COMPLEX*16 ZA,ZB +* INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. +* COMPLEX*16 ZX(*),ZY(*) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZAXPBY constant times a vector plus constant times a vector. +*> +*> Y = ALPHA * X + BETA * Y +*> +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> number of elements in input vector(s) +*> \endverbatim +*> +*> \param[in] ZA +*> \verbatim +*> ZA is COMPLEX*16 +*> On entry, ZA specifies the scalar alpha. +*> \endverbatim +*> +*> \param[in] ZX +*> \verbatim +*> ZX is COMPLEX*16 array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) +*> \endverbatim +*> +*> \param[in] INCX +*> \verbatim +*> INCX is INTEGER +*> storage spacing between elements of ZX +*> \endverbatim +*> +*> \param[in] ZB +*> \verbatim +*> ZB is COMPLEX*16 +*> On entry, ZB specifies the scalar beta. +*> \endverbatim +*> +*> \param[in,out] ZY +*> \verbatim +*> ZY is COMPLEX*16 array, dimension ( 1 + ( N - 1 )*abs( INCY ) ) +*> \endverbatim +*> +*> \param[in] INCY +*> \verbatim +*> INCY is INTEGER +*> storage spacing between elements of ZY +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +*> \author Martin Koehler, MPI Magdeburg +* +*> \ingroup axpby +* +* ===================================================================== + SUBROUTINE ZAXPBY(N,ZA,ZX,INCX,ZB,ZY,INCY) + IMPLICIT NONE +* +* -- Reference BLAS level1 routine -- +* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + COMPLEX*16 ZA,ZB + INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. + COMPLEX*16 ZX(*),ZY(*) +* .. +* .. External Subroutines .. + EXTERNAL ZSCAL +* +* ===================================================================== +* +* .. Local Scalars .. + INTEGER I,IX,IY +* .. + IF (N.LE.0) RETURN + +* Scale if ZA .EQ. 0 + IF ( ZA.EQ.(0.0D0,0.0D0) .AND. ZB.NE.(0.0D0,0.0D0)) THEN + CALL ZSCAL(N, ZB, ZY, INCY) + RETURN + END IF + + IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN +* +* code for both increments equal to 1 +* + DO I = 1,N + ZY(I) = ZB*ZY(I) + ZA*ZX(I) + END DO + ELSE +* +* code for unequal increments or equal increments +* not equal to 1 +* + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO I = 1,N + ZY(IY) = ZB*ZY(IY) + ZA*ZX(IX) + IX = IX + INCX + IY = IY + INCY + END DO + END IF +* + RETURN +* +* End of ZAXBPY +* + END diff --git a/BLAS/SRC/zaxpy.f b/BLAS/SRC/zaxpy.f index b7b9ee69e4..c464655549 100644 --- a/BLAS/SRC/zaxpy.f +++ b/BLAS/SRC/zaxpy.f @@ -72,9 +72,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level1 +*> \ingroup axpy * *> \par Further Details: * ===================== @@ -87,11 +85,11 @@ *> * ===================================================================== SUBROUTINE ZAXPY(N,ZA,ZX,INCX,ZY,INCY) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ZA @@ -105,13 +103,16 @@ SUBROUTINE ZAXPY(N,ZA,ZX,INCX,ZY,INCY) * * .. Local Scalars .. INTEGER I,IX,IY + COMPLEX*16 ZDUM +* .. +* .. Statement Functions .. + DOUBLE PRECISION CABS1 * .. -* .. External Functions .. - DOUBLE PRECISION DCABS1 - EXTERNAL DCABS1 +* .. Statement Function definitions .. + CABS1(ZDUM) = ABS(DBLE(ZDUM)) + ABS(DIMAG(ZDUM)) * .. IF (N.LE.0) RETURN - IF (DCABS1(ZA).EQ.0.0d0) RETURN + IF (CABS1(ZA).EQ.0.0D+0) RETURN IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN * * code for both increments equal to 1 @@ -136,4 +137,7 @@ SUBROUTINE ZAXPY(N,ZA,ZX,INCX,ZY,INCY) END IF * RETURN +* +* End of ZAXPY +* END diff --git a/BLAS/SRC/zcopy.f b/BLAS/SRC/zcopy.f index 3777079730..736bb9f680 100644 --- a/BLAS/SRC/zcopy.f +++ b/BLAS/SRC/zcopy.f @@ -65,9 +65,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level1 +*> \ingroup copy * *> \par Further Details: * ===================== @@ -80,11 +78,11 @@ *> * ===================================================================== SUBROUTINE ZCOPY(N,ZX,INCX,ZY,INCY) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,INCY,N @@ -122,4 +120,7 @@ SUBROUTINE ZCOPY(N,ZX,INCX,ZY,INCY) END DO END IF RETURN +* +* End of ZCOPY +* END diff --git a/BLAS/SRC/zdotc.f b/BLAS/SRC/zdotc.f index e6cd11b21d..bdb6e8c6f8 100644 --- a/BLAS/SRC/zdotc.f +++ b/BLAS/SRC/zdotc.f @@ -39,7 +39,7 @@ *> *> \param[in] ZX *> \verbatim -*> ZX is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) +*> ZX is COMPLEX*16 array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) *> \endverbatim *> *> \param[in] INCX @@ -50,7 +50,7 @@ *> *> \param[in] ZY *> \verbatim -*> ZY is REAL array, dimension ( 1 + ( N - 1 )*abs( INCY ) ) +*> ZY is COMPLEX*16 array, dimension ( 1 + ( N - 1 )*abs( INCY ) ) *> \endverbatim *> *> \param[in] INCY @@ -67,9 +67,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level1 +*> \ingroup dot * *> \par Further Details: * ===================== @@ -82,11 +80,11 @@ *> * ===================================================================== COMPLEX*16 FUNCTION ZDOTC(N,ZX,INCX,ZY,INCY) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,INCY,N @@ -131,4 +129,7 @@ COMPLEX*16 FUNCTION ZDOTC(N,ZX,INCX,ZY,INCY) END IF ZDOTC = ZTEMP RETURN +* +* End of ZDOTC +* END diff --git a/BLAS/SRC/zdotu.f b/BLAS/SRC/zdotu.f index 1ac013f01a..aeed01201d 100644 --- a/BLAS/SRC/zdotu.f +++ b/BLAS/SRC/zdotu.f @@ -39,7 +39,7 @@ *> *> \param[in] ZX *> \verbatim -*> ZX is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) +*> ZX is COMPLEX*16 array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) *> \endverbatim *> *> \param[in] INCX @@ -50,7 +50,7 @@ *> *> \param[in] ZY *> \verbatim -*> ZY is REAL array, dimension ( 1 + ( N - 1 )*abs( INCY ) ) +*> ZY is COMPLEX*16 array, dimension ( 1 + ( N - 1 )*abs( INCY ) ) *> \endverbatim *> *> \param[in] INCY @@ -67,9 +67,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level1 +*> \ingroup dot * *> \par Further Details: * ===================== @@ -82,11 +80,11 @@ *> * ===================================================================== COMPLEX*16 FUNCTION ZDOTU(N,ZX,INCX,ZY,INCY) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,INCY,N @@ -128,4 +126,7 @@ COMPLEX*16 FUNCTION ZDOTU(N,ZX,INCX,ZY,INCY) END IF ZDOTU = ZTEMP RETURN +* +* End of ZDOTU +* END diff --git a/BLAS/SRC/zdrot.f b/BLAS/SRC/zdrot.f index 8a4cf652a2..6c4c2f6fe6 100644 --- a/BLAS/SRC/zdrot.f +++ b/BLAS/SRC/zdrot.f @@ -8,14 +8,14 @@ * Definition: * =========== * -* SUBROUTINE ZDROT( N, CX, INCX, CY, INCY, C, S ) +* SUBROUTINE ZDROT( N, ZX, INCX, ZY, INCY, C, S ) * * .. Scalar Arguments .. * INTEGER INCX, INCY, N * DOUBLE PRECISION C, S * .. * .. Array Arguments .. -* COMPLEX*16 CX( * ), CY( * ) +* COMPLEX*16 ZX( * ), ZY( * ) * .. * * @@ -39,12 +39,12 @@ *> N must be at least zero. *> \endverbatim *> -*> \param[in,out] CX +*> \param[in,out] ZX *> \verbatim -*> CX is COMPLEX*16 array, dimension at least +*> ZX is COMPLEX*16 array, dimension at least *> ( 1 + ( N - 1 )*abs( INCX ) ). -*> Before entry, the incremented array CX must contain the n -*> element vector cx. On exit, CX is overwritten by the updated +*> Before entry, the incremented array ZX must contain the n +*> element vector cx. On exit, ZX is overwritten by the updated *> vector cx. *> \endverbatim *> @@ -52,15 +52,15 @@ *> \verbatim *> INCX is INTEGER *> On entry, INCX specifies the increment for the elements of -*> CX. INCX must not be zero. +*> ZX. INCX must not be zero. *> \endverbatim *> -*> \param[in,out] CY +*> \param[in,out] ZY *> \verbatim -*> CY is COMPLEX*16 array, dimension at least +*> ZY is COMPLEX*16 array, dimension at least *> ( 1 + ( N - 1 )*abs( INCY ) ). -*> Before entry, the incremented array CY must contain the n -*> element vector cy. On exit, CY is overwritten by the updated +*> Before entry, the incremented array ZY must contain the n +*> element vector cy. On exit, ZY is overwritten by the updated *> vector cy. *> \endverbatim *> @@ -68,7 +68,7 @@ *> \verbatim *> INCY is INTEGER *> On entry, INCY specifies the increment for the elements of -*> CY. INCY must not be zero. +*> ZY. INCY must not be zero. *> \endverbatim *> *> \param[in] C @@ -91,24 +91,22 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level1 +*> \ingroup rot * * ===================================================================== - SUBROUTINE ZDROT( N, CX, INCX, CY, INCY, C, S ) + SUBROUTINE ZDROT( N, ZX, INCX, ZY, INCY, C, S ) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX, INCY, N DOUBLE PRECISION C, S * .. * .. Array Arguments .. - COMPLEX*16 CX( * ), CY( * ) + COMPLEX*16 ZX( * ), ZY( * ) * .. * * ===================================================================== @@ -126,9 +124,9 @@ SUBROUTINE ZDROT( N, CX, INCX, CY, INCY, C, S ) * code for both increments equal to 1 * DO I = 1, N - CTEMP = C*CX( I ) + S*CY( I ) - CY( I ) = C*CY( I ) - S*CX( I ) - CX( I ) = CTEMP + CTEMP = C*ZX( I ) + S*ZY( I ) + ZY( I ) = C*ZY( I ) - S*ZX( I ) + ZX( I ) = CTEMP END DO ELSE * @@ -142,12 +140,15 @@ SUBROUTINE ZDROT( N, CX, INCX, CY, INCY, C, S ) IF( INCY.LT.0 ) $ IY = ( -N+1 )*INCY + 1 DO I = 1, N - CTEMP = C*CX( IX ) + S*CY( IY ) - CY( IY ) = C*CY( IY ) - S*CX( IX ) - CX( IX ) = CTEMP + CTEMP = C*ZX( IX ) + S*ZY( IY ) + ZY( IY ) = C*ZY( IY ) - S*ZX( IX ) + ZX( IX ) = CTEMP IX = IX + INCX IY = IY + INCY END DO END IF RETURN +* +* End of ZDROT +* END diff --git a/BLAS/SRC/zdscal.f b/BLAS/SRC/zdscal.f index 71d4da55be..14a6e98c40 100644 --- a/BLAS/SRC/zdscal.f +++ b/BLAS/SRC/zdscal.f @@ -61,9 +61,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level1 +*> \ingroup scal * *> \par Further Details: * ===================== @@ -77,11 +75,11 @@ *> * ===================================================================== SUBROUTINE ZDSCAL(N,DA,ZX,INCX) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION DA @@ -95,17 +93,20 @@ SUBROUTINE ZDSCAL(N,DA,ZX,INCX) * * .. Local Scalars .. INTEGER I,NINCX +* .. Parameters .. + DOUBLE PRECISION ONE + PARAMETER (ONE=1.0D+0) * .. * .. Intrinsic Functions .. - INTRINSIC DCMPLX + INTRINSIC DBLE, DCMPLX, DIMAG * .. - IF (N.LE.0 .OR. INCX.LE.0) RETURN + IF (N.LE.0 .OR. INCX.LE.0 .OR. DA.EQ.ONE) RETURN IF (INCX.EQ.1) THEN * * code for increment equal to 1 * DO I = 1,N - ZX(I) = DCMPLX(DA,0.0d0)*ZX(I) + ZX(I) = DCMPLX(DA*DBLE(ZX(I)),DA*DIMAG(ZX(I))) END DO ELSE * @@ -113,8 +114,11 @@ SUBROUTINE ZDSCAL(N,DA,ZX,INCX) * NINCX = N*INCX DO I = 1,NINCX,INCX - ZX(I) = DCMPLX(DA,0.0d0)*ZX(I) + ZX(I) = DCMPLX(DA*DBLE(ZX(I)),DA*DIMAG(ZX(I))) END DO END IF RETURN +* +* End of ZDSCAL +* END diff --git a/BLAS/SRC/zgbmv.f b/BLAS/SRC/zgbmv.f index 7303df879e..bb162da970 100644 --- a/BLAS/SRC/zgbmv.f +++ b/BLAS/SRC/zgbmv.f @@ -148,6 +148,8 @@ *> ( 1 + ( n - 1 )*abs( INCY ) ) otherwise. *> Before entry, the incremented array Y must contain the *> vector y. On exit, Y is overwritten by the updated vector y. +*> If either m or n is zero, then Y not referenced and the function +*> performs a quick return. *> \endverbatim *> *> \param[in] INCY @@ -165,9 +167,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level2 +*> \ingroup gbmv * *> \par Further Details: * ===================== @@ -185,12 +185,13 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) + SUBROUTINE ZGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX, + + BETA,Y,INCY) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ALPHA,BETA @@ -385,6 +386,6 @@ SUBROUTINE ZGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) * RETURN * -* End of ZGBMV . +* End of ZGBMV * END diff --git a/BLAS/SRC/zgemm.f b/BLAS/SRC/zgemm.f index c3ac7551d1..de8b2f2c4d 100644 --- a/BLAS/SRC/zgemm.f +++ b/BLAS/SRC/zgemm.f @@ -35,6 +35,16 @@ *> *> alpha and beta are scalars, and A, B and C are matrices, with op( A ) *> an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. +*> +*> Note: if alpha and/or beta is zero, some parts of the matrix-matrix +*> operations are not performed. This results in the following NaN/Inf +*> propagation quirks: +*> +*> 1. If alpha is zero, NaNs or Infs in A or B do not affect the result. +*> 2. If both alpha and beta are zero, then a zero matrix is returned in C, +*> irrespective of any NaNs or Infs in A, B or C. +*> 3. If only beta is zero, alpha*op( A )*op( B ) is returned, irrespective +*> of any NaNs or Infs in C. *> \endverbatim * * Arguments: @@ -92,7 +102,9 @@ *> \param[in] ALPHA *> \verbatim *> ALPHA is COMPLEX*16 -*> On entry, ALPHA specifies the scalar alpha. +*> On entry, ALPHA specifies the scalar alpha. If ALPHA is zero the +*> values in A and B do not affect the result. This also means that +*> NaN/Inf propagation from A and B is inhibited if ALPHA is zero. *> \endverbatim *> *> \param[in] A @@ -102,7 +114,10 @@ *> Before entry with TRANSA = 'N' or 'n', the leading m by k *> part of the array A must contain the matrix A, otherwise *> the leading k by m part of the array A must contain the -*> matrix A. +*> matrix A, except if ALPHA is zero. +*> If ALPHA is zero, none of the values in A affect the result, even +*> if they are NaN/Inf. This also implies that if ALPHA is zero, +*> the matrix elements of A need not be initialized by the caller. *> \endverbatim *> *> \param[in] LDA @@ -121,7 +136,10 @@ *> Before entry with TRANSB = 'N' or 'n', the leading k by n *> part of the array B must contain the matrix B, otherwise *> the leading n by k part of the array B must contain the -*> matrix B. +*> matrix B, except if ALPHA is zero. +*> If ALPHA is zero, none of the values in B affect the result, even +*> if they are NaN/Inf. This also implies that if ALPHA is zero, +*> the matrix elements of B need not be initialized by the caller. *> \endverbatim *> *> \param[in] LDB @@ -136,16 +154,19 @@ *> \param[in] BETA *> \verbatim *> BETA is COMPLEX*16 -*> On entry, BETA specifies the scalar beta. When BETA is -*> supplied as zero then C need not be set on input. +*> On entry, BETA specifies the scalar beta. If BETA is zero the +*> values in C do not affect the result. This also means that +*> NaN/Inf propagation from C is inhibited if BETA is zero. *> \endverbatim *> *> \param[in,out] C *> \verbatim *> C is COMPLEX*16 array, dimension ( LDC, N ) *> Before entry, the leading m by n part of the array C must -*> contain the matrix C, except when beta is zero, in which -*> case C need not be set on entry. +*> contain the matrix C,, except if beta is zero. +*> If beta is zero, none of the values in C affect the result, even +*> if they are NaN/Inf. This also implies that if beta is zero, +*> the matrix elements of C need not be initialized by the caller. *> On exit, the array C is overwritten by the m by n matrix *> ( alpha*op( A )*op( B ) + beta*C ). *> \endverbatim @@ -166,9 +187,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level3 +*> \ingroup gemm * *> \par Further Details: * ===================== @@ -185,12 +204,13 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) + SUBROUTINE ZGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB, + + BETA,C,LDC) + IMPLICIT NONE * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ALPHA,BETA @@ -215,7 +235,7 @@ SUBROUTINE ZGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * .. * .. Local Scalars .. COMPLEX*16 TEMP - INTEGER I,INFO,J,L,NCOLA,NROWA,NROWB + INTEGER I,INFO,J,L,NROWA,NROWB LOGICAL CONJA,CONJB,NOTA,NOTB * .. * .. Parameters .. @@ -228,8 +248,7 @@ SUBROUTINE ZGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * Set NOTA and NOTB as true if A and B respectively are not * conjugated or transposed, set CONJA and CONJB as true if A and * B respectively are to be transposed but not conjugated and set -* NROWA, NCOLA and NROWB as the number of rows and columns of A -* and the number of rows of B respectively. +* NROWA and NROWB as the number of rows of A and B respectively. * NOTA = LSAME(TRANSA,'N') NOTB = LSAME(TRANSB,'N') @@ -237,10 +256,8 @@ SUBROUTINE ZGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) CONJB = LSAME(TRANSB,'C') IF (NOTA) THEN NROWA = M - NCOLA = K ELSE NROWA = K - NCOLA = M END IF IF (NOTB) THEN NROWB = K @@ -478,6 +495,6 @@ SUBROUTINE ZGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * RETURN * -* End of ZGEMM . +* End of ZGEMM * END diff --git a/BLAS/SRC/zgemmtr.f b/BLAS/SRC/zgemmtr.f new file mode 100644 index 0000000000..01dd91c387 --- /dev/null +++ b/BLAS/SRC/zgemmtr.f @@ -0,0 +1,569 @@ +*> \brief \b ZGEMMTR +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE ZGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB,BETA, +* C,LDC) +* +* .. Scalar Arguments .. +* COMPLEX*16 ALPHA,BETA +* INTEGER K,LDA,LDB,LDC,N +* CHARACTER TRANSA,TRANSB, UPLO +* .. +* .. Array Arguments .. +* COMPLEX*16 A(LDA,*),B(LDB,*),C(LDC,*) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZGEMMTR performs one of the matrix-matrix operations +*> +*> C := alpha*op( A )*op( B ) + beta*C, +*> +*> where op( X ) is one of +*> +*> op( X ) = X or op( X ) = X**T, +*> +*> alpha and beta are scalars, and A, B and C are matrices, with op( A ) +*> an n by k matrix, op( B ) a k by n matrix and C an n by n matrix. +*> Thereby, the routine only accesses and updates the upper or lower +*> triangular part of the result matrix C. This behaviour can be used if +*> the resulting matrix C is known to be Hermitian or symmetric. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] UPLO +*> \verbatim +*> UPLO is CHARACTER*1 +*> On entry, UPLO specifies whether the lower or the upper +*> triangular part of C is access and updated. +*> +*> UPLO = 'L' or 'l', the lower triangular part of C is used. +*> +*> UPLO = 'U' or 'u', the upper triangular part of C is used. +*> \endverbatim +* +*> \param[in] TRANSA +*> \verbatim +*> TRANSA is CHARACTER*1 +*> On entry, TRANSA specifies the form of op( A ) to be used in +*> the matrix multiplication as follows: +*> +*> TRANSA = 'N' or 'n', op( A ) = A. +*> +*> TRANSA = 'T' or 't', op( A ) = A**T. +*> +*> TRANSA = 'C' or 'c', op( A ) = A**H. +*> \endverbatim +*> +*> \param[in] TRANSB +*> \verbatim +*> TRANSB is CHARACTER*1 +*> On entry, TRANSB specifies the form of op( B ) to be used in +*> the matrix multiplication as follows: +*> +*> TRANSB = 'N' or 'n', op( B ) = B. +*> +*> TRANSB = 'T' or 't', op( B ) = B**T. +*> +*> TRANSB = 'C' or 'c', op( B ) = B**H. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> On entry, N specifies the number of rows and columns of +*> the matrix C, the number of columns of op(B) and the number +*> of rows of op(A). N must be at least zero. +*> \endverbatim +*> +*> \param[in] K +*> \verbatim +*> K is INTEGER +*> On entry, K specifies the number of columns of the matrix +*> op( A ) and the number of rows of the matrix op( B ). K must +*> be at least zero. +*> \endverbatim +*> +*> \param[in] ALPHA +*> \verbatim +*> ALPHA is COMPLEX*16. +*> On entry, ALPHA specifies the scalar alpha. +*> \endverbatim +*> +*> \param[in] A +*> \verbatim +*> A is COMPLEX*16 array, dimension ( LDA, ka ), where ka is +*> k when TRANSA = 'N' or 'n', and is n otherwise. +*> Before entry with TRANSA = 'N' or 'n', the leading n by k +*> part of the array A must contain the matrix A, otherwise +*> the leading k by m part of the array A must contain the +*> matrix A. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> On entry, LDA specifies the first dimension of A as declared +*> in the calling (sub) program. When TRANSA = 'N' or 'n' then +*> LDA must be at least max( 1, n ), otherwise LDA must be at +*> least max( 1, k ). +*> \endverbatim +*> +*> \param[in] B +*> \verbatim +*> B is COMPLEX*16 array, dimension ( LDB, kb ), where kb is +*> n when TRANSB = 'N' or 'n', and is k otherwise. +*> Before entry with TRANSB = 'N' or 'n', the leading k by n +*> part of the array B must contain the matrix B, otherwise +*> the leading n by k part of the array B must contain the +*> matrix B. +*> \endverbatim +*> +*> \param[in] LDB +*> \verbatim +*> LDB is INTEGER +*> On entry, LDB specifies the first dimension of B as declared +*> in the calling (sub) program. When TRANSB = 'N' or 'n' then +*> LDB must be at least max( 1, k ), otherwise LDB must be at +*> least max( 1, n ). +*> \endverbatim +*> +*> \param[in] BETA +*> \verbatim +*> BETA is COMPLEX*16. +*> On entry, BETA specifies the scalar beta. When BETA is +*> supplied as zero then C need not be set on input. +*> \endverbatim +*> +*> \param[in,out] C +*> \verbatim +*> C is COMPLEX*16 array, dimension ( LDC, N ) +*> Before entry, the leading n by n part of the array C must +*> contain the matrix C, except when beta is zero, in which +*> case C need not be set on entry. +*> On exit, the upper or lower triangular part of the matrix +*> C is overwritten by the n by n matrix +*> ( alpha*op( A )*op( B ) + beta*C ). +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> On entry, LDC specifies the first dimension of C as declared +*> in the calling (sub) program. LDC must be at least +*> max( 1, n ). +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Martin Koehler +* +*> \ingroup gemmtr +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> Level 3 Blas routine. +*> +*> -- Written on 19-July-2023. +*> Martin Koehler, MPI Magdeburg +*> \endverbatim +*> +* ===================================================================== + SUBROUTINE ZGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB, + + BETA,C,LDC) + IMPLICIT NONE +* +* -- Reference BLAS level3 routine -- +* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + COMPLEX*16 ALPHA,BETA + INTEGER K,LDA,LDB,LDC,N + CHARACTER TRANSA,TRANSB,UPLO +* .. +* .. Array Arguments .. + COMPLEX*16 A(LDA,*),B(LDB,*),C(LDC,*) +* .. +* +* ===================================================================== +* +* .. External Functions .. + LOGICAL LSAME + EXTERNAL LSAME +* .. +* .. External Subroutines .. + EXTERNAL XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC CONJG,MAX +* .. +* .. Local Scalars .. + COMPLEX*16 TEMP + INTEGER I,INFO,J,L,NROWA,NROWB,ISTART, ISTOP + LOGICAL CONJA,CONJB,NOTA,NOTB,UPPER +* .. +* .. Parameters .. + COMPLEX*16 ONE + PARAMETER (ONE= (1.0D+0,0.0D+0)) + COMPLEX*16 ZERO + PARAMETER (ZERO= (0.0D+0,0.0D+0)) +* .. +* +* Set NOTA and NOTB as true if A and B respectively are not +* conjugated or transposed, set CONJA and CONJB as true if A and +* B respectively are to be transposed but not conjugated and set +* NROWA and NROWB as the number of rows of A and B respectively. +* + NOTA = LSAME(TRANSA,'N') + NOTB = LSAME(TRANSB,'N') + CONJA = LSAME(TRANSA,'C') + CONJB = LSAME(TRANSB,'C') + IF (NOTA) THEN + NROWA = N + ELSE + NROWA = K + END IF + IF (NOTB) THEN + NROWB = K + ELSE + NROWB = N + END IF + UPPER = LSAME(UPLO, 'U') + +* +* Test the input parameters. +* + INFO = 0 + IF ((.NOT. UPPER) .AND. (.NOT. LSAME(UPLO, 'L'))) THEN + INFO = 1 + ELSE IF ((.NOT.NOTA) .AND. (.NOT.CONJA) .AND. + + (.NOT.LSAME(TRANSA,'T'))) THEN + INFO = 2 + ELSE IF ((.NOT.NOTB) .AND. (.NOT.CONJB) .AND. + + (.NOT.LSAME(TRANSB,'T'))) THEN + INFO = 3 + ELSE IF (N.LT.0) THEN + INFO = 4 + ELSE IF (K.LT.0) THEN + INFO = 5 + ELSE IF (LDA.LT.MAX(1,NROWA)) THEN + INFO = 8 + ELSE IF (LDB.LT.MAX(1,NROWB)) THEN + INFO = 10 + ELSE IF (LDC.LT.MAX(1,N)) THEN + INFO = 13 + END IF + IF (INFO.NE.0) THEN + CALL XERBLA('ZGEMMTR',INFO) + RETURN + END IF +* +* Quick return if possible. +* + IF (N.EQ.0) RETURN +* +* And when alpha.eq.zero. +* + IF (ALPHA.EQ.ZERO) THEN + IF (BETA.EQ.ZERO) THEN + DO 20 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 10 I = ISTART, ISTOP + C(I,J) = ZERO + 10 CONTINUE + 20 CONTINUE + ELSE + DO 40 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + DO 30 I = ISTART, ISTOP + C(I,J) = BETA*C(I,J) + 30 CONTINUE + 40 CONTINUE + END IF + RETURN + END IF +* +* Start the operations. +* + IF (NOTB) THEN + IF (NOTA) THEN +* +* Form C := alpha*A*B + beta*C. +* + DO 90 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + IF (BETA.EQ.ZERO) THEN + DO 50 I = ISTART, ISTOP + C(I,J) = ZERO + 50 CONTINUE + ELSE IF (BETA.NE.ONE) THEN + DO 60 I = ISTART, ISTOP + C(I,J) = BETA*C(I,J) + 60 CONTINUE + END IF + DO 80 L = 1,K + TEMP = ALPHA*B(L,J) + DO 70 I = ISTART, ISTOP + C(I,J) = C(I,J) + TEMP*A(I,L) + 70 CONTINUE + 80 CONTINUE + 90 CONTINUE + ELSE IF (CONJA) THEN +* +* Form C := alpha*A**H*B + beta*C. +* + DO 120 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 110 I = ISTART, ISTOP + TEMP = ZERO + DO 100 L = 1,K + TEMP = TEMP + CONJG(A(L,I))*B(L,J) + 100 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP + ELSE + C(I,J) = ALPHA*TEMP + BETA*C(I,J) + END IF + 110 CONTINUE + 120 CONTINUE + ELSE +* +* Form C := alpha*A**T*B + beta*C +* + DO 150 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 140 I = ISTART, ISTOP + TEMP = ZERO + DO 130 L = 1,K + TEMP = TEMP + A(L,I)*B(L,J) + 130 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP + ELSE + C(I,J) = ALPHA*TEMP + BETA*C(I,J) + END IF + 140 CONTINUE + 150 CONTINUE + END IF + ELSE IF (NOTA) THEN + IF (CONJB) THEN +* +* Form C := alpha*A*B**H + beta*C. +* + DO 200 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + IF (BETA.EQ.ZERO) THEN + DO 160 I = ISTART,ISTOP + C(I,J) = ZERO + 160 CONTINUE + ELSE IF (BETA.NE.ONE) THEN + DO 170 I = ISTART, ISTOP + C(I,J) = BETA*C(I,J) + 170 CONTINUE + END IF + DO 190 L = 1,K + TEMP = ALPHA*CONJG(B(J,L)) + DO 180 I = ISTART, ISTOP + C(I,J) = C(I,J) + TEMP*A(I,L) + 180 CONTINUE + 190 CONTINUE + 200 CONTINUE + ELSE +* +* Form C := alpha*A*B**T + beta*C +* + DO 250 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + IF (BETA.EQ.ZERO) THEN + DO 210 I = ISTART, ISTOP + C(I,J) = ZERO + 210 CONTINUE + ELSE IF (BETA.NE.ONE) THEN + DO 220 I = ISTART, ISTOP + C(I,J) = BETA*C(I,J) + 220 CONTINUE + END IF + DO 240 L = 1,K + TEMP = ALPHA*B(J,L) + DO 230 I = ISTART, ISTOP + C(I,J) = C(I,J) + TEMP*A(I,L) + 230 CONTINUE + 240 CONTINUE + 250 CONTINUE + END IF + ELSE IF (CONJA) THEN + IF (CONJB) THEN +* +* Form C := alpha*A**H*B**H + beta*C. +* + DO 280 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 270 I = ISTART, ISTOP + TEMP = ZERO + DO 260 L = 1,K + TEMP = TEMP + CONJG(A(L,I))*CONJG(B(J,L)) + 260 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP + ELSE + C(I,J) = ALPHA*TEMP + BETA*C(I,J) + END IF + 270 CONTINUE + 280 CONTINUE + ELSE +* +* Form C := alpha*A**H*B**T + beta*C +* + DO 310 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 300 I = ISTART, ISTOP + TEMP = ZERO + DO 290 L = 1,K + TEMP = TEMP + CONJG(A(L,I))*B(J,L) + 290 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP + ELSE + C(I,J) = ALPHA*TEMP + BETA*C(I,J) + END IF + 300 CONTINUE + 310 CONTINUE + END IF + ELSE + IF (CONJB) THEN +* +* Form C := alpha*A**T*B**H + beta*C +* + DO 340 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 330 I = ISTART, ISTOP + TEMP = ZERO + DO 320 L = 1,K + TEMP = TEMP + A(L,I)*CONJG(B(J,L)) + 320 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP + ELSE + C(I,J) = ALPHA*TEMP + BETA*C(I,J) + END IF + 330 CONTINUE + 340 CONTINUE + ELSE +* +* Form C := alpha*A**T*B**T + beta*C +* + DO 370 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 360 I = ISTART, ISTOP + TEMP = ZERO + DO 350 L = 1,K + TEMP = TEMP + A(L,I)*B(J,L) + 350 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP + ELSE + C(I,J) = ALPHA*TEMP + BETA*C(I,J) + END IF + 360 CONTINUE + 370 CONTINUE + END IF + END IF +* + RETURN +* +* End of ZGEMMTR +* + END diff --git a/BLAS/SRC/zgemv.f b/BLAS/SRC/zgemv.f index 7088d383f4..4d41239193 100644 --- a/BLAS/SRC/zgemv.f +++ b/BLAS/SRC/zgemv.f @@ -119,6 +119,8 @@ *> Before entry with BETA non-zero, the incremented array Y *> must contain the vector y. On exit, Y is overwritten by the *> updated vector y. +*> If either m or n is zero, then Y not referenced and the function +*> performs a quick return. *> \endverbatim *> *> \param[in] INCY @@ -136,9 +138,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level2 +*> \ingroup gemv * *> \par Further Details: * ===================== @@ -157,11 +157,11 @@ *> * ===================================================================== SUBROUTINE ZGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ALPHA,BETA @@ -345,6 +345,6 @@ SUBROUTINE ZGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) * RETURN * -* End of ZGEMV . +* End of ZGEMV * END diff --git a/BLAS/SRC/zgerc.f b/BLAS/SRC/zgerc.f index 058dccfc1c..a5f1cfd280 100644 --- a/BLAS/SRC/zgerc.f +++ b/BLAS/SRC/zgerc.f @@ -109,9 +109,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level2 +*> \ingroup ger * *> \par Further Details: * ===================== @@ -129,11 +127,11 @@ *> * ===================================================================== SUBROUTINE ZGERC(M,N,ALPHA,X,INCX,Y,INCY,A,LDA) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ALPHA @@ -222,6 +220,6 @@ SUBROUTINE ZGERC(M,N,ALPHA,X,INCX,Y,INCY,A,LDA) * RETURN * -* End of ZGERC . +* End of ZGERC * END diff --git a/BLAS/SRC/zgeru.f b/BLAS/SRC/zgeru.f index 683a778d50..601eee645a 100644 --- a/BLAS/SRC/zgeru.f +++ b/BLAS/SRC/zgeru.f @@ -109,9 +109,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level2 +*> \ingroup ger * *> \par Further Details: * ===================== @@ -129,11 +127,11 @@ *> * ===================================================================== SUBROUTINE ZGERU(M,N,ALPHA,X,INCX,Y,INCY,A,LDA) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ALPHA @@ -222,6 +220,6 @@ SUBROUTINE ZGERU(M,N,ALPHA,X,INCX,Y,INCY,A,LDA) * RETURN * -* End of ZGERU . +* End of ZGERU * END diff --git a/BLAS/SRC/zhbmv.f b/BLAS/SRC/zhbmv.f index 19d8f7d458..c760e35abd 100644 --- a/BLAS/SRC/zhbmv.f +++ b/BLAS/SRC/zhbmv.f @@ -165,9 +165,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level2 +*> \ingroup hbmv * *> \par Further Details: * ===================== @@ -186,11 +184,11 @@ *> * ===================================================================== SUBROUTINE ZHBMV(UPLO,N,K,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ALPHA,BETA @@ -375,6 +373,6 @@ SUBROUTINE ZHBMV(UPLO,N,K,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) * RETURN * -* End of ZHBMV . +* End of ZHBMV * END diff --git a/BLAS/SRC/zhemm.f b/BLAS/SRC/zhemm.f index d63778b75e..abc36e5d56 100644 --- a/BLAS/SRC/zhemm.f +++ b/BLAS/SRC/zhemm.f @@ -170,9 +170,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level3 +*> \ingroup hemm * *> \par Further Details: * ===================== @@ -190,11 +188,11 @@ *> * ===================================================================== SUBROUTINE ZHEMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC) + IMPLICIT NONE * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ALPHA,BETA @@ -241,9 +239,11 @@ SUBROUTINE ZHEMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * Test the input parameters. * INFO = 0 - IF ((.NOT.LSAME(SIDE,'L')) .AND. (.NOT.LSAME(SIDE,'R'))) THEN + IF ((.NOT.LSAME(SIDE,'L')) .AND. + + (.NOT.LSAME(SIDE,'R'))) THEN INFO = 1 - ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN + ELSE IF ((.NOT.UPPER) .AND. + + (.NOT.LSAME(UPLO,'L'))) THEN INFO = 2 ELSE IF (M.LT.0) THEN INFO = 3 @@ -366,6 +366,6 @@ SUBROUTINE ZHEMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * RETURN * -* End of ZHEMM . +* End of ZHEMM * END diff --git a/BLAS/SRC/zhemv.f b/BLAS/SRC/zhemv.f index 3ea0753f40..390d002056 100644 --- a/BLAS/SRC/zhemv.f +++ b/BLAS/SRC/zhemv.f @@ -132,9 +132,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level2 +*> \ingroup hemv * *> \par Further Details: * ===================== @@ -153,11 +151,11 @@ *> * ===================================================================== SUBROUTINE ZHEMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ALPHA,BETA @@ -332,6 +330,6 @@ SUBROUTINE ZHEMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) * RETURN * -* End of ZHEMV . +* End of ZHEMV * END diff --git a/BLAS/SRC/zher.f b/BLAS/SRC/zher.f index 5e0c89634e..c572daa8b1 100644 --- a/BLAS/SRC/zher.f +++ b/BLAS/SRC/zher.f @@ -114,9 +114,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level2 +*> \ingroup her * *> \par Further Details: * ===================== @@ -134,11 +132,11 @@ *> * ===================================================================== SUBROUTINE ZHER(UPLO,N,ALPHA,X,INCX,A,LDA) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA @@ -273,6 +271,6 @@ SUBROUTINE ZHER(UPLO,N,ALPHA,X,INCX,A,LDA) * RETURN * -* End of ZHER . +* End of ZHER * END diff --git a/BLAS/SRC/zher2.f b/BLAS/SRC/zher2.f index e3a383189d..6d59b00bef 100644 --- a/BLAS/SRC/zher2.f +++ b/BLAS/SRC/zher2.f @@ -129,9 +129,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level2 +*> \ingroup her2 * *> \par Further Details: * ===================== @@ -149,11 +147,11 @@ *> * ===================================================================== SUBROUTINE ZHER2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ALPHA @@ -312,6 +310,6 @@ SUBROUTINE ZHER2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA) * RETURN * -* End of ZHER2 . +* End of ZHER2 * END diff --git a/BLAS/SRC/zher2k.f b/BLAS/SRC/zher2k.f index 474c65e575..6000487f8d 100644 --- a/BLAS/SRC/zher2k.f +++ b/BLAS/SRC/zher2k.f @@ -174,9 +174,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level3 +*> \ingroup her2k * *> \par Further Details: * ===================== @@ -197,11 +195,11 @@ *> * ===================================================================== SUBROUTINE ZHER2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) + IMPLICIT NONE * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ALPHA @@ -438,6 +436,6 @@ SUBROUTINE ZHER2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * RETURN * -* End of ZHER2K. +* End of ZHER2K * END diff --git a/BLAS/SRC/zherk.f b/BLAS/SRC/zherk.f index 0d11f227bf..1ee4bd61f3 100644 --- a/BLAS/SRC/zherk.f +++ b/BLAS/SRC/zherk.f @@ -149,9 +149,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level3 +*> \ingroup herk * *> \par Further Details: * ===================== @@ -172,11 +170,11 @@ *> * ===================================================================== SUBROUTINE ZHERK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC) + IMPLICIT NONE * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA,BETA @@ -355,7 +353,7 @@ SUBROUTINE ZHERK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC) 200 CONTINUE RTEMP = ZERO DO 210 L = 1,K - RTEMP = RTEMP + DCONJG(A(L,J))*A(L,J) + RTEMP = RTEMP + DBLE(DCONJG(A(L,J))*A(L,J)) 210 CONTINUE IF (BETA.EQ.ZERO) THEN C(J,J) = ALPHA*RTEMP @@ -367,7 +365,7 @@ SUBROUTINE ZHERK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC) DO 260 J = 1,N RTEMP = ZERO DO 230 L = 1,K - RTEMP = RTEMP + DCONJG(A(L,J))*A(L,J) + RTEMP = RTEMP + DBLE(DCONJG(A(L,J))*A(L,J)) 230 CONTINUE IF (BETA.EQ.ZERO) THEN C(J,J) = ALPHA*RTEMP @@ -391,6 +389,6 @@ SUBROUTINE ZHERK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC) * RETURN * -* End of ZHERK . +* End of ZHERK * END diff --git a/BLAS/SRC/zhpmv.f b/BLAS/SRC/zhpmv.f index 9bd3ea45a8..9e4d455b2f 100644 --- a/BLAS/SRC/zhpmv.f +++ b/BLAS/SRC/zhpmv.f @@ -127,9 +127,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level2 +*> \ingroup hpmv * *> \par Further Details: * ===================== @@ -148,11 +146,11 @@ *> * ===================================================================== SUBROUTINE ZHPMV(UPLO,N,ALPHA,AP,X,INCX,BETA,Y,INCY) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ALPHA,BETA @@ -333,6 +331,6 @@ SUBROUTINE ZHPMV(UPLO,N,ALPHA,AP,X,INCX,BETA,Y,INCY) * RETURN * -* End of ZHPMV . +* End of ZHPMV * END diff --git a/BLAS/SRC/zhpr.f b/BLAS/SRC/zhpr.f index af82dfbd8c..2a8a9249b8 100644 --- a/BLAS/SRC/zhpr.f +++ b/BLAS/SRC/zhpr.f @@ -109,9 +109,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level2 +*> \ingroup hpr * *> \par Further Details: * ===================== @@ -129,11 +127,11 @@ *> * ===================================================================== SUBROUTINE ZHPR(UPLO,N,ALPHA,X,INCX,AP) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA @@ -274,6 +272,6 @@ SUBROUTINE ZHPR(UPLO,N,ALPHA,X,INCX,AP) * RETURN * -* End of ZHPR . +* End of ZHPR * END diff --git a/BLAS/SRC/zhpr2.f b/BLAS/SRC/zhpr2.f index 1b0fd3aac6..3ab26ac690 100644 --- a/BLAS/SRC/zhpr2.f +++ b/BLAS/SRC/zhpr2.f @@ -124,9 +124,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level2 +*> \ingroup hpr2 * *> \par Further Details: * ===================== @@ -144,11 +142,11 @@ *> * ===================================================================== SUBROUTINE ZHPR2(UPLO,N,ALPHA,X,INCX,Y,INCY,AP) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ALPHA @@ -313,6 +311,6 @@ SUBROUTINE ZHPR2(UPLO,N,ALPHA,X,INCX,Y,INCY,AP) * RETURN * -* End of ZHPR2 . +* End of ZHPR2 * END diff --git a/BLAS/SRC/zrotg.f b/BLAS/SRC/zrotg.f deleted file mode 100644 index 8fcf0851a7..0000000000 --- a/BLAS/SRC/zrotg.f +++ /dev/null @@ -1,98 +0,0 @@ -*> \brief \b ZROTG -* -* =========== DOCUMENTATION =========== -* -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ -* -* Definition: -* =========== -* -* SUBROUTINE ZROTG(CA,CB,C,S) -* -* .. Scalar Arguments .. -* COMPLEX*16 CA,CB,S -* DOUBLE PRECISION C -* .. -* -* -*> \par Purpose: -* ============= -*> -*> \verbatim -*> -*> ZROTG determines a double complex Givens rotation. -*> \endverbatim -* -* Arguments: -* ========== -* -*> \param[in] CA -*> \verbatim -*> CA is COMPLEX*16 -*> \endverbatim -*> -*> \param[in] CB -*> \verbatim -*> CB is COMPLEX*16 -*> \endverbatim -*> -*> \param[out] C -*> \verbatim -*> C is DOUBLE PRECISION -*> \endverbatim -*> -*> \param[out] S -*> \verbatim -*> S is COMPLEX*16 -*> \endverbatim -* -* Authors: -* ======== -* -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. -* -*> \date December 2016 -* -*> \ingroup complex16_blas_level1 -* -* ===================================================================== - SUBROUTINE ZROTG(CA,CB,C,S) -* -* -- Reference BLAS level1 routine (version 3.7.0) -- -* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 -* -* .. Scalar Arguments .. - COMPLEX*16 CA,CB,S - DOUBLE PRECISION C -* .. -* -* ===================================================================== -* -* .. Local Scalars .. - COMPLEX*16 ALPHA - DOUBLE PRECISION NORM,SCALE -* .. -* .. Intrinsic Functions .. - INTRINSIC CDABS,DCMPLX,DCONJG,DSQRT -* .. - IF (CDABS(CA).EQ.0.0d0) THEN - C = 0.0d0 - S = (1.0d0,0.0d0) - CA = CB - ELSE - SCALE = CDABS(CA) + CDABS(CB) - NORM = SCALE*DSQRT((CDABS(CA/DCMPLX(SCALE,0.0d0)))**2+ - $ (CDABS(CB/DCMPLX(SCALE,0.0d0)))**2) - ALPHA = CA/CDABS(CA) - C = CDABS(CA)/NORM - S = ALPHA*DCONJG(CB)/NORM - CA = ALPHA*NORM - END IF - RETURN - END diff --git a/BLAS/SRC/zrotg.f90 b/BLAS/SRC/zrotg.f90 new file mode 100644 index 0000000000..0dae53b837 --- /dev/null +++ b/BLAS/SRC/zrotg.f90 @@ -0,0 +1,277 @@ +!> \brief \b ZROTG generates a Givens rotation with real cosine and complex sine. +! +! =========== DOCUMENTATION =========== +! +! Online html documentation available at +! http://www.netlib.org/lapack/explore-html/ +! +!> \par Purpose: +! ============= +!> +!> \verbatim +!> +!> ZROTG constructs a plane rotation +!> [ c s ] [ a ] = [ r ] +!> [ -conjg(s) c ] [ b ] [ 0 ] +!> where c is real, s is complex, and c**2 + conjg(s)*s = 1. +!> +!> The computation uses the formulas +!> |x| = sqrt( Re(x)**2 + Im(x)**2 ) +!> sgn(x) = x / |x| if x /= 0 +!> = 1 if x = 0 +!> c = |a| / sqrt(|a|**2 + |b|**2) +!> s = sgn(a) * conjg(b) / sqrt(|a|**2 + |b|**2) +!> r = sgn(a)*sqrt(|a|**2 + |b|**2) +!> When a and b are real and r /= 0, the formulas simplify to +!> c = a / r +!> s = b / r +!> the same as in DROTG when |a| > |b|. When |b| >= |a|, the +!> sign of c and s will be different from those computed by DROTG +!> if the signs of a and b are not the same. +!> +!> \endverbatim +!> +!> @see lartg, @see lartgp +! +! Arguments: +! ========== +! +!> \param[in,out] A +!> \verbatim +!> A is DOUBLE COMPLEX +!> On entry, the scalar a. +!> On exit, the scalar r. +!> \endverbatim +!> +!> \param[in] B +!> \verbatim +!> B is DOUBLE COMPLEX +!> The scalar b. +!> \endverbatim +!> +!> \param[out] C +!> \verbatim +!> C is DOUBLE PRECISION +!> The scalar c. +!> \endverbatim +!> +!> \param[out] S +!> \verbatim +!> S is DOUBLE COMPLEX +!> The scalar s. +!> \endverbatim +! +! Authors: +! ======== +! +!> \author Weslley Pereira, University of Colorado Denver, USA +! +!> \date December 2021 +! +!> \ingroup rotg +! +!> \par Further Details: +! ===================== +!> +!> \verbatim +!> +!> Based on the algorithm from +!> +!> Anderson E. (2017) +!> Algorithm 978: Safe Scaling in the Level 1 BLAS +!> ACM Trans Math Softw 44:1--28 +!> https://doi.org/10.1145/3061665 +!> +!> \endverbatim +! +! ===================================================================== +subroutine ZROTG( a, b, c, s ) + implicit none + integer, parameter :: wp = kind(1.d0) +! +! -- Reference BLAS level1 routine -- +! -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +! -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +! +! .. Constants .. + real(wp), parameter :: zero = 0.0_wp + real(wp), parameter :: one = 1.0_wp + complex(wp), parameter :: czero = 0.0_wp +! .. +! .. Scaling constants .. + real(wp), parameter :: safmin = real(radix(0._wp),wp)**max( & + minexponent(0._wp)-1, & + 1-maxexponent(0._wp) & + ) + real(wp), parameter :: safmax = real(radix(0._wp),wp)**max( & + 1-minexponent(0._wp), & + maxexponent(0._wp)-1 & + ) + real(wp), parameter :: rtmin = sqrt( safmin ) +! .. +! .. Scalar Arguments .. + real(wp) :: c + complex(wp) :: a, b, s +! .. +! .. Local Scalars .. + real(wp) :: d, f1, f2, g1, g2, h2, u, v, w, rtmax + complex(wp) :: f, fs, g, gs, r, t +! .. +! .. Intrinsic Functions .. + intrinsic :: abs, aimag, conjg, max, min, real, sqrt +! .. +! .. Statement Functions .. + real(wp) :: ABSSQ +! .. +! .. Statement Function definitions .. + ABSSQ( t ) = real( t )**2 + aimag( t )**2 +! .. +! .. Executable Statements .. +! + f = a + g = b + if( g == czero ) then + c = one + s = czero + r = f + else if( f == czero ) then + c = zero + if( real(g) == zero ) then + r = abs(aimag(g)) + s = conjg( g ) / r + elseif( aimag(g) == zero ) then + r = abs(real(g)) + s = conjg( g ) / r + else + g1 = max( abs(real(g)), abs(aimag(g)) ) + rtmax = sqrt( safmax/2 ) + if( g1 > rtmin .and. g1 < rtmax ) then +! +! Use unscaled algorithm +! +! The following two lines can be replaced by `d = abs( g )`. +! This algorithm do not use the intrinsic complex abs. + g2 = ABSSQ( g ) + d = sqrt( g2 ) + s = conjg( g ) / d + r = d + else +! +! Use scaled algorithm +! + u = min( safmax, max( safmin, g1 ) ) + gs = g / u +! The following two lines can be replaced by `d = abs( gs )`. +! This algorithm do not use the intrinsic complex abs. + g2 = ABSSQ( gs ) + d = sqrt( g2 ) + s = conjg( gs ) / d + r = d*u + end if + end if + else + f1 = max( abs(real(f)), abs(aimag(f)) ) + g1 = max( abs(real(g)), abs(aimag(g)) ) + rtmax = sqrt( safmax/4 ) + if( f1 > rtmin .and. f1 < rtmax .and. & + g1 > rtmin .and. g1 < rtmax ) then +! +! Use unscaled algorithm +! + f2 = ABSSQ( f ) + g2 = ABSSQ( g ) + h2 = f2 + g2 + ! safmin <= f2 <= h2 <= safmax + if( f2 >= h2 * safmin ) then + ! safmin <= f2/h2 <= 1, and h2/f2 is finite + c = sqrt( f2 / h2 ) + r = f / c + rtmax = rtmax * 2 + if( f2 > rtmin .and. h2 < rtmax ) then + ! safmin <= sqrt( f2*h2 ) <= safmax + s = conjg( g ) * ( f / sqrt( f2*h2 ) ) + else + s = conjg( g ) * ( r / h2 ) + end if + else + ! f2/h2 <= safmin may be subnormal, and h2/f2 may overflow. + ! Moreover, + ! safmin <= f2*f2 * safmax < f2 * h2 < h2*h2 * safmin <= safmax, + ! sqrt(safmin) <= sqrt(f2 * h2) <= sqrt(safmax). + ! Also, + ! g2 >> f2, which means that h2 = g2. + d = sqrt( f2 * h2 ) + c = f2 / d + if( c >= safmin ) then + r = f / c + else + ! f2 / sqrt(f2 * h2) < safmin, then + ! sqrt(safmin) <= f2 * sqrt(safmax) <= h2 / sqrt(f2 * h2) <= h2 * (safmin / f2) <= h2 <= safmax + r = f * ( h2 / d ) + end if + s = conjg( g ) * ( f / d ) + end if + else +! +! Use scaled algorithm +! + u = min( safmax, max( safmin, f1, g1 ) ) + gs = g / u + g2 = ABSSQ( gs ) + if( f1 / u < rtmin ) then +! +! f is not well-scaled when scaled by g1. +! Use a different scaling for f. +! + v = min( safmax, max( safmin, f1 ) ) + w = v / u + fs = f / v + f2 = ABSSQ( fs ) + h2 = f2*w**2 + g2 + else +! +! Otherwise use the same scaling for f and g. +! + w = one + fs = f / u + f2 = ABSSQ( fs ) + h2 = f2 + g2 + end if + ! safmin <= f2 <= h2 <= safmax + if( f2 >= h2 * safmin ) then + ! safmin <= f2/h2 <= 1, and h2/f2 is finite + c = sqrt( f2 / h2 ) + r = fs / c + rtmax = rtmax * 2 + if( f2 > rtmin .and. h2 < rtmax ) then + ! safmin <= sqrt( f2*h2 ) <= safmax + s = conjg( gs ) * ( fs / sqrt( f2*h2 ) ) + else + s = conjg( gs ) * ( r / h2 ) + end if + else + ! f2/h2 <= safmin may be subnormal, and h2/f2 may overflow. + ! Moreover, + ! safmin <= f2*f2 * safmax < f2 * h2 < h2*h2 * safmin <= safmax, + ! sqrt(safmin) <= sqrt(f2 * h2) <= sqrt(safmax). + ! Also, + ! g2 >> f2, which means that h2 = g2. + d = sqrt( f2 * h2 ) + c = f2 / d + if( c >= safmin ) then + r = fs / c + else + ! f2 / sqrt(f2 * h2) < safmin, then + ! sqrt(safmin) <= f2 * sqrt(safmax) <= h2 / sqrt(f2 * h2) <= h2 * (safmin / f2) <= h2 <= safmax + r = fs * ( h2 / d ) + end if + s = conjg( gs ) * ( fs / d ) + end if + ! Rescale c and r + c = c * w + r = r * u + end if + end if + a = r + return +end subroutine diff --git a/BLAS/SRC/zscal.f b/BLAS/SRC/zscal.f index 9f6d4b1d39..29db3b1f92 100644 --- a/BLAS/SRC/zscal.f +++ b/BLAS/SRC/zscal.f @@ -61,9 +61,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level1 +*> \ingroup scal * *> \par Further Details: * ===================== @@ -77,11 +75,11 @@ *> * ===================================================================== SUBROUTINE ZSCAL(N,ZA,ZX,INCX) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ZA @@ -96,7 +94,11 @@ SUBROUTINE ZSCAL(N,ZA,ZX,INCX) * .. Local Scalars .. INTEGER I,NINCX * .. - IF (N.LE.0 .OR. INCX.LE.0) RETURN +* .. Parameters .. + COMPLEX*16 ONE + PARAMETER (ONE= (1.0D+0,0.0D+0)) +* .. + IF (N.LE.0 .OR. INCX.LE.0 .OR. ZA.EQ.ONE) RETURN IF (INCX.EQ.1) THEN * * code for increment equal to 1 @@ -114,4 +116,7 @@ SUBROUTINE ZSCAL(N,ZA,ZX,INCX) END DO END IF RETURN +* +* End of ZSCAL +* END diff --git a/BLAS/SRC/zswap.f b/BLAS/SRC/zswap.f index 6768d5e6e0..a13bfffc80 100644 --- a/BLAS/SRC/zswap.f +++ b/BLAS/SRC/zswap.f @@ -65,9 +65,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level1 +*> \ingroup swap * *> \par Further Details: * ===================== @@ -80,11 +78,11 @@ *> * ===================================================================== SUBROUTINE ZSWAP(N,ZX,INCX,ZY,INCY) + IMPLICIT NONE * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,INCY,N @@ -126,4 +124,7 @@ SUBROUTINE ZSWAP(N,ZX,INCX,ZY,INCY) END DO END IF RETURN +* +* End of ZSWAP +* END diff --git a/BLAS/SRC/zsymm.f b/BLAS/SRC/zsymm.f index bd37934aee..6990fed816 100644 --- a/BLAS/SRC/zsymm.f +++ b/BLAS/SRC/zsymm.f @@ -168,9 +168,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level3 +*> \ingroup hemm * *> \par Further Details: * ===================== @@ -188,11 +186,11 @@ *> * ===================================================================== SUBROUTINE ZSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC) + IMPLICIT NONE * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ALPHA,BETA @@ -239,9 +237,11 @@ SUBROUTINE ZSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * Test the input parameters. * INFO = 0 - IF ((.NOT.LSAME(SIDE,'L')) .AND. (.NOT.LSAME(SIDE,'R'))) THEN + IF ((.NOT.LSAME(SIDE,'L')) .AND. + + (.NOT.LSAME(SIDE,'R'))) THEN INFO = 1 - ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN + ELSE IF ((.NOT.UPPER) .AND. + + (.NOT.LSAME(UPLO,'L'))) THEN INFO = 2 ELSE IF (M.LT.0) THEN INFO = 3 @@ -364,6 +364,6 @@ SUBROUTINE ZSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * RETURN * -* End of ZSYMM . +* End of ZSYMM * END diff --git a/BLAS/SRC/zsyr2k.f b/BLAS/SRC/zsyr2k.f index 92bbfeeb5c..3c0aab1432 100644 --- a/BLAS/SRC/zsyr2k.f +++ b/BLAS/SRC/zsyr2k.f @@ -167,9 +167,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level3 +*> \ingroup her2k * *> \par Further Details: * ===================== @@ -187,11 +185,11 @@ *> * ===================================================================== SUBROUTINE ZSYR2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) + IMPLICIT NONE * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ALPHA,BETA @@ -391,6 +389,6 @@ SUBROUTINE ZSYR2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * RETURN * -* End of ZSYR2K. +* End of ZSYR2K * END diff --git a/BLAS/SRC/zsyrk.f b/BLAS/SRC/zsyrk.f index 122539f58e..7589727406 100644 --- a/BLAS/SRC/zsyrk.f +++ b/BLAS/SRC/zsyrk.f @@ -146,9 +146,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level3 +*> \ingroup herk * *> \par Further Details: * ===================== @@ -166,11 +164,11 @@ *> * ===================================================================== SUBROUTINE ZSYRK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC) + IMPLICIT NONE * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ALPHA,BETA @@ -358,6 +356,6 @@ SUBROUTINE ZSYRK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC) * RETURN * -* End of ZSYRK . +* End of ZSYRK * END diff --git a/BLAS/SRC/ztbmv.f b/BLAS/SRC/ztbmv.f index a4d9c2ed1b..7860f6a9c5 100644 --- a/BLAS/SRC/ztbmv.f +++ b/BLAS/SRC/ztbmv.f @@ -164,9 +164,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level2 +*> \ingroup tbmv * *> \par Further Details: * ===================== @@ -185,11 +183,11 @@ *> * ===================================================================== SUBROUTINE ZTBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,K,LDA,N @@ -200,10 +198,6 @@ SUBROUTINE ZTBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) * .. * * ===================================================================== -* -* .. Parameters .. - COMPLEX*16 ZERO - PARAMETER (ZERO= (0.0D+0,0.0D+0)) * .. * .. Local Scalars .. COMPLEX*16 TEMP @@ -226,10 +220,12 @@ SUBROUTINE ZTBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) INFO = 0 IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN INFO = 1 - ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND. + ELSE IF (.NOT.LSAME(TRANS,'N') .AND. + + .NOT.LSAME(TRANS,'T') .AND. + .NOT.LSAME(TRANS,'C')) THEN INFO = 2 - ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN + ELSE IF (.NOT.LSAME(DIAG,'U') .AND. + + .NOT.LSAME(DIAG,'N')) THEN INFO = 3 ELSE IF (N.LT.0) THEN INFO = 4 @@ -272,28 +268,24 @@ SUBROUTINE ZTBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) KPLUS1 = K + 1 IF (INCX.EQ.1) THEN DO 20 J = 1,N - IF (X(J).NE.ZERO) THEN - TEMP = X(J) - L = KPLUS1 - J - DO 10 I = MAX(1,J-K),J - 1 - X(I) = X(I) + TEMP*A(L+I,J) - 10 CONTINUE - IF (NOUNIT) X(J) = X(J)*A(KPLUS1,J) - END IF + TEMP = X(J) + L = KPLUS1 - J + DO 10 I = MAX(1,J-K),J - 1 + X(I) = X(I) + TEMP*A(L+I,J) + 10 CONTINUE + IF (NOUNIT) X(J) = X(J)*A(KPLUS1,J) 20 CONTINUE ELSE JX = KX DO 40 J = 1,N - IF (X(JX).NE.ZERO) THEN - TEMP = X(JX) - IX = KX - L = KPLUS1 - J - DO 30 I = MAX(1,J-K),J - 1 - X(IX) = X(IX) + TEMP*A(L+I,J) - IX = IX + INCX - 30 CONTINUE - IF (NOUNIT) X(JX) = X(JX)*A(KPLUS1,J) - END IF + TEMP = X(JX) + IX = KX + L = KPLUS1 - J + DO 30 I = MAX(1,J-K),J - 1 + X(IX) = X(IX) + TEMP*A(L+I,J) + IX = IX + INCX + 30 CONTINUE + IF (NOUNIT) X(JX) = X(JX)*A(KPLUS1,J) JX = JX + INCX IF (J.GT.K) KX = KX + INCX 40 CONTINUE @@ -301,29 +293,25 @@ SUBROUTINE ZTBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) ELSE IF (INCX.EQ.1) THEN DO 60 J = N,1,-1 - IF (X(J).NE.ZERO) THEN - TEMP = X(J) - L = 1 - J - DO 50 I = MIN(N,J+K),J + 1,-1 - X(I) = X(I) + TEMP*A(L+I,J) - 50 CONTINUE - IF (NOUNIT) X(J) = X(J)*A(1,J) - END IF + TEMP = X(J) + L = 1 - J + DO 50 I = MIN(N,J+K),J + 1,-1 + X(I) = X(I) + TEMP*A(L+I,J) + 50 CONTINUE + IF (NOUNIT) X(J) = X(J)*A(1,J) 60 CONTINUE ELSE KX = KX + (N-1)*INCX JX = KX DO 80 J = N,1,-1 - IF (X(JX).NE.ZERO) THEN - TEMP = X(JX) - IX = KX - L = 1 - J - DO 70 I = MIN(N,J+K),J + 1,-1 - X(IX) = X(IX) + TEMP*A(L+I,J) - IX = IX - INCX - 70 CONTINUE - IF (NOUNIT) X(JX) = X(JX)*A(1,J) - END IF + TEMP = X(JX) + IX = KX + L = 1 - J + DO 70 I = MIN(N,J+K),J + 1,-1 + X(IX) = X(IX) + TEMP*A(L+I,J) + IX = IX - INCX + 70 CONTINUE + IF (NOUNIT) X(JX) = X(JX)*A(1,J) JX = JX - INCX IF ((N-J).GE.K) KX = KX - INCX 80 CONTINUE @@ -424,6 +412,6 @@ SUBROUTINE ZTBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) * RETURN * -* End of ZTBMV . +* End of ZTBMV * END diff --git a/BLAS/SRC/ztbsv.f b/BLAS/SRC/ztbsv.f index eaf8500468..1b6af2b13e 100644 --- a/BLAS/SRC/ztbsv.f +++ b/BLAS/SRC/ztbsv.f @@ -168,9 +168,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level2 +*> \ingroup tbsv * *> \par Further Details: * ===================== @@ -188,11 +186,11 @@ *> * ===================================================================== SUBROUTINE ZTBSV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,K,LDA,N @@ -203,10 +201,6 @@ SUBROUTINE ZTBSV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) * .. * * ===================================================================== -* -* .. Parameters .. - COMPLEX*16 ZERO - PARAMETER (ZERO= (0.0D+0,0.0D+0)) * .. * .. Local Scalars .. COMPLEX*16 TEMP @@ -229,10 +223,12 @@ SUBROUTINE ZTBSV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) INFO = 0 IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN INFO = 1 - ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND. + ELSE IF (.NOT.LSAME(TRANS,'N') .AND. + + .NOT.LSAME(TRANS,'T') .AND. + .NOT.LSAME(TRANS,'C')) THEN INFO = 2 - ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN + ELSE IF (.NOT.LSAME(DIAG,'U') .AND. + + .NOT.LSAME(DIAG,'N')) THEN INFO = 3 ELSE IF (N.LT.0) THEN INFO = 4 @@ -275,59 +271,51 @@ SUBROUTINE ZTBSV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) KPLUS1 = K + 1 IF (INCX.EQ.1) THEN DO 20 J = N,1,-1 - IF (X(J).NE.ZERO) THEN - L = KPLUS1 - J - IF (NOUNIT) X(J) = X(J)/A(KPLUS1,J) - TEMP = X(J) - DO 10 I = J - 1,MAX(1,J-K),-1 - X(I) = X(I) - TEMP*A(L+I,J) - 10 CONTINUE - END IF + L = KPLUS1 - J + IF (NOUNIT) X(J) = X(J)/A(KPLUS1,J) + TEMP = X(J) + DO 10 I = J - 1,MAX(1,J-K),-1 + X(I) = X(I) - TEMP*A(L+I,J) + 10 CONTINUE 20 CONTINUE ELSE KX = KX + (N-1)*INCX JX = KX DO 40 J = N,1,-1 KX = KX - INCX - IF (X(JX).NE.ZERO) THEN - IX = KX - L = KPLUS1 - J - IF (NOUNIT) X(JX) = X(JX)/A(KPLUS1,J) - TEMP = X(JX) - DO 30 I = J - 1,MAX(1,J-K),-1 - X(IX) = X(IX) - TEMP*A(L+I,J) - IX = IX - INCX - 30 CONTINUE - END IF + IX = KX + L = KPLUS1 - J + IF (NOUNIT) X(JX) = X(JX)/A(KPLUS1,J) + TEMP = X(JX) + DO 30 I = J - 1,MAX(1,J-K),-1 + X(IX) = X(IX) - TEMP*A(L+I,J) + IX = IX - INCX + 30 CONTINUE JX = JX - INCX 40 CONTINUE END IF ELSE IF (INCX.EQ.1) THEN DO 60 J = 1,N - IF (X(J).NE.ZERO) THEN - L = 1 - J - IF (NOUNIT) X(J) = X(J)/A(1,J) - TEMP = X(J) - DO 50 I = J + 1,MIN(N,J+K) - X(I) = X(I) - TEMP*A(L+I,J) - 50 CONTINUE - END IF + L = 1 - J + IF (NOUNIT) X(J) = X(J)/A(1,J) + TEMP = X(J) + DO 50 I = J + 1,MIN(N,J+K) + X(I) = X(I) - TEMP*A(L+I,J) + 50 CONTINUE 60 CONTINUE ELSE JX = KX DO 80 J = 1,N KX = KX + INCX - IF (X(JX).NE.ZERO) THEN - IX = KX - L = 1 - J - IF (NOUNIT) X(JX) = X(JX)/A(1,J) - TEMP = X(JX) - DO 70 I = J + 1,MIN(N,J+K) - X(IX) = X(IX) - TEMP*A(L+I,J) - IX = IX + INCX - 70 CONTINUE - END IF + IX = KX + L = 1 - J + IF (NOUNIT) X(JX) = X(JX)/A(1,J) + TEMP = X(JX) + DO 70 I = J + 1,MIN(N,J+K) + X(IX) = X(IX) - TEMP*A(L+I,J) + IX = IX + INCX + 70 CONTINUE JX = JX + INCX 80 CONTINUE END IF @@ -427,6 +415,6 @@ SUBROUTINE ZTBSV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX) * RETURN * -* End of ZTBSV . +* End of ZTBSV * END diff --git a/BLAS/SRC/ztpmv.f b/BLAS/SRC/ztpmv.f index 65aa2a0abc..72465b74e5 100644 --- a/BLAS/SRC/ztpmv.f +++ b/BLAS/SRC/ztpmv.f @@ -120,9 +120,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level2 +*> \ingroup tpmv * *> \par Further Details: * ===================== @@ -141,11 +139,11 @@ *> * ===================================================================== SUBROUTINE ZTPMV(UPLO,TRANS,DIAG,N,AP,X,INCX) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,N @@ -156,10 +154,6 @@ SUBROUTINE ZTPMV(UPLO,TRANS,DIAG,N,AP,X,INCX) * .. * * ===================================================================== -* -* .. Parameters .. - COMPLEX*16 ZERO - PARAMETER (ZERO= (0.0D+0,0.0D+0)) * .. * .. Local Scalars .. COMPLEX*16 TEMP @@ -182,10 +176,12 @@ SUBROUTINE ZTPMV(UPLO,TRANS,DIAG,N,AP,X,INCX) INFO = 0 IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN INFO = 1 - ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND. + ELSE IF (.NOT.LSAME(TRANS,'N') .AND. + + .NOT.LSAME(TRANS,'T') .AND. + .NOT.LSAME(TRANS,'C')) THEN INFO = 2 - ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN + ELSE IF (.NOT.LSAME(DIAG,'U') .AND. + + .NOT.LSAME(DIAG,'N')) THEN INFO = 3 ELSE IF (N.LT.0) THEN INFO = 4 @@ -224,29 +220,25 @@ SUBROUTINE ZTPMV(UPLO,TRANS,DIAG,N,AP,X,INCX) KK = 1 IF (INCX.EQ.1) THEN DO 20 J = 1,N - IF (X(J).NE.ZERO) THEN - TEMP = X(J) - K = KK - DO 10 I = 1,J - 1 - X(I) = X(I) + TEMP*AP(K) - K = K + 1 - 10 CONTINUE - IF (NOUNIT) X(J) = X(J)*AP(KK+J-1) - END IF + TEMP = X(J) + K = KK + DO 10 I = 1,J - 1 + X(I) = X(I) + TEMP*AP(K) + K = K + 1 + 10 CONTINUE + IF (NOUNIT) X(J) = X(J)*AP(KK+J-1) KK = KK + J 20 CONTINUE ELSE JX = KX DO 40 J = 1,N - IF (X(JX).NE.ZERO) THEN - TEMP = X(JX) - IX = KX - DO 30 K = KK,KK + J - 2 - X(IX) = X(IX) + TEMP*AP(K) - IX = IX + INCX - 30 CONTINUE - IF (NOUNIT) X(JX) = X(JX)*AP(KK+J-1) - END IF + TEMP = X(JX) + IX = KX + DO 30 K = KK,KK + J - 2 + X(IX) = X(IX) + TEMP*AP(K) + IX = IX + INCX + 30 CONTINUE + IF (NOUNIT) X(JX) = X(JX)*AP(KK+J-1) JX = JX + INCX KK = KK + J 40 CONTINUE @@ -255,30 +247,26 @@ SUBROUTINE ZTPMV(UPLO,TRANS,DIAG,N,AP,X,INCX) KK = (N* (N+1))/2 IF (INCX.EQ.1) THEN DO 60 J = N,1,-1 - IF (X(J).NE.ZERO) THEN - TEMP = X(J) - K = KK - DO 50 I = N,J + 1,-1 - X(I) = X(I) + TEMP*AP(K) - K = K - 1 - 50 CONTINUE - IF (NOUNIT) X(J) = X(J)*AP(KK-N+J) - END IF + TEMP = X(J) + K = KK + DO 50 I = N,J + 1,-1 + X(I) = X(I) + TEMP*AP(K) + K = K - 1 + 50 CONTINUE + IF (NOUNIT) X(J) = X(J)*AP(KK-N+J) KK = KK - (N-J+1) 60 CONTINUE ELSE KX = KX + (N-1)*INCX JX = KX DO 80 J = N,1,-1 - IF (X(JX).NE.ZERO) THEN - TEMP = X(JX) - IX = KX - DO 70 K = KK,KK - (N- (J+1)),-1 - X(IX) = X(IX) + TEMP*AP(K) - IX = IX - INCX - 70 CONTINUE - IF (NOUNIT) X(JX) = X(JX)*AP(KK-N+J) - END IF + TEMP = X(JX) + IX = KX + DO 70 K = KK,KK - (N- (J+1)),-1 + X(IX) = X(IX) + TEMP*AP(K) + IX = IX - INCX + 70 CONTINUE + IF (NOUNIT) X(JX) = X(JX)*AP(KK-N+J) JX = JX - INCX KK = KK - (N-J+1) 80 CONTINUE @@ -383,6 +371,6 @@ SUBROUTINE ZTPMV(UPLO,TRANS,DIAG,N,AP,X,INCX) * RETURN * -* End of ZTPMV . +* End of ZTPMV * END diff --git a/BLAS/SRC/ztpsv.f b/BLAS/SRC/ztpsv.f index 538888424a..09a75a0487 100644 --- a/BLAS/SRC/ztpsv.f +++ b/BLAS/SRC/ztpsv.f @@ -123,9 +123,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level2 +*> \ingroup tpsv * *> \par Further Details: * ===================== @@ -143,11 +141,11 @@ *> * ===================================================================== SUBROUTINE ZTPSV(UPLO,TRANS,DIAG,N,AP,X,INCX) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,N @@ -158,10 +156,6 @@ SUBROUTINE ZTPSV(UPLO,TRANS,DIAG,N,AP,X,INCX) * .. * * ===================================================================== -* -* .. Parameters .. - COMPLEX*16 ZERO - PARAMETER (ZERO= (0.0D+0,0.0D+0)) * .. * .. Local Scalars .. COMPLEX*16 TEMP @@ -184,10 +178,12 @@ SUBROUTINE ZTPSV(UPLO,TRANS,DIAG,N,AP,X,INCX) INFO = 0 IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN INFO = 1 - ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND. + ELSE IF (.NOT.LSAME(TRANS,'N') .AND. + + .NOT.LSAME(TRANS,'T') .AND. + .NOT.LSAME(TRANS,'C')) THEN INFO = 2 - ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN + ELSE IF (.NOT.LSAME(DIAG,'U') .AND. + + .NOT.LSAME(DIAG,'N')) THEN INFO = 3 ELSE IF (N.LT.0) THEN INFO = 4 @@ -226,29 +222,25 @@ SUBROUTINE ZTPSV(UPLO,TRANS,DIAG,N,AP,X,INCX) KK = (N* (N+1))/2 IF (INCX.EQ.1) THEN DO 20 J = N,1,-1 - IF (X(J).NE.ZERO) THEN - IF (NOUNIT) X(J) = X(J)/AP(KK) - TEMP = X(J) - K = KK - 1 - DO 10 I = J - 1,1,-1 - X(I) = X(I) - TEMP*AP(K) - K = K - 1 - 10 CONTINUE - END IF + IF (NOUNIT) X(J) = X(J)/AP(KK) + TEMP = X(J) + K = KK - 1 + DO 10 I = J - 1,1,-1 + X(I) = X(I) - TEMP*AP(K) + K = K - 1 + 10 CONTINUE KK = KK - J 20 CONTINUE ELSE JX = KX + (N-1)*INCX DO 40 J = N,1,-1 - IF (X(JX).NE.ZERO) THEN - IF (NOUNIT) X(JX) = X(JX)/AP(KK) - TEMP = X(JX) - IX = JX - DO 30 K = KK - 1,KK - J + 1,-1 - IX = IX - INCX - X(IX) = X(IX) - TEMP*AP(K) - 30 CONTINUE - END IF + IF (NOUNIT) X(JX) = X(JX)/AP(KK) + TEMP = X(JX) + IX = JX + DO 30 K = KK - 1,KK - J + 1,-1 + IX = IX - INCX + X(IX) = X(IX) - TEMP*AP(K) + 30 CONTINUE JX = JX - INCX KK = KK - J 40 CONTINUE @@ -257,29 +249,25 @@ SUBROUTINE ZTPSV(UPLO,TRANS,DIAG,N,AP,X,INCX) KK = 1 IF (INCX.EQ.1) THEN DO 60 J = 1,N - IF (X(J).NE.ZERO) THEN - IF (NOUNIT) X(J) = X(J)/AP(KK) - TEMP = X(J) - K = KK + 1 - DO 50 I = J + 1,N - X(I) = X(I) - TEMP*AP(K) - K = K + 1 - 50 CONTINUE - END IF + IF (NOUNIT) X(J) = X(J)/AP(KK) + TEMP = X(J) + K = KK + 1 + DO 50 I = J + 1,N + X(I) = X(I) - TEMP*AP(K) + K = K + 1 + 50 CONTINUE KK = KK + (N-J+1) 60 CONTINUE ELSE JX = KX DO 80 J = 1,N - IF (X(JX).NE.ZERO) THEN - IF (NOUNIT) X(JX) = X(JX)/AP(KK) - TEMP = X(JX) - IX = JX - DO 70 K = KK + 1,KK + N - J - IX = IX + INCX - X(IX) = X(IX) - TEMP*AP(K) - 70 CONTINUE - END IF + IF (NOUNIT) X(JX) = X(JX)/AP(KK) + TEMP = X(JX) + IX = JX + DO 70 K = KK + 1,KK + N - J + IX = IX + INCX + X(IX) = X(IX) - TEMP*AP(K) + 70 CONTINUE JX = JX + INCX KK = KK + (N-J+1) 80 CONTINUE @@ -385,6 +373,6 @@ SUBROUTINE ZTPSV(UPLO,TRANS,DIAG,N,AP,X,INCX) * RETURN * -* End of ZTPSV . +* End of ZTPSV * END diff --git a/BLAS/SRC/ztrmm.f b/BLAS/SRC/ztrmm.f index 0f445f52a7..4c370e1058 100644 --- a/BLAS/SRC/ztrmm.f +++ b/BLAS/SRC/ztrmm.f @@ -156,9 +156,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level3 +*> \ingroup trmm * *> \par Further Details: * ===================== @@ -176,11 +174,11 @@ *> * ===================================================================== SUBROUTINE ZTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) + IMPLICIT NONE * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ALPHA @@ -236,7 +234,8 @@ SUBROUTINE ZTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) + (.NOT.LSAME(TRANSA,'T')) .AND. + (.NOT.LSAME(TRANSA,'C'))) THEN INFO = 3 - ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN + ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. + + (.NOT.LSAME(DIAG,'N'))) THEN INFO = 4 ELSE IF (M.LT.0) THEN INFO = 5 @@ -277,27 +276,23 @@ SUBROUTINE ZTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) IF (UPPER) THEN DO 50 J = 1,N DO 40 K = 1,M - IF (B(K,J).NE.ZERO) THEN - TEMP = ALPHA*B(K,J) - DO 30 I = 1,K - 1 - B(I,J) = B(I,J) + TEMP*A(I,K) - 30 CONTINUE - IF (NOUNIT) TEMP = TEMP*A(K,K) - B(K,J) = TEMP - END IF + TEMP = ALPHA*B(K,J) + DO 30 I = 1,K - 1 + B(I,J) = B(I,J) + TEMP*A(I,K) + 30 CONTINUE + IF (NOUNIT) TEMP = TEMP*A(K,K) + B(K,J) = TEMP 40 CONTINUE 50 CONTINUE ELSE DO 80 J = 1,N DO 70 K = M,1,-1 - IF (B(K,J).NE.ZERO) THEN - TEMP = ALPHA*B(K,J) - B(K,J) = TEMP - IF (NOUNIT) B(K,J) = B(K,J)*A(K,K) - DO 60 I = K + 1,M - B(I,J) = B(I,J) + TEMP*A(I,K) - 60 CONTINUE - END IF + TEMP = ALPHA*B(K,J) + B(K,J) = TEMP + IF (NOUNIT) B(K,J) = B(K,J)*A(K,K) + DO 60 I = K + 1,M + B(I,J) = B(I,J) + TEMP*A(I,K) + 60 CONTINUE 70 CONTINUE 80 CONTINUE END IF @@ -356,12 +351,10 @@ SUBROUTINE ZTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) B(I,J) = TEMP*B(I,J) 170 CONTINUE DO 190 K = 1,J - 1 - IF (A(K,J).NE.ZERO) THEN - TEMP = ALPHA*A(K,J) - DO 180 I = 1,M - B(I,J) = B(I,J) + TEMP*B(I,K) - 180 CONTINUE - END IF + TEMP = ALPHA*A(K,J) + DO 180 I = 1,M + B(I,J) = B(I,J) + TEMP*B(I,K) + 180 CONTINUE 190 CONTINUE 200 CONTINUE ELSE @@ -372,12 +365,10 @@ SUBROUTINE ZTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) B(I,J) = TEMP*B(I,J) 210 CONTINUE DO 230 K = J + 1,N - IF (A(K,J).NE.ZERO) THEN - TEMP = ALPHA*A(K,J) - DO 220 I = 1,M - B(I,J) = B(I,J) + TEMP*B(I,K) - 220 CONTINUE - END IF + TEMP = ALPHA*A(K,J) + DO 220 I = 1,M + B(I,J) = B(I,J) + TEMP*B(I,K) + 220 CONTINUE 230 CONTINUE 240 CONTINUE END IF @@ -388,16 +379,14 @@ SUBROUTINE ZTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) IF (UPPER) THEN DO 280 K = 1,N DO 260 J = 1,K - 1 - IF (A(J,K).NE.ZERO) THEN - IF (NOCONJ) THEN - TEMP = ALPHA*A(J,K) - ELSE - TEMP = ALPHA*DCONJG(A(J,K)) - END IF - DO 250 I = 1,M - B(I,J) = B(I,J) + TEMP*B(I,K) - 250 CONTINUE + IF (NOCONJ) THEN + TEMP = ALPHA*A(J,K) + ELSE + TEMP = ALPHA*DCONJG(A(J,K)) END IF + DO 250 I = 1,M + B(I,J) = B(I,J) + TEMP*B(I,K) + 250 CONTINUE 260 CONTINUE TEMP = ALPHA IF (NOUNIT) THEN @@ -416,16 +405,14 @@ SUBROUTINE ZTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) ELSE DO 320 K = N,1,-1 DO 300 J = K + 1,N - IF (A(J,K).NE.ZERO) THEN - IF (NOCONJ) THEN - TEMP = ALPHA*A(J,K) - ELSE - TEMP = ALPHA*DCONJG(A(J,K)) - END IF - DO 290 I = 1,M - B(I,J) = B(I,J) + TEMP*B(I,K) - 290 CONTINUE + IF (NOCONJ) THEN + TEMP = ALPHA*A(J,K) + ELSE + TEMP = ALPHA*DCONJG(A(J,K)) END IF + DO 290 I = 1,M + B(I,J) = B(I,J) + TEMP*B(I,K) + 290 CONTINUE 300 CONTINUE TEMP = ALPHA IF (NOUNIT) THEN @@ -447,6 +434,6 @@ SUBROUTINE ZTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) * RETURN * -* End of ZTRMM . +* End of ZTRMM * END diff --git a/BLAS/SRC/ztrmv.f b/BLAS/SRC/ztrmv.f index 52d1ae6799..036cc9b3c3 100644 --- a/BLAS/SRC/ztrmv.f +++ b/BLAS/SRC/ztrmv.f @@ -125,9 +125,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level2 +*> \ingroup trmv * *> \par Further Details: * ===================== @@ -146,11 +144,11 @@ *> * ===================================================================== SUBROUTINE ZTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,LDA,N @@ -161,10 +159,6 @@ SUBROUTINE ZTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) * .. * * ===================================================================== -* -* .. Parameters .. - COMPLEX*16 ZERO - PARAMETER (ZERO= (0.0D+0,0.0D+0)) * .. * .. Local Scalars .. COMPLEX*16 TEMP @@ -187,10 +181,12 @@ SUBROUTINE ZTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) INFO = 0 IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN INFO = 1 - ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND. + ELSE IF (.NOT.LSAME(TRANS,'N') .AND. + + .NOT.LSAME(TRANS,'T') .AND. + .NOT.LSAME(TRANS,'C')) THEN INFO = 2 - ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN + ELSE IF (.NOT.LSAME(DIAG,'U') .AND. + + .NOT.LSAME(DIAG,'N')) THEN INFO = 3 ELSE IF (N.LT.0) THEN INFO = 4 @@ -230,53 +226,45 @@ SUBROUTINE ZTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) IF (LSAME(UPLO,'U')) THEN IF (INCX.EQ.1) THEN DO 20 J = 1,N - IF (X(J).NE.ZERO) THEN - TEMP = X(J) - DO 10 I = 1,J - 1 - X(I) = X(I) + TEMP*A(I,J) - 10 CONTINUE - IF (NOUNIT) X(J) = X(J)*A(J,J) - END IF + TEMP = X(J) + DO 10 I = 1,J - 1 + X(I) = X(I) + TEMP*A(I,J) + 10 CONTINUE + IF (NOUNIT) X(J) = X(J)*A(J,J) 20 CONTINUE ELSE JX = KX DO 40 J = 1,N - IF (X(JX).NE.ZERO) THEN - TEMP = X(JX) - IX = KX - DO 30 I = 1,J - 1 - X(IX) = X(IX) + TEMP*A(I,J) - IX = IX + INCX - 30 CONTINUE - IF (NOUNIT) X(JX) = X(JX)*A(J,J) - END IF + TEMP = X(JX) + IX = KX + DO 30 I = 1,J - 1 + X(IX) = X(IX) + TEMP*A(I,J) + IX = IX + INCX + 30 CONTINUE + IF (NOUNIT) X(JX) = X(JX)*A(J,J) JX = JX + INCX 40 CONTINUE END IF ELSE IF (INCX.EQ.1) THEN DO 60 J = N,1,-1 - IF (X(J).NE.ZERO) THEN - TEMP = X(J) - DO 50 I = N,J + 1,-1 - X(I) = X(I) + TEMP*A(I,J) - 50 CONTINUE - IF (NOUNIT) X(J) = X(J)*A(J,J) - END IF + TEMP = X(J) + DO 50 I = N,J + 1,-1 + X(I) = X(I) + TEMP*A(I,J) + 50 CONTINUE + IF (NOUNIT) X(J) = X(J)*A(J,J) 60 CONTINUE ELSE KX = KX + (N-1)*INCX JX = KX DO 80 J = N,1,-1 - IF (X(JX).NE.ZERO) THEN - TEMP = X(JX) - IX = KX - DO 70 I = N,J + 1,-1 - X(IX) = X(IX) + TEMP*A(I,J) - IX = IX - INCX - 70 CONTINUE - IF (NOUNIT) X(JX) = X(JX)*A(J,J) - END IF + TEMP = X(JX) + IX = KX + DO 70 I = N,J + 1,-1 + X(IX) = X(IX) + TEMP*A(I,J) + IX = IX - INCX + 70 CONTINUE + IF (NOUNIT) X(JX) = X(JX)*A(J,J) JX = JX - INCX 80 CONTINUE END IF @@ -368,6 +356,6 @@ SUBROUTINE ZTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) * RETURN * -* End of ZTRMV . +* End of ZTRMV * END diff --git a/BLAS/SRC/ztrsm.f b/BLAS/SRC/ztrsm.f index 46a6afc77d..32367632bf 100644 --- a/BLAS/SRC/ztrsm.f +++ b/BLAS/SRC/ztrsm.f @@ -159,9 +159,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level3 +*> \ingroup trsm * *> \par Further Details: * ===================== @@ -179,11 +177,11 @@ *> * ===================================================================== SUBROUTINE ZTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) + IMPLICIT NONE * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ALPHA @@ -212,8 +210,6 @@ SUBROUTINE ZTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) LOGICAL LSIDE,NOCONJ,NOUNIT,UPPER * .. * .. Parameters .. - COMPLEX*16 ONE - PARAMETER (ONE= (1.0D+0,0.0D+0)) COMPLEX*16 ZERO PARAMETER (ZERO= (0.0D+0,0.0D+0)) * .. @@ -239,7 +235,8 @@ SUBROUTINE ZTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) + (.NOT.LSAME(TRANSA,'T')) .AND. + (.NOT.LSAME(TRANSA,'C'))) THEN INFO = 3 - ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN + ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. + + (.NOT.LSAME(DIAG,'N'))) THEN INFO = 4 ELSE IF (M.LT.0) THEN INFO = 5 @@ -279,34 +276,26 @@ SUBROUTINE ZTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) * IF (UPPER) THEN DO 60 J = 1,N - IF (ALPHA.NE.ONE) THEN - DO 30 I = 1,M - B(I,J) = ALPHA*B(I,J) - 30 CONTINUE - END IF - DO 50 K = M,1,-1 - IF (B(K,J).NE.ZERO) THEN - IF (NOUNIT) B(K,J) = B(K,J)/A(K,K) - DO 40 I = 1,K - 1 - B(I,J) = B(I,J) - B(K,J)*A(I,K) - 40 CONTINUE - END IF + DO 30 I = 1,M + B(I,J) = ALPHA*B(I,J) + 30 CONTINUE + DO 50 K = M,1,-1 + IF (NOUNIT) B(K,J) = B(K,J)/A(K,K) + DO 40 I = 1,K - 1 + B(I,J) = B(I,J) - B(K,J)*A(I,K) + 40 CONTINUE 50 CONTINUE 60 CONTINUE - ELSE - DO 100 J = 1,N - IF (ALPHA.NE.ONE) THEN - DO 70 I = 1,M - B(I,J) = ALPHA*B(I,J) - 70 CONTINUE - END IF - DO 90 K = 1,M - IF (B(K,J).NE.ZERO) THEN - IF (NOUNIT) B(K,J) = B(K,J)/A(K,K) - DO 80 I = K + 1,M - B(I,J) = B(I,J) - B(K,J)*A(I,K) - 80 CONTINUE - END IF + ELSE + DO 100 J = 1,N + DO 70 I = 1,M + B(I,J) = ALPHA*B(I,J) + 70 CONTINUE + DO 90 K = 1,M + IF (NOUNIT) B(K,J) = B(K,J)/A(K,K) + DO 80 I = K + 1,M + B(I,J) = B(I,J) - B(K,J)*A(I,K) + 80 CONTINUE 90 CONTINUE 100 CONTINUE END IF @@ -360,43 +349,33 @@ SUBROUTINE ZTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) * IF (UPPER) THEN DO 230 J = 1,N - IF (ALPHA.NE.ONE) THEN - DO 190 I = 1,M - B(I,J) = ALPHA*B(I,J) - 190 CONTINUE - END IF + DO 190 I = 1,M + B(I,J) = ALPHA*B(I,J) + 190 CONTINUE DO 210 K = 1,J - 1 - IF (A(K,J).NE.ZERO) THEN - DO 200 I = 1,M - B(I,J) = B(I,J) - A(K,J)*B(I,K) - 200 CONTINUE - END IF + DO 200 I = 1,M + B(I,J) = B(I,J) - A(K,J)*B(I,K) + 200 CONTINUE 210 CONTINUE IF (NOUNIT) THEN - TEMP = ONE/A(J,J) DO 220 I = 1,M - B(I,J) = TEMP*B(I,J) + B(I,J) = B(I,J)/A(J,J) 220 CONTINUE END IF 230 CONTINUE ELSE DO 280 J = N,1,-1 - IF (ALPHA.NE.ONE) THEN - DO 240 I = 1,M - B(I,J) = ALPHA*B(I,J) - 240 CONTINUE - END IF + DO 240 I = 1,M + B(I,J) = ALPHA*B(I,J) + 240 CONTINUE DO 260 K = J + 1,N - IF (A(K,J).NE.ZERO) THEN - DO 250 I = 1,M - B(I,J) = B(I,J) - A(K,J)*B(I,K) - 250 CONTINUE - END IF + DO 250 I = 1,M + B(I,J) = B(I,J) - A(K,J)*B(I,K) + 250 CONTINUE 260 CONTINUE IF (NOUNIT) THEN - TEMP = ONE/A(J,J) DO 270 I = 1,M - B(I,J) = TEMP*B(I,J) + B(I,J) = B(I,J)/A(J,J) 270 CONTINUE END IF 280 CONTINUE @@ -410,61 +389,55 @@ SUBROUTINE ZTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) DO 330 K = N,1,-1 IF (NOUNIT) THEN IF (NOCONJ) THEN - TEMP = ONE/A(K,K) + DO 290 I = 1,M + B(I,K) = B(I,K)/A(K,K) + 290 CONTINUE ELSE - TEMP = ONE/DCONJG(A(K,K)) + DO 390 I = 1,M + B(I,K) = B(I,K)/DCONJG(A(K,K)) + 390 CONTINUE END IF - DO 290 I = 1,M - B(I,K) = TEMP*B(I,K) - 290 CONTINUE END IF DO 310 J = 1,K - 1 - IF (A(J,K).NE.ZERO) THEN - IF (NOCONJ) THEN - TEMP = A(J,K) - ELSE - TEMP = DCONJG(A(J,K)) - END IF - DO 300 I = 1,M - B(I,J) = B(I,J) - TEMP*B(I,K) - 300 CONTINUE + IF (NOCONJ) THEN + TEMP = A(J,K) + ELSE + TEMP = DCONJG(A(J,K)) END IF + DO 300 I = 1,M + B(I,J) = B(I,J) - TEMP*B(I,K) + 300 CONTINUE 310 CONTINUE - IF (ALPHA.NE.ONE) THEN - DO 320 I = 1,M - B(I,K) = ALPHA*B(I,K) - 320 CONTINUE - END IF + DO 320 I = 1,M + B(I,K) = ALPHA*B(I,K) + 320 CONTINUE 330 CONTINUE ELSE DO 380 K = 1,N IF (NOUNIT) THEN IF (NOCONJ) THEN - TEMP = ONE/A(K,K) + DO 340 I = 1,M + B(I,K) = B(I,K)/A(K,K) + 340 CONTINUE ELSE - TEMP = ONE/DCONJG(A(K,K)) + DO 400 I = 1,M + B(I,K) = B(I,K)/DCONJG(A(K,K)) + 400 CONTINUE END IF - DO 340 I = 1,M - B(I,K) = TEMP*B(I,K) - 340 CONTINUE END IF DO 360 J = K + 1,N - IF (A(J,K).NE.ZERO) THEN - IF (NOCONJ) THEN - TEMP = A(J,K) - ELSE - TEMP = DCONJG(A(J,K)) - END IF - DO 350 I = 1,M - B(I,J) = B(I,J) - TEMP*B(I,K) - 350 CONTINUE + IF (NOCONJ) THEN + TEMP = A(J,K) + ELSE + TEMP = DCONJG(A(J,K)) END IF + DO 350 I = 1,M + B(I,J) = B(I,J) - TEMP*B(I,K) + 350 CONTINUE 360 CONTINUE - IF (ALPHA.NE.ONE) THEN - DO 370 I = 1,M - B(I,K) = ALPHA*B(I,K) - 370 CONTINUE - END IF + DO 370 I = 1,M + B(I,K) = ALPHA*B(I,K) + 370 CONTINUE 380 CONTINUE END IF END IF @@ -472,6 +445,6 @@ SUBROUTINE ZTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) * RETURN * -* End of ZTRSM . +* End of ZTRSM * END diff --git a/BLAS/SRC/ztrsv.f b/BLAS/SRC/ztrsv.f index ba7aa35c31..ec71cf27bb 100644 --- a/BLAS/SRC/ztrsv.f +++ b/BLAS/SRC/ztrsv.f @@ -128,9 +128,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* -*> \ingroup complex16_blas_level2 +*> \ingroup trsv * *> \par Further Details: * ===================== @@ -148,11 +146,11 @@ *> * ===================================================================== SUBROUTINE ZTRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) + IMPLICIT NONE * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,LDA,N @@ -163,10 +161,6 @@ SUBROUTINE ZTRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) * .. * * ===================================================================== -* -* .. Parameters .. - COMPLEX*16 ZERO - PARAMETER (ZERO= (0.0D+0,0.0D+0)) * .. * .. Local Scalars .. COMPLEX*16 TEMP @@ -189,10 +183,12 @@ SUBROUTINE ZTRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) INFO = 0 IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN INFO = 1 - ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND. + ELSE IF (.NOT.LSAME(TRANS,'N') .AND. + + .NOT.LSAME(TRANS,'T') .AND. + .NOT.LSAME(TRANS,'C')) THEN INFO = 2 - ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN + ELSE IF (.NOT.LSAME(DIAG,'U') .AND. + + .NOT.LSAME(DIAG,'N')) THEN INFO = 3 ELSE IF (N.LT.0) THEN INFO = 4 @@ -232,52 +228,44 @@ SUBROUTINE ZTRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) IF (LSAME(UPLO,'U')) THEN IF (INCX.EQ.1) THEN DO 20 J = N,1,-1 - IF (X(J).NE.ZERO) THEN - IF (NOUNIT) X(J) = X(J)/A(J,J) - TEMP = X(J) - DO 10 I = J - 1,1,-1 - X(I) = X(I) - TEMP*A(I,J) - 10 CONTINUE - END IF + IF (NOUNIT) X(J) = X(J)/A(J,J) + TEMP = X(J) + DO 10 I = J - 1,1,-1 + X(I) = X(I) - TEMP*A(I,J) + 10 CONTINUE 20 CONTINUE ELSE JX = KX + (N-1)*INCX DO 40 J = N,1,-1 - IF (X(JX).NE.ZERO) THEN - IF (NOUNIT) X(JX) = X(JX)/A(J,J) - TEMP = X(JX) - IX = JX - DO 30 I = J - 1,1,-1 - IX = IX - INCX - X(IX) = X(IX) - TEMP*A(I,J) - 30 CONTINUE - END IF + IF (NOUNIT) X(JX) = X(JX)/A(J,J) + TEMP = X(JX) + IX = JX + DO 30 I = J - 1,1,-1 + IX = IX - INCX + X(IX) = X(IX) - TEMP*A(I,J) + 30 CONTINUE JX = JX - INCX 40 CONTINUE END IF ELSE IF (INCX.EQ.1) THEN DO 60 J = 1,N - IF (X(J).NE.ZERO) THEN - IF (NOUNIT) X(J) = X(J)/A(J,J) - TEMP = X(J) - DO 50 I = J + 1,N - X(I) = X(I) - TEMP*A(I,J) - 50 CONTINUE - END IF + IF (NOUNIT) X(J) = X(J)/A(J,J) + TEMP = X(J) + DO 50 I = J + 1,N + X(I) = X(I) - TEMP*A(I,J) + 50 CONTINUE 60 CONTINUE ELSE JX = KX DO 80 J = 1,N - IF (X(JX).NE.ZERO) THEN - IF (NOUNIT) X(JX) = X(JX)/A(J,J) - TEMP = X(JX) - IX = JX - DO 70 I = J + 1,N - IX = IX + INCX - X(IX) = X(IX) - TEMP*A(I,J) - 70 CONTINUE - END IF + IF (NOUNIT) X(JX) = X(JX)/A(J,J) + TEMP = X(JX) + IX = JX + DO 70 I = J + 1,N + IX = IX + INCX + X(IX) = X(IX) - TEMP*A(I,J) + 70 CONTINUE JX = JX + INCX 80 CONTINUE END IF @@ -370,6 +358,6 @@ SUBROUTINE ZTRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) * RETURN * -* End of ZTRSV . +* End of ZTRSV * END diff --git a/BLAS/TESTING/CMakeLists.txt b/BLAS/TESTING/CMakeLists.txt index 9b130db0fd..72316c9f9d 100644 --- a/BLAS/TESTING/CMakeLists.txt +++ b/BLAS/TESTING/CMakeLists.txt @@ -1,21 +1,56 @@ -macro(add_blas_test name src) - get_filename_component(baseNAME ${src} NAME_WE) - set(TEST_INPUT "${CMAKE_CURRENT_SOURCE_DIR}/${baseNAME}.in") +function(_add_blas_test name src test_input test_output) add_executable(${name} ${src}) - target_link_libraries(${name} blas) - if(EXISTS "${TEST_INPUT}") + target_link_libraries(${name} PRIVATE ${BLASLIB}) + lapack_add_coverage(${name}) + if(EXISTS "${test_input}") add_test(NAME BLAS-${name} COMMAND "${CMAKE_COMMAND}" -DTEST=$ - -DINPUT=${TEST_INPUT} + -DINPUT=${test_input} -DINTDIR=${CMAKE_CFG_INTDIR} -P "${LAPACK_SOURCE_DIR}/TESTING/runtest.cmake") else() add_test(NAME BLAS-${name} COMMAND "${CMAKE_COMMAND}" -DTEST=$ + -DOUTPUT=${test_output} -DINTDIR=${CMAKE_CFG_INTDIR} -P "${LAPACK_SOURCE_DIR}/TESTING/runtest.cmake") endif() -endmacro() + + # Disable constant propagation for NAG compiler to avoid issues with + # special values (Inf, NaN) returned by SXVALS and DXVALS. + if(CMAKE_Fortran_COMPILER_ID STREQUAL "NAG") + target_compile_options(${name} PRIVATE "-Onopropagate") + endif() +endfunction() + +function(add_blas_test name source) + get_filename_component(baseNAME ${source} NAME_WE) + set(test_input "${CMAKE_CURRENT_SOURCE_DIR}/${baseNAME}.in") + + if(BUILD_DEFAULT_API) + _add_blas_test(${name} ${source} "${test_input}" + "${CMAKE_CURRENT_BINARY_DIR}/${baseNAME}.out") + endif() + + if(BUILD_INDEX64_EXT_API) + include(ExtendedAPIHelpers) + generate_64bit_suffixed_sources(${name} source source_64 NO_STRING_REPLACEMENTS) + + # Create 64-bit version of test input if it exists, replacing output + # file names with their 64-bit counterparts + if(EXISTS "${test_input}") + file(READ "${test_input}" test_input_content) + string(REPLACE "'${baseNAME}.out'" "'${baseNAME}_64.out'" + test_input_content "${test_input_content}") + set(test_input_64 "${CMAKE_CURRENT_BINARY_DIR}/${baseNAME}_64.in") + file(WRITE "${test_input_64}" "${test_input_content}") + endif() + + _add_blas_test(${name}_64 "${source_64}" "${test_input_64}" + "${CMAKE_CURRENT_BINARY_DIR}/${baseNAME}_64.out") + target_compile_options(${name}_64 PRIVATE ${FOPT_ILP64}) + endif() +endfunction() if(BUILD_SINGLE) add_blas_test(xblat1s sblat1.f) diff --git a/BLAS/TESTING/Makefile b/BLAS/TESTING/Makefile index 97150b1a30..5b3b0d6ee2 100644 --- a/BLAS/TESTING/Makefile +++ b/BLAS/TESTING/Makefile @@ -1,5 +1,7 @@ -include ../../make.inc +TOPSRCDIR = ../.. +include $(TOPSRCDIR)/make.inc +.PHONY: all single double complex complex16 all: single double complex complex16 single: xblat1s xblat2s xblat3s double: xblat1d xblat2d xblat3d @@ -7,32 +9,33 @@ complex: xblat1c xblat2c xblat3c complex16: xblat1z xblat2z xblat3z xblat1s: sblat1.o $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xblat1d: dblat1.o $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xblat1c: cblat1.o $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xblat1z: zblat1.o $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xblat2s: sblat2.o $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xblat2d: dblat2.o $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xblat2c: cblat2.o $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xblat2z: zblat2.o $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xblat3s: sblat3.o $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xblat3d: dblat3.o $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xblat3c: cblat3.o $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xblat3z: zblat3.o $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ +.PHONY: run run: all ./xblat1s > sblat1.out ./xblat1d > dblat1.out @@ -47,6 +50,7 @@ run: all ./xblat3c < cblat3.in ./xblat3z < zblat3.in +.PHONY: clean cleanobj cleanexe cleantest clean: cleanobj cleanexe cleantest cleanobj: rm -f *.o @@ -54,6 +58,3 @@ cleanexe: rm -f xblat* cleantest: rm -f *.out core - -.f.o: - $(FORTRAN) $(OPTS) -c -o $@ $< diff --git a/BLAS/TESTING/cblat1.f b/BLAS/TESTING/cblat1.f index 036dca3e04..5071ca6f2f 100644 --- a/BLAS/TESTING/cblat1.f +++ b/BLAS/TESTING/cblat1.f @@ -30,17 +30,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date April 2012 -* *> \ingroup complex_blas_testing * * ===================================================================== PROGRAM CBLAT1 + IMPLICIT NONE * -* -- Reference BLAS test routine (version 3.7.0) -- +* -- Reference BLAS test routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* April 2012 * * ===================================================================== * @@ -48,20 +46,26 @@ PROGRAM CBLAT1 INTEGER NOUT PARAMETER (NOUT=6) * .. Scalars in Common .. + INTEGER NTESTS, NFAILS + CHARACTER*6 SUBNAM INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Scalars .. + REAL S1, S2 REAL SFAC INTEGER IC * .. External Subroutines .. EXTERNAL CHECK1, CHECK2, HEADER * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS + COMMON /CNTBLA/NTESTS, NFAILS + COMMON /NAMBLA/SUBNAM * .. Data statements .. DATA SFAC/9.765625E-4/ * .. Executable Statements .. + CALL CPU_TIME( S1 ) WRITE (NOUT,99999) - DO 20 IC = 1, 10 + DO 20 IC = 1, 11 ICASE = IC CALL HEADER * @@ -71,33 +75,47 @@ PROGRAM CBLAT1 * these parameters. * PASS = .TRUE. + NTESTS = 0 + NFAILS = 0 INCX = 9999 INCY = 9999 MODE = 9999 - IF (ICASE.LE.5) THEN + IF (ICASE.LE.5 .OR. ICASE.EQ.11) THEN CALL CHECK2(SFAC) ELSE IF (ICASE.GE.6) THEN CALL CHECK1(SFAC) END IF * -- Print IF (PASS) WRITE (NOUT,99998) + WRITE (NOUT,99997) SUBNAM, NTESTS, NFAILS 20 CONTINUE + CALL CPU_TIME( S2 ) + WRITE (NOUT,99996) S2 - S1 STOP * 99999 FORMAT (' Complex BLAS Test Program Results',/1X) 99998 FORMAT (' ----- PASS -----') +99997 FORMAT (1X,A6,' COMPUTATIONAL TESTS:',I9,' RUN,',I9, + + ' FAILED') +99996 FORMAT (' Total time used = ',F12.2,' seconds',/) +* +* End of CBLAT1 +* END SUBROUTINE HEADER + IMPLICIT NONE * .. Parameters .. INTEGER NOUT PARAMETER (NOUT=6) * .. Scalars in Common .. + CHARACTER*6 SUBNAM INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Arrays .. - CHARACTER*6 L(10) + CHARACTER*6 L(11) * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS + COMMON /NAMBLA/SUBNAM * .. Data statements .. DATA L(1)/'CDOTC '/ DATA L(2)/'CDOTU '/ @@ -109,16 +127,24 @@ SUBROUTINE HEADER DATA L(8)/'CSCAL '/ DATA L(9)/'CSSCAL'/ DATA L(10)/'ICAMAX'/ + DATA L(11)/'CAXPBY'/ + * .. Executable Statements .. + SUBNAM = L(ICASE) WRITE (NOUT,99999) ICASE, L(ICASE) RETURN * 99999 FORMAT (/' Test of subprogram number',I3,12X,A6) +* +* End of HEADER +* END SUBROUTINE CHECK1(SFAC) + IMPLICIT NONE * .. Parameters .. INTEGER NOUT - PARAMETER (NOUT=6) + REAL THRESH + PARAMETER (NOUT=6, THRESH=10.0E0) * .. Scalar Arguments .. REAL SFAC * .. Scalars in Common .. @@ -127,18 +153,18 @@ SUBROUTINE CHECK1(SFAC) * .. Local Scalars .. COMPLEX CA REAL SA - INTEGER I, J, LEN, NP1 + INTEGER I, IX, J, LEN, NP1 * .. Local Arrays .. - COMPLEX CTRUE5(8,5,2), CTRUE6(8,5,2), CV(8,5,2), CX(8), - + MWPCS(5), MWPCT(5) + COMPLEX CTRUE5(8,5,2), CTRUE6(8,5,2), CV(8,5,2), CVR(8), + + CX(8), CXR(15), MWPCS(5), MWPCT(5) REAL STRUE2(5), STRUE4(5) - INTEGER ITRUE3(5) + INTEGER ITRUE3(5), ITRUEC(5) * .. External Functions .. REAL SCASUM, SCNRM2 INTEGER ICAMAX EXTERNAL SCASUM, SCNRM2, ICAMAX * .. External Subroutines .. - EXTERNAL CSCAL, CSSCAL, CTEST, ITEST1, STEST1 + EXTERNAL CB1NRM2, CSCAL, CSSCAL, CTEST, ITEST1, STEST1 * .. Intrinsic Functions .. INTRINSIC MAX * .. Common blocks .. @@ -173,6 +199,9 @@ SUBROUTINE CHECK1(SFAC) + (7.0E0,2.0E0), (0.3E0,0.1E0), (5.0E0,8.0E0), + (0.5E0,0.0E0), (6.0E0,9.0E0), (0.0E0,0.5E0), + (8.0E0,3.0E0), (0.0E0,0.2E0), (9.0E0,4.0E0)/ + DATA CVR/(8.0E0,8.0E0), (-7.0E0,-7.0E0), + + (9.0E0,9.0E0), (5.0E0,5.0E0), (9.0E0,9.0E0), + + (8.0E0,8.0E0), (7.0E0,7.0E0), (7.0E0,7.0E0)/ DATA STRUE2/0.0E0, 0.5E0, 0.6E0, 0.7E0, 0.8E0/ DATA STRUE4/0.0E0, 0.7E0, 1.0E0, 1.3E0, 1.6E0/ DATA ((CTRUE5(I,J,1),I=1,8),J=1,5)/(0.1E0,0.1E0), @@ -238,6 +267,7 @@ SUBROUTINE CHECK1(SFAC) + (0.15E0,0.00E0), (6.0E0,9.0E0), (0.00E0,0.15E0), + (8.0E0,3.0E0), (0.00E0,0.06E0), (9.0E0,4.0E0)/ DATA ITRUE3/0, 1, 2, 2, 2/ + DATA ITRUEC/0, 1, 1, 1, 1/ * .. Executable Statements .. DO 60 INCX = 1, 2 DO 40 NP1 = 1, 5 @@ -249,6 +279,10 @@ SUBROUTINE CHECK1(SFAC) 20 CONTINUE IF (ICASE.EQ.6) THEN * .. SCNRM2 .. +* Test scaling when some entries are tiny or huge + CALL CB1NRM2(N,(INCX-2)*2,THRESH) + CALL CB1NRM2(N,INCX,THRESH) +* Test with hardcoded mid range entries CALL STEST1(SCNRM2(N,CX,INCX),STRUE2(NP1),STRUE2(NP1), + SFAC) ELSE IF (ICASE.EQ.7) THEN @@ -268,12 +302,25 @@ SUBROUTINE CHECK1(SFAC) ELSE IF (ICASE.EQ.10) THEN * .. ICAMAX .. CALL ITEST1(ICAMAX(N,CX,INCX),ITRUE3(NP1)) + DO 160 I = 1, LEN + CX(I) = (42.0E0,43.0E0) + 160 CONTINUE + CALL ITEST1(ICAMAX(N,CX,INCX),ITRUEC(NP1)) ELSE WRITE (NOUT,*) ' Shouldn''t be here in CHECK1' STOP END IF * 40 CONTINUE + IF (ICASE.EQ.10) THEN + N = 8 + IX = 1 + DO 180 I = 1, N + CXR(IX) = CVR(I) + IX = IX + INCX + 180 CONTINUE + CALL ITEST1(ICAMAX(N,CXR,INCX),3) + END IF 60 CONTINUE * INCX = 1 @@ -315,8 +362,12 @@ SUBROUTINE CHECK1(SFAC) CALL CTEST(5,CX,MWPCT,MWPCS,SFAC) END IF RETURN +* +* End of CHECK1 +* END SUBROUTINE CHECK2(SFAC) + IMPLICIT NONE * .. Parameters .. INTEGER NOUT PARAMETER (NOUT=6) @@ -326,24 +377,27 @@ SUBROUTINE CHECK2(SFAC) INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Scalars .. - COMPLEX CA - INTEGER I, J, KI, KN, KSIZE, LENX, LENY, MX, MY + COMPLEX CA, CB + INTEGER I, J, KI, KN, KSIZE, LENX, LENY, LINCX, LINCY, + + MX, MY * .. Local Arrays .. COMPLEX CDOT(1), CSIZE1(4), CSIZE2(7,2), CSIZE3(14), + CT10X(7,4,4), CT10Y(7,4,4), CT6(4,4), CT7(4,4), - + CT8(7,4,4), CX(7), CX1(7), CY(7), CY1(7) + + CT8(7,4,4), CTY0(1), CX(7), CX0(1), CX1(7), + + CY(7), CY0(1), CY1(7), CT11(7,4,4) INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4) * .. External Functions .. COMPLEX CDOTC, CDOTU EXTERNAL CDOTC, CDOTU * .. External Subroutines .. - EXTERNAL CAXPY, CCOPY, CSWAP, CTEST + EXTERNAL CAXPY, CAXPBY, CCOPY, CSWAP, CTEST * .. Intrinsic Functions .. INTRINSIC ABS, MIN * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS * .. Data statements .. DATA CA/(0.4E0,-0.7E0)/ + DATA CB/(0.7E0,-0.4E0)/ DATA INCXS/1, 2, -2, -1/ DATA INCYS/1, -2, 1, -2/ DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/ @@ -513,6 +567,53 @@ SUBROUTINE CHECK2(SFAC) + (1.54E0,1.54E0), (1.54E0,1.54E0), + (1.54E0,1.54E0), (1.54E0,1.54E0), + (1.54E0,1.54E0), (1.54E0,1.54E0)/ + + DATA ((CT11(I,J,1),I=1,7),J=1,4)/(0.6E0,-0.6E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (-0.1E0,-1.47E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (-0.1E0,-1.47E0), + + (-1.08E0,0.71E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (-0.1E0,-1.47E0), (-1.08E0,0.71E0), + + (-0.42E0,-0.99E0), (-0.61E0,-0.85E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/ + DATA ((CT11(I,J,2),I=1,7),J=1,4)/(0.6E0,-0.6E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (-0.1E0,-1.47E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (-0.49E0,-0.95E0), + + (-0.9E0,0.5E0),(-0.03E0,-1.51E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.36E0,0.00E0), (-0.9E0,0.5E0), + + (-0.39E0,-0.23E0), (0.1E0,-0.5E0), + + (-0.82E0,-0.39E0), (-0.5E0,-0.3E0), + + (0.0E0,-1.62E0)/ + DATA ((CT11(I,J,3),I=1,7),J=1,4)/(0.6E0,-0.6E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (-0.1E0,-1.47E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (-0.49E0,-0.95E0), + + (-0.71E0,-0.1E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.36E0,0.00E0), (-1.07E0,1.18E0), + + (-0.42E0,-0.99E0), (-0.41E0,-1.2E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/ + DATA ((CT11(I,J,4),I=1,7),J=1,4)/(0.6E0,-0.6E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (-0.1E0,-1.47E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (-0.1E0,-1.47E0), (-0.9E0,0.5E0), + + (-0.4E0,-0.7E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (-0.1E0,-1.47E0), + + (-0.9E0,0.5E0),(-0.4E0,-0.7E0), (0.1E0,-0.5E0), + + (-0.82E0,-0.39E0), (-0.5E0,-0.3E0), + + (-0.2E0,-1.27E0)/ + * .. Executable Statements .. DO 60 KI = 1, 4 INCX = INCXS(KI) @@ -546,11 +647,32 @@ SUBROUTINE CHECK2(SFAC) * .. CCOPY .. CALL CCOPY(N,CX,INCX,CY,INCY) CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0E0) + IF (KI.EQ.1) THEN + CX0(1) = (42.0E0,43.0E0) + CY0(1) = (44.0E0,45.0E0) + IF (N.EQ.0) THEN + CTY0(1) = CY0(1) + ELSE + CTY0(1) = CX0(1) + END IF + LINCX = INCX + INCX = 0 + LINCY = INCY + INCY = 0 + CALL CCOPY(N,CX0,INCX,CY0,INCY) + CALL CTEST(1,CY0,CTY0,CSIZE3,1.0E0) + INCX = LINCX + INCY = LINCY + END IF ELSE IF (ICASE.EQ.5) THEN * .. CSWAP .. CALL CSWAP(N,CX,INCX,CY,INCY) CALL CTEST(LENX,CX,CT10X(1,KN,KI),CSIZE3,1.0E0) CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0E0) + ELSE IF (ICASE.EQ.11) THEN +* .. CAXBPY .. + CALL CAXPBY(N,CA,CX,INCX,CB,CY,INCY) + CALL CTEST(LENY,CY,CT11(1,KN,KI),CSIZE2(1,KSIZE),SFAC) ELSE WRITE (NOUT,*) ' Shouldn''t be here in CHECK2' STOP @@ -559,8 +681,12 @@ SUBROUTINE CHECK2(SFAC) 40 CONTINUE 60 CONTINUE RETURN +* +* End of CHECK2 +* END SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC) + IMPLICIT NONE * ********************************* STEST ************************** * * THIS SUBR COMPARES ARRAYS SCOMP() AND STRUE() OF LENGTH LEN TO @@ -579,6 +705,7 @@ SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC) * .. Array Arguments .. REAL SCOMP(LEN), SSIZE(LEN), STRUE(LEN) * .. Scalars in Common .. + INTEGER NTESTS, NFAILS INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Scalars .. @@ -591,12 +718,15 @@ SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC) INTRINSIC ABS * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS + COMMON /CNTBLA/NTESTS, NFAILS * .. Executable Statements .. * DO 40 I = 1, LEN + NTESTS = NTESTS + 1 SD = SCOMP(I) - STRUE(I) IF (ABS(SFAC*SD) .LE. ABS(SSIZE(I))*EPSILON(ZERO)) + GO TO 40 + NFAILS = NFAILS + 1 * * HERE SCOMP(I) IS NOT CLOSE TO STRUE(I). * @@ -615,11 +745,15 @@ SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC) + ' COMP(I) TRUE(I) DIFFERENCE', + ' SIZE(I)',/1X) 99997 FORMAT (1X,I4,I3,3I5,I3,2E36.8,2E12.4) +* +* End of STEST +* END SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC) + IMPLICIT NONE * ************************* STEST1 ***************************** * -* THIS IS AN INTERFACE SUBROUTINE TO ACCOMODATE THE FORTRAN +* THIS IS AN INTERFACE SUBROUTINE TO ACCOMMODATE THE FORTRAN * REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE * ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT. * @@ -640,8 +774,12 @@ SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC) CALL STEST(1,SCOMP,STRUE,SSIZE,SFAC) * RETURN +* +* End of STEST1 +* END REAL FUNCTION SDIFF(SA,SB) + IMPLICIT NONE * ********************************* SDIFF ************************** * COMPUTES DIFFERENCE OF TWO NUMBERS. C. L. LAWSON, JPL 1974 FEB 15 * @@ -650,8 +788,12 @@ REAL FUNCTION SDIFF(SA,SB) * .. Executable Statements .. SDIFF = SA - SB RETURN +* +* End of SDIFF +* END SUBROUTINE CTEST(LEN,CCOMP,CTRUE,CSIZE,SFAC) + IMPLICIT NONE * **************************** CTEST ***************************** * * C.L. LAWSON, JPL, 1978 DEC 6 @@ -681,8 +823,12 @@ SUBROUTINE CTEST(LEN,CCOMP,CTRUE,CSIZE,SFAC) * CALL STEST(2*LEN,SCOMP,STRUE,SSIZE,SFAC) RETURN +* +* End of CTEST +* END SUBROUTINE ITEST1(ICOMP,ITRUE) + IMPLICIT NONE * ********************************* ITEST1 ************************* * * THIS SUBROUTINE COMPARES THE VARIABLES ICOMP AND ITRUE FOR @@ -695,14 +841,18 @@ SUBROUTINE ITEST1(ICOMP,ITRUE) * .. Scalar Arguments .. INTEGER ICOMP, ITRUE * .. Scalars in Common .. + INTEGER NTESTS, NFAILS INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Scalars .. INTEGER ID * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS + COMMON /CNTBLA/NTESTS, NFAILS * .. Executable Statements .. + NTESTS = NTESTS + 1 IF (ICOMP.EQ.ITRUE) GO TO 40 + NFAILS = NFAILS + 1 * * HERE ICOMP IS NOT EQUAL TO ITRUE. * @@ -721,4 +871,246 @@ SUBROUTINE ITEST1(ICOMP,ITRUE) + ' COMP TRUE DIFFERENCE', + /1X) 99997 FORMAT (1X,I4,I3,3I5,2I36,I12) +* +* End of ITEST1 +* + END + SUBROUTINE CB1NRM2(N,INCX,THRESH) + IMPLICIT NONE +* Compare NRM2 with a reference computation using combinations +* of the following values: +* +* 0, very small, small, ulp, 1, 1/ulp, big, very big, infinity, NaN +* +* one of these values is used to initialize x(1) and x(2:N) is +* filled with random values from [-1,1] scaled by another of +* these values. +* +* This routine is adapted from the test suite provided by +* Anderson E. (2017) +* Algorithm 978: Safe Scaling in the Level 1 BLAS +* ACM Trans Math Softw 44:1--28 +* https://doi.org/10.1145/3061665 +* +* .. Scalar Arguments .. + INTEGER INCX, N + REAL THRESH +* +* ===================================================================== +* .. Parameters .. + INTEGER NMAX, NOUT, NV + PARAMETER (NMAX=20, NOUT=6, NV=10) + REAL HALF, ONE, THREE, TWO, ZERO + PARAMETER (HALF=0.5E+0, ONE=1.0E+0, TWO= 2.0E+0, + & THREE=3.0E+0, ZERO=0.0E+0) +* .. External Functions .. + REAL SCNRM2 + EXTERNAL SCNRM2 +* .. Intrinsic Functions .. + INTRINSIC AIMAG, ABS, CMPLX, MAX, MIN, REAL, SQRT +* .. Model parameters .. + REAL BIGNUM, SAFMAX, SAFMIN, SMLNUM, ULP + PARAMETER (BIGNUM=0.1014120480E+32, + & SAFMAX=0.8507059173E+38, + & SAFMIN=0.1175494351E-37, + & SMLNUM=0.9860761315E-31, + & ULP=0.1192092896E-06) +* .. Local Scalars .. + COMPLEX ROGUE + REAL SNRM, TRAT, V0, V1, WORKSSQ, Y1, Y2, + & YMAX, YMIN, YNRM, ZNRM + INTEGER I, IV, IW, IX, KS + LOGICAL FIRST +* .. Local Arrays .. + COMPLEX X(NMAX), Z(NMAX) + REAL VALUES(NV), WORK(NMAX) +* .. Scalars in Common .. + INTEGER NTESTS, NFAILS +* .. Common blocks .. + COMMON /CNTBLA/NTESTS, NFAILS +* .. Executable Statements .. + VALUES(1) = ZERO + VALUES(2) = TWO*SAFMIN + VALUES(3) = SMLNUM + VALUES(4) = ULP + VALUES(5) = ONE + VALUES(6) = ONE / ULP + VALUES(7) = BIGNUM + VALUES(8) = SAFMAX + VALUES(9) = SXVALS(V0,2) + VALUES(10) = SXVALS(V0,3) + ROGUE = CMPLX(1234.5678E+0,-1234.5678E+0) + FIRST = .TRUE. +* +* Check that the arrays are large enough +* + IF (N*ABS(INCX).GT.NMAX) THEN + WRITE (NOUT,99) "SCNRM2", NMAX, INCX, N, N*ABS(INCX) + RETURN + END IF +* +* Zero-sized inputs are tested in STEST1. + IF (N.LE.0) THEN + RETURN + END IF +* +* Generate 2*(N-1) values in (-1,1). +* + KS = 2*(N-1) + DO I = 1, KS + CALL RANDOM_NUMBER(WORK(I)) + WORK(I) = ONE - TWO*WORK(I) + END DO +* +* Compute the sum of squares of the random values +* by an unscaled algorithm. +* + WORKSSQ = ZERO + DO I = 1, KS + WORKSSQ = WORKSSQ + WORK(I)*WORK(I) + END DO +* +* Construct the test vector with one known value +* and the rest from the random work array multiplied +* by a scaling factor. +* + DO IV = 1, NV + V0 = VALUES(IV) + IF (ABS(V0).GT.ONE) THEN + V0 = V0*HALF*HALF + END IF + Z(1) = CMPLX(V0,-THREE*V0) + DO IW = 1, NV + V1 = VALUES(IW) + IF (ABS(V1).GT.ONE) THEN + V1 = (V1*HALF) / SQRT(REAL(KS+1)) + END IF + DO I = 1, N-1 + Z(I+1) = CMPLX(V1*WORK(2*I-1),V1*WORK(2*I)) + END DO +* +* Compute the expected value of the 2-norm +* + Y1 = ABS(V0) * SQRT(10.0E0) + IF (N.GT.1) THEN + Y2 = ABS(V1)*SQRT(WORKSSQ) + ELSE + Y2 = ZERO + END IF + YMIN = MIN(Y1, Y2) + YMAX = MAX(Y1, Y2) +* +* Expected value is NaN if either is NaN. The test +* for YMIN == YMAX avoids further computation if both +* are infinity. +* + IF ((Y1.NE.Y1).OR.(Y2.NE.Y2)) THEN +* add to propagate NaN + YNRM = Y1 + Y2 + ELSE IF (YMIN == YMAX) THEN + YNRM = SQRT(TWO)*YMAX + ELSE IF (YMAX == ZERO) THEN + YNRM = ZERO + ELSE + YNRM = YMAX*SQRT(ONE + (YMIN / YMAX)**2) + END IF +* +* Fill the input array to SCNRM2 with steps of incx +* + DO I = 1, N + X(I) = ROGUE + END DO + IX = 1 + IF (INCX.LT.0) IX = 1 - (N-1)*INCX + DO I = 1, N + X(IX) = Z(I) + IX = IX + INCX + END DO +* +* Call SCNRM2 to compute the 2-norm +* + SNRM = SCNRM2(N,X,INCX) +* +* Compare SNRM and ZNRM. Roundoff error grows like O(n) +* in this implementation so we scale the test ratio accordingly. +* + IF (INCX.EQ.0) THEN + Y1 = ABS(REAL(X(1))) + Y2 = ABS(AIMAG(X(1))) + YMIN = MIN(Y1, Y2) + YMAX = MAX(Y1, Y2) + IF ((Y1.NE.Y1).OR.(Y2.NE.Y2)) THEN +* add to propagate NaN + ZNRM = Y1 + Y2 + ELSE IF (YMIN == YMAX) THEN + ZNRM = SQRT(TWO)*YMAX + ELSE IF (YMAX == ZERO) THEN + ZNRM = ZERO + ELSE + ZNRM = YMAX * SQRT(ONE + (YMIN / YMAX)**2) + END IF + ZNRM = SQRT(REAL(n)) * ZNRM + ELSE + ZNRM = YNRM + END IF +* +* The tests for NaN rely on the compiler not being overly +* aggressive and removing the statements altogether. + IF ((SNRM.NE.SNRM).OR.(ZNRM.NE.ZNRM)) THEN + IF ((SNRM.NE.SNRM).NEQV.(ZNRM.NE.ZNRM)) THEN + TRAT = ONE / ULP + ELSE + TRAT = ZERO + END IF + ELSE IF (SNRM == ZNRM) THEN + TRAT = ZERO + ELSE IF (ZNRM == ZERO) THEN + TRAT = SNRM / ULP + ELSE + TRAT = (ABS(SNRM-ZNRM) / ZNRM) / (TWO*REAL(N)*ULP) + END IF + NTESTS = NTESTS + 1 + IF ((TRAT.NE.TRAT).OR.(TRAT.GE.THRESH)) THEN + NFAILS = NFAILS + 1 + IF (FIRST) THEN + FIRST = .FALSE. + WRITE(NOUT,99999) + END IF + WRITE (NOUT,98) "SCNRM2", N, INCX, IV, IW, TRAT + END IF + END DO + END DO +99999 FORMAT (' FAIL') + 99 FORMAT ( ' Not enough space to test ', A6, ': NMAX = ',I6, + + ', INCX = ',I6,/,' N = ',I6,', must be at least ',I6 ) + 98 FORMAT( 1X, A6, ': N=', I6,', INCX=', I4, ', IV=', I2, ', IW=', + + I2, ', test=', E15.8 ) + RETURN + CONTAINS + REAL FUNCTION SXVALS(XX,K) + IMPLICIT NONE +* .. Scalar Arguments .. + REAL XX + INTEGER K +* .. Parameters .. + REAL ZERO + PARAMETER (ZERO=0.0E+0) +* .. Local Scalars .. + REAL X, Y, Z +* .. Intrinsic Functions .. + INTRINSIC HUGE +* .. Executable Statements .. + X = ZERO + Y = HUGE(XX) + Z = Y*Y + IF (K.EQ.1) THEN + X = -Z + ELSE IF (K.EQ.2) THEN + X = Z + ELSE IF (K.EQ.3) THEN + X = Z / Z + END IF + SXVALS = X + RETURN + END END diff --git a/BLAS/TESTING/cblat2.f b/BLAS/TESTING/cblat2.f index 8c7bac48ea..8d4fe6d713 100644 --- a/BLAS/TESTING/cblat2.f +++ b/BLAS/TESTING/cblat2.f @@ -96,17 +96,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date April 2012 -* *> \ingroup complex_blas_testing * * ===================================================================== PROGRAM CBLAT2 + IMPLICIT NONE * -* -- Reference BLAS test routine (version 3.7.0) -- +* -- Reference BLAS test routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* April 2012 * * ===================================================================== * @@ -125,6 +123,7 @@ PROGRAM CBLAT2 PARAMETER ( NINMAX = 7, NIDMAX = 9, NKBMAX = 7, $ NALMAX = 7, NBEMAX = 7 ) * .. Local Scalars .. + REAL S1, S2 REAL EPS, ERR, THRESH INTEGER I, ISNUM, J, N, NALF, NBET, NIDIM, NINC, NKB, $ NOUT, NTRA @@ -167,6 +166,7 @@ PROGRAM CBLAT2 $ 'CGERU ', 'CHER ', 'CHPR ', 'CHER2 ', $ 'CHPR2 '/ * .. Executable Statements .. + CALL CPU_TIME( S1 ) * * Read name and unit number for summary output file and open file. * @@ -294,13 +294,14 @@ PROGRAM CBLAT2 N = MIN( 32, NMAX ) DO 120 J = 1, N DO 110 I = 1, N - A( I, J ) = MAX( I - J + 1, 0 ) + A( I, J ) = REAL( MAX( I - J + 1, 0 ) ) 110 CONTINUE - X( J ) = J + X( J ) = REAL( J ) Y( J ) = ZERO 120 CONTINUE DO 130 J = 1, N - YY( J ) = J*( ( J + 1 )*J )/2 - ( ( J + 1 )*J*( J - 1 ) )/3 + YY( J ) = REAL( J*( ( J + 1 )*J )/2 - + $ ( ( J + 1 )*J*( J - 1 ) )/3 ) 130 CONTINUE * YY holds the exact result. On exit from CMVCH YT holds * the result computed by CMVCH. @@ -395,6 +396,8 @@ PROGRAM CBLAT2 240 CONTINUE IF( TRACE ) $ CLOSE ( NTRA ) + CALL CPU_TIME( S2 ) + WRITE( NOUT, FMT = 9979 )S2 - S1 CLOSE ( NOUT ) STOP * @@ -430,14 +433,16 @@ PROGRAM CBLAT2 9982 FORMAT( /' END OF TESTS' ) 9981 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' ) 9980 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' ) + 9979 FORMAT( ' Total time used = ', F12.2, ' seconds', / ) * -* End of CBLAT2. +* End of CBLAT2 * END SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, NBET, $ BET, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX, $ XS, Y, YY, YS, YT, G ) + IMPLICIT NONE * * Tests CGEMV and CGBMV. * @@ -469,6 +474,7 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX ALPHA, ALS, BETA, BLS, TRANSL REAL ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, IC, IKU, IM, IN, INCX, INCXS, INCY, $ INCYS, IX, IY, KL, KLS, KU, KUS, LAA, LDA, $ LDAS, LX, LY, M, ML, MS, N, NARGS, NC, ND, NK, @@ -482,7 +488,7 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, LOGICAL LCE, LCERES EXTERNAL LCE, LCERES * .. External Subroutines .. - EXTERNAL CGBMV, CGEMV, CMAKE, CMVCH + EXTERNAL CGBMV, CGEMV, CMAKE, CMVCH, CREGR1 * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN * .. Scalars in Common .. @@ -505,6 +511,8 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 120 IN = 1, NIDIM N = IDIM( IN ) @@ -646,6 +654,8 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9993 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 130 END IF * @@ -699,6 +709,8 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 130 END IF * @@ -711,6 +723,9 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ INCY, YT, G, YY, EPS, ERR, $ FATAL, NOUT, .TRUE. ) ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -737,6 +752,36 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * 120 CONTINUE * +* Regression test to verify preservation of y when m zero, n nonzero. +* + CALL CREGR1( TRANS, M, N, LY, KL, KU, ALPHA, AA, LDA, XX, INCX, + $ BETA, YY, INCY, YS ) + IF( FULL )THEN + IF( TRACE ) + $ WRITE( NTRA, FMT = 9994 )NC, SNAME, TRANS, M, N, ALPHA, LDA, + $ INCX, BETA, INCY + IF( REWI ) + $ REWIND NTRA + CALL CGEMV( TRANS, M, N, ALPHA, AA, LDA, XX, INCX, BETA, YY, + $ INCY ) + ELSE IF( BANDED )THEN + IF( TRACE ) + $ WRITE( NTRA, FMT = 9995 )NC, SNAME, TRANS, M, N, KL, KU, + $ ALPHA, LDA, INCX, BETA, INCY + IF( REWI ) + $ REWIND NTRA + CALL CGBMV( TRANS, M, N, KL, KU, ALPHA, AA, LDA, XX, INCX, + $ BETA, YY, INCY ) + END IF + NC = NC + 1 + IF( .NOT.LCE( YS, YY, LY ) )THEN + WRITE( NOUT, FMT = 9998 )NARGS - 1 + FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 + GO TO 130 + END IF +* * Report result. * IF( ERRMAX.LT.THRESH )THEN @@ -757,6 +802,7 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 140 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', @@ -775,14 +821,17 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ F4.1, '), Y,', I2, ') .' ) 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A6, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of CCHK1. +* End of CCHK1 * END SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, NBET, $ BET, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX, $ XS, Y, YY, YS, YT, G ) + IMPLICIT NONE * * Tests CHEMV, CHBMV and CHPMV. * @@ -814,6 +863,7 @@ SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX ALPHA, ALS, BETA, BLS, TRANSL REAL ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, IC, IK, IN, INCX, INCXS, INCY, $ INCYS, IX, IY, K, KS, LAA, LDA, LDAS, LX, LY, $ N, NARGS, NC, NK, NS @@ -852,6 +902,8 @@ SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 110 IN = 1, NIDIM N = IDIM( IN ) @@ -982,6 +1034,8 @@ SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1044,6 +1098,8 @@ SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1056,6 +1112,9 @@ SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ YY, EPS, ERR, FATAL, NOUT, $ .TRUE. ) ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -1102,6 +1161,7 @@ SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 130 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', @@ -1123,13 +1183,16 @@ SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ 'Y,', I2, ') .' ) 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A6, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of CCHK2. +* End of CCHK2 * END SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NKB, KB, NINC, INC, NMAX, $ INCMAX, A, AA, AS, X, XX, XS, XT, G, Z ) + IMPLICIT NONE * * Tests CTRMV, CTBMV, CTPMV, CTRSV, CTBSV and CTPSV. * @@ -1159,6 +1222,7 @@ SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX TRANSL REAL ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, ICD, ICT, ICU, IK, IN, INCX, INCXS, IX, K, $ KS, LAA, LDA, LDAS, LX, N, NARGS, NC, NK, NS LOGICAL BANDED, FULL, NULL, PACKED, RESET, SAME @@ -1198,6 +1262,8 @@ SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * Set up zero vector for CMVCH. DO 10 I = 1, NMAX Z( I ) = ZERO @@ -1344,6 +1410,8 @@ SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1396,6 +1464,8 @@ SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1424,6 +1494,9 @@ SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ .FALSE. ) END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and return. IF( FATAL ) $ GO TO 120 @@ -1466,6 +1539,7 @@ SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 130 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', @@ -1484,14 +1558,17 @@ SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ I3, ', X,', I2, ') .' ) 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A6, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of CCHK3. +* End of CCHK3 * END SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX, $ INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G, $ Z ) + IMPLICIT NONE * * Tests CGERC and CGERU. * @@ -1523,6 +1600,7 @@ SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX ALPHA, ALS, TRANSL REAL ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IM, IN, INCX, INCXS, INCY, INCYS, IX, $ IY, J, LAA, LDA, LDAS, LX, LY, M, MS, N, NARGS, $ NC, ND, NS @@ -1550,6 +1628,8 @@ SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 120 IN = 1, NIDIM N = IDIM( IN ) @@ -1650,6 +1730,8 @@ SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9993 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 140 END IF * @@ -1680,6 +1762,8 @@ SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 140 END IF * @@ -1709,6 +1793,9 @@ SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ AA( 1 + ( J - 1 )*LDA ), EPS, $ ERR, FATAL, NOUT, .TRUE. ) ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and return. IF( FATAL ) $ GO TO 130 @@ -1745,6 +1832,7 @@ SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, WRITE( NOUT, FMT = 9994 )NC, SNAME, M, N, ALPHA, INCX, INCY, LDA * 150 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', @@ -1761,14 +1849,17 @@ SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ ' .' ) 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A6, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of CCHK4. +* End of CCHK4 * END SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX, $ INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G, $ Z ) + IMPLICIT NONE * * Tests CHER and CHPR. * @@ -1800,6 +1891,7 @@ SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX ALPHA, TRANSL REAL ERR, ERRMAX, RALPHA, RALS + INTEGER NTESTS, NFAILS INTEGER I, IA, IC, IN, INCX, INCXS, IX, J, JA, JJ, LAA, $ LDA, LDAS, LJ, LX, N, NARGS, NC, NS LOGICAL FULL, NULL, PACKED, RESET, SAME, UPPER @@ -1835,6 +1927,8 @@ SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 100 IN = 1, NIDIM N = IDIM( IN ) @@ -1919,6 +2013,8 @@ SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1949,6 +2045,8 @@ SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 30 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1989,6 +2087,9 @@ SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, JA = JA + LJ END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and return. IF( FATAL ) $ GO TO 110 @@ -2028,6 +2129,7 @@ SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 130 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', @@ -2045,14 +2147,17 @@ SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ I2, ', A,', I3, ') .' ) 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A6, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of CCHK5. +* End of CCHK5 * END SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX, $ INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G, $ Z ) + IMPLICIT NONE * * Tests CHER2 and CHPR2. * @@ -2084,6 +2189,7 @@ SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX ALPHA, ALS, TRANSL REAL ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IC, IN, INCX, INCXS, INCY, INCYS, IX, $ IY, J, JA, JJ, LAA, LDA, LDAS, LJ, LX, LY, N, $ NARGS, NC, NS @@ -2120,6 +2226,8 @@ SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 140 IN = 1, NIDIM N = IDIM( IN ) @@ -2224,6 +2332,8 @@ SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 160 END IF * @@ -2256,6 +2366,8 @@ SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 160 END IF * @@ -2306,6 +2418,9 @@ SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, JA = JA + LJ END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and return. IF( FATAL ) $ GO TO 150 @@ -2348,6 +2463,7 @@ SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 170 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', @@ -2367,11 +2483,14 @@ SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ ' .' ) 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A6, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of CCHK6. +* End of CCHK6 * END SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT ) + IMPLICIT NONE * * Tests the error exits from the Level 2 Blas. * Requires a special version of the error-handling routine XERBLA. @@ -2387,6 +2506,7 @@ SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT ) INTEGER ISNUM, NOUT CHARACTER*6 SRNAMT * .. Scalars in Common .. + INTEGER NXRUN, NXFAIL, NXBAD INTEGER INFOT, NOUTC LOGICAL LERR, OK * .. Local Scalars .. @@ -2400,6 +2520,7 @@ SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT ) $ CTBSV, CTPMV, CTPSV, CTRMV, CTRSV * .. Common blocks .. COMMON /INFOC/INFOT, NOUTC, OK, LERR + COMMON /XERCNT/NXRUN, NXFAIL, NXBAD * .. Executable Statements .. * OK is set to .FALSE. by the special version of XERBLA or by CHKXER * if anything is wrong. @@ -2407,6 +2528,11 @@ SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT ) * LERR is set to .TRUE. by the special version of XERBLA each time * it is called, and is then tested and re-set by CHKXER. LERR = .FALSE. +* NXRUN and NXFAIL count the error-exit tests of this routine; +* NXBAD is set by XERBLA when it is called wrongly. + NXRUN = 0 + NXFAIL = 0 + NXBAD = 0 GO TO ( 10, 20, 30, 40, 50, 60, 70, 80, $ 90, 100, 110, 120, 130, 140, 150, 160, $ 170 )ISNUM @@ -2705,17 +2831,21 @@ SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT ) ELSE WRITE( NOUT, FMT = 9998 )SRNAMT END IF + WRITE( NOUT, FMT = 9979 )SRNAMT, NXRUN, NXFAIL RETURN * 9999 FORMAT( ' ', A6, ' PASSED THE TESTS OF ERROR-EXITS' ) 9998 FORMAT( ' ******* ', A6, ' FAILED THE TESTS OF ERROR-EXITS *****', $ '**' ) + 9979 FORMAT( ' ', A6, ' ERROR-EXIT TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of CCHKE. +* End of CCHKE * END SUBROUTINE CMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, $ KU, RESET, TRANSL ) + IMPLICIT NONE * * Generates values for an M by N matrix A within the bandwidth * defined by KL and KU. @@ -2903,11 +3033,12 @@ SUBROUTINE CMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, END IF RETURN * -* End of CMAKE. +* End of CMAKE * END SUBROUTINE CMVCH( TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y, $ INCY, YT, G, YY, EPS, ERR, FATAL, NOUT, MV ) + IMPLICIT NONE * * Checks the results of the computational tests. * @@ -2939,9 +3070,9 @@ SUBROUTINE CMVCH( TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y, * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, CONJG, MAX, REAL, SQRT * .. Statement Functions .. - REAL ABS1 + REAL CABS1 * .. Statement Function definitions .. - ABS1( C ) = ABS( REAL( C ) ) + ABS( AIMAG( C ) ) + CABS1( C ) = ABS( REAL( C ) ) + ABS( AIMAG( C ) ) * .. Executable Statements .. TRAN = TRANS.EQ.'T' CTRAN = TRANS.EQ.'C' @@ -2978,24 +3109,25 @@ SUBROUTINE CMVCH( TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y, IF( TRAN )THEN DO 10 J = 1, NL YT( IY ) = YT( IY ) + A( J, I )*X( JX ) - G( IY ) = G( IY ) + ABS1( A( J, I ) )*ABS1( X( JX ) ) + G( IY ) = G( IY ) + CABS1( A( J, I ) )*CABS1( X( JX ) ) JX = JX + INCXL 10 CONTINUE ELSE IF( CTRAN )THEN DO 20 J = 1, NL YT( IY ) = YT( IY ) + CONJG( A( J, I ) )*X( JX ) - G( IY ) = G( IY ) + ABS1( A( J, I ) )*ABS1( X( JX ) ) + G( IY ) = G( IY ) + CABS1( A( J, I ) )*CABS1( X( JX ) ) JX = JX + INCXL 20 CONTINUE ELSE DO 30 J = 1, NL YT( IY ) = YT( IY ) + A( I, J )*X( JX ) - G( IY ) = G( IY ) + ABS1( A( I, J ) )*ABS1( X( JX ) ) + G( IY ) = G( IY ) + CABS1( A( I, J ) )*CABS1( X( JX ) ) JX = JX + INCXL 30 CONTINUE END IF YT( IY ) = ALPHA*YT( IY ) + BETA*Y( IY ) - G( IY ) = ABS1( ALPHA )*G( IY ) + ABS1( BETA )*ABS1( Y( IY ) ) + G( IY ) = CABS1( ALPHA )*G( IY ) + $ + CABS1( BETA )*CABS1( Y( IY ) ) IY = IY + INCYL 40 CONTINUE * @@ -3035,10 +3167,11 @@ SUBROUTINE CMVCH( TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y, $ 'SULT COMPUTED RESULT' ) 9998 FORMAT( 1X, I7, 2( ' (', G15.6, ',', G15.6, ')' ) ) * -* End of CMVCH. +* End of CMVCH * END LOGICAL FUNCTION LCE( RI, RJ, LR ) + IMPLICIT NONE * * Tests if two arrays are identical. * @@ -3065,10 +3198,11 @@ LOGICAL FUNCTION LCE( RI, RJ, LR ) LCE = .FALSE. 30 RETURN * -* End of LCE. +* End of LCE * END LOGICAL FUNCTION LCERES( TYPE, UPLO, M, N, AA, AS, LDA ) + IMPLICIT NONE * * Tests if selected elements in two arrays are equal. * @@ -3124,10 +3258,11 @@ LOGICAL FUNCTION LCERES( TYPE, UPLO, M, N, AA, AS, LDA ) LCERES = .FALSE. 80 RETURN * -* End of LCERES. +* End of LCERES * END COMPLEX FUNCTION CBEG( RESET ) + IMPLICIT NONE * * Generates complex numbers as pairs of random numbers uniformly * distributed between -0.5 and 0.5. @@ -3173,13 +3308,14 @@ COMPLEX FUNCTION CBEG( RESET ) IC = 0 GO TO 10 END IF - CBEG = CMPLX( ( I - 500 )/1001.0, ( J - 500 )/1001.0 ) + CBEG = CMPLX( REAL( I - 500 )/1001.0, REAL( J - 500 )/1001.0 ) RETURN * -* End of CBEG. +* End of CBEG * END REAL FUNCTION SDIFF( X, Y ) + IMPLICIT NONE * * Auxiliary routine for test program for Level 2 Blas. * @@ -3192,10 +3328,11 @@ REAL FUNCTION SDIFF( X, Y ) SDIFF = X - Y RETURN * -* End of SDIFF. +* End of SDIFF * END SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + IMPLICIT NONE * * Tests whether XERBLA has detected an error when it should. * @@ -3209,21 +3346,65 @@ SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INTEGER INFOT, NOUT LOGICAL LERR, OK CHARACTER*6 SRNAMT +* .. Scalars in Common .. + INTEGER NXRUN, NXFAIL, NXBAD +* .. Common blocks .. + COMMON /XERCNT/NXRUN, NXFAIL, NXBAD * .. Executable Statements .. + NXRUN = NXRUN + 1 IF( .NOT.LERR )THEN WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT OK = .FALSE. + NXFAIL = NXFAIL + 1 + ELSE IF( NXBAD.NE.0 )THEN + NXFAIL = NXFAIL + 1 END IF + NXBAD = 0 LERR = .FALSE. RETURN * 9999 FORMAT( ' ***** ILLEGAL VALUE OF PARAMETER NUMBER ', I2, ' NOT D', $ 'ETECTED BY ', A6, ' *****' ) * -* End of CHKXER. +* End of CHKXER +* + END + SUBROUTINE CREGR1( TRANS, M, N, LY, KL, KU, ALPHA, A, LDA, X, + $ INCX, BETA, Y, INCY, YS ) + IMPLICIT NONE +* +* Input initialization for regression test. * +* .. Scalar Arguments .. + CHARACTER*1 TRANS + INTEGER LY, M, N, KL, KU, LDA, INCX, INCY + COMPLEX ALPHA, BETA +* .. Array Arguments .. + COMPLEX A(LDA,*), X(*), Y(*), YS(*) +* .. Local Scalars .. + INTEGER I +* .. Intrinsic Functions .. + INTRINSIC CMPLX, REAL +* .. Executable Statements .. + TRANS = 'T' + M = 0 + N = 5 + KL = 0 + KU = 0 + ALPHA = CMPLX( 1.0 ) + LDA = MAX( 1, M ) + INCX = 1 + BETA = CMPLX( -0.7, -0.8 ) + INCY = 1 + LY = ABS( INCY )*N + DO 10 I = 1, LY + Y( I ) = CMPLX( 42.0, REAL( I ) ) + YS( I ) = Y( I ) + 10 CONTINUE + RETURN END SUBROUTINE XERBLA( SRNAME, INFO ) + IMPLICIT NONE * * This is a special version of XERBLA to be used only as part of * the test program for testing error exits from the Level 2 BLAS @@ -3242,14 +3423,18 @@ SUBROUTINE XERBLA( SRNAME, INFO ) * * .. Scalar Arguments .. INTEGER INFO - CHARACTER*6 SRNAME + CHARACTER*(*) SRNAME * .. Scalars in Common .. + INTEGER NXRUN, NXFAIL, NXBAD INTEGER INFOT, NOUT LOGICAL LERR, OK CHARACTER*6 SRNAMT * .. Common blocks .. COMMON /INFOC/INFOT, NOUT, OK, LERR + COMMON /XERCNT/NXRUN, NXFAIL, NXBAD COMMON /SRNAMC/SRNAMT +* .. Locals .. + INTEGER SRLEN * .. Executable Statements .. LERR = .TRUE. IF( INFO.NE.INFOT )THEN @@ -3259,16 +3444,19 @@ SUBROUTINE XERBLA( SRNAME, INFO ) WRITE( NOUT, FMT = 9997 )INFO END IF OK = .FALSE. + NXBAD = 1 END IF - IF( SRNAME.NE.SRNAMT )THEN + SRLEN = MIN(LEN_TRIM(SRNAME), LEN_TRIM(SRNAMT)) + IF( SRNAME(1:SRLEN).NE.SRNAMT(1:SRLEN) )THEN WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT OK = .FALSE. + NXBAD = 1 END IF RETURN * 9999 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6, ' INSTEAD', $ ' OF ', I2, ' *******' ) - 9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A6, ' INSTE', + 9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A, ' INSTE', $ 'AD OF ', A6, ' *******' ) 9997 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6, $ ' *******' ) @@ -3276,4 +3464,3 @@ SUBROUTINE XERBLA( SRNAME, INFO ) * End of XERBLA * END - diff --git a/BLAS/TESTING/cblat3.f b/BLAS/TESTING/cblat3.f index a65e1364cf..1e8f865bdf 100644 --- a/BLAS/TESTING/cblat3.f +++ b/BLAS/TESTING/cblat3.f @@ -19,8 +19,8 @@ *> Test program for the COMPLEX Level 3 Blas. *> *> The program must be driven by a short data file. The first 14 records -*> of the file are read using list-directed input, the last 9 records -*> are read using the format ( A6, L2 ). An annotated example of a data +*> of the file are read using list-directed input, the last 10 records +*> are read using the format ( A7, L2 ). An annotated example of a data *> file can be obtained by deleting the first 3 characters from the *> following 23 lines: *> 'cblat3.out' NAME OF SUMMARY OUTPUT FILE @@ -46,6 +46,7 @@ *> CSYRK T PUT F FOR NO TEST. SAME COLUMNS. *> CHER2K T PUT F FOR NO TEST. SAME COLUMNS. *> CSYR2K T PUT F FOR NO TEST. SAME COLUMNS. +*> CGEMMTR T PUT F FOR NO TEST. SAME COLUMNS. *> *> Further Details *> =============== @@ -78,17 +79,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date April 2012 -* *> \ingroup complex_blas_testing * * ===================================================================== PROGRAM CBLAT3 + IMPLICIT NONE * -* -- Reference BLAS test routine (version 3.7.0) -- +* -- Reference BLAS test routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* April 2012 * * ===================================================================== * @@ -96,7 +95,7 @@ PROGRAM CBLAT3 INTEGER NIN PARAMETER ( NIN = 5 ) INTEGER NSUBS - PARAMETER ( NSUBS = 9 ) + PARAMETER ( NSUBS = 10 ) COMPLEX ZERO, ONE PARAMETER ( ZERO = ( 0.0, 0.0 ), ONE = ( 1.0, 0.0 ) ) REAL RZERO @@ -106,12 +105,13 @@ PROGRAM CBLAT3 INTEGER NIDMAX, NALMAX, NBEMAX PARAMETER ( NIDMAX = 9, NALMAX = 7, NBEMAX = 7 ) * .. Local Scalars .. + REAL S1, S2 REAL EPS, ERR, THRESH INTEGER I, ISNUM, J, N, NALF, NBET, NIDIM, NOUT, NTRA LOGICAL FATAL, LTESTT, REWI, SAME, SFATAL, TRACE, $ TSTERR CHARACTER*1 TRANSA, TRANSB - CHARACTER*6 SNAMET + CHARACTER*7 SNAMET CHARACTER*32 SNAPS, SUMMRY * .. Local Arrays .. COMPLEX AA( NMAX*NMAX ), AB( NMAX, 2*NMAX ), @@ -123,27 +123,29 @@ PROGRAM CBLAT3 REAL G( NMAX ) INTEGER IDIM( NIDMAX ) LOGICAL LTEST( NSUBS ) - CHARACTER*6 SNAMES( NSUBS ) + CHARACTER*7 SNAMES( NSUBS ) * .. External Functions .. REAL SDIFF LOGICAL LCE EXTERNAL SDIFF, LCE * .. External Subroutines .. EXTERNAL CCHK1, CCHK2, CCHK3, CCHK4, CCHK5, CCHKE, CMMCH + EXTERNAL CCHK6 * .. Intrinsic Functions .. INTRINSIC MAX, MIN * .. Scalars in Common .. INTEGER INFOT, NOUTC LOGICAL LERR, OK - CHARACTER*6 SRNAMT + CHARACTER*7 SRNAMT * .. Common blocks .. COMMON /INFOC/INFOT, NOUTC, OK, LERR COMMON /SRNAMC/SRNAMT * .. Data statements .. DATA SNAMES/'CGEMM ', 'CHEMM ', 'CSYMM ', 'CTRMM ', $ 'CTRSM ', 'CHERK ', 'CSYRK ', 'CHER2K', - $ 'CSYR2K'/ + $ 'CSYR2K', 'CGEMMTR'/ * .. Executable Statements .. + CALL CPU_TIME( S1 ) * * Read name and unit number for summary output file and open file. * @@ -243,14 +245,15 @@ PROGRAM CBLAT3 N = MIN( 32, NMAX ) DO 100 J = 1, N DO 90 I = 1, N - AB( I, J ) = MAX( I - J + 1, 0 ) + AB( I, J ) = REAL( MAX( I - J + 1, 0 ) ) 90 CONTINUE - AB( J, NMAX + 1 ) = J - AB( 1, NMAX + J ) = J + AB( J, NMAX + 1 ) = REAL( J ) + AB( 1, NMAX + J ) = REAL( J ) C( J, 1 ) = ZERO 100 CONTINUE DO 110 J = 1, N - CC( J ) = J*( ( J + 1 )*J )/2 - ( ( J + 1 )*J*( J - 1 ) )/3 + CC( J ) = REAL( J*( ( J + 1 )*J )/2 - + $ ( ( J + 1 )*J*( J - 1 ) )/3 ) 110 CONTINUE * CC holds the exact result. On exit from CMMCH CT holds * the result computed by CMMCH. @@ -274,12 +277,12 @@ PROGRAM CBLAT3 STOP END IF DO 120 J = 1, N - AB( J, NMAX + 1 ) = N - J + 1 - AB( 1, NMAX + J ) = N - J + 1 + AB( J, NMAX + 1 ) = REAL( N - J + 1 ) + AB( 1, NMAX + J ) = REAL( N - J + 1 ) 120 CONTINUE DO 130 J = 1, N - CC( N - J + 1 ) = J*( ( J + 1 )*J )/2 - - $ ( ( J + 1 )*J*( J - 1 ) )/3 + CC( N - J + 1 ) = REAL( J*( ( J + 1 )*J )/2 - + $ ( ( J + 1 )*J*( J - 1 ) )/3 ) 130 CONTINUE TRANSA = 'C' TRANSB = 'N' @@ -320,7 +323,7 @@ PROGRAM CBLAT3 OK = .TRUE. FATAL = .FALSE. GO TO ( 140, 150, 150, 160, 160, 170, 170, - $ 180, 180 )ISNUM + $ 180, 180, 185 )ISNUM * Test CGEMM, 01. 140 CALL CCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, @@ -349,6 +352,11 @@ PROGRAM CBLAT3 $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W ) GO TO 190 + 185 CALL CCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, + $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, + $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, + $ CC, CS, CT, G ) + * 190 IF( FATAL.AND.SFATAL ) $ GO TO 210 @@ -367,6 +375,8 @@ PROGRAM CBLAT3 230 CONTINUE IF( TRACE ) $ CLOSE ( NTRA ) + CALL CPU_TIME( S2 ) + WRITE( NOUT, FMT = 9983 )S2 - S1 CLOSE ( NOUT ) STOP * @@ -385,7 +395,7 @@ PROGRAM CBLAT3 $ 7( '(', F4.1, ',', F4.1, ') ', : ) ) 9991 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM', $ /' ******* TESTS ABANDONED *******' ) - 9990 FORMAT( ' SUBPROGRAM NAME ', A6, ' NOT RECOGNIZED', /' ******* T', + 9990 FORMAT( ' SUBPROGRAM NAME ', A7, ' NOT RECOGNIZED', /' ******* T', $ 'ESTS ABANDONED *******' ) 9989 FORMAT( ' ERROR IN CMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALU', $ 'ATED WRONGLY.', /' CMMCH WAS CALLED WITH TRANSA = ', A1, @@ -393,13 +403,14 @@ PROGRAM CBLAT3 $ 'ERR = ', F12.3, '.', /' THIS MAY BE DUE TO FAULTS IN THE ', $ 'ARITHMETIC OR THE COMPILER.', /' ******* TESTS ABANDONED ', $ '*******' ) - 9988 FORMAT( A6, L2 ) - 9987 FORMAT( 1X, A6, ' WAS NOT TESTED' ) + 9988 FORMAT( A7, L2 ) + 9987 FORMAT( 1X, A7, ' WAS NOT TESTED' ) 9986 FORMAT( /' END OF TESTS' ) 9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' ) 9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' ) + 9983 FORMAT( ' Total time used = ', F12.2, ' seconds', / ) * -* End of CBLAT3. +* End of CBLAT3 * END SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, @@ -425,7 +436,7 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -437,6 +448,7 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX ALPHA, ALS, BETA, BLS REAL ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, ICA, ICB, IK, IM, IN, K, KS, LAA, $ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, M, $ MA, MB, MS, N, NA, NARGS, NB, NC, NS @@ -465,6 +477,8 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 110 IM = 1, NIDIM M = IDIM( IM ) @@ -586,6 +600,8 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9994 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -621,6 +637,8 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -633,6 +651,9 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ C, NMAX, CT, G, CC, LDC, EPS, $ ERR, FATAL, NOUT, .TRUE. ) ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -668,23 +689,26 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ ALPHA, LDA, LDB, BETA, LDC * 130 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', + 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', $ 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', + 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',''', A1, ''',', + 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A7, '(''', A1, ''',''', A1, ''',', $ 3( I3, ',' ), '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, $ ',(', F4.1, ',', F4.1, '), C,', I3, ').' ) 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A7, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of CCHK1. +* End of CCHK1 * END SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, @@ -710,7 +734,7 @@ SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -722,6 +746,7 @@ SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX ALPHA, ALS, BETA, BLS REAL ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, ICS, ICU, IM, IN, LAA, LBB, LCC, $ LDA, LDAS, LDB, LDBS, LDC, LDCS, M, MS, N, NA, $ NARGS, NC, NS @@ -751,6 +776,8 @@ SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 100 IM = 1, NIDIM M = IDIM( IM ) @@ -861,6 +888,8 @@ SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9994 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 110 END IF * @@ -895,6 +924,8 @@ SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 110 END IF * @@ -914,6 +945,9 @@ SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NOUT, .TRUE. ) END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -947,23 +981,26 @@ SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ LDB, BETA, LDC * 120 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', + 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', $ 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', + 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A7, '(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1, $ ',', F4.1, '), C,', I3, ') .' ) 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A7, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of CCHK2. +* End of CCHK2 * END SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, @@ -989,7 +1026,7 @@ SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -1000,6 +1037,7 @@ SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX ALPHA, ALS REAL ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, ICD, ICS, ICT, ICU, IM, IN, J, LAA, LBB, $ LDA, LDAS, LDB, LDBS, M, MS, N, NA, NARGS, NC, $ NS @@ -1030,6 +1068,8 @@ SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * Set up zero matrix for CMMCH. DO 20 J = 1, NMAX DO 10 I = 1, NMAX @@ -1139,6 +1179,8 @@ SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9994 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 150 END IF * @@ -1172,6 +1214,8 @@ SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 50 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 150 END IF * @@ -1222,6 +1266,9 @@ SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -1257,23 +1304,26 @@ SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ N, ALPHA, LDA, LDB * 160 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', + 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', $ 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', + 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A6, '(', 4( '''', A1, ''',' ), 2( I3, ',' ), + 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A7, '(', 4( '''', A1, ''',' ), 2( I3, ',' ), $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ') ', $ ' .' ) 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A7, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of CCHK3. +* End of CCHK3 * END SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, @@ -1299,7 +1349,7 @@ SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -1311,6 +1361,7 @@ SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX ALPHA, ALS, BETA, BETS REAL ERR, ERRMAX, RALPHA, RALS, RBETA, RBETS + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, K, KS, $ LAA, LCC, LDA, LDAS, LDC, LDCS, LJ, MA, N, NA, $ NARGS, NC, NS @@ -1340,6 +1391,8 @@ SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 100 IN = 1, NIDIM N = IDIM( IN ) @@ -1460,6 +1513,8 @@ SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1500,6 +1555,8 @@ SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 30 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1542,6 +1599,9 @@ SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, JC = JC + LDC + 1 END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -1585,27 +1645,30 @@ SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 130 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', + 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', $ 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', + 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9994 FORMAT( 1X, I6, ': ', A7, '(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ') ', $ ' .' ) - 9993 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9993 FORMAT( 1X, I6, ': ', A7, '(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ '(', F4.1, ',', F4.1, ') , A,', I3, ',(', F4.1, ',', F4.1, $ '), C,', I3, ') .' ) 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A7, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of CCHK4. +* End of CCHK4 * END SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, @@ -1631,7 +1694,7 @@ SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. COMPLEX AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ), $ ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ), @@ -1643,6 +1706,7 @@ SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX ALPHA, ALS, BETA, BETS REAL ERR, ERRMAX, RBETA, RBETS + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, JJAB, $ K, KS, LAA, LBB, LCC, LDA, LDAS, LDB, LDBS, $ LDC, LDCS, LJ, MA, N, NA, NARGS, NC, NS @@ -1672,6 +1736,8 @@ SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 130 IN = 1, NIDIM N = IDIM( IN ) @@ -1805,6 +1871,8 @@ SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 150 END IF * @@ -1843,6 +1911,8 @@ SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 150 END IF * @@ -1915,6 +1985,9 @@ SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ JJAB = JJAB + 2*NMAX END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -1958,27 +2031,30 @@ SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 160 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', + 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', $ 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', + 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9994 FORMAT( 1X, I6, ': ', A7, '(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',', F4.1, $ ', C,', I3, ') .' ) - 9993 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9993 FORMAT( 1X, I6, ': ', A7, '(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1, $ ',', F4.1, '), C,', I3, ') .' ) 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A7, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of CCHK5. +* End of CCHK5 * END SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT ) @@ -2001,8 +2077,9 @@ SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT ) * * .. Scalar Arguments .. INTEGER ISNUM, NOUT - CHARACTER*6 SRNAMT + CHARACTER*7 SRNAMT * .. Scalars in Common .. + INTEGER NXRUN, NXFAIL, NXBAD INTEGER INFOT, NOUTC LOGICAL LERR, OK * .. Parameters .. @@ -2015,9 +2092,10 @@ SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT ) COMPLEX A( 2, 1 ), B( 2, 1 ), C( 2, 1 ) * .. External Subroutines .. EXTERNAL CGEMM, CHEMM, CHER2K, CHERK, CHKXER, CSYMM, - $ CSYR2K, CSYRK, CTRMM, CTRSM + $ CSYR2K, CSYRK, CTRMM, CTRSM, CGEMMTR * .. Common blocks .. COMMON /INFOC/INFOT, NOUTC, OK, LERR + COMMON /XERCNT/NXRUN, NXFAIL, NXBAD * .. Executable Statements .. * OK is set to .FALSE. by the special version of XERBLA or by CHKXER * if anything is wrong. @@ -2025,6 +2103,11 @@ SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT ) * LERR is set to .TRUE. by the special version of XERBLA each time * it is called, and is then tested and re-set by CHKXER. LERR = .FALSE. +* NXRUN and NXFAIL count the error-exit tests of this routine; +* NXBAD is set by XERBLA when it is called wrongly. + NXRUN = 0 + NXFAIL = 0 + NXBAD = 0 * * Initialize ALPHA, BETA, RALPHA, and RBETA. * @@ -2034,7 +2117,7 @@ SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT ) RBETA = TWO * GO TO ( 10, 20, 30, 40, 50, 60, 70, 80, - $ 90 )ISNUM + $ 90, 100 )ISNUM 10 INFOT = 1 CALL CGEMM( '/', 'N', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2215,7 +2298,7 @@ SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 13 CALL CGEMM( 'T', 'T', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 100 + GO TO 110 20 INFOT = 1 CALL CHEMM( '/', 'U', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2282,7 +2365,7 @@ SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 12 CALL CHEMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 100 + GO TO 110 30 INFOT = 1 CALL CSYMM( '/', 'U', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2349,7 +2432,7 @@ SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 12 CALL CSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 100 + GO TO 110 40 INFOT = 1 CALL CTRMM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2506,7 +2589,7 @@ SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 11 CALL CTRMM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 100 + GO TO 110 50 INFOT = 1 CALL CTRSM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2663,7 +2746,7 @@ SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 11 CALL CTRSM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 100 + GO TO 110 60 INFOT = 1 CALL CHERK( '/', 'N', 0, 0, RALPHA, A, 1, RBETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2718,7 +2801,7 @@ SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 10 CALL CHERK( 'L', 'C', 2, 0, RALPHA, A, 1, RBETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 100 + GO TO 110 70 INFOT = 1 CALL CSYRK( '/', 'N', 0, 0, ALPHA, A, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2773,7 +2856,7 @@ SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 10 CALL CSYRK( 'L', 'T', 2, 0, ALPHA, A, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 100 + GO TO 110 80 INFOT = 1 CALL CHER2K( '/', 'N', 0, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2840,7 +2923,7 @@ SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 12 CALL CHER2K( 'L', 'C', 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 100 + GO TO 110 90 INFOT = 1 CALL CSYR2K( '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2907,19 +2990,218 @@ SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 12 CALL CSYR2K( 'L', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + GO TO 110 + 100 INFOT = 1 + CALL CGEMMTR( '/', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 1 + CALL CGEMMTR( '/', 'N', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 1 + CALL CGEMMTR( '/', 'N', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 1 + CALL CGEMMTR( '/', 'T', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 1 + CALL CGEMMTR( '/', 'T', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 1 + CALL CGEMMTR( '/', 'T', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 1 + CALL CGEMMTR( '/', 'C', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 1 + CALL CGEMMTR( '/', 'C', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 1 + CALL CGEMMTR( '/', 'C', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + + INFOT = 2 + CALL CGEMMTR( 'U', '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL CGEMMTR( 'U', '/', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL CGEMMTR( 'U', '/', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL CGEMMTR( 'L', '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL CGEMMTR( 'L', '/', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL CGEMMTR( 'L', '/', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + + INFOT = 3 + CALL CGEMMTR( 'U', 'N', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL CGEMMTR( 'U', 'C', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL CGEMMTR( 'U', 'T', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL CGEMMTR( 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL CGEMMTR( 'U', 'N', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL CGEMMTR( 'U', 'N', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL CGEMMTR( 'U', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL CGEMMTR( 'U', 'C', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL CGEMMTR( 'U', 'C', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL CGEMMTR( 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL CGEMMTR( 'U', 'T', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL CGEMMTR( 'U', 'T', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL CGEMMTR( 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL CGEMMTR( 'U', 'N', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL CGEMMTR( 'U', 'N', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL CGEMMTR( 'U', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL CGEMMTR( 'U', 'C', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL CGEMMTR( 'U', 'C', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL CGEMMTR( 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL CGEMMTR( 'U', 'T', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL CGEMMTR( 'U', 'T', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + + INFOT = 8 + CALL CGEMMTR( 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL CGEMMTR( 'U', 'N', 'C', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL CGEMMTR( 'U', 'N', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL CGEMMTR( 'U', 'C', 'N', 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL CGEMMTR( 'U', 'C', 'C', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL CGEMMTR( 'U', 'C', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL CGEMMTR( 'U', 'T', 'N', 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL CGEMMTR( 'U', 'T', 'C', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL CGEMMTR( 'U', 'T', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + + INFOT = 10 + CALL CGEMMTR( 'U', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 10 + CALL CGEMMTR( 'U', 'C', 'N', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 10 + CALL CGEMMTR( 'U', 'T', 'N', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL CGEMMTR( 'U', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL CGEMMTR( 'U', 'N', 'C', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL CGEMMTR( 'U', 'N', 'T', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL CGEMMTR( 'U', 'C', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL CGEMMTR( 'U', 'C', 'C', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL CGEMMTR( 'U', 'C', 'T', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL CGEMMTR( 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL CGEMMTR( 'U', 'T', 'C', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL CGEMMTR( 'U', 'T', 'T', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + GO TO 110 + * - 100 IF( OK )THEN + 110 IF( OK )THEN WRITE( NOUT, FMT = 9999 )SRNAMT ELSE WRITE( NOUT, FMT = 9998 )SRNAMT END IF + WRITE( NOUT, FMT = 9979 )SRNAMT, NXRUN, NXFAIL RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE TESTS OF ERROR-EXITS' ) - 9998 FORMAT( ' ******* ', A6, ' FAILED THE TESTS OF ERROR-EXITS *****', + 9999 FORMAT( ' ', A7, ' PASSED THE TESTS OF ERROR-EXITS' ) + 9998 FORMAT( ' ******* ', A7, ' FAILED THE TESTS OF ERROR-EXITS *****', $ '**' ) + 9979 FORMAT( ' ', A7, ' ERROR-EXIT TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of CCHKE. +* End of CCHKE * END SUBROUTINE CMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET, @@ -3047,7 +3329,7 @@ SUBROUTINE CMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET, END IF RETURN * -* End of CMAKE. +* End of CMAKE * END SUBROUTINE CMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, @@ -3087,9 +3369,9 @@ SUBROUTINE CMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, CONJG, MAX, REAL, SQRT * .. Statement Functions .. - REAL ABS1 + REAL CABS1 * .. Statement Function definitions .. - ABS1( CL ) = ABS( REAL( CL ) ) + ABS( AIMAG( CL ) ) + CABS1( CL ) = ABS( REAL( CL ) ) + ABS( AIMAG( CL ) ) * .. Executable Statements .. TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' @@ -3110,7 +3392,8 @@ SUBROUTINE CMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, DO 30 K = 1, KK DO 20 I = 1, M CT( I ) = CT( I ) + A( I, K )*B( K, J ) - G( I ) = G( I ) + ABS1( A( I, K ) )*ABS1( B( K, J ) ) + G( I ) = G( I ) + $ + CABS1( A( I, K ) )*CABS1( B( K, J ) ) 20 CONTINUE 30 CONTINUE ELSE IF( TRANA.AND..NOT.TRANB )THEN @@ -3118,16 +3401,16 @@ SUBROUTINE CMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, DO 50 K = 1, KK DO 40 I = 1, M CT( I ) = CT( I ) + CONJG( A( K, I ) )*B( K, J ) - G( I ) = G( I ) + ABS1( A( K, I ) )* - $ ABS1( B( K, J ) ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( K, J ) ) 40 CONTINUE 50 CONTINUE ELSE DO 70 K = 1, KK DO 60 I = 1, M CT( I ) = CT( I ) + A( K, I )*B( K, J ) - G( I ) = G( I ) + ABS1( A( K, I ) )* - $ ABS1( B( K, J ) ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( K, J ) ) 60 CONTINUE 70 CONTINUE END IF @@ -3136,16 +3419,16 @@ SUBROUTINE CMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, DO 90 K = 1, KK DO 80 I = 1, M CT( I ) = CT( I ) + A( I, K )*CONJG( B( J, K ) ) - G( I ) = G( I ) + ABS1( A( I, K ) )* - $ ABS1( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( I, K ) )* + $ CABS1( B( J, K ) ) 80 CONTINUE 90 CONTINUE ELSE DO 110 K = 1, KK DO 100 I = 1, M CT( I ) = CT( I ) + A( I, K )*B( J, K ) - G( I ) = G( I ) + ABS1( A( I, K ) )* - $ ABS1( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( I, K ) )* + $ CABS1( B( J, K ) ) 100 CONTINUE 110 CONTINUE END IF @@ -3156,16 +3439,16 @@ SUBROUTINE CMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, DO 120 I = 1, M CT( I ) = CT( I ) + CONJG( A( K, I ) )* $ CONJG( B( J, K ) ) - G( I ) = G( I ) + ABS1( A( K, I ) )* - $ ABS1( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( J, K ) ) 120 CONTINUE 130 CONTINUE ELSE DO 150 K = 1, KK DO 140 I = 1, M CT( I ) = CT( I ) + CONJG( A( K, I ) )*B( J, K ) - G( I ) = G( I ) + ABS1( A( K, I ) )* - $ ABS1( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( J, K ) ) 140 CONTINUE 150 CONTINUE END IF @@ -3174,16 +3457,16 @@ SUBROUTINE CMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, DO 170 K = 1, KK DO 160 I = 1, M CT( I ) = CT( I ) + A( K, I )*CONJG( B( J, K ) ) - G( I ) = G( I ) + ABS1( A( K, I ) )* - $ ABS1( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( J, K ) ) 160 CONTINUE 170 CONTINUE ELSE DO 190 K = 1, KK DO 180 I = 1, M CT( I ) = CT( I ) + A( K, I )*B( J, K ) - G( I ) = G( I ) + ABS1( A( K, I ) )* - $ ABS1( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( J, K ) ) 180 CONTINUE 190 CONTINUE END IF @@ -3191,15 +3474,15 @@ SUBROUTINE CMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, END IF DO 200 I = 1, M CT( I ) = ALPHA*CT( I ) + BETA*C( I, J ) - G( I ) = ABS1( ALPHA )*G( I ) + - $ ABS1( BETA )*ABS1( C( I, J ) ) + G( I ) = CABS1( ALPHA )*G( I ) + + $ CABS1( BETA )*CABS1( C( I, J ) ) 200 CONTINUE * * Compute the error ratio for this result. * ERR = ZERO DO 210 I = 1, M - ERRI = ABS1( CT( I ) - CC( I, J ) )/EPS + ERRI = CABS1( CT( I ) - CC( I, J ) )/EPS IF( G( I ).NE.RZERO ) $ ERRI = ERRI/G( I ) ERR = MAX( ERR, ERRI ) @@ -3235,7 +3518,7 @@ SUBROUTINE CMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, 9998 FORMAT( 1X, I7, 2( ' (', G15.6, ',', G15.6, ')' ) ) 9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) * -* End of CMMCH. +* End of CMMCH * END LOGICAL FUNCTION LCE( RI, RJ, LR ) @@ -3267,7 +3550,7 @@ LOGICAL FUNCTION LCE( RI, RJ, LR ) LCE = .FALSE. 30 RETURN * -* End of LCE. +* End of LCE * END LOGICAL FUNCTION LCERES( TYPE, UPLO, M, N, AA, AS, LDA ) @@ -3328,7 +3611,7 @@ LOGICAL FUNCTION LCERES( TYPE, UPLO, M, N, AA, AS, LDA ) LCERES = .FALSE. 80 RETURN * -* End of LCERES. +* End of LCERES * END COMPLEX FUNCTION CBEG( RESET ) @@ -3379,10 +3662,10 @@ COMPLEX FUNCTION CBEG( RESET ) IC = 0 GO TO 10 END IF - CBEG = CMPLX( ( I - 500 )/1001.0, ( J - 500 )/1001.0 ) + CBEG = CMPLX( REAL( I - 500 )/1001.0, REAL( J - 500 )/1001.0 ) RETURN * -* End of CBEG. +* End of CBEG * END REAL FUNCTION SDIFF( X, Y ) @@ -3401,7 +3684,7 @@ REAL FUNCTION SDIFF( X, Y ) SDIFF = X - Y RETURN * -* End of SDIFF. +* End of SDIFF * END SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -3419,19 +3702,28 @@ SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) * .. Scalar Arguments .. INTEGER INFOT, NOUT LOGICAL LERR, OK - CHARACTER*6 SRNAMT + CHARACTER*7 SRNAMT +* .. Scalars in Common .. + INTEGER NXRUN, NXFAIL, NXBAD +* .. Common blocks .. + COMMON /XERCNT/NXRUN, NXFAIL, NXBAD * .. Executable Statements .. + NXRUN = NXRUN + 1 IF( .NOT.LERR )THEN WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT OK = .FALSE. + NXFAIL = NXFAIL + 1 + ELSE IF( NXBAD.NE.0 )THEN + NXFAIL = NXFAIL + 1 END IF + NXBAD = 0 LERR = .FALSE. RETURN * 9999 FORMAT( ' ***** ILLEGAL VALUE OF PARAMETER NUMBER ', I2, ' NOT D', - $ 'ETECTED BY ', A6, ' *****' ) + $ 'ETECTED BY ', A7, ' *****' ) * -* End of CHKXER. +* End of CHKXER * END SUBROUTINE XERBLA( SRNAME, INFO ) @@ -3455,14 +3747,18 @@ SUBROUTINE XERBLA( SRNAME, INFO ) * * .. Scalar Arguments .. INTEGER INFO - CHARACTER*6 SRNAME + CHARACTER*(*) SRNAME * .. Scalars in Common .. + INTEGER NXRUN, NXFAIL, NXBAD INTEGER INFOT, NOUT LOGICAL LERR, OK - CHARACTER*6 SRNAMT + CHARACTER*7 SRNAMT * .. Common blocks .. COMMON /INFOC/INFOT, NOUT, OK, LERR + COMMON /XERCNT/NXRUN, NXFAIL, NXBAD COMMON /SRNAMC/SRNAMT +* .. Locals .. + INTEGER SRLEN * .. Executable Statements .. LERR = .TRUE. IF( INFO.NE.INFOT )THEN @@ -3472,17 +3768,20 @@ SUBROUTINE XERBLA( SRNAME, INFO ) WRITE( NOUT, FMT = 9997 )INFO END IF OK = .FALSE. + NXBAD = 1 END IF - IF( SRNAME.NE.SRNAMT )THEN + SRLEN = MIN(LEN_TRIM(SRNAME), LEN_TRIM(SRNAMT)) + IF( SRNAME(1:SRLEN).NE.SRNAMT(1:SRLEN) )THEN WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT OK = .FALSE. + NXBAD = 1 END IF RETURN * 9999 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6, ' INSTEAD', $ ' OF ', I2, ' *******' ) - 9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A6, ' INSTE', - $ 'AD OF ', A6, ' *******' ) + 9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A, ' INSTE', + $ 'AD OF ', A7, ' *******' ) 9997 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6, $ ' *******' ) * @@ -3490,3 +3789,509 @@ SUBROUTINE XERBLA( SRNAME, INFO ) * END + SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, + $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, + $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G ) +* +* Tests CGEMMTR. +* +* Auxiliary routine for test program for Level 3 Blas. +* +* -- Written on 8-February-1989. +* Jack Dongarra, Argonne National Laboratory. +* Iain Duff, AERE Harwell. +* Jeremy Du Croz, Numerical Algorithms Group Ltd. +* Sven Hammarling, Numerical Algorithms Group Ltd. +* +* .. Parameters .. + COMPLEX ZERO + PARAMETER ( ZERO = ( 0.0, 0.0 ) ) + REAL RZERO + PARAMETER ( RZERO = 0.0 ) +* .. Scalar Arguments .. + REAL EPS, THRESH + INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA + LOGICAL FATAL, REWI, TRACE + CHARACTER*7 SNAME +* .. Array Arguments .. + COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), + $ AS( NMAX*NMAX ), B( NMAX, NMAX ), + $ BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ), + $ C( NMAX, NMAX ), CC( NMAX*NMAX ), + $ CS( NMAX*NMAX ), CT( NMAX ) + REAL G( NMAX ) + INTEGER IDIM( NIDIM ) +* .. Local Scalars .. + COMPLEX ALPHA, ALS, BETA, BLS + REAL ERR, ERRMAX + INTEGER NTESTS, NFAILS + INTEGER I, IA, IB, ICA, ICB, IK, IN, K, KS, LAA, + $ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, + $ MA, MB, N, NA, NARGS, NB, NC, NS, IS + LOGICAL NULL, RESET, SAME, TRANA, TRANB + CHARACTER*1 TRANAS, TRANBS, TRANSA, TRANSB, UPLO, UPLOS + CHARACTER*3 ICH + CHARACTER*2 ISHAPE +* .. Local Arrays .. + LOGICAL ISAME( 13 ) +* .. External Functions .. + LOGICAL LCE, LCERES + EXTERNAL LCE, LCERES +* .. External Subroutines .. + EXTERNAL CGEMMTR, CMAKE, CMMTCH +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. Scalars in Common .. + INTEGER INFOT, NOUTC + LOGICAL LERR, OK +* .. Common blocks .. + COMMON /INFOC/INFOT, NOUTC, OK, LERR +* .. Data statements .. + DATA ICH/'NTC'/ + DATA ISHAPE/'UL'/ + +* .. Executable Statements .. +* + NARGS = 13 + NC = 0 + RESET = .TRUE. + ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 +* + DO 100 IN = 1, NIDIM + N = IDIM( IN ) +* Set LDC to 1 more than minimum value if room. + LDC = N + IF( LDC.LT.NMAX ) + $ LDC = LDC + 1 +* Skip tests if not enough room. + IF( LDC.GT.NMAX ) + $ GO TO 100 + LCC = LDC*N + NULL = N.LE.0 +* + DO 90 IK = 1, NIDIM + K = IDIM( IK ) +* + DO 80 ICA = 1, 3 + TRANSA = ICH( ICA: ICA ) + TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' +* + IF( TRANA )THEN + MA = K + NA = N + ELSE + MA = N + NA = K + END IF +* Set LDA to 1 more than minimum value if room. + LDA = MA + IF( LDA.LT.NMAX ) + $ LDA = LDA + 1 +* Skip tests if not enough room. + IF( LDA.GT.NMAX ) + $ GO TO 80 + LAA = LDA*NA +* +* Generate the matrix A. +* + CALL CMAKE( 'GE', ' ', ' ', MA, NA, A, NMAX, AA, LDA, + $ RESET, ZERO ) +* + DO 70 ICB = 1, 3 + TRANSB = ICH( ICB: ICB ) + TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' +* + IF( TRANB )THEN + MB = N + NB = K + ELSE + MB = K + NB = N + END IF +* Set LDB to 1 more than minimum value if room. + LDB = MB + IF( LDB.LT.NMAX ) + $ LDB = LDB + 1 +* Skip tests if not enough room. + IF( LDB.GT.NMAX ) + $ GO TO 70 + LBB = LDB*NB +* +* Generate the matrix B. +* + CALL CMAKE( 'GE', ' ', ' ', MB, NB, B, NMAX, BB, + $ LDB, RESET, ZERO ) +* + DO 60 IA = 1, NALF + ALPHA = ALF( IA ) +* + DO 50 IB = 1, NBET + BETA = BET( IB ) + DO 45 IS = 1, 2 + UPLO = ISHAPE( IS: IS ) + +* +* Generate the matrix C. +* + CALL CMAKE( 'GE', UPLO, ' ', N, N, C, NMAX, + $ CC, LDC, RESET, ZERO ) +* + NC = NC + 1 +* +* Save every datum before calling the +* subroutine. +* + UPLOS = UPLO + TRANAS = TRANSA + TRANBS = TRANSB + NS = N + KS = K + ALS = ALPHA + DO 10 I = 1, LAA + AS( I ) = AA( I ) + 10 CONTINUE + LDAS = LDA + DO 20 I = 1, LBB + BS( I ) = BB( I ) + 20 CONTINUE + LDBS = LDB + BLS = BETA + DO 30 I = 1, LCC + CS( I ) = CC( I ) + 30 CONTINUE + LDCS = LDC +* +* Call the subroutine. +* + IF( TRACE ) + $ WRITE( NTRA, FMT = 9995 )NC, SNAME, UPLO, + $ TRANSA, TRANSB, N, K, ALPHA, LDA, LDB, + $ BETA, LDC + IF( REWI ) + $ REWIND NTRA + CALL CGEMMTR( UPLO, TRANSA, TRANSB, N, K, + $ ALPHA, AA, LDA, BB, LDB, BETA, + $ CC, LDC ) +* +* Check if error-exit was taken incorrectly. +* + IF( .NOT.OK )THEN + WRITE( NOUT, FMT = 9994 ) + FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 + GO TO 120 + END IF +* +* See what data changed inside subroutines. +* + ISAME( 1 ) = UPLOS.EQ.UPLO + ISAME( 2 ) = TRANSA.EQ.TRANAS + ISAME( 3 ) = TRANSB.EQ.TRANBS + ISAME( 4 ) = NS.EQ.N + ISAME( 5 ) = KS.EQ.K + ISAME( 6 ) = ALS.EQ.ALPHA + ISAME( 7 ) = LCE( AS, AA, LAA ) + ISAME( 8 ) = LDAS.EQ.LDA + ISAME( 9 ) = LCE( BS, BB, LBB ) + ISAME( 10 ) = LDBS.EQ.LDB + ISAME( 11 ) = BLS.EQ.BETA + IF( NULL )THEN + ISAME( 12 ) = LCE( CS, CC, LCC ) + ELSE + ISAME( 12 ) = LCERES( 'GE', ' ', N, N, CS, + $ CC, LDC ) + END IF + ISAME( 13 ) = LDCS.EQ.LDC +* +* If data was incorrectly changed, report +* and return. +* + SAME = .TRUE. + DO 40 I = 1, NARGS + SAME = SAME.AND.ISAME( I ) + IF( .NOT.ISAME( I ) ) + $ WRITE( NOUT, FMT = 9998 )I + 40 CONTINUE + IF( .NOT.SAME )THEN + FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 + GO TO 120 + END IF +* + IF( .NOT.NULL )THEN +* +* Check the result. +* + CALL CMMTCH( UPLO, TRANSA, TRANSB, N, + $ K, ALPHA, A, NMAX, B, NMAX, + $ BETA, C, NMAX, CT, G, CC, LDC, + $ EPS, ERR, FATAL, NOUT, .TRUE.) + ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 +* If got really bad answer, report and +* return. + IF( FATAL ) + $ GO TO 120 + END IF + 45 CONTINUE +* + 50 CONTINUE +* + 60 CONTINUE +* + 70 CONTINUE +* + 80 CONTINUE +* + 90 CONTINUE +* + 100 CONTINUE +* +* +* Report result. +* + IF( ERRMAX.LT.THRESH )THEN + WRITE( NOUT, FMT = 9999 )SNAME, NC + ELSE + WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX + END IF + GO TO 130 +* + 120 CONTINUE + WRITE( NOUT, FMT = 9996 )SNAME + WRITE( NOUT, FMT = 9995 )NC, SNAME, UPLO, TRANSA, TRANSB, N, K, + $ ALPHA, LDA, LDB, BETA, LDC +* + 130 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + RETURN +* + 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', + $ 'S)' ) + 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', + $ 'ANGED INCORRECTLY *******' ) + 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', + $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, + $ ' - SUSPECT *******' ) + 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A7, '(''',A1, ''',''',A1, ''',''', A1,''',', + $ 2( I3, ',' ), '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, + $ ',(', F4.1, ',', F4.1, '), C,', I3, ').' ) + 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', + $ '******' ) + 9979 FORMAT( ' ', A7, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) +* +* End of CCHK6 +* + END + + SUBROUTINE CMMTCH( UPLO, TRANSA, TRANSB, N, KK, ALPHA, A, LDA, + $ B, LDB, BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, + $ FATAL, NOUT, MV ) + IMPLICIT NONE +* +* Checks the results of the computational tests. +* +* Auxiliary routine for test program for Level 3 Blas. +* +* -- Written on 8-February-1989. +* Jack Dongarra, Argonne National Laboratory. +* Iain Duff, AERE Harwell. +* Jeremy Du Croz, Numerical Algorithms Group Ltd. +* Sven Hammarling, Numerical Algorithms Group Ltd. +* +* .. Parameters .. + COMPLEX ZERO + PARAMETER ( ZERO = ( 0.0, 0.0 ) ) + REAL RZERO, RONE + PARAMETER ( RZERO = 0.0, RONE = 1.0 ) +* .. Scalar Arguments .. + COMPLEX ALPHA, BETA + REAL EPS, ERR + INTEGER KK, LDA, LDB, LDC, LDCC, N, NOUT + LOGICAL FATAL, MV + CHARACTER*1 TRANSA, TRANSB, UPLO +* .. Array Arguments .. + COMPLEX A( LDA, * ), B( LDB, * ), C( LDC, * ), + $ CC( LDCC, * ), CT( * ) + REAL G( * ) +* .. Local Scalars .. + COMPLEX CL + REAL ERRI + INTEGER I, J, K, ISTART, ISTOP + LOGICAL CTRANA, CTRANB, TRANA, TRANB, UPPER +* .. Intrinsic Functions .. + INTRINSIC ABS, AIMAG, CONJG, MAX, REAL, SQRT +* .. Statement Functions .. + REAL CABS1 +* .. Statement Function definitions .. + CABS1( CL ) = ABS( REAL( CL ) ) + ABS( AIMAG( CL ) ) +* .. Executable Statements .. + UPPER = UPLO.EQ.'U' + TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' + TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' + CTRANA = TRANSA.EQ.'C' + CTRANB = TRANSB.EQ.'C' +* +* Compute expected result, one column at a time, in CT using data +* in A, B and C. +* Compute gauges in G. +* + ISTART = 1 + ISTOP = 1 + + DO 220 J = 1, N +* + IF ( UPPER ) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 10 I = ISTART, ISTOP + CT( I ) = ZERO + G( I ) = RZERO + 10 CONTINUE + IF( .NOT.TRANA.AND..NOT.TRANB )THEN + DO 30 K = 1, KK + DO 20 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*B( K, J ) + G( I ) = G( I ) + $ + CABS1( A( I, K ) )*CABS1( B( K, J ) ) + 20 CONTINUE + 30 CONTINUE + ELSE IF( TRANA.AND..NOT.TRANB )THEN + IF( CTRANA )THEN + DO 50 K = 1, KK + DO 40 I = ISTART, ISTOP + CT( I ) = CT( I ) + CONJG( A( K, I ) )*B( K, J ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( K, J ) ) + 40 CONTINUE + 50 CONTINUE + ELSE + DO 70 K = 1, KK + DO 60 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*B( K, J ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( K, J ) ) + 60 CONTINUE + 70 CONTINUE + END IF + ELSE IF( .NOT.TRANA.AND.TRANB )THEN + IF( CTRANB )THEN + DO 90 K = 1, KK + DO 80 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*CONJG( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( I, K ) )* + $ CABS1( B( J, K ) ) + 80 CONTINUE + 90 CONTINUE + ELSE + DO 110 K = 1, KK + DO 100 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*B( J, K ) + G( I ) = G( I ) + CABS1( A( I, K ) )* + $ CABS1( B( J, K ) ) + 100 CONTINUE + 110 CONTINUE + END IF + ELSE IF( TRANA.AND.TRANB )THEN + IF( CTRANA )THEN + IF( CTRANB )THEN + DO 130 K = 1, KK + DO 120 I = ISTART, ISTOP + CT( I ) = CT( I ) + CONJG( A( K, I ) )* + $ CONJG( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( J, K ) ) + 120 CONTINUE + 130 CONTINUE + ELSE + DO 150 K = 1, KK + DO 140 I = ISTART, ISTOP + CT( I ) = CT( I ) + CONJG( A( K, I ) )*B( J, K ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( J, K ) ) + 140 CONTINUE + 150 CONTINUE + END IF + ELSE + IF( CTRANB )THEN + DO 170 K = 1, KK + DO 160 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*CONJG( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( J, K ) ) + 160 CONTINUE + 170 CONTINUE + ELSE + DO 190 K = 1, KK + DO 180 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*B( J, K ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( J, K ) ) + 180 CONTINUE + 190 CONTINUE + END IF + END IF + END IF + DO 200 I = ISTART, ISTOP + CT( I ) = ALPHA*CT( I ) + BETA*C( I, J ) + G( I ) = CABS1( ALPHA )*G( I ) + + $ CABS1( BETA )*CABS1( C( I, J ) ) + 200 CONTINUE +* +* Compute the error ratio for this result. +* + ERR = ZERO + DO 210 I = ISTART, ISTOP + ERRI = CABS1( CT( I ) - CC( I, J ) )/EPS + IF( G( I ).NE.RZERO ) + $ ERRI = ERRI/G( I ) + ERR = MAX( ERR, ERRI ) + IF( ERR*SQRT( EPS ).GE.RONE ) + $ GO TO 230 + 210 CONTINUE +* + 220 CONTINUE +* +* If the loop completes, all results are at least half accurate. + GO TO 250 +* +* Report fatal error. +* + 230 FATAL = .TRUE. + WRITE( NOUT, FMT = 9999 ) + DO 240 I = ISTART, ISTOP + IF( MV )THEN + WRITE( NOUT, FMT = 9998 )I, CT( I ), CC( I, J ) + ELSE + WRITE( NOUT, FMT = 9998 )I, CC( I, J ), CT( I ) + END IF + 240 CONTINUE + IF( N.GT.1 ) + $ WRITE( NOUT, FMT = 9997 )J +* + 250 CONTINUE + RETURN +* + 9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL', + $ 'F ACCURATE *******', /' EXPECTED RE', + $ 'SULT COMPUTED RESULT' ) + 9998 FORMAT( 1X, I7, 2( ' (', G15.6, ',', G15.6, ')' ) ) + 9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) +* +* End of CMMTCH +* + END + diff --git a/BLAS/TESTING/cblat3.in b/BLAS/TESTING/cblat3.in index f1480557a1..701180f550 100644 --- a/BLAS/TESTING/cblat3.in +++ b/BLAS/TESTING/cblat3.in @@ -12,12 +12,13 @@ T LOGICAL FLAG, T TO TEST ERROR EXITS. (0.0,0.0) (1.0,0.0) (0.7,-0.9) VALUES OF ALPHA 3 NUMBER OF VALUES OF BETA (0.0,0.0) (1.0,0.0) (1.3,-1.1) VALUES OF BETA -CGEMM T PUT F FOR NO TEST. SAME COLUMNS. -CHEMM T PUT F FOR NO TEST. SAME COLUMNS. -CSYMM T PUT F FOR NO TEST. SAME COLUMNS. -CTRMM T PUT F FOR NO TEST. SAME COLUMNS. -CTRSM T PUT F FOR NO TEST. SAME COLUMNS. -CHERK T PUT F FOR NO TEST. SAME COLUMNS. -CSYRK T PUT F FOR NO TEST. SAME COLUMNS. -CHER2K T PUT F FOR NO TEST. SAME COLUMNS. -CSYR2K T PUT F FOR NO TEST. SAME COLUMNS. +CGEMM T PUT F FOR NO TEST. SAME COLUMNS. +CHEMM T PUT F FOR NO TEST. SAME COLUMNS. +CSYMM T PUT F FOR NO TEST. SAME COLUMNS. +CTRMM T PUT F FOR NO TEST. SAME COLUMNS. +CTRSM T PUT F FOR NO TEST. SAME COLUMNS. +CHERK T PUT F FOR NO TEST. SAME COLUMNS. +CSYRK T PUT F FOR NO TEST. SAME COLUMNS. +CHER2K T PUT F FOR NO TEST. SAME COLUMNS. +CSYR2K T PUT F FOR NO TEST. SAME COLUMNS. +CGEMMTR T PUT F FOR NO TEST. SAME COLUMNS. diff --git a/BLAS/TESTING/dblat1.f b/BLAS/TESTING/dblat1.f index 7f606aa392..875dbf53e5 100644 --- a/BLAS/TESTING/dblat1.f +++ b/BLAS/TESTING/dblat1.f @@ -30,17 +30,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date April 2012 -* *> \ingroup double_blas_testing * * ===================================================================== PROGRAM DBLAT1 + IMPLICIT NONE * -* -- Reference BLAS test routine (version 3.7.0) -- +* -- Reference BLAS test routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* April 2012 * * ===================================================================== * @@ -48,20 +46,26 @@ PROGRAM DBLAT1 INTEGER NOUT PARAMETER (NOUT=6) * .. Scalars in Common .. + INTEGER NTESTS, NFAILS + CHARACTER*6 SUBNAM INTEGER ICASE, INCX, INCY, N LOGICAL PASS * .. Local Scalars .. + DOUBLE PRECISION S1, S2 DOUBLE PRECISION SFAC INTEGER IC * .. External Subroutines .. EXTERNAL CHECK0, CHECK1, CHECK2, CHECK3, HEADER * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, PASS + COMMON /CNTBLA/NTESTS, NFAILS + COMMON /NAMBLA/SUBNAM * .. Data statements .. DATA SFAC/9.765625D-4/ * .. Executable Statements .. + CALL CPU_TIME( S1 ) WRITE (NOUT,99999) - DO 20 IC = 1, 13 + DO 20 IC = 1, 14 ICASE = IC CALL HEADER * @@ -71,6 +75,8 @@ PROGRAM DBLAT1 * .. these parameters .. * PASS = .TRUE. + NTESTS = 0 + NFAILS = 0 INCX = 9999 INCY = 9999 IF (ICASE.EQ.3 .OR. ICASE.EQ.11) THEN @@ -79,30 +85,42 @@ PROGRAM DBLAT1 + ICASE.EQ.10) THEN CALL CHECK1(SFAC) ELSE IF (ICASE.EQ.1 .OR. ICASE.EQ.2 .OR. ICASE.EQ.5 .OR. - + ICASE.EQ.6 .OR. ICASE.EQ.12 .OR. ICASE.EQ.13) THEN + + ICASE.EQ.6 .OR. ICASE.EQ.12 .OR. ICASE.EQ.13 .OR. + + ICASE.EQ.14 ) THEN CALL CHECK2(SFAC) ELSE IF (ICASE.EQ.4) THEN CALL CHECK3(SFAC) END IF * -- Print IF (PASS) WRITE (NOUT,99998) + WRITE (NOUT,99997) SUBNAM, NTESTS, NFAILS 20 CONTINUE + CALL CPU_TIME( S2 ) + WRITE (NOUT,99996) S2 - S1 STOP * 99999 FORMAT (' Real BLAS Test Program Results',/1X) 99998 FORMAT (' ----- PASS -----') +99997 FORMAT (1X,A6,' COMPUTATIONAL TESTS:',I9,' RUN,',I9, + + ' FAILED') +99996 FORMAT (' Total time used = ',F12.2,' seconds',/) +* +* End of DBLAT1 +* END SUBROUTINE HEADER * .. Parameters .. INTEGER NOUT PARAMETER (NOUT=6) * .. Scalars in Common .. + CHARACTER*6 SUBNAM INTEGER ICASE, INCX, INCY, N LOGICAL PASS * .. Local Arrays .. - CHARACTER*6 L(13) + CHARACTER*6 L(14) * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, PASS + COMMON /NAMBLA/SUBNAM * .. Data statements .. DATA L(1)/' DDOT '/ DATA L(2)/'DAXPY '/ @@ -117,13 +135,20 @@ SUBROUTINE HEADER DATA L(11)/'DROTMG'/ DATA L(12)/'DROTM '/ DATA L(13)/'DSDOT '/ + DATA L(14)/'DAXPBY'/ + * .. Executable Statements .. + SUBNAM = L(ICASE) WRITE (NOUT,99999) ICASE, L(ICASE) RETURN * 99999 FORMAT (/' Test of subprogram number',I3,12X,A6) +* +* End of HEADER +* END SUBROUTINE CHECK0(SFAC) + IMPLICIT NONE * .. Parameters .. INTEGER NOUT PARAMETER (NOUT=6) @@ -139,7 +164,7 @@ SUBROUTINE CHECK0(SFAC) DOUBLE PRECISION DA1(8), DATRUE(8), DB1(8), DBTRUE(8), DC1(8), $ DS1(8), DAB(4,9), DTEMP(9), DTRUE(9,9) * .. External Subroutines .. - EXTERNAL DROTG, DROTMG, STEST1 + EXTERNAL DROTG, DROTMG, STEST, STEST1 * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, PASS * .. Data statements .. @@ -164,7 +189,7 @@ SUBROUTINE CHECK0(SFAC) E 4.D10, 2.D-2, 1.D-5, 10.D0, F 2.D-10, 4.D-2, 1.D5, 10.D0, G 2.D10, 4.D-2, 1.D-5, 10.D0, - H 4.D0, -2.D0, 8.D0, 4.D0 / + H 4.D-9, 2.D-9, 2.D0, 1.D0/ * TRUE RESULTS FOR MODIFIED GIVENS DATA DTRUE/0.D0,0.D0, 1.3D0, .2D0, 0.D0,0.D0,0.D0, .5D0, 0.D0, A 0.D0,0.D0, 4.5D0, 4.2D0, 1.D0, .5D0, 0.D0,0.D0,0.D0, @@ -199,8 +224,15 @@ SUBROUTINE CHECK0(SFAC) DTRUE(9,7) = 1.D4 / D12 DTRUE(1,8) = DTRUE(1,7) DTRUE(2,8) = 2.D10 / (1.5D0 * D12 * D12) - DTRUE(1,9) = 32.D0 / 7.D0 - DTRUE(2,9) = -16.D0 / 7.D0 + DTRUE(1,9) = 5.9652323555555560D-02 + DTRUE(2,9) = 2.9826161777777780D-02 + DTRUE(3,9) = 5.4931640625000000D-04 + DTRUE(4,9) = 1.D0 + DTRUE(5,9) = -1.D0 + DTRUE(6,9) = 2.4414062500000000D-04 + DTRUE(7,9) = -1.2207031250000000D-04 + DTRUE(8,9) = 6.1035156250000000D-05 + DTRUE(9,9) = 2.4414062500000000D-04 * .. Executable Statements .. * * Compute true values which cannot be prestored @@ -210,7 +242,7 @@ SUBROUTINE CHECK0(SFAC) DBTRUE(3) = -1.0D0/0.6D0 DBTRUE(5) = 1.0D0/0.6D0 * - DO 20 K = 1, 8 + DO 20 K = 1, 9 * .. Set N=K for identification in output if any .. N = K IF (ICASE.EQ.3) THEN @@ -238,28 +270,34 @@ SUBROUTINE CHECK0(SFAC) END IF 20 CONTINUE 40 RETURN +* +* End of CHECK0 +* END SUBROUTINE CHECK1(SFAC) + IMPLICIT NONE * .. Parameters .. + DOUBLE PRECISION THRESH INTEGER NOUT - PARAMETER (NOUT=6) + PARAMETER (NOUT=6, THRESH=10.0D0) * .. Scalar Arguments .. DOUBLE PRECISION SFAC * .. Scalars in Common .. INTEGER ICASE, INCX, INCY, N LOGICAL PASS * .. Local Scalars .. - INTEGER I, LEN, NP1 + INTEGER I, IX, LEN, NP1 * .. Local Arrays .. DOUBLE PRECISION DTRUE1(5), DTRUE3(5), DTRUE5(8,5,2), DV(8,5,2), - + SA(10), STEMP(1), STRUE(8), SX(8) - INTEGER ITRUE2(5) + + DVR(8), SA(10), STEMP(1), STRUE(8), SX(8), + + SXR(15) + INTEGER ITRUE2(5), ITRUEC(5) * .. External Functions .. DOUBLE PRECISION DASUM, DNRM2 INTEGER IDAMAX EXTERNAL DASUM, DNRM2, IDAMAX * .. External Subroutines .. - EXTERNAL ITEST1, DSCAL, STEST, STEST1 + EXTERNAL ITEST1, DB1NRM2, DSCAL, STEST, STEST1 * .. Intrinsic Functions .. INTRINSIC MAX * .. Common blocks .. @@ -280,6 +318,8 @@ SUBROUTINE CHECK1(SFAC) + 0.2D0, 3.0D0, -0.6D0, 5.0D0, 0.3D0, 2.0D0, + 2.0D0, 2.0D0, 0.1D0, 4.0D0, -0.3D0, 6.0D0, + -0.5D0, 7.0D0, -0.1D0, 3.0D0/ + DATA DVR/8.0D0, -7.0D0, 9.0D0, 5.0D0, 9.0D0, 8.0D0, + + 7.0D0, 7.0D0/ DATA DTRUE1/0.0D0, 0.3D0, 0.5D0, 0.7D0, 0.6D0/ DATA DTRUE3/0.0D0, 0.3D0, 0.7D0, 1.1D0, 1.0D0/ DATA DTRUE5/0.10D0, 2.0D0, 2.0D0, 2.0D0, 2.0D0, @@ -297,6 +337,7 @@ SUBROUTINE CHECK1(SFAC) + 0.03D0, 4.0D0, -0.09D0, 6.0D0, -0.15D0, 7.0D0, + -0.03D0, 3.0D0/ DATA ITRUE2/0, 1, 2, 2, 3/ + DATA ITRUEC/0, 1, 1, 1, 1/ * .. Executable Statements .. DO 80 INCX = 1, 2 DO 60 NP1 = 1, 5 @@ -309,6 +350,10 @@ SUBROUTINE CHECK1(SFAC) * IF (ICASE.EQ.7) THEN * .. DNRM2 .. +* Test scaling when some entries are tiny or huge + CALL DB1NRM2(N,(INCX-2)*2,THRESH) + CALL DB1NRM2(N,INCX,THRESH) +* Test with hardcoded mid range entries STEMP(1) = DTRUE1(NP1) CALL STEST1(DNRM2(N,SX,INCX),STEMP(1),STEMP,SFAC) ELSE IF (ICASE.EQ.8) THEN @@ -325,15 +370,32 @@ SUBROUTINE CHECK1(SFAC) ELSE IF (ICASE.EQ.10) THEN * .. IDAMAX .. CALL ITEST1(IDAMAX(N,SX,INCX),ITRUE2(NP1)) + DO 100 I = 1, LEN + SX(I) = 42.0D0 + 100 CONTINUE + CALL ITEST1(IDAMAX(N,SX,INCX),ITRUEC(NP1)) ELSE WRITE (NOUT,*) ' Shouldn''t be here in CHECK1' STOP END IF 60 CONTINUE + IF (ICASE.EQ.10) THEN + N = 8 + IX = 1 + DO 120 I = 1, N + SXR(IX) = DVR(I) + IX = IX + INCX + 120 CONTINUE + CALL ITEST1(IDAMAX(N,SXR,INCX),3) + END IF 80 CONTINUE RETURN +* +* End of CHECK1 +* END SUBROUTINE CHECK2(SFAC) + IMPLICIT NONE * .. Parameters .. INTEGER NOUT PARAMETER (NOUT=6) @@ -343,9 +405,9 @@ SUBROUTINE CHECK2(SFAC) INTEGER ICASE, INCX, INCY, N LOGICAL PASS * .. Local Scalars .. - DOUBLE PRECISION SA + DOUBLE PRECISION SA, SB INTEGER I, J, KI, KN, KNI, KPAR, KSIZE, LENX, LENY, - $ MX, MY + $ LINCX, LINCY, MX, MY * .. Local Arrays .. DOUBLE PRECISION DT10X(7,4,4), DT10Y(7,4,4), DT7(4,4), $ DT8(7,4,4), DX1(7), @@ -354,13 +416,15 @@ SUBROUTINE CHECK2(SFAC) $ DPAR(5,4), DT19X(7,4,16),DT19XA(7,4,4), $ DT19XB(7,4,4), DT19XC(7,4,4),DT19XD(7,4,4), $ DT19Y(7,4,16), DT19YA(7,4,4),DT19YB(7,4,4), - $ DT19YC(7,4,4), DT19YD(7,4,4), DTEMP(5) + $ DT19YC(7,4,4), DT19YD(7,4,4), DTEMP(5), + $ STY0(1), SX0(1), SY0(1), DT20(7,4,4) INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4) * .. External Functions .. DOUBLE PRECISION DDOT, DSDOT EXTERNAL DDOT, DSDOT * .. External Subroutines .. - EXTERNAL DAXPY, DCOPY, DROTM, DSWAP, STEST, STEST1 + EXTERNAL DAXPY, DAXPBY, DCOPY, DROTM, DSWAP, STEST, + $ STEST1, TESTDSDOT * .. Intrinsic Functions .. INTRINSIC ABS, MIN * .. Common blocks .. @@ -374,6 +438,7 @@ SUBROUTINE CHECK2(SFAC) B (DT19Y(1,1,13),DT19YD(1,1,1)) DATA SA/0.3D0/ + DATA SB/0.5D0/ DATA INCXS/1, 2, -2, -1/ DATA INCYS/1, -2, 1, -2/ DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/ @@ -589,6 +654,27 @@ SUBROUTINE CHECK2(SFAC) M .7D0, -.9D0, 1.2D0, .7D0, -1.5D0, .2D0, 1.6D0, N 1.7D0, -.9D0, .5D0, .7D0, -1.6D0, .2D0, 2.4D0, O -2.6D0, -.9D0, -1.3D0, .7D0, 2.9D0, .2D0, -4.0D0 / + DATA DT20/0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, + + 0.0D0, 0.43D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, + + 0.0D0, 0.0D0, 0.43D0, -0.42D0, 0.0D0, 0.0D0, + + 0.0D0, 0.0D0, 0.0D0, 0.43D0, -0.42D0, 0.0D0, + + 0.59D0, 0.0D0, 0.0D0, 0.0D0, 0.5D0, 0.0D0, + + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.43D0, + + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, + + 0.1D0, -0.9D0, 0.33D0, 0.0D0, 0.0D0, 0.0D0, + + 0.0D0, 0.13D0, -0.9D0, 0.42D0, 0.7D0, -0.45D0, + + 0.2D0, 0.58D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, + + 0.0D0, 0.0D0, 0.0D0, 0.43D0, 0.0D0, 0.0D0, + + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.1D0, -0.27D0, + + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.13D0, + + -0.18D0, 0.00D0, 0.53D0, 0.0D0, 0.0D0, 0.0D0, + + 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, + + 0.43D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, + + 0.0D0, 0.43D0, -0.9D0, 0.18D0, 0.0D0, 0.0D0, + + 0.0D0, 0.0D0, 0.43D0, -0.9D0, 0.18D0, 0.7D0, + + -0.45D0, 0.2D0, 0.64D0/ + + * * .. Executable Statements .. * @@ -620,6 +706,14 @@ SUBROUTINE CHECK2(SFAC) STY(J) = DT8(J,KN,KI) 40 CONTINUE CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC) + ELSE IF (ICASE.EQ.14) THEN +* .. DAXPBY .. + CALL DAXPBY(N,SA,SX,INCX,SB,SY,INCY) + DO 50 J = 1, LENY + STY(J) = DT20(J,KN,KI) + 50 CONTINUE + CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC) + ELSE IF (ICASE.EQ.5) THEN * .. DCOPY .. DO 60 I = 1, 7 @@ -627,6 +721,23 @@ SUBROUTINE CHECK2(SFAC) 60 CONTINUE CALL DCOPY(N,SX,INCX,SY,INCY) CALL STEST(LENY,SY,STY,SSIZE2(1,1),1.0D0) + IF (KI.EQ.1) THEN + SX0(1) = 42.0D0 + SY0(1) = 43.0D0 + IF (N.EQ.0) THEN + STY0(1) = SY0(1) + ELSE + STY0(1) = SX0(1) + END IF + LINCX = INCX + INCX = 0 + LINCY = INCY + INCY = 0 + CALL DCOPY(N,SX0,INCX,SY0,INCY) + CALL STEST(1,SY0,STY0,SSIZE2(1,1),1.0D0) + INCX = LINCX + INCY = LINCY + END IF ELSE IF (ICASE.EQ.6) THEN * .. DSWAP .. CALL DSWAP(N,SX,INCX,SY,INCY) @@ -676,8 +787,12 @@ SUBROUTINE CHECK2(SFAC) 100 CONTINUE 120 CONTINUE RETURN +* +* End of CHECK2 +* END SUBROUTINE CHECK3(SFAC) + IMPLICIT NONE * .. Parameters .. INTEGER NOUT PARAMETER (NOUT=6) @@ -882,8 +997,12 @@ SUBROUTINE CHECK3(SFAC) CALL STEST(5,COPYY,MWPSTY,MWPSTY,SFAC) 200 CONTINUE RETURN +* +* End of CHECK3 +* END SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC) + IMPLICIT NONE * ********************************* STEST ************************** * * THIS SUBR COMPARES ARRAYS SCOMP() AND STRUE() OF LENGTH LEN TO @@ -902,6 +1021,7 @@ SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC) * .. Array Arguments .. DOUBLE PRECISION SCOMP(LEN), SSIZE(LEN), STRUE(LEN) * .. Scalars in Common .. + INTEGER NTESTS, NFAILS INTEGER ICASE, INCX, INCY, N LOGICAL PASS * .. Local Scalars .. @@ -914,12 +1034,15 @@ SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC) INTRINSIC ABS * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, PASS + COMMON /CNTBLA/NTESTS, NFAILS * .. Executable Statements .. * DO 40 I = 1, LEN + NTESTS = NTESTS + 1 SD = SCOMP(I) - STRUE(I) IF (ABS(SFAC*SD) .LE. ABS(SSIZE(I))*EPSILON(ZERO)) + GO TO 40 + NFAILS = NFAILS + 1 * * HERE SCOMP(I) IS NOT CLOSE TO STRUE(I). * @@ -938,8 +1061,12 @@ SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC) + ' COMP(I) TRUE(I) DIFFERENCE', + ' SIZE(I)',/1X) 99997 FORMAT (1X,I4,I3,2I5,I3,2D36.8,2D12.4) +* +* End of STEST +* END SUBROUTINE TESTDSDOT(SCOMP,STRUE,SSIZE,SFAC) + IMPLICIT NONE * ********************************* STEST ************************** * * THIS SUBR COMPARES ARRAYS SCOMP() AND STRUE() OF LENGTH LEN TO @@ -955,6 +1082,7 @@ SUBROUTINE TESTDSDOT(SCOMP,STRUE,SSIZE,SFAC) * .. Scalar Arguments .. REAL SFAC, SCOMP, SSIZE, STRUE * .. Scalars in Common .. + INTEGER NTESTS, NFAILS INTEGER ICASE, INCX, INCY, N LOGICAL PASS * .. Local Scalars .. @@ -963,11 +1091,13 @@ SUBROUTINE TESTDSDOT(SCOMP,STRUE,SSIZE,SFAC) INTRINSIC ABS * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, PASS + COMMON /CNTBLA/NTESTS, NFAILS * .. Executable Statements .. * SD = SCOMP - STRUE IF (ABS(SFAC*SD) .LE. ABS(SSIZE) * EPSILON(ZERO)) + GO TO 40 + NFAILS = NFAILS + 1 * * HERE SCOMP(I) IS NOT CLOSE TO STRUE(I). * @@ -986,11 +1116,15 @@ SUBROUTINE TESTDSDOT(SCOMP,STRUE,SSIZE,SFAC) + ' COMP(I) TRUE(I) DIFFERENCE', + ' SIZE(I)',/1X) 99997 FORMAT (1X,I4,I3,1I5,I3,2E36.8,2E12.4) +* +* End of TESTDSDOT +* END SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC) + IMPLICIT NONE * ************************* STEST1 ***************************** * -* THIS IS AN INTERFACE SUBROUTINE TO ACCOMODATE THE FORTRAN +* THIS IS AN INTERFACE SUBROUTINE TO ACCOMMODATE THE FORTRAN * REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE * ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT. * @@ -1011,8 +1145,12 @@ SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC) CALL STEST(1,SCOMP,STRUE,SSIZE,SFAC) * RETURN +* +* End of STEST1 +* END DOUBLE PRECISION FUNCTION SDIFF(SA,SB) + IMPLICIT NONE * ********************************* SDIFF ************************** * COMPUTES DIFFERENCE OF TWO NUMBERS. C. L. LAWSON, JPL 1974 FEB 15 * @@ -1021,8 +1159,12 @@ DOUBLE PRECISION FUNCTION SDIFF(SA,SB) * .. Executable Statements .. SDIFF = SA - SB RETURN +* +* End of SDIFF +* END SUBROUTINE ITEST1(ICOMP,ITRUE) + IMPLICIT NONE * ********************************* ITEST1 ************************* * * THIS SUBROUTINE COMPARES THE VARIABLES ICOMP AND ITRUE FOR @@ -1035,15 +1177,19 @@ SUBROUTINE ITEST1(ICOMP,ITRUE) * .. Scalar Arguments .. INTEGER ICOMP, ITRUE * .. Scalars in Common .. + INTEGER NTESTS, NFAILS INTEGER ICASE, INCX, INCY, N LOGICAL PASS * .. Local Scalars .. INTEGER ID * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, PASS + COMMON /CNTBLA/NTESTS, NFAILS * .. Executable Statements .. * + NTESTS = NTESTS + 1 IF (ICOMP.EQ.ITRUE) GO TO 40 + NFAILS = NFAILS + 1 * * HERE ICOMP IS NOT EQUAL TO ITRUE. * @@ -1062,4 +1208,229 @@ SUBROUTINE ITEST1(ICOMP,ITRUE) + ' COMP TRUE DIFFERENCE', + /1X) 99997 FORMAT (1X,I4,I3,2I5,2I36,I12) +* +* End of ITEST1 +* + END + SUBROUTINE DB1NRM2(N,INCX,THRESH) + IMPLICIT NONE +* Compare NRM2 with a reference computation using combinations +* of the following values: +* +* 0, very small, small, ulp, 1, 1/ulp, big, very big, infinity, NaN +* +* one of these values is used to initialize x(1) and x(2:N) is +* filled with random values from [-1,1] scaled by another of +* these values. +* +* This routine is adapted from the test suite provided by +* Anderson E. (2017) +* Algorithm 978: Safe Scaling in the Level 1 BLAS +* ACM Trans Math Softw 44:1--28 +* https://doi.org/10.1145/3061665 +* +* .. Scalar Arguments .. + INTEGER INCX, N + DOUBLE PRECISION THRESH +* +* ===================================================================== +* .. Parameters .. + INTEGER NMAX, NOUT, NV + PARAMETER (NMAX=20, NOUT=6, NV=10) + DOUBLE PRECISION HALF, ONE, TWO, ZERO + PARAMETER (HALF=0.5D+0, ONE=1.0D+0, TWO= 2.0D+0, + & ZERO=0.0D+0) +* .. External Functions .. + DOUBLE PRECISION DNRM2 + EXTERNAL DNRM2 +* .. Intrinsic Functions .. + INTRINSIC ABS, DBLE, MAX, MIN, SQRT +* .. Model parameters .. + DOUBLE PRECISION BIGNUM, SAFMAX, SAFMIN, SMLNUM, ULP + PARAMETER (BIGNUM=0.99792015476735990583D+292, + & SAFMAX=0.44942328371557897693D+308, + & SAFMIN=0.22250738585072013831D-307, + & SMLNUM=0.10020841800044863890D-291, + & ULP=0.22204460492503130808D-015) +* .. Local Scalars .. + DOUBLE PRECISION ROGUE, SNRM, TRAT, V0, V1, WORKSSQ, Y1, Y2, + & YMAX, YMIN, YNRM, ZNRM + INTEGER I, IV, IW, IX + LOGICAL FIRST +* .. Local Arrays .. + DOUBLE PRECISION VALUES(NV), WORK(NMAX), X(NMAX), Z(NMAX) +* .. Scalars in Common .. + INTEGER NTESTS, NFAILS +* .. Common blocks .. + COMMON /CNTBLA/NTESTS, NFAILS +* .. Executable Statements .. + VALUES(1) = ZERO + VALUES(2) = TWO*SAFMIN + VALUES(3) = SMLNUM + VALUES(4) = ULP + VALUES(5) = ONE + VALUES(6) = ONE / ULP + VALUES(7) = BIGNUM + VALUES(8) = SAFMAX + VALUES(9) = DXVALS(V0,2) + VALUES(10) = DXVALS(V0,3) + ROGUE = -1234.5678D+0 + FIRST = .TRUE. +* +* Check that the arrays are large enough +* + IF (N*ABS(INCX).GT.NMAX) THEN + WRITE (NOUT,99) "DNRM2", NMAX, INCX, N, N*ABS(INCX) + RETURN + END IF +* +* Zero-sized inputs are tested in STEST1. + IF (N.LE.0) THEN + RETURN + END IF +* +* Generate (N-1) values in (-1,1). +* + DO I = 2, N + CALL RANDOM_NUMBER(WORK(I)) + WORK(I) = ONE - TWO*WORK(I) + END DO +* +* Compute the sum of squares of the random values +* by an unscaled algorithm. +* + WORKSSQ = ZERO + DO I = 2, N + WORKSSQ = WORKSSQ + WORK(I)*WORK(I) + END DO +* +* Construct the test vector with one known value +* and the rest from the random work array multiplied +* by a scaling factor. +* + DO IV = 1, NV + V0 = VALUES(IV) + IF (ABS(V0).GT.ONE) THEN + V0 = V0*HALF + END IF + Z(1) = V0 + DO IW = 1, NV + V1 = VALUES(IW) + IF (ABS(V1).GT.ONE) THEN + V1 = (V1*HALF) / SQRT(DBLE(N)) + END IF + DO I = 2, N + Z(I) = V1*WORK(I) + END DO +* +* Compute the expected value of the 2-norm +* + Y1 = ABS(V0) + IF (N.GT.1) THEN + Y2 = ABS(V1)*SQRT(WORKSSQ) + ELSE + Y2 = ZERO + END IF + YMIN = MIN(Y1, Y2) + YMAX = MAX(Y1, Y2) +* +* Expected value is NaN if either is NaN. The test +* for YMIN == YMAX avoids further computation if both +* are infinity. +* + IF ((Y1.NE.Y1).OR.(Y2.NE.Y2)) THEN +* Add to propagate NaN + YNRM = Y1 + Y2 + ELSE IF (YMAX == ZERO) THEN + YNRM = ZERO + ELSE IF (YMIN == YMAX) THEN + YNRM = SQRT(TWO)*YMAX + ELSE + YNRM = YMAX*SQRT(ONE + (YMIN / YMAX)**2) + END IF +* +* Fill the input array to DNRM2 with steps of incx +* + DO I = 1, N + X(I) = ROGUE + END DO + IX = 1 + IF (INCX.LT.0) IX = 1 - (N-1)*INCX + DO I = 1, N + X(IX) = Z(I) + IX = IX + INCX + END DO +* +* Call DNRM2 to compute the 2-norm +* + SNRM = DNRM2(N,X,INCX) +* +* Compare SNRM and ZNRM. Roundoff error grows like O(n) +* in this implementation so we scale the test ratio accordingly. +* + IF (INCX.EQ.0) THEN + ZNRM = SQRT(DBLE(N))*ABS(X(1)) + ELSE + ZNRM = YNRM + END IF +* +* The tests for NaN rely on the compiler not being overly +* aggressive and removing the statements altogether. + IF ((SNRM.NE.SNRM).OR.(ZNRM.NE.ZNRM)) THEN + IF ((SNRM.NE.SNRM).NEQV.(ZNRM.NE.ZNRM)) THEN + TRAT = ONE / ULP + ELSE + TRAT = ZERO + END IF + ELSE IF (SNRM == ZNRM) THEN + TRAT = ZERO + ELSE IF (ZNRM == ZERO) THEN + TRAT = SNRM / ULP + ELSE + TRAT = (ABS(SNRM-ZNRM) / ZNRM) / (DBLE(N)*ULP) + END IF + NTESTS = NTESTS + 1 + IF ((TRAT.NE.TRAT).OR.(TRAT.GE.THRESH)) THEN + NFAILS = NFAILS + 1 + IF (FIRST) THEN + FIRST = .FALSE. + WRITE(NOUT,99999) + END IF + WRITE (NOUT,98) "DNRM2", N, INCX, IV, IW, TRAT + END IF + END DO + END DO +99999 FORMAT (' FAIL') + 99 FORMAT ( ' Not enough space to test ', A6, ': NMAX = ',I6, + + ', INCX = ',I6,/,' N = ',I6,', must be at least ',I6 ) + 98 FORMAT( 1X, A6, ': N=', I6,', INCX=', I4, ', IV=', I2, ', IW=', + + I2, ', test=', E15.8 ) + RETURN + CONTAINS + DOUBLE PRECISION FUNCTION DXVALS(XX,K) + IMPLICIT NONE +* .. Scalar Arguments .. + DOUBLE PRECISION XX + INTEGER K +* .. Parameters .. + DOUBLE PRECISION ZERO + PARAMETER (ZERO=0.0D+0) +* .. Local Scalars .. + DOUBLE PRECISION X, Y, Z +* .. Intrinsic Functions .. + INTRINSIC HUGE +* .. Executable Statements .. + X = ZERO + Y = HUGE(XX) + Z = Y*Y + IF (K.EQ.1) THEN + X = -Z + ELSE IF (K.EQ.2) THEN + X = Z + ELSE IF (K.EQ.3) THEN + X = Z / Z + END IF + DXVALS = X + RETURN + END END diff --git a/BLAS/TESTING/dblat2.f b/BLAS/TESTING/dblat2.f index 9bbbe9792b..8092518a30 100644 --- a/BLAS/TESTING/dblat2.f +++ b/BLAS/TESTING/dblat2.f @@ -20,7 +20,7 @@ *> *> The program must be driven by a short data file. The first 18 records *> of the file are read using list-directed input, the last 16 records -*> are read using the format ( A6, L2 ). An annotated example of a data +*> are read using the format ( A10, L2 ). An annotated example of a data *> file can be obtained by deleting the first 3 characters from the *> following 34 lines: *> 'dblat2.out' NAME OF SUMMARY OUTPUT FILE @@ -57,6 +57,8 @@ *> DSPR T PUT F FOR NO TEST. SAME COLUMNS. *> DSYR2 T PUT F FOR NO TEST. SAME COLUMNS. *> DSPR2 T PUT F FOR NO TEST. SAME COLUMNS. +*> DSKEWSYMV T PUT F FOR NO TEST. SAME COLUMNS. +*> DSKEWSYR T PUT F FOR NO TEST. SAME COLUMNS. *> *> Further Details *> =============== @@ -95,17 +97,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date April 2012 -* *> \ingroup double_blas_testing * * ===================================================================== PROGRAM DBLAT2 + IMPLICIT NONE * -* -- Reference BLAS test routine (version 3.7.0) -- +* -- Reference BLAS test routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* April 2012 * * ===================================================================== * @@ -113,7 +113,7 @@ PROGRAM DBLAT2 INTEGER NIN PARAMETER ( NIN = 5 ) INTEGER NSUBS - PARAMETER ( NSUBS = 16 ) + PARAMETER ( NSUBS = 18 ) DOUBLE PRECISION ZERO, ONE PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) INTEGER NMAX, INCMAX @@ -122,13 +122,14 @@ PROGRAM DBLAT2 PARAMETER ( NINMAX = 7, NIDMAX = 9, NKBMAX = 7, $ NALMAX = 7, NBEMAX = 7 ) * .. Local Scalars .. + DOUBLE PRECISION S1, S2 DOUBLE PRECISION EPS, ERR, THRESH INTEGER I, ISNUM, J, N, NALF, NBET, NIDIM, NINC, NKB, $ NOUT, NTRA LOGICAL FATAL, LTESTT, REWI, SAME, SFATAL, TRACE, $ TSTERR CHARACTER*1 TRANS - CHARACTER*6 SNAMET + CHARACTER*10 SNAMET CHARACTER*32 SNAPS, SUMMRY * .. Local Arrays .. DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), @@ -139,7 +140,7 @@ PROGRAM DBLAT2 $ YY( NMAX*INCMAX ), Z( 2*NMAX ) INTEGER IDIM( NIDMAX ), INC( NINMAX ), KB( NKBMAX ) LOGICAL LTEST( NSUBS ) - CHARACTER*6 SNAMES( NSUBS ) + CHARACTER*10 SNAMES( NSUBS ) * .. External Functions .. DOUBLE PRECISION DDIFF LOGICAL LDE @@ -152,16 +153,22 @@ PROGRAM DBLAT2 * .. Scalars in Common .. INTEGER INFOT, NOUTC LOGICAL LERR, OK - CHARACTER*6 SRNAMT + CHARACTER*10 SRNAMT * .. Common blocks .. COMMON /INFOC/INFOT, NOUTC, OK, LERR COMMON /SRNAMC/SRNAMT * .. Data statements .. - DATA SNAMES/'DGEMV ', 'DGBMV ', 'DSYMV ', 'DSBMV ', - $ 'DSPMV ', 'DTRMV ', 'DTBMV ', 'DTPMV ', - $ 'DTRSV ', 'DTBSV ', 'DTPSV ', 'DGER ', - $ 'DSYR ', 'DSPR ', 'DSYR2 ', 'DSPR2 '/ + DATA SNAMES/'DGEMV ', 'DGBMV ', + $ 'DSYMV ', 'DSBMV ', + $ 'DSPMV ', 'DTRMV ', + $ 'DTBMV ', 'DTPMV ', + $ 'DTRSV ', 'DTBSV ', + $ 'DTPSV ', 'DGER ', + $ 'DSYR ', 'DSPR ', + $ 'DSYR2 ', 'DSPR2 ', + $ 'DSKEWSYMV ', 'DSKEWSYR2 '/ * .. Executable Statements .. + CALL CPU_TIME( S1 ) * * Read name and unit number for summary output file and open file. * @@ -336,14 +343,14 @@ PROGRAM DBLAT2 FATAL = .FALSE. GO TO ( 140, 140, 150, 150, 150, 160, 160, $ 160, 160, 160, 160, 170, 180, 180, - $ 190, 190 )ISNUM + $ 190, 190, 150, 190 )ISNUM * Test DGEMV, 01, and DGBMV, 02. 140 CALL DCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, $ NBET, BET, NINC, INC, NMAX, INCMAX, A, AA, AS, $ X, XX, XS, Y, YY, YS, YT, G ) GO TO 200 -* Test DSYMV, 03, DSBMV, 04, and DSPMV, 05. +* Test DSYMV, 03, DSBMV, 04, DSPMV, 05, and DSKEWSYMV, 17. 150 CALL DCHK2( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, $ NBET, BET, NINC, INC, NMAX, INCMAX, A, AA, AS, @@ -367,7 +374,7 @@ PROGRAM DBLAT2 $ NMAX, INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, $ YT, G, Z ) GO TO 200 -* Test DSYR2, 15, and DSPR2, 16. +* Test DSYR2, 15, DSPR2, 16, and DSKEWSYR2, 18. 190 CALL DCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, $ NMAX, INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, @@ -390,6 +397,8 @@ PROGRAM DBLAT2 240 CONTINUE IF( TRACE ) $ CLOSE ( NTRA ) + CALL CPU_TIME( S2 ) + WRITE( NOUT, FMT = 9979 )S2 - S1 CLOSE ( NOUT ) STOP * @@ -411,26 +420,28 @@ PROGRAM DBLAT2 9988 FORMAT( ' FOR BETA ', 7F6.1 ) 9987 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM', $ /' ******* TESTS ABANDONED *******' ) - 9986 FORMAT( ' SUBPROGRAM NAME ', A6, ' NOT RECOGNIZED', /' ******* T', - $ 'ESTS ABANDONED *******' ) + 9986 FORMAT( ' SUBPROGRAM NAME ', A10, ' NOT RECOGNIZED', /' ******* ', + $ 'TESTS ABANDONED *******' ) 9985 FORMAT( ' ERROR IN DMVCH - IN-LINE DOT PRODUCTS ARE BEING EVALU', $ 'ATED WRONGLY.', /' DMVCH WAS CALLED WITH TRANS = ', A1, $ ' AND RETURNED SAME = ', L1, ' AND ERR = ', F12.3, '.', / $ ' THIS MAY BE DUE TO FAULTS IN THE ARITHMETIC OR THE COMPILER.' $ , /' ******* TESTS ABANDONED *******' ) - 9984 FORMAT( A6, L2 ) - 9983 FORMAT( 1X, A6, ' WAS NOT TESTED' ) + 9984 FORMAT( A10, L2 ) + 9983 FORMAT( 1X, A10, ' WAS NOT TESTED' ) 9982 FORMAT( /' END OF TESTS' ) 9981 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' ) 9980 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' ) + 9979 FORMAT( ' Total time used = ', F12.2, ' seconds', / ) * -* End of DBLAT2. +* End of DBLAT2 * END SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, NBET, $ BET, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX, $ XS, Y, YY, YS, YT, G ) + IMPLICIT NONE * * Tests DGEMV and DGBMV. * @@ -448,7 +459,7 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER INCMAX, NALF, NBET, NIDIM, NINC, NKB, NMAX, $ NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*10 SNAME * .. Array Arguments .. DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), BET( NBET ), G( NMAX ), @@ -459,6 +470,7 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ), INC( NINC ), KB( NKB ) * .. Local Scalars .. DOUBLE PRECISION ALPHA, ALS, BETA, BLS, ERR, ERRMAX, TRANSL + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, IC, IKU, IM, IN, INCX, INCXS, INCY, $ INCYS, IX, IY, KL, KLS, KU, KUS, LAA, LDA, $ LDAS, LX, LY, M, ML, MS, N, NARGS, NC, ND, NK, @@ -472,7 +484,7 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, LOGICAL LDE, LDERES EXTERNAL LDE, LDERES * .. External Subroutines .. - EXTERNAL DGBMV, DGEMV, DMAKE, DMVCH + EXTERNAL DGBMV, DGEMV, DMAKE, DMVCH, DREGR1 * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN * .. Scalars in Common .. @@ -495,6 +507,8 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * DO 120 IN = 1, NIDIM N = IDIM( IN ) @@ -636,6 +650,8 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9993 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 130 END IF * @@ -689,6 +705,8 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 130 END IF * @@ -701,6 +719,9 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ INCY, YT, G, YY, EPS, ERR, $ FATAL, NOUT, .TRUE. ) ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -727,6 +748,36 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * 120 CONTINUE * +* Regression test to verify preservation of y when m zero, n nonzero. +* + CALL DREGR1( TRANS, M, N, LY, KL, KU, ALPHA, AA, LDA, XX, INCX, + $ BETA, YY, INCY, YS ) + IF( FULL )THEN + IF( TRACE ) + $ WRITE( NTRA, FMT = 9994 )NC, SNAME, TRANS, M, N, ALPHA, LDA, + $ INCX, BETA, INCY + IF( REWI ) + $ REWIND NTRA + CALL DGEMV( TRANS, M, N, ALPHA, AA, LDA, XX, INCX, BETA, YY, + $ INCY ) + ELSE IF( BANDED )THEN + IF( TRACE ) + $ WRITE( NTRA, FMT = 9995 )NC, SNAME, TRANS, M, N, KL, KU, + $ ALPHA, LDA, INCX, BETA, INCY + IF( REWI ) + $ REWIND NTRA + CALL DGBMV( TRANS, M, N, KL, KU, ALPHA, AA, LDA, XX, INCX, + $ BETA, YY, INCY ) + END IF + NC = NC + 1 + IF( .NOT.LDE( YS, YY, LY ) )THEN + WRITE( NOUT, FMT = 9998 )NARGS - 1 + FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 + GO TO 130 + END IF +* * Report result. * IF( ERRMAX.LT.THRESH )THEN @@ -747,33 +798,37 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 140 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', - $ 'S)' ) + 9999 FORMAT( ' ', A10, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CAL', + $ 'LS)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', - $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, + 9997 FORMAT( ' ', A10, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' ', + $ 'CALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', 4( I3, ',' ), F4.1, + 9996 FORMAT( ' ******* ', A10, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A10, '(''', A1, ''',', 4( I3, ',' ), F4.1, $ ', A,', I3, ', X,', I2, ',', F4.1, ', Y,', I2, ') .' ) - 9994 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', 2( I3, ',' ), F4.1, + 9994 FORMAT( 1X, I6, ': ', A10, '(''', A1, ''',', 2( I3, ',' ), F4.1, $ ', A,', I3, ', X,', I2, ',', F4.1, ', Y,', I2, $ ') .' ) 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A10, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of DCHK1. +* End of DCHK1 * END SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, NBET, $ BET, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX, $ XS, Y, YY, YS, YT, G ) + IMPLICIT NONE * -* Tests DSYMV, DSBMV and DSPMV. +* Tests DSYMV, DSKEWSYMV, DSBMV and DSPMV. * * Auxiliary routine for test program for Level 2 Blas. * @@ -789,7 +844,7 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER INCMAX, NALF, NBET, NIDIM, NINC, NKB, NMAX, $ NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*10 SNAME * .. Array Arguments .. DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), BET( NBET ), G( NMAX ), @@ -800,10 +855,12 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ), INC( NINC ), KB( NKB ) * .. Local Scalars .. DOUBLE PRECISION ALPHA, ALS, BETA, BLS, ERR, ERRMAX, TRANSL + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, IC, IK, IN, INCX, INCXS, INCY, $ INCYS, IX, IY, K, KS, LAA, LDA, LDAS, LX, LY, $ N, NARGS, NC, NK, NS - LOGICAL BANDED, FULL, NULL, PACKED, RESET, SAME + LOGICAL BANDED, FULL, NULL, PACKED, RESET, SAME, + $ SKEWFULL CHARACTER*1 UPLO, UPLOS CHARACTER*2 ICH * .. Local Arrays .. @@ -812,7 +869,7 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, LOGICAL LDE, LDERES EXTERNAL LDE, LDERES * .. External Subroutines .. - EXTERNAL DMAKE, DMVCH, DSBMV, DSPMV, DSYMV + EXTERNAL DMAKE, DMVCH, DSBMV, DSPMV, DSYMV, DSKEWSYMV * .. Intrinsic Functions .. INTRINSIC ABS, MAX * .. Scalars in Common .. @@ -826,8 +883,9 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, FULL = SNAME( 3: 3 ).EQ.'Y' BANDED = SNAME( 3: 3 ).EQ.'B' PACKED = SNAME( 3: 3 ).EQ.'P' + SKEWFULL = SNAME( 2: 5 ).EQ.'SKEW' * Define the number of arguments. - IF( FULL )THEN + IF( FULL.OR.SKEWFULL )THEN NARGS = 10 ELSE IF( BANDED )THEN NARGS = 11 @@ -838,6 +896,8 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * DO 110 IN = 1, NIDIM N = IDIM( IN ) @@ -944,6 +1004,14 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ REWIND NTRA CALL DSYMV( UPLO, N, ALPHA, AA, LDA, XX, $ INCX, BETA, YY, INCY ) + ELSE IF( SKEWFULL )THEN + IF( TRACE ) + $ WRITE( NTRA, FMT = 9993 )NC, SNAME, + $ UPLO, N, ALPHA, LDA, INCX, BETA, INCY + IF( REWI ) + $ REWIND NTRA + CALL DSKEWSYMV( UPLO, N, ALPHA, AA, LDA, + $ XX, INCX, BETA, YY, INCY ) ELSE IF( BANDED )THEN IF( TRACE ) $ WRITE( NTRA, FMT = 9994 )NC, SNAME, @@ -968,6 +1036,8 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -975,7 +1045,7 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * ISAME( 1 ) = UPLO.EQ.UPLOS ISAME( 2 ) = NS.EQ.N - IF( FULL )THEN + IF( FULL.OR.SKEWFULL )THEN ISAME( 3 ) = ALS.EQ.ALPHA ISAME( 4 ) = LDE( AS, AA, LAA ) ISAME( 5 ) = LDAS.EQ.LDA @@ -1030,6 +1100,8 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1042,6 +1114,9 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ YY, EPS, ERR, FATAL, NOUT, $ .TRUE. ) ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -1088,32 +1163,37 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 130 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', - $ 'S)' ) + 9999 FORMAT( ' ', A10, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CAL', + $ 'LS)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', - $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, + 9997 FORMAT( ' ', A10, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' ', + $ 'CALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',', F4.1, ', AP', - $ ', X,', I2, ',', F4.1, ', Y,', I2, ') .' ) - 9994 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', 2( I3, ',' ), F4.1, + 9996 FORMAT( ' ******* ', A10, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A10, '(''', A1, ''',', I3, ',', F4.1, ', A', + $ 'P, X,', I2, ',', F4.1, ', Y,', I2, ') .' ) + 9994 FORMAT( 1X, I6, ': ', A10, '(''', A1, ''',', 2( I3, ',' ), F4.1, $ ', A,', I3, ', X,', I2, ',', F4.1, ', Y,', I2, $ ') .' ) - 9993 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',', F4.1, ', A,', - $ I3, ', X,', I2, ',', F4.1, ', Y,', I2, ') .' ) + 9993 FORMAT( 1X, I6, ': ', A10, '(''', A1, ''',', I3, ',', F4.1, + $ ', A,', I3, ', X,', I2, ',', F4.1, ', Y,', I2, + $ ') .' ) 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A10, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of DCHK2. +* End of DCHK2 * END SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NKB, KB, NINC, INC, NMAX, $ INCMAX, A, AA, AS, X, XX, XS, XT, G, Z ) + IMPLICIT NONE * * Tests DTRMV, DTBMV, DTPMV, DTRSV, DTBSV and DTPSV. * @@ -1130,7 +1210,7 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER INCMAX, NIDIM, NINC, NKB, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*10 SNAME * .. Array Arguments .. DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), $ AS( NMAX*NMAX ), G( NMAX ), X( NMAX ), @@ -1139,6 +1219,7 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ), INC( NINC ), KB( NKB ) * .. Local Scalars .. DOUBLE PRECISION ERR, ERRMAX, TRANSL + INTEGER NTESTS, NFAILS INTEGER I, ICD, ICT, ICU, IK, IN, INCX, INCXS, IX, K, $ KS, LAA, LDA, LDAS, LX, N, NARGS, NC, NK, NS LOGICAL BANDED, FULL, NULL, PACKED, RESET, SAME @@ -1178,6 +1259,8 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * Set up zero vector for DMVCH. DO 10 I = 1, NMAX Z( I ) = ZERO @@ -1324,6 +1407,8 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1376,6 +1461,8 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1404,6 +1491,9 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ .FALSE. ) END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and return. IF( FATAL ) $ GO TO 120 @@ -1446,32 +1536,36 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 130 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', - $ 'S)' ) + 9999 FORMAT( ' ', A10, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CAL', + $ 'LS)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', - $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, + 9997 FORMAT( ' ', A10, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' ', + $ 'CALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A6, '(', 3( '''', A1, ''',' ), I3, ', AP, ', - $ 'X,', I2, ') .' ) - 9994 FORMAT( 1X, I6, ': ', A6, '(', 3( '''', A1, ''',' ), 2( I3, ',' ), - $ ' A,', I3, ', X,', I2, ') .' ) - 9993 FORMAT( 1X, I6, ': ', A6, '(', 3( '''', A1, ''',' ), I3, ', A,', + 9996 FORMAT( ' ******* ', A10, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A10, '(', 3( '''', A1, ''',' ), I3, ', AP,', + $ ' X,', I2, ') .' ) + 9994 FORMAT( 1X, I6, ': ', A10, '(', 3( '''', A1, ''',' ), + $ 2( I3, ',' ), ' A,', I3, ', X,', I2, ') .' ) + 9993 FORMAT( 1X, I6, ': ', A10, '(', 3( '''', A1, ''',' ), I3, ', A,', $ I3, ', X,', I2, ') .' ) 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A10, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of DCHK3. +* End of DCHK3 * END SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX, $ INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G, $ Z ) + IMPLICIT NONE * * Tests DGER. * @@ -1488,7 +1582,7 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER INCMAX, NALF, NIDIM, NINC, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*10 SNAME * .. Array Arguments .. DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), G( NMAX ), X( NMAX ), @@ -1498,6 +1592,7 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ), INC( NINC ) * .. Local Scalars .. DOUBLE PRECISION ALPHA, ALS, ERR, ERRMAX, TRANSL + INTEGER NTESTS, NFAILS INTEGER I, IA, IM, IN, INCX, INCXS, INCY, INCYS, IX, $ IY, J, LAA, LDA, LDAS, LX, LY, M, MS, N, NARGS, $ NC, ND, NS @@ -1524,6 +1619,8 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * DO 120 IN = 1, NIDIM N = IDIM( IN ) @@ -1617,6 +1714,8 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9993 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 140 END IF * @@ -1647,6 +1746,8 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 140 END IF * @@ -1674,6 +1775,9 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ AA( 1 + ( J - 1 )*LDA ), EPS, $ ERR, FATAL, NOUT, .TRUE. ) ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and return. IF( FATAL ) $ GO TO 130 @@ -1710,29 +1814,33 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, WRITE( NOUT, FMT = 9994 )NC, SNAME, M, N, ALPHA, INCX, INCY, LDA * 150 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', - $ 'S)' ) + 9999 FORMAT( ' ', A10, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CAL', + $ 'LS)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', - $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, + 9997 FORMAT( ' ', A10, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' ', + $ 'CALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ', A10, ' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT( 1X, I6, ': ', A6, '(', 2( I3, ',' ), F4.1, ', X,', I2, + 9994 FORMAT( 1X, I6, ': ', A10, '(', 2( I3, ',' ), F4.1, ', X,', I2, $ ', Y,', I2, ', A,', I3, ') .' ) 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A10, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of DCHK4. +* End of DCHK4 * END SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX, $ INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G, $ Z ) + IMPLICIT NONE * * Tests DSYR and DSPR. * @@ -1749,7 +1857,7 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER INCMAX, NALF, NIDIM, NINC, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*10 SNAME * .. Array Arguments .. DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), G( NMAX ), X( NMAX ), @@ -1759,6 +1867,7 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ), INC( NINC ) * .. Local Scalars .. DOUBLE PRECISION ALPHA, ALS, ERR, ERRMAX, TRANSL + INTEGER NTESTS, NFAILS INTEGER I, IA, IC, IN, INCX, INCXS, IX, J, JA, JJ, LAA, $ LDA, LDAS, LJ, LX, N, NARGS, NC, NS LOGICAL FULL, NULL, PACKED, RESET, SAME, UPPER @@ -1794,6 +1903,8 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * DO 100 IN = 1, NIDIM N = IDIM( IN ) @@ -1877,6 +1988,8 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1907,6 +2020,8 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 30 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1947,6 +2062,9 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, JA = JA + LJ END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and return. IF( FATAL ) $ GO TO 110 @@ -1986,33 +2104,37 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 130 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', - $ 'S)' ) + 9999 FORMAT( ' ', A10, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CAL', + $ 'LS)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', - $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, + 9997 FORMAT( ' ', A10, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' ', + $ 'CALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ', A10, ' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',', F4.1, ', X,', - $ I2, ', AP) .' ) - 9993 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',', F4.1, ', X,', - $ I2, ', A,', I3, ') .' ) + 9994 FORMAT( 1X, I6, ': ', A10, '(''', A1, ''',', I3, ',', F4.1, + $ ', X,', I2, ', AP) .' ) + 9993 FORMAT( 1X, I6, ': ', A10, '(''', A1, ''',', I3, ',', F4.1, + $ ', X,', I2, ', A,', I3, ') .' ) 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A10, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of DCHK5. +* End of DCHK5 * END SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX, $ INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G, $ Z ) + IMPLICIT NONE * -* Tests DSYR2 and DSPR2. +* Tests DSYR2, DSKEWSYR2 and DSPR2. * * Auxiliary routine for test program for Level 2 Blas. * @@ -2027,7 +2149,7 @@ SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER INCMAX, NALF, NIDIM, NINC, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*10 SNAME * .. Array Arguments .. DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), G( NMAX ), X( NMAX ), @@ -2037,10 +2159,12 @@ SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ), INC( NINC ) * .. Local Scalars .. DOUBLE PRECISION ALPHA, ALS, ERR, ERRMAX, TRANSL + INTEGER NTESTS, NFAILS INTEGER I, IA, IC, IN, INCX, INCXS, INCY, INCYS, IX, $ IY, J, JA, JJ, LAA, LDA, LDAS, LJ, LX, LY, N, $ NARGS, NC, NS - LOGICAL FULL, NULL, PACKED, RESET, SAME, UPPER + LOGICAL FULL, NULL, PACKED, RESET, SAME, UPPER, + $ SKEWFULL CHARACTER*1 UPLO, UPLOS CHARACTER*2 ICH * .. Local Arrays .. @@ -2050,7 +2174,7 @@ SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, LOGICAL LDE, LDERES EXTERNAL LDE, LDERES * .. External Subroutines .. - EXTERNAL DMAKE, DMVCH, DSPR2, DSYR2 + EXTERNAL DMAKE, DMVCH, DSPR2, DSYR2, DSKEWSYR2 * .. Intrinsic Functions .. INTRINSIC ABS, MAX * .. Scalars in Common .. @@ -2063,8 +2187,9 @@ SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Executable Statements .. FULL = SNAME( 3: 3 ).EQ.'Y' PACKED = SNAME( 3: 3 ).EQ.'P' + SKEWFULL = SNAME( 2: 5 ).EQ.'SKEW' * Define the number of arguments. - IF( FULL )THEN + IF( FULL.OR.SKEWFULL )THEN NARGS = 9 ELSE IF( PACKED )THEN NARGS = 8 @@ -2073,6 +2198,8 @@ SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * DO 140 IN = 1, NIDIM N = IDIM( IN ) @@ -2162,6 +2289,14 @@ SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ REWIND NTRA CALL DSYR2( UPLO, N, ALPHA, XX, INCX, YY, INCY, $ AA, LDA ) + ELSE IF( SKEWFULL )THEN + IF( TRACE ) + $ WRITE( NTRA, FMT = 9993 )NC, SNAME, UPLO, N, + $ ALPHA, INCX, INCY, LDA + IF( REWI ) + $ REWIND NTRA + CALL DSKEWSYR2( UPLO, N, ALPHA, XX, INCX, YY, + $ INCY, AA, LDA ) ELSE IF( PACKED )THEN IF( TRACE ) $ WRITE( NTRA, FMT = 9994 )NC, SNAME, UPLO, N, @@ -2177,6 +2312,8 @@ SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 160 END IF * @@ -2209,6 +2346,8 @@ SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 160 END IF * @@ -2234,22 +2373,36 @@ SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, Z( I, 2 ) = Y( N - I + 1 ) 80 CONTINUE END IF - JA = 1 + IF( .NOT.SKEWFULL.OR.UPPER )THEN + JA = 1 + ELSE + JA = 2 + END IF DO 90 J = 1, N - W( 1 ) = Z( J, 2 ) + IF( .NOT.SKEWFULL )THEN + W( 1 ) = Z( J, 2 ) + ELSE + W( 1 ) = -Z( J, 2 ) + END IF W( 2 ) = Z( J, 1 ) - IF( UPPER )THEN + IF( .NOT.SKEWFULL.AND.UPPER )THEN JJ = 1 LJ = J - ELSE + ELSE IF( .NOT.SKEWFULL.AND..NOT.UPPER )THEN JJ = J LJ = N - J + 1 + ELSE IF( SKEWFULL.AND.UPPER )THEN + JJ = 1 + LJ = J - 1 + ELSE + JJ = J + 1 + LJ = N - J END IF CALL DMVCH( 'N', LJ, 2, ALPHA, Z( JJ, 1 ), $ NMAX, W, 1, ONE, A( JJ, J ), 1, $ YT, G, AA( JA ), EPS, ERR, FATAL, $ NOUT, .TRUE. ) - IF( FULL )THEN + IF( FULL.OR.SKEWFULL )THEN IF( UPPER )THEN JA = JA + LDA ELSE @@ -2259,6 +2412,9 @@ SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, JA = JA + LJ END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and return. IF( FATAL ) $ GO TO 150 @@ -2293,7 +2449,7 @@ SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * 160 CONTINUE WRITE( NOUT, FMT = 9996 )SNAME - IF( FULL )THEN + IF( FULL.OR.SKEWFULL )THEN WRITE( NOUT, FMT = 9993 )NC, SNAME, UPLO, N, ALPHA, INCX, $ INCY, LDA ELSE IF( PACKED )THEN @@ -2301,28 +2457,33 @@ SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 170 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', - $ 'S)' ) + 9999 FORMAT( ' ', A10, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CAL', + $ 'LS)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', - $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, + 9997 FORMAT( ' ', A10, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' ', + $ 'CALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ', A10, ' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',', F4.1, ', X,', - $ I2, ', Y,', I2, ', AP) .' ) - 9993 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',', F4.1, ', X,', - $ I2, ', Y,', I2, ', A,', I3, ') .' ) + 9994 FORMAT( 1X, I6, ': ', A10, '(''', A1, ''',', I3, ',', F4.1, + $ ', X,', I2, ', Y,', I2, ', AP) .' ) + 9993 FORMAT( 1X, I6, ': ', A10, '(''', A1, ''',', I3, ',', F4.1, + $ ', X,', I2, ', Y,', I2, ', A,', I3, + $ ') .' ) 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A10, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of DCHK6. +* End of DCHK6 * END SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) + IMPLICIT NONE * * Tests the error exits from the Level 2 Blas. * Requires a special version of the error-handling routine XERBLA. @@ -2336,8 +2497,9 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) * * .. Scalar Arguments .. INTEGER ISNUM, NOUT - CHARACTER*6 SRNAMT + CHARACTER*10 SRNAMT * .. Scalars in Common .. + INTEGER NXRUN, NXFAIL, NXBAD INTEGER INFOT, NOUTC LOGICAL LERR, OK * .. Local Scalars .. @@ -2350,6 +2512,7 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) $ DTPSV, DTRMV, DTRSV * .. Common blocks .. COMMON /INFOC/INFOT, NOUTC, OK, LERR + COMMON /XERCNT/NXRUN, NXFAIL, NXBAD * .. Executable Statements .. * OK is set to .FALSE. by the special version of XERBLA or by CHKXER * if anything is wrong. @@ -2357,9 +2520,14 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) * LERR is set to .TRUE. by the special version of XERBLA each time * it is called, and is then tested and re-set by CHKXER. LERR = .FALSE. +* NXRUN and NXFAIL count the error-exit tests of this routine; +* NXBAD is set by XERBLA when it is called wrongly. + NXRUN = 0 + NXFAIL = 0 + NXBAD = 0 GO TO ( 10, 20, 30, 40, 50, 60, 70, 80, $ 90, 100, 110, 120, 130, 140, 150, - $ 160 )ISNUM + $ 160, 170, 180 )ISNUM 10 INFOT = 1 CALL DGEMV( '/', 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2378,7 +2546,7 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 11 CALL DGEMV( 'N', 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 170 + GO TO 190 20 INFOT = 1 CALL DGBMV( '/', 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2403,7 +2571,7 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 13 CALL DGBMV( 'N', 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 170 + GO TO 190 30 INFOT = 1 CALL DSYMV( '/', 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2419,7 +2587,7 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 10 CALL DSYMV( 'U', 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 170 + GO TO 190 40 INFOT = 1 CALL DSBMV( '/', 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2438,7 +2606,7 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 11 CALL DSBMV( 'U', 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 170 + GO TO 190 50 INFOT = 1 CALL DSPMV( '/', 0, ALPHA, A, X, 1, BETA, Y, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2451,7 +2619,7 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 9 CALL DSPMV( 'U', 0, ALPHA, A, X, 1, BETA, Y, 0 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 170 + GO TO 190 60 INFOT = 1 CALL DTRMV( '/', 'N', 'N', 0, A, 1, X, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2470,7 +2638,7 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 8 CALL DTRMV( 'U', 'N', 'N', 0, A, 1, X, 0 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 170 + GO TO 190 70 INFOT = 1 CALL DTBMV( '/', 'N', 'N', 0, 0, A, 1, X, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2492,7 +2660,7 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 9 CALL DTBMV( 'U', 'N', 'N', 0, 0, A, 1, X, 0 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 170 + GO TO 190 80 INFOT = 1 CALL DTPMV( '/', 'N', 'N', 0, A, X, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2508,7 +2676,7 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 7 CALL DTPMV( 'U', 'N', 'N', 0, A, X, 0 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 170 + GO TO 190 90 INFOT = 1 CALL DTRSV( '/', 'N', 'N', 0, A, 1, X, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2527,7 +2695,7 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 8 CALL DTRSV( 'U', 'N', 'N', 0, A, 1, X, 0 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 170 + GO TO 190 100 INFOT = 1 CALL DTBSV( '/', 'N', 'N', 0, 0, A, 1, X, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2549,7 +2717,7 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 9 CALL DTBSV( 'U', 'N', 'N', 0, 0, A, 1, X, 0 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 170 + GO TO 190 110 INFOT = 1 CALL DTPSV( '/', 'N', 'N', 0, A, X, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2565,7 +2733,7 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 7 CALL DTPSV( 'U', 'N', 'N', 0, A, X, 0 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 170 + GO TO 190 120 INFOT = 1 CALL DGER( -1, 0, ALPHA, X, 1, Y, 1, A, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2581,7 +2749,7 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 9 CALL DGER( 2, 0, ALPHA, X, 1, Y, 1, A, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 170 + GO TO 190 130 INFOT = 1 CALL DSYR( '/', 0, ALPHA, X, 1, A, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2594,7 +2762,7 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 7 CALL DSYR( 'U', 2, ALPHA, X, 1, A, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 170 + GO TO 190 140 INFOT = 1 CALL DSPR( '/', 0, ALPHA, X, 1, A ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2604,7 +2772,7 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 5 CALL DSPR( 'U', 0, ALPHA, X, 0, A ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 170 + GO TO 190 150 INFOT = 1 CALL DSYR2( '/', 0, ALPHA, X, 1, Y, 1, A, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2620,7 +2788,7 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 9 CALL DSYR2( 'U', 2, ALPHA, X, 1, Y, 1, A, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 170 + GO TO 190 160 INFOT = 1 CALL DSPR2( '/', 0, ALPHA, X, 1, Y, 1, A ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2633,30 +2801,66 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 7 CALL DSPR2( 'U', 0, ALPHA, X, 1, Y, 0, A ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + GO TO 190 + 170 INFOT = 1 + CALL DSKEWSYMV( '/', 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL DSKEWSYMV( 'U', -1, ALPHA, A, 1, X, 1, BETA, Y, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL DSKEWSYMV( 'U', 2, ALPHA, A, 1, X, 1, BETA, Y, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 7 + CALL DSKEWSYMV( 'U', 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 10 + CALL DSKEWSYMV( 'U', 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + GO TO 190 + 180 INFOT = 1 + CALL DSKEWSYR2( '/', 0, ALPHA, X, 1, Y, 1, A, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL DSKEWSYR2( 'U', -1, ALPHA, X, 1, Y, 1, A, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL DSKEWSYR2( 'U', 0, ALPHA, X, 0, Y, 1, A, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 7 + CALL DSKEWSYR2( 'U', 0, ALPHA, X, 1, Y, 0, A, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 9 + CALL DSKEWSYR2( 'U', 2, ALPHA, X, 1, Y, 1, A, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) * - 170 IF( OK )THEN + 190 IF( OK )THEN WRITE( NOUT, FMT = 9999 )SRNAMT ELSE WRITE( NOUT, FMT = 9998 )SRNAMT END IF + WRITE( NOUT, FMT = 9979 )SRNAMT, NXRUN, NXFAIL RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE TESTS OF ERROR-EXITS' ) - 9998 FORMAT( ' ******* ', A6, ' FAILED THE TESTS OF ERROR-EXITS *****', - $ '**' ) + 9999 FORMAT( ' ', A10, ' PASSED THE TESTS OF ERROR-EXITS' ) + 9998 FORMAT( ' ******* ', A10, ' FAILED THE TESTS OF ERROR-EXITS ****', + $ '***' ) + 9979 FORMAT( ' ', A10, ' ERROR-EXIT TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of DCHKE. +* End of DCHKE * END SUBROUTINE DMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, $ KU, RESET, TRANSL ) + IMPLICIT NONE * * Generates values for an M by N matrix A within the bandwidth * defined by KL and KU. * Stores the values in the array AA in the data structure required * by the routine, with unwanted elements set to rogue value. * -* TYPE is 'GE', 'GB', 'SY', 'SB', 'SP', 'TR', 'TB' OR 'TP'. +* TYPE is 'GE', 'GB', 'SY', 'SB', 'SP', 'SK', 'TR', 'TB' OR 'TP'. * * Auxiliary routine for test program for Level 2 Blas. * @@ -2679,7 +2883,8 @@ SUBROUTINE DMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, DOUBLE PRECISION A( NMAX, * ), AA( * ) * .. Local Scalars .. INTEGER I, I1, I2, I3, IBEG, IEND, IOFF, J, KK - LOGICAL GEN, LOWER, SYM, TRI, UNIT, UPPER + LOGICAL GEN, LOWER, SYM, TRI, UNIT, UPPER, + $ SKEW * .. External Functions .. DOUBLE PRECISION DBEG EXTERNAL DBEG @@ -2687,10 +2892,11 @@ SUBROUTINE DMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, INTRINSIC MAX, MIN * .. Executable Statements .. GEN = TYPE( 1: 1 ).EQ.'G' - SYM = TYPE( 1: 1 ).EQ.'S' + SYM = TYPE( 1: 1 ).EQ.'S'.AND.TYPE( 2: 2 ).NE.'K' + SKEW = TYPE( 1: 1 ).EQ.'S'.AND.TYPE( 2: 2 ).EQ.'K' TRI = TYPE( 1: 1 ).EQ.'T' - UPPER = ( SYM.OR.TRI ).AND.UPLO.EQ.'U' - LOWER = ( SYM.OR.TRI ).AND.UPLO.EQ.'L' + UPPER = ( SYM.OR.SKEW.OR.TRI ).AND.UPLO.EQ.'U' + LOWER = ( SYM.OR.SKEW.OR.TRI ).AND.UPLO.EQ.'L' UNIT = TRI.AND.DIAG.EQ.'U' * * Generate data in array A. @@ -2708,6 +2914,8 @@ SUBROUTINE DMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, IF( I.NE.J )THEN IF( SYM )THEN A( J, I ) = A( I, J ) + ELSE IF( SKEW )THEN + A( J, I ) = -A( I, J ) ELSE IF( TRI )THEN A( J, I ) = ZERO END IF @@ -2718,6 +2926,8 @@ SUBROUTINE DMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, $ A( J, J ) = A( J, J ) + ONE IF( UNIT ) $ A( J, J ) = ONE + IF( SKEW ) + $ A( J, J ) = ZERO 20 CONTINUE * * Store elements in array AS in data structure required by routine. @@ -2743,17 +2953,17 @@ SUBROUTINE DMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, AA( I3 + ( J - 1 )*LDA ) = ROGUE 80 CONTINUE 90 CONTINUE - ELSE IF( TYPE.EQ.'SY'.OR.TYPE.EQ.'TR' )THEN + ELSE IF( TYPE.EQ.'SY'.OR.TYPE.EQ.'SK'.OR.TYPE.EQ.'TR' )THEN DO 130 J = 1, N IF( UPPER )THEN IBEG = 1 - IF( UNIT )THEN + IF( UNIT.OR.SKEW )THEN IEND = J - 1 ELSE IEND = J END IF ELSE - IF( UNIT )THEN + IF( UNIT.OR.SKEW )THEN IBEG = J + 1 ELSE IBEG = J @@ -2821,11 +3031,12 @@ SUBROUTINE DMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, END IF RETURN * -* End of DMAKE. +* End of DMAKE * END SUBROUTINE DMVCH( TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y, $ INCY, YT, G, YY, EPS, ERR, FATAL, NOUT, MV ) + IMPLICIT NONE * * Checks the results of the computational tests. * @@ -2938,10 +3149,11 @@ SUBROUTINE DMVCH( TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y, $ 'TED RESULT' ) 9998 FORMAT( 1X, I7, 2G18.6 ) * -* End of DMVCH. +* End of DMVCH * END LOGICAL FUNCTION LDE( RI, RJ, LR ) + IMPLICIT NONE * * Tests if two arrays are identical. * @@ -2968,14 +3180,15 @@ LOGICAL FUNCTION LDE( RI, RJ, LR ) LDE = .FALSE. 30 RETURN * -* End of LDE. +* End of LDE * END LOGICAL FUNCTION LDERES( TYPE, UPLO, M, N, AA, AS, LDA ) + IMPLICIT NONE * * Tests if selected elements in two arrays are equal. * -* TYPE is 'GE', 'SY' or 'SP'. +* TYPE is 'GE', 'SY', 'SK' or 'SP'. * * Auxiliary routine for test program for Level 2 Blas. * @@ -3001,14 +3214,20 @@ LOGICAL FUNCTION LDERES( TYPE, UPLO, M, N, AA, AS, LDA ) $ GO TO 70 10 CONTINUE 20 CONTINUE - ELSE IF( TYPE.EQ.'SY' )THEN + ELSE IF( TYPE.EQ.'SY'.OR.TYPE.EQ.'SK' )THEN DO 50 J = 1, N - IF( UPPER )THEN + IF( UPPER.AND.TYPE.EQ.'SY' )THEN IBEG = 1 IEND = J - ELSE + ELSE IF( .NOT.UPPER.AND.TYPE.EQ.'SY' )THEN IBEG = J IEND = N + ELSE IF( UPPER.AND.TYPE.EQ.'SK' )THEN + IBEG = 1 + IEND = J - 1 + ELSE + IBEG = J + 1 + IEND = N END IF DO 30 I = 1, IBEG - 1 IF( AA( I, J ).NE.AS( I, J ) ) @@ -3027,10 +3246,11 @@ LOGICAL FUNCTION LDERES( TYPE, UPLO, M, N, AA, AS, LDA ) LDERES = .FALSE. 80 RETURN * -* End of LDERES. +* End of LDERES * END DOUBLE PRECISION FUNCTION DBEG( RESET ) + IMPLICIT NONE * * Generates random numbers uniformly distributed between -0.5 and 0.5. * @@ -3073,10 +3293,11 @@ DOUBLE PRECISION FUNCTION DBEG( RESET ) DBEG = DBLE( I - 500 )/1001.0D0 RETURN * -* End of DBEG. +* End of DBEG * END DOUBLE PRECISION FUNCTION DDIFF( X, Y ) + IMPLICIT NONE * * Auxiliary routine for test program for Level 2 Blas. * @@ -3089,10 +3310,11 @@ DOUBLE PRECISION FUNCTION DDIFF( X, Y ) DDIFF = X - Y RETURN * -* End of DDIFF. +* End of DDIFF * END SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + IMPLICIT NONE * * Tests whether XERBLA has detected an error when it should. * @@ -3105,22 +3327,66 @@ SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) * .. Scalar Arguments .. INTEGER INFOT, NOUT LOGICAL LERR, OK - CHARACTER*6 SRNAMT + CHARACTER*10 SRNAMT +* .. Scalars in Common .. + INTEGER NXRUN, NXFAIL, NXBAD +* .. Common blocks .. + COMMON /XERCNT/NXRUN, NXFAIL, NXBAD * .. Executable Statements .. + NXRUN = NXRUN + 1 IF( .NOT.LERR )THEN WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT OK = .FALSE. + NXFAIL = NXFAIL + 1 + ELSE IF( NXBAD.NE.0 )THEN + NXFAIL = NXFAIL + 1 END IF + NXBAD = 0 LERR = .FALSE. RETURN * 9999 FORMAT( ' ***** ILLEGAL VALUE OF PARAMETER NUMBER ', I2, ' NOT D', - $ 'ETECTED BY ', A6, ' *****' ) + $ 'ETECTED BY ', A10, ' *****' ) +* +* End of CHKXER +* + END + SUBROUTINE DREGR1( TRANS, M, N, LY, KL, KU, ALPHA, A, LDA, X, + $ INCX, BETA, Y, INCY, YS ) + IMPLICIT NONE * -* End of CHKXER. +* Input initialization for regression test. * +* .. Scalar Arguments .. + CHARACTER*1 TRANS + INTEGER LY, M, N, KL, KU, LDA, INCX, INCY + DOUBLE PRECISION ALPHA, BETA +* .. Array Arguments .. + DOUBLE PRECISION A(LDA,*), X(*), Y(*), YS(*) +* .. Local Scalars .. + INTEGER I +* .. Intrinsic Functions .. + INTRINSIC DBLE +* .. Executable Statements .. + TRANS = 'T' + M = 0 + N = 5 + KL = 0 + KU = 0 + ALPHA = 1.0D0 + LDA = MAX( 1, M ) + INCX = 1 + BETA = -0.7D0 + INCY = 1 + LY = ABS( INCY )*N + DO 10 I = 1, LY + Y( I ) = 42.0D0 + DBLE( I ) + YS( I ) = Y( I ) + 10 CONTINUE + RETURN END SUBROUTINE XERBLA( SRNAME, INFO ) + IMPLICIT NONE * * This is a special version of XERBLA to be used only as part of * the test program for testing error exits from the Level 2 BLAS @@ -3139,14 +3405,18 @@ SUBROUTINE XERBLA( SRNAME, INFO ) * * .. Scalar Arguments .. INTEGER INFO - CHARACTER*6 SRNAME + CHARACTER*(*) SRNAME * .. Scalars in Common .. + INTEGER NXRUN, NXFAIL, NXBAD INTEGER INFOT, NOUT LOGICAL LERR, OK - CHARACTER*6 SRNAMT + CHARACTER*10 SRNAMT * .. Common blocks .. COMMON /INFOC/INFOT, NOUT, OK, LERR + COMMON /XERCNT/NXRUN, NXFAIL, NXBAD COMMON /SRNAMC/SRNAMT +* .. Locals .. + INTEGER SRLEN * .. Executable Statements .. LERR = .TRUE. IF( INFO.NE.INFOT )THEN @@ -3156,21 +3426,23 @@ SUBROUTINE XERBLA( SRNAME, INFO ) WRITE( NOUT, FMT = 9997 )INFO END IF OK = .FALSE. + NXBAD = 1 END IF - IF( SRNAME.NE.SRNAMT )THEN + SRLEN = MIN(LEN_TRIM(SRNAME), LEN_TRIM(SRNAMT)) + IF( SRNAME(1:SRLEN).NE.SRNAMT(1:SRLEN) )THEN WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT OK = .FALSE. + NXBAD = 1 END IF RETURN * 9999 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6, ' INSTEAD', $ ' OF ', I2, ' *******' ) - 9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A6, ' INSTE', - $ 'AD OF ', A6, ' *******' ) + 9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A, ' INST', + $ 'EAD OF ', A10, ' *******' ) 9997 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6, $ ' *******' ) * * End of XERBLA * END - diff --git a/BLAS/TESTING/dblat2.in b/BLAS/TESTING/dblat2.in index d436350a4f..6293cf6795 100644 --- a/BLAS/TESTING/dblat2.in +++ b/BLAS/TESTING/dblat2.in @@ -16,19 +16,21 @@ T LOGICAL FLAG, T TO TEST ERROR EXITS. 0.0 1.0 0.7 VALUES OF ALPHA 3 NUMBER OF VALUES OF BETA 0.0 1.0 0.9 VALUES OF BETA -DGEMV T PUT F FOR NO TEST. SAME COLUMNS. -DGBMV T PUT F FOR NO TEST. SAME COLUMNS. -DSYMV T PUT F FOR NO TEST. SAME COLUMNS. -DSBMV T PUT F FOR NO TEST. SAME COLUMNS. -DSPMV T PUT F FOR NO TEST. SAME COLUMNS. -DTRMV T PUT F FOR NO TEST. SAME COLUMNS. -DTBMV T PUT F FOR NO TEST. SAME COLUMNS. -DTPMV T PUT F FOR NO TEST. SAME COLUMNS. -DTRSV T PUT F FOR NO TEST. SAME COLUMNS. -DTBSV T PUT F FOR NO TEST. SAME COLUMNS. -DTPSV T PUT F FOR NO TEST. SAME COLUMNS. -DGER T PUT F FOR NO TEST. SAME COLUMNS. -DSYR T PUT F FOR NO TEST. SAME COLUMNS. -DSPR T PUT F FOR NO TEST. SAME COLUMNS. -DSYR2 T PUT F FOR NO TEST. SAME COLUMNS. -DSPR2 T PUT F FOR NO TEST. SAME COLUMNS. +DGEMV T PUT F FOR NO TEST. SAME COLUMNS. +DGBMV T PUT F FOR NO TEST. SAME COLUMNS. +DSYMV T PUT F FOR NO TEST. SAME COLUMNS. +DSBMV T PUT F FOR NO TEST. SAME COLUMNS. +DSPMV T PUT F FOR NO TEST. SAME COLUMNS. +DTRMV T PUT F FOR NO TEST. SAME COLUMNS. +DTBMV T PUT F FOR NO TEST. SAME COLUMNS. +DTPMV T PUT F FOR NO TEST. SAME COLUMNS. +DTRSV T PUT F FOR NO TEST. SAME COLUMNS. +DTBSV T PUT F FOR NO TEST. SAME COLUMNS. +DTPSV T PUT F FOR NO TEST. SAME COLUMNS. +DGER T PUT F FOR NO TEST. SAME COLUMNS. +DSYR T PUT F FOR NO TEST. SAME COLUMNS. +DSPR T PUT F FOR NO TEST. SAME COLUMNS. +DSYR2 T PUT F FOR NO TEST. SAME COLUMNS. +DSPR2 T PUT F FOR NO TEST. SAME COLUMNS. +DSKEWSYMV T PUT F FOR NO TEST. SAME COLUMNS. +DSKEWSYR2 T PUT F FOR NO TEST. SAME COLUMNS. diff --git a/BLAS/TESTING/dblat3.f b/BLAS/TESTING/dblat3.f index 1ebec4ffa6..757fb0ece7 100644 --- a/BLAS/TESTING/dblat3.f +++ b/BLAS/TESTING/dblat3.f @@ -19,10 +19,10 @@ *> Test program for the DOUBLE PRECISION Level 3 Blas. *> *> The program must be driven by a short data file. The first 14 records -*> of the file are read using list-directed input, the last 6 records -*> are read using the format ( A6, L2 ). An annotated example of a data +*> of the file are read using list-directed input, the last 9 records +*> are read using the format ( A11, L2 ). An annotated example of a data *> file can be obtained by deleting the first 3 characters from the -*> following 20 lines: +*> following 21 lines: *> 'dblat3.out' NAME OF SUMMARY OUTPUT FILE *> 6 UNIT NUMBER OF SUMMARY FILE *> 'DBLAT3.SNAP' NAME OF SNAPSHOT OUTPUT FILE @@ -37,12 +37,15 @@ *> 0.0 1.0 0.7 VALUES OF ALPHA *> 3 NUMBER OF VALUES OF BETA *> 0.0 1.0 1.3 VALUES OF BETA -*> DGEMM T PUT F FOR NO TEST. SAME COLUMNS. -*> DSYMM T PUT F FOR NO TEST. SAME COLUMNS. -*> DTRMM T PUT F FOR NO TEST. SAME COLUMNS. -*> DTRSM T PUT F FOR NO TEST. SAME COLUMNS. -*> DSYRK T PUT F FOR NO TEST. SAME COLUMNS. -*> DSYR2K T PUT F FOR NO TEST. SAME COLUMNS. +*> DGEMM T PUT F FOR NO TEST. SAME COLUMNS. +*> DSYMM T PUT F FOR NO TEST. SAME COLUMNS. +*> DTRMM T PUT F FOR NO TEST. SAME COLUMNS. +*> DTRSM T PUT F FOR NO TEST. SAME COLUMNS. +*> DSYRK T PUT F FOR NO TEST. SAME COLUMNS. +*> DSYR2K T PUT F FOR NO TEST. SAME COLUMNS. +*> DGEMMTR T PUT F FOR NO TEST. SAME COLUMNS. +*> DSKEWSYMM T PUT F FOR NO TEST. SAME COLUMNS. +*> DSKEWSYR2K T PUT F FOR NO TEST. SAME COLUMNS. *> *> Further Details *> =============== @@ -75,17 +78,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date April 2012 -* *> \ingroup double_blas_testing * * ===================================================================== PROGRAM DBLAT3 + IMPLICIT NONE * -* -- Reference BLAS test routine (version 3.7.0) -- +* -- Reference BLAS test routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* April 2012 * * ===================================================================== * @@ -93,7 +94,7 @@ PROGRAM DBLAT3 INTEGER NIN PARAMETER ( NIN = 5 ) INTEGER NSUBS - PARAMETER ( NSUBS = 6 ) + PARAMETER ( NSUBS = 9 ) DOUBLE PRECISION ZERO, ONE PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) INTEGER NMAX @@ -101,12 +102,13 @@ PROGRAM DBLAT3 INTEGER NIDMAX, NALMAX, NBEMAX PARAMETER ( NIDMAX = 9, NALMAX = 7, NBEMAX = 7 ) * .. Local Scalars .. + DOUBLE PRECISION S1, S2 DOUBLE PRECISION EPS, ERR, THRESH INTEGER I, ISNUM, J, N, NALF, NBET, NIDIM, NOUT, NTRA LOGICAL FATAL, LTESTT, REWI, SAME, SFATAL, TRACE, $ TSTERR CHARACTER*1 TRANSA, TRANSB - CHARACTER*6 SNAMET + CHARACTER*11 SNAMET CHARACTER*32 SNAPS, SUMMRY * .. Local Arrays .. DOUBLE PRECISION AA( NMAX*NMAX ), AB( NMAX, 2*NMAX ), @@ -117,26 +119,31 @@ PROGRAM DBLAT3 $ G( NMAX ), W( 2*NMAX ) INTEGER IDIM( NIDMAX ) LOGICAL LTEST( NSUBS ) - CHARACTER*6 SNAMES( NSUBS ) + CHARACTER*11 SNAMES( NSUBS ) * .. External Functions .. DOUBLE PRECISION DDIFF LOGICAL LDE EXTERNAL DDIFF, LDE * .. External Subroutines .. EXTERNAL DCHK1, DCHK2, DCHK3, DCHK4, DCHK5, DCHKE, DMMCH + EXTERNAL DCHK6 * .. Intrinsic Functions .. INTRINSIC MAX, MIN * .. Scalars in Common .. INTEGER INFOT, NOUTC LOGICAL LERR, OK - CHARACTER*6 SRNAMT + CHARACTER*11 SRNAMT * .. Common blocks .. COMMON /INFOC/INFOT, NOUTC, OK, LERR COMMON /SRNAMC/SRNAMT * .. Data statements .. - DATA SNAMES/'DGEMM ', 'DSYMM ', 'DTRMM ', 'DTRSM ', - $ 'DSYRK ', 'DSYR2K'/ + DATA SNAMES/'DGEMM ', 'DSYMM ', + $ 'DTRMM ', 'DTRSM ', + $ 'DSYRK ', 'DSYR2K ', + $ 'DGEMMTR ', + $ 'DSKEWSYMM ', 'DSKEWSYR2K '/ * .. Executable Statements .. + CALL CPU_TIME( S1 ) * * Read name and unit number for summary output file and open file. * @@ -312,14 +319,14 @@ PROGRAM DBLAT3 INFOT = 0 OK = .TRUE. FATAL = .FALSE. - GO TO ( 140, 150, 160, 160, 170, 180 )ISNUM + GO TO ( 140, 150, 160, 160, 170, 180, 185, 150, 180 )ISNUM * Test DGEMM, 01. 140 CALL DCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, $ CC, CS, CT, G ) GO TO 190 -* Test DSYMM, 02. +* Test SSYMM, 02, DSKEWSYMM, 07. 150 CALL DCHK2( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, @@ -336,11 +343,17 @@ PROGRAM DBLAT3 $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, $ CC, CS, CT, G ) GO TO 190 -* Test DSYR2K, 06. +* Test SSYR2K, 06, DSKEWSYR2K, 08. 180 CALL DCHK5( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W ) GO TO 190 +* Test DGEMMTR, 07. + 185 CALL DCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, + $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, + $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, + $ CC, CS, CT, G ) + * 190 IF( FATAL.AND.SFATAL ) $ GO TO 210 @@ -359,6 +372,8 @@ PROGRAM DBLAT3 230 CONTINUE IF( TRACE ) $ CLOSE ( NTRA ) + CALL CPU_TIME( S2 ) + WRITE( NOUT, FMT = 9983 )S2 - S1 CLOSE ( NOUT ) STOP * @@ -375,26 +390,28 @@ PROGRAM DBLAT3 9992 FORMAT( ' FOR BETA ', 7F6.1 ) 9991 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM', $ /' ******* TESTS ABANDONED *******' ) - 9990 FORMAT( ' SUBPROGRAM NAME ', A6, ' NOT RECOGNIZED', /' ******* T', - $ 'ESTS ABANDONED *******' ) + 9990 FORMAT( ' SUBPROGRAM NAME ', A11, ' NOT RECOGNIZED', /' ******* ', + $ 'TESTS ABANDONED *******' ) 9989 FORMAT( ' ERROR IN DMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALU', $ 'ATED WRONGLY.', /' DMMCH WAS CALLED WITH TRANSA = ', A1, $ ' AND TRANSB = ', A1, /' AND RETURNED SAME = ', L1, ' AND ', $ 'ERR = ', F12.3, '.', /' THIS MAY BE DUE TO FAULTS IN THE ', $ 'ARITHMETIC OR THE COMPILER.', /' ******* TESTS ABANDONED ', $ '*******' ) - 9988 FORMAT( A6, L2 ) - 9987 FORMAT( 1X, A6, ' WAS NOT TESTED' ) + 9988 FORMAT( A11, L2 ) + 9987 FORMAT( 1X, A11, ' WAS NOT TESTED' ) 9986 FORMAT( /' END OF TESTS' ) 9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' ) 9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' ) + 9983 FORMAT( ' Total time used = ', F12.2, ' seconds', / ) * -* End of DBLAT3. +* End of DBLAT3 * END SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G ) + IMPLICIT NONE * * Tests DGEMM. * @@ -413,7 +430,7 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*11 SNAME * .. Array Arguments .. DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -423,6 +440,7 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ) * .. Local Scalars .. DOUBLE PRECISION ALPHA, ALS, BETA, BLS, ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, ICA, ICB, IK, IM, IN, K, KS, LAA, $ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, M, $ MA, MB, MS, N, NA, NARGS, NB, NC, NS @@ -451,6 +469,8 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * DO 110 IM = 1, NIDIM M = IDIM( IM ) @@ -572,6 +592,8 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9994 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -607,6 +629,8 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -619,6 +643,9 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ C, NMAX, CT, G, CC, LDC, EPS, $ ERR, FATAL, NOUT, .TRUE. ) ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -654,28 +681,32 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ ALPHA, LDA, LDB, BETA, LDC * 130 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', - $ 'S)' ) + 9999 FORMAT( ' ', A11, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CAL', + $ 'LS)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', - $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, + 9997 FORMAT( ' ', A11, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' ', + $ 'CALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',''', A1, ''',', + 9996 FORMAT( ' ******* ', A11, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A11, '(''', A1, ''',''', A1, ''',', $ 3( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', ', $ 'C,', I3, ').' ) 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A11, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of DCHK1. +* End of DCHK1 * END SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G ) + IMPLICIT NONE * * Tests DSYMM. * @@ -694,7 +725,7 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*11 SNAME * .. Array Arguments .. DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -704,10 +735,11 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ) * .. Local Scalars .. DOUBLE PRECISION ALPHA, ALS, BETA, BLS, ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, ICS, ICU, IM, IN, LAA, LBB, LCC, $ LDA, LDAS, LDB, LDBS, LDC, LDCS, M, MS, N, NA, $ NARGS, NC, NS - LOGICAL LEFT, NULL, RESET, SAME + LOGICAL LEFT, NULL, RESET, SAME, SKEWFULL CHARACTER*1 SIDE, SIDES, UPLO, UPLOS CHARACTER*2 ICHS, ICHU * .. Local Arrays .. @@ -716,7 +748,7 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, LOGICAL LDE, LDERES EXTERNAL LDE, LDERES * .. External Subroutines .. - EXTERNAL DMAKE, DMMCH, DSYMM + EXTERNAL DMAKE, DMMCH, DSYMM, DSKEWSYMM * .. Intrinsic Functions .. INTRINSIC MAX * .. Scalars in Common .. @@ -728,10 +760,13 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DATA ICHS/'LR'/, ICHU/'UL'/ * .. Executable Statements .. * + SKEWFULL = SNAME( 2: 5 ).EQ.'SKEW' NARGS = 12 NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * DO 100 IM = 1, NIDIM M = IDIM( IM ) @@ -785,8 +820,13 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * * Generate the symmetric matrix A. * - CALL DMAKE( 'SY', UPLO, ' ', NA, NA, A, NMAX, AA, LDA, - $ RESET, ZERO ) + IF(.NOT.SKEWFULL) THEN + CALL DMAKE( 'SY', UPLO, ' ', NA, NA, A, NMAX, AA, + $ LDA, RESET, ZERO ) + ELSE + CALL DMAKE( 'SK', UPLO, ' ', NA, NA, A, NMAX, AA, + $ LDA, RESET, ZERO ) + END IF * DO 60 IA = 1, NALF ALPHA = ALF( IA ) @@ -830,14 +870,21 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ UPLO, M, N, ALPHA, LDA, LDB, BETA, LDC IF( REWI ) $ REWIND NTRA - CALL DSYMM( SIDE, UPLO, M, N, ALPHA, AA, LDA, - $ BB, LDB, BETA, CC, LDC ) + IF(.NOT.SKEWFULL) THEN + CALL DSYMM( SIDE, UPLO, M, N, ALPHA, AA, + $ LDA, BB, LDB, BETA, CC, LDC ) + ELSE + CALL DSKEWSYMM( SIDE, UPLO, M, N, ALPHA, AA, + $ LDA, BB, LDB, BETA, CC, LDC ) + END IF * * Check if error-exit was taken incorrectly. * IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9994 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 110 END IF * @@ -872,6 +919,8 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 110 END IF * @@ -891,6 +940,9 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NOUT, .TRUE. ) END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -924,28 +976,32 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ LDB, BETA, LDC * 120 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', - $ 'S)' ) + 9999 FORMAT( ' ', A11, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CAL', + $ 'LS)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', - $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, + 9997 FORMAT( ' ', A11, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' ', + $ 'CALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ), - $ F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', C,', I3, ') ', - $ ' .' ) + 9996 FORMAT( ' ******* ', A11, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A11, '(', 2( '''', A1, ''',' ), + $ 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, + $ ', C,', I3, ') ', ' .' ) 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A11, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of DCHK2. +* End of DCHK2 * END SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NMAX, A, AA, AS, $ B, BB, BS, CT, G, C ) + IMPLICIT NONE * * Tests DTRMM and DTRSM. * @@ -964,7 +1020,7 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*11 SNAME * .. Array Arguments .. DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -973,6 +1029,7 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ) * .. Local Scalars .. DOUBLE PRECISION ALPHA, ALS, ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, ICD, ICS, ICT, ICU, IM, IN, J, LAA, LBB, $ LDA, LDAS, LDB, LDBS, M, MS, N, NA, NARGS, NC, $ NS @@ -1003,6 +1060,8 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * Set up zero matrix for DMMCH. DO 20 J = 1, NMAX DO 10 I = 1, NMAX @@ -1112,6 +1171,8 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9994 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 150 END IF * @@ -1145,6 +1206,8 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 50 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 150 END IF * @@ -1195,6 +1258,9 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -1230,27 +1296,31 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ N, ALPHA, LDA, LDB * 160 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', - $ 'S)' ) + 9999 FORMAT( ' ', A11, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CAL', + $ 'LS)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', - $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, + 9997 FORMAT( ' ', A11, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' ', + $ 'CALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A6, '(', 4( '''', A1, ''',' ), 2( I3, ',' ), - $ F4.1, ', A,', I3, ', B,', I3, ') .' ) + 9996 FORMAT( ' ******* ', A11, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A11, '(', 4( '''', A1, ''',' ), + $ 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ') .' ) 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A11, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of DCHK3. +* End of DCHK3 * END SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G ) + IMPLICIT NONE * * Tests DSYRK. * @@ -1269,7 +1339,7 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*11 SNAME * .. Array Arguments .. DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -1279,6 +1349,7 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ) * .. Local Scalars .. DOUBLE PRECISION ALPHA, ALS, BETA, BETS, ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, K, KS, $ LAA, LCC, LDA, LDAS, LDC, LDCS, LJ, MA, N, NA, $ NARGS, NC, NS @@ -1308,6 +1379,8 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * DO 100 IN = 1, NIDIM N = IDIM( IN ) @@ -1397,6 +1470,8 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9993 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1429,6 +1504,8 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 30 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1466,6 +1543,9 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, JC = JC + LDC + 1 END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -1504,28 +1584,33 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ LDA, BETA, LDC * 130 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', - $ 'S)' ) + 9999 FORMAT( ' ', A11, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CAL', + $ 'LS)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', - $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, + 9997 FORMAT( ' ', A11, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' ', + $ 'CALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ', A11, ' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ), - $ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ') .' ) + 9994 FORMAT( 1X, I6, ': ', A11, '(', 2( '''', A1, ''',' ), + $ 2( I3, ',' ), F4.1, ', A,', I3, ',', F4.1, ', C,', I3, + $ ') .' ) 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A11, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of DCHK4. +* End of DCHK4 * END SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, $ AB, AA, AS, BB, BS, C, CC, CS, CT, G, W ) + IMPLICIT NONE * * Tests DSYR2K. * @@ -1544,7 +1629,7 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*11 SNAME * .. Array Arguments .. DOUBLE PRECISION AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ), $ ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ), @@ -1554,10 +1639,11 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ) * .. Local Scalars .. DOUBLE PRECISION ALPHA, ALS, BETA, BETS, ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, JJAB, $ K, KS, LAA, LBB, LCC, LDA, LDAS, LDB, LDBS, $ LDC, LDCS, LJ, MA, N, NA, NARGS, NC, NS - LOGICAL NULL, RESET, SAME, TRAN, UPPER + LOGICAL NULL, RESET, SAME, TRAN, UPPER, SKEWFULL CHARACTER*1 TRANS, TRANSS, UPLO, UPLOS CHARACTER*2 ICHU CHARACTER*3 ICHT @@ -1567,7 +1653,7 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, LOGICAL LDE, LDERES EXTERNAL LDE, LDERES * .. External Subroutines .. - EXTERNAL DMAKE, DMMCH, DSYR2K + EXTERNAL DMAKE, DMMCH, DSYR2K, DSKEWSYR2K * .. Intrinsic Functions .. INTRINSIC MAX * .. Scalars in Common .. @@ -1579,10 +1665,13 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DATA ICHT/'NTC'/, ICHU/'UL'/ * .. Executable Statements .. * + SKEWFULL = SNAME( 2: 5 ).EQ.'SKEW' NARGS = 12 NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * DO 130 IN = 1, NIDIM N = IDIM( IN ) @@ -1652,8 +1741,13 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * * Generate the matrix C. * - CALL DMAKE( 'SY', UPLO, ' ', N, N, C, NMAX, CC, - $ LDC, RESET, ZERO ) + IF(.NOT.SKEWFULL) THEN + CALL DMAKE( 'SY', UPLO, ' ', N, N, C, NMAX, + $ CC, LDC, RESET, ZERO ) + ELSE + CALL DMAKE( 'SK', UPLO, ' ', N, N, C, NMAX, + $ CC, LDC, RESET, ZERO ) + END IF * NC = NC + 1 * @@ -1685,14 +1779,22 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ TRANS, N, K, ALPHA, LDA, LDB, BETA, LDC IF( REWI ) $ REWIND NTRA - CALL DSYR2K( UPLO, TRANS, N, K, ALPHA, AA, LDA, - $ BB, LDB, BETA, CC, LDC ) + IF(.NOT.SKEWFULL) THEN + CALL DSYR2K( UPLO, TRANS, N, K, ALPHA, AA, + $ LDA, BB, LDB, BETA, CC, LDC ) + ELSE + CALL DSKEWSYR2K( UPLO, TRANS, N, K, ALPHA, + $ AA, LDA, BB, LDB, BETA, CC, + $ LDC ) + END IF * * Check if error-exit was taken incorrectly. * IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9993 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 150 END IF * @@ -1711,8 +1813,13 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( NULL )THEN ISAME( 11 ) = LDE( CS, CC, LCC ) ELSE - ISAME( 11 ) = LDERES( 'SY', UPLO, N, N, CS, - $ CC, LDC ) + IF(.NOT.SKEWFULL) THEN + ISAME( 11 ) = LDERES( 'SY', UPLO, N, N, + $ CS, CC, LDC ) + ELSE + ISAME( 11 ) = LDERES( 'SK', UPLO, N, N, + $ CS, CC, LDC ) + END IF END IF ISAME( 12 ) = LDCS.EQ.LDC * @@ -1727,6 +1834,8 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 150 END IF * @@ -1734,20 +1843,37 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * * Check the result column by column. * + IF( .NOT.SKEWFULL.OR.UPPER )THEN JJAB = 1 JC = 1 + ELSE + JJAB = 1 + 2*NMAX + JC = 2 + END IF DO 70 J = 1, N - IF( UPPER )THEN + IF( .NOT.SKEWFULL.AND.UPPER )THEN JJ = 1 LJ = J - ELSE + ELSE IF( .NOT.SKEWFULL.AND..NOT.UPPER ) + $ THEN JJ = J LJ = N - J + 1 + ELSE IF( SKEWFULL.AND.UPPER )THEN + JJ = 1 + LJ = J - 1 + ELSE + JJ = J + 1 + LJ = N - J END IF IF( TRAN )THEN DO 50 I = 1, K - W( I ) = AB( ( J - 1 )*2*NMAX + K + - $ I ) + IF(.NOT.SKEWFULL) THEN + W( I ) = AB( ( J - 1 )*2*NMAX + $ + K + I ) + ELSE + W( I ) = -AB( ( J - 1 )*2*NMAX + $ + K + I ) + END IF W( K + I ) = AB( ( J - 1 )*2*NMAX + $ I ) 50 CONTINUE @@ -1759,8 +1885,13 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NOUT, .TRUE. ) ELSE DO 60 I = 1, K - W( I ) = AB( ( K + I - 1 )*NMAX + - $ J ) + IF(.NOT.SKEWFULL) THEN + W( I ) = AB( ( K + I - 1 )*NMAX + $ + J ) + ELSE + W( I ) = -AB( ( K + I - 1 )*NMAX + $ + J ) + END IF W( K + I ) = AB( ( I - 1 )*NMAX + $ J ) 60 CONTINUE @@ -1779,6 +1910,9 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ JJAB = JJAB + 2*NMAX END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -1817,27 +1951,31 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ LDA, LDB, BETA, LDC * 160 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', - $ 'S)' ) + 9999 FORMAT( ' ', A11, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CAL', + $ 'LS)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', - $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, + 9997 FORMAT( ' ', A11, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' ', + $ 'CALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ', A11, ' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ), - $ F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', C,', I3, ') ', - $ ' .' ) + 9994 FORMAT( 1X, I6, ': ', A11, '(', 2( '''', A1, ''',' ) + $ , 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, + $ ', C,', I3, ') ', ' .' ) 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A11, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of DCHK5. +* End of DCHK5 * END SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) + IMPLICIT NONE * * Tests the error exits from the Level 3 Blas. * Requires a special version of the error-handling routine XERBLA. @@ -1856,8 +1994,9 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) * * .. Scalar Arguments .. INTEGER ISNUM, NOUT - CHARACTER*6 SRNAMT + CHARACTER*11 SRNAMT * .. Scalars in Common .. + INTEGER NXRUN, NXFAIL, NXBAD INTEGER INFOT, NOUTC LOGICAL LERR, OK * .. Parameters .. @@ -1869,9 +2008,10 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) DOUBLE PRECISION A( 2, 1 ), B( 2, 1 ), C( 2, 1 ) * .. External Subroutines .. EXTERNAL CHKXER, DGEMM, DSYMM, DSYR2K, DSYRK, DTRMM, - $ DTRSM + $ DTRSM, DGEMMTR * .. Common blocks .. COMMON /INFOC/INFOT, NOUTC, OK, LERR + COMMON /XERCNT/NXRUN, NXFAIL, NXBAD * .. Executable Statements .. * OK is set to .FALSE. by the special version of XERBLA or by CHKXER * if anything is wrong. @@ -1879,13 +2019,18 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) * LERR is set to .TRUE. by the special version of XERBLA each time * it is called, and is then tested and re-set by CHKXER. LERR = .FALSE. +* NXRUN and NXFAIL count the error-exit tests of this routine; +* NXBAD is set by XERBLA when it is called wrongly. + NXRUN = 0 + NXFAIL = 0 + NXBAD = 0 * * Initialize ALPHA and BETA. * ALPHA = ONE BETA = TWO * - GO TO ( 10, 20, 30, 40, 50, 60 )ISNUM + GO TO ( 10, 20, 30, 40, 50, 60, 70, 80, 90 )ISNUM 10 INFOT = 1 CALL DGEMM( '/', 'N', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -1970,7 +2115,7 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 13 CALL DGEMM( 'T', 'T', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 70 + GO TO 100 20 INFOT = 1 CALL DSYMM( '/', 'U', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2037,7 +2182,7 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 12 CALL DSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 70 + GO TO 100 30 INFOT = 1 CALL DTRMM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2146,7 +2291,7 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 11 CALL DTRMM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 70 + GO TO 100 40 INFOT = 1 CALL DTRSM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2255,7 +2400,7 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 11 CALL DTRSM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 70 + GO TO 100 50 INFOT = 1 CALL DSYRK( '/', 'N', 0, 0, ALPHA, A, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2310,7 +2455,7 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 10 CALL DSYRK( 'L', 'T', 2, 0, ALPHA, A, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 70 + GO TO 100 60 INFOT = 1 CALL DSYR2K( '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2377,29 +2522,246 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 12 CALL DSYR2K( 'L', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + GO TO 100 + 70 INFOT = 1 + CALL DGEMMTR( '/', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL DGEMMTR( 'U', '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL DGEMMTR( 'U', '/', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL DGEMMTR( 'U', 'N', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL DGEMMTR( 'U', 'T', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL DGEMMTR( 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL DGEMMTR( 'U', 'N', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL DGEMMTR( 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL DGEMMTR( 'U', 'T', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL DGEMMTR( 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL DGEMMTR( 'U', 'N', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL DGEMMTR( 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL DGEMMTR( 'U', 'T', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL DGEMMTR( 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2, BETA, C, + $ 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL DGEMMTR( 'U', 'N', 'T', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 10 + CALL DGEMMTR( 'U', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 10 + CALL DGEMMTR( 'U', 'T', 'N', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 10 + CALL DGEMMTR( 'U', 'N', 'T', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 10 + CALL DGEMMTR( 'U', 'T', 'T', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL DGEMMTR( 'U', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL DGEMMTR( 'U', 'N', 'T', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL DGEMMTR( 'U', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL DGEMMTR( 'U', 'T', 'T', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + GO TO 100 + 80 INFOT = 1 + CALL DSKEWSYMM( '/', 'U', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL DSKEWSYMM( 'L', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL DSKEWSYMM( 'L', 'U', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL DSKEWSYMM( 'R', 'U', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL DSKEWSYMM( 'L', 'L', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL DSKEWSYMM( 'R', 'L', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL DSKEWSYMM( 'L', 'U', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL DSKEWSYMM( 'R', 'U', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL DSKEWSYMM( 'L', 'L', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL DSKEWSYMM( 'R', 'L', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 7 + CALL DSKEWSYMM( 'L', 'U', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 7 + CALL DSKEWSYMM( 'R', 'U', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 7 + CALL DSKEWSYMM( 'L', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 7 + CALL DSKEWSYMM( 'R', 'L', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 9 + CALL DSKEWSYMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 9 + CALL DSKEWSYMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 9 + CALL DSKEWSYMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 9 + CALL DSKEWSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 12 + CALL DSKEWSYMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 12 + CALL DSKEWSYMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 12 + CALL DSKEWSYMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 12 + CALL DSKEWSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + GO TO 100 + 90 INFOT = 1 + CALL DSKEWSYR2K( '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL DSKEWSYR2K( 'U', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL DSKEWSYR2K( 'U', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL DSKEWSYR2K( 'U', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL DSKEWSYR2K( 'L', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL DSKEWSYR2K( 'L', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL DSKEWSYR2K( 'U', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL DSKEWSYR2K( 'U', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL DSKEWSYR2K( 'L', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL DSKEWSYR2K( 'L', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 7 + CALL DSKEWSYR2K( 'U', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 7 + CALL DSKEWSYR2K( 'U', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 7 + CALL DSKEWSYR2K( 'L', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 7 + CALL DSKEWSYR2K( 'L', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 9 + CALL DSKEWSYR2K( 'U', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 9 + CALL DSKEWSYR2K( 'U', 'T', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 9 + CALL DSKEWSYR2K( 'L', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 9 + CALL DSKEWSYR2K( 'L', 'T', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 12 + CALL DSKEWSYR2K( 'U', 'N', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 12 + CALL DSKEWSYR2K( 'U', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 12 + CALL DSKEWSYR2K( 'L', 'N', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 12 + CALL DSKEWSYR2K( 'L', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) * - 70 IF( OK )THEN + 100 IF( OK )THEN WRITE( NOUT, FMT = 9999 )SRNAMT ELSE WRITE( NOUT, FMT = 9998 )SRNAMT END IF + WRITE( NOUT, FMT = 9979 )SRNAMT, NXRUN, NXFAIL RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE TESTS OF ERROR-EXITS' ) - 9998 FORMAT( ' ******* ', A6, ' FAILED THE TESTS OF ERROR-EXITS *****', - $ '**' ) + 9999 FORMAT( ' ', A11, ' PASSED THE TESTS OF ERROR-EXITS' ) + 9998 FORMAT( ' ******* ', A11, ' FAILED THE TESTS OF ERROR-EXITS ****', + $ '***' ) + 9979 FORMAT( ' ', A11, ' ERROR-EXIT TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of DCHKE. +* End of DCHKE * END SUBROUTINE DMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET, $ TRANSL ) + IMPLICIT NONE * * Generates values for an M by N matrix A. * Stores the values in the array AA in the data structure required * by the routine, with unwanted elements set to rogue value. * -* TYPE is 'GE', 'SY' or 'TR'. +* TYPE is 'GE', 'SY', 'SK' or 'TR'. * * Auxiliary routine for test program for Level 3 Blas. * @@ -2424,7 +2786,8 @@ SUBROUTINE DMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET, DOUBLE PRECISION A( NMAX, * ), AA( * ) * .. Local Scalars .. INTEGER I, IBEG, IEND, J - LOGICAL GEN, LOWER, SYM, TRI, UNIT, UPPER + LOGICAL GEN, LOWER, SYM, TRI, UNIT, UPPER, + $ SKEW * .. External Functions .. DOUBLE PRECISION DBEG EXTERNAL DBEG @@ -2432,8 +2795,9 @@ SUBROUTINE DMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET, GEN = TYPE.EQ.'GE' SYM = TYPE.EQ.'SY' TRI = TYPE.EQ.'TR' - UPPER = ( SYM.OR.TRI ).AND.UPLO.EQ.'U' - LOWER = ( SYM.OR.TRI ).AND.UPLO.EQ.'L' + SKEW = TYPE.EQ.'SK' + UPPER = ( SYM.OR.SKEW.OR.TRI ).AND.UPLO.EQ.'U' + LOWER = ( SYM.OR.SKEW.OR.TRI ).AND.UPLO.EQ.'L' UNIT = TRI.AND.DIAG.EQ.'U' * * Generate data in array A. @@ -2449,6 +2813,8 @@ SUBROUTINE DMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET, $ A( I, J ) = ZERO IF( SYM )THEN A( J, I ) = A( I, J ) + ELSE IF( SKEW )THEN + A( J, I ) = -A( I, J ) ELSE IF( TRI )THEN A( J, I ) = ZERO END IF @@ -2459,6 +2825,8 @@ SUBROUTINE DMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET, $ A( J, J ) = A( J, J ) + ONE IF( UNIT ) $ A( J, J ) = ONE + IF( SKEW ) + $ A( J, J ) = ZERO 20 CONTINUE * * Store elements in array AS in data structure required by routine. @@ -2472,17 +2840,17 @@ SUBROUTINE DMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET, AA( I + ( J - 1 )*LDA ) = ROGUE 40 CONTINUE 50 CONTINUE - ELSE IF( TYPE.EQ.'SY'.OR.TYPE.EQ.'TR' )THEN + ELSE IF( TYPE.EQ.'SY'.OR.TYPE.EQ.'SK'.OR.TYPE.EQ.'TR' )THEN DO 90 J = 1, N IF( UPPER )THEN IBEG = 1 - IF( UNIT )THEN + IF( UNIT.OR.SKEW )THEN IEND = J - 1 ELSE IEND = J END IF ELSE - IF( UNIT )THEN + IF( UNIT.OR.SKEW )THEN IBEG = J + 1 ELSE IBEG = J @@ -2502,12 +2870,13 @@ SUBROUTINE DMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET, END IF RETURN * -* End of DMAKE. +* End of DMAKE * END SUBROUTINE DMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, $ BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, FATAL, $ NOUT, MV ) + IMPLICIT NONE * * Checks the results of the computational tests. * @@ -2624,10 +2993,11 @@ SUBROUTINE DMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, 9998 FORMAT( 1X, I7, 2G18.6 ) 9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) * -* End of DMMCH. +* End of DMMCH * END LOGICAL FUNCTION LDE( RI, RJ, LR ) + IMPLICIT NONE * * Tests if two arrays are identical. * @@ -2656,14 +3026,15 @@ LOGICAL FUNCTION LDE( RI, RJ, LR ) LDE = .FALSE. 30 RETURN * -* End of LDE. +* End of LDE * END LOGICAL FUNCTION LDERES( TYPE, UPLO, M, N, AA, AS, LDA ) + IMPLICIT NONE * * Tests if selected elements in two arrays are equal. * -* TYPE is 'GE' or 'SY'. +* TYPE is 'GE' or 'SY' or 'SK'. * * Auxiliary routine for test program for Level 3 Blas. * @@ -2691,14 +3062,20 @@ LOGICAL FUNCTION LDERES( TYPE, UPLO, M, N, AA, AS, LDA ) $ GO TO 70 10 CONTINUE 20 CONTINUE - ELSE IF( TYPE.EQ.'SY' )THEN + ELSE IF( TYPE.EQ.'SY'.OR.TYPE.EQ.'SK' )THEN DO 50 J = 1, N - IF( UPPER )THEN + IF( UPPER.AND.TYPE.EQ.'SY' )THEN IBEG = 1 IEND = J - ELSE + ELSE IF( .NOT.UPPER.AND.TYPE.EQ.'SY' )THEN IBEG = J IEND = N + ELSE IF( UPPER.AND.TYPE.EQ.'SK' )THEN + IBEG = 1 + IEND = J - 1 + ELSE + IBEG = J + 1 + IEND = N END IF DO 30 I = 1, IBEG - 1 IF( AA( I, J ).NE.AS( I, J ) ) @@ -2717,10 +3094,11 @@ LOGICAL FUNCTION LDERES( TYPE, UPLO, M, N, AA, AS, LDA ) LDERES = .FALSE. 80 RETURN * -* End of LDERES. +* End of LDERES * END DOUBLE PRECISION FUNCTION DBEG( RESET ) + IMPLICIT NONE * * Generates random numbers uniformly distributed between -0.5 and 0.5. * @@ -2763,10 +3141,11 @@ DOUBLE PRECISION FUNCTION DBEG( RESET ) DBEG = ( I - 500 )/1001.0D0 RETURN * -* End of DBEG. +* End of DBEG * END DOUBLE PRECISION FUNCTION DDIFF( X, Y ) + IMPLICIT NONE * * Auxiliary routine for test program for Level 3 Blas. * @@ -2782,10 +3161,11 @@ DOUBLE PRECISION FUNCTION DDIFF( X, Y ) DDIFF = X - Y RETURN * -* End of DDIFF. +* End of DDIFF * END SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + IMPLICIT NONE * * Tests whether XERBLA has detected an error when it should. * @@ -2800,22 +3180,32 @@ SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) * .. Scalar Arguments .. INTEGER INFOT, NOUT LOGICAL LERR, OK - CHARACTER*6 SRNAMT + CHARACTER*11 SRNAMT +* .. Scalars in Common .. + INTEGER NXRUN, NXFAIL, NXBAD +* .. Common blocks .. + COMMON /XERCNT/NXRUN, NXFAIL, NXBAD * .. Executable Statements .. + NXRUN = NXRUN + 1 IF( .NOT.LERR )THEN WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT OK = .FALSE. + NXFAIL = NXFAIL + 1 + ELSE IF( NXBAD.NE.0 )THEN + NXFAIL = NXFAIL + 1 END IF + NXBAD = 0 LERR = .FALSE. RETURN * 9999 FORMAT( ' ***** ILLEGAL VALUE OF PARAMETER NUMBER ', I2, ' NOT D', - $ 'ETECTED BY ', A6, ' *****' ) + $ 'ETECTED BY ', A11, ' *****' ) * -* End of CHKXER. +* End of CHKXER * END SUBROUTINE XERBLA( SRNAME, INFO ) + IMPLICIT NONE * * This is a special version of XERBLA to be used only as part of * the test program for testing error exits from the Level 3 BLAS @@ -2836,14 +3226,18 @@ SUBROUTINE XERBLA( SRNAME, INFO ) * * .. Scalar Arguments .. INTEGER INFO - CHARACTER*6 SRNAME + CHARACTER*(*) SRNAME * .. Scalars in Common .. + INTEGER NXRUN, NXFAIL, NXBAD INTEGER INFOT, NOUT LOGICAL LERR, OK - CHARACTER*6 SRNAMT + CHARACTER*11 SRNAMT * .. Common blocks .. COMMON /INFOC/INFOT, NOUT, OK, LERR + COMMON /XERCNT/NXRUN, NXFAIL, NXBAD COMMON /SRNAMC/SRNAMT +* .. Locals .. + INTEGER SRLEN * .. Executable Statements .. LERR = .TRUE. IF( INFO.NE.INFOT )THEN @@ -2853,17 +3247,20 @@ SUBROUTINE XERBLA( SRNAME, INFO ) WRITE( NOUT, FMT = 9997 )INFO END IF OK = .FALSE. + NXBAD = 1 END IF - IF( SRNAME.NE.SRNAMT )THEN + SRLEN = MIN(LEN_TRIM(SRNAME), LEN_TRIM(SRNAMT)) + IF( SRNAME(1:SRLEN).NE.SRNAMT(1:SRLEN) )THEN WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT OK = .FALSE. + NXBAD = 1 END IF RETURN * 9999 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6, ' INSTEAD', $ ' OF ', I2, ' *******' ) - 9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A6, ' INSTE', - $ 'AD OF ', A6, ' *******' ) + 9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A, ' INST', + $ 'EAD OF ', A11, ' *******' ) 9997 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6, $ ' *******' ) * @@ -2871,3 +3268,434 @@ SUBROUTINE XERBLA( SRNAME, INFO ) * END + SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, + $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, + $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G ) + IMPLICIT NONE +* +* Tests DGEMMTR. +* +* Auxiliary routine for test program for Level 3 Blas. +* +* -- Written on 19-July-2023. +* Martin Koehler, MPI Magdeburg +* +* .. Parameters .. + DOUBLE PRECISION ZERO + PARAMETER ( ZERO = 0.0D0 ) +* .. Scalar Arguments .. + DOUBLE PRECISION EPS, THRESH + INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA + LOGICAL FATAL, REWI, TRACE + CHARACTER*11 SNAME +* .. Array Arguments .. + DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), + $ AS( NMAX*NMAX ), B( NMAX, NMAX ), + $ BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ), + $ C( NMAX, NMAX ), CC( NMAX*NMAX ), + $ CS( NMAX*NMAX ), CT( NMAX ), G( NMAX ) + INTEGER IDIM( NIDIM ) +* .. Local Scalars .. + DOUBLE PRECISION ALPHA, ALS, BETA, BLS, ERR, ERRMAX + INTEGER NTESTS, NFAILS + INTEGER I, IA, IB, ICA, ICB, IK, IN, K, KS, LAA, + $ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, + $ MA, MB, N, NA, NARGS, NB, NC, NS, IS + LOGICAL NULL, RESET, SAME, TRANA, TRANB + CHARACTER*1 TRANAS, TRANBS, TRANSA, TRANSB, UPLO, UPLOS + CHARACTER*3 ICH + CHARACTER*2 ISHAPE +* .. Local Arrays .. + LOGICAL ISAME( 13 ) +* .. External Functions .. + LOGICAL LDE, LDERES + EXTERNAL LDE, LDERES +* .. External Subroutines .. + EXTERNAL DGEMMTR, DMAKE, DMMTCH +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. Scalars in Common .. + INTEGER INFOT, NOUTC + LOGICAL LERR, OK +* .. Common blocks .. + COMMON /INFOC/INFOT, NOUTC, OK, LERR +* .. Data statements .. + DATA ICH/'NTC'/ + DATA ISHAPE/'UL'/ +* .. Executable Statements .. +* + NARGS = 13 + NC = 0 + RESET = .TRUE. + ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 +* + DO 100 IN = 1, NIDIM + N = IDIM( IN ) +* Set LDC to 1 more than minimum value if room. + LDC = N + IF( LDC.LT.NMAX ) + $ LDC = LDC + 1 +* Skip tests if not enough room. + IF( LDC.GT.NMAX ) + $ GO TO 100 + LCC = LDC*N + NULL = N.LE.0 +* + DO 90 IK = 1, NIDIM + K = IDIM( IK ) +* + DO 80 ICA = 1, 3 + TRANSA = ICH( ICA: ICA ) + TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' +* + IF( TRANA )THEN + MA = K + NA = N + ELSE + MA = N + NA = K + END IF +* Set LDA to 1 more than minimum value if room. + LDA = MA + IF( LDA.LT.NMAX ) + $ LDA = LDA + 1 +* Skip tests if not enough room. + IF( LDA.GT.NMAX ) + $ GO TO 80 + LAA = LDA*NA +* +* Generate the matrix A. +* + CALL DMAKE( 'GE', ' ', ' ', MA, NA, A, NMAX, AA, LDA, + $ RESET, ZERO ) +* + DO 70 ICB = 1, 3 + TRANSB = ICH( ICB: ICB ) + TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' +* + IF( TRANB )THEN + MB = N + NB = K + ELSE + MB = K + NB = N + END IF +* Set LDB to 1 more than minimum value if room. + LDB = MB + IF( LDB.LT.NMAX ) + $ LDB = LDB + 1 +* Skip tests if not enough room. + IF( LDB.GT.NMAX ) + $ GO TO 70 + LBB = LDB*NB +* +* Generate the matrix B. +* + CALL DMAKE( 'GE', ' ', ' ', MB, NB, B, NMAX, BB, + $ LDB, RESET, ZERO ) +* + DO 60 IA = 1, NALF + ALPHA = ALF( IA ) +* + DO 50 IB = 1, NBET + BETA = BET( IB ) + + DO 45 IS = 1, 2 + UPLO = ISHAPE( IS: IS ) + +* +* Generate the matrix C. +* + CALL DMAKE( 'GE', UPLO, ' ', N, N, C, + $ NMAX, CC, LDC, RESET, ZERO ) +* + NC = NC + 1 +* +* Save every datum before calling the +* subroutine. +* + UPLOS = UPLO + TRANAS = TRANSA + TRANBS = TRANSB + NS = N + KS = K + ALS = ALPHA + DO 10 I = 1, LAA + AS( I ) = AA( I ) + 10 CONTINUE + LDAS = LDA + DO 20 I = 1, LBB + BS( I ) = BB( I ) + 20 CONTINUE + LDBS = LDB + BLS = BETA + DO 30 I = 1, LCC + CS( I ) = CC( I ) + 30 CONTINUE + LDCS = LDC +* +* Call the subroutine. +* + IF( TRACE ) + $ WRITE( NTRA, FMT = 9995 )NC, SNAME, + $ UPLO, TRANSA, TRANSB, N, K, ALPHA, LDA, + $ LDB, BETA, LDC + IF( REWI ) + $ REWIND NTRA + CALL DGEMMTR( UPLO, TRANSA, TRANSB, N, + $ K, ALPHA, AA, LDA, BB, LDB, + $ BETA, CC, LDC ) +* +* Check if error-exit was taken incorrectly. +* + IF( .NOT.OK )THEN + WRITE( NOUT, FMT = 9994 ) + FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 + GO TO 120 + END IF +* +* See what data changed inside subroutines. +* + ISAME( 1 ) = UPLO.EQ.UPLOS + ISAME( 2 ) = TRANSA.EQ.TRANAS + ISAME( 3 ) = TRANSB.EQ.TRANBS + ISAME( 4 ) = NS.EQ.N + ISAME( 5 ) = KS.EQ.K + ISAME( 6 ) = ALS.EQ.ALPHA + ISAME( 7 ) = LDE( AS, AA, LAA ) + ISAME( 8 ) = LDAS.EQ.LDA + ISAME( 9 ) = LDE( BS, BB, LBB ) + ISAME( 10 ) = LDBS.EQ.LDB + ISAME( 11 ) = BLS.EQ.BETA + IF( NULL )THEN + ISAME( 12 ) = LDE( CS, CC, LCC ) + ELSE + ISAME( 12 ) = LDERES( 'GE', ' ', N, N, + $ CS, CC, LDC ) + END IF + ISAME( 13 ) = LDCS.EQ.LDC +* +* If data was incorrectly changed, report +* and return. +* + SAME = .TRUE. + DO 40 I = 1, NARGS + SAME = SAME.AND.ISAME( I ) + IF( .NOT.ISAME( I ) ) + $ WRITE( NOUT, FMT = 9998 )I + 40 CONTINUE + IF( .NOT.SAME )THEN + FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 + GO TO 120 + END IF +* + IF( .NOT.NULL )THEN +* +* Check the result. +* + CALL DMMTCH( UPLO, TRANSA, TRANSB, + $ N, K, + $ ALPHA, A, NMAX, B, NMAX, BETA, + $ C, NMAX, CT, G, CC, LDC, EPS, + $ ERR, FATAL, NOUT, .TRUE. ) + ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 +* If got really bad answer, report and +* return. + IF( FATAL ) + $ GO TO 120 + END IF +* + 45 CONTINUE +* + 50 CONTINUE +* + 60 CONTINUE +* + 70 CONTINUE +* + 80 CONTINUE +* + 90 CONTINUE +* + 100 CONTINUE +* +* +* Report result. +* + IF( ERRMAX.LT.THRESH )THEN + WRITE( NOUT, FMT = 9999 )SNAME, NC + ELSE + WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX + END IF + GO TO 130 +* + 120 CONTINUE + WRITE( NOUT, FMT = 9996 )SNAME + WRITE( NOUT, FMT = 9995 )NC, SNAME, UPLO, TRANSA, TRANSB, N, K, + $ ALPHA, LDA, LDB, BETA, LDC +* + 130 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + RETURN +* + 9999 FORMAT( ' ', A11, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CAL', + $ 'LS)' ) + 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', + $ 'ANGED INCORRECTLY *******' ) + 9997 FORMAT( ' ', A11, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' ', + $ 'CALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, + $ ' - SUSPECT *******' ) + 9996 FORMAT( ' ******* ', A11, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A11, '(''', A1, ''',''', A1, ''',''', A1, + $ ''',', 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', + $ F4.1, ', ', 'C,', I3, ').' ) + 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', + $ '******' ) + 9979 FORMAT( ' ', A11, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) +* +* End of DCHK6 +* + END + + SUBROUTINE DMMTCH( UPLO, TRANSA, TRANSB, N, KK, ALPHA, A, LDA, + $ B, LDB, BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, + $ FATAL, NOUT, MV ) + IMPLICIT NONE +* +* Checks the results of the computational tests. +* +* Auxiliary routine for test program for Level 3 Blas. (DGEMMTR) +* +* -- Written on 19-July-2023. +* Martin Koehler, MPI Magdeburg +* +* .. Parameters .. + DOUBLE PRECISION ZERO, ONE + PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) +* .. Scalar Arguments .. + DOUBLE PRECISION ALPHA, BETA, EPS, ERR + INTEGER KK, LDA, LDB, LDC, LDCC, N, NOUT + LOGICAL FATAL, MV + CHARACTER*1 UPLO, TRANSA, TRANSB +* .. Array Arguments .. + DOUBLE PRECISION A( LDA, * ), B( LDB, * ), C( LDC, * ), + $ CC( LDCC, * ), CT( * ), G( * ) +* .. Local Scalars .. + DOUBLE PRECISION ERRI + INTEGER I, J, K, ISTART, ISTOP + LOGICAL TRANA, TRANB, UPPER +* .. Intrinsic Functions .. + INTRINSIC ABS, MAX, SQRT +* .. Executable Statements .. + UPPER = UPLO.EQ.'U' + TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' + TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' +* +* Compute expected result, one column at a time, in CT using data +* in A, B and C. +* Compute gauges in G. +* + ISTART = 1 + ISTOP = N + + DO 120 J = 1, N +* + IF ( UPPER ) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + DO 10 I = ISTART, ISTOP + CT( I ) = ZERO + G( I ) = ZERO + 10 CONTINUE + IF( .NOT.TRANA.AND..NOT.TRANB )THEN + DO 30 K = 1, KK + DO 20 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*B( K, J ) + G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( K, J ) ) + 20 CONTINUE + 30 CONTINUE + ELSE IF( TRANA.AND..NOT.TRANB )THEN + DO 50 K = 1, KK + DO 40 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*B( K, J ) + G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( K, J ) ) + 40 CONTINUE + 50 CONTINUE + ELSE IF( .NOT.TRANA.AND.TRANB )THEN + DO 70 K = 1, KK + DO 60 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*B( J, K ) + G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( J, K ) ) + 60 CONTINUE + 70 CONTINUE + ELSE IF( TRANA.AND.TRANB )THEN + DO 90 K = 1, KK + DO 80 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*B( J, K ) + G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( J, K ) ) + 80 CONTINUE + 90 CONTINUE + END IF + DO 100 I = ISTART, ISTOP + CT( I ) = ALPHA*CT( I ) + BETA*C( I, J ) + G( I ) = ABS( ALPHA )*G( I ) + ABS( BETA )*ABS( C( I, J ) ) + 100 CONTINUE +* +* Compute the error ratio for this result. +* + ERR = ZERO + DO 110 I = ISTART, ISTOP + ERRI = ABS( CT( I ) - CC( I, J ) )/EPS + IF( G( I ).NE.ZERO ) + $ ERRI = ERRI/G( I ) + ERR = MAX( ERR, ERRI ) + IF( ERR*SQRT( EPS ).GE.ONE ) + $ GO TO 130 + 110 CONTINUE +* + 120 CONTINUE +* +* If the loop completes, all results are at least half accurate. + GO TO 150 +* +* Report fatal error. +* + 130 FATAL = .TRUE. + WRITE( NOUT, FMT = 9999 ) + DO 140 I = ISTART, ISTOP + IF( MV )THEN + WRITE( NOUT, FMT = 9998 )I, CT( I ), CC( I, J ) + ELSE + WRITE( NOUT, FMT = 9998 )I, CC( I, J ), CT( I ) + END IF + 140 CONTINUE + IF( N.GT.1 ) + $ WRITE( NOUT, FMT = 9997 )J +* + 150 CONTINUE + RETURN +* + 9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL', + $ 'F ACCURATE *******', /' EXPECTED RESULT COMPU', + $ 'TED RESULT' ) + 9998 FORMAT( 1X, I7, 2G18.6 ) + 9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) +* +* End of DMMTCH +* + END + diff --git a/BLAS/TESTING/dblat3.in b/BLAS/TESTING/dblat3.in index 0098f3e521..df1037a162 100644 --- a/BLAS/TESTING/dblat3.in +++ b/BLAS/TESTING/dblat3.in @@ -12,9 +12,12 @@ T LOGICAL FLAG, T TO TEST ERROR EXITS. 0.0 1.0 0.7 VALUES OF ALPHA 3 NUMBER OF VALUES OF BETA 0.0 1.0 1.3 VALUES OF BETA -DGEMM T PUT F FOR NO TEST. SAME COLUMNS. -DSYMM T PUT F FOR NO TEST. SAME COLUMNS. -DTRMM T PUT F FOR NO TEST. SAME COLUMNS. -DTRSM T PUT F FOR NO TEST. SAME COLUMNS. -DSYRK T PUT F FOR NO TEST. SAME COLUMNS. -DSYR2K T PUT F FOR NO TEST. SAME COLUMNS. +DGEMM T PUT F FOR NO TEST. SAME COLUMNS. +DSYMM T PUT F FOR NO TEST. SAME COLUMNS. +DTRMM T PUT F FOR NO TEST. SAME COLUMNS. +DTRSM T PUT F FOR NO TEST. SAME COLUMNS. +DSYRK T PUT F FOR NO TEST. SAME COLUMNS. +DSYR2K T PUT F FOR NO TEST. SAME COLUMNS. +DGEMMTR T PUT F FOR NO TEST. SAME COLUMNS. +DSKEWSYMM T PUT F FOR NO TEST. SAME COLUMNS. +DSKEWSYR2K T PUT F FOR NO TEST. SAME COLUMNS. diff --git a/BLAS/TESTING/sblat1.f b/BLAS/TESTING/sblat1.f index 3ea607be47..084e3f141b 100644 --- a/BLAS/TESTING/sblat1.f +++ b/BLAS/TESTING/sblat1.f @@ -30,17 +30,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date April 2012 -* *> \ingroup single_blas_testing * * ===================================================================== PROGRAM SBLAT1 + IMPLICIT NONE * -* -- Reference BLAS test routine (version 3.7.0) -- +* -- Reference BLAS test routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* April 2012 * * ===================================================================== * @@ -48,20 +46,26 @@ PROGRAM SBLAT1 INTEGER NOUT PARAMETER (NOUT=6) * .. Scalars in Common .. + INTEGER NTESTS, NFAILS + CHARACTER*6 SUBNAM INTEGER ICASE, INCX, INCY, N LOGICAL PASS * .. Local Scalars .. + REAL S1, S2 REAL SFAC INTEGER IC * .. External Subroutines .. EXTERNAL CHECK0, CHECK1, CHECK2, CHECK3, HEADER * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, PASS + COMMON /CNTBLA/NTESTS, NFAILS + COMMON /NAMBLA/SUBNAM * .. Data statements .. DATA SFAC/9.765625E-4/ * .. Executable Statements .. + CALL CPU_TIME( S1 ) WRITE (NOUT,99999) - DO 20 IC = 1, 13 + DO 20 IC = 1, 14 ICASE = IC CALL HEADER * @@ -71,6 +75,8 @@ PROGRAM SBLAT1 * .. these parameters .. * PASS = .TRUE. + NTESTS = 0 + NFAILS = 0 INCX = 9999 INCY = 9999 IF (ICASE.EQ.3 .OR. ICASE.EQ.11) THEN @@ -79,30 +85,42 @@ PROGRAM SBLAT1 + ICASE.EQ.10) THEN CALL CHECK1(SFAC) ELSE IF (ICASE.EQ.1 .OR. ICASE.EQ.2 .OR. ICASE.EQ.5 .OR. - + ICASE.EQ.6 .OR. ICASE.EQ.12 .OR. ICASE.EQ.13) THEN + + ICASE.EQ.6 .OR. ICASE.EQ.12 .OR. ICASE.EQ.13 .OR. + + ICASE.EQ.14 ) THEN CALL CHECK2(SFAC) ELSE IF (ICASE.EQ.4) THEN CALL CHECK3(SFAC) END IF * -- Print IF (PASS) WRITE (NOUT,99998) + WRITE (NOUT,99997) SUBNAM, NTESTS, NFAILS 20 CONTINUE + CALL CPU_TIME( S2 ) + WRITE (NOUT,99996) S2 - S1 STOP * 99999 FORMAT (' Real BLAS Test Program Results',/1X) 99998 FORMAT (' ----- PASS -----') +99997 FORMAT (1X,A6,' COMPUTATIONAL TESTS:',I9,' RUN,',I9, + + ' FAILED') +99996 FORMAT (' Total time used = ',F12.2,' seconds',/) +* +* End of SBLAT1 +* END SUBROUTINE HEADER * .. Parameters .. INTEGER NOUT PARAMETER (NOUT=6) * .. Scalars in Common .. + CHARACTER*6 SUBNAM INTEGER ICASE, INCX, INCY, N LOGICAL PASS * .. Local Arrays .. - CHARACTER*6 L(13) + CHARACTER*6 L(14) * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, PASS + COMMON /NAMBLA/SUBNAM * .. Data statements .. DATA L(1)/' SDOT '/ DATA L(2)/'SAXPY '/ @@ -117,11 +135,17 @@ SUBROUTINE HEADER DATA L(11)/'SROTMG'/ DATA L(12)/'SROTM '/ DATA L(13)/'SDSDOT'/ + DATA L(14)/'SAXPBY'/ + * .. Executable Statements .. + SUBNAM = L(ICASE) WRITE (NOUT,99999) ICASE, L(ICASE) RETURN * 99999 FORMAT (/' Test of subprogram number',I3,12X,A6) +* +* End of HEADER +* END SUBROUTINE CHECK0(SFAC) * .. Parameters .. @@ -139,7 +163,7 @@ SUBROUTINE CHECK0(SFAC) REAL DA1(8), DATRUE(8), DB1(8), DBTRUE(8), DC1(8), + DS1(8), DAB(4,9), DTEMP(9), DTRUE(9,9) * .. External Subroutines .. - EXTERNAL SROTG, SROTMG, STEST1 + EXTERNAL SROTG, SROTMG, STEST, STEST1 * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, PASS * .. Data statements .. @@ -164,7 +188,7 @@ SUBROUTINE CHECK0(SFAC) E 4.E10, 2.E-2, 1.E-5, 10.E0, F 2.E-10, 4.E-2, 1.E5, 10.E0, G 2.E10, 4.E-2, 1.E-5, 10.E0, - H 4.E0, -2.E0, 8.E0, 4.E0 / + H 4.E-9, 2.E-9, 2.E0, 1.E0/ * TRUE RESULTS FOR MODIFIED GIVENS DATA DTRUE/0.E0,0.E0, 1.3E0, .2E0, 0.E0,0.E0,0.E0, .5E0, 0.E0, A 0.E0,0.E0, 4.5E0, 4.2E0, 1.E0, .5E0, 0.E0,0.E0,0.E0, @@ -199,8 +223,15 @@ SUBROUTINE CHECK0(SFAC) DTRUE(9,7) = 1.E4 / D12 DTRUE(1,8) = DTRUE(1,7) DTRUE(2,8) = 2.E10 / (1.5E0 * D12 * D12) - DTRUE(1,9) = 32.E0 / 7.E0 - DTRUE(2,9) = -16.E0 / 7.E0 + DTRUE(1,9) = 5.9652323555555560E-02 + DTRUE(2,9) = 2.9826161777777780E-02 + DTRUE(3,9) = 5.4931640625000000E-04 + DTRUE(4,9) = 1.E0 + DTRUE(5,9) = -1.E0 + DTRUE(6,9) = 2.4414062500000000E-04 + DTRUE(7,9) = -1.2207031250000000E-04 + DTRUE(8,9) = 6.1035156250000000E-05 + DTRUE(9,9) = 2.4414062500000000E-04 * .. Executable Statements .. * * Compute true values which cannot be prestored @@ -210,7 +241,7 @@ SUBROUTINE CHECK0(SFAC) DBTRUE(3) = -1.0E0/0.6E0 DBTRUE(5) = 1.0E0/0.6E0 * - DO 20 K = 1, 8 + DO 20 K = 1, 9 * .. Set N=K for identification in output if any .. N = K IF (ICASE.EQ.3) THEN @@ -238,28 +269,33 @@ SUBROUTINE CHECK0(SFAC) END IF 20 CONTINUE 40 RETURN +* +* End of CHECK0 +* END SUBROUTINE CHECK1(SFAC) * .. Parameters .. INTEGER NOUT - PARAMETER (NOUT=6) + REAL THRESH + PARAMETER (NOUT=6, THRESH=10.0E0) * .. Scalar Arguments .. REAL SFAC * .. Scalars in Common .. INTEGER ICASE, INCX, INCY, N LOGICAL PASS * .. Local Scalars .. - INTEGER I, LEN, NP1 + INTEGER I, IX, LEN, NP1 * .. Local Arrays .. REAL DTRUE1(5), DTRUE3(5), DTRUE5(8,5,2), DV(8,5,2), - + SA(10), STEMP(1), STRUE(8), SX(8) - INTEGER ITRUE2(5) + + DVR(8), SA(10), STEMP(1), STRUE(8), SX(8), + + SXR(15) + INTEGER ITRUE2(5), ITRUEC(5) * .. External Functions .. REAL SASUM, SNRM2 INTEGER ISAMAX EXTERNAL SASUM, SNRM2, ISAMAX * .. External Subroutines .. - EXTERNAL ITEST1, SSCAL, STEST, STEST1 + EXTERNAL ITEST1, SB1NRM2, SSCAL, STEST, STEST1 * .. Intrinsic Functions .. INTRINSIC MAX * .. Common blocks .. @@ -280,6 +316,8 @@ SUBROUTINE CHECK1(SFAC) + 0.2E0, 3.0E0, -0.6E0, 5.0E0, 0.3E0, 2.0E0, + 2.0E0, 2.0E0, 0.1E0, 4.0E0, -0.3E0, 6.0E0, + -0.5E0, 7.0E0, -0.1E0, 3.0E0/ + DATA DVR/8.0E0, -7.0E0, 9.0E0, 5.0E0, 9.0E0, 8.0E0, + + 7.0E0, 7.0E0/ DATA DTRUE1/0.0E0, 0.3E0, 0.5E0, 0.7E0, 0.6E0/ DATA DTRUE3/0.0E0, 0.3E0, 0.7E0, 1.1E0, 1.0E0/ DATA DTRUE5/0.10E0, 2.0E0, 2.0E0, 2.0E0, 2.0E0, @@ -297,6 +335,7 @@ SUBROUTINE CHECK1(SFAC) + 0.03E0, 4.0E0, -0.09E0, 6.0E0, -0.15E0, 7.0E0, + -0.03E0, 3.0E0/ DATA ITRUE2/0, 1, 2, 2, 3/ + DATA ITRUEC/0, 1, 1, 1, 1/ * .. Executable Statements .. DO 80 INCX = 1, 2 DO 60 NP1 = 1, 5 @@ -309,6 +348,10 @@ SUBROUTINE CHECK1(SFAC) * IF (ICASE.EQ.7) THEN * .. SNRM2 .. +* Test scaling when some entries are tiny or huge + CALL SB1NRM2(N,(INCX-2)*2,THRESH) + CALL SB1NRM2(N,INCX,THRESH) +* Test with hardcoded mid range entries STEMP(1) = DTRUE1(NP1) CALL STEST1(SNRM2(N,SX,INCX),STEMP(1),STEMP,SFAC) ELSE IF (ICASE.EQ.8) THEN @@ -325,13 +368,29 @@ SUBROUTINE CHECK1(SFAC) ELSE IF (ICASE.EQ.10) THEN * .. ISAMAX .. CALL ITEST1(ISAMAX(N,SX,INCX),ITRUE2(NP1)) + DO 100 I = 1, LEN + SX(I) = 42.0E0 + 100 CONTINUE + CALL ITEST1(ISAMAX(N,SX,INCX),ITRUEC(NP1)) ELSE WRITE (NOUT,*) ' Shouldn''t be here in CHECK1' STOP END IF 60 CONTINUE + IF (ICASE.EQ.10) THEN + N = 8 + IX = 1 + DO 120 I = 1, N + SXR(IX) = DVR(I) + IX = IX + INCX + 120 CONTINUE + CALL ITEST1(ISAMAX(N,SXR,INCX),3) + END IF 80 CONTINUE RETURN +* +* End of CHECK1 +* END SUBROUTINE CHECK2(SFAC) * .. Parameters .. @@ -343,9 +402,9 @@ SUBROUTINE CHECK2(SFAC) INTEGER ICASE, INCX, INCY, N LOGICAL PASS * .. Local Scalars .. - REAL SA + REAL SA,SB INTEGER I, J, KI, KN, KNI, KPAR, KSIZE, LENX, LENY, - $ MX, MY + $ LINCX, LINCY, MX, MY * .. Local Arrays .. REAL DT10X(7,4,4), DT10Y(7,4,4), DT7(4,4), $ DT8(7,4,4), DX1(7), @@ -355,13 +414,13 @@ SUBROUTINE CHECK2(SFAC) $ DT19XB(7,4,4), DT19XC(7,4,4),DT19XD(7,4,4), $ DT19Y(7,4,16), DT19YA(7,4,4),DT19YB(7,4,4), $ DT19YC(7,4,4), DT19YD(7,4,4), DTEMP(5), - $ ST7B(4,4) + $ ST7B(4,4), STY0(1), SX0(1), SY0(1), DT20(7,4,4) INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4) * .. External Functions .. REAL SDOT, SDSDOT EXTERNAL SDOT, SDSDOT * .. External Subroutines .. - EXTERNAL SAXPY, SCOPY, SROTM, SSWAP, STEST, STEST1 + EXTERNAL SAXPY, SAXPBY,SCOPY, SROTM, SSWAP, STEST, STEST1 * .. Intrinsic Functions .. INTRINSIC ABS, MIN * .. Common blocks .. @@ -375,6 +434,7 @@ SUBROUTINE CHECK2(SFAC) B (DT19Y(1,1,13),DT19YD(1,1,1)) DATA SA/0.3E0/ + DATA SB/0.5E0/ DATA INCXS/1, 2, -2, -1/ DATA INCYS/1, -2, 1, -2/ DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/ @@ -593,6 +653,27 @@ SUBROUTINE CHECK2(SFAC) M .7E0, -.9E0, 1.2E0, .7E0, -1.5E0, .2E0, 1.6E0, N 1.7E0, -.9E0, .5E0, .7E0, -1.6E0, .2E0, 2.4E0, O -2.6E0, -.9E0, -1.3E0, .7E0, 2.9E0, .2E0, -4.0E0 / + DATA DT20/0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, + + 0.0E0, 0.43E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, + + 0.0E0, 0.0E0, 0.43E0, -0.42E0, 0.0E0, 0.0E0, + + 0.0E0, 0.0E0, 0.0E0, 0.43E0, -0.42E0, 0.0E0, + + 0.59E0, 0.0E0, 0.0E0, 0.0E0, 0.5E0, 0.0E0, + + 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.43E0, + + 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, + + 0.1E0, -0.9E0, 0.33E0, 0.0E0, 0.0E0, 0.0E0, + + 0.0E0, 0.13E0, -0.9E0, 0.42E0, 0.7E0, -0.45E0, + + 0.2E0, 0.58E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0, + + 0.0E0, 0.0E0, 0.0E0, 0.43E0, 0.0E0, 0.0E0, + + 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.1E0, -0.27E0, + + 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.13E0, + + -0.18E0, 0.00E0, 0.53E0, 0.0E0, 0.0E0, 0.0E0, + + 0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, + + 0.43E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, + + 0.0E0, 0.43E0, -0.9E0, 0.18E0, 0.0E0, 0.0E0, + + 0.0E0, 0.0E0, 0.43E0, -0.9E0, 0.18E0, 0.7E0, + + -0.45E0, 0.2E0, 0.64E0/ + + * * .. Executable Statements .. * @@ -624,6 +705,14 @@ SUBROUTINE CHECK2(SFAC) STY(J) = DT8(J,KN,KI) 40 CONTINUE CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC) + ELSE IF (ICASE.EQ.14) THEN +* .. SAXPBY .. + CALL SAXPBY(N,SA,SX,INCX,SB,SY,INCY) + DO 50 J = 1, LENY + STY(J) = DT20(J,KN,KI) + 50 CONTINUE + CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC) + ELSE IF (ICASE.EQ.5) THEN * .. SCOPY .. DO 60 I = 1, 7 @@ -631,6 +720,23 @@ SUBROUTINE CHECK2(SFAC) 60 CONTINUE CALL SCOPY(N,SX,INCX,SY,INCY) CALL STEST(LENY,SY,STY,SSIZE2(1,1),1.0E0) + IF (KI.EQ.1) THEN + SX0(1) = 42.0E0 + SY0(1) = 43.0E0 + IF (N.EQ.0) THEN + STY0(1) = SY0(1) + ELSE + STY0(1) = SX0(1) + END IF + LINCX = INCX + INCX = 0 + LINCY = INCY + INCY = 0 + CALL SCOPY(N,SX0,INCX,SY0,INCY) + CALL STEST(1,SY0,STY0,SSIZE2(1,1),1.0E0) + INCX = LINCX + INCY = LINCY + END IF ELSE IF (ICASE.EQ.6) THEN * .. SSWAP .. CALL SSWAP(N,SX,INCX,SY,INCY) @@ -680,6 +786,9 @@ SUBROUTINE CHECK2(SFAC) 100 CONTINUE 120 CONTINUE RETURN +* +* End of CHECK2 +* END SUBROUTINE CHECK3(SFAC) * .. Parameters .. @@ -831,26 +940,26 @@ SUBROUTINE CHECK3(SFAC) MWPN(5) = 3 MWPN(10) = 3 DO 160 I = 1, 5 - MWPX(I) = I - MWPY(I) = I - MWPTX(1,I) = I - MWPTY(1,I) = I - MWPTX(2,I) = I - MWPTY(2,I) = -I - MWPTX(3,I) = 6 - I - MWPTY(3,I) = I - 6 - MWPTX(4,I) = I - MWPTY(4,I) = -I - MWPTX(6,I) = 6 - I - MWPTY(6,I) = I - 6 - MWPTX(7,I) = -I - MWPTY(7,I) = I - MWPTX(8,I) = I - 6 - MWPTY(8,I) = 6 - I - MWPTX(9,I) = -I - MWPTY(9,I) = I - MWPTX(11,I) = I - 6 - MWPTY(11,I) = 6 - I + MWPX(I) = REAL( I ) + MWPY(I) = REAL( I ) + MWPTX(1,I) = REAL( I ) + MWPTY(1,I) = REAL( I ) + MWPTX(2,I) = REAL( I ) + MWPTY(2,I) = REAL( -I ) + MWPTX(3,I) = REAL( 6 - I ) + MWPTY(3,I) = REAL( I - 6 ) + MWPTX(4,I) = REAL( I ) + MWPTY(4,I) = REAL( -I ) + MWPTX(6,I) = REAL( 6 - I ) + MWPTY(6,I) = REAL( I - 6 ) + MWPTX(7,I) = REAL( -I ) + MWPTY(7,I) = REAL( I ) + MWPTX(8,I) = REAL( I - 6 ) + MWPTY(8,I) = REAL( 6 - I ) + MWPTX(9,I) = REAL( -I ) + MWPTY(9,I) = REAL( I ) + MWPTX(11,I) = REAL( I - 6 ) + MWPTY(11,I) = REAL( 6 - I ) 160 CONTINUE MWPTX(5,1) = 1 MWPTX(5,2) = 3 @@ -886,6 +995,9 @@ SUBROUTINE CHECK3(SFAC) CALL STEST(5,COPYY,MWPSTY,MWPSTY,SFAC) 200 CONTINUE RETURN +* +* End of CHECK3 +* END SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC) * ********************************* STEST ************************** @@ -906,6 +1018,7 @@ SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC) * .. Array Arguments .. REAL SCOMP(LEN), SSIZE(LEN), STRUE(LEN) * .. Scalars in Common .. + INTEGER NTESTS, NFAILS INTEGER ICASE, INCX, INCY, N LOGICAL PASS * .. Local Scalars .. @@ -918,12 +1031,15 @@ SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC) INTRINSIC ABS * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, PASS + COMMON /CNTBLA/NTESTS, NFAILS * .. Executable Statements .. * DO 40 I = 1, LEN + NTESTS = NTESTS + 1 SD = SCOMP(I) - STRUE(I) IF (ABS(SFAC*SD) .LE. ABS(SSIZE(I))*EPSILON(ZERO)) + GO TO 40 + NFAILS = NFAILS + 1 * * HERE SCOMP(I) IS NOT CLOSE TO STRUE(I). * @@ -942,11 +1058,14 @@ SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC) + ' COMP(I) TRUE(I) DIFFERENCE', + ' SIZE(I)',/1X) 99997 FORMAT (1X,I4,I3,2I5,I3,2E36.8,2E12.4) +* +* End of STEST +* END SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC) * ************************* STEST1 ***************************** * -* THIS IS AN INTERFACE SUBROUTINE TO ACCOMODATE THE FORTRAN +* THIS IS AN INTERFACE SUBROUTINE TO ACCOMMODATE THE FORTRAN * REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE * ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT. * @@ -967,6 +1086,9 @@ SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC) CALL STEST(1,SCOMP,STRUE,SSIZE,SFAC) * RETURN +* +* End of STEST1 +* END REAL FUNCTION SDIFF(SA,SB) * ********************************* SDIFF ************************** @@ -977,6 +1099,9 @@ REAL FUNCTION SDIFF(SA,SB) * .. Executable Statements .. SDIFF = SA - SB RETURN +* +* End of SDIFF +* END SUBROUTINE ITEST1(ICOMP,ITRUE) * ********************************* ITEST1 ************************* @@ -991,15 +1116,19 @@ SUBROUTINE ITEST1(ICOMP,ITRUE) * .. Scalar Arguments .. INTEGER ICOMP, ITRUE * .. Scalars in Common .. + INTEGER NTESTS, NFAILS INTEGER ICASE, INCX, INCY, N LOGICAL PASS * .. Local Scalars .. INTEGER ID * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, PASS + COMMON /CNTBLA/NTESTS, NFAILS * .. Executable Statements .. * + NTESTS = NTESTS + 1 IF (ICOMP.EQ.ITRUE) GO TO 40 + NFAILS = NFAILS + 1 * * HERE ICOMP IS NOT EQUAL TO ITRUE. * @@ -1018,4 +1147,228 @@ SUBROUTINE ITEST1(ICOMP,ITRUE) + ' COMP TRUE DIFFERENCE', + /1X) 99997 FORMAT (1X,I4,I3,2I5,2I36,I12) +* +* End of ITEST1 +* + END + SUBROUTINE SB1NRM2(N,INCX,THRESH) +* Compare NRM2 with a reference computation using combinations +* of the following values: +* +* 0, very small, small, ulp, 1, 1/ulp, big, very big, infinity, NaN +* +* one of these values is used to initialize x(1) and x(2:N) is +* filled with random values from [-1,1] scaled by another of +* these values. +* +* This routine is adapted from the test suite provided by +* Anderson E. (2017) +* Algorithm 978: Safe Scaling in the Level 1 BLAS +* ACM Trans Math Softw 44:1--28 +* https://doi.org/10.1145/3061665 +* + IMPLICIT NONE +* .. Scalar Arguments .. + INTEGER INCX, N + REAL THRESH +* +* ===================================================================== +* .. Parameters .. + INTEGER NMAX, NOUT, NV + PARAMETER (NMAX=20, NOUT=6, NV=10) + REAL HALF, ONE, TWO, ZERO + PARAMETER (HALF=0.5E+0, ONE=1.0E+0, TWO= 2.0E+0, + & ZERO=0.0E+0) +* .. External Functions .. + REAL SNRM2 + EXTERNAL SNRM2 +* .. Intrinsic Functions .. + INTRINSIC ABS, MAX, MIN, REAL, SQRT +* .. Model parameters .. + REAL BIGNUM, SAFMAX, SAFMIN, SMLNUM, ULP + PARAMETER (BIGNUM=0.1014120480E+32, + & SAFMAX=0.8507059173E+38, + & SAFMIN=0.1175494351E-37, + & SMLNUM=0.9860761315E-31, + & ULP=0.1192092896E-06) +* .. Local Scalars .. + REAL ROGUE, SNRM, TRAT, V0, V1, WORKSSQ, Y1, Y2, + & YMAX, YMIN, YNRM, ZNRM + INTEGER I, IV, IW, IX + LOGICAL FIRST +* .. Local Arrays .. + REAL VALUES(NV), WORK(NMAX), X(NMAX), Z(NMAX) +* .. Scalars in Common .. + INTEGER NTESTS, NFAILS +* .. Common blocks .. + COMMON /CNTBLA/NTESTS, NFAILS +* .. Executable Statements .. + VALUES(1) = ZERO + VALUES(2) = TWO*SAFMIN + VALUES(3) = SMLNUM + VALUES(4) = ULP + VALUES(5) = ONE + VALUES(6) = ONE / ULP + VALUES(7) = BIGNUM + VALUES(8) = SAFMAX + VALUES(9) = SXVALS(V0,2) + VALUES(10) = SXVALS(V0,3) + ROGUE = -1234.5678E+0 + FIRST = .TRUE. +* +* Check that the arrays are large enough +* + IF (N*ABS(INCX).GT.NMAX) THEN + WRITE (NOUT,99) "SNRM2", NMAX, INCX, N, N*ABS(INCX) + RETURN + END IF +* +* Zero-sized inputs are tested in STEST1. + IF (N.LE.0) THEN + RETURN + END IF +* +* Generate (N-1) values in (-1,1). +* + DO I = 2, N + CALL RANDOM_NUMBER(WORK(I)) + WORK(I) = ONE - TWO*WORK(I) + END DO +* +* Compute the sum of squares of the random values +* by an unscaled algorithm. +* + WORKSSQ = ZERO + DO I = 2, N + WORKSSQ = WORKSSQ + WORK(I)*WORK(I) + END DO +* +* Construct the test vector with one known value +* and the rest from the random work array multiplied +* by a scaling factor. +* + DO IV = 1, NV + V0 = VALUES(IV) + IF (ABS(V0).GT.ONE) THEN + V0 = V0*HALF + END IF + Z(1) = V0 + DO IW = 1, NV + V1 = VALUES(IW) + IF (ABS(V1).GT.ONE) THEN + V1 = (V1*HALF) / SQRT(REAL(N)) + END IF + DO I = 2, N + Z(I) = V1*WORK(I) + END DO +* +* Compute the expected value of the 2-norm +* + Y1 = ABS(V0) + IF (N.GT.1) THEN + Y2 = ABS(V1)*SQRT(WORKSSQ) + ELSE + Y2 = ZERO + END IF + YMIN = MIN(Y1, Y2) + YMAX = MAX(Y1, Y2) +* +* Expected value is NaN if either is NaN. The test +* for YMIN == YMAX avoids further computation if both +* are infinity. +* + IF ((Y1.NE.Y1).OR.(Y2.NE.Y2)) THEN +* add to propagate NaN + YNRM = Y1 + Y2 + ELSE IF (YMIN == YMAX) THEN + YNRM = SQRT(TWO)*YMAX + ELSE IF (YMAX == ZERO) THEN + YNRM = ZERO + ELSE + YNRM = YMAX*SQRT(ONE + (YMIN / YMAX)**2) + END IF +* +* Fill the input array to SNRM2 with steps of incx +* + DO I = 1, N + X(I) = ROGUE + END DO + IX = 1 + IF (INCX.LT.0) IX = 1 - (N-1)*INCX + DO I = 1, N + X(IX) = Z(I) + IX = IX + INCX + END DO +* +* Call SNRM2 to compute the 2-norm +* + SNRM = SNRM2(N,X,INCX) +* +* Compare SNRM and ZNRM. Roundoff error grows like O(n) +* in this implementation so we scale the test ratio accordingly. +* + IF (INCX.EQ.0) THEN + ZNRM = SQRT(REAL(N))*ABS(X(1)) + ELSE + ZNRM = YNRM + END IF +* +* The tests for NaN rely on the compiler not being overly +* aggressive and removing the statements altogether. + IF ((SNRM.NE.SNRM).OR.(ZNRM.NE.ZNRM)) THEN + IF ((SNRM.NE.SNRM).NEQV.(ZNRM.NE.ZNRM)) THEN + TRAT = ONE / ULP + ELSE + TRAT = ZERO + END IF + ELSE IF (SNRM == ZNRM) THEN + TRAT = ZERO + ELSE IF (ZNRM == ZERO) THEN + TRAT = SNRM / ULP + ELSE + TRAT = (ABS(SNRM-ZNRM) / ZNRM) / (REAL(N)*ULP) + END IF + NTESTS = NTESTS + 1 + IF ((TRAT.NE.TRAT).OR.(TRAT.GE.THRESH)) THEN + NFAILS = NFAILS + 1 + IF (FIRST) THEN + FIRST = .FALSE. + WRITE(NOUT,99999) + END IF + WRITE (NOUT,98) "SNRM2", N, INCX, IV, IW, TRAT + END IF + END DO + END DO +99999 FORMAT (' FAIL') + 99 FORMAT ( ' Not enough space to test ', A6, ': NMAX = ',I6, + + ', INCX = ',I6,/,' N = ',I6,', must be at least ',I6 ) + 98 FORMAT( 1X, A6, ': N=', I6,', INCX=', I4, ', IV=', I2, ', IW=', + + I2, ', test=', E15.8 ) + RETURN + CONTAINS + REAL FUNCTION SXVALS(XX,K) +* .. Scalar Arguments .. + REAL XX + INTEGER K +* .. Parameters .. + REAL ZERO + PARAMETER (ZERO=0.0E+0) +* .. Local Scalars .. + REAL X, Y, Z +* .. Intrinsic Functions .. + INTRINSIC HUGE +* .. Executable Statements .. + X = ZERO + Y = HUGE(XX) + Z = Y*Y + IF (K.EQ.1) THEN + X = -Z + ELSE IF (K.EQ.2) THEN + X = Z + ELSE IF (K.EQ.3) THEN + X = Z / Z + END IF + SXVALS = X + RETURN + END END diff --git a/BLAS/TESTING/sblat2.f b/BLAS/TESTING/sblat2.f index 56ead8640d..22483a1910 100644 --- a/BLAS/TESTING/sblat2.f +++ b/BLAS/TESTING/sblat2.f @@ -20,7 +20,7 @@ *> *> The program must be driven by a short data file. The first 18 records *> of the file are read using list-directed input, the last 16 records -*> are read using the format ( A6, L2 ). An annotated example of a data +*> are read using the format ( A10, L2 ). An annotated example of a data *> file can be obtained by deleting the first 3 characters from the *> following 34 lines: *> 'sblat2.out' NAME OF SUMMARY OUTPUT FILE @@ -57,6 +57,8 @@ *> SSPR T PUT F FOR NO TEST. SAME COLUMNS. *> SSYR2 T PUT F FOR NO TEST. SAME COLUMNS. *> SSPR2 T PUT F FOR NO TEST. SAME COLUMNS. +*> SSKEWSYMV T PUT F FOR NO TEST. SAME COLUMNS. +*> SSKEWSYR T PUT F FOR NO TEST. SAME COLUMNS. *> *> Further Details *> =============== @@ -95,17 +97,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date April 2012 -* *> \ingroup single_blas_testing * * ===================================================================== PROGRAM SBLAT2 + IMPLICIT NONE * -* -- Reference BLAS test routine (version 3.7.0) -- +* -- Reference BLAS test routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* April 2012 * * ===================================================================== * @@ -113,7 +113,7 @@ PROGRAM SBLAT2 INTEGER NIN PARAMETER ( NIN = 5 ) INTEGER NSUBS - PARAMETER ( NSUBS = 16 ) + PARAMETER ( NSUBS = 18 ) REAL ZERO, ONE PARAMETER ( ZERO = 0.0, ONE = 1.0 ) INTEGER NMAX, INCMAX @@ -122,13 +122,14 @@ PROGRAM SBLAT2 PARAMETER ( NINMAX = 7, NIDMAX = 9, NKBMAX = 7, $ NALMAX = 7, NBEMAX = 7 ) * .. Local Scalars .. + REAL S1, S2 REAL EPS, ERR, THRESH INTEGER I, ISNUM, J, N, NALF, NBET, NIDIM, NINC, NKB, $ NOUT, NTRA LOGICAL FATAL, LTESTT, REWI, SAME, SFATAL, TRACE, $ TSTERR CHARACTER*1 TRANS - CHARACTER*6 SNAMET + CHARACTER*10 SNAMET CHARACTER*32 SNAPS, SUMMRY * .. Local Arrays .. REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), @@ -139,7 +140,7 @@ PROGRAM SBLAT2 $ YY( NMAX*INCMAX ), Z( 2*NMAX ) INTEGER IDIM( NIDMAX ), INC( NINMAX ), KB( NKBMAX ) LOGICAL LTEST( NSUBS ) - CHARACTER*6 SNAMES( NSUBS ) + CHARACTER*10 SNAMES( NSUBS ) * .. External Functions .. REAL SDIFF LOGICAL LSE @@ -152,16 +153,22 @@ PROGRAM SBLAT2 * .. Scalars in Common .. INTEGER INFOT, NOUTC LOGICAL LERR, OK - CHARACTER*6 SRNAMT + CHARACTER*10 SRNAMT * .. Common blocks .. COMMON /INFOC/INFOT, NOUTC, OK, LERR COMMON /SRNAMC/SRNAMT * .. Data statements .. - DATA SNAMES/'SGEMV ', 'SGBMV ', 'SSYMV ', 'SSBMV ', - $ 'SSPMV ', 'STRMV ', 'STBMV ', 'STPMV ', - $ 'STRSV ', 'STBSV ', 'STPSV ', 'SGER ', - $ 'SSYR ', 'SSPR ', 'SSYR2 ', 'SSPR2 '/ + DATA SNAMES/'SGEMV ', 'SGBMV ', + $ 'SSYMV ', 'SSBMV ', + $ 'SSPMV ', 'STRMV ', + $ 'STBMV ', 'STPMV ', + $ 'STRSV ', 'STBSV ', + $ 'STPSV ', 'SGER ', + $ 'SSYR ', 'SSPR ', + $ 'SSYR2 ', 'SSPR2 ', + $ 'SSKEWSYMV ', 'SSKEWSYR2 '/ * .. Executable Statements .. + CALL CPU_TIME( S1 ) * * Read name and unit number for summary output file and open file. * @@ -289,13 +296,14 @@ PROGRAM SBLAT2 N = MIN( 32, NMAX ) DO 120 J = 1, N DO 110 I = 1, N - A( I, J ) = MAX( I - J + 1, 0 ) + A( I, J ) = REAL( MAX( I - J + 1, 0 ) ) 110 CONTINUE - X( J ) = J + X( J ) = REAL( J ) Y( J ) = ZERO 120 CONTINUE DO 130 J = 1, N - YY( J ) = J*( ( J + 1 )*J )/2 - ( ( J + 1 )*J*( J - 1 ) )/3 + YY( J ) = REAL( J*( ( J + 1 )*J )/2 - + $ ( ( J + 1 )*J*( J - 1 ) )/3 ) 130 CONTINUE * YY holds the exact result. On exit from SMVCH YT holds * the result computed by SMVCH. @@ -336,14 +344,14 @@ PROGRAM SBLAT2 FATAL = .FALSE. GO TO ( 140, 140, 150, 150, 150, 160, 160, $ 160, 160, 160, 160, 170, 180, 180, - $ 190, 190 )ISNUM + $ 190, 190, 150, 190 )ISNUM * Test SGEMV, 01, and SGBMV, 02. 140 CALL SCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, $ NBET, BET, NINC, INC, NMAX, INCMAX, A, AA, AS, $ X, XX, XS, Y, YY, YS, YT, G ) GO TO 200 -* Test SSYMV, 03, SSBMV, 04, and SSPMV, 05. +* Test SSYMV, 03, SSBMV, 04, SSPMV, 05, and SSKEWSYMV, 17. 150 CALL SCHK2( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, $ NBET, BET, NINC, INC, NMAX, INCMAX, A, AA, AS, @@ -367,7 +375,7 @@ PROGRAM SBLAT2 $ NMAX, INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, $ YT, G, Z ) GO TO 200 -* Test SSYR2, 15, and SSPR2, 16. +* Test SSYR2, 15, SSPR2, 16, and SSKEWSYR2, 18. 190 CALL SCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, $ NMAX, INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, @@ -390,6 +398,8 @@ PROGRAM SBLAT2 240 CONTINUE IF( TRACE ) $ CLOSE ( NTRA ) + CALL CPU_TIME( S2 ) + WRITE( NOUT, FMT = 9979 )S2 - S1 CLOSE ( NOUT ) STOP * @@ -411,26 +421,28 @@ PROGRAM SBLAT2 9988 FORMAT( ' FOR BETA ', 7F6.1 ) 9987 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM', $ /' ******* TESTS ABANDONED *******' ) - 9986 FORMAT( ' SUBPROGRAM NAME ', A6, ' NOT RECOGNIZED', /' ******* T', - $ 'ESTS ABANDONED *******' ) + 9986 FORMAT( ' SUBPROGRAM NAME ', A10, ' NOT RECOGNIZED', /' ******* ', + $ 'TESTS ABANDONED *******' ) 9985 FORMAT( ' ERROR IN SMVCH - IN-LINE DOT PRODUCTS ARE BEING EVALU', $ 'ATED WRONGLY.', /' SMVCH WAS CALLED WITH TRANS = ', A1, $ ' AND RETURNED SAME = ', L1, ' AND ERR = ', F12.3, '.', / $ ' THIS MAY BE DUE TO FAULTS IN THE ARITHMETIC OR THE COMPILER.' $ , /' ******* TESTS ABANDONED *******' ) - 9984 FORMAT( A6, L2 ) - 9983 FORMAT( 1X, A6, ' WAS NOT TESTED' ) + 9984 FORMAT( A10, L2 ) + 9983 FORMAT( 1X, A10, ' WAS NOT TESTED' ) 9982 FORMAT( /' END OF TESTS' ) 9981 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' ) 9980 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' ) + 9979 FORMAT( ' Total time used = ', F12.2, ' seconds', / ) * -* End of SBLAT2. +* End of SBLAT2 * END SUBROUTINE SCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, NBET, $ BET, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX, $ XS, Y, YY, YS, YT, G ) + IMPLICIT NONE * * Tests SGEMV and SGBMV. * @@ -448,7 +460,7 @@ SUBROUTINE SCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER INCMAX, NALF, NBET, NIDIM, NINC, NKB, NMAX, $ NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*10 SNAME * .. Array Arguments .. REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), BET( NBET ), G( NMAX ), @@ -459,6 +471,7 @@ SUBROUTINE SCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ), INC( NINC ), KB( NKB ) * .. Local Scalars .. REAL ALPHA, ALS, BETA, BLS, ERR, ERRMAX, TRANSL + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, IC, IKU, IM, IN, INCX, INCXS, INCY, $ INCYS, IX, IY, KL, KLS, KU, KUS, LAA, LDA, $ LDAS, LX, LY, M, ML, MS, N, NARGS, NC, ND, NK, @@ -472,7 +485,7 @@ SUBROUTINE SCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, LOGICAL LSE, LSERES EXTERNAL LSE, LSERES * .. External Subroutines .. - EXTERNAL SGBMV, SGEMV, SMAKE, SMVCH + EXTERNAL SGBMV, SGEMV, SMAKE, SMVCH, SREGR1 * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN * .. Scalars in Common .. @@ -495,6 +508,8 @@ SUBROUTINE SCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * DO 120 IN = 1, NIDIM N = IDIM( IN ) @@ -636,6 +651,8 @@ SUBROUTINE SCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9993 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 130 END IF * @@ -689,6 +706,8 @@ SUBROUTINE SCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 130 END IF * @@ -701,6 +720,9 @@ SUBROUTINE SCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ INCY, YT, G, YY, EPS, ERR, $ FATAL, NOUT, .TRUE. ) ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -727,6 +749,36 @@ SUBROUTINE SCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * 120 CONTINUE * +* Regression test to verify preservation of y when m zero, n nonzero. +* + CALL SREGR1( TRANS, M, N, LY, KL, KU, ALPHA, AA, LDA, XX, INCX, + $ BETA, YY, INCY, YS ) + IF( FULL )THEN + IF( TRACE ) + $ WRITE( NTRA, FMT = 9994 )NC, SNAME, TRANS, M, N, ALPHA, LDA, + $ INCX, BETA, INCY + IF( REWI ) + $ REWIND NTRA + CALL SGEMV( TRANS, M, N, ALPHA, AA, LDA, XX, INCX, BETA, YY, + $ INCY ) + ELSE IF( BANDED )THEN + IF( TRACE ) + $ WRITE( NTRA, FMT = 9995 )NC, SNAME, TRANS, M, N, KL, KU, + $ ALPHA, LDA, INCX, BETA, INCY + IF( REWI ) + $ REWIND NTRA + CALL SGBMV( TRANS, M, N, KL, KU, ALPHA, AA, LDA, XX, INCX, + $ BETA, YY, INCY ) + END IF + NC = NC + 1 + IF( .NOT.LSE( YS, YY, LY ) )THEN + WRITE( NOUT, FMT = 9998 )NARGS - 1 + FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 + GO TO 130 + END IF +* * Report result. * IF( ERRMAX.LT.THRESH )THEN @@ -747,33 +799,37 @@ SUBROUTINE SCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 140 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', - $ 'S)' ) + 9999 FORMAT( ' ', A10, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CAL', + $ 'LS)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', - $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, + 9997 FORMAT( ' ', A10, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' ', + $ 'CALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', 4( I3, ',' ), F4.1, + 9996 FORMAT( ' ******* ', A10, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A10, '(''', A1, ''',', 4( I3, ',' ), F4.1, $ ', A,', I3, ', X,', I2, ',', F4.1, ', Y,', I2, ') .' ) - 9994 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', 2( I3, ',' ), F4.1, + 9994 FORMAT( 1X, I6, ': ', A10, '(''', A1, ''',', 2( I3, ',' ), F4.1, $ ', A,', I3, ', X,', I2, ',', F4.1, ', Y,', I2, $ ') .' ) 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A10, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of SCHK1. +* End of SCHK1 * END SUBROUTINE SCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, NBET, $ BET, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX, $ XS, Y, YY, YS, YT, G ) + IMPLICIT NONE * -* Tests SSYMV, SSBMV and SSPMV. +* Tests SSYMV, SSKEWSYMV, SSBMV and SSPMV. * * Auxiliary routine for test program for Level 2 Blas. * @@ -789,7 +845,7 @@ SUBROUTINE SCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER INCMAX, NALF, NBET, NIDIM, NINC, NKB, NMAX, $ NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*10 SNAME * .. Array Arguments .. REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), BET( NBET ), G( NMAX ), @@ -800,10 +856,12 @@ SUBROUTINE SCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ), INC( NINC ), KB( NKB ) * .. Local Scalars .. REAL ALPHA, ALS, BETA, BLS, ERR, ERRMAX, TRANSL + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, IC, IK, IN, INCX, INCXS, INCY, $ INCYS, IX, IY, K, KS, LAA, LDA, LDAS, LX, LY, $ N, NARGS, NC, NK, NS - LOGICAL BANDED, FULL, NULL, PACKED, RESET, SAME + LOGICAL BANDED, FULL, NULL, PACKED, RESET, SAME, + $ SKEWFULL CHARACTER*1 UPLO, UPLOS CHARACTER*2 ICH * .. Local Arrays .. @@ -812,7 +870,7 @@ SUBROUTINE SCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, LOGICAL LSE, LSERES EXTERNAL LSE, LSERES * .. External Subroutines .. - EXTERNAL SMAKE, SMVCH, SSBMV, SSPMV, SSYMV + EXTERNAL SMAKE, SMVCH, SSBMV, SSPMV, SSYMV, SSKEWSYMV * .. Intrinsic Functions .. INTRINSIC ABS, MAX * .. Scalars in Common .. @@ -826,8 +884,9 @@ SUBROUTINE SCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, FULL = SNAME( 3: 3 ).EQ.'Y' BANDED = SNAME( 3: 3 ).EQ.'B' PACKED = SNAME( 3: 3 ).EQ.'P' + SKEWFULL = SNAME( 2: 5 ).EQ.'SKEW' * Define the number of arguments. - IF( FULL )THEN + IF( FULL.OR.SKEWFULL )THEN NARGS = 10 ELSE IF( BANDED )THEN NARGS = 11 @@ -838,6 +897,8 @@ SUBROUTINE SCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * DO 110 IN = 1, NIDIM N = IDIM( IN ) @@ -944,6 +1005,14 @@ SUBROUTINE SCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ REWIND NTRA CALL SSYMV( UPLO, N, ALPHA, AA, LDA, XX, $ INCX, BETA, YY, INCY ) + ELSE IF( SKEWFULL )THEN + IF( TRACE ) + $ WRITE( NTRA, FMT = 9993 )NC, SNAME, + $ UPLO, N, ALPHA, LDA, INCX, BETA, INCY + IF( REWI ) + $ REWIND NTRA + CALL SSKEWSYMV( UPLO, N, ALPHA, AA, LDA, + $ XX, INCX, BETA, YY, INCY ) ELSE IF( BANDED )THEN IF( TRACE ) $ WRITE( NTRA, FMT = 9994 )NC, SNAME, @@ -968,6 +1037,8 @@ SUBROUTINE SCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -975,7 +1046,7 @@ SUBROUTINE SCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * ISAME( 1 ) = UPLO.EQ.UPLOS ISAME( 2 ) = NS.EQ.N - IF( FULL )THEN + IF( FULL.OR.SKEWFULL )THEN ISAME( 3 ) = ALS.EQ.ALPHA ISAME( 4 ) = LSE( AS, AA, LAA ) ISAME( 5 ) = LDAS.EQ.LDA @@ -1030,6 +1101,8 @@ SUBROUTINE SCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1042,6 +1115,9 @@ SUBROUTINE SCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ YY, EPS, ERR, FATAL, NOUT, $ .TRUE. ) ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -1088,32 +1164,37 @@ SUBROUTINE SCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 130 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', - $ 'S)' ) + 9999 FORMAT( ' ', A10, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CAL', + $ 'LS)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', - $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, + 9997 FORMAT( ' ', A10, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' ', + $ 'CALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',', F4.1, ', AP', - $ ', X,', I2, ',', F4.1, ', Y,', I2, ') .' ) - 9994 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', 2( I3, ',' ), F4.1, + 9996 FORMAT( ' ******* ', A10, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A10, '(''', A1, ''',', I3, ',', F4.1, ', A', + $ 'P, X,', I2, ',', F4.1, ', Y,', I2, ') .' ) + 9994 FORMAT( 1X, I6, ': ', A10, '(''', A1, ''',', 2( I3, ',' ), F4.1, $ ', A,', I3, ', X,', I2, ',', F4.1, ', Y,', I2, $ ') .' ) - 9993 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',', F4.1, ', A,', - $ I3, ', X,', I2, ',', F4.1, ', Y,', I2, ') .' ) + 9993 FORMAT( 1X, I6, ': ', A10, '(''', A1, ''',', I3, ',', F4.1, ', A', + $ ',', I3, ', X,', I2, ',', F4.1, ', Y,', I2, ') ', + $ ' .' ) 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A10, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of SCHK2. +* End of SCHK2 * END SUBROUTINE SCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NKB, KB, NINC, INC, NMAX, $ INCMAX, A, AA, AS, X, XX, XS, XT, G, Z ) + IMPLICIT NONE * * Tests STRMV, STBMV, STPMV, STRSV, STBSV and STPSV. * @@ -1130,7 +1211,7 @@ SUBROUTINE SCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER INCMAX, NIDIM, NINC, NKB, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*10 SNAME * .. Array Arguments .. REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), $ AS( NMAX*NMAX ), G( NMAX ), X( NMAX ), @@ -1139,6 +1220,7 @@ SUBROUTINE SCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ), INC( NINC ), KB( NKB ) * .. Local Scalars .. REAL ERR, ERRMAX, TRANSL + INTEGER NTESTS, NFAILS INTEGER I, ICD, ICT, ICU, IK, IN, INCX, INCXS, IX, K, $ KS, LAA, LDA, LDAS, LX, N, NARGS, NC, NK, NS LOGICAL BANDED, FULL, NULL, PACKED, RESET, SAME @@ -1178,6 +1260,8 @@ SUBROUTINE SCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * Set up zero vector for SMVCH. DO 10 I = 1, NMAX Z( I ) = ZERO @@ -1324,6 +1408,8 @@ SUBROUTINE SCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1376,6 +1462,8 @@ SUBROUTINE SCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1404,6 +1492,9 @@ SUBROUTINE SCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ .FALSE. ) END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and return. IF( FATAL ) $ GO TO 120 @@ -1446,32 +1537,36 @@ SUBROUTINE SCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 130 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', - $ 'S)' ) + 9999 FORMAT( ' ', A10, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CAL', + $ 'LS)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', - $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, + 9997 FORMAT( ' ', A10, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' ', + $ 'CALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A6, '(', 3( '''', A1, ''',' ), I3, ', AP, ', - $ 'X,', I2, ') .' ) - 9994 FORMAT( 1X, I6, ': ', A6, '(', 3( '''', A1, ''',' ), 2( I3, ',' ), - $ ' A,', I3, ', X,', I2, ') .' ) - 9993 FORMAT( 1X, I6, ': ', A6, '(', 3( '''', A1, ''',' ), I3, ', A,', + 9996 FORMAT( ' ******* ', A10, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A10, '(', 3( '''', A1, ''',' ), I3, ', AP,', + $ ' X,', I2, ') .' ) + 9994 FORMAT( 1X, I6, ': ', A10, '(', 3( '''', A1, ''',' ), + $ 2( I3, ',' ), ' A,', I3, ', X,', I2, ') .' ) + 9993 FORMAT( 1X, I6, ': ', A10, '(', 3( '''', A1, ''',' ), I3, ', A,', $ I3, ', X,', I2, ') .' ) 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A10, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of SCHK3. +* End of SCHK3 * END SUBROUTINE SCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX, $ INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G, $ Z ) + IMPLICIT NONE * * Tests SGER. * @@ -1488,7 +1583,7 @@ SUBROUTINE SCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER INCMAX, NALF, NIDIM, NINC, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*10 SNAME * .. Array Arguments .. REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), G( NMAX ), X( NMAX ), @@ -1498,6 +1593,7 @@ SUBROUTINE SCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ), INC( NINC ) * .. Local Scalars .. REAL ALPHA, ALS, ERR, ERRMAX, TRANSL + INTEGER NTESTS, NFAILS INTEGER I, IA, IM, IN, INCX, INCXS, INCY, INCYS, IX, $ IY, J, LAA, LDA, LDAS, LX, LY, M, MS, N, NARGS, $ NC, ND, NS @@ -1524,6 +1620,8 @@ SUBROUTINE SCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * DO 120 IN = 1, NIDIM N = IDIM( IN ) @@ -1617,6 +1715,8 @@ SUBROUTINE SCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9993 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 140 END IF * @@ -1647,6 +1747,8 @@ SUBROUTINE SCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 140 END IF * @@ -1674,6 +1776,9 @@ SUBROUTINE SCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ AA( 1 + ( J - 1 )*LDA ), EPS, $ ERR, FATAL, NOUT, .TRUE. ) ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and return. IF( FATAL ) $ GO TO 130 @@ -1710,29 +1815,33 @@ SUBROUTINE SCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, WRITE( NOUT, FMT = 9994 )NC, SNAME, M, N, ALPHA, INCX, INCY, LDA * 150 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', - $ 'S)' ) + 9999 FORMAT( ' ', A10, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CAL', + $ 'LS)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', - $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, + 9997 FORMAT( ' ', A10, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' ', + $ 'CALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ', A10, ' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT( 1X, I6, ': ', A6, '(', 2( I3, ',' ), F4.1, ', X,', I2, + 9994 FORMAT( 1X, I6, ': ', A10, '(', 2( I3, ',' ), F4.1, ', X,', I2, $ ', Y,', I2, ', A,', I3, ') .' ) 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A10, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of SCHK4. +* End of SCHK4 * END SUBROUTINE SCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX, $ INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G, $ Z ) + IMPLICIT NONE * * Tests SSYR and SSPR. * @@ -1749,7 +1858,7 @@ SUBROUTINE SCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER INCMAX, NALF, NIDIM, NINC, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*10 SNAME * .. Array Arguments .. REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), G( NMAX ), X( NMAX ), @@ -1759,6 +1868,7 @@ SUBROUTINE SCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ), INC( NINC ) * .. Local Scalars .. REAL ALPHA, ALS, ERR, ERRMAX, TRANSL + INTEGER NTESTS, NFAILS INTEGER I, IA, IC, IN, INCX, INCXS, IX, J, JA, JJ, LAA, $ LDA, LDAS, LJ, LX, N, NARGS, NC, NS LOGICAL FULL, NULL, PACKED, RESET, SAME, UPPER @@ -1794,6 +1904,8 @@ SUBROUTINE SCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * DO 100 IN = 1, NIDIM N = IDIM( IN ) @@ -1877,6 +1989,8 @@ SUBROUTINE SCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1907,6 +2021,8 @@ SUBROUTINE SCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 30 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1947,6 +2063,9 @@ SUBROUTINE SCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, JA = JA + LJ END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and return. IF( FATAL ) $ GO TO 110 @@ -1986,33 +2105,37 @@ SUBROUTINE SCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 130 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', - $ 'S)' ) + 9999 FORMAT( ' ', A10, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CAL', + $ 'LS)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', - $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, + 9997 FORMAT( ' ', A10, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' ', + $ 'CALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ', A10, ' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',', F4.1, ', X,', - $ I2, ', AP) .' ) - 9993 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',', F4.1, ', X,', - $ I2, ', A,', I3, ') .' ) + 9994 FORMAT( 1X, I6, ': ', A10, '(''', A1, ''',', I3, ',', F4.1, ', X', + $ ',', I2, ', AP) .' ) + 9993 FORMAT( 1X, I6, ': ', A10, '(''', A1, ''',', I3, ',', F4.1, ', X', + $ ',', I2, ', A,', I3, ') .' ) 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A10, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of SCHK5. +* End of SCHK5 * END SUBROUTINE SCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX, $ INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G, $ Z ) + IMPLICIT NONE * -* Tests SSYR2 and SSPR2. +* Tests SSYR2, SSKEWSYR2 and SSPR2. * * Auxiliary routine for test program for Level 2 Blas. * @@ -2027,7 +2150,7 @@ SUBROUTINE SCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER INCMAX, NALF, NIDIM, NINC, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*10 SNAME * .. Array Arguments .. REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), G( NMAX ), X( NMAX ), @@ -2037,10 +2160,12 @@ SUBROUTINE SCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ), INC( NINC ) * .. Local Scalars .. REAL ALPHA, ALS, ERR, ERRMAX, TRANSL + INTEGER NTESTS, NFAILS INTEGER I, IA, IC, IN, INCX, INCXS, INCY, INCYS, IX, $ IY, J, JA, JJ, LAA, LDA, LDAS, LJ, LX, LY, N, $ NARGS, NC, NS - LOGICAL FULL, NULL, PACKED, RESET, SAME, UPPER + LOGICAL FULL, NULL, PACKED, RESET, SAME, UPPER, + $ SKEWFULL CHARACTER*1 UPLO, UPLOS CHARACTER*2 ICH * .. Local Arrays .. @@ -2050,7 +2175,7 @@ SUBROUTINE SCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, LOGICAL LSE, LSERES EXTERNAL LSE, LSERES * .. External Subroutines .. - EXTERNAL SMAKE, SMVCH, SSPR2, SSYR2 + EXTERNAL SMAKE, SMVCH, SSPR2, SSYR2, SSKEWSYR2 * .. Intrinsic Functions .. INTRINSIC ABS, MAX * .. Scalars in Common .. @@ -2063,8 +2188,9 @@ SUBROUTINE SCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Executable Statements .. FULL = SNAME( 3: 3 ).EQ.'Y' PACKED = SNAME( 3: 3 ).EQ.'P' + SKEWFULL = SNAME( 2: 5 ).EQ.'SKEW' * Define the number of arguments. - IF( FULL )THEN + IF( FULL.OR.SKEWFULL )THEN NARGS = 9 ELSE IF( PACKED )THEN NARGS = 8 @@ -2073,6 +2199,8 @@ SUBROUTINE SCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * DO 140 IN = 1, NIDIM N = IDIM( IN ) @@ -2162,6 +2290,14 @@ SUBROUTINE SCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ REWIND NTRA CALL SSYR2( UPLO, N, ALPHA, XX, INCX, YY, INCY, $ AA, LDA ) + ELSE IF( SKEWFULL )THEN + IF( TRACE ) + $ WRITE( NTRA, FMT = 9993 )NC, SNAME, UPLO, N, + $ ALPHA, INCX, INCY, LDA + IF( REWI ) + $ REWIND NTRA + CALL SSKEWSYR2( UPLO, N, ALPHA, XX, INCX, YY, + $ INCY, AA, LDA ) ELSE IF( PACKED )THEN IF( TRACE ) $ WRITE( NTRA, FMT = 9994 )NC, SNAME, UPLO, N, @@ -2177,6 +2313,8 @@ SUBROUTINE SCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 160 END IF * @@ -2209,6 +2347,8 @@ SUBROUTINE SCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 160 END IF * @@ -2234,22 +2374,36 @@ SUBROUTINE SCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, Z( I, 2 ) = Y( N - I + 1 ) 80 CONTINUE END IF - JA = 1 + IF( .NOT.SKEWFULL.OR.UPPER )THEN + JA = 1 + ELSE + JA = 2 + END IF DO 90 J = 1, N - W( 1 ) = Z( J, 2 ) + IF( .NOT.SKEWFULL )THEN + W( 1 ) = Z( J, 2 ) + ELSE + W( 1 ) = -Z( J, 2 ) + END IF W( 2 ) = Z( J, 1 ) - IF( UPPER )THEN + IF( .NOT.SKEWFULL.AND.UPPER )THEN JJ = 1 LJ = J - ELSE + ELSE IF( .NOT.SKEWFULL.AND..NOT.UPPER )THEN JJ = J LJ = N - J + 1 + ELSE IF( SKEWFULL.AND.UPPER )THEN + JJ = 1 + LJ = J - 1 + ELSE + JJ = J + 1 + LJ = N - J END IF CALL SMVCH( 'N', LJ, 2, ALPHA, Z( JJ, 1 ), $ NMAX, W, 1, ONE, A( JJ, J ), 1, $ YT, G, AA( JA ), EPS, ERR, FATAL, $ NOUT, .TRUE. ) - IF( FULL )THEN + IF( FULL.OR.SKEWFULL )THEN IF( UPPER )THEN JA = JA + LDA ELSE @@ -2259,6 +2413,9 @@ SUBROUTINE SCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, JA = JA + LJ END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and return. IF( FATAL ) $ GO TO 150 @@ -2293,7 +2450,7 @@ SUBROUTINE SCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * 160 CONTINUE WRITE( NOUT, FMT = 9996 )SNAME - IF( FULL )THEN + IF( FULL.OR.SKEWFULL )THEN WRITE( NOUT, FMT = 9993 )NC, SNAME, UPLO, N, ALPHA, INCX, $ INCY, LDA ELSE IF( PACKED )THEN @@ -2301,28 +2458,32 @@ SUBROUTINE SCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 170 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', - $ 'S)' ) + 9999 FORMAT( ' ', A10, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CAL', + $ 'LS)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', - $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, + 9997 FORMAT( ' ', A10, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' ', + $ 'CALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ', A10, ' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',', F4.1, ', X,', - $ I2, ', Y,', I2, ', AP) .' ) - 9993 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',', F4.1, ', X,', - $ I2, ', Y,', I2, ', A,', I3, ') .' ) + 9994 FORMAT( 1X, I6, ': ', A10, '(''', A1, ''',', I3, ',', F4.1, ', X', + $ ',', I2, ', Y,', I2, ', AP) .' ) + 9993 FORMAT( 1X, I6, ': ', A10, '(''', A1, ''',', I3, ',', F4.1, ', X', + $ ',', I2, ', Y,', I2, ', A,', I3, ') .' ) 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A10, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of SCHK6. +* End of SCHK6 * END SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) + IMPLICIT NONE * * Tests the error exits from the Level 2 Blas. * Requires a special version of the error-handling routine XERBLA. @@ -2336,8 +2497,9 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) * * .. Scalar Arguments .. INTEGER ISNUM, NOUT - CHARACTER*6 SRNAMT + CHARACTER*10 SRNAMT * .. Scalars in Common .. + INTEGER NXRUN, NXFAIL, NXBAD INTEGER INFOT, NOUTC LOGICAL LERR, OK * .. Local Scalars .. @@ -2350,6 +2512,7 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) $ STPSV, STRMV, STRSV * .. Common blocks .. COMMON /INFOC/INFOT, NOUTC, OK, LERR + COMMON /XERCNT/NXRUN, NXFAIL, NXBAD * .. Executable Statements .. * OK is set to .FALSE. by the special version of XERBLA or by CHKXER * if anything is wrong. @@ -2357,9 +2520,14 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) * LERR is set to .TRUE. by the special version of XERBLA each time * it is called, and is then tested and re-set by CHKXER. LERR = .FALSE. +* NXRUN and NXFAIL count the error-exit tests of this routine; +* NXBAD is set by XERBLA when it is called wrongly. + NXRUN = 0 + NXFAIL = 0 + NXBAD = 0 GO TO ( 10, 20, 30, 40, 50, 60, 70, 80, $ 90, 100, 110, 120, 130, 140, 150, - $ 160 )ISNUM + $ 160, 170, 180 )ISNUM 10 INFOT = 1 CALL SGEMV( '/', 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2378,7 +2546,7 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 11 CALL SGEMV( 'N', 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 170 + GO TO 190 20 INFOT = 1 CALL SGBMV( '/', 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2403,7 +2571,7 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 13 CALL SGBMV( 'N', 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 170 + GO TO 190 30 INFOT = 1 CALL SSYMV( '/', 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2419,7 +2587,7 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 10 CALL SSYMV( 'U', 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 170 + GO TO 190 40 INFOT = 1 CALL SSBMV( '/', 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2438,7 +2606,7 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 11 CALL SSBMV( 'U', 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 170 + GO TO 190 50 INFOT = 1 CALL SSPMV( '/', 0, ALPHA, A, X, 1, BETA, Y, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2451,7 +2619,7 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 9 CALL SSPMV( 'U', 0, ALPHA, A, X, 1, BETA, Y, 0 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 170 + GO TO 190 60 INFOT = 1 CALL STRMV( '/', 'N', 'N', 0, A, 1, X, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2470,7 +2638,7 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 8 CALL STRMV( 'U', 'N', 'N', 0, A, 1, X, 0 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 170 + GO TO 190 70 INFOT = 1 CALL STBMV( '/', 'N', 'N', 0, 0, A, 1, X, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2492,7 +2660,7 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 9 CALL STBMV( 'U', 'N', 'N', 0, 0, A, 1, X, 0 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 170 + GO TO 190 80 INFOT = 1 CALL STPMV( '/', 'N', 'N', 0, A, X, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2508,7 +2676,7 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 7 CALL STPMV( 'U', 'N', 'N', 0, A, X, 0 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 170 + GO TO 190 90 INFOT = 1 CALL STRSV( '/', 'N', 'N', 0, A, 1, X, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2527,7 +2695,7 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 8 CALL STRSV( 'U', 'N', 'N', 0, A, 1, X, 0 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 170 + GO TO 190 100 INFOT = 1 CALL STBSV( '/', 'N', 'N', 0, 0, A, 1, X, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2549,7 +2717,7 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 9 CALL STBSV( 'U', 'N', 'N', 0, 0, A, 1, X, 0 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 170 + GO TO 190 110 INFOT = 1 CALL STPSV( '/', 'N', 'N', 0, A, X, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2565,7 +2733,7 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 7 CALL STPSV( 'U', 'N', 'N', 0, A, X, 0 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 170 + GO TO 190 120 INFOT = 1 CALL SGER( -1, 0, ALPHA, X, 1, Y, 1, A, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2581,7 +2749,7 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 9 CALL SGER( 2, 0, ALPHA, X, 1, Y, 1, A, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 170 + GO TO 190 130 INFOT = 1 CALL SSYR( '/', 0, ALPHA, X, 1, A, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2594,7 +2762,7 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 7 CALL SSYR( 'U', 2, ALPHA, X, 1, A, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 170 + GO TO 190 140 INFOT = 1 CALL SSPR( '/', 0, ALPHA, X, 1, A ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2604,7 +2772,7 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 5 CALL SSPR( 'U', 0, ALPHA, X, 0, A ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 170 + GO TO 190 150 INFOT = 1 CALL SSYR2( '/', 0, ALPHA, X, 1, Y, 1, A, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2620,7 +2788,7 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 9 CALL SSYR2( 'U', 2, ALPHA, X, 1, Y, 1, A, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 170 + GO TO 190 160 INFOT = 1 CALL SSPR2( '/', 0, ALPHA, X, 1, Y, 1, A ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2633,30 +2801,66 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 7 CALL SSPR2( 'U', 0, ALPHA, X, 1, Y, 0, A ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + GO TO 190 + 170 INFOT = 1 + CALL SSKEWSYMV( '/', 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL SSKEWSYMV( 'U', -1, ALPHA, A, 1, X, 1, BETA, Y, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL SSKEWSYMV( 'U', 2, ALPHA, A, 1, X, 1, BETA, Y, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 7 + CALL SSKEWSYMV( 'U', 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 10 + CALL SSKEWSYMV( 'U', 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + GO TO 190 + 180 INFOT = 1 + CALL SSKEWSYR2( '/', 0, ALPHA, X, 1, Y, 1, A, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL SSKEWSYR2( 'U', -1, ALPHA, X, 1, Y, 1, A, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL SSKEWSYR2( 'U', 0, ALPHA, X, 0, Y, 1, A, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 7 + CALL SSKEWSYR2( 'U', 0, ALPHA, X, 1, Y, 0, A, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 9 + CALL SSKEWSYR2( 'U', 2, ALPHA, X, 1, Y, 1, A, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) * - 170 IF( OK )THEN + 190 IF( OK )THEN WRITE( NOUT, FMT = 9999 )SRNAMT ELSE WRITE( NOUT, FMT = 9998 )SRNAMT END IF + WRITE( NOUT, FMT = 9979 )SRNAMT, NXRUN, NXFAIL RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE TESTS OF ERROR-EXITS' ) - 9998 FORMAT( ' ******* ', A6, ' FAILED THE TESTS OF ERROR-EXITS *****', - $ '**' ) + 9999 FORMAT( ' ', A10, ' PASSED THE TESTS OF ERROR-EXITS' ) + 9998 FORMAT( ' ******* ', A10, ' FAILED THE TESTS OF ERROR-EXITS ****', + $ '***' ) + 9979 FORMAT( ' ', A10, ' ERROR-EXIT TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of SCHKE. +* End of SCHKE * END SUBROUTINE SMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, $ KU, RESET, TRANSL ) + IMPLICIT NONE * * Generates values for an M by N matrix A within the bandwidth * defined by KL and KU. * Stores the values in the array AA in the data structure required * by the routine, with unwanted elements set to rogue value. * -* TYPE is 'GE', 'GB', 'SY', 'SB', 'SP', 'TR', 'TB' OR 'TP'. +* TYPE is 'GE', 'GB', 'SY', 'SB', 'SP', 'SK', 'TR', 'TB' OR 'TP'. * * Auxiliary routine for test program for Level 2 Blas. * @@ -2679,7 +2883,8 @@ SUBROUTINE SMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, REAL A( NMAX, * ), AA( * ) * .. Local Scalars .. INTEGER I, I1, I2, I3, IBEG, IEND, IOFF, J, KK - LOGICAL GEN, LOWER, SYM, TRI, UNIT, UPPER + LOGICAL GEN, LOWER, SYM, TRI, UNIT, UPPER, + $ SKEW * .. External Functions .. REAL SBEG EXTERNAL SBEG @@ -2687,10 +2892,11 @@ SUBROUTINE SMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, INTRINSIC MAX, MIN * .. Executable Statements .. GEN = TYPE( 1: 1 ).EQ.'G' - SYM = TYPE( 1: 1 ).EQ.'S' + SYM = TYPE( 1: 1 ).EQ.'S'.AND.TYPE( 2: 2 ).NE.'K' + SKEW = TYPE( 1: 1 ).EQ.'S'.AND.TYPE( 2: 2 ).EQ.'K' TRI = TYPE( 1: 1 ).EQ.'T' - UPPER = ( SYM.OR.TRI ).AND.UPLO.EQ.'U' - LOWER = ( SYM.OR.TRI ).AND.UPLO.EQ.'L' + UPPER = ( SYM.OR.SKEW.OR.TRI ).AND.UPLO.EQ.'U' + LOWER = ( SYM.OR.SKEW.OR.TRI ).AND.UPLO.EQ.'L' UNIT = TRI.AND.DIAG.EQ.'U' * * Generate data in array A. @@ -2708,6 +2914,8 @@ SUBROUTINE SMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, IF( I.NE.J )THEN IF( SYM )THEN A( J, I ) = A( I, J ) + ELSE IF( SKEW )THEN + A( J, I ) = -A( I, J ) ELSE IF( TRI )THEN A( J, I ) = ZERO END IF @@ -2718,6 +2926,8 @@ SUBROUTINE SMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, $ A( J, J ) = A( J, J ) + ONE IF( UNIT ) $ A( J, J ) = ONE + IF( SKEW ) + $ A( J, J ) = ZERO 20 CONTINUE * * Store elements in array AS in data structure required by routine. @@ -2743,17 +2953,17 @@ SUBROUTINE SMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, AA( I3 + ( J - 1 )*LDA ) = ROGUE 80 CONTINUE 90 CONTINUE - ELSE IF( TYPE.EQ.'SY'.OR.TYPE.EQ.'TR' )THEN + ELSE IF( TYPE.EQ.'SY'.OR.TYPE.EQ.'SK'.OR.TYPE.EQ.'TR' )THEN DO 130 J = 1, N IF( UPPER )THEN IBEG = 1 - IF( UNIT )THEN + IF( UNIT.OR.SKEW )THEN IEND = J - 1 ELSE IEND = J END IF ELSE - IF( UNIT )THEN + IF( UNIT.OR.SKEW )THEN IBEG = J + 1 ELSE IBEG = J @@ -2821,11 +3031,12 @@ SUBROUTINE SMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, END IF RETURN * -* End of SMAKE. +* End of SMAKE * END SUBROUTINE SMVCH( TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y, $ INCY, YT, G, YY, EPS, ERR, FATAL, NOUT, MV ) + IMPLICIT NONE * * Checks the results of the computational tests. * @@ -2938,10 +3149,11 @@ SUBROUTINE SMVCH( TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y, $ 'TED RESULT' ) 9998 FORMAT( 1X, I7, 2G18.6 ) * -* End of SMVCH. +* End of SMVCH * END LOGICAL FUNCTION LSE( RI, RJ, LR ) + IMPLICIT NONE * * Tests if two arrays are identical. * @@ -2968,14 +3180,15 @@ LOGICAL FUNCTION LSE( RI, RJ, LR ) LSE = .FALSE. 30 RETURN * -* End of LSE. +* End of LSE * END LOGICAL FUNCTION LSERES( TYPE, UPLO, M, N, AA, AS, LDA ) + IMPLICIT NONE * * Tests if selected elements in two arrays are equal. * -* TYPE is 'GE', 'SY' or 'SP'. +* TYPE is 'GE', 'SY', 'SK' or 'SP'. * * Auxiliary routine for test program for Level 2 Blas. * @@ -3001,14 +3214,20 @@ LOGICAL FUNCTION LSERES( TYPE, UPLO, M, N, AA, AS, LDA ) $ GO TO 70 10 CONTINUE 20 CONTINUE - ELSE IF( TYPE.EQ.'SY' )THEN + ELSE IF( TYPE.EQ.'SY'.OR.TYPE.EQ.'SK' )THEN DO 50 J = 1, N - IF( UPPER )THEN + IF( UPPER.AND.TYPE.EQ.'SY' )THEN IBEG = 1 IEND = J - ELSE + ELSE IF( .NOT.UPPER.AND.TYPE.EQ.'SY' )THEN IBEG = J IEND = N + ELSE IF( UPPER.AND.TYPE.EQ.'SK' )THEN + IBEG = 1 + IEND = J - 1 + ELSE + IBEG = J + 1 + IEND = N END IF DO 30 I = 1, IBEG - 1 IF( AA( I, J ).NE.AS( I, J ) ) @@ -3027,10 +3246,11 @@ LOGICAL FUNCTION LSERES( TYPE, UPLO, M, N, AA, AS, LDA ) LSERES = .FALSE. 80 RETURN * -* End of LSERES. +* End of LSERES * END REAL FUNCTION SBEG( RESET ) + IMPLICIT NONE * * Generates random numbers uniformly distributed between -0.5 and 0.5. * @@ -3073,10 +3293,11 @@ REAL FUNCTION SBEG( RESET ) SBEG = REAL( I - 500 )/1001.0 RETURN * -* End of SBEG. +* End of SBEG * END REAL FUNCTION SDIFF( X, Y ) + IMPLICIT NONE * * Auxiliary routine for test program for Level 2 Blas. * @@ -3089,10 +3310,11 @@ REAL FUNCTION SDIFF( X, Y ) SDIFF = X - Y RETURN * -* End of SDIFF. +* End of SDIFF * END SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + IMPLICIT NONE * * Tests whether XERBLA has detected an error when it should. * @@ -3105,22 +3327,66 @@ SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) * .. Scalar Arguments .. INTEGER INFOT, NOUT LOGICAL LERR, OK - CHARACTER*6 SRNAMT + CHARACTER*10 SRNAMT +* .. Scalars in Common .. + INTEGER NXRUN, NXFAIL, NXBAD +* .. Common blocks .. + COMMON /XERCNT/NXRUN, NXFAIL, NXBAD * .. Executable Statements .. + NXRUN = NXRUN + 1 IF( .NOT.LERR )THEN WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT OK = .FALSE. + NXFAIL = NXFAIL + 1 + ELSE IF( NXBAD.NE.0 )THEN + NXFAIL = NXFAIL + 1 END IF + NXBAD = 0 LERR = .FALSE. RETURN * 9999 FORMAT( ' ***** ILLEGAL VALUE OF PARAMETER NUMBER ', I2, ' NOT D', - $ 'ETECTED BY ', A6, ' *****' ) + $ 'ETECTED BY ', A10, ' *****' ) +* +* End of CHKXER +* + END + SUBROUTINE SREGR1( TRANS, M, N, LY, KL, KU, ALPHA, A, LDA, X, + $ INCX, BETA, Y, INCY, YS ) + IMPLICIT NONE * -* End of CHKXER. +* Input initialization for regression test. * +* .. Scalar Arguments .. + CHARACTER*1 TRANS + INTEGER LY, M, N, KL, KU, LDA, INCX, INCY + REAL ALPHA, BETA +* .. Array Arguments .. + REAL A(LDA,*), X(*), Y(*), YS(*) +* .. Local Scalars .. + INTEGER I +* .. Intrinsic Functions .. + INTRINSIC REAL +* .. Executable Statements .. + TRANS = 'T' + M = 0 + N = 5 + KL = 0 + KU = 0 + ALPHA = 1.0 + LDA = MAX( 1, M ) + INCX = 1 + BETA = -0.7 + INCY = 1 + LY = ABS( INCY )*N + DO 10 I = 1, LY + Y( I ) = 42.0 + REAL( I ) + YS( I ) = Y( I ) + 10 CONTINUE + RETURN END SUBROUTINE XERBLA( SRNAME, INFO ) + IMPLICIT NONE * * This is a special version of XERBLA to be used only as part of * the test program for testing error exits from the Level 2 BLAS @@ -3139,14 +3405,18 @@ SUBROUTINE XERBLA( SRNAME, INFO ) * * .. Scalar Arguments .. INTEGER INFO - CHARACTER*6 SRNAME + CHARACTER*(*) SRNAME * .. Scalars in Common .. + INTEGER NXRUN, NXFAIL, NXBAD INTEGER INFOT, NOUT LOGICAL LERR, OK - CHARACTER*6 SRNAMT + CHARACTER*10 SRNAMT * .. Common blocks .. COMMON /INFOC/INFOT, NOUT, OK, LERR + COMMON /XERCNT/NXRUN, NXFAIL, NXBAD COMMON /SRNAMC/SRNAMT +* .. Locals .. + INTEGER SRLEN * .. Executable Statements .. LERR = .TRUE. IF( INFO.NE.INFOT )THEN @@ -3156,21 +3426,23 @@ SUBROUTINE XERBLA( SRNAME, INFO ) WRITE( NOUT, FMT = 9997 )INFO END IF OK = .FALSE. + NXBAD = 1 END IF - IF( SRNAME.NE.SRNAMT )THEN + SRLEN = MIN(LEN_TRIM(SRNAME), LEN_TRIM(SRNAMT)) + IF( SRNAME(1:SRLEN).NE.SRNAMT(1:SRLEN) )THEN WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT OK = .FALSE. + NXBAD = 1 END IF RETURN * 9999 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6, ' INSTEAD', $ ' OF ', I2, ' *******' ) - 9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A6, ' INSTE', - $ 'AD OF ', A6, ' *******' ) + 9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A, ' INST', + $ 'EAD OF ', A10, ' *******' ) 9997 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6, $ ' *******' ) * * End of XERBLA * END - diff --git a/BLAS/TESTING/sblat2.in b/BLAS/TESTING/sblat2.in index fefc7e958a..a8e88d3a2b 100644 --- a/BLAS/TESTING/sblat2.in +++ b/BLAS/TESTING/sblat2.in @@ -16,19 +16,21 @@ T LOGICAL FLAG, T TO TEST ERROR EXITS. 0.0 1.0 0.7 VALUES OF ALPHA 3 NUMBER OF VALUES OF BETA 0.0 1.0 0.9 VALUES OF BETA -SGEMV T PUT F FOR NO TEST. SAME COLUMNS. -SGBMV T PUT F FOR NO TEST. SAME COLUMNS. -SSYMV T PUT F FOR NO TEST. SAME COLUMNS. -SSBMV T PUT F FOR NO TEST. SAME COLUMNS. -SSPMV T PUT F FOR NO TEST. SAME COLUMNS. -STRMV T PUT F FOR NO TEST. SAME COLUMNS. -STBMV T PUT F FOR NO TEST. SAME COLUMNS. -STPMV T PUT F FOR NO TEST. SAME COLUMNS. -STRSV T PUT F FOR NO TEST. SAME COLUMNS. -STBSV T PUT F FOR NO TEST. SAME COLUMNS. -STPSV T PUT F FOR NO TEST. SAME COLUMNS. -SGER T PUT F FOR NO TEST. SAME COLUMNS. -SSYR T PUT F FOR NO TEST. SAME COLUMNS. -SSPR T PUT F FOR NO TEST. SAME COLUMNS. -SSYR2 T PUT F FOR NO TEST. SAME COLUMNS. -SSPR2 T PUT F FOR NO TEST. SAME COLUMNS. +SGEMV T PUT F FOR NO TEST. SAME COLUMNS. +SGBMV T PUT F FOR NO TEST. SAME COLUMNS. +SSYMV T PUT F FOR NO TEST. SAME COLUMNS. +SSBMV T PUT F FOR NO TEST. SAME COLUMNS. +SSPMV T PUT F FOR NO TEST. SAME COLUMNS. +STRMV T PUT F FOR NO TEST. SAME COLUMNS. +STBMV T PUT F FOR NO TEST. SAME COLUMNS. +STPMV T PUT F FOR NO TEST. SAME COLUMNS. +STRSV T PUT F FOR NO TEST. SAME COLUMNS. +STBSV T PUT F FOR NO TEST. SAME COLUMNS. +STPSV T PUT F FOR NO TEST. SAME COLUMNS. +SGER T PUT F FOR NO TEST. SAME COLUMNS. +SSYR T PUT F FOR NO TEST. SAME COLUMNS. +SSPR T PUT F FOR NO TEST. SAME COLUMNS. +SSYR2 T PUT F FOR NO TEST. SAME COLUMNS. +SSPR2 T PUT F FOR NO TEST. SAME COLUMNS. +SSKEWSYMV T PUT F FOR NO TEST. SAME COLUMNS. +SSKEWSYR2 T PUT F FOR NO TEST. SAME COLUMNS. diff --git a/BLAS/TESTING/sblat3.f b/BLAS/TESTING/sblat3.f index 66edac14ea..4f91b17964 100644 --- a/BLAS/TESTING/sblat3.f +++ b/BLAS/TESTING/sblat3.f @@ -19,8 +19,8 @@ *> Test program for the REAL Level 3 Blas. *> *> The program must be driven by a short data file. The first 14 records -*> of the file are read using list-directed input, the last 6 records -*> are read using the format ( A6, L2 ). An annotated example of a data +*> of the file are read using list-directed input, the last 9 records +*> are read using the format ( A11, L2 ). An annotated example of a data *> file can be obtained by deleting the first 3 characters from the *> following 20 lines: *> 'sblat3.out' NAME OF SUMMARY OUTPUT FILE @@ -43,6 +43,9 @@ *> STRSM T PUT F FOR NO TEST. SAME COLUMNS. *> SSYRK T PUT F FOR NO TEST. SAME COLUMNS. *> SSYR2K T PUT F FOR NO TEST. SAME COLUMNS. +*> SGEMMTR T PUT F FOR NO TEST. SAME COLUMNS. +*> SSKEWSYMM T PUT F FOR NO TEST. SAME COLUMNS. +*> SSKEWSYR2K T PUT F FOR NO TEST. SAME COLUMNS. *> *> Further Details *> =============== @@ -75,17 +78,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date April 2012 -* *> \ingroup single_blas_testing * * ===================================================================== PROGRAM SBLAT3 + IMPLICIT NONE * -* -- Reference BLAS test routine (version 3.7.0) -- +* -- Reference BLAS test routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* April 2012 * * ===================================================================== * @@ -93,7 +94,7 @@ PROGRAM SBLAT3 INTEGER NIN PARAMETER ( NIN = 5 ) INTEGER NSUBS - PARAMETER ( NSUBS = 6 ) + PARAMETER ( NSUBS = 9 ) REAL ZERO, ONE PARAMETER ( ZERO = 0.0, ONE = 1.0 ) INTEGER NMAX @@ -101,12 +102,13 @@ PROGRAM SBLAT3 INTEGER NIDMAX, NALMAX, NBEMAX PARAMETER ( NIDMAX = 9, NALMAX = 7, NBEMAX = 7 ) * .. Local Scalars .. + REAL S1, S2 REAL EPS, ERR, THRESH INTEGER I, ISNUM, J, N, NALF, NBET, NIDIM, NOUT, NTRA LOGICAL FATAL, LTESTT, REWI, SAME, SFATAL, TRACE, $ TSTERR CHARACTER*1 TRANSA, TRANSB - CHARACTER*6 SNAMET + CHARACTER*11 SNAMET CHARACTER*32 SNAPS, SUMMRY * .. Local Arrays .. REAL AA( NMAX*NMAX ), AB( NMAX, 2*NMAX ), @@ -117,26 +119,31 @@ PROGRAM SBLAT3 $ G( NMAX ), W( 2*NMAX ) INTEGER IDIM( NIDMAX ) LOGICAL LTEST( NSUBS ) - CHARACTER*6 SNAMES( NSUBS ) + CHARACTER*11 SNAMES( NSUBS ) * .. External Functions .. REAL SDIFF LOGICAL LSE EXTERNAL SDIFF, LSE * .. External Subroutines .. EXTERNAL SCHK1, SCHK2, SCHK3, SCHK4, SCHK5, SCHKE, SMMCH + EXTERNAL SCHK6 * .. Intrinsic Functions .. INTRINSIC MAX, MIN * .. Scalars in Common .. INTEGER INFOT, NOUTC LOGICAL LERR, OK - CHARACTER*6 SRNAMT + CHARACTER*11 SRNAMT * .. Common blocks .. COMMON /INFOC/INFOT, NOUTC, OK, LERR COMMON /SRNAMC/SRNAMT * .. Data statements .. - DATA SNAMES/'SGEMM ', 'SSYMM ', 'STRMM ', 'STRSM ', - $ 'SSYRK ', 'SSYR2K'/ + DATA SNAMES/'SGEMM ', 'SSYMM ', + $ 'STRMM ', 'STRSM ', + $ 'SSYRK ', 'SSYR2K ', + $ 'SGEMMTR ', + $ 'SSKEWSYMM ', 'SSKEWSYR2K '/ * .. Executable Statements .. + CALL CPU_TIME( S1 ) * * Read name and unit number for summary output file and open file. * @@ -236,14 +243,15 @@ PROGRAM SBLAT3 N = MIN( 32, NMAX ) DO 100 J = 1, N DO 90 I = 1, N - AB( I, J ) = MAX( I - J + 1, 0 ) + AB( I, J ) = REAL( MAX( I - J + 1, 0 ) ) 90 CONTINUE - AB( J, NMAX + 1 ) = J - AB( 1, NMAX + J ) = J + AB( J, NMAX + 1 ) = REAL( J ) + AB( 1, NMAX + J ) = REAL( J ) C( J, 1 ) = ZERO 100 CONTINUE DO 110 J = 1, N - CC( J ) = J*( ( J + 1 )*J )/2 - ( ( J + 1 )*J*( J - 1 ) )/3 + CC( J ) = REAL( J*( ( J + 1 )*J )/2 - + $ ( ( J + 1 )*J*( J - 1 ) )/3 ) 110 CONTINUE * CC holds the exact result. On exit from SMMCH CT holds * the result computed by SMMCH. @@ -267,12 +275,12 @@ PROGRAM SBLAT3 STOP END IF DO 120 J = 1, N - AB( J, NMAX + 1 ) = N - J + 1 - AB( 1, NMAX + J ) = N - J + 1 + AB( J, NMAX + 1 ) = REAL( N - J + 1 ) + AB( 1, NMAX + J ) = REAL( N - J + 1 ) 120 CONTINUE DO 130 J = 1, N - CC( N - J + 1 ) = J*( ( J + 1 )*J )/2 - - $ ( ( J + 1 )*J*( J - 1 ) )/3 + CC( N - J + 1 ) = REAL( J*( ( J + 1 )*J )/2 - + $ ( ( J + 1 )*J*( J - 1 ) )/3 ) 130 CONTINUE TRANSA = 'T' TRANSB = 'N' @@ -312,14 +320,14 @@ PROGRAM SBLAT3 INFOT = 0 OK = .TRUE. FATAL = .FALSE. - GO TO ( 140, 150, 160, 160, 170, 180 )ISNUM + GO TO ( 140, 150, 160, 160, 170, 180, 185, 150, 180 )ISNUM * Test SGEMM, 01. 140 CALL SCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, $ CC, CS, CT, G ) GO TO 190 -* Test SSYMM, 02. +* Test SSYMM, 02, SSKEWSYMM, 07. 150 CALL SCHK2( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, @@ -336,11 +344,17 @@ PROGRAM SBLAT3 $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, $ CC, CS, CT, G ) GO TO 190 -* Test SSYR2K, 06. +* Test SSYR2K, 06, SSKEWSYR2K, 08. 180 CALL SCHK5( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W ) GO TO 190 +* Test SGEMMTR, 07. + 185 CALL SCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, + $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, + $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, + $ CC, CS, CT, G ) + GO TO 190 * 190 IF( FATAL.AND.SFATAL ) $ GO TO 210 @@ -359,6 +373,8 @@ PROGRAM SBLAT3 230 CONTINUE IF( TRACE ) $ CLOSE ( NTRA ) + CALL CPU_TIME( S2 ) + WRITE( NOUT, FMT = 9983 )S2 - S1 CLOSE ( NOUT ) STOP * @@ -375,26 +391,28 @@ PROGRAM SBLAT3 9992 FORMAT( ' FOR BETA ', 7F6.1 ) 9991 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM', $ /' ******* TESTS ABANDONED *******' ) - 9990 FORMAT( ' SUBPROGRAM NAME ', A6, ' NOT RECOGNIZED', /' ******* T', - $ 'ESTS ABANDONED *******' ) + 9990 FORMAT( ' SUBPROGRAM NAME ', A11, ' NOT RECOGNIZED', /' ******* ', + $ 'TESTS ABANDONED *******' ) 9989 FORMAT( ' ERROR IN SMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALU', $ 'ATED WRONGLY.', /' SMMCH WAS CALLED WITH TRANSA = ', A1, $ ' AND TRANSB = ', A1, /' AND RETURNED SAME = ', L1, ' AND ', $ 'ERR = ', F12.3, '.', /' THIS MAY BE DUE TO FAULTS IN THE ', $ 'ARITHMETIC OR THE COMPILER.', /' ******* TESTS ABANDONED ', $ '*******' ) - 9988 FORMAT( A6, L2 ) - 9987 FORMAT( 1X, A6, ' WAS NOT TESTED' ) + 9988 FORMAT( A11, L2 ) + 9987 FORMAT( 1X, A11, ' WAS NOT TESTED' ) 9986 FORMAT( /' END OF TESTS' ) 9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' ) 9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' ) + 9983 FORMAT( ' Total time used = ', F12.2, ' seconds', / ) * -* End of SBLAT3. +* End of SBLAT3 * END SUBROUTINE SCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G ) + IMPLICIT NONE * * Tests SGEMM. * @@ -413,7 +431,7 @@ SUBROUTINE SCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*11 SNAME * .. Array Arguments .. REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -423,6 +441,7 @@ SUBROUTINE SCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ) * .. Local Scalars .. REAL ALPHA, ALS, BETA, BLS, ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, ICA, ICB, IK, IM, IN, K, KS, LAA, $ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, M, $ MA, MB, MS, N, NA, NARGS, NB, NC, NS @@ -451,6 +470,8 @@ SUBROUTINE SCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * DO 110 IM = 1, NIDIM M = IDIM( IM ) @@ -572,6 +593,8 @@ SUBROUTINE SCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9994 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -607,6 +630,8 @@ SUBROUTINE SCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -619,6 +644,9 @@ SUBROUTINE SCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ C, NMAX, CT, G, CC, LDC, EPS, $ ERR, FATAL, NOUT, .TRUE. ) ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -654,28 +682,32 @@ SUBROUTINE SCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ ALPHA, LDA, LDB, BETA, LDC * 130 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', - $ 'S)' ) + 9999 FORMAT( ' ', A11, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CAL', + $ 'LS)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', - $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, + 9997 FORMAT( ' ', A11, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' ', + $ 'CALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',''', A1, ''',', + 9996 FORMAT( ' ******* ', A11, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A11, '(''', A1, ''',''', A1, ''',', $ 3( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', ', $ 'C,', I3, ').' ) 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A11, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of SCHK1. +* End of SCHK1 * END SUBROUTINE SCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G ) + IMPLICIT NONE * * Tests SSYMM. * @@ -694,7 +726,7 @@ SUBROUTINE SCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*11 SNAME * .. Array Arguments .. REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -704,10 +736,11 @@ SUBROUTINE SCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ) * .. Local Scalars .. REAL ALPHA, ALS, BETA, BLS, ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, ICS, ICU, IM, IN, LAA, LBB, LCC, $ LDA, LDAS, LDB, LDBS, LDC, LDCS, M, MS, N, NA, $ NARGS, NC, NS - LOGICAL LEFT, NULL, RESET, SAME + LOGICAL LEFT, NULL, RESET, SAME, SKEWFULL CHARACTER*1 SIDE, SIDES, UPLO, UPLOS CHARACTER*2 ICHS, ICHU * .. Local Arrays .. @@ -716,7 +749,7 @@ SUBROUTINE SCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, LOGICAL LSE, LSERES EXTERNAL LSE, LSERES * .. External Subroutines .. - EXTERNAL SMAKE, SMMCH, SSYMM + EXTERNAL SMAKE, SMMCH, SSYMM, SSKEWSYMM * .. Intrinsic Functions .. INTRINSIC MAX * .. Scalars in Common .. @@ -728,10 +761,13 @@ SUBROUTINE SCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DATA ICHS/'LR'/, ICHU/'UL'/ * .. Executable Statements .. * + SKEWFULL = SNAME( 2: 5 ).EQ.'SKEW' NARGS = 12 NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * DO 100 IM = 1, NIDIM M = IDIM( IM ) @@ -785,8 +821,13 @@ SUBROUTINE SCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * * Generate the symmetric matrix A. * - CALL SMAKE( 'SY', UPLO, ' ', NA, NA, A, NMAX, AA, LDA, - $ RESET, ZERO ) + IF(.NOT.SKEWFULL) THEN + CALL SMAKE( 'SY', UPLO, ' ', NA, NA, A, NMAX, AA, + $ LDA, RESET, ZERO ) + ELSE + CALL SMAKE( 'SK', UPLO, ' ', NA, NA, A, NMAX, AA, + $ LDA, RESET, ZERO ) + END IF * DO 60 IA = 1, NALF ALPHA = ALF( IA ) @@ -830,14 +871,21 @@ SUBROUTINE SCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ UPLO, M, N, ALPHA, LDA, LDB, BETA, LDC IF( REWI ) $ REWIND NTRA - CALL SSYMM( SIDE, UPLO, M, N, ALPHA, AA, LDA, - $ BB, LDB, BETA, CC, LDC ) + IF(.NOT.SKEWFULL) THEN + CALL SSYMM( SIDE, UPLO, M, N, ALPHA, AA, + $ LDA, BB, LDB, BETA, CC, LDC ) + ELSE + CALL SSKEWSYMM( SIDE, UPLO, M, N, ALPHA, AA, + $ LDA, BB, LDB, BETA, CC, LDC ) + END IF * * Check if error-exit was taken incorrectly. * IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9994 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 110 END IF * @@ -872,6 +920,8 @@ SUBROUTINE SCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 110 END IF * @@ -891,6 +941,9 @@ SUBROUTINE SCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NOUT, .TRUE. ) END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -924,28 +977,32 @@ SUBROUTINE SCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ LDB, BETA, LDC * 120 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', - $ 'S)' ) + 9999 FORMAT( ' ', A11, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CAL', + $ 'LS)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', - $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, + 9997 FORMAT( ' ', A11, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' ', + $ 'CALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ), - $ F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', C,', I3, ') ', - $ ' .' ) + 9996 FORMAT( ' ******* ', A11, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A11, '(', 2( '''', A1, ''',' ), + $ 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, + $ ', C,', I3, ') .' ) 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A11, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of SCHK2. +* End of SCHK2 * END SUBROUTINE SCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NMAX, A, AA, AS, $ B, BB, BS, CT, G, C ) + IMPLICIT NONE * * Tests STRMM and STRSM. * @@ -964,7 +1021,7 @@ SUBROUTINE SCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*11 SNAME * .. Array Arguments .. REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -973,6 +1030,7 @@ SUBROUTINE SCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ) * .. Local Scalars .. REAL ALPHA, ALS, ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, ICD, ICS, ICT, ICU, IM, IN, J, LAA, LBB, $ LDA, LDAS, LDB, LDBS, M, MS, N, NA, NARGS, NC, $ NS @@ -1003,6 +1061,8 @@ SUBROUTINE SCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * Set up zero matrix for SMMCH. DO 20 J = 1, NMAX DO 10 I = 1, NMAX @@ -1112,6 +1172,8 @@ SUBROUTINE SCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9994 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 150 END IF * @@ -1145,6 +1207,8 @@ SUBROUTINE SCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 50 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 150 END IF * @@ -1195,6 +1259,9 @@ SUBROUTINE SCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -1230,27 +1297,31 @@ SUBROUTINE SCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ N, ALPHA, LDA, LDB * 160 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', - $ 'S)' ) + 9999 FORMAT( ' ', A11, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CAL', + $ 'LS)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', - $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, + 9997 FORMAT( ' ', A11, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' ', + $ 'CALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A6, '(', 4( '''', A1, ''',' ), 2( I3, ',' ), - $ F4.1, ', A,', I3, ', B,', I3, ') .' ) + 9996 FORMAT( ' ******* ', A11, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A11, '(', 4( '''', A1, ''',' ), + $ 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ') .' ) 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A11, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of SCHK3. +* End of SCHK3 * END SUBROUTINE SCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G ) + IMPLICIT NONE * * Tests SSYRK. * @@ -1269,7 +1340,7 @@ SUBROUTINE SCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*11 SNAME * .. Array Arguments .. REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -1279,6 +1350,7 @@ SUBROUTINE SCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ) * .. Local Scalars .. REAL ALPHA, ALS, BETA, BETS, ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, K, KS, $ LAA, LCC, LDA, LDAS, LDC, LDCS, LJ, MA, N, NA, $ NARGS, NC, NS @@ -1308,6 +1380,8 @@ SUBROUTINE SCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * DO 100 IN = 1, NIDIM N = IDIM( IN ) @@ -1397,6 +1471,8 @@ SUBROUTINE SCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9993 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1429,6 +1505,8 @@ SUBROUTINE SCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 30 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1466,6 +1544,9 @@ SUBROUTINE SCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, JC = JC + LDC + 1 END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -1504,28 +1585,33 @@ SUBROUTINE SCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ LDA, BETA, LDC * 130 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', - $ 'S)' ) + 9999 FORMAT( ' ', A11, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CAL', + $ 'LS)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', - $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, + 9997 FORMAT( ' ', A11, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' ', + $ 'CALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ', A11, ' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ), - $ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ') .' ) + 9994 FORMAT( 1X, I6, ': ', A11, '(', 2( '''', A1, ''',' ), + $ 2( I3, ',' ), F4.1, ', A,', I3, ',', F4.1, ', C,', I3, + $ ') .' ) 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A11, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of SCHK4. +* End of SCHK4 * END SUBROUTINE SCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, $ AB, AA, AS, BB, BS, C, CC, CS, CT, G, W ) + IMPLICIT NONE * * Tests SSYR2K. * @@ -1544,7 +1630,7 @@ SUBROUTINE SCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*11 SNAME * .. Array Arguments .. REAL AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ), $ ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ), @@ -1554,10 +1640,11 @@ SUBROUTINE SCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ) * .. Local Scalars .. REAL ALPHA, ALS, BETA, BETS, ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, JJAB, $ K, KS, LAA, LBB, LCC, LDA, LDAS, LDB, LDBS, $ LDC, LDCS, LJ, MA, N, NA, NARGS, NC, NS - LOGICAL NULL, RESET, SAME, TRAN, UPPER + LOGICAL NULL, RESET, SAME, TRAN, UPPER, SKEWFULL CHARACTER*1 TRANS, TRANSS, UPLO, UPLOS CHARACTER*2 ICHU CHARACTER*3 ICHT @@ -1567,7 +1654,7 @@ SUBROUTINE SCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, LOGICAL LSE, LSERES EXTERNAL LSE, LSERES * .. External Subroutines .. - EXTERNAL SMAKE, SMMCH, SSYR2K + EXTERNAL SMAKE, SMMCH, SSYR2K, SSKEWSYR2K * .. Intrinsic Functions .. INTRINSIC MAX * .. Scalars in Common .. @@ -1579,10 +1666,13 @@ SUBROUTINE SCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DATA ICHT/'NTC'/, ICHU/'UL'/ * .. Executable Statements .. * + SKEWFULL = SNAME( 2: 5 ).EQ.'SKEW' NARGS = 12 NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * DO 130 IN = 1, NIDIM N = IDIM( IN ) @@ -1652,8 +1742,13 @@ SUBROUTINE SCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * * Generate the matrix C. * - CALL SMAKE( 'SY', UPLO, ' ', N, N, C, NMAX, CC, - $ LDC, RESET, ZERO ) + IF(.NOT.SKEWFULL) THEN + CALL SMAKE( 'SY', UPLO, ' ', N, N, C, NMAX, + $ CC, LDC, RESET, ZERO ) + ELSE + CALL SMAKE( 'SK', UPLO, ' ', N, N, C, NMAX, + $ CC, LDC, RESET, ZERO ) + END IF * NC = NC + 1 * @@ -1685,14 +1780,22 @@ SUBROUTINE SCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ TRANS, N, K, ALPHA, LDA, LDB, BETA, LDC IF( REWI ) $ REWIND NTRA - CALL SSYR2K( UPLO, TRANS, N, K, ALPHA, AA, LDA, - $ BB, LDB, BETA, CC, LDC ) + IF(.NOT.SKEWFULL) THEN + CALL SSYR2K( UPLO, TRANS, N, K, ALPHA, AA, + $ LDA, BB, LDB, BETA, CC, LDC ) + ELSE + CALL SSKEWSYR2K( UPLO, TRANS, N, K, ALPHA, + $ AA, LDA, BB, LDB, BETA, CC, + $ LDC ) + END IF * * Check if error-exit was taken incorrectly. * IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9993 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 150 END IF * @@ -1711,8 +1814,13 @@ SUBROUTINE SCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( NULL )THEN ISAME( 11 ) = LSE( CS, CC, LCC ) ELSE - ISAME( 11 ) = LSERES( 'SY', UPLO, N, N, CS, - $ CC, LDC ) + IF(.NOT.SKEWFULL) THEN + ISAME( 11 ) = LSERES( 'SY', UPLO, N, N, + $ CS, CC, LDC ) + ELSE + ISAME( 11 ) = LSERES( 'SK', UPLO, N, N, + $ CS, CC, LDC ) + END IF END IF ISAME( 12 ) = LDCS.EQ.LDC * @@ -1727,6 +1835,8 @@ SUBROUTINE SCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 150 END IF * @@ -1734,20 +1844,37 @@ SUBROUTINE SCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * * Check the result column by column. * + IF( .NOT.SKEWFULL.OR.UPPER )THEN JJAB = 1 JC = 1 + ELSE + JJAB = 1 + 2*NMAX + JC = 2 + END IF DO 70 J = 1, N - IF( UPPER )THEN + IF( .NOT.SKEWFULL.AND.UPPER )THEN JJ = 1 LJ = J - ELSE + ELSE IF( .NOT.SKEWFULL.AND..NOT.UPPER ) + $ THEN JJ = J LJ = N - J + 1 + ELSE IF( SKEWFULL.AND.UPPER )THEN + JJ = 1 + LJ = J - 1 + ELSE + JJ = J + 1 + LJ = N - J END IF IF( TRAN )THEN DO 50 I = 1, K - W( I ) = AB( ( J - 1 )*2*NMAX + K + - $ I ) + IF(.NOT.SKEWFULL) THEN + W( I ) = AB( ( J - 1 )*2*NMAX + $ + K + I ) + ELSE + W( I ) = -AB( ( J - 1 )*2*NMAX + $ + K + I ) + END IF W( K + I ) = AB( ( J - 1 )*2*NMAX + $ I ) 50 CONTINUE @@ -1759,8 +1886,13 @@ SUBROUTINE SCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NOUT, .TRUE. ) ELSE DO 60 I = 1, K - W( I ) = AB( ( K + I - 1 )*NMAX + - $ J ) + IF(.NOT.SKEWFULL) THEN + W( I ) = AB( ( K + I - 1 )*NMAX + $ + J ) + ELSE + W( I ) = -AB( ( K + I - 1 )*NMAX + $ + J ) + END IF W( K + I ) = AB( ( I - 1 )*NMAX + $ J ) 60 CONTINUE @@ -1779,6 +1911,9 @@ SUBROUTINE SCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ JJAB = JJAB + 2*NMAX END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -1817,27 +1952,31 @@ SUBROUTINE SCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ LDA, LDB, BETA, LDC * 160 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', - $ 'S)' ) + 9999 FORMAT( ' ', A11, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CAL', + $ 'LS)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', - $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, + 9997 FORMAT( ' ', A11, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' ', + $ 'CALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ', A11, ' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ), - $ F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', C,', I3, ') ', - $ ' .' ) + 9994 FORMAT( 1X, I6, ': ', A11, '(', 2( '''', A1, ''',' ), + $ 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, + $ ', C,', I3, ') .' ) 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A11, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of SCHK5. +* End of SCHK5 * END SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) + IMPLICIT NONE * * Tests the error exits from the Level 3 Blas. * Requires a special version of the error-handling routine XERBLA. @@ -1856,8 +1995,9 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) * * .. Scalar Arguments .. INTEGER ISNUM, NOUT - CHARACTER*6 SRNAMT + CHARACTER*11 SRNAMT * .. Scalars in Common .. + INTEGER NXRUN, NXFAIL, NXBAD INTEGER INFOT, NOUTC LOGICAL LERR, OK * .. Parameters .. @@ -1869,9 +2009,10 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) REAL A( 2, 1 ), B( 2, 1 ), C( 2, 1 ) * .. External Subroutines .. EXTERNAL CHKXER, SGEMM, SSYMM, SSYR2K, SSYRK, STRMM, - $ STRSM + $ STRSM, SGEMMTR * .. Common blocks .. COMMON /INFOC/INFOT, NOUTC, OK, LERR + COMMON /XERCNT/NXRUN, NXFAIL, NXBAD * .. Executable Statements .. * OK is set to .FALSE. by the special version of XERBLA or by CHKXER * if anything is wrong. @@ -1879,13 +2020,18 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) * LERR is set to .TRUE. by the special version of XERBLA each time * it is called, and is then tested and re-set by CHKXER. LERR = .FALSE. +* NXRUN and NXFAIL count the error-exit tests of this routine; +* NXBAD is set by XERBLA when it is called wrongly. + NXRUN = 0 + NXFAIL = 0 + NXBAD = 0 * * Initialize ALPHA and BETA. * ALPHA = ONE BETA = TWO * - GO TO ( 10, 20, 30, 40, 50, 60 )ISNUM + GO TO ( 10, 20, 30, 40, 50, 60, 70, 80, 90 )ISNUM 10 INFOT = 1 CALL SGEMM( '/', 'N', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -1970,7 +2116,7 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 13 CALL SGEMM( 'T', 'T', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 70 + GO TO 100 20 INFOT = 1 CALL SSYMM( '/', 'U', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2037,7 +2183,7 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 12 CALL SSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 70 + GO TO 100 30 INFOT = 1 CALL STRMM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2146,7 +2292,7 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 11 CALL STRMM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 70 + GO TO 100 40 INFOT = 1 CALL STRSM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2255,7 +2401,7 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 11 CALL STRSM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 70 + GO TO 100 50 INFOT = 1 CALL SSYRK( '/', 'N', 0, 0, ALPHA, A, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2310,7 +2456,7 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 10 CALL SSYRK( 'L', 'T', 2, 0, ALPHA, A, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 70 + GO TO 100 60 INFOT = 1 CALL SSYR2K( '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2377,29 +2523,246 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 12 CALL SSYR2K( 'L', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + GO TO 100 + 70 INFOT = 1 + CALL SGEMMTR( '/', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL SGEMMTR( 'U', '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL SGEMMTR( 'U', '/', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL SGEMMTR( 'U', 'N', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL SGEMMTR( 'U', 'T', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL SGEMMTR( 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL SGEMMTR( 'U', 'N', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL SGEMMTR( 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL SGEMMTR( 'U', 'T', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL SGEMMTR( 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL SGEMMTR( 'U', 'N', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL SGEMMTR( 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL SGEMMTR( 'U', 'T', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL SGEMMTR( 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2, BETA, C, + $ 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL SGEMMTR( 'U', 'N', 'T', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 10 + CALL SGEMMTR( 'U', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 10 + CALL SGEMMTR( 'U', 'T', 'N', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 10 + CALL SGEMMTR( 'U', 'N', 'T', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 10 + CALL SGEMMTR( 'U', 'T', 'T', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL SGEMMTR( 'U', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL SGEMMTR( 'U', 'N', 'T', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL SGEMMTR( 'U', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL SGEMMTR( 'U', 'T', 'T', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + GO TO 100 + 80 INFOT = 1 + CALL SSKEWSYMM( '/', 'U', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL SSKEWSYMM( 'L', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL SSKEWSYMM( 'L', 'U', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL SSKEWSYMM( 'R', 'U', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL SSKEWSYMM( 'L', 'L', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL SSKEWSYMM( 'R', 'L', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL SSKEWSYMM( 'L', 'U', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL SSKEWSYMM( 'R', 'U', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL SSKEWSYMM( 'L', 'L', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL SSKEWSYMM( 'R', 'L', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 7 + CALL SSKEWSYMM( 'L', 'U', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 7 + CALL SSKEWSYMM( 'R', 'U', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 7 + CALL SSKEWSYMM( 'L', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 7 + CALL SSKEWSYMM( 'R', 'L', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 9 + CALL SSKEWSYMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 9 + CALL SSKEWSYMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 9 + CALL SSKEWSYMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 9 + CALL SSKEWSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 12 + CALL SSKEWSYMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 12 + CALL SSKEWSYMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 12 + CALL SSKEWSYMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 12 + CALL SSKEWSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + GO TO 100 + 90 INFOT = 1 + CALL SSKEWSYR2K( '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL SSKEWSYR2K( 'U', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL SSKEWSYR2K( 'U', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL SSKEWSYR2K( 'U', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL SSKEWSYR2K( 'L', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL SSKEWSYR2K( 'L', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL SSKEWSYR2K( 'U', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL SSKEWSYR2K( 'U', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL SSKEWSYR2K( 'L', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL SSKEWSYR2K( 'L', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 7 + CALL SSKEWSYR2K( 'U', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 7 + CALL SSKEWSYR2K( 'U', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 7 + CALL SSKEWSYR2K( 'L', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 7 + CALL SSKEWSYR2K( 'L', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 9 + CALL SSKEWSYR2K( 'U', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 9 + CALL SSKEWSYR2K( 'U', 'T', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 9 + CALL SSKEWSYR2K( 'L', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 9 + CALL SSKEWSYR2K( 'L', 'T', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 12 + CALL SSKEWSYR2K( 'U', 'N', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 12 + CALL SSKEWSYR2K( 'U', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 12 + CALL SSKEWSYR2K( 'L', 'N', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 12 + CALL SSKEWSYR2K( 'L', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) * - 70 IF( OK )THEN + 100 IF( OK )THEN WRITE( NOUT, FMT = 9999 )SRNAMT ELSE WRITE( NOUT, FMT = 9998 )SRNAMT END IF + WRITE( NOUT, FMT = 9979 )SRNAMT, NXRUN, NXFAIL RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE TESTS OF ERROR-EXITS' ) - 9998 FORMAT( ' ******* ', A6, ' FAILED THE TESTS OF ERROR-EXITS *****', - $ '**' ) + 9999 FORMAT( ' ', A11, ' PASSED THE TESTS OF ERROR-EXITS' ) + 9998 FORMAT( ' ******* ', A11, ' FAILED THE TESTS OF ERROR-EXITS ****', + $ '***' ) + 9979 FORMAT( ' ', A11, ' ERROR-EXIT TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of SCHKE. +* End of SCHKE * END SUBROUTINE SMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET, $ TRANSL ) + IMPLICIT NONE * * Generates values for an M by N matrix A. * Stores the values in the array AA in the data structure required * by the routine, with unwanted elements set to rogue value. * -* TYPE is 'GE', 'SY' or 'TR'. +* TYPE is 'GE', 'SY', 'SK' or 'TR'. * * Auxiliary routine for test program for Level 3 Blas. * @@ -2424,7 +2787,8 @@ SUBROUTINE SMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET, REAL A( NMAX, * ), AA( * ) * .. Local Scalars .. INTEGER I, IBEG, IEND, J - LOGICAL GEN, LOWER, SYM, TRI, UNIT, UPPER + LOGICAL GEN, LOWER, SYM, TRI, UNIT, UPPER, + $ SKEW * .. External Functions .. REAL SBEG EXTERNAL SBEG @@ -2432,8 +2796,9 @@ SUBROUTINE SMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET, GEN = TYPE.EQ.'GE' SYM = TYPE.EQ.'SY' TRI = TYPE.EQ.'TR' - UPPER = ( SYM.OR.TRI ).AND.UPLO.EQ.'U' - LOWER = ( SYM.OR.TRI ).AND.UPLO.EQ.'L' + SKEW = TYPE.EQ.'SK' + UPPER = ( SYM.OR.SKEW.OR.TRI ).AND.UPLO.EQ.'U' + LOWER = ( SYM.OR.SKEW.OR.TRI ).AND.UPLO.EQ.'L' UNIT = TRI.AND.DIAG.EQ.'U' * * Generate data in array A. @@ -2449,6 +2814,8 @@ SUBROUTINE SMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET, $ A( I, J ) = ZERO IF( SYM )THEN A( J, I ) = A( I, J ) + ELSE IF( SKEW )THEN + A( J, I ) = -A( I, J ) ELSE IF( TRI )THEN A( J, I ) = ZERO END IF @@ -2459,6 +2826,8 @@ SUBROUTINE SMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET, $ A( J, J ) = A( J, J ) + ONE IF( UNIT ) $ A( J, J ) = ONE + IF( SKEW ) + $ A( J, J ) = ZERO 20 CONTINUE * * Store elements in array AS in data structure required by routine. @@ -2472,17 +2841,17 @@ SUBROUTINE SMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET, AA( I + ( J - 1 )*LDA ) = ROGUE 40 CONTINUE 50 CONTINUE - ELSE IF( TYPE.EQ.'SY'.OR.TYPE.EQ.'TR' )THEN + ELSE IF( TYPE.EQ.'SY'.OR.TYPE.EQ.'SK'.OR.TYPE.EQ.'TR' )THEN DO 90 J = 1, N IF( UPPER )THEN IBEG = 1 - IF( UNIT )THEN + IF( UNIT.OR.SKEW )THEN IEND = J - 1 ELSE IEND = J END IF ELSE - IF( UNIT )THEN + IF( UNIT.OR.SKEW )THEN IBEG = J + 1 ELSE IBEG = J @@ -2502,12 +2871,13 @@ SUBROUTINE SMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET, END IF RETURN * -* End of SMAKE. +* End of SMAKE * END SUBROUTINE SMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, $ BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, FATAL, $ NOUT, MV ) + IMPLICIT NONE * * Checks the results of the computational tests. * @@ -2624,10 +2994,11 @@ SUBROUTINE SMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, 9998 FORMAT( 1X, I7, 2G18.6 ) 9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) * -* End of SMMCH. +* End of SMMCH * END LOGICAL FUNCTION LSE( RI, RJ, LR ) + IMPLICIT NONE * * Tests if two arrays are identical. * @@ -2656,14 +3027,15 @@ LOGICAL FUNCTION LSE( RI, RJ, LR ) LSE = .FALSE. 30 RETURN * -* End of LSE. +* End of LSE * END LOGICAL FUNCTION LSERES( TYPE, UPLO, M, N, AA, AS, LDA ) + IMPLICIT NONE * * Tests if selected elements in two arrays are equal. * -* TYPE is 'GE' or 'SY'. +* TYPE is 'GE' or 'SY' or 'SK'. * * Auxiliary routine for test program for Level 3 Blas. * @@ -2691,14 +3063,20 @@ LOGICAL FUNCTION LSERES( TYPE, UPLO, M, N, AA, AS, LDA ) $ GO TO 70 10 CONTINUE 20 CONTINUE - ELSE IF( TYPE.EQ.'SY' )THEN + ELSE IF( TYPE.EQ.'SY'.OR.TYPE.EQ.'SK' )THEN DO 50 J = 1, N - IF( UPPER )THEN + IF( UPPER.AND.TYPE.EQ.'SY' )THEN IBEG = 1 IEND = J - ELSE + ELSE IF( .NOT.UPPER.AND.TYPE.EQ.'SY' )THEN IBEG = J IEND = N + ELSE IF( UPPER.AND.TYPE.EQ.'SK' )THEN + IBEG = 1 + IEND = J - 1 + ELSE + IBEG = J + 1 + IEND = N END IF DO 30 I = 1, IBEG - 1 IF( AA( I, J ).NE.AS( I, J ) ) @@ -2717,10 +3095,11 @@ LOGICAL FUNCTION LSERES( TYPE, UPLO, M, N, AA, AS, LDA ) LSERES = .FALSE. 80 RETURN * -* End of LSERES. +* End of LSERES * END REAL FUNCTION SBEG( RESET ) + IMPLICIT NONE * * Generates random numbers uniformly distributed between -0.5 and 0.5. * @@ -2760,13 +3139,14 @@ REAL FUNCTION SBEG( RESET ) IC = 0 GO TO 10 END IF - SBEG = ( I - 500 )/1001.0 + SBEG = REAL( I - 500 )/1001.0 RETURN * -* End of SBEG. +* End of SBEG * END REAL FUNCTION SDIFF( X, Y ) + IMPLICIT NONE * * Auxiliary routine for test program for Level 3 Blas. * @@ -2782,10 +3162,11 @@ REAL FUNCTION SDIFF( X, Y ) SDIFF = X - Y RETURN * -* End of SDIFF. +* End of SDIFF * END SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + IMPLICIT NONE * * Tests whether XERBLA has detected an error when it should. * @@ -2800,22 +3181,32 @@ SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) * .. Scalar Arguments .. INTEGER INFOT, NOUT LOGICAL LERR, OK - CHARACTER*6 SRNAMT + CHARACTER*11 SRNAMT +* .. Scalars in Common .. + INTEGER NXRUN, NXFAIL, NXBAD +* .. Common blocks .. + COMMON /XERCNT/NXRUN, NXFAIL, NXBAD * .. Executable Statements .. + NXRUN = NXRUN + 1 IF( .NOT.LERR )THEN WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT OK = .FALSE. + NXFAIL = NXFAIL + 1 + ELSE IF( NXBAD.NE.0 )THEN + NXFAIL = NXFAIL + 1 END IF + NXBAD = 0 LERR = .FALSE. RETURN * 9999 FORMAT( ' ***** ILLEGAL VALUE OF PARAMETER NUMBER ', I2, ' NOT D', - $ 'ETECTED BY ', A6, ' *****' ) + $ 'ETECTED BY ', A11, ' *****' ) * -* End of CHKXER. +* End of CHKXER * END SUBROUTINE XERBLA( SRNAME, INFO ) + IMPLICIT NONE * * This is a special version of XERBLA to be used only as part of * the test program for testing error exits from the Level 3 BLAS @@ -2836,14 +3227,18 @@ SUBROUTINE XERBLA( SRNAME, INFO ) * * .. Scalar Arguments .. INTEGER INFO - CHARACTER*6 SRNAME + CHARACTER*(*) SRNAME * .. Scalars in Common .. + INTEGER NXRUN, NXFAIL, NXBAD INTEGER INFOT, NOUT LOGICAL LERR, OK - CHARACTER*6 SRNAMT + CHARACTER*11 SRNAMT * .. Common blocks .. COMMON /INFOC/INFOT, NOUT, OK, LERR + COMMON /XERCNT/NXRUN, NXFAIL, NXBAD COMMON /SRNAMC/SRNAMT +* .. Locals .. + INTEGER SRLEN * .. Executable Statements .. LERR = .TRUE. IF( INFO.NE.INFOT )THEN @@ -2853,17 +3248,20 @@ SUBROUTINE XERBLA( SRNAME, INFO ) WRITE( NOUT, FMT = 9997 )INFO END IF OK = .FALSE. + NXBAD = 1 END IF - IF( SRNAME.NE.SRNAMT )THEN + SRLEN = MIN(LEN_TRIM(SRNAME), LEN_TRIM(SRNAMT)) + IF( SRNAME(1:SRLEN).NE.SRNAMT(1:SRLEN) )THEN WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT OK = .FALSE. + NXBAD = 1 END IF RETURN * 9999 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6, ' INSTEAD', $ ' OF ', I2, ' *******' ) - 9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A6, ' INSTE', - $ 'AD OF ', A6, ' *******' ) + 9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A, ' INST', + $ 'EAD OF ', A11, ' *******' ) 9997 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6, $ ' *******' ) * @@ -2871,3 +3269,434 @@ SUBROUTINE XERBLA( SRNAME, INFO ) * END + + SUBROUTINE SCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, + $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, + $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G ) + IMPLICIT NONE +* +* Tests SGEMMTR. +* +* Auxiliary routine for test program for Level 3 Blas. +* +* -- Written on 19-July-2023. +* Martin Koehler, MPI Magdeburg +* +* .. Parameters .. + REAL ZERO + PARAMETER ( ZERO = 0.0D0 ) +* .. Scalar Arguments .. + REAL EPS, THRESH + INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA + LOGICAL FATAL, REWI, TRACE + CHARACTER*11 SNAME +* .. Array Arguments .. + REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), + $ AS( NMAX*NMAX ), B( NMAX, NMAX ), + $ BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ), + $ C( NMAX, NMAX ), CC( NMAX*NMAX ), + $ CS( NMAX*NMAX ), CT( NMAX ), G( NMAX ) + INTEGER IDIM( NIDIM ) +* .. Local Scalars .. + REAL ALPHA, ALS, BETA, BLS, ERR, ERRMAX + INTEGER NTESTS, NFAILS + INTEGER I, IA, IB, ICA, ICB, IK, IN, K, KS, LAA, + $ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, + $ MA, MB, N, NA, NARGS, NB, NC, NS, IS + LOGICAL NULL, RESET, SAME, TRANA, TRANB + CHARACTER*1 TRANAS, TRANBS, TRANSA, TRANSB, UPLO, UPLOS + CHARACTER*3 ICH + CHARACTER*2 ISHAPE +* .. Local Arrays .. + LOGICAL ISAME( 13 ) +* .. External Functions .. + LOGICAL LSE, LSERES + EXTERNAL LSE, LSERES +* .. External Subroutines .. + EXTERNAL SGEMMTR, SMAKE, SMMTCH +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. Scalars in Common .. + INTEGER INFOT, NOUTC + LOGICAL LERR, OK +* .. Common blocks .. + COMMON /INFOC/INFOT, NOUTC, OK, LERR +* .. Data statements .. + DATA ICH/'NTC'/ + DATA ISHAPE/'UL'/ +* .. Executable Statements .. +* + NARGS = 13 + NC = 0 + RESET = .TRUE. + ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 +* + DO 100 IN = 1, NIDIM + N = IDIM( IN ) +* Set LDC to 1 more than minimum value if room. + LDC = N + IF( LDC.LT.NMAX ) + $ LDC = LDC + 1 +* Skip tests if not enough room. + IF( LDC.GT.NMAX ) + $ GO TO 100 + LCC = LDC*N + NULL = N.LE.0 +* + DO 90 IK = 1, NIDIM + K = IDIM( IK ) +* + DO 80 ICA = 1, 3 + TRANSA = ICH( ICA: ICA ) + TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' +* + IF( TRANA )THEN + MA = K + NA = N + ELSE + MA = N + NA = K + END IF +* Set LDA to 1 more than minimum value if room. + LDA = MA + IF( LDA.LT.NMAX ) + $ LDA = LDA + 1 +* Skip tests if not enough room. + IF( LDA.GT.NMAX ) + $ GO TO 80 + LAA = LDA*NA +* +* Generate the matrix A. +* + CALL SMAKE( 'GE', ' ', ' ', MA, NA, A, NMAX, AA, LDA, + $ RESET, ZERO ) +* + DO 70 ICB = 1, 3 + TRANSB = ICH( ICB: ICB ) + TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' +* + IF( TRANB )THEN + MB = N + NB = K + ELSE + MB = K + NB = N + END IF +* Set LDB to 1 more than minimum value if room. + LDB = MB + IF( LDB.LT.NMAX ) + $ LDB = LDB + 1 +* Skip tests if not enough room. + IF( LDB.GT.NMAX ) + $ GO TO 70 + LBB = LDB*NB +* +* Generate the matrix B. +* + CALL SMAKE( 'GE', ' ', ' ', MB, NB, B, NMAX, BB, + $ LDB, RESET, ZERO ) +* + DO 60 IA = 1, NALF + ALPHA = ALF( IA ) +* + DO 50 IB = 1, NBET + BETA = BET( IB ) + + DO 45 IS = 1, 2 + UPLO = ISHAPE( IS: IS ) + +* +* Generate the matrix C. +* + CALL SMAKE( 'GE', UPLO, ' ', N, N, C, + $ NMAX, CC, LDC, RESET, ZERO ) +* + NC = NC + 1 +* +* Save every datum before calling the +* subroutine. +* + UPLOS = UPLO + TRANAS = TRANSA + TRANBS = TRANSB + NS = N + KS = K + ALS = ALPHA + DO 10 I = 1, LAA + AS( I ) = AA( I ) + 10 CONTINUE + LDAS = LDA + DO 20 I = 1, LBB + BS( I ) = BB( I ) + 20 CONTINUE + LDBS = LDB + BLS = BETA + DO 30 I = 1, LCC + CS( I ) = CC( I ) + 30 CONTINUE + LDCS = LDC +* +* Call the subroutine. +* + IF( TRACE ) + $ WRITE( NTRA, FMT = 9995 )NC, SNAME, + $ UPLO, TRANSA, TRANSB, N, K, ALPHA, LDA, + $ LDB, BETA, LDC + IF( REWI ) + $ REWIND NTRA + CALL SGEMMTR( UPLO, TRANSA, TRANSB, N, + $ K, ALPHA, AA, LDA, BB, LDB, + $ BETA, CC, LDC ) +* +* Check if error-exit was taken incorrectly. +* + IF( .NOT.OK )THEN + WRITE( NOUT, FMT = 9994 ) + FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 + GO TO 120 + END IF +* +* See what data changed inside subroutines. +* + ISAME( 1 ) = UPLO.EQ.UPLOS + ISAME( 2 ) = TRANSA.EQ.TRANAS + ISAME( 3 ) = TRANSB.EQ.TRANBS + ISAME( 4 ) = NS.EQ.N + ISAME( 5 ) = KS.EQ.K + ISAME( 6 ) = ALS.EQ.ALPHA + ISAME( 7 ) = LSE( AS, AA, LAA ) + ISAME( 8 ) = LDAS.EQ.LDA + ISAME( 9 ) = LSE( BS, BB, LBB ) + ISAME( 10 ) = LDBS.EQ.LDB + ISAME( 11 ) = BLS.EQ.BETA + IF( NULL )THEN + ISAME( 12 ) = LSE( CS, CC, LCC ) + ELSE + ISAME( 12 ) = LSERES( 'GE', ' ', N, N, + $ CS, CC, LDC ) + END IF + ISAME( 13 ) = LDCS.EQ.LDC +* +* If data was incorrectly changed, report +* and return. +* + SAME = .TRUE. + DO 40 I = 1, NARGS + SAME = SAME.AND.ISAME( I ) + IF( .NOT.ISAME( I ) ) + $ WRITE( NOUT, FMT = 9998 )I + 40 CONTINUE + IF( .NOT.SAME )THEN + FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 + GO TO 120 + END IF +* + IF( .NOT.NULL )THEN +* +* Check the result. +* + CALL SMMTCH( UPLO, TRANSA, TRANSB, + $ N, K, + $ ALPHA, A, NMAX, B, NMAX, BETA, + $ C, NMAX, CT, G, CC, LDC, EPS, + $ ERR, FATAL, NOUT, .TRUE. ) + ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 +* If got really bad answer, report and +* return. + IF( FATAL ) + $ GO TO 120 + END IF +* + 45 CONTINUE +* + 50 CONTINUE +* + 60 CONTINUE +* + 70 CONTINUE +* + 80 CONTINUE +* + 90 CONTINUE +* + 100 CONTINUE +* +* +* Report result. +* + IF( ERRMAX.LT.THRESH )THEN + WRITE( NOUT, FMT = 9999 )SNAME, NC + ELSE + WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX + END IF + GO TO 130 +* + 120 CONTINUE + WRITE( NOUT, FMT = 9996 )SNAME + WRITE( NOUT, FMT = 9995 )NC, SNAME, UPLO, TRANSA, TRANSB, N, K, + $ ALPHA, LDA, LDB, BETA, LDC +* + 130 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + RETURN +* + 9999 FORMAT( ' ', A11, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CAL', + $ 'LS)' ) + 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', + $ 'ANGED INCORRECTLY *******' ) + 9997 FORMAT( ' ', A11, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' ', + $ 'CALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, + $ ' - SUSPECT *******' ) + 9996 FORMAT( ' ******* ', A11, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A11, '(''', A1, ''',''', A1, ''',''', A1, + $ ''',', 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', + $ F4.1, ', ', 'C,', I3, ').' ) + 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', + $ '******' ) + 9979 FORMAT( ' ', A11, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) +* +* End of DCHK6 +* + END + + SUBROUTINE SMMTCH( UPLO, TRANSA, TRANSB, N, KK, ALPHA, A, LDA, + $ B, LDB, BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, + $ FATAL, NOUT, MV ) + IMPLICIT NONE +* +* Checks the results of the computational tests. +* +* Auxiliary routine for test program for Level 3 Blas. (SGEMMTR) +* +* -- Written on 19-July-2023. +* Martin Koehler, MPI Magdeburg +* +* .. Parameters .. + REAL ZERO, ONE + PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) +* .. Scalar Arguments .. + REAL ALPHA, BETA, EPS, ERR + INTEGER KK, LDA, LDB, LDC, LDCC, N, NOUT + LOGICAL FATAL, MV + CHARACTER*1 UPLO, TRANSA, TRANSB +* .. Array Arguments .. + REAL A( LDA, * ), B( LDB, * ), C( LDC, * ), + $ CC( LDCC, * ), CT( * ), G( * ) +* .. Local Scalars .. + REAL ERRI + INTEGER I, J, K, ISTART, ISTOP + LOGICAL TRANA, TRANB, UPPER +* .. Intrinsic Functions .. + INTRINSIC ABS, MAX, SQRT +* .. Executable Statements .. + UPPER = UPLO.EQ.'U' + TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' + TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' +* +* Compute expected result, one column at a time, in CT using data +* in A, B and C. +* Compute gauges in G. +* + ISTART = 1 + ISTOP = N + + DO 120 J = 1, N +* + IF ( UPPER ) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + DO 10 I = ISTART, ISTOP + CT( I ) = ZERO + G( I ) = ZERO + 10 CONTINUE + IF( .NOT.TRANA.AND..NOT.TRANB )THEN + DO 30 K = 1, KK + DO 20 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*B( K, J ) + G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( K, J ) ) + 20 CONTINUE + 30 CONTINUE + ELSE IF( TRANA.AND..NOT.TRANB )THEN + DO 50 K = 1, KK + DO 40 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*B( K, J ) + G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( K, J ) ) + 40 CONTINUE + 50 CONTINUE + ELSE IF( .NOT.TRANA.AND.TRANB )THEN + DO 70 K = 1, KK + DO 60 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*B( J, K ) + G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( J, K ) ) + 60 CONTINUE + 70 CONTINUE + ELSE IF( TRANA.AND.TRANB )THEN + DO 90 K = 1, KK + DO 80 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*B( J, K ) + G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( J, K ) ) + 80 CONTINUE + 90 CONTINUE + END IF + DO 100 I = ISTART, ISTOP + CT( I ) = ALPHA*CT( I ) + BETA*C( I, J ) + G( I ) = ABS( ALPHA )*G( I ) + ABS( BETA )*ABS( C( I, J ) ) + 100 CONTINUE +* +* Compute the error ratio for this result. +* + ERR = ZERO + DO 110 I = ISTART, ISTOP + ERRI = ABS( CT( I ) - CC( I, J ) )/EPS + IF( G( I ).NE.ZERO ) + $ ERRI = ERRI/G( I ) + ERR = MAX( ERR, ERRI ) + IF( ERR*SQRT( EPS ).GE.ONE ) + $ GO TO 130 + 110 CONTINUE +* + 120 CONTINUE +* +* If the loop completes, all results are at least half accurate. + GO TO 150 +* +* Report fatal error. +* + 130 FATAL = .TRUE. + WRITE( NOUT, FMT = 9999 ) + DO 140 I = ISTART, ISTOP + IF( MV )THEN + WRITE( NOUT, FMT = 9998 )I, CT( I ), CC( I, J ) + ELSE + WRITE( NOUT, FMT = 9998 )I, CC( I, J ), CT( I ) + END IF + 140 CONTINUE + IF( N.GT.1 ) + $ WRITE( NOUT, FMT = 9997 )J +* + 150 CONTINUE + RETURN +* + 9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL', + $ 'F ACCURATE *******', /' EXPECTED RESULT COMPU', + $ 'TED RESULT' ) + 9998 FORMAT( 1X, I7, 2G18.6 ) + 9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) +* +* End of DMMTCH +* + END diff --git a/BLAS/TESTING/sblat3.in b/BLAS/TESTING/sblat3.in index 5c4e3b83e1..6aac3da81b 100644 --- a/BLAS/TESTING/sblat3.in +++ b/BLAS/TESTING/sblat3.in @@ -12,9 +12,12 @@ T LOGICAL FLAG, T TO TEST ERROR EXITS. 0.0 1.0 0.7 VALUES OF ALPHA 3 NUMBER OF VALUES OF BETA 0.0 1.0 1.3 VALUES OF BETA -SGEMM T PUT F FOR NO TEST. SAME COLUMNS. -SSYMM T PUT F FOR NO TEST. SAME COLUMNS. -STRMM T PUT F FOR NO TEST. SAME COLUMNS. -STRSM T PUT F FOR NO TEST. SAME COLUMNS. -SSYRK T PUT F FOR NO TEST. SAME COLUMNS. -SSYR2K T PUT F FOR NO TEST. SAME COLUMNS. +SGEMM T PUT F FOR NO TEST. SAME COLUMNS. +SSYMM T PUT F FOR NO TEST. SAME COLUMNS. +STRMM T PUT F FOR NO TEST. SAME COLUMNS. +STRSM T PUT F FOR NO TEST. SAME COLUMNS. +SSYRK T PUT F FOR NO TEST. SAME COLUMNS. +SSYR2K T PUT F FOR NO TEST. SAME COLUMNS. +SGEMMTR T PUT F FOR NO TEST. SAME COLUMNS. +SSKEWSYMM T PUT F FOR NO TEST. SAME COLUMNS. +SSKEWSYR2K T PUT F FOR NO TEST. SAME COLUMNS. diff --git a/BLAS/TESTING/zblat1.f b/BLAS/TESTING/zblat1.f index 4b0bcf8849..0c45936b81 100644 --- a/BLAS/TESTING/zblat1.f +++ b/BLAS/TESTING/zblat1.f @@ -30,17 +30,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date April 2012 -* *> \ingroup complex16_blas_testing * * ===================================================================== PROGRAM ZBLAT1 + IMPLICIT NONE * -* -- Reference BLAS test routine (version 3.7.0) -- +* -- Reference BLAS test routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* April 2012 * * ===================================================================== * @@ -48,20 +46,26 @@ PROGRAM ZBLAT1 INTEGER NOUT PARAMETER (NOUT=6) * .. Scalars in Common .. + INTEGER NTESTS, NFAILS + CHARACTER*6 SUBNAM INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Scalars .. + DOUBLE PRECISION S1, S2 DOUBLE PRECISION SFAC INTEGER IC * .. External Subroutines .. EXTERNAL CHECK1, CHECK2, HEADER * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS + COMMON /CNTBLA/NTESTS, NFAILS + COMMON /NAMBLA/SUBNAM * .. Data statements .. DATA SFAC/9.765625D-4/ * .. Executable Statements .. + CALL CPU_TIME( S1 ) WRITE (NOUT,99999) - DO 20 IC = 1, 10 + DO 20 IC = 1, 11 ICASE = IC CALL HEADER * @@ -71,33 +75,46 @@ PROGRAM ZBLAT1 * these parameters. * PASS = .TRUE. + NTESTS = 0 + NFAILS = 0 INCX = 9999 INCY = 9999 MODE = 9999 - IF (ICASE.LE.5) THEN + IF (ICASE.LE.5 .OR. ICASE.EQ.11) THEN CALL CHECK2(SFAC) ELSE IF (ICASE.GE.6) THEN CALL CHECK1(SFAC) END IF * -- Print IF (PASS) WRITE (NOUT,99998) + WRITE (NOUT,99997) SUBNAM, NTESTS, NFAILS 20 CONTINUE + CALL CPU_TIME( S2 ) + WRITE (NOUT,99996) S2 - S1 STOP * 99999 FORMAT (' Complex BLAS Test Program Results',/1X) 99998 FORMAT (' ----- PASS -----') +99997 FORMAT (1X,A6,' COMPUTATIONAL TESTS:',I9,' RUN,',I9, + + ' FAILED') +99996 FORMAT (' Total time used = ',F12.2,' seconds',/) +* +* End of ZBLAT1 +* END SUBROUTINE HEADER * .. Parameters .. INTEGER NOUT PARAMETER (NOUT=6) * .. Scalars in Common .. + CHARACTER*6 SUBNAM INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Arrays .. - CHARACTER*6 L(10) + CHARACTER*6 L(11) * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS + COMMON /NAMBLA/SUBNAM * .. Data statements .. DATA L(1)/'ZDOTC '/ DATA L(2)/'ZDOTU '/ @@ -109,16 +126,24 @@ SUBROUTINE HEADER DATA L(8)/'ZSCAL '/ DATA L(9)/'ZDSCAL'/ DATA L(10)/'IZAMAX'/ + DATA L(11)/'ZAXPBY'/ + * .. Executable Statements .. + SUBNAM = L(ICASE) WRITE (NOUT,99999) ICASE, L(ICASE) RETURN * 99999 FORMAT (/' Test of subprogram number',I3,12X,A6) +* +* End of HEADER +* END SUBROUTINE CHECK1(SFAC) + IMPLICIT NONE * .. Parameters .. INTEGER NOUT - PARAMETER (NOUT=6) + DOUBLE PRECISION THRESH + PARAMETER (NOUT=6, THRESH=10.0D0) * .. Scalar Arguments .. DOUBLE PRECISION SFAC * .. Scalars in Common .. @@ -127,18 +152,18 @@ SUBROUTINE CHECK1(SFAC) * .. Local Scalars .. COMPLEX*16 CA DOUBLE PRECISION SA - INTEGER I, J, LEN, NP1 + INTEGER I, IX, J, LEN, NP1 * .. Local Arrays .. - COMPLEX*16 CTRUE5(8,5,2), CTRUE6(8,5,2), CV(8,5,2), CX(8), - + MWPCS(5), MWPCT(5) + COMPLEX*16 CTRUE5(8,5,2), CTRUE6(8,5,2), CV(8,5,2), CVR(8), + + CX(8), CXR(15), MWPCS(5), MWPCT(5) DOUBLE PRECISION STRUE2(5), STRUE4(5) - INTEGER ITRUE3(5) + INTEGER ITRUE3(5), ITRUEC(5) * .. External Functions .. DOUBLE PRECISION DZASUM, DZNRM2 INTEGER IZAMAX EXTERNAL DZASUM, DZNRM2, IZAMAX * .. External Subroutines .. - EXTERNAL ZSCAL, ZDSCAL, CTEST, ITEST1, STEST1 + EXTERNAL ZB1NRM2, ZSCAL, ZDSCAL, CTEST, ITEST1, STEST1 * .. Intrinsic Functions .. INTRINSIC MAX * .. Common blocks .. @@ -173,6 +198,9 @@ SUBROUTINE CHECK1(SFAC) + (7.0D0,2.0D0), (0.3D0,0.1D0), (5.0D0,8.0D0), + (0.5D0,0.0D0), (6.0D0,9.0D0), (0.0D0,0.5D0), + (8.0D0,3.0D0), (0.0D0,0.2D0), (9.0D0,4.0D0)/ + DATA CVR/(8.0D0,8.0D0), (-7.0D0,-7.0D0), + + (9.0D0,9.0D0), (5.0D0,5.0D0), (9.0D0,9.0D0), + + (8.0D0,8.0D0), (7.0D0,7.0D0), (7.0D0,7.0D0)/ DATA STRUE2/0.0D0, 0.5D0, 0.6D0, 0.7D0, 0.8D0/ DATA STRUE4/0.0D0, 0.7D0, 1.0D0, 1.3D0, 1.6D0/ DATA ((CTRUE5(I,J,1),I=1,8),J=1,5)/(0.1D0,0.1D0), @@ -238,6 +266,7 @@ SUBROUTINE CHECK1(SFAC) + (0.15D0,0.00D0), (6.0D0,9.0D0), (0.00D0,0.15D0), + (8.0D0,3.0D0), (0.00D0,0.06D0), (9.0D0,4.0D0)/ DATA ITRUE3/0, 1, 2, 2, 2/ + DATA ITRUEC/0, 1, 1, 1, 1/ * .. Executable Statements .. DO 60 INCX = 1, 2 DO 40 NP1 = 1, 5 @@ -249,6 +278,10 @@ SUBROUTINE CHECK1(SFAC) 20 CONTINUE IF (ICASE.EQ.6) THEN * .. DZNRM2 .. +* Test scaling when some entries are tiny or huge + CALL ZB1NRM2(N,(INCX-2)*2,THRESH) + CALL ZB1NRM2(N,INCX,THRESH) +* Test with hardcoded mid range entries CALL STEST1(DZNRM2(N,CX,INCX),STRUE2(NP1),STRUE2(NP1), + SFAC) ELSE IF (ICASE.EQ.7) THEN @@ -268,12 +301,25 @@ SUBROUTINE CHECK1(SFAC) ELSE IF (ICASE.EQ.10) THEN * .. IZAMAX .. CALL ITEST1(IZAMAX(N,CX,INCX),ITRUE3(NP1)) + DO 160 I = 1, LEN + CX(I) = (42.0D0,43.0D0) + 160 CONTINUE + CALL ITEST1(IZAMAX(N,CX,INCX),ITRUEC(NP1)) ELSE WRITE (NOUT,*) ' Shouldn''t be here in CHECK1' STOP END IF * 40 CONTINUE + IF (ICASE.EQ.10) THEN + N = 8 + IX = 1 + DO 180 I = 1, N + CXR(IX) = CVR(I) + IX = IX + INCX + 180 CONTINUE + CALL ITEST1(IZAMAX(N,CXR,INCX),3) + END IF 60 CONTINUE * INCX = 1 @@ -315,8 +361,12 @@ SUBROUTINE CHECK1(SFAC) CALL CTEST(5,CX,MWPCT,MWPCS,SFAC) END IF RETURN +* +* End of CHECK1 +* END SUBROUTINE CHECK2(SFAC) + IMPLICIT NONE * .. Parameters .. INTEGER NOUT PARAMETER (NOUT=6) @@ -326,24 +376,27 @@ SUBROUTINE CHECK2(SFAC) INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Scalars .. - COMPLEX*16 CA - INTEGER I, J, KI, KN, KSIZE, LENX, LENY, MX, MY + COMPLEX*16 CA, CB + INTEGER I, J, KI, KN, KSIZE, LENX, LENY, LINCX, LINCY, + + MX, MY * .. Local Arrays .. COMPLEX*16 CDOT(1), CSIZE1(4), CSIZE2(7,2), CSIZE3(14), + CT10X(7,4,4), CT10Y(7,4,4), CT6(4,4), CT7(4,4), - + CT8(7,4,4), CX(7), CX1(7), CY(7), CY1(7) + + CT8(7,4,4), CTY0(1), CX(7), CX0(1), CX1(7), + + CY(7), CY0(1), CY1(7), CT11(7,4,4) INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4) * .. External Functions .. COMPLEX*16 ZDOTC, ZDOTU EXTERNAL ZDOTC, ZDOTU * .. External Subroutines .. - EXTERNAL ZAXPY, ZCOPY, ZSWAP, CTEST + EXTERNAL ZAXPY, ZAXPBY, ZCOPY, ZSWAP, CTEST * .. Intrinsic Functions .. INTRINSIC ABS, MIN * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS * .. Data statements .. DATA CA/(0.4D0,-0.7D0)/ + DATA CB/(0.7D0,-0.4D0)/ DATA INCXS/1, 2, -2, -1/ DATA INCYS/1, -2, 1, -2/ DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/ @@ -513,6 +566,54 @@ SUBROUTINE CHECK2(SFAC) + (1.54D0,1.54D0), (1.54D0,1.54D0), + (1.54D0,1.54D0), (1.54D0,1.54D0), + (1.54D0,1.54D0), (1.54D0,1.54D0)/ + + DATA ((CT11(I,J,1),I=1,7),J=1,4)/(0.6D0,-0.6D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (-0.1D0,-1.47D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (-0.1D0,-1.47D0), + + (-1.08D0,0.71D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (-0.1D0,-1.47D0), (-1.08D0,0.71D0), + + (-0.42D0,-0.99D0), (-0.61D0,-0.85D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/ + DATA ((CT11(I,J,2),I=1,7),J=1,4)/(0.6D0,-0.6D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (-0.1D0,-1.47D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (-0.49D0,-0.95D0), + + (-0.9D0,0.5D0),(-0.03D0,-1.51D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.36D0,0.00D0), (-0.9D0,0.5D0), + + (-0.39D0,-0.23D0), (0.1D0,-0.5D0), + + (-0.82D0,-0.39D0), (-0.5D0,-0.3D0), + + (0.0D0,-1.62D0)/ + DATA ((CT11(I,J,3),I=1,7),J=1,4)/(0.6D0,-0.6D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (-0.1D0,-1.47D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (-0.49D0,-0.95D0), + + (-0.71D0,-0.1D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.36D0,0.00D0), (-1.07D0,1.18D0), + + (-0.42D0,-0.99D0), (-0.41D0,-1.2D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/ + DATA ((CT11(I,J,4),I=1,7),J=1,4)/(0.6D0,-0.6D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (-0.1D0,-1.47D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (-0.1D0,-1.47D0), (-0.9D0,0.5D0), + + (-0.4D0,-0.7D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (-0.1D0,-1.47D0), + + (-0.9D0,0.5D0),(-0.4D0,-0.7D0), (0.1D0,-0.5D0), + + (-0.82D0,-0.39D0), (-0.5D0,-0.3D0), + + (-0.2D0,-1.27D0)/ + + * .. Executable Statements .. DO 60 KI = 1, 4 INCX = INCXS(KI) @@ -546,11 +647,32 @@ SUBROUTINE CHECK2(SFAC) * .. ZCOPY .. CALL ZCOPY(N,CX,INCX,CY,INCY) CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0D0) + IF (KI.EQ.1) THEN + CX0(1) = (42.0D0,43.0D0) + CY0(1) = (44.0D0,45.0D0) + IF (N.EQ.0) THEN + CTY0(1) = CY0(1) + ELSE + CTY0(1) = CX0(1) + END IF + LINCX = INCX + INCX = 0 + LINCY = INCY + INCY = 0 + CALL ZCOPY(N,CX0,INCX,CY0,INCY) + CALL CTEST(1,CY0,CTY0,CSIZE3,1.0D0) + INCX = LINCX + INCY = LINCY + END IF ELSE IF (ICASE.EQ.5) THEN * .. ZSWAP .. CALL ZSWAP(N,CX,INCX,CY,INCY) CALL CTEST(LENX,CX,CT10X(1,KN,KI),CSIZE3,1.0D0) CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0D0) + ELSE IF (ICASE.EQ.11) THEN +* .. ZAXPY .. + CALL ZAXPBY(N,CA,CX,INCX,CB, CY,INCY) + CALL CTEST(LENY,CY,CT11(1,KN,KI),CSIZE2(1,KSIZE),SFAC) ELSE WRITE (NOUT,*) ' Shouldn''t be here in CHECK2' STOP @@ -559,8 +681,12 @@ SUBROUTINE CHECK2(SFAC) 40 CONTINUE 60 CONTINUE RETURN +* +* End of CHECK2 +* END SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC) + IMPLICIT NONE * ********************************* STEST ************************** * * THIS SUBR COMPARES ARRAYS SCOMP() AND STRUE() OF LENGTH LEN TO @@ -579,6 +705,7 @@ SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC) * .. Array Arguments .. DOUBLE PRECISION SCOMP(LEN), SSIZE(LEN), STRUE(LEN) * .. Scalars in Common .. + INTEGER NTESTS, NFAILS INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Scalars .. @@ -591,12 +718,15 @@ SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC) INTRINSIC ABS * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS + COMMON /CNTBLA/NTESTS, NFAILS * .. Executable Statements .. * DO 40 I = 1, LEN + NTESTS = NTESTS + 1 SD = SCOMP(I) - STRUE(I) IF (ABS(SFAC*SD) .LE. ABS(SSIZE(I))*EPSILON(ZERO)) + GO TO 40 + NFAILS = NFAILS + 1 * * HERE SCOMP(I) IS NOT CLOSE TO STRUE(I). * @@ -615,11 +745,15 @@ SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC) + ' COMP(I) TRUE(I) DIFFERENCE', + ' SIZE(I)',/1X) 99997 FORMAT (1X,I4,I3,3I5,I3,2D36.8,2D12.4) +* +* End of STEST +* END SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC) + IMPLICIT NONE * ************************* STEST1 ***************************** * -* THIS IS AN INTERFACE SUBROUTINE TO ACCOMODATE THE FORTRAN +* THIS IS AN INTERFACE SUBROUTINE TO ACCOMMODATE THE FORTRAN * REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE * ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT. * @@ -640,8 +774,12 @@ SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC) CALL STEST(1,SCOMP,STRUE,SSIZE,SFAC) * RETURN +* +* End of STEST1 +* END DOUBLE PRECISION FUNCTION SDIFF(SA,SB) + IMPLICIT NONE * ********************************* SDIFF ************************** * COMPUTES DIFFERENCE OF TWO NUMBERS. C. L. LAWSON, JPL 1974 FEB 15 * @@ -650,8 +788,12 @@ DOUBLE PRECISION FUNCTION SDIFF(SA,SB) * .. Executable Statements .. SDIFF = SA - SB RETURN +* +* End of SDIFF +* END SUBROUTINE CTEST(LEN,CCOMP,CTRUE,CSIZE,SFAC) + IMPLICIT NONE * **************************** CTEST ***************************** * * C.L. LAWSON, JPL, 1978 DEC 6 @@ -681,8 +823,12 @@ SUBROUTINE CTEST(LEN,CCOMP,CTRUE,CSIZE,SFAC) * CALL STEST(2*LEN,SCOMP,STRUE,SSIZE,SFAC) RETURN +* +* End of CTEST +* END SUBROUTINE ITEST1(ICOMP,ITRUE) + IMPLICIT NONE * ********************************* ITEST1 ************************* * * THIS SUBROUTINE COMPARES THE VARIABLES ICOMP AND ITRUE FOR @@ -695,14 +841,18 @@ SUBROUTINE ITEST1(ICOMP,ITRUE) * .. Scalar Arguments .. INTEGER ICOMP, ITRUE * .. Scalars in Common .. + INTEGER NTESTS, NFAILS INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Scalars .. INTEGER ID * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS + COMMON /CNTBLA/NTESTS, NFAILS * .. Executable Statements .. + NTESTS = NTESTS + 1 IF (ICOMP.EQ.ITRUE) GO TO 40 + NFAILS = NFAILS + 1 * * HERE ICOMP IS NOT EQUAL TO ITRUE. * @@ -721,4 +871,246 @@ SUBROUTINE ITEST1(ICOMP,ITRUE) + ' COMP TRUE DIFFERENCE', + /1X) 99997 FORMAT (1X,I4,I3,3I5,2I36,I12) +* +* End of ITEST1 +* + END + SUBROUTINE ZB1NRM2(N,INCX,THRESH) + IMPLICIT NONE +* Compare NRM2 with a reference computation using combinations +* of the following values: +* +* 0, very small, small, ulp, 1, 1/ulp, big, very big, infinity, NaN +* +* one of these values is used to initialize x(1) and x(2:N) is +* filled with random values from [-1,1] scaled by another of +* these values. +* +* This routine is adapted from the test suite provided by +* Anderson E. (2017) +* Algorithm 978: Safe Scaling in the Level 1 BLAS +* ACM Trans Math Softw 44:1--28 +* https://doi.org/10.1145/3061665 +* +* .. Scalar Arguments .. + INTEGER INCX, N + DOUBLE PRECISION THRESH +* +* ===================================================================== +* .. Parameters .. + INTEGER NMAX, NOUT, NV + PARAMETER (NMAX=20, NOUT=6, NV=10) + DOUBLE PRECISION HALF, ONE, THREE, TWO, ZERO + PARAMETER (HALF=0.5D+0, ONE=1.0D+0, TWO= 2.0D+0, + & THREE=3.0D+0, ZERO=0.0D+0) +* .. External Functions .. + DOUBLE PRECISION DZNRM2 + EXTERNAL DZNRM2 +* .. Intrinsic Functions .. + INTRINSIC AIMAG, ABS, DCMPLX, DBLE, MAX, MIN, SQRT +* .. Model parameters .. + DOUBLE PRECISION BIGNUM, SAFMAX, SAFMIN, SMLNUM, ULP + PARAMETER (BIGNUM=0.99792015476735990583D+292, + & SAFMAX=0.44942328371557897693D+308, + & SAFMIN=0.22250738585072013831D-307, + & SMLNUM=0.10020841800044863890D-291, + & ULP=0.22204460492503130808D-015) +* .. Local Scalars .. + COMPLEX*16 ROGUE + DOUBLE PRECISION SNRM, TRAT, V0, V1, WORKSSQ, Y1, Y2, + & YMAX, YMIN, YNRM, ZNRM + INTEGER I, IV, IW, IX, KS + LOGICAL FIRST +* .. Local Arrays .. + COMPLEX*16 X(NMAX), Z(NMAX) + DOUBLE PRECISION VALUES(NV), WORK(NMAX) +* .. Scalars in Common .. + INTEGER NTESTS, NFAILS +* .. Common blocks .. + COMMON /CNTBLA/NTESTS, NFAILS +* .. Executable Statements .. + VALUES(1) = ZERO + VALUES(2) = TWO*SAFMIN + VALUES(3) = SMLNUM + VALUES(4) = ULP + VALUES(5) = ONE + VALUES(6) = ONE / ULP + VALUES(7) = BIGNUM + VALUES(8) = SAFMAX + VALUES(9) = DXVALS(V0,2) + VALUES(10) = DXVALS(V0,3) + ROGUE = DCMPLX(1234.5678D+0,-1234.5678D+0) + FIRST = .TRUE. +* +* Check that the arrays are large enough +* + IF (N*ABS(INCX).GT.NMAX) THEN + WRITE (NOUT,99) "DZNRM2", NMAX, INCX, N, N*ABS(INCX) + RETURN + END IF +* +* Zero-sized inputs are tested in STEST1. + IF (N.LE.0) THEN + RETURN + END IF +* +* Generate 2*(N-1) values in (-1,1). +* + KS = 2*(N-1) + DO I = 1, KS + CALL RANDOM_NUMBER(WORK(I)) + WORK(I) = ONE - TWO*WORK(I) + END DO +* +* Compute the sum of squares of the random values +* by an unscaled algorithm. +* + WORKSSQ = ZERO + DO I = 1, KS + WORKSSQ = WORKSSQ + WORK(I)*WORK(I) + END DO +* +* Construct the test vector with one known value +* and the rest from the random work array multiplied +* by a scaling factor. +* + DO IV = 1, NV + V0 = VALUES(IV) + IF (ABS(V0).GT.ONE) THEN + V0 = V0*HALF*HALF + END IF + Z(1) = DCMPLX(V0,-THREE*V0) + DO IW = 1, NV + V1 = VALUES(IW) + IF (ABS(V1).GT.ONE) THEN + V1 = (V1*HALF) / SQRT(DBLE(KS+1)) + END IF + DO I = 1, N-1 + Z(I+1) = DCMPLX(V1*WORK(2*I-1),V1*WORK(2*I)) + END DO +* +* Compute the expected value of the 2-norm +* + Y1 = ABS(V0) * SQRT(10.0D0) + IF (N.GT.1) THEN + Y2 = ABS(V1)*SQRT(WORKSSQ) + ELSE + Y2 = ZERO + END IF + YMIN = MIN(Y1, Y2) + YMAX = MAX(Y1, Y2) +* +* Expected value is NaN if either is NaN. The test +* for YMIN == YMAX avoids further computation if both +* are infinity. +* + IF ((Y1.NE.Y1).OR.(Y2.NE.Y2)) THEN +* add to propagate NaN + YNRM = Y1 + Y2 + ELSE IF (YMIN == YMAX) THEN + YNRM = SQRT(TWO)*YMAX + ELSE IF (YMAX == ZERO) THEN + YNRM = ZERO + ELSE + YNRM = YMAX*SQRT(ONE + (YMIN / YMAX)**2) + END IF +* +* Fill the input array to DZNRM2 with steps of incx +* + DO I = 1, N + X(I) = ROGUE + END DO + IX = 1 + IF (INCX.LT.0) IX = 1 - (N-1)*INCX + DO I = 1, N + X(IX) = Z(I) + IX = IX + INCX + END DO +* +* Call DZNRM2 to compute the 2-norm +* + SNRM = DZNRM2(N,X,INCX) +* +* Compare SNRM and ZNRM. Roundoff error grows like O(n) +* in this implementation so we scale the test ratio accordingly. +* + IF (INCX.EQ.0) THEN + Y1 = ABS(DBLE(X(1))) + Y2 = ABS(AIMAG(X(1))) + YMIN = MIN(Y1, Y2) + YMAX = MAX(Y1, Y2) + IF ((Y1.NE.Y1).OR.(Y2.NE.Y2)) THEN +* add to propagate NaN + ZNRM = Y1 + Y2 + ELSE IF (YMIN == YMAX) THEN + ZNRM = SQRT(TWO)*YMAX + ELSE IF (YMAX == ZERO) THEN + ZNRM = ZERO + ELSE + ZNRM = YMAX * SQRT(ONE + (YMIN / YMAX)**2) + END IF + ZNRM = SQRT(DBLE(n)) * ZNRM + ELSE + ZNRM = YNRM + END IF +* +* The tests for NaN rely on the compiler not being overly +* aggressive and removing the statements altogether. + IF ((SNRM.NE.SNRM).OR.(ZNRM.NE.ZNRM)) THEN + IF ((SNRM.NE.SNRM).NEQV.(ZNRM.NE.ZNRM)) THEN + TRAT = ONE / ULP + ELSE + TRAT = ZERO + END IF + ELSE IF (SNRM == ZNRM) THEN + TRAT = ZERO + ELSE IF (ZNRM == ZERO) THEN + TRAT = SNRM / ULP + ELSE + TRAT = (ABS(SNRM-ZNRM) / ZNRM) / (TWO*DBLE(N)*ULP) + END IF + NTESTS = NTESTS + 1 + IF ((TRAT.NE.TRAT).OR.(TRAT.GE.THRESH)) THEN + NFAILS = NFAILS + 1 + IF (FIRST) THEN + FIRST = .FALSE. + WRITE(NOUT,99999) + END IF + WRITE (NOUT,98) "DZNRM2", N, INCX, IV, IW, TRAT + END IF + END DO + END DO +99999 FORMAT (' FAIL') + 99 FORMAT ( ' Not enough space to test ', A6, ': NMAX = ',I6, + + ', INCX = ',I6,/,' N = ',I6,', must be at least ',I6 ) + 98 FORMAT( 1X, A6, ': N=', I6,', INCX=', I4, ', IV=', I2, ', IW=', + + I2, ', test=', E15.8 ) + RETURN + CONTAINS + DOUBLE PRECISION FUNCTION DXVALS(XX,K) + IMPLICIT NONE +* .. Scalar Arguments .. + DOUBLE PRECISION XX + INTEGER K +* .. Parameters .. + DOUBLE PRECISION ZERO + PARAMETER (ZERO=0.0D+0) +* .. Local Scalars .. + DOUBLE PRECISION X, Y, Z +* .. Intrinsic Functions .. + INTRINSIC HUGE +* .. Executable Statements .. + X = ZERO + Y = HUGE(XX) + Z = Y*Y + IF (K.EQ.1) THEN + X = -Z + ELSE IF (K.EQ.2) THEN + X = Z + ELSE IF (K.EQ.3) THEN + X = Z / Z + END IF + DXVALS = X + RETURN + END END diff --git a/BLAS/TESTING/zblat2.f b/BLAS/TESTING/zblat2.f index 4a20ac5675..7aa9e577d2 100644 --- a/BLAS/TESTING/zblat2.f +++ b/BLAS/TESTING/zblat2.f @@ -96,17 +96,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date April 2012 -* *> \ingroup complex16_blas_testing * * ===================================================================== PROGRAM ZBLAT2 + IMPLICIT NONE * -* -- Reference BLAS test routine (version 3.7.0) -- +* -- Reference BLAS test routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* April 2012 * * ===================================================================== * @@ -126,6 +124,7 @@ PROGRAM ZBLAT2 PARAMETER ( NINMAX = 7, NIDMAX = 9, NKBMAX = 7, $ NALMAX = 7, NBEMAX = 7 ) * .. Local Scalars .. + DOUBLE PRECISION S1, S2 DOUBLE PRECISION EPS, ERR, THRESH INTEGER I, ISNUM, J, N, NALF, NBET, NIDIM, NINC, NKB, $ NOUT, NTRA @@ -168,6 +167,7 @@ PROGRAM ZBLAT2 $ 'ZGERU ', 'ZHER ', 'ZHPR ', 'ZHER2 ', $ 'ZHPR2 '/ * .. Executable Statements .. + CALL CPU_TIME( S1 ) * * Read name and unit number for summary output file and open file. * @@ -396,6 +396,8 @@ PROGRAM ZBLAT2 240 CONTINUE IF( TRACE ) $ CLOSE ( NTRA ) + CALL CPU_TIME( S2 ) + WRITE( NOUT, FMT = 9979 )S2 - S1 CLOSE ( NOUT ) STOP * @@ -431,14 +433,16 @@ PROGRAM ZBLAT2 9982 FORMAT( /' END OF TESTS' ) 9981 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' ) 9980 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' ) + 9979 FORMAT( ' Total time used = ', F12.2, ' seconds', / ) * -* End of ZBLAT2. +* End of ZBLAT2 * END SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, NBET, $ BET, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX, $ XS, Y, YY, YS, YT, G ) + IMPLICIT NONE * * Tests ZGEMV and ZGBMV. * @@ -471,6 +475,7 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX*16 ALPHA, ALS, BETA, BLS, TRANSL DOUBLE PRECISION ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, IC, IKU, IM, IN, INCX, INCXS, INCY, $ INCYS, IX, IY, KL, KLS, KU, KUS, LAA, LDA, $ LDAS, LX, LY, M, ML, MS, N, NARGS, NC, ND, NK, @@ -484,7 +489,7 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, LOGICAL LZE, LZERES EXTERNAL LZE, LZERES * .. External Subroutines .. - EXTERNAL ZGBMV, ZGEMV, ZMAKE, ZMVCH + EXTERNAL ZGBMV, ZGEMV, ZMAKE, ZMVCH, ZREGR1 * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN * .. Scalars in Common .. @@ -507,6 +512,8 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 120 IN = 1, NIDIM N = IDIM( IN ) @@ -648,6 +655,8 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9993 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 130 END IF * @@ -701,6 +710,8 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 130 END IF * @@ -713,6 +724,9 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ INCY, YT, G, YY, EPS, ERR, $ FATAL, NOUT, .TRUE. ) ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -739,6 +753,36 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * 120 CONTINUE * +* Regression test to verify preservation of y when m zero, n nonzero. +* + CALL ZREGR1( TRANS, M, N, LY, KL, KU, ALPHA, AA, LDA, XX, INCX, + $ BETA, YY, INCY, YS ) + IF( FULL )THEN + IF( TRACE ) + $ WRITE( NTRA, FMT = 9994 )NC, SNAME, TRANS, M, N, ALPHA, LDA, + $ INCX, BETA, INCY + IF( REWI ) + $ REWIND NTRA + CALL ZGEMV( TRANS, M, N, ALPHA, AA, LDA, XX, INCX, BETA, YY, + $ INCY ) + ELSE IF( BANDED )THEN + IF( TRACE ) + $ WRITE( NTRA, FMT = 9995 )NC, SNAME, TRANS, M, N, KL, KU, + $ ALPHA, LDA, INCX, BETA, INCY + IF( REWI ) + $ REWIND NTRA + CALL ZGBMV( TRANS, M, N, KL, KU, ALPHA, AA, LDA, XX, INCX, + $ BETA, YY, INCY ) + END IF + NC = NC + 1 + IF( .NOT.LZE( YS, YY, LY ) )THEN + WRITE( NOUT, FMT = 9998 )NARGS - 1 + FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 + GO TO 130 + END IF +* * Report result. * IF( ERRMAX.LT.THRESH )THEN @@ -759,6 +803,7 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 140 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', @@ -777,14 +822,17 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ F4.1, '), Y,', I2, ') .' ) 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A6, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of ZCHK1. +* End of ZCHK1 * END SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, NBET, $ BET, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX, $ XS, Y, YY, YS, YT, G ) + IMPLICIT NONE * * Tests ZHEMV, ZHBMV and ZHPMV. * @@ -817,6 +865,7 @@ SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX*16 ALPHA, ALS, BETA, BLS, TRANSL DOUBLE PRECISION ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, IC, IK, IN, INCX, INCXS, INCY, $ INCYS, IX, IY, K, KS, LAA, LDA, LDAS, LX, LY, $ N, NARGS, NC, NK, NS @@ -855,6 +904,8 @@ SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 110 IN = 1, NIDIM N = IDIM( IN ) @@ -985,6 +1036,8 @@ SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1047,6 +1100,8 @@ SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1059,6 +1114,9 @@ SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ YY, EPS, ERR, FATAL, NOUT, $ .TRUE. ) ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -1105,6 +1163,7 @@ SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 130 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', @@ -1126,13 +1185,16 @@ SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ 'Y,', I2, ') .' ) 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A6, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of ZCHK2. +* End of ZCHK2 * END SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NKB, KB, NINC, INC, NMAX, $ INCMAX, A, AA, AS, X, XX, XS, XT, G, Z ) + IMPLICIT NONE * * Tests ZTRMV, ZTBMV, ZTPMV, ZTRSV, ZTBSV and ZTPSV. * @@ -1163,6 +1225,7 @@ SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX*16 TRANSL DOUBLE PRECISION ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, ICD, ICT, ICU, IK, IN, INCX, INCXS, IX, K, $ KS, LAA, LDA, LDAS, LX, N, NARGS, NC, NK, NS LOGICAL BANDED, FULL, NULL, PACKED, RESET, SAME @@ -1202,6 +1265,8 @@ SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * Set up zero vector for ZMVCH. DO 10 I = 1, NMAX Z( I ) = ZERO @@ -1348,6 +1413,8 @@ SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1400,6 +1467,8 @@ SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1428,6 +1497,9 @@ SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ .FALSE. ) END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and return. IF( FATAL ) $ GO TO 120 @@ -1470,6 +1542,7 @@ SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 130 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', @@ -1488,14 +1561,17 @@ SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ I3, ', X,', I2, ') .' ) 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A6, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of ZCHK3. +* End of ZCHK3 * END SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX, $ INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G, $ Z ) + IMPLICIT NONE * * Tests ZGERC and ZGERU. * @@ -1528,6 +1604,7 @@ SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX*16 ALPHA, ALS, TRANSL DOUBLE PRECISION ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IM, IN, INCX, INCXS, INCY, INCYS, IX, $ IY, J, LAA, LDA, LDAS, LX, LY, M, MS, N, NARGS, $ NC, ND, NS @@ -1555,6 +1632,8 @@ SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 120 IN = 1, NIDIM N = IDIM( IN ) @@ -1655,6 +1734,8 @@ SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9993 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 140 END IF * @@ -1685,6 +1766,8 @@ SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 140 END IF * @@ -1714,6 +1797,9 @@ SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ AA( 1 + ( J - 1 )*LDA ), EPS, $ ERR, FATAL, NOUT, .TRUE. ) ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and return. IF( FATAL ) $ GO TO 130 @@ -1750,6 +1836,7 @@ SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, WRITE( NOUT, FMT = 9994 )NC, SNAME, M, N, ALPHA, INCX, INCY, LDA * 150 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', @@ -1766,14 +1853,17 @@ SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ ' .' ) 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A6, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of ZCHK4. +* End of ZCHK4 * END SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX, $ INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G, $ Z ) + IMPLICIT NONE * * Tests ZHER and ZHPR. * @@ -1806,6 +1896,7 @@ SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX*16 ALPHA, TRANSL DOUBLE PRECISION ERR, ERRMAX, RALPHA, RALS + INTEGER NTESTS, NFAILS INTEGER I, IA, IC, IN, INCX, INCXS, IX, J, JA, JJ, LAA, $ LDA, LDAS, LJ, LX, N, NARGS, NC, NS LOGICAL FULL, NULL, PACKED, RESET, SAME, UPPER @@ -1841,6 +1932,8 @@ SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 100 IN = 1, NIDIM N = IDIM( IN ) @@ -1925,6 +2018,8 @@ SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1955,6 +2050,8 @@ SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 30 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1995,6 +2092,9 @@ SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, JA = JA + LJ END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and return. IF( FATAL ) $ GO TO 110 @@ -2034,6 +2134,7 @@ SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 130 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', @@ -2051,14 +2152,17 @@ SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ I2, ', A,', I3, ') .' ) 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A6, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of ZCHK5. +* End of ZCHK5 * END SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX, $ INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G, $ Z ) + IMPLICIT NONE * * Tests ZHER2 and ZHPR2. * @@ -2091,6 +2195,7 @@ SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX*16 ALPHA, ALS, TRANSL DOUBLE PRECISION ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IC, IN, INCX, INCXS, INCY, INCYS, IX, $ IY, J, JA, JJ, LAA, LDA, LDAS, LJ, LX, LY, N, $ NARGS, NC, NS @@ -2127,6 +2232,8 @@ SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 140 IN = 1, NIDIM N = IDIM( IN ) @@ -2231,6 +2338,8 @@ SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 160 END IF * @@ -2263,6 +2372,8 @@ SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 160 END IF * @@ -2313,6 +2424,9 @@ SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, JA = JA + LJ END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and return. IF( FATAL ) $ GO TO 150 @@ -2355,6 +2469,7 @@ SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 170 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', @@ -2374,11 +2489,14 @@ SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ ' .' ) 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A6, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of ZCHK6. +* End of ZCHK6 * END SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) + IMPLICIT NONE * * Tests the error exits from the Level 2 Blas. * Requires a special version of the error-handling routine XERBLA. @@ -2394,6 +2512,7 @@ SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) INTEGER ISNUM, NOUT CHARACTER*6 SRNAMT * .. Scalars in Common .. + INTEGER NXRUN, NXFAIL, NXBAD INTEGER INFOT, NOUTC LOGICAL LERR, OK * .. Local Scalars .. @@ -2407,6 +2526,7 @@ SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) $ ZTBSV, ZTPMV, ZTPSV, ZTRMV, ZTRSV * .. Common blocks .. COMMON /INFOC/INFOT, NOUTC, OK, LERR + COMMON /XERCNT/NXRUN, NXFAIL, NXBAD * .. Executable Statements .. * OK is set to .FALSE. by the special version of XERBLA or by CHKXER * if anything is wrong. @@ -2414,6 +2534,11 @@ SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) * LERR is set to .TRUE. by the special version of XERBLA each time * it is called, and is then tested and re-set by CHKXER. LERR = .FALSE. +* NXRUN and NXFAIL count the error-exit tests of this routine; +* NXBAD is set by XERBLA when it is called wrongly. + NXRUN = 0 + NXFAIL = 0 + NXBAD = 0 GO TO ( 10, 20, 30, 40, 50, 60, 70, 80, $ 90, 100, 110, 120, 130, 140, 150, 160, $ 170 )ISNUM @@ -2712,17 +2837,21 @@ SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) ELSE WRITE( NOUT, FMT = 9998 )SRNAMT END IF + WRITE( NOUT, FMT = 9979 )SRNAMT, NXRUN, NXFAIL RETURN * 9999 FORMAT( ' ', A6, ' PASSED THE TESTS OF ERROR-EXITS' ) 9998 FORMAT( ' ******* ', A6, ' FAILED THE TESTS OF ERROR-EXITS *****', $ '**' ) + 9979 FORMAT( ' ', A6, ' ERROR-EXIT TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of ZCHKE. +* End of ZCHKE * END SUBROUTINE ZMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, $ KU, RESET, TRANSL ) + IMPLICIT NONE * * Generates values for an M by N matrix A within the bandwidth * defined by KL and KU. @@ -2911,11 +3040,12 @@ SUBROUTINE ZMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, END IF RETURN * -* End of ZMAKE. +* End of ZMAKE * END SUBROUTINE ZMVCH( TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y, $ INCY, YT, G, YY, EPS, ERR, FATAL, NOUT, MV ) + IMPLICIT NONE * * Checks the results of the computational tests. * @@ -2947,9 +3077,9 @@ SUBROUTINE ZMVCH( TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y, * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DCONJG, DIMAG, MAX, SQRT * .. Statement Functions .. - DOUBLE PRECISION ABS1 + DOUBLE PRECISION CABS1 * .. Statement Function definitions .. - ABS1( C ) = ABS( DBLE( C ) ) + ABS( DIMAG( C ) ) + CABS1( C ) = ABS( DBLE( C ) ) + ABS( DIMAG( C ) ) * .. Executable Statements .. TRAN = TRANS.EQ.'T' CTRAN = TRANS.EQ.'C' @@ -2986,24 +3116,25 @@ SUBROUTINE ZMVCH( TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y, IF( TRAN )THEN DO 10 J = 1, NL YT( IY ) = YT( IY ) + A( J, I )*X( JX ) - G( IY ) = G( IY ) + ABS1( A( J, I ) )*ABS1( X( JX ) ) + G( IY ) = G( IY ) + CABS1( A( J, I ) )*CABS1( X( JX ) ) JX = JX + INCXL 10 CONTINUE ELSE IF( CTRAN )THEN DO 20 J = 1, NL YT( IY ) = YT( IY ) + DCONJG( A( J, I ) )*X( JX ) - G( IY ) = G( IY ) + ABS1( A( J, I ) )*ABS1( X( JX ) ) + G( IY ) = G( IY ) + CABS1( A( J, I ) )*CABS1( X( JX ) ) JX = JX + INCXL 20 CONTINUE ELSE DO 30 J = 1, NL YT( IY ) = YT( IY ) + A( I, J )*X( JX ) - G( IY ) = G( IY ) + ABS1( A( I, J ) )*ABS1( X( JX ) ) + G( IY ) = G( IY ) + CABS1( A( I, J ) )*CABS1( X( JX ) ) JX = JX + INCXL 30 CONTINUE END IF YT( IY ) = ALPHA*YT( IY ) + BETA*Y( IY ) - G( IY ) = ABS1( ALPHA )*G( IY ) + ABS1( BETA )*ABS1( Y( IY ) ) + G( IY ) = CABS1( ALPHA )*G( IY ) + $ + CABS1( BETA )*CABS1( Y( IY ) ) IY = IY + INCYL 40 CONTINUE * @@ -3043,10 +3174,11 @@ SUBROUTINE ZMVCH( TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y, $ 'SULT COMPUTED RESULT' ) 9998 FORMAT( 1X, I7, 2( ' (', G15.6, ',', G15.6, ')' ) ) * -* End of ZMVCH. +* End of ZMVCH * END LOGICAL FUNCTION LZE( RI, RJ, LR ) + IMPLICIT NONE * * Tests if two arrays are identical. * @@ -3073,10 +3205,11 @@ LOGICAL FUNCTION LZE( RI, RJ, LR ) LZE = .FALSE. 30 RETURN * -* End of LZE. +* End of LZE * END LOGICAL FUNCTION LZERES( TYPE, UPLO, M, N, AA, AS, LDA ) + IMPLICIT NONE * * Tests if selected elements in two arrays are equal. * @@ -3132,10 +3265,11 @@ LOGICAL FUNCTION LZERES( TYPE, UPLO, M, N, AA, AS, LDA ) LZERES = .FALSE. 80 RETURN * -* End of LZERES. +* End of LZERES * END COMPLEX*16 FUNCTION ZBEG( RESET ) + IMPLICIT NONE * * Generates complex numbers as pairs of random numbers uniformly * distributed between -0.5 and 0.5. @@ -3184,10 +3318,11 @@ COMPLEX*16 FUNCTION ZBEG( RESET ) ZBEG = DCMPLX( ( I - 500 )/1001.0D0, ( J - 500 )/1001.0D0 ) RETURN * -* End of ZBEG. +* End of ZBEG * END DOUBLE PRECISION FUNCTION DDIFF( X, Y ) + IMPLICIT NONE * * Auxiliary routine for test program for Level 2 Blas. * @@ -3200,10 +3335,11 @@ DOUBLE PRECISION FUNCTION DDIFF( X, Y ) DDIFF = X - Y RETURN * -* End of DDIFF. +* End of DDIFF * END SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + IMPLICIT NONE * * Tests whether XERBLA has detected an error when it should. * @@ -3217,21 +3353,65 @@ SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INTEGER INFOT, NOUT LOGICAL LERR, OK CHARACTER*6 SRNAMT +* .. Scalars in Common .. + INTEGER NXRUN, NXFAIL, NXBAD +* .. Common blocks .. + COMMON /XERCNT/NXRUN, NXFAIL, NXBAD * .. Executable Statements .. + NXRUN = NXRUN + 1 IF( .NOT.LERR )THEN WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT OK = .FALSE. + NXFAIL = NXFAIL + 1 + ELSE IF( NXBAD.NE.0 )THEN + NXFAIL = NXFAIL + 1 END IF + NXBAD = 0 LERR = .FALSE. RETURN * 9999 FORMAT( ' ***** ILLEGAL VALUE OF PARAMETER NUMBER ', I2, ' NOT D', $ 'ETECTED BY ', A6, ' *****' ) * -* End of CHKXER. +* End of CHKXER +* + END + SUBROUTINE ZREGR1( TRANS, M, N, LY, KL, KU, ALPHA, A, LDA, X, + $ INCX, BETA, Y, INCY, YS ) + IMPLICIT NONE +* +* Input initialization for regression test. * +* .. Scalar Arguments .. + CHARACTER*1 TRANS + INTEGER LY, M, N, KL, KU, LDA, INCX, INCY + COMPLEX*16 ALPHA, BETA +* .. Array Arguments .. + COMPLEX*16 A(LDA,*), X(*), Y(*), YS(*) +* .. Local Scalars .. + INTEGER I +* .. Intrinsic Functions .. + INTRINSIC DBLE, DCMPLX +* .. Executable Statements .. + TRANS = 'T' + M = 0 + N = 5 + KL = 0 + KU = 0 + ALPHA = DCMPLX( 1.0D0 ) + LDA = MAX( 1, M ) + INCX = 1 + BETA = DCMPLX( -0.7D0, -0.8D0 ) + INCY = 1 + LY = ABS( INCY )*N + DO 10 I = 1, LY + Y( I ) = DCMPLX( 42.0D0, DBLE( I ) ) + YS( I ) = Y( I ) + 10 CONTINUE + RETURN END SUBROUTINE XERBLA( SRNAME, INFO ) + IMPLICIT NONE * * This is a special version of XERBLA to be used only as part of * the test program for testing error exits from the Level 2 BLAS @@ -3250,14 +3430,18 @@ SUBROUTINE XERBLA( SRNAME, INFO ) * * .. Scalar Arguments .. INTEGER INFO - CHARACTER*6 SRNAME + CHARACTER*(*) SRNAME * .. Scalars in Common .. + INTEGER NXRUN, NXFAIL, NXBAD INTEGER INFOT, NOUT LOGICAL LERR, OK CHARACTER*6 SRNAMT * .. Common blocks .. COMMON /INFOC/INFOT, NOUT, OK, LERR + COMMON /XERCNT/NXRUN, NXFAIL, NXBAD COMMON /SRNAMC/SRNAMT +* .. Locals .. + INTEGER SRLEN * .. Executable Statements .. LERR = .TRUE. IF( INFO.NE.INFOT )THEN @@ -3267,16 +3451,19 @@ SUBROUTINE XERBLA( SRNAME, INFO ) WRITE( NOUT, FMT = 9997 )INFO END IF OK = .FALSE. + NXBAD = 1 END IF - IF( SRNAME.NE.SRNAMT )THEN + SRLEN = MIN(LEN_TRIM(SRNAME), LEN_TRIM(SRNAMT)) + IF( SRNAME(1:SRLEN).NE.SRNAMT(1:SRLEN) )THEN WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT OK = .FALSE. + NXBAD = 1 END IF RETURN * 9999 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6, ' INSTEAD', $ ' OF ', I2, ' *******' ) - 9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A6, ' INSTE', + 9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A, ' INSTE', $ 'AD OF ', A6, ' *******' ) 9997 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6, $ ' *******' ) @@ -3284,4 +3471,3 @@ SUBROUTINE XERBLA( SRNAME, INFO ) * End of XERBLA * END - diff --git a/BLAS/TESTING/zblat3.f b/BLAS/TESTING/zblat3.f index 0e38334e9a..f9ecd7ec35 100644 --- a/BLAS/TESTING/zblat3.f +++ b/BLAS/TESTING/zblat3.f @@ -19,8 +19,8 @@ *> Test program for the COMPLEX*16 Level 3 Blas. *> *> The program must be driven by a short data file. The first 14 records -*> of the file are read using list-directed input, the last 9 records -*> are read using the format ( A6, L2 ). An annotated example of a data +*> of the file are read using list-directed input, the last 10 records +*> are read using the format ( A7, L2 ). An annotated example of a data *> file can be obtained by deleting the first 3 characters from the *> following 23 lines: *> 'zblat3.out' NAME OF SUMMARY OUTPUT FILE @@ -46,6 +46,7 @@ *> ZSYRK T PUT F FOR NO TEST. SAME COLUMNS. *> ZHER2K T PUT F FOR NO TEST. SAME COLUMNS. *> ZSYR2K T PUT F FOR NO TEST. SAME COLUMNS. +*> ZGEMMTR T PUT F FOR NO TEST. SAME COLUMNS. *> *> *> Further Details @@ -79,17 +80,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date April 2012 -* *> \ingroup complex16_blas_testing * * ===================================================================== PROGRAM ZBLAT3 + IMPLICIT NONE * -* -- Reference BLAS test routine (version 3.7.0) -- +* -- Reference BLAS test routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* April 2012 * * ===================================================================== * @@ -97,7 +96,7 @@ PROGRAM ZBLAT3 INTEGER NIN PARAMETER ( NIN = 5 ) INTEGER NSUBS - PARAMETER ( NSUBS = 9 ) + PARAMETER ( NSUBS = 10 ) COMPLEX*16 ZERO, ONE PARAMETER ( ZERO = ( 0.0D0, 0.0D0 ), $ ONE = ( 1.0D0, 0.0D0 ) ) @@ -108,12 +107,13 @@ PROGRAM ZBLAT3 INTEGER NIDMAX, NALMAX, NBEMAX PARAMETER ( NIDMAX = 9, NALMAX = 7, NBEMAX = 7 ) * .. Local Scalars .. + DOUBLE PRECISION S1, S2 DOUBLE PRECISION EPS, ERR, THRESH INTEGER I, ISNUM, J, N, NALF, NBET, NIDIM, NOUT, NTRA LOGICAL FATAL, LTESTT, REWI, SAME, SFATAL, TRACE, $ TSTERR CHARACTER*1 TRANSA, TRANSB - CHARACTER*6 SNAMET + CHARACTER*7 SNAMET CHARACTER*32 SNAPS, SUMMRY * .. Local Arrays .. COMPLEX*16 AA( NMAX*NMAX ), AB( NMAX, 2*NMAX ), @@ -125,27 +125,29 @@ PROGRAM ZBLAT3 DOUBLE PRECISION G( NMAX ) INTEGER IDIM( NIDMAX ) LOGICAL LTEST( NSUBS ) - CHARACTER*6 SNAMES( NSUBS ) + CHARACTER*7 SNAMES( NSUBS ) * .. External Functions .. DOUBLE PRECISION DDIFF LOGICAL LZE EXTERNAL DDIFF, LZE * .. External Subroutines .. - EXTERNAL ZCHK1, ZCHK2, ZCHK3, ZCHK4, ZCHK5, ZCHKE, ZMMCH + EXTERNAL ZCHK1, ZCHK2, ZCHK3, ZCHK4, ZCHK5, ZCHK6 + EXTERNAL ZCHKE, ZMMCH * .. Intrinsic Functions .. INTRINSIC MAX, MIN * .. Scalars in Common .. INTEGER INFOT, NOUTC LOGICAL LERR, OK - CHARACTER*6 SRNAMT + CHARACTER*7 SRNAMT * .. Common blocks .. COMMON /INFOC/INFOT, NOUTC, OK, LERR COMMON /SRNAMC/SRNAMT * .. Data statements .. DATA SNAMES/'ZGEMM ', 'ZHEMM ', 'ZSYMM ', 'ZTRMM ', $ 'ZTRSM ', 'ZHERK ', 'ZSYRK ', 'ZHER2K', - $ 'ZSYR2K'/ + $ 'ZSYR2K', 'ZGEMMTR'/ * .. Executable Statements .. + CALL CPU_TIME( S1 ) * * Read name and unit number for summary output file and open file. * @@ -322,7 +324,7 @@ PROGRAM ZBLAT3 OK = .TRUE. FATAL = .FALSE. GO TO ( 140, 150, 150, 160, 160, 170, 170, - $ 180, 180 )ISNUM + $ 180, 180, 185 )ISNUM * Test ZGEMM, 01. 140 CALL ZCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, @@ -351,6 +353,13 @@ PROGRAM ZBLAT3 $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W ) GO TO 190 +* Test ZGEMMTR, 01. + 185 CALL ZCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, + $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, + $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, + $ CC, CS, CT, G ) + GO TO 190 + * 190 IF( FATAL.AND.SFATAL ) $ GO TO 210 @@ -369,6 +378,8 @@ PROGRAM ZBLAT3 230 CONTINUE IF( TRACE ) $ CLOSE ( NTRA ) + CALL CPU_TIME( S2 ) + WRITE( NOUT, FMT = 9983 )S2 - S1 CLOSE ( NOUT ) STOP * @@ -387,7 +398,7 @@ PROGRAM ZBLAT3 $ 7( '(', F4.1, ',', F4.1, ') ', : ) ) 9991 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM', $ /' ******* TESTS ABANDONED *******' ) - 9990 FORMAT( ' SUBPROGRAM NAME ', A6, ' NOT RECOGNIZED', /' ******* T', + 9990 FORMAT( ' SUBPROGRAM NAME ', A7, ' NOT RECOGNIZED', /' ******* T', $ 'ESTS ABANDONED *******' ) 9989 FORMAT( ' ERROR IN ZMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALU', $ 'ATED WRONGLY.', /' ZMMCH WAS CALLED WITH TRANSA = ', A1, @@ -395,13 +406,14 @@ PROGRAM ZBLAT3 $ 'ERR = ', F12.3, '.', /' THIS MAY BE DUE TO FAULTS IN THE ', $ 'ARITHMETIC OR THE COMPILER.', /' ******* TESTS ABANDONED ', $ '*******' ) - 9988 FORMAT( A6, L2 ) - 9987 FORMAT( 1X, A6, ' WAS NOT TESTED' ) + 9988 FORMAT( A7, L2 ) + 9987 FORMAT( 1X, A7, ' WAS NOT TESTED' ) 9986 FORMAT( /' END OF TESTS' ) 9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' ) 9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' ) + 9983 FORMAT( ' Total time used = ', F12.2, ' seconds', / ) * -* End of ZBLAT3. +* End of ZBLAT3 * END SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, @@ -427,7 +439,7 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -439,6 +451,7 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX*16 ALPHA, ALS, BETA, BLS DOUBLE PRECISION ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, ICA, ICB, IK, IM, IN, K, KS, LAA, $ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, M, $ MA, MB, MS, N, NA, NARGS, NB, NC, NS @@ -467,6 +480,8 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 110 IM = 1, NIDIM M = IDIM( IM ) @@ -588,6 +603,8 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9994 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -623,6 +640,8 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -635,6 +654,9 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ C, NMAX, CT, G, CC, LDC, EPS, $ ERR, FATAL, NOUT, .TRUE. ) ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -670,23 +692,26 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ ALPHA, LDA, LDB, BETA, LDC * 130 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', + 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', $ 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', + 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',''', A1, ''',', + 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A7, '(''', A1, ''',''', A1, ''',', $ 3( I3, ',' ), '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, $ ',(', F4.1, ',', F4.1, '), C,', I3, ').' ) 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A7, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of ZCHK1. +* End of ZCHK1 * END SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, @@ -712,7 +737,7 @@ SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -724,6 +749,7 @@ SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX*16 ALPHA, ALS, BETA, BLS DOUBLE PRECISION ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, ICS, ICU, IM, IN, LAA, LBB, LCC, $ LDA, LDAS, LDB, LDBS, LDC, LDCS, M, MS, N, NA, $ NARGS, NC, NS @@ -753,6 +779,8 @@ SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 100 IM = 1, NIDIM M = IDIM( IM ) @@ -863,6 +891,8 @@ SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9994 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 110 END IF * @@ -897,6 +927,8 @@ SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 110 END IF * @@ -916,6 +948,9 @@ SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NOUT, .TRUE. ) END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -949,23 +984,26 @@ SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ LDB, BETA, LDC * 120 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', + 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', $ 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', + 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A7, '(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1, $ ',', F4.1, '), C,', I3, ') .' ) 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A7, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of ZCHK2. +* End of ZCHK2 * END SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, @@ -992,7 +1030,7 @@ SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -1003,6 +1041,7 @@ SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX*16 ALPHA, ALS DOUBLE PRECISION ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, ICD, ICS, ICT, ICU, IM, IN, J, LAA, LBB, $ LDA, LDAS, LDB, LDBS, M, MS, N, NA, NARGS, NC, $ NS @@ -1033,6 +1072,8 @@ SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * Set up zero matrix for ZMMCH. DO 20 J = 1, NMAX DO 10 I = 1, NMAX @@ -1142,6 +1183,8 @@ SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9994 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 150 END IF * @@ -1175,6 +1218,8 @@ SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 50 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 150 END IF * @@ -1225,6 +1270,9 @@ SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -1260,23 +1308,26 @@ SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ N, ALPHA, LDA, LDB * 160 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', + 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', $ 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', + 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A6, '(', 4( '''', A1, ''',' ), 2( I3, ',' ), + 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A7, '(', 4( '''', A1, ''',' ), 2( I3, ',' ), $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ') ', $ ' .' ) 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A7, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of ZCHK3. +* End of ZCHK3 * END SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, @@ -1302,7 +1353,7 @@ SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -1314,6 +1365,7 @@ SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX*16 ALPHA, ALS, BETA, BETS DOUBLE PRECISION ERR, ERRMAX, RALPHA, RALS, RBETA, RBETS + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, K, KS, $ LAA, LCC, LDA, LDAS, LDC, LDCS, LJ, MA, N, NA, $ NARGS, NC, NS @@ -1343,6 +1395,8 @@ SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 100 IN = 1, NIDIM N = IDIM( IN ) @@ -1463,6 +1517,8 @@ SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1503,6 +1559,8 @@ SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 30 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1545,6 +1603,9 @@ SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, JC = JC + LDC + 1 END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -1588,27 +1649,30 @@ SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 130 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', + 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', $ 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', + 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9994 FORMAT( 1X, I6, ': ', A7, '(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ') ', $ ' .' ) - 9993 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9993 FORMAT( 1X, I6, ': ', A7, '(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ '(', F4.1, ',', F4.1, ') , A,', I3, ',(', F4.1, ',', F4.1, $ '), C,', I3, ') .' ) 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A7, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of ZCHK4. +* End of ZCHK4 * END SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, @@ -1635,7 +1699,7 @@ SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. COMPLEX*16 AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ), $ ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ), @@ -1647,6 +1711,7 @@ SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX*16 ALPHA, ALS, BETA, BETS DOUBLE PRECISION ERR, ERRMAX, RBETA, RBETS + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, JJAB, $ K, KS, LAA, LBB, LCC, LDA, LDAS, LDB, LDBS, $ LDC, LDCS, LJ, MA, N, NA, NARGS, NC, NS @@ -1676,6 +1741,8 @@ SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 130 IN = 1, NIDIM N = IDIM( IN ) @@ -1809,6 +1876,8 @@ SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 150 END IF * @@ -1847,6 +1916,8 @@ SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 150 END IF * @@ -1919,6 +1990,9 @@ SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ JJAB = JJAB + 2*NMAX END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -1962,27 +2036,30 @@ SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 160 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', + 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', $ 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', + 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9994 FORMAT( 1X, I6, ': ', A7, '(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',', F4.1, $ ', C,', I3, ') .' ) - 9993 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9993 FORMAT( 1X, I6, ': ', A7, '(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1, $ ',', F4.1, '), C,', I3, ') .' ) 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A7, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of ZCHK5. +* End of ZCHK5 * END SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) @@ -2006,12 +2083,13 @@ SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) * * .. Scalar Arguments .. INTEGER ISNUM, NOUT - CHARACTER*6 SRNAMT + CHARACTER*7 SRNAMT * .. Scalars in Common .. + INTEGER NXRUN, NXFAIL, NXBAD INTEGER INFOT, NOUTC LOGICAL LERR, OK * .. Parameters .. - REAL ONE, TWO + DOUBLE PRECISION ONE, TWO PARAMETER ( ONE = 1.0D0, TWO = 2.0D0 ) * .. Local Scalars .. COMPLEX*16 ALPHA, BETA @@ -2020,11 +2098,12 @@ SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) COMPLEX*16 A( 2, 1 ), B( 2, 1 ), C( 2, 1 ) * .. External Subroutines .. EXTERNAL ZGEMM, ZHEMM, ZHER2K, ZHERK, CHKXER, ZSYMM, - $ ZSYR2K, ZSYRK, ZTRMM, ZTRSM + $ ZSYR2K, ZSYRK, ZTRMM, ZTRSM, ZGEMMTR * .. Intrinsic Functions .. INTRINSIC DCMPLX * .. Common blocks .. COMMON /INFOC/INFOT, NOUTC, OK, LERR + COMMON /XERCNT/NXRUN, NXFAIL, NXBAD * .. Executable Statements .. * OK is set to .FALSE. by the special version of XERBLA or by CHKXER * if anything is wrong. @@ -2032,6 +2111,11 @@ SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) * LERR is set to .TRUE. by the special version of XERBLA each time * it is called, and is then tested and re-set by CHKXER. LERR = .FALSE. +* NXRUN and NXFAIL count the error-exit tests of this routine; +* NXBAD is set by XERBLA when it is called wrongly. + NXRUN = 0 + NXFAIL = 0 + NXBAD = 0 * * Initialize ALPHA, BETA, RALPHA, and RBETA. * @@ -2041,7 +2125,7 @@ SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) RBETA = TWO * GO TO ( 10, 20, 30, 40, 50, 60, 70, 80, - $ 90 )ISNUM + $ 90, 100 )ISNUM 10 INFOT = 1 CALL ZGEMM( '/', 'N', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2222,7 +2306,7 @@ SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 13 CALL ZGEMM( 'T', 'T', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 100 + GO TO 110 20 INFOT = 1 CALL ZHEMM( '/', 'U', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2289,7 +2373,7 @@ SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 12 CALL ZHEMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 100 + GO TO 110 30 INFOT = 1 CALL ZSYMM( '/', 'U', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2356,7 +2440,7 @@ SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 12 CALL ZSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 100 + GO TO 110 40 INFOT = 1 CALL ZTRMM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2513,7 +2597,7 @@ SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 11 CALL ZTRMM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 100 + GO TO 110 50 INFOT = 1 CALL ZTRSM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2670,7 +2754,7 @@ SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 11 CALL ZTRSM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 100 + GO TO 110 60 INFOT = 1 CALL ZHERK( '/', 'N', 0, 0, RALPHA, A, 1, RBETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2725,7 +2809,7 @@ SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 10 CALL ZHERK( 'L', 'C', 2, 0, RALPHA, A, 1, RBETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 100 + GO TO 110 70 INFOT = 1 CALL ZSYRK( '/', 'N', 0, 0, ALPHA, A, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2780,7 +2864,7 @@ SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 10 CALL ZSYRK( 'L', 'T', 2, 0, ALPHA, A, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 100 + GO TO 110 80 INFOT = 1 CALL ZHER2K( '/', 'N', 0, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2847,7 +2931,7 @@ SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 12 CALL ZHER2K( 'L', 'C', 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 100 + GO TO 110 90 INFOT = 1 CALL ZSYR2K( '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2914,19 +2998,218 @@ SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 12 CALL ZSYR2K( 'L', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + GO TO 110 + 100 INFOT = 1 + CALL ZGEMMTR( '/', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 1 + CALL ZGEMMTR( '/', 'N', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 1 + CALL ZGEMMTR( '/', 'N', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 1 + CALL ZGEMMTR( '/', 'T', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 1 + CALL ZGEMMTR( '/', 'T', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 1 + CALL ZGEMMTR( '/', 'T', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 1 + CALL ZGEMMTR( '/', 'C', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 1 + CALL ZGEMMTR( '/', 'C', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 1 + CALL ZGEMMTR( '/', 'C', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + + INFOT = 2 + CALL ZGEMMTR( 'U', '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL ZGEMMTR( 'U', '/', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL ZGEMMTR( 'U', '/', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL ZGEMMTR( 'L', '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL ZGEMMTR( 'L', '/', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL ZGEMMTR( 'L', '/', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + + INFOT = 3 + CALL ZGEMMTR( 'U', 'N', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL ZGEMMTR( 'U', 'C', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL ZGEMMTR( 'U', 'T', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL ZGEMMTR( 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL ZGEMMTR( 'U', 'N', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL ZGEMMTR( 'U', 'N', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL ZGEMMTR( 'U', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL ZGEMMTR( 'U', 'C', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL ZGEMMTR( 'U', 'C', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL ZGEMMTR( 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL ZGEMMTR( 'U', 'T', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL ZGEMMTR( 'U', 'T', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL ZGEMMTR( 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL ZGEMMTR( 'U', 'N', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL ZGEMMTR( 'U', 'N', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL ZGEMMTR( 'U', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL ZGEMMTR( 'U', 'C', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL ZGEMMTR( 'U', 'C', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL ZGEMMTR( 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL ZGEMMTR( 'U', 'T', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL ZGEMMTR( 'U', 'T', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + + INFOT = 8 + CALL ZGEMMTR( 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL ZGEMMTR( 'U', 'N', 'C', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL ZGEMMTR( 'U', 'N', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL ZGEMMTR( 'U', 'C', 'N', 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL ZGEMMTR( 'U', 'C', 'C', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL ZGEMMTR( 'U', 'C', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL ZGEMMTR( 'U', 'T', 'N', 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL ZGEMMTR( 'U', 'T', 'C', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL ZGEMMTR( 'U', 'T', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + + INFOT = 10 + CALL ZGEMMTR( 'U', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 10 + CALL ZGEMMTR( 'U', 'C', 'N', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 10 + CALL ZGEMMTR( 'U', 'T', 'N', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL ZGEMMTR( 'U', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL ZGEMMTR( 'U', 'N', 'C', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL ZGEMMTR( 'U', 'N', 'T', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL ZGEMMTR( 'U', 'C', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL ZGEMMTR( 'U', 'C', 'C', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL ZGEMMTR( 'U', 'C', 'T', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL ZGEMMTR( 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL ZGEMMTR( 'U', 'T', 'C', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL ZGEMMTR( 'U', 'T', 'T', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + GO TO 110 + * - 100 IF( OK )THEN + 110 IF( OK )THEN WRITE( NOUT, FMT = 9999 )SRNAMT ELSE WRITE( NOUT, FMT = 9998 )SRNAMT END IF + WRITE( NOUT, FMT = 9979 )SRNAMT, NXRUN, NXFAIL RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE TESTS OF ERROR-EXITS' ) - 9998 FORMAT( ' ******* ', A6, ' FAILED THE TESTS OF ERROR-EXITS *****', + 9999 FORMAT( ' ', A7, ' PASSED THE TESTS OF ERROR-EXITS' ) + 9998 FORMAT( ' ******* ', A7, ' FAILED THE TESTS OF ERROR-EXITS *****', $ '**' ) + 9979 FORMAT( ' ', A7, ' ERROR-EXIT TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) * -* End of ZCHKE. +* End of ZCHKE * END SUBROUTINE ZMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET, @@ -3055,7 +3338,7 @@ SUBROUTINE ZMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET, END IF RETURN * -* End of ZMAKE. +* End of ZMAKE * END SUBROUTINE ZMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, @@ -3095,9 +3378,9 @@ SUBROUTINE ZMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, * .. Intrinsic Functions .. INTRINSIC ABS, DIMAG, DCONJG, MAX, DBLE, SQRT * .. Statement Functions .. - DOUBLE PRECISION ABS1 + DOUBLE PRECISION CABS1 * .. Statement Function definitions .. - ABS1( CL ) = ABS( DBLE( CL ) ) + ABS( DIMAG( CL ) ) + CABS1( CL ) = ABS( DBLE( CL ) ) + ABS( DIMAG( CL ) ) * .. Executable Statements .. TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' @@ -3118,7 +3401,8 @@ SUBROUTINE ZMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, DO 30 K = 1, KK DO 20 I = 1, M CT( I ) = CT( I ) + A( I, K )*B( K, J ) - G( I ) = G( I ) + ABS1( A( I, K ) )*ABS1( B( K, J ) ) + G( I ) = G( I ) + $ + CABS1( A( I, K ) )*CABS1( B( K, J ) ) 20 CONTINUE 30 CONTINUE ELSE IF( TRANA.AND..NOT.TRANB )THEN @@ -3126,16 +3410,16 @@ SUBROUTINE ZMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, DO 50 K = 1, KK DO 40 I = 1, M CT( I ) = CT( I ) + DCONJG( A( K, I ) )*B( K, J ) - G( I ) = G( I ) + ABS1( A( K, I ) )* - $ ABS1( B( K, J ) ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( K, J ) ) 40 CONTINUE 50 CONTINUE ELSE DO 70 K = 1, KK DO 60 I = 1, M CT( I ) = CT( I ) + A( K, I )*B( K, J ) - G( I ) = G( I ) + ABS1( A( K, I ) )* - $ ABS1( B( K, J ) ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( K, J ) ) 60 CONTINUE 70 CONTINUE END IF @@ -3144,16 +3428,16 @@ SUBROUTINE ZMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, DO 90 K = 1, KK DO 80 I = 1, M CT( I ) = CT( I ) + A( I, K )*DCONJG( B( J, K ) ) - G( I ) = G( I ) + ABS1( A( I, K ) )* - $ ABS1( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( I, K ) )* + $ CABS1( B( J, K ) ) 80 CONTINUE 90 CONTINUE ELSE DO 110 K = 1, KK DO 100 I = 1, M CT( I ) = CT( I ) + A( I, K )*B( J, K ) - G( I ) = G( I ) + ABS1( A( I, K ) )* - $ ABS1( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( I, K ) )* + $ CABS1( B( J, K ) ) 100 CONTINUE 110 CONTINUE END IF @@ -3164,8 +3448,8 @@ SUBROUTINE ZMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, DO 120 I = 1, M CT( I ) = CT( I ) + DCONJG( A( K, I ) )* $ DCONJG( B( J, K ) ) - G( I ) = G( I ) + ABS1( A( K, I ) )* - $ ABS1( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( J, K ) ) 120 CONTINUE 130 CONTINUE ELSE @@ -3173,8 +3457,8 @@ SUBROUTINE ZMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, DO 140 I = 1, M CT( I ) = CT( I ) + DCONJG( A( K, I ) )* $ B( J, K ) - G( I ) = G( I ) + ABS1( A( K, I ) )* - $ ABS1( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( J, K ) ) 140 CONTINUE 150 CONTINUE END IF @@ -3184,16 +3468,16 @@ SUBROUTINE ZMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, DO 160 I = 1, M CT( I ) = CT( I ) + A( K, I )* $ DCONJG( B( J, K ) ) - G( I ) = G( I ) + ABS1( A( K, I ) )* - $ ABS1( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( J, K ) ) 160 CONTINUE 170 CONTINUE ELSE DO 190 K = 1, KK DO 180 I = 1, M CT( I ) = CT( I ) + A( K, I )*B( J, K ) - G( I ) = G( I ) + ABS1( A( K, I ) )* - $ ABS1( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( J, K ) ) 180 CONTINUE 190 CONTINUE END IF @@ -3201,15 +3485,15 @@ SUBROUTINE ZMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, END IF DO 200 I = 1, M CT( I ) = ALPHA*CT( I ) + BETA*C( I, J ) - G( I ) = ABS1( ALPHA )*G( I ) + - $ ABS1( BETA )*ABS1( C( I, J ) ) + G( I ) = CABS1( ALPHA )*G( I ) + + $ CABS1( BETA )*CABS1( C( I, J ) ) 200 CONTINUE * * Compute the error ratio for this result. * ERR = ZERO DO 210 I = 1, M - ERRI = ABS1( CT( I ) - CC( I, J ) )/EPS + ERRI = CABS1( CT( I ) - CC( I, J ) )/EPS IF( G( I ).NE.RZERO ) $ ERRI = ERRI/G( I ) ERR = MAX( ERR, ERRI ) @@ -3245,7 +3529,7 @@ SUBROUTINE ZMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, 9998 FORMAT( 1X, I7, 2( ' (', G15.6, ',', G15.6, ')' ) ) 9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) * -* End of ZMMCH. +* End of ZMMCH * END LOGICAL FUNCTION LZE( RI, RJ, LR ) @@ -3277,7 +3561,7 @@ LOGICAL FUNCTION LZE( RI, RJ, LR ) LZE = .FALSE. 30 RETURN * -* End of LZE. +* End of LZE * END LOGICAL FUNCTION LZERES( TYPE, UPLO, M, N, AA, AS, LDA ) @@ -3338,7 +3622,7 @@ LOGICAL FUNCTION LZERES( TYPE, UPLO, M, N, AA, AS, LDA ) LZERES = .FALSE. 80 RETURN * -* End of LZERES. +* End of LZERES * END COMPLEX*16 FUNCTION ZBEG( RESET ) @@ -3392,7 +3676,7 @@ COMPLEX*16 FUNCTION ZBEG( RESET ) ZBEG = DCMPLX( ( I - 500 )/1001.0D0, ( J - 500 )/1001.0D0 ) RETURN * -* End of ZBEG. +* End of ZBEG * END DOUBLE PRECISION FUNCTION DDIFF( X, Y ) @@ -3411,7 +3695,7 @@ DOUBLE PRECISION FUNCTION DDIFF( X, Y ) DDIFF = X - Y RETURN * -* End of DDIFF. +* End of DDIFF * END SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -3429,19 +3713,28 @@ SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) * .. Scalar Arguments .. INTEGER INFOT, NOUT LOGICAL LERR, OK - CHARACTER*6 SRNAMT + CHARACTER*7 SRNAMT +* .. Scalars in Common .. + INTEGER NXRUN, NXFAIL, NXBAD +* .. Common blocks .. + COMMON /XERCNT/NXRUN, NXFAIL, NXBAD * .. Executable Statements .. + NXRUN = NXRUN + 1 IF( .NOT.LERR )THEN WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT OK = .FALSE. + NXFAIL = NXFAIL + 1 + ELSE IF( NXBAD.NE.0 )THEN + NXFAIL = NXFAIL + 1 END IF + NXBAD = 0 LERR = .FALSE. RETURN * 9999 FORMAT( ' ***** ILLEGAL VALUE OF PARAMETER NUMBER ', I2, ' NOT D', - $ 'ETECTED BY ', A6, ' *****' ) + $ 'ETECTED BY ', A7, ' *****' ) * -* End of CHKXER. +* End of CHKXER * END SUBROUTINE XERBLA( SRNAME, INFO ) @@ -3465,14 +3758,18 @@ SUBROUTINE XERBLA( SRNAME, INFO ) * * .. Scalar Arguments .. INTEGER INFO - CHARACTER*6 SRNAME + CHARACTER*(*) SRNAME * .. Scalars in Common .. + INTEGER NXRUN, NXFAIL, NXBAD INTEGER INFOT, NOUT LOGICAL LERR, OK - CHARACTER*6 SRNAMT + CHARACTER*7 SRNAMT * .. Common blocks .. COMMON /INFOC/INFOT, NOUT, OK, LERR + COMMON /XERCNT/NXRUN, NXFAIL, NXBAD COMMON /SRNAMC/SRNAMT +* .. Locals .. + INTEGER SRLEN * .. Executable Statements .. LERR = .TRUE. IF( INFO.NE.INFOT )THEN @@ -3482,17 +3779,20 @@ SUBROUTINE XERBLA( SRNAME, INFO ) WRITE( NOUT, FMT = 9997 )INFO END IF OK = .FALSE. + NXBAD = 1 END IF - IF( SRNAME.NE.SRNAMT )THEN + SRLEN = MIN(LEN_TRIM(SRNAME), LEN_TRIM(SRNAMT)) + IF( SRNAME(1:SRLEN).NE.SRNAMT(1:SRLEN) )THEN WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT OK = .FALSE. + NXBAD = 1 END IF RETURN * 9999 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6, ' INSTEAD', $ ' OF ', I2, ' *******' ) - 9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A6, ' INSTE', - $ 'AD OF ', A6, ' *******' ) + 9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A, ' INSTE', + $ 'AD OF ', A7, ' *******' ) 9997 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6, $ ' *******' ) * @@ -3500,3 +3800,511 @@ SUBROUTINE XERBLA( SRNAME, INFO ) * END + + + SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, + $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, + $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G ) +* +* Tests ZGEMMTR. +* +* Auxiliary routine for test program for Level 3 Blas. +* +* -- Written on 8-February-1989. +* Jack Dongarra, Argonne National Laboratory. +* Iain Duff, AERE Harwell. +* Jeremy Du Croz, Numerical Algorithms Group Ltd. +* Sven Hammarling, Numerical Algorithms Group Ltd. +* +* .. Parameters .. + COMPLEX*16 ZERO + PARAMETER ( ZERO = ( 0.0, 0.0 ) ) + DOUBLE PRECISION RZERO + PARAMETER ( RZERO = 0.0D0 ) +* .. Scalar Arguments .. + DOUBLE PRECISION EPS, THRESH + INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA + LOGICAL FATAL, REWI, TRACE + CHARACTER*7 SNAME +* .. Array Arguments .. + COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), + $ AS( NMAX*NMAX ), B( NMAX, NMAX ), + $ BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ), + $ C( NMAX, NMAX ), CC( NMAX*NMAX ), + $ CS( NMAX*NMAX ), CT( NMAX ) + DOUBLE PRECISION G( NMAX ) + INTEGER IDIM( NIDIM ) +* .. Local Scalars .. + COMPLEX*16 ALPHA, ALS, BETA, BLS + DOUBLE PRECISION ERR, ERRMAX + INTEGER NTESTS, NFAILS + INTEGER I, IA, IB, ICA, ICB, IK, IN, K, KS, LAA, + $ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, + $ MA, MB, N, NA, NARGS, NB, NC, NS, IS + LOGICAL NULL, RESET, SAME, TRANA, TRANB + CHARACTER*1 TRANAS, TRANBS, TRANSA, TRANSB, UPLO, UPLOS + CHARACTER*3 ICH + CHARACTER*2 ISHAPE +* .. Local Arrays .. + LOGICAL ISAME( 13 ) +* .. External Functions .. + LOGICAL LZE, LZERES + EXTERNAL LZE, LZERES +* .. External Subroutines .. + EXTERNAL ZGEMMTR, ZMAKE, ZMMTCH +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. Scalars in Common .. + INTEGER INFOT, NOUTC + LOGICAL LERR, OK +* .. Common blocks .. + COMMON /INFOC/INFOT, NOUTC, OK, LERR +* .. Data statements .. + DATA ICH/'NTC'/ + DATA ISHAPE/'UL'/ + +* .. Executable Statements .. +* + NARGS = 13 + NC = 0 + RESET = .TRUE. + ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 +* + DO 100 IN = 1, NIDIM + N = IDIM( IN ) +* Set LDC to 1 more than minimum value if room. + LDC = N + IF( LDC.LT.NMAX ) + $ LDC = LDC + 1 +* Skip tests if not enough room. + IF( LDC.GT.NMAX ) + $ GO TO 100 + LCC = LDC*N + NULL = N.LE.0 +* + DO 90 IK = 1, NIDIM + K = IDIM( IK ) +* + DO 80 ICA = 1, 3 + TRANSA = ICH( ICA: ICA ) + TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' +* + IF( TRANA )THEN + MA = K + NA = N + ELSE + MA = N + NA = K + END IF +* Set LDA to 1 more than minimum value if room. + LDA = MA + IF( LDA.LT.NMAX ) + $ LDA = LDA + 1 +* Skip tests if not enough room. + IF( LDA.GT.NMAX ) + $ GO TO 80 + LAA = LDA*NA +* +* Generate the matrix A. +* + CALL ZMAKE( 'GE', ' ', ' ', MA, NA, A, NMAX, AA, LDA, + $ RESET, ZERO ) +* + DO 70 ICB = 1, 3 + TRANSB = ICH( ICB: ICB ) + TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' +* + IF( TRANB )THEN + MB = N + NB = K + ELSE + MB = K + NB = N + END IF +* Set LDB to 1 more than minimum value if room. + LDB = MB + IF( LDB.LT.NMAX ) + $ LDB = LDB + 1 +* Skip tests if not enough room. + IF( LDB.GT.NMAX ) + $ GO TO 70 + LBB = LDB*NB +* +* Generate the matrix B. +* + CALL ZMAKE( 'GE', ' ', ' ', MB, NB, B, NMAX, BB, + $ LDB, RESET, ZERO ) +* + DO 60 IA = 1, NALF + ALPHA = ALF( IA ) +* + DO 50 IB = 1, NBET + BETA = BET( IB ) + DO 45 IS = 1, 2 + UPLO = ISHAPE( IS: IS ) + +* +* Generate the matrix C. +* + CALL ZMAKE( 'GE', UPLO, ' ', N, N, C, NMAX, + $ CC, LDC, RESET, ZERO ) +* + NC = NC + 1 +* +* Save every datum before calling the +* subroutine. +* + UPLOS = UPLO + TRANAS = TRANSA + TRANBS = TRANSB + NS = N + KS = K + ALS = ALPHA + DO 10 I = 1, LAA + AS( I ) = AA( I ) + 10 CONTINUE + LDAS = LDA + DO 20 I = 1, LBB + BS( I ) = BB( I ) + 20 CONTINUE + LDBS = LDB + BLS = BETA + DO 30 I = 1, LCC + CS( I ) = CC( I ) + 30 CONTINUE + LDCS = LDC +* +* Call the subroutine. +* + IF( TRACE ) + $ WRITE( NTRA, FMT = 9995 )NC, SNAME, UPLO, + $ TRANSA, TRANSB, N, K, ALPHA, LDA, LDB, + $ BETA, LDC + IF( REWI ) + $ REWIND NTRA + CALL ZGEMMTR( UPLO, TRANSA, TRANSB, N, K, + $ ALPHA, AA, LDA, BB, LDB, BETA, + $ CC, LDC ) +* +* Check if error-exit was taken incorrectly. +* + IF( .NOT.OK )THEN + WRITE( NOUT, FMT = 9994 ) + FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 + GO TO 120 + END IF +* +* See what data changed inside subroutines. +* + ISAME( 1 ) = UPLOS.EQ.UPLO + ISAME( 2 ) = TRANSA.EQ.TRANAS + ISAME( 3 ) = TRANSB.EQ.TRANBS + ISAME( 4 ) = NS.EQ.N + ISAME( 5 ) = KS.EQ.K + ISAME( 6 ) = ALS.EQ.ALPHA + ISAME( 7 ) = LZE( AS, AA, LAA ) + ISAME( 8 ) = LDAS.EQ.LDA + ISAME( 9 ) = LZE( BS, BB, LBB ) + ISAME( 10 ) = LDBS.EQ.LDB + ISAME( 11 ) = BLS.EQ.BETA + IF( NULL )THEN + ISAME( 12 ) = LZE( CS, CC, LCC ) + ELSE + ISAME( 12 ) = LZERES( 'GE', ' ', N, N, CS, + $ CC, LDC ) + END IF + ISAME( 13 ) = LDCS.EQ.LDC +* +* If data was incorrectly changed, report +* and return. +* + SAME = .TRUE. + DO 40 I = 1, NARGS + SAME = SAME.AND.ISAME( I ) + IF( .NOT.ISAME( I ) ) + $ WRITE( NOUT, FMT = 9998 )I + 40 CONTINUE + IF( .NOT.SAME )THEN + FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 + GO TO 120 + END IF +* + IF( .NOT.NULL )THEN +* +* Check the result. +* + CALL ZMMTCH( UPLO, TRANSA, TRANSB, N, + $ K, ALPHA, A, NMAX, B, NMAX, + $ BETA, C, NMAX, CT, G, CC, LDC, + $ EPS, ERR, FATAL, NOUT, .TRUE.) + ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 +* If got really bad answer, report and +* return. + IF( FATAL ) + $ GO TO 120 + END IF + 45 CONTINUE +* + 50 CONTINUE +* + 60 CONTINUE +* + 70 CONTINUE +* + 80 CONTINUE +* + 90 CONTINUE +* + 100 CONTINUE +* +* +* Report result. +* + IF( ERRMAX.LT.THRESH )THEN + WRITE( NOUT, FMT = 9999 )SNAME, NC + ELSE + WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX + END IF + GO TO 130 +* + 120 CONTINUE + WRITE( NOUT, FMT = 9996 )SNAME + WRITE( NOUT, FMT = 9995 )NC, UPLO, SNAME, TRANSA, TRANSB, N, K, + $ ALPHA, LDA, LDB, BETA, LDC +* + 130 CONTINUE + WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + RETURN +* + 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', + $ 'S)' ) + 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', + $ 'ANGED INCORRECTLY *******' ) + 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', + $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, + $ ' - SUSPECT *******' ) + 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A7, '(''',A1, ''',''',A1, ''',''', A1,''',', + $ 2( I3, ',' ), '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, + $ ',(', F4.1, ',', F4.1, '), C,', I3, ').' ) + 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', + $ '******' ) + 9979 FORMAT( ' ', A7, ' COMPUTATIONAL TESTS:', I9, ' RUN,', I9, + $ ' FAILED' ) +* +* End of ZCHK6 +* + END + + SUBROUTINE ZMMTCH( UPLO, TRANSA, TRANSB, N, KK, ALPHA, A, LDA, + $ B, LDB, BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, + $ FATAL, NOUT, MV ) + IMPLICIT NONE +* +* Checks the results of the computational tests. +* +* Auxiliary routine for test program for Level 3 Blas. +* +* -- Written on 8-February-1989. +* Jack Dongarra, Argonne National Laboratory. +* Iain Duff, AERE Harwell. +* Jeremy Du Croz, Numerical Algorithms Group Ltd. +* Sven Hammarling, Numerical Algorithms Group Ltd. +* +* .. Parameters .. + COMPLEX*16 ZERO + PARAMETER ( ZERO = ( 0.0, 0.0 ) ) + DOUBLE PRECISION RZERO, RONE + PARAMETER ( RZERO = 0.0D0, RONE = 1.0D0 ) +* .. Scalar Arguments .. + COMPLEX*16 ALPHA, BETA + DOUBLE PRECISION EPS, ERR + INTEGER KK, LDA, LDB, LDC, LDCC, N, NOUT + LOGICAL FATAL, MV + CHARACTER*1 TRANSA, TRANSB, UPLO +* .. Array Arguments .. + COMPLEX*16 A( LDA, * ), B( LDB, * ), C( LDC, * ), + $ CC( LDCC, * ), CT( * ) + DOUBLE PRECISION G( * ) +* .. Local Scalars .. + COMPLEX*16 CL + DOUBLE PRECISION ERRI + INTEGER I, J, K, ISTART, ISTOP + LOGICAL CTRANA, CTRANB, TRANA, TRANB, UPPER +* .. Intrinsic Functions .. + INTRINSIC ABS, AIMAG, CONJG, MAX, REAL, SQRT +* .. Statement Functions .. + DOUBLE PRECISION CABS1 +* .. Statement Function definitions .. + CABS1( CL ) = ABS( DBLE( CL ) ) + ABS( DIMAG( CL ) ) +* .. Executable Statements .. + UPPER = UPLO.EQ.'U' + TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' + TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' + CTRANA = TRANSA.EQ.'C' + CTRANB = TRANSB.EQ.'C' +* +* Compute expected result, one column at a time, in CT using data +* in A, B and C. +* Compute gauges in G. +* + ISTART = 1 + ISTOP = 1 + + DO 220 J = 1, N +* + IF ( UPPER ) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 10 I = ISTART, ISTOP + CT( I ) = ZERO + G( I ) = RZERO + 10 CONTINUE + IF( .NOT.TRANA.AND..NOT.TRANB )THEN + DO 30 K = 1, KK + DO 20 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*B( K, J ) + G( I ) = G( I ) + $ + CABS1( A( I, K ) )*CABS1( B( K, J ) ) + 20 CONTINUE + 30 CONTINUE + ELSE IF( TRANA.AND..NOT.TRANB )THEN + IF( CTRANA )THEN + DO 50 K = 1, KK + DO 40 I = ISTART, ISTOP + CT( I ) = CT( I ) + CONJG( A( K, I ) )*B( K, J ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( K, J ) ) + 40 CONTINUE + 50 CONTINUE + ELSE + DO 70 K = 1, KK + DO 60 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*B( K, J ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( K, J ) ) + 60 CONTINUE + 70 CONTINUE + END IF + ELSE IF( .NOT.TRANA.AND.TRANB )THEN + IF( CTRANB )THEN + DO 90 K = 1, KK + DO 80 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*CONJG( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( I, K ) )* + $ CABS1( B( J, K ) ) + 80 CONTINUE + 90 CONTINUE + ELSE + DO 110 K = 1, KK + DO 100 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*B( J, K ) + G( I ) = G( I ) + CABS1( A( I, K ) )* + $ CABS1( B( J, K ) ) + 100 CONTINUE + 110 CONTINUE + END IF + ELSE IF( TRANA.AND.TRANB )THEN + IF( CTRANA )THEN + IF( CTRANB )THEN + DO 130 K = 1, KK + DO 120 I = ISTART, ISTOP + CT( I ) = CT( I ) + CONJG( A( K, I ) )* + $ CONJG( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( J, K ) ) + 120 CONTINUE + 130 CONTINUE + ELSE + DO 150 K = 1, KK + DO 140 I = ISTART, ISTOP + CT( I ) = CT( I ) + CONJG( A( K, I ) )*B( J, K ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( J, K ) ) + 140 CONTINUE + 150 CONTINUE + END IF + ELSE + IF( CTRANB )THEN + DO 170 K = 1, KK + DO 160 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*CONJG( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( J, K ) ) + 160 CONTINUE + 170 CONTINUE + ELSE + DO 190 K = 1, KK + DO 180 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*B( J, K ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( J, K ) ) + 180 CONTINUE + 190 CONTINUE + END IF + END IF + END IF + DO 200 I = ISTART, ISTOP + CT( I ) = ALPHA*CT( I ) + BETA*C( I, J ) + G( I ) = CABS1( ALPHA )*G( I ) + + $ CABS1( BETA )*CABS1( C( I, J ) ) + 200 CONTINUE +* +* Compute the error ratio for this result. +* + ERR = ZERO + DO 210 I = ISTART, ISTOP + ERRI = CABS1( CT( I ) - CC( I, J ) )/EPS + IF( G( I ).NE.RZERO ) + $ ERRI = ERRI/G( I ) + ERR = MAX( ERR, ERRI ) + IF( ERR*SQRT( EPS ).GE.RONE ) + $ GO TO 230 + 210 CONTINUE +* + 220 CONTINUE +* +* If the loop completes, all results are at least half accurate. + GO TO 250 +* +* Report fatal error. +* + 230 FATAL = .TRUE. + WRITE( NOUT, FMT = 9999 ) + DO 240 I = ISTART, ISTOP + IF( MV )THEN + WRITE( NOUT, FMT = 9998 )I, CT( I ), CC( I, J ) + ELSE + WRITE( NOUT, FMT = 9998 )I, CC( I, J ), CT( I ) + END IF + 240 CONTINUE + IF( N.GT.1 ) + $ WRITE( NOUT, FMT = 9997 )J +* + 250 CONTINUE + RETURN +* + 9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL', + $ 'F ACCURATE *******', /' EXPECTED RE', + $ 'SULT COMPUTED RESULT' ) + 9998 FORMAT( 1X, I7, 2( ' (', G15.6, ',', G15.6, ')' ) ) + 9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) +* +* End of ZMMTCH +* + END + diff --git a/BLAS/TESTING/zblat3.in b/BLAS/TESTING/zblat3.in index a3618b0f6d..7768859c11 100644 --- a/BLAS/TESTING/zblat3.in +++ b/BLAS/TESTING/zblat3.in @@ -12,12 +12,13 @@ T LOGICAL FLAG, T TO TEST ERROR EXITS. (0.0,0.0) (1.0,0.0) (0.7,-0.9) VALUES OF ALPHA 3 NUMBER OF VALUES OF BETA (0.0,0.0) (1.0,0.0) (1.3,-1.1) VALUES OF BETA -ZGEMM T PUT F FOR NO TEST. SAME COLUMNS. -ZHEMM T PUT F FOR NO TEST. SAME COLUMNS. -ZSYMM T PUT F FOR NO TEST. SAME COLUMNS. -ZTRMM T PUT F FOR NO TEST. SAME COLUMNS. -ZTRSM T PUT F FOR NO TEST. SAME COLUMNS. -ZHERK T PUT F FOR NO TEST. SAME COLUMNS. -ZSYRK T PUT F FOR NO TEST. SAME COLUMNS. -ZHER2K T PUT F FOR NO TEST. SAME COLUMNS. -ZSYR2K T PUT F FOR NO TEST. SAME COLUMNS. +ZGEMM T PUT F FOR NO TEST. SAME COLUMNS. +ZHEMM T PUT F FOR NO TEST. SAME COLUMNS. +ZSYMM T PUT F FOR NO TEST. SAME COLUMNS. +ZTRMM T PUT F FOR NO TEST. SAME COLUMNS. +ZTRSM T PUT F FOR NO TEST. SAME COLUMNS. +ZHERK T PUT F FOR NO TEST. SAME COLUMNS. +ZSYRK T PUT F FOR NO TEST. SAME COLUMNS. +ZHER2K T PUT F FOR NO TEST. SAME COLUMNS. +ZSYR2K T PUT F FOR NO TEST. SAME COLUMNS. +ZGEMMTR T PUT F FOR NO TEST. SAME COLUMNS. diff --git a/BLAS/blas.pc.in b/BLAS/blas.pc.in index 37809773ba..31e11e6389 100644 --- a/BLAS/blas.pc.in +++ b/BLAS/blas.pc.in @@ -5,4 +5,4 @@ Name: BLAS Description: FORTRAN reference implementation of BLAS Basic Linear Algebra Subprograms Version: @LAPACK_VERSION@ URL: http://www.netlib.org/blas/ -Libs: -L${libdir} -lblas +Libs: -L${libdir} -l@BLASLIB@ diff --git a/CBLAS/.clang-format b/CBLAS/.clang-format new file mode 100644 index 0000000000..1a990a6a8b --- /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/CMakeLists.txt b/CBLAS/CMakeLists.txt index d9fa245303..eb360cdee3 100644 --- a/CBLAS/CMakeLists.txt +++ b/CBLAS/CMakeLists.txt @@ -1,23 +1,30 @@ -message(STATUS "CBLAS enable") +message(STATUS "CBLAS enabled") enable_language(C) -set(LAPACK_INSTALL_EXPORT_NAME cblas-targets) +include(CheckLanguage) +check_language(Fortran) +if(CMAKE_Fortran_COMPILER) + enable_language(Fortran) -# Create a header file cblas.h for the routines called in my C programs -include(FortranCInterface) -## Ensure that the fortran compiler and c compiler specified are compatible -FortranCInterface_VERIFY() -FortranCInterface_HEADER(${LAPACK_BINARY_DIR}/include/cblas_mangling.h - MACRO_NAMESPACE "F77_" - SYMBOL_NAMESPACE "F77_") -if(NOT FortranCInterface_GLOBAL_FOUND OR NOT FortranCInterface_MODULE_FOUND) - message(WARNING "Reverting to pre-defined include/lapacke_mangling.h") - configure_file(include/lapacke_mangling_with_flags.h.in - ${LAPACK_BINARY_DIR}/include/lapacke_mangling.h) + # Check for any necessary platform specific compiler flags + include(CheckLAPACKCompilerFlags) + CheckLAPACKCompilerFlags() endif() -include_directories(include ${LAPACK_BINARY_DIR}/include) -add_subdirectory(include) +set(LAPACK_INSTALL_EXPORT_NAME ${CBLASLIB}-targets) + +if(WIN32) + # MSVC does not support __attribute__((weak)) and the Intel compiler supports + # it but produces linker errors when used in CBLAS, so we disable it for all + # Windows builds. + set(HAS_ATTRIBUTE_WEAK_SUPPORT FALSE) +else() + include(CheckCSourceCompiles) + check_c_source_compiles("int __attribute__((weak)) main() {};" + HAS_ATTRIBUTE_WEAK_SUPPORT) +endif() + +include_directories(${LAPACK_BINARY_DIR}/include include) add_subdirectory(src) macro(append_subdir_files variable dirname) @@ -27,59 +34,34 @@ foreach(depfile ${holder}) endforeach() endmacro() -append_subdir_files(CBLAS_INCLUDE "include") -install(FILES ${CBLAS_INCLUDE} ${LAPACK_BINARY_DIR}/include/cblas_mangling.h DESTINATION ${CMAKE_INSTALL_INCLUDEDIR}) - -# -------------------------------------------------- if(BUILD_TESTING) add_subdirectory(testing) add_subdirectory(examples) endif() -if(NOT BLAS_FOUND) - set(ALL_TARGETS ${ALL_TARGETS} blas) -endif() - -# Export cblas targets from the -# install tree, if any. -set(_cblas_config_install_guard_target "") -if(ALL_TARGETS) - install(EXPORT cblas-targets - DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/cblas-${LAPACK_VERSION}) - # Choose one of the cblas targets to use as a guard for - # cblas-config.cmake to load targets from the install tree. - list(GET ALL_TARGETS 0 _cblas_config_install_guard_target) -endif() - -# Export cblas targets from the build tree, if any. -set(_cblas_config_build_guard_target "") -if(ALL_TARGETS) - export(TARGETS ${ALL_TARGETS} FILE cblas-targets.cmake) - - # Choose one of the cblas targets to use as a guard - # for cblas-config.cmake to load targets from the build tree. - list(GET ALL_TARGETS 0 _cblas_config_build_guard_target) -endif() +configure_file(${CMAKE_CURRENT_SOURCE_DIR}/cblas.pc.in + ${CMAKE_CURRENT_BINARY_DIR}/${CBLASLIB}.pc @ONLY) +install(FILES + ${CMAKE_CURRENT_BINARY_DIR}/${CBLASLIB}.pc + DESTINATION ${PKG_CONFIG_DIR} + COMPONENT Development + ) configure_file(${CMAKE_CURRENT_SOURCE_DIR}/cmake/cblas-config-version.cmake.in - ${LAPACK_BINARY_DIR}/cblas-config-version.cmake @ONLY) + ${LAPACK_BINARY_DIR}/${CBLASLIB}-config-version.cmake @ONLY) configure_file(${CMAKE_CURRENT_SOURCE_DIR}/cmake/cblas-config-build.cmake.in - ${LAPACK_BINARY_DIR}/cblas-config.cmake @ONLY) - - -configure_file(${CMAKE_CURRENT_SOURCE_DIR}/cblas.pc.in ${CMAKE_CURRENT_BINARY_DIR}/cblas.pc @ONLY) - install(FILES - ${CMAKE_CURRENT_BINARY_DIR}/cblas.pc - DESTINATION ${PKG_CONFIG_DIR} - ) + ${LAPACK_BINARY_DIR}/${CBLASLIB}-config.cmake @ONLY) configure_file(${CMAKE_CURRENT_SOURCE_DIR}/cmake/cblas-config-install.cmake.in - ${CMAKE_CURRENT_BINARY_DIR}/CMakeFiles/cblas-config.cmake @ONLY) + ${CMAKE_CURRENT_BINARY_DIR}/CMakeFiles/${CBLASLIB}-config.cmake @ONLY) install(FILES - ${CMAKE_CURRENT_BINARY_DIR}/CMakeFiles/cblas-config.cmake - ${LAPACK_BINARY_DIR}/cblas-config-version.cmake - DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/cblas-${LAPACK_VERSION} + ${CMAKE_CURRENT_BINARY_DIR}/CMakeFiles/${CBLASLIB}-config.cmake + ${LAPACK_BINARY_DIR}/${CBLASLIB}-config-version.cmake + DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/${CBLASLIB}-${LAPACK_VERSION} + COMPONENT Development ) -#install(EXPORT cblas-targets -# DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/cblas-${LAPACK_VERSION}) +install(EXPORT ${CBLASLIB}-targets + DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/${CBLASLIB}-${LAPACK_VERSION} + COMPONENT Development + ) diff --git a/CBLAS/Makefile b/CBLAS/Makefile index 513e8fc824..6e199cdceb 100644 --- a/CBLAS/Makefile +++ b/CBLAS/Makefile @@ -1,19 +1,25 @@ -include ../make.inc +TOPSRCDIR = .. +include $(TOPSRCDIR)/make.inc +.PHONY: all all: cblas +.PHONY: cblas cblas: include/cblas_mangling.h $(MAKE) -C src include/cblas_mangling.h: include/cblas_mangling_with_flags.h.in - cp $< $@ + cp include/cblas_mangling_with_flags.h.in $@ +.PHONY: cblas_testing cblas_testing: cblas $(MAKE) -C testing run +.PHONY: cblas_example cblas_example: cblas $(MAKE) -C examples +.PHONY: clean cleanobj cleanlib cleanexe cleantest clean: $(MAKE) -C src clean $(MAKE) -C testing clean diff --git a/CBLAS/cblas.pc.in b/CBLAS/cblas.pc.in index 7c95ebbb43..882642e6c0 100644 --- a/CBLAS/cblas.pc.in +++ b/CBLAS/cblas.pc.in @@ -5,6 +5,6 @@ Name: CBLAS Description: C Standard Interface to BLAS Basic Linear Algebra Subprograms Version: @LAPACK_VERSION@ URL: http://www.netlib.org/blas/#_cblas -Libs: -L${libdir} -lcblas +Libs: -L${libdir} -l@CBLASLIB@ Cflags: -I${includedir} -Requires.private: blas +Requires.private: @BLASLIB@ diff --git a/CBLAS/cmake/cblas-config-build.cmake.in b/CBLAS/cmake/cblas-config-build.cmake.in index 3747f041c4..dc21c2d0f3 100644 --- a/CBLAS/cmake/cblas-config-build.cmake.in +++ b/CBLAS/cmake/cblas-config-build.cmake.in @@ -4,11 +4,11 @@ find_package(LAPACK NO_MODULE) # Load lapack targets from the build tree, including lapacke targets. if(NOT TARGET lapacke) - include("@LAPACK_BINARY_DIR@/lapack-targets.cmake") + include("@LAPACK_BINARY_DIR@/@LAPACKLIB@-targets.cmake") endif() # Report cblas header search locations from build tree. set(CBLAS_INCLUDE_DIRS "@LAPACK_BINARY_DIR@/include") # Report cblas libraries. -set(CBLAS_LIBRARIES cblas) +set(CBLAS_LIBRARIES @CBLASLIB@) diff --git a/CBLAS/cmake/cblas-config-install.cmake.in b/CBLAS/cmake/cblas-config-install.cmake.in index a5e2183e1a..95b1f71941 100644 --- a/CBLAS/cmake/cblas-config-install.cmake.in +++ b/CBLAS/cmake/cblas-config-install.cmake.in @@ -1,23 +1,19 @@ # Compute locations from /@{LIBRARY_DIR@/cmake/lapacke-/.cmake get_filename_component(_CBLAS_SELF_DIR "${CMAKE_CURRENT_LIST_FILE}" PATH) -get_filename_component(_CBLAS_PREFIX "${_CBLAS_SELF_DIR}" PATH) -get_filename_component(_CBLAS_PREFIX "${_CBLAS_PREFIX}" PATH) -get_filename_component(_CBLAS_PREFIX "${_CBLAS_PREFIX}" PATH) # Load the LAPACK package with which we were built. -set(LAPACK_DIR "${_CBLAS_PREFIX}/@{LIBRARY_DIR@/cmake/lapack-@LAPACK_VERSION@") +set(LAPACK_DIR "@CMAKE_INSTALL_FULL_LIBDIR@/cmake/@LAPACKLIB@-@LAPACK_VERSION@") find_package(LAPACK NO_MODULE) # Load lapacke targets from the install tree. -if(NOT TARGET cblas) - include(${_CBLAS_SELF_DIR}/cblas-targets.cmake) +if(NOT TARGET @CBLASLIB@) + include(${_CBLAS_SELF_DIR}/@CBLASLIB@-targets.cmake) endif() # Report lapacke header search locations. -set(CBLAS_INCLUDE_DIRS ${_CBLAS_PREFIX}/include) +set(CBLAS_INCLUDE_DIRS @CMAKE_INSTALL_FULL_INCLUDEDIR@) # Report lapacke libraries. -set(CBLAS_LIBRARIES cblas) +set(CBLAS_LIBRARIES @CBLASLIB@) -unset(_CBLAS_PREFIX) unset(_CBLAS_SELF_DIR) diff --git a/CBLAS/examples/CMakeLists.txt b/CBLAS/examples/CMakeLists.txt index 0241fd1640..a6fe68b867 100644 --- a/CBLAS/examples/CMakeLists.txt +++ b/CBLAS/examples/CMakeLists.txt @@ -1,8 +1,21 @@ -add_executable(xexample1_CBLAS cblas_example1.c) -add_executable(xexample2_CBLAS cblas_example2.c) +if(BUILD_DEFAULT_API) + add_executable(xexample1_CBLAS cblas_example1.c) + add_executable(xexample2_CBLAS cblas_example2.c) -target_link_libraries(xexample1_CBLAS cblas) -target_link_libraries(xexample2_CBLAS cblas ${BLAS_LIBRARIES}) + target_link_libraries(xexample1_CBLAS ${CBLASLIB}) + target_link_libraries(xexample2_CBLAS ${CBLASLIB} ${BLAS_LIBRARIES}) -add_test(example1_CBLAS ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/xexample1_CBLAS) -add_test(example2_CBLAS ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/xexample2_CBLAS) + add_test(example1_CBLAS ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/xexample1_CBLAS) + add_test(example2_CBLAS ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/xexample2_CBLAS) +endif() + +if(BUILD_INDEX64_EXT_API) + add_executable(xexample1_64_CBLAS cblas_example1_64.c) + add_executable(xexample2_64_CBLAS cblas_example2_64.c) + + target_link_libraries(xexample1_64_CBLAS ${CBLASLIB}) + target_link_libraries(xexample2_64_CBLAS ${CBLASLIB} ${BLAS_LIBRARIES}) + + add_test(example1_64_CBLAS ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/xexample1_64_CBLAS) + add_test(example2_64_CBLAS ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/xexample2_64_CBLAS) +endif() diff --git a/CBLAS/examples/Makefile b/CBLAS/examples/Makefile index 664b8bc576..84acd65618 100644 --- a/CBLAS/examples/Makefile +++ b/CBLAS/examples/Makefile @@ -1,17 +1,21 @@ -include ../../make.inc +TOPSRCDIR = ../.. +include $(TOPSRCDIR)/make.inc +.SUFFIXES: .c .o +.c.o: + $(CC) $(CFLAGS) -I../include -c -o $@ $< + +.PHONY: all all: cblas_ex1 cblas_ex2 cblas_ex1: cblas_example1.o $(CBLASLIB) $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ cblas_ex2: cblas_example2.o $(CBLASLIB) $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ +.PHONY: clean cleanobj cleanexe clean: cleanobj cleanexe cleanobj: rm -f *.o cleanexe: rm -f cblas_ex1 cblas_ex2 - -.c.o: - $(CC) $(CFLAGS) -I../include -c -o $@ $< diff --git a/CBLAS/examples/cblas_example1.c b/CBLAS/examples/cblas_example1.c index c3acd554d4..0571770ba5 100644 --- a/CBLAS/examples/cblas_example1.c +++ b/CBLAS/examples/cblas_example1.c @@ -11,7 +11,7 @@ int main ( ) double *a, *x, *y; double alpha, beta; - int m, n, lda, incx, incy, i; + CBLAS_INT m, n, lda, incx, incy, i; Layout = CblasColMajor; transa = CblasNoTrans; @@ -47,7 +47,7 @@ int main ( ) a[m*3+1] = 6; a[m*3+2] = 7; a[m*3+3] = 8; - /* The elemetns of x and y */ + /* The elements of x and y */ x[0] = 1; x[1] = 2; x[2] = 1; @@ -61,7 +61,7 @@ int main ( ) y, incy ); /* Print y */ for( i = 0; i < n; i++ ) - printf(" y%d = %f\n", i, y[i]); + printf(" y%" CBLAS_IFMT " = %f\n", i, y[i]); free(a); free(x); free(y); diff --git a/CBLAS/examples/cblas_example1_64.c b/CBLAS/examples/cblas_example1_64.c new file mode 100644 index 0000000000..99c1f55f67 --- /dev/null +++ b/CBLAS/examples/cblas_example1_64.c @@ -0,0 +1,69 @@ +/* cblas_example.c */ + +#include +#include +#include "cblas_64.h" + +int main ( ) +{ + CBLAS_LAYOUT Layout; + CBLAS_TRANSPOSE transa; + + double *a, *x, *y; + double alpha, beta; + int64_t m, n, lda, incx, incy, i; + + Layout = CblasColMajor; + transa = CblasNoTrans; + + m = 4; /* Size of Column ( the number of rows ) */ + n = 4; /* Size of Row ( the number of columns ) */ + lda = 4; /* Leading dimension of 5 * 4 matrix is 5 */ + incx = 1; + incy = 1; + alpha = 1; + beta = 0; + + a = (double *)malloc(sizeof(double)*m*n); + x = (double *)malloc(sizeof(double)*n); + y = (double *)malloc(sizeof(double)*n); + /* The elements of the first column */ + a[0] = 1; + a[1] = 2; + a[2] = 3; + a[3] = 4; + /* The elements of the second column */ + a[m] = 1; + a[m+1] = 1; + a[m+2] = 1; + a[m+3] = 1; + /* The elements of the third column */ + a[m*2] = 3; + a[m*2+1] = 4; + a[m*2+2] = 5; + a[m*2+3] = 6; + /* The elements of the fourth column */ + a[m*3] = 5; + a[m*3+1] = 6; + a[m*3+2] = 7; + a[m*3+3] = 8; + /* The elements of x and y */ + x[0] = 1; + x[1] = 2; + x[2] = 1; + x[3] = 1; + y[0] = 0; + y[1] = 0; + y[2] = 0; + y[3] = 0; + + cblas_dgemv_64( Layout, transa, m, n, alpha, a, lda, x, incx, beta, + y, incy ); + /* Print y */ + for( i = 0; i < n; i++ ) + printf(" y%" PRId64 " = %f\n", i, y[i]); + free(a); + free(x); + free(y); + return 0; +} diff --git a/CBLAS/examples/cblas_example2.c b/CBLAS/examples/cblas_example2.c index d2c28d53f3..8b6e6b4d4e 100644 --- a/CBLAS/examples/cblas_example2.c +++ b/CBLAS/examples/cblas_example2.c @@ -9,7 +9,7 @@ int main (int argc, char **argv ) { - int rout=-1,info=0,m,n,k,lda,ldb,ldc; + CBLAS_INT rout=-1,info=0,m,n,k,lda,ldb,ldc; double A[2] = {0.0,0.0}, B[2] = {0.0,0.0}, C[2] = {0.0,0.0}, diff --git a/CBLAS/examples/cblas_example2_64.c b/CBLAS/examples/cblas_example2_64.c new file mode 100644 index 0000000000..1682e6d208 --- /dev/null +++ b/CBLAS/examples/cblas_example2_64.c @@ -0,0 +1,75 @@ +/* cblas_example2.c */ + +#define CBLAS_API64 +#define F77_INT int64_t + +#include +#include +#include "cblas_64.h" +#include "cblas_f77.h" + +#define INVALID -1 + +int main (int argc, char **argv ) +{ + int64_t rout=-1,info=0,m,n,k,lda,ldb,ldc; + double A[2] = {0.0,0.0}, + B[2] = {0.0,0.0}, + C[2] = {0.0,0.0}, + ALPHA=0.0, BETA=0.0; + + if (argc > 2){ + rout = atoi(argv[1]); + info = atoi(argv[2]); + } + + if (rout == 1) { + if (info==0) { + printf("Checking if cblas_dgemm fails on parameter 4\n"); + cblas_dgemm_64( CblasRowMajor, CblasTrans, CblasNoTrans, INVALID, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + } + if (info==1) { + printf("Checking if cblas_dgemm fails on parameter 5\n"); + cblas_dgemm_64( CblasRowMajor, CblasNoTrans, CblasTrans, 0, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + } + if (info==2) { + printf("Checking if cblas_dgemm fails on parameter 9\n"); + cblas_dgemm_64( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 2 ); + } + if (info==3) { + printf("Checking if cblas_dgemm fails on parameter 11\n"); + cblas_dgemm_64( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 2, 2, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + } + } else { + if (info==0) { + printf("Checking if F77_dgemm fails on parameter 3\n"); + m=INVALID; n=0; k=0; lda=1; ldb=1; ldc=1; + F77_dgemm( "T", "N", &m, &n, &k, + &ALPHA, A, &lda, B, &ldb, &BETA, C, &ldc ); + } + if (info==1) { + m=0; n=INVALID; k=0; lda=1; ldb=1; ldc=1; + printf("Checking if F77_dgemm fails on parameter 4\n"); + F77_dgemm( "N", "T", &m, &n, &k, + &ALPHA, A, &lda, B, &ldb, &BETA, C, &ldc ); + } + if (info==2) { + printf("Checking if F77_dgemm fails on parameter 8\n"); + m=2; n=0; k=0; lda=1; ldb=1; ldc=2; + F77_dgemm( "N", "N" , &m, &n, &k, + &ALPHA, A, &lda, B, &ldb, &BETA, C, &ldc ); + } + if (info==3) { + printf("Checking if F77_dgemm fails on parameter 10\n"); + m=0; n=0; k=2; lda=1; ldb=1; ldc=1; + F77_dgemm( "N", "N" , &m, &n, &k, + &ALPHA, A, &lda, B, &ldb, &BETA, C, &ldc ); + } + } + + return 0; +} diff --git a/CBLAS/include/CMakeLists.txt b/CBLAS/include/CMakeLists.txt index 299b45c9eb..d7aee02a48 100644 --- a/CBLAS/include/CMakeLists.txt +++ b/CBLAS/include/CMakeLists.txt @@ -1,3 +1,49 @@ -set(CBLAS_INCLUDE cblas.h cblas_f77.h cblas_test.h) +# Replace FORTRAN_STRLEN definition in cblas_f77.h if needed +file(READ cblas_f77.h cblas_f77_h_content) +if(FORTRAN_STRLEN_TYPE) + string(REPLACE + "#define FORTRAN_STRLEN size_t" "#define FORTRAN_STRLEN ${FORTRAN_STRLEN_TYPE}" + cblas_f77_h_content "${cblas_f77_h_content}") +endif() +file(WRITE ${LAPACK_BINARY_DIR}/include/cblas_f77.h "${cblas_f77_h_content}") +install( + FILES ${LAPACK_BINARY_DIR}/include/cblas_f77.h + DESTINATION ${CMAKE_INSTALL_INCLUDEDIR} + COMPONENT Development) -file(COPY ${CBLAS_INCLUDE} DESTINATION ${LAPACK_BINARY_DIR}/include) +if(CBLAS) + set(CBLAS_INCLUDE cblas.h cblas_64.h) + file(COPY ${CBLAS_INCLUDE} DESTINATION ${LAPACK_BINARY_DIR}/include) + install(FILES ${CBLAS_INCLUDE} + DESTINATION ${CMAKE_INSTALL_INCLUDEDIR} + COMPONENT Development) +endif() + +# Create a header file for CBLAS routine mangling (cblas_mangling.h) +include(CheckLanguage) +check_language(Fortran) +check_language(C) +if(CMAKE_Fortran_COMPILER AND CMAKE_C_COMPILER) + enable_language(Fortran) + enable_language(C) + include(FortranCInterface) + ## Ensure that the fortran compiler and c compiler specified are compatible + FortranCInterface_VERIFY() + FortranCInterface_HEADER(${LAPACK_BINARY_DIR}/include/cblas_mangling.h + MACRO_NAMESPACE "F77_" + SYMBOL_NAMESPACE "F77_") + + # Check for any necessary platform specific compiler flags + include(CheckLAPACKCompilerFlags) + CheckLAPACKCompilerFlags() +endif() +if(NOT FortranCInterface_GLOBAL_FOUND OR NOT FortranCInterface_MODULE_FOUND) + message(WARNING "Reverting to pre-defined include/cblas_mangling.h") + configure_file( + cblas_mangling_with_flags.h.in + ${LAPACK_BINARY_DIR}/include/cblas_mangling.h) +endif() + +install(FILES ${LAPACK_BINARY_DIR}/include/cblas_mangling.h + DESTINATION ${CMAKE_INSTALL_INCLUDEDIR} + COMPONENT Development) diff --git a/CBLAS/include/cblas.h b/CBLAS/include/cblas.h index 9e937964ed..d840bc944a 100644 --- a/CBLAS/include/cblas.h +++ b/CBLAS/include/cblas.h @@ -1,6 +1,8 @@ #ifndef CBLAS_H #define CBLAS_H #include +#include +#include #ifdef __cplusplus @@ -10,21 +12,65 @@ extern "C" { /* Assume C declarations for C++ */ /* * Enumerated and derived types */ +#define CBLAS_INDEX size_t /* this may vary between platforms */ + +/* + * Integer type + */ +#ifndef CBLAS_INT +#ifdef WeirdNEC + #define CBLAS_INT int64_t +#else + #define CBLAS_INT int32_t +#endif +#endif + +/* + * Integer format string + */ +#ifndef CBLAS_IFMT #ifdef WeirdNEC - #define CBLAS_INDEX long + #define CBLAS_IFMT PRId64 #else - #define CBLAS_INDEX int + #define CBLAS_IFMT PRId32 +#endif #endif -typedef enum {CblasRowMajor=101, CblasColMajor=102} CBLAS_LAYOUT; -typedef enum {CblasNoTrans=111, CblasTrans=112, CblasConjTrans=113} CBLAS_TRANSPOSE; -typedef enum {CblasUpper=121, CblasLower=122} CBLAS_UPLO; -typedef enum {CblasNonUnit=131, CblasUnit=132} CBLAS_DIAG; -typedef enum {CblasLeft=141, CblasRight=142} CBLAS_SIDE; +typedef enum CBLAS_LAYOUT {CblasRowMajor=101, CblasColMajor=102} CBLAS_LAYOUT; +typedef enum CBLAS_TRANSPOSE {CblasNoTrans=111, CblasTrans=112, CblasConjTrans=113} CBLAS_TRANSPOSE; +typedef enum CBLAS_UPLO {CblasUpper=121, CblasLower=122} CBLAS_UPLO; +typedef enum CBLAS_DIAG {CblasNonUnit=131, CblasUnit=132} CBLAS_DIAG; +typedef enum CBLAS_SIDE {CblasLeft=141, CblasRight=142} CBLAS_SIDE; -typedef CBLAS_LAYOUT CBLAS_ORDER; /* this for backward compatibility with CBLAS_ORDER */ +#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 + */ +#ifndef API_SUFFIX +#ifdef CBLAS_API64 +#define API_SUFFIX(a) a##_64 +#include "cblas_64.h" +#else +#define API_SUFFIX(a) a +#endif +#endif -#include "cblas_mangling.h" /* * =========================================================================== @@ -35,52 +81,52 @@ typedef CBLAS_LAYOUT CBLAS_ORDER; /* this for backward compatibility with CBLAS_ double cblas_dcabs1(const void *z); float cblas_scabs1(const void *c); -float cblas_sdsdot(const int N, const float alpha, const float *X, - const int incX, const float *Y, const int incY); -double cblas_dsdot(const int N, const float *X, const int incX, const float *Y, - const int incY); -float cblas_sdot(const int N, const float *X, const int incX, - const float *Y, const int incY); -double cblas_ddot(const int N, const double *X, const int incX, - const double *Y, const int incY); +float cblas_sdsdot(const CBLAS_INT N, const float alpha, const float *X, + const CBLAS_INT incX, const float *Y, const CBLAS_INT incY); +double cblas_dsdot(const CBLAS_INT N, const float *X, const CBLAS_INT incX, const float *Y, + const CBLAS_INT incY); +float cblas_sdot(const CBLAS_INT N, const float *X, const CBLAS_INT incX, + const float *Y, const CBLAS_INT incY); +double cblas_ddot(const CBLAS_INT N, const double *X, const CBLAS_INT incX, + const double *Y, const CBLAS_INT incY); /* * Functions having prefixes Z and C only */ -void cblas_cdotu_sub(const int N, const void *X, const int incX, - const void *Y, const int incY, void *dotu); -void cblas_cdotc_sub(const int N, const void *X, const int incX, - const void *Y, const int incY, void *dotc); +void cblas_cdotu_sub(const CBLAS_INT N, const void *X, const CBLAS_INT incX, + const void *Y, const CBLAS_INT incY, void *dotu); +void cblas_cdotc_sub(const CBLAS_INT N, const void *X, const CBLAS_INT incX, + const void *Y, const CBLAS_INT incY, void *dotc); -void cblas_zdotu_sub(const int N, const void *X, const int incX, - const void *Y, const int incY, void *dotu); -void cblas_zdotc_sub(const int N, const void *X, const int incX, - const void *Y, const int incY, void *dotc); +void cblas_zdotu_sub(const CBLAS_INT N, const void *X, const CBLAS_INT incX, + const void *Y, const CBLAS_INT incY, void *dotu); +void cblas_zdotc_sub(const CBLAS_INT N, const void *X, const CBLAS_INT incX, + const void *Y, const CBLAS_INT incY, void *dotc); /* * Functions having prefixes S D SC DZ */ -float cblas_snrm2(const int N, const float *X, const int incX); -float cblas_sasum(const int N, const float *X, const int incX); +float cblas_snrm2(const CBLAS_INT N, const float *X, const CBLAS_INT incX); +float cblas_sasum(const CBLAS_INT N, const float *X, const CBLAS_INT incX); -double cblas_dnrm2(const int N, const double *X, const int incX); -double cblas_dasum(const int N, const double *X, const int incX); +double cblas_dnrm2(const CBLAS_INT N, const double *X, const CBLAS_INT incX); +double cblas_dasum(const CBLAS_INT N, const double *X, const CBLAS_INT incX); -float cblas_scnrm2(const int N, const void *X, const int incX); -float cblas_scasum(const int N, const void *X, const int incX); +float cblas_scnrm2(const CBLAS_INT N, const void *X, const CBLAS_INT incX); +float cblas_scasum(const CBLAS_INT N, const void *X, const CBLAS_INT incX); -double cblas_dznrm2(const int N, const void *X, const int incX); -double cblas_dzasum(const int N, const void *X, const int incX); +double cblas_dznrm2(const CBLAS_INT N, const void *X, const CBLAS_INT incX); +double cblas_dzasum(const CBLAS_INT N, const void *X, const CBLAS_INT incX); /* * Functions having standard 4 prefixes (S D C Z) */ -CBLAS_INDEX cblas_isamax(const int N, const float *X, const int incX); -CBLAS_INDEX cblas_idamax(const int N, const double *X, const int incX); -CBLAS_INDEX cblas_icamax(const int N, const void *X, const int incX); -CBLAS_INDEX cblas_izamax(const int N, const void *X, const int incX); +CBLAS_INDEX cblas_isamax(const CBLAS_INT N, const float *X, const CBLAS_INT incX); +CBLAS_INDEX cblas_idamax(const CBLAS_INT N, const double *X, const CBLAS_INT incX); +CBLAS_INDEX cblas_icamax(const CBLAS_INT N, const void *X, const CBLAS_INT incX); +CBLAS_INDEX cblas_izamax(const CBLAS_INT N, const void *X, const CBLAS_INT incX); /* * =========================================================================== @@ -91,62 +137,78 @@ CBLAS_INDEX cblas_izamax(const int N, const void *X, const int incX); /* * Routines with standard 4 prefixes (s, d, c, z) */ -void cblas_sswap(const int N, float *X, const int incX, - float *Y, const int incY); -void cblas_scopy(const int N, const float *X, const int incX, - float *Y, const int incY); -void cblas_saxpy(const int N, const float alpha, const float *X, - const int incX, float *Y, const int incY); - -void cblas_dswap(const int N, double *X, const int incX, - double *Y, const int incY); -void cblas_dcopy(const int N, const double *X, const int incX, - double *Y, const int incY); -void cblas_daxpy(const int N, const double alpha, const double *X, - const int incX, double *Y, const int incY); - -void cblas_cswap(const int N, void *X, const int incX, - void *Y, const int incY); -void cblas_ccopy(const int N, const void *X, const int incX, - void *Y, const int incY); -void cblas_caxpy(const int N, const void *alpha, const void *X, - const int incX, void *Y, const int incY); - -void cblas_zswap(const int N, void *X, const int incX, - void *Y, const int incY); -void cblas_zcopy(const int N, const void *X, const int incX, - void *Y, const int incY); -void cblas_zaxpy(const int N, const void *alpha, const void *X, - const int incX, void *Y, const int incY); +void cblas_sswap(const CBLAS_INT N, float *X, const CBLAS_INT incX, + float *Y, const CBLAS_INT incY); +void cblas_scopy(const CBLAS_INT N, const float *X, const CBLAS_INT incX, + float *Y, const CBLAS_INT incY); +void cblas_saxpy(const CBLAS_INT N, const float alpha, const float *X, + const CBLAS_INT incX, float *Y, const CBLAS_INT incY); +void cblas_saxpby(const CBLAS_INT N, const float alpha, const float *X, + const CBLAS_INT incX, const float beta, float *Y, const CBLAS_INT incY); + +void cblas_dswap(const CBLAS_INT N, double *X, const CBLAS_INT incX, + double *Y, const CBLAS_INT incY); +void cblas_dcopy(const CBLAS_INT N, const double *X, const CBLAS_INT incX, + double *Y, const CBLAS_INT incY); +void cblas_daxpy(const CBLAS_INT N, const double alpha, const double *X, + const CBLAS_INT incX, double *Y, const CBLAS_INT incY); +void cblas_daxpby(const CBLAS_INT N, const double alpha, const double *X, + const CBLAS_INT incX, const double beta, double *Y, const CBLAS_INT incY); + +void cblas_cswap(const CBLAS_INT N, void *X, const CBLAS_INT incX, + void *Y, const CBLAS_INT incY); +void cblas_ccopy(const CBLAS_INT N, const void *X, const CBLAS_INT incX, + void *Y, const CBLAS_INT incY); +void cblas_caxpy(const CBLAS_INT N, const void *alpha, const void *X, + const CBLAS_INT incX, void *Y, const CBLAS_INT incY); +void cblas_caxpby(const CBLAS_INT N, const void *alpha, const void *X, + const CBLAS_INT incX, const void *beta, void *Y, const CBLAS_INT incY); + +void cblas_zswap(const CBLAS_INT N, void *X, const CBLAS_INT incX, + void *Y, const CBLAS_INT incY); +void cblas_zcopy(const CBLAS_INT N, const void *X, const CBLAS_INT incX, + void *Y, const CBLAS_INT incY); +void cblas_zaxpy(const CBLAS_INT N, const void *alpha, const void *X, + const CBLAS_INT incX, void *Y, const CBLAS_INT incY); +void cblas_zaxpby(const CBLAS_INT N, const void *alpha, const void *X, + const CBLAS_INT incX, const void *beta, void *Y, const CBLAS_INT incY); /* * Routines with S and D prefix only */ -void cblas_srotg(float *a, float *b, float *c, float *s); void cblas_srotmg(float *d1, float *d2, float *b1, const float b2, float *P); -void cblas_srot(const int N, float *X, const int incX, - float *Y, const int incY, const float c, const float s); -void cblas_srotm(const int N, float *X, const int incX, - float *Y, const int incY, const float *P); - -void cblas_drotg(double *a, double *b, double *c, double *s); +void cblas_srotm(const CBLAS_INT N, float *X, const CBLAS_INT incX, + float *Y, const CBLAS_INT incY, const float *P); void cblas_drotmg(double *d1, double *d2, double *b1, const double b2, double *P); -void cblas_drot(const int N, double *X, const int incX, - double *Y, const int incY, const double c, const double s); -void cblas_drotm(const int N, double *X, const int incX, - double *Y, const int incY, const double *P); +void cblas_drotm(const CBLAS_INT N, double *X, const CBLAS_INT incX, + double *Y, const CBLAS_INT incY, const double *P); + /* * Routines with S D C Z CS and ZD prefixes */ -void cblas_sscal(const int N, const float alpha, float *X, const int incX); -void cblas_dscal(const int N, const double alpha, double *X, const int incX); -void cblas_cscal(const int N, const void *alpha, void *X, const int incX); -void cblas_zscal(const int N, const void *alpha, void *X, const int incX); -void cblas_csscal(const int N, const float alpha, void *X, const int incX); -void cblas_zdscal(const int N, const double alpha, void *X, const int incX); +void cblas_sscal(const CBLAS_INT N, const float alpha, float *X, const CBLAS_INT incX); +void cblas_dscal(const CBLAS_INT N, const double alpha, double *X, const CBLAS_INT incX); +void cblas_cscal(const CBLAS_INT N, const void *alpha, void *X, const CBLAS_INT incX); +void cblas_zscal(const CBLAS_INT N, const void *alpha, void *X, const CBLAS_INT incX); +void cblas_csscal(const CBLAS_INT N, const float alpha, void *X, const CBLAS_INT incX); +void cblas_zdscal(const CBLAS_INT N, const double alpha, void *X, const CBLAS_INT incX); + +void cblas_srotg(float *a, float *b, float *c, float *s); +void cblas_drotg(double *a, double *b, double *c, double *s); +void cblas_crotg(void *a, void *b, float *c, void *s); +void cblas_zrotg(void *a, void *b, double *c, void *s); + +void cblas_srot(const CBLAS_INT N, float *X, const CBLAS_INT incX, + float *Y, const CBLAS_INT incY, const float c, const float s); +void cblas_drot(const CBLAS_INT N, double *X, const CBLAS_INT incX, + double *Y, const CBLAS_INT incY, const double c, const double s); +void cblas_csrot(const CBLAS_INT N, void *X, const CBLAS_INT incX, + void *Y, const CBLAS_INT incY, const float c, const float s); +void cblas_zdrot(const CBLAS_INT N, void *X, const CBLAS_INT incX, + void *Y, const CBLAS_INT incY, const double c, const double s); /* * =========================================================================== @@ -158,264 +220,280 @@ void cblas_zdscal(const int N, const double alpha, void *X, const int incX); * Routines with standard 4 prefixes (S, D, C, Z) */ void cblas_sgemv(const CBLAS_LAYOUT layout, - const CBLAS_TRANSPOSE TransA, const int M, const int N, - const float alpha, const float *A, const int lda, - const float *X, const int incX, const float beta, - float *Y, const int incY); + const CBLAS_TRANSPOSE TransA, const CBLAS_INT M, const CBLAS_INT N, + const float alpha, const float *A, const CBLAS_INT lda, + const float *X, const CBLAS_INT incX, const float beta, + float *Y, const CBLAS_INT incY); void cblas_sgbmv(CBLAS_LAYOUT layout, - CBLAS_TRANSPOSE TransA, const int M, const int N, - const int KL, const int KU, const float alpha, - const float *A, const int lda, const float *X, - const int incX, const float beta, float *Y, const int incY); + CBLAS_TRANSPOSE TransA, const CBLAS_INT M, const CBLAS_INT N, + const CBLAS_INT KL, const CBLAS_INT KU, const float alpha, + const float *A, const CBLAS_INT lda, const float *X, + const CBLAS_INT incX, const float beta, float *Y, const CBLAS_INT incY); void cblas_strmv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, - const int N, const float *A, const int lda, - float *X, const int incX); + const CBLAS_INT N, const float *A, const CBLAS_INT lda, + float *X, const CBLAS_INT incX); void cblas_stbmv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, - const int N, const int K, const float *A, const int lda, - float *X, const int incX); + const CBLAS_INT N, const CBLAS_INT K, const float *A, const CBLAS_INT lda, + float *X, const CBLAS_INT incX); void cblas_stpmv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, - const int N, const float *Ap, float *X, const int incX); + const CBLAS_INT N, const float *Ap, float *X, const CBLAS_INT incX); void cblas_strsv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, - const int N, const float *A, const int lda, float *X, - const int incX); + const CBLAS_INT N, const float *A, const CBLAS_INT lda, float *X, + const CBLAS_INT incX); void cblas_stbsv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, - const int N, const int K, const float *A, const int lda, - float *X, const int incX); + const CBLAS_INT N, const CBLAS_INT K, const float *A, const CBLAS_INT lda, + float *X, const CBLAS_INT incX); void cblas_stpsv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, - const int N, const float *Ap, float *X, const int incX); + const CBLAS_INT N, const float *Ap, float *X, const CBLAS_INT incX); void cblas_dgemv(CBLAS_LAYOUT layout, - CBLAS_TRANSPOSE TransA, const int M, const int N, - const double alpha, const double *A, const int lda, - const double *X, const int incX, const double beta, - double *Y, const int incY); + CBLAS_TRANSPOSE TransA, const CBLAS_INT M, const CBLAS_INT N, + const double alpha, const double *A, const CBLAS_INT lda, + const double *X, const CBLAS_INT incX, const double beta, + double *Y, const CBLAS_INT incY); void cblas_dgbmv(CBLAS_LAYOUT layout, - CBLAS_TRANSPOSE TransA, const int M, const int N, - const int KL, const int KU, const double alpha, - const double *A, const int lda, const double *X, - const int incX, const double beta, double *Y, const int incY); + CBLAS_TRANSPOSE TransA, const CBLAS_INT M, const CBLAS_INT N, + const CBLAS_INT KL, const CBLAS_INT KU, const double alpha, + const double *A, const CBLAS_INT lda, const double *X, + const CBLAS_INT incX, const double beta, double *Y, const CBLAS_INT incY); void cblas_dtrmv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, - const int N, const double *A, const int lda, - double *X, const int incX); + const CBLAS_INT N, const double *A, const CBLAS_INT lda, + double *X, const CBLAS_INT incX); void cblas_dtbmv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, - const int N, const int K, const double *A, const int lda, - double *X, const int incX); + const CBLAS_INT N, const CBLAS_INT K, const double *A, const CBLAS_INT lda, + double *X, const CBLAS_INT incX); void cblas_dtpmv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, - const int N, const double *Ap, double *X, const int incX); + const CBLAS_INT N, const double *Ap, double *X, const CBLAS_INT incX); void cblas_dtrsv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, - const int N, const double *A, const int lda, double *X, - const int incX); + const CBLAS_INT N, const double *A, const CBLAS_INT lda, double *X, + const CBLAS_INT incX); void cblas_dtbsv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, - const int N, const int K, const double *A, const int lda, - double *X, const int incX); + const CBLAS_INT N, const CBLAS_INT K, const double *A, const CBLAS_INT lda, + double *X, const CBLAS_INT incX); void cblas_dtpsv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, - const int N, const double *Ap, double *X, const int incX); + const CBLAS_INT N, const double *Ap, double *X, const CBLAS_INT incX); void cblas_cgemv(CBLAS_LAYOUT layout, - CBLAS_TRANSPOSE TransA, const int M, const int N, - const void *alpha, const void *A, const int lda, - const void *X, const int incX, const void *beta, - void *Y, const int incY); + CBLAS_TRANSPOSE TransA, const CBLAS_INT M, const CBLAS_INT N, + const void *alpha, const void *A, const CBLAS_INT lda, + const void *X, const CBLAS_INT incX, const void *beta, + void *Y, const CBLAS_INT incY); void cblas_cgbmv(CBLAS_LAYOUT layout, - CBLAS_TRANSPOSE TransA, const int M, const int N, - const int KL, const int KU, const void *alpha, - const void *A, const int lda, const void *X, - const int incX, const void *beta, void *Y, const int incY); + CBLAS_TRANSPOSE TransA, const CBLAS_INT M, const CBLAS_INT N, + const CBLAS_INT KL, const CBLAS_INT KU, const void *alpha, + const void *A, const CBLAS_INT lda, const void *X, + const CBLAS_INT incX, const void *beta, void *Y, const CBLAS_INT incY); void cblas_ctrmv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, - const int N, const void *A, const int lda, - void *X, const int incX); + const CBLAS_INT N, const void *A, const CBLAS_INT lda, + void *X, const CBLAS_INT incX); void cblas_ctbmv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, - const int N, const int K, const void *A, const int lda, - void *X, const int incX); + const CBLAS_INT N, const CBLAS_INT K, const void *A, const CBLAS_INT lda, + void *X, const CBLAS_INT incX); void cblas_ctpmv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, - const int N, const void *Ap, void *X, const int incX); + const CBLAS_INT N, const void *Ap, void *X, const CBLAS_INT incX); void cblas_ctrsv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, - const int N, const void *A, const int lda, void *X, - const int incX); + const CBLAS_INT N, const void *A, const CBLAS_INT lda, void *X, + const CBLAS_INT incX); void cblas_ctbsv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, - const int N, const int K, const void *A, const int lda, - void *X, const int incX); + const CBLAS_INT N, const CBLAS_INT K, const void *A, const CBLAS_INT lda, + void *X, const CBLAS_INT incX); void cblas_ctpsv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, - const int N, const void *Ap, void *X, const int incX); + const CBLAS_INT N, const void *Ap, void *X, const CBLAS_INT incX); void cblas_zgemv(CBLAS_LAYOUT layout, - CBLAS_TRANSPOSE TransA, const int M, const int N, - const void *alpha, const void *A, const int lda, - const void *X, const int incX, const void *beta, - void *Y, const int incY); + CBLAS_TRANSPOSE TransA, const CBLAS_INT M, const CBLAS_INT N, + const void *alpha, const void *A, const CBLAS_INT lda, + const void *X, const CBLAS_INT incX, const void *beta, + void *Y, const CBLAS_INT incY); void cblas_zgbmv(CBLAS_LAYOUT layout, - CBLAS_TRANSPOSE TransA, const int M, const int N, - const int KL, const int KU, const void *alpha, - const void *A, const int lda, const void *X, - const int incX, const void *beta, void *Y, const int incY); + CBLAS_TRANSPOSE TransA, const CBLAS_INT M, const CBLAS_INT N, + const CBLAS_INT KL, const CBLAS_INT KU, const void *alpha, + const void *A, const CBLAS_INT lda, const void *X, + const CBLAS_INT incX, const void *beta, void *Y, const CBLAS_INT incY); void cblas_ztrmv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, - const int N, const void *A, const int lda, - void *X, const int incX); + const CBLAS_INT N, const void *A, const CBLAS_INT lda, + void *X, const CBLAS_INT incX); void cblas_ztbmv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, - const int N, const int K, const void *A, const int lda, - void *X, const int incX); + const CBLAS_INT N, const CBLAS_INT K, const void *A, const CBLAS_INT lda, + void *X, const CBLAS_INT incX); void cblas_ztpmv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, - const int N, const void *Ap, void *X, const int incX); + const CBLAS_INT N, const void *Ap, void *X, const CBLAS_INT incX); void cblas_ztrsv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, - const int N, const void *A, const int lda, void *X, - const int incX); + const CBLAS_INT N, const void *A, const CBLAS_INT lda, void *X, + const CBLAS_INT incX); void cblas_ztbsv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, - const int N, const int K, const void *A, const int lda, - void *X, const int incX); + const CBLAS_INT N, const CBLAS_INT K, const void *A, const CBLAS_INT lda, + void *X, const CBLAS_INT incX); void cblas_ztpsv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, - const int N, const void *Ap, void *X, const int incX); + const CBLAS_INT N, const void *Ap, void *X, const CBLAS_INT incX); /* * Routines with S and D prefixes only */ void cblas_ssymv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - const int N, const float alpha, const float *A, - const int lda, const float *X, const int incX, - const float beta, float *Y, const int incY); + const CBLAS_INT N, const float alpha, const float *A, + const CBLAS_INT lda, const float *X, const CBLAS_INT incX, + const float beta, float *Y, const CBLAS_INT incY); void cblas_ssbmv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - const int N, const int K, const float alpha, const float *A, - const int lda, const float *X, const int incX, - const float beta, float *Y, const int incY); + const CBLAS_INT N, const CBLAS_INT K, const float alpha, const float *A, + const CBLAS_INT lda, const float *X, const CBLAS_INT incX, + const float beta, float *Y, const CBLAS_INT incY); void cblas_sspmv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - const int N, const float alpha, const float *Ap, - const float *X, const int incX, - const float beta, float *Y, const int incY); -void cblas_sger(CBLAS_LAYOUT layout, const int M, const int N, - const float alpha, const float *X, const int incX, - const float *Y, const int incY, float *A, const int lda); + const CBLAS_INT N, const float alpha, const float *Ap, + const float *X, const CBLAS_INT incX, + const float beta, float *Y, const CBLAS_INT incY); +void cblas_sskewsymv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + const CBLAS_INT N, const float alpha, const float *A, + const CBLAS_INT lda, const float *X, const CBLAS_INT incX, + const float beta, float *Y, const CBLAS_INT incY); +void cblas_sger(CBLAS_LAYOUT layout, const CBLAS_INT M, const CBLAS_INT N, + const float alpha, const float *X, const CBLAS_INT incX, + const float *Y, const CBLAS_INT incY, float *A, const CBLAS_INT lda); void cblas_ssyr(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - const int N, const float alpha, const float *X, - const int incX, float *A, const int lda); + const CBLAS_INT N, const float alpha, const float *X, + const CBLAS_INT incX, float *A, const CBLAS_INT lda); void cblas_sspr(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - const int N, const float alpha, const float *X, - const int incX, float *Ap); + const CBLAS_INT N, const float alpha, const float *X, + const CBLAS_INT incX, float *Ap); void cblas_ssyr2(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - const int N, const float alpha, const float *X, - const int incX, const float *Y, const int incY, float *A, - const int lda); + const CBLAS_INT N, const float alpha, const float *X, + const CBLAS_INT incX, const float *Y, const CBLAS_INT incY, float *A, + const CBLAS_INT lda); void cblas_sspr2(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - const int N, const float alpha, const float *X, - const int incX, const float *Y, const int incY, float *A); + const CBLAS_INT N, const float alpha, const float *X, + const CBLAS_INT incX, const float *Y, const CBLAS_INT incY, float *A); +void cblas_sskewsyr2(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + const CBLAS_INT N, const float alpha, const float *X, + const CBLAS_INT incX, const float *Y, const CBLAS_INT incY, float *A, + const CBLAS_INT lda); void cblas_dsymv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - const int N, const double alpha, const double *A, - const int lda, const double *X, const int incX, - const double beta, double *Y, const int incY); + const CBLAS_INT N, const double alpha, const double *A, + const CBLAS_INT lda, const double *X, const CBLAS_INT incX, + const double beta, double *Y, const CBLAS_INT incY); void cblas_dsbmv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - const int N, const int K, const double alpha, const double *A, - const int lda, const double *X, const int incX, - const double beta, double *Y, const int incY); + const CBLAS_INT N, const CBLAS_INT K, const double alpha, const double *A, + const CBLAS_INT lda, const double *X, const CBLAS_INT incX, + const double beta, double *Y, const CBLAS_INT incY); void cblas_dspmv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - const int N, const double alpha, const double *Ap, - const double *X, const int incX, - const double beta, double *Y, const int incY); -void cblas_dger(CBLAS_LAYOUT layout, const int M, const int N, - const double alpha, const double *X, const int incX, - const double *Y, const int incY, double *A, const int lda); + const CBLAS_INT N, const double alpha, const double *Ap, + const double *X, const CBLAS_INT incX, + const double beta, double *Y, const CBLAS_INT incY); +void cblas_dskewsymv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + const CBLAS_INT N, const double alpha, const double *A, + const CBLAS_INT lda, const double *X, const CBLAS_INT incX, + const double beta, double *Y, const CBLAS_INT incY); +void cblas_dger(CBLAS_LAYOUT layout, const CBLAS_INT M, const CBLAS_INT N, + const double alpha, const double *X, const CBLAS_INT incX, + const double *Y, const CBLAS_INT incY, double *A, const CBLAS_INT lda); void cblas_dsyr(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - const int N, const double alpha, const double *X, - const int incX, double *A, const int lda); + const CBLAS_INT N, const double alpha, const double *X, + const CBLAS_INT incX, double *A, const CBLAS_INT lda); void cblas_dspr(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - const int N, const double alpha, const double *X, - const int incX, double *Ap); + const CBLAS_INT N, const double alpha, const double *X, + const CBLAS_INT incX, double *Ap); void cblas_dsyr2(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - const int N, const double alpha, const double *X, - const int incX, const double *Y, const int incY, double *A, - const int lda); + const CBLAS_INT N, const double alpha, const double *X, + const CBLAS_INT incX, const double *Y, const CBLAS_INT incY, double *A, + const CBLAS_INT lda); void cblas_dspr2(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - const int N, const double alpha, const double *X, - const int incX, const double *Y, const int incY, double *A); + const CBLAS_INT N, const double alpha, const double *X, + const CBLAS_INT incX, const double *Y, const CBLAS_INT incY, double *A); +void cblas_dskewsyr2(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + const CBLAS_INT N, const double alpha, const double *X, + const CBLAS_INT incX, const double *Y, const CBLAS_INT incY, double *A, + const CBLAS_INT lda); /* * Routines with C and Z prefixes only */ void cblas_chemv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - const int N, const void *alpha, const void *A, - const int lda, const void *X, const int incX, - const void *beta, void *Y, const int incY); + const CBLAS_INT N, const void *alpha, const void *A, + const CBLAS_INT lda, const void *X, const CBLAS_INT incX, + const void *beta, void *Y, const CBLAS_INT incY); void cblas_chbmv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - const int N, const int K, const void *alpha, const void *A, - const int lda, const void *X, const int incX, - const void *beta, void *Y, const int incY); + const CBLAS_INT N, const CBLAS_INT K, const void *alpha, const void *A, + const CBLAS_INT lda, const void *X, const CBLAS_INT incX, + const void *beta, void *Y, const CBLAS_INT incY); void cblas_chpmv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - const int N, const void *alpha, const void *Ap, - const void *X, const int incX, - const void *beta, void *Y, const int incY); -void cblas_cgeru(CBLAS_LAYOUT layout, const int M, const int N, - const void *alpha, const void *X, const int incX, - const void *Y, const int incY, void *A, const int lda); -void cblas_cgerc(CBLAS_LAYOUT layout, const int M, const int N, - const void *alpha, const void *X, const int incX, - const void *Y, const int incY, void *A, const int lda); + const CBLAS_INT N, const void *alpha, const void *Ap, + const void *X, const CBLAS_INT incX, + const void *beta, void *Y, const CBLAS_INT incY); +void cblas_cgeru(CBLAS_LAYOUT layout, const CBLAS_INT M, const CBLAS_INT N, + const void *alpha, const void *X, const CBLAS_INT incX, + const void *Y, const CBLAS_INT incY, void *A, const CBLAS_INT lda); +void cblas_cgerc(CBLAS_LAYOUT layout, const CBLAS_INT M, const CBLAS_INT N, + const void *alpha, const void *X, const CBLAS_INT incX, + const void *Y, const CBLAS_INT incY, void *A, const CBLAS_INT lda); void cblas_cher(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - const int N, const float alpha, const void *X, const int incX, - void *A, const int lda); + const CBLAS_INT N, const float alpha, const void *X, const CBLAS_INT incX, + void *A, const CBLAS_INT lda); void cblas_chpr(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - const int N, const float alpha, const void *X, - const int incX, void *A); -void cblas_cher2(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const int N, - const void *alpha, const void *X, const int incX, - const void *Y, const int incY, void *A, const int lda); -void cblas_chpr2(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const int N, - const void *alpha, const void *X, const int incX, - const void *Y, const int incY, void *Ap); + const CBLAS_INT N, const float alpha, const void *X, + const CBLAS_INT incX, void *A); +void cblas_cher2(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const CBLAS_INT N, + const void *alpha, const void *X, const CBLAS_INT incX, + const void *Y, const CBLAS_INT incY, void *A, const CBLAS_INT lda); +void cblas_chpr2(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const CBLAS_INT N, + const void *alpha, const void *X, const CBLAS_INT incX, + const void *Y, const CBLAS_INT incY, void *Ap); void cblas_zhemv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - const int N, const void *alpha, const void *A, - const int lda, const void *X, const int incX, - const void *beta, void *Y, const int incY); + const CBLAS_INT N, const void *alpha, const void *A, + const CBLAS_INT lda, const void *X, const CBLAS_INT incX, + const void *beta, void *Y, const CBLAS_INT incY); void cblas_zhbmv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - const int N, const int K, const void *alpha, const void *A, - const int lda, const void *X, const int incX, - const void *beta, void *Y, const int incY); + const CBLAS_INT N, const CBLAS_INT K, const void *alpha, const void *A, + const CBLAS_INT lda, const void *X, const CBLAS_INT incX, + const void *beta, void *Y, const CBLAS_INT incY); void cblas_zhpmv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - const int N, const void *alpha, const void *Ap, - const void *X, const int incX, - const void *beta, void *Y, const int incY); -void cblas_zgeru(CBLAS_LAYOUT layout, const int M, const int N, - const void *alpha, const void *X, const int incX, - const void *Y, const int incY, void *A, const int lda); -void cblas_zgerc(CBLAS_LAYOUT layout, const int M, const int N, - const void *alpha, const void *X, const int incX, - const void *Y, const int incY, void *A, const int lda); + const CBLAS_INT N, const void *alpha, const void *Ap, + const void *X, const CBLAS_INT incX, + const void *beta, void *Y, const CBLAS_INT incY); +void cblas_zgeru(CBLAS_LAYOUT layout, const CBLAS_INT M, const CBLAS_INT N, + const void *alpha, const void *X, const CBLAS_INT incX, + const void *Y, const CBLAS_INT incY, void *A, const CBLAS_INT lda); +void cblas_zgerc(CBLAS_LAYOUT layout, const CBLAS_INT M, const CBLAS_INT N, + const void *alpha, const void *X, const CBLAS_INT incX, + const void *Y, const CBLAS_INT incY, void *A, const CBLAS_INT lda); void cblas_zher(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - const int N, const double alpha, const void *X, const int incX, - void *A, const int lda); + const CBLAS_INT N, const double alpha, const void *X, const CBLAS_INT incX, + void *A, const CBLAS_INT lda); void cblas_zhpr(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - const int N, const double alpha, const void *X, - const int incX, void *A); -void cblas_zher2(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const int N, - const void *alpha, const void *X, const int incX, - const void *Y, const int incY, void *A, const int lda); -void cblas_zhpr2(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const int N, - const void *alpha, const void *X, const int incX, - const void *Y, const int incY, void *Ap); + const CBLAS_INT N, const double alpha, const void *X, + const CBLAS_INT incX, void *A); +void cblas_zher2(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const CBLAS_INT N, + const void *alpha, const void *X, const CBLAS_INT incX, + const void *Y, const CBLAS_INT incY, void *A, const CBLAS_INT lda); +void cblas_zhpr2(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const CBLAS_INT N, + const void *alpha, const void *X, const CBLAS_INT incX, + const void *Y, const CBLAS_INT incY, void *Ap); /* * =========================================================================== @@ -427,160 +505,202 @@ void cblas_zhpr2(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const int N, * Routines with standard 4 prefixes (S, D, C, Z) */ void cblas_sgemm(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA, - CBLAS_TRANSPOSE TransB, const int M, const int N, - const int K, const float alpha, const float *A, - const int lda, const float *B, const int ldb, - const float beta, float *C, const int ldc); + CBLAS_TRANSPOSE TransB, const CBLAS_INT M, const CBLAS_INT N, + const CBLAS_INT K, const float alpha, const float *A, + const CBLAS_INT lda, const float *B, const CBLAS_INT ldb, + const float beta, float *C, const CBLAS_INT ldc); +void cblas_sgemmtr(CBLAS_LAYOUT layout,CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, + CBLAS_TRANSPOSE TransB, const CBLAS_INT N, + const CBLAS_INT K, const float alpha, const float *A, + const CBLAS_INT lda, const float *B, const CBLAS_INT ldb, + const float beta, float *C, const CBLAS_INT ldc); + void cblas_ssymm(CBLAS_LAYOUT layout, CBLAS_SIDE Side, - CBLAS_UPLO Uplo, const int M, const int N, - const float alpha, const float *A, const int lda, - const float *B, const int ldb, const float beta, - float *C, const int ldc); + CBLAS_UPLO Uplo, const CBLAS_INT M, const CBLAS_INT N, + const float alpha, const float *A, const CBLAS_INT lda, + const float *B, const CBLAS_INT ldb, const float beta, + float *C, const CBLAS_INT ldc); +void cblas_sskewsymm(CBLAS_LAYOUT layout, CBLAS_SIDE Side, + CBLAS_UPLO Uplo, const CBLAS_INT M, const CBLAS_INT N, + const float alpha, const float *A, const CBLAS_INT lda, + const float *B, const CBLAS_INT ldb, const float beta, + float *C, const CBLAS_INT ldc); void cblas_ssyrk(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - CBLAS_TRANSPOSE Trans, const int N, const int K, - const float alpha, const float *A, const int lda, - const float beta, float *C, const int ldc); + CBLAS_TRANSPOSE Trans, const CBLAS_INT N, const CBLAS_INT K, + const float alpha, const float *A, const CBLAS_INT lda, + const float beta, float *C, const CBLAS_INT ldc); void cblas_ssyr2k(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - CBLAS_TRANSPOSE Trans, const int N, const int K, - const float alpha, const float *A, const int lda, - const float *B, const int ldb, const float beta, - float *C, const int ldc); + CBLAS_TRANSPOSE Trans, const CBLAS_INT N, const CBLAS_INT K, + const float alpha, const float *A, const CBLAS_INT lda, + const float *B, const CBLAS_INT ldb, const float beta, + float *C, const CBLAS_INT ldc); +void cblas_sskewsyr2k(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE Trans, const CBLAS_INT N, const CBLAS_INT K, + const float alpha, const float *A, const CBLAS_INT lda, + const float *B, const CBLAS_INT ldb, const float beta, + float *C, const CBLAS_INT ldc); void cblas_strmm(CBLAS_LAYOUT layout, CBLAS_SIDE Side, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, - CBLAS_DIAG Diag, const int M, const int N, - const float alpha, const float *A, const int lda, - float *B, const int ldb); + CBLAS_DIAG Diag, const CBLAS_INT M, const CBLAS_INT N, + const float alpha, const float *A, const CBLAS_INT lda, + float *B, const CBLAS_INT ldb); void cblas_strsm(CBLAS_LAYOUT layout, CBLAS_SIDE Side, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, - CBLAS_DIAG Diag, const int M, const int N, - const float alpha, const float *A, const int lda, - float *B, const int ldb); + CBLAS_DIAG Diag, const CBLAS_INT M, const CBLAS_INT N, + const float alpha, const float *A, const CBLAS_INT lda, + float *B, const CBLAS_INT ldb); void cblas_dgemm(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA, - CBLAS_TRANSPOSE TransB, const int M, const int N, - const int K, const double alpha, const double *A, - const int lda, const double *B, const int ldb, - const double beta, double *C, const int ldc); + CBLAS_TRANSPOSE TransB, const CBLAS_INT M, const CBLAS_INT N, + const CBLAS_INT K, const double alpha, const double *A, + const CBLAS_INT lda, const double *B, const CBLAS_INT ldb, + const double beta, double *C, const CBLAS_INT ldc); +void cblas_dgemmtr(CBLAS_LAYOUT layout,CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, + CBLAS_TRANSPOSE TransB, const CBLAS_INT N, + const CBLAS_INT K, const double alpha, const double *A, + const CBLAS_INT lda, const double *B, const CBLAS_INT ldb, + const double beta, double *C, const CBLAS_INT ldc); void cblas_dsymm(CBLAS_LAYOUT layout, CBLAS_SIDE Side, - CBLAS_UPLO Uplo, const int M, const int N, - const double alpha, const double *A, const int lda, - const double *B, const int ldb, const double beta, - double *C, const int ldc); + CBLAS_UPLO Uplo, const CBLAS_INT M, const CBLAS_INT N, + const double alpha, const double *A, const CBLAS_INT lda, + const double *B, const CBLAS_INT ldb, const double beta, + double *C, const CBLAS_INT ldc); +void cblas_dskewsymm(CBLAS_LAYOUT layout, CBLAS_SIDE Side, + CBLAS_UPLO Uplo, const CBLAS_INT M, const CBLAS_INT N, + const double alpha, const double *A, const CBLAS_INT lda, + const double *B, const CBLAS_INT ldb, const double beta, + double *C, const CBLAS_INT ldc); void cblas_dsyrk(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - CBLAS_TRANSPOSE Trans, const int N, const int K, - const double alpha, const double *A, const int lda, - const double beta, double *C, const int ldc); + CBLAS_TRANSPOSE Trans, const CBLAS_INT N, const CBLAS_INT K, + const double alpha, const double *A, const CBLAS_INT lda, + const double beta, double *C, const CBLAS_INT ldc); void cblas_dsyr2k(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - CBLAS_TRANSPOSE Trans, const int N, const int K, - const double alpha, const double *A, const int lda, - const double *B, const int ldb, const double beta, - double *C, const int ldc); + CBLAS_TRANSPOSE Trans, const CBLAS_INT N, const CBLAS_INT K, + const double alpha, const double *A, const CBLAS_INT lda, + const double *B, const CBLAS_INT ldb, const double beta, + double *C, const CBLAS_INT ldc); +void cblas_dskewsyr2k(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE Trans, const CBLAS_INT N, const CBLAS_INT K, + const double alpha, const double *A, const CBLAS_INT lda, + const double *B, const CBLAS_INT ldb, const double beta, + double *C, const CBLAS_INT ldc); void cblas_dtrmm(CBLAS_LAYOUT layout, CBLAS_SIDE Side, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, - CBLAS_DIAG Diag, const int M, const int N, - const double alpha, const double *A, const int lda, - double *B, const int ldb); + CBLAS_DIAG Diag, const CBLAS_INT M, const CBLAS_INT N, + const double alpha, const double *A, const CBLAS_INT lda, + double *B, const CBLAS_INT ldb); void cblas_dtrsm(CBLAS_LAYOUT layout, CBLAS_SIDE Side, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, - CBLAS_DIAG Diag, const int M, const int N, - const double alpha, const double *A, const int lda, - double *B, const int ldb); + CBLAS_DIAG Diag, const CBLAS_INT M, const CBLAS_INT N, + const double alpha, const double *A, const CBLAS_INT lda, + double *B, const CBLAS_INT ldb); void cblas_cgemm(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA, - CBLAS_TRANSPOSE TransB, const int M, const int N, - const int K, const void *alpha, const void *A, - const int lda, const void *B, const int ldb, - const void *beta, void *C, const int ldc); + CBLAS_TRANSPOSE TransB, const CBLAS_INT M, const CBLAS_INT N, + const CBLAS_INT K, const void *alpha, const void *A, + const CBLAS_INT lda, const void *B, const CBLAS_INT ldb, + const void *beta, void *C, const CBLAS_INT ldc); +void cblas_cgemmtr(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, + CBLAS_TRANSPOSE TransB, const CBLAS_INT N, + const CBLAS_INT K, const void *alpha, const void *A, + const CBLAS_INT lda, const void *B, const CBLAS_INT ldb, + const void *beta, void *C, const CBLAS_INT ldc); void cblas_csymm(CBLAS_LAYOUT layout, CBLAS_SIDE Side, - CBLAS_UPLO Uplo, const int M, const int N, - const void *alpha, const void *A, const int lda, - const void *B, const int ldb, const void *beta, - void *C, const int ldc); + CBLAS_UPLO Uplo, const CBLAS_INT M, const CBLAS_INT N, + const void *alpha, const void *A, const CBLAS_INT lda, + const void *B, const CBLAS_INT ldb, const void *beta, + void *C, const CBLAS_INT ldc); void cblas_csyrk(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - CBLAS_TRANSPOSE Trans, const int N, const int K, - const void *alpha, const void *A, const int lda, - const void *beta, void *C, const int ldc); + CBLAS_TRANSPOSE Trans, const CBLAS_INT N, const CBLAS_INT K, + const void *alpha, const void *A, const CBLAS_INT lda, + const void *beta, void *C, const CBLAS_INT ldc); void cblas_csyr2k(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - CBLAS_TRANSPOSE Trans, const int N, const int K, - const void *alpha, const void *A, const int lda, - const void *B, const int ldb, const void *beta, - void *C, const int ldc); + CBLAS_TRANSPOSE Trans, const CBLAS_INT N, const CBLAS_INT K, + const void *alpha, const void *A, const CBLAS_INT lda, + const void *B, const CBLAS_INT ldb, const void *beta, + void *C, const CBLAS_INT ldc); void cblas_ctrmm(CBLAS_LAYOUT layout, CBLAS_SIDE Side, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, - CBLAS_DIAG Diag, const int M, const int N, - const void *alpha, const void *A, const int lda, - void *B, const int ldb); + CBLAS_DIAG Diag, const CBLAS_INT M, const CBLAS_INT N, + const void *alpha, const void *A, const CBLAS_INT lda, + void *B, const CBLAS_INT ldb); void cblas_ctrsm(CBLAS_LAYOUT layout, CBLAS_SIDE Side, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, - CBLAS_DIAG Diag, const int M, const int N, - const void *alpha, const void *A, const int lda, - void *B, const int ldb); + CBLAS_DIAG Diag, const CBLAS_INT M, const CBLAS_INT N, + const void *alpha, const void *A, const CBLAS_INT lda, + void *B, const CBLAS_INT ldb); void cblas_zgemm(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA, - CBLAS_TRANSPOSE TransB, const int M, const int N, - const int K, const void *alpha, const void *A, - const int lda, const void *B, const int ldb, - const void *beta, void *C, const int ldc); + CBLAS_TRANSPOSE TransB, const CBLAS_INT M, const CBLAS_INT N, + const CBLAS_INT K, const void *alpha, const void *A, + const CBLAS_INT lda, const void *B, const CBLAS_INT ldb, + const void *beta, void *C, const CBLAS_INT ldc); +void cblas_zgemmtr(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, + CBLAS_TRANSPOSE TransB, const CBLAS_INT N, + const CBLAS_INT K, const void *alpha, const void *A, + const CBLAS_INT lda, const void *B, const CBLAS_INT ldb, + const void *beta, void *C, const CBLAS_INT ldc); void cblas_zsymm(CBLAS_LAYOUT layout, CBLAS_SIDE Side, - CBLAS_UPLO Uplo, const int M, const int N, - const void *alpha, const void *A, const int lda, - const void *B, const int ldb, const void *beta, - void *C, const int ldc); + CBLAS_UPLO Uplo, const CBLAS_INT M, const CBLAS_INT N, + const void *alpha, const void *A, const CBLAS_INT lda, + const void *B, const CBLAS_INT ldb, const void *beta, + void *C, const CBLAS_INT ldc); void cblas_zsyrk(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - CBLAS_TRANSPOSE Trans, const int N, const int K, - const void *alpha, const void *A, const int lda, - const void *beta, void *C, const int ldc); + CBLAS_TRANSPOSE Trans, const CBLAS_INT N, const CBLAS_INT K, + const void *alpha, const void *A, const CBLAS_INT lda, + const void *beta, void *C, const CBLAS_INT ldc); void cblas_zsyr2k(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - CBLAS_TRANSPOSE Trans, const int N, const int K, - const void *alpha, const void *A, const int lda, - const void *B, const int ldb, const void *beta, - void *C, const int ldc); + CBLAS_TRANSPOSE Trans, const CBLAS_INT N, const CBLAS_INT K, + const void *alpha, const void *A, const CBLAS_INT lda, + const void *B, const CBLAS_INT ldb, const void *beta, + void *C, const CBLAS_INT ldc); void cblas_ztrmm(CBLAS_LAYOUT layout, CBLAS_SIDE Side, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, - CBLAS_DIAG Diag, const int M, const int N, - const void *alpha, const void *A, const int lda, - void *B, const int ldb); + CBLAS_DIAG Diag, const CBLAS_INT M, const CBLAS_INT N, + const void *alpha, const void *A, const CBLAS_INT lda, + void *B, const CBLAS_INT ldb); void cblas_ztrsm(CBLAS_LAYOUT layout, CBLAS_SIDE Side, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, - CBLAS_DIAG Diag, const int M, const int N, - const void *alpha, const void *A, const int lda, - void *B, const int ldb); + CBLAS_DIAG Diag, const CBLAS_INT M, const CBLAS_INT N, + const void *alpha, const void *A, const CBLAS_INT lda, + void *B, const CBLAS_INT ldb); /* * Routines with prefixes C and Z only */ void cblas_chemm(CBLAS_LAYOUT layout, CBLAS_SIDE Side, - CBLAS_UPLO Uplo, const int M, const int N, - const void *alpha, const void *A, const int lda, - const void *B, const int ldb, const void *beta, - void *C, const int ldc); + CBLAS_UPLO Uplo, const CBLAS_INT M, const CBLAS_INT N, + const void *alpha, const void *A, const CBLAS_INT lda, + const void *B, const CBLAS_INT ldb, const void *beta, + void *C, const CBLAS_INT ldc); void cblas_cherk(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - CBLAS_TRANSPOSE Trans, const int N, const int K, - const float alpha, const void *A, const int lda, - const float beta, void *C, const int ldc); + CBLAS_TRANSPOSE Trans, const CBLAS_INT N, const CBLAS_INT K, + const float alpha, const void *A, const CBLAS_INT lda, + const float beta, void *C, const CBLAS_INT ldc); void cblas_cher2k(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - CBLAS_TRANSPOSE Trans, const int N, const int K, - const void *alpha, const void *A, const int lda, - const void *B, const int ldb, const float beta, - void *C, const int ldc); + CBLAS_TRANSPOSE Trans, const CBLAS_INT N, const CBLAS_INT K, + const void *alpha, const void *A, const CBLAS_INT lda, + const void *B, const CBLAS_INT ldb, const float beta, + void *C, const CBLAS_INT ldc); void cblas_zhemm(CBLAS_LAYOUT layout, CBLAS_SIDE Side, - CBLAS_UPLO Uplo, const int M, const int N, - const void *alpha, const void *A, const int lda, - const void *B, const int ldb, const void *beta, - void *C, const int ldc); + CBLAS_UPLO Uplo, const CBLAS_INT M, const CBLAS_INT N, + const void *alpha, const void *A, const CBLAS_INT lda, + const void *B, const CBLAS_INT ldb, const void *beta, + void *C, const CBLAS_INT ldc); void cblas_zherk(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - CBLAS_TRANSPOSE Trans, const int N, const int K, - const double alpha, const void *A, const int lda, - const double beta, void *C, const int ldc); + CBLAS_TRANSPOSE Trans, const CBLAS_INT N, const CBLAS_INT K, + const double alpha, const void *A, const CBLAS_INT lda, + const double beta, void *C, const CBLAS_INT ldc); void cblas_zher2k(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, - CBLAS_TRANSPOSE Trans, const int N, const int K, - const void *alpha, const void *A, const int lda, - const void *B, const int ldb, const double beta, - void *C, const int ldc); + CBLAS_TRANSPOSE Trans, const CBLAS_INT N, const CBLAS_INT K, + const void *alpha, const void *A, const CBLAS_INT lda, + const void *B, const CBLAS_INT ldb, const double beta, + void *C, const CBLAS_INT ldc); -void cblas_xerbla(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 new file mode 100644 index 0000000000..32009bd2dd --- /dev/null +++ b/CBLAS/include/cblas_64.h @@ -0,0 +1,648 @@ +#ifndef CBLAS_64_H +#define CBLAS_64_H +#include +#include +#include + +#include "cblas.h" + +#ifdef __cplusplus +extern "C" { /* Assume C declarations for C++ */ +#endif /* __cplusplus */ + +/* + * =========================================================================== + * Prototypes for level 1 BLAS functions (complex are recast as routines) + * =========================================================================== + */ + +double cblas_dcabs1_64(const void *z); +float cblas_scabs1_64(const void *c); + +float cblas_sdsdot_64(const int64_t N, const float alpha, const float *X, + const int64_t incX, const float *Y, const int64_t incY); +double cblas_dsdot_64(const int64_t N, const float *X, const int64_t incX, const float *Y, + const int64_t incY); +float cblas_sdot_64(const int64_t N, const float *X, const int64_t incX, + const float *Y, const int64_t incY); +double cblas_ddot_64(const int64_t N, const double *X, const int64_t incX, + const double *Y, const int64_t incY); + +/* + * Functions having prefixes Z and C only + */ +void cblas_cdotu_sub_64(const int64_t N, const void *X, const int64_t incX, + const void *Y, const int64_t incY, void *dotu); +void cblas_cdotc_sub_64(const int64_t N, const void *X, const int64_t incX, + const void *Y, const int64_t incY, void *dotc); + +void cblas_zdotu_sub_64(const int64_t N, const void *X, const int64_t incX, + const void *Y, const int64_t incY, void *dotu); +void cblas_zdotc_sub_64(const int64_t N, const void *X, const int64_t incX, + const void *Y, const int64_t incY, void *dotc); + + +/* + * Functions having prefixes S D SC DZ + */ +float cblas_snrm2_64(const int64_t N, const float *X, const int64_t incX); +float cblas_sasum_64(const int64_t N, const float *X, const int64_t incX); + +double cblas_dnrm2_64(const int64_t N, const double *X, const int64_t incX); +double cblas_dasum_64(const int64_t N, const double *X, const int64_t incX); + +float cblas_scnrm2_64(const int64_t N, const void *X, const int64_t incX); +float cblas_scasum_64(const int64_t N, const void *X, const int64_t incX); + +double cblas_dznrm2_64(const int64_t N, const void *X, const int64_t incX); +double cblas_dzasum_64(const int64_t N, const void *X, const int64_t incX); + + +/* + * Functions having standard 4 prefixes (S D C Z) + */ +CBLAS_INDEX cblas_isamax_64(const int64_t N, const float *X, const int64_t incX); +CBLAS_INDEX cblas_idamax_64(const int64_t N, const double *X, const int64_t incX); +CBLAS_INDEX cblas_icamax_64(const int64_t N, const void *X, const int64_t incX); +CBLAS_INDEX cblas_izamax_64(const int64_t N, const void *X, const int64_t incX); + +/* + * =========================================================================== + * Prototypes for level 1 BLAS routines + * =========================================================================== + */ + +/* + * Routines with standard 4 prefixes (s, d, c, z) + */ +void cblas_sswap_64(const int64_t N, float *X, const int64_t incX, + float *Y, const int64_t incY); +void cblas_scopy_64(const int64_t N, const float *X, const int64_t incX, + float *Y, const int64_t incY); +void cblas_saxpy_64(const int64_t N, const float alpha, const float *X, + const int64_t incX, float *Y, const int64_t incY); +void cblas_saxpby_64(const int64_t N, const float alpha, const float *X, + const int64_t incX, const float beta, float *Y, const int64_t incY); + + +void cblas_dswap_64(const int64_t N, double *X, const int64_t incX, + double *Y, const int64_t incY); +void cblas_dcopy_64(const int64_t N, const double *X, const int64_t incX, + double *Y, const int64_t incY); +void cblas_daxpy_64(const int64_t N, const double alpha, const double *X, + const int64_t incX, double *Y, const int64_t incY); +void cblas_daxpby_64(const int64_t N, const double alpha, const double *X, + const int64_t incX, const double beta, double *Y, const int64_t incY); + +void cblas_cswap_64(const int64_t N, void *X, const int64_t incX, + void *Y, const int64_t incY); +void cblas_ccopy_64(const int64_t N, const void *X, const int64_t incX, + void *Y, const int64_t incY); +void cblas_caxpy_64(const int64_t N, const void *alpha, const void *X, + const int64_t incX, void *Y, const int64_t incY); +void cblas_caxpby_64(const int64_t N, const void *alpha, const void *X, + const int64_t incX, const void *beta, void *Y, const int64_t incY); + +void cblas_zswap_64(const int64_t N, void *X, const int64_t incX, + void *Y, const int64_t incY); +void cblas_zcopy_64(const int64_t N, const void *X, const int64_t incX, + void *Y, const int64_t incY); +void cblas_zaxpy_64(const int64_t N, const void *alpha, const void *X, + const int64_t incX, void *Y, const int64_t incY); +void cblas_zaxpby_64(const int64_t N, const void *alpha, const void *X, + const int64_t incX, const void *beta, void *Y, const int64_t incY); + + +/* + * Routines with S and D prefix only + */ +void cblas_srotmg_64(float *d1, float *d2, float *b1, const float b2, float *P); +void cblas_srotm_64(const int64_t N, float *X, const int64_t incX, + float *Y, const int64_t incY, const float *P); +void cblas_drotmg_64(double *d1, double *d2, double *b1, const double b2, double *P); +void cblas_drotm_64(const int64_t N, double *X, const int64_t incX, + double *Y, const int64_t incY, const double *P); + + + +/* + * Routines with S D C Z CS and ZD prefixes + */ +void cblas_sscal_64(const int64_t N, const float alpha, float *X, const int64_t incX); +void cblas_dscal_64(const int64_t N, const double alpha, double *X, const int64_t incX); +void cblas_cscal_64(const int64_t N, const void *alpha, void *X, const int64_t incX); +void cblas_zscal_64(const int64_t N, const void *alpha, void *X, const int64_t incX); +void cblas_csscal_64(const int64_t N, const float alpha, void *X, const int64_t incX); +void cblas_zdscal_64(const int64_t N, const double alpha, void *X, const int64_t incX); + +void cblas_srotg_64(float *a, float *b, float *c, float *s); +void cblas_drotg_64(double *a, double *b, double *c, double *s); +void cblas_crotg_64(void *a, void *b, float *c, void *s); +void cblas_zrotg_64(void *a, void *b, double *c, void *s); + +void cblas_srot_64(const int64_t N, float *X, const int64_t incX, + float *Y, const int64_t incY, const float c, const float s); +void cblas_drot_64(const int64_t N, double *X, const int64_t incX, + double *Y, const int64_t incY, const double c, const double s); +void cblas_csrot_64(const int64_t N, void *X, const int64_t incX, + void *Y, const int64_t incY, const float c, const float s); +void cblas_zdrot_64(const int64_t N, void *X, const int64_t incX, + void *Y, const int64_t incY, const double c, const double s); + +/* + * =========================================================================== + * Prototypes for level 2 BLAS + * =========================================================================== + */ + +/* + * Routines with standard 4 prefixes (S, D, C, Z) + */ +void cblas_sgemv_64(const CBLAS_LAYOUT layout, + const CBLAS_TRANSPOSE TransA, const int64_t M, const int64_t N, + const float alpha, const float *A, const int64_t lda, + const float *X, const int64_t incX, const float beta, + float *Y, const int64_t incY); +void cblas_sgbmv_64(CBLAS_LAYOUT layout, + CBLAS_TRANSPOSE TransA, const int64_t M, const int64_t N, + const int64_t KL, const int64_t KU, const float alpha, + const float *A, const int64_t lda, const float *X, + const int64_t incX, const float beta, float *Y, const int64_t incY); +void cblas_strmv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + const int64_t N, const float *A, const int64_t lda, + float *X, const int64_t incX); +void cblas_stbmv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + const int64_t N, const int64_t K, const float *A, const int64_t lda, + float *X, const int64_t incX); +void cblas_stpmv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + const int64_t N, const float *Ap, float *X, const int64_t incX); +void cblas_strsv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + const int64_t N, const float *A, const int64_t lda, float *X, + const int64_t incX); +void cblas_stbsv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + const int64_t N, const int64_t K, const float *A, const int64_t lda, + float *X, const int64_t incX); +void cblas_stpsv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + const int64_t N, const float *Ap, float *X, const int64_t incX); + +void cblas_dgemv_64(CBLAS_LAYOUT layout, + CBLAS_TRANSPOSE TransA, const int64_t M, const int64_t N, + const double alpha, const double *A, const int64_t lda, + const double *X, const int64_t incX, const double beta, + double *Y, const int64_t incY); +void cblas_dgbmv_64(CBLAS_LAYOUT layout, + CBLAS_TRANSPOSE TransA, const int64_t M, const int64_t N, + const int64_t KL, const int64_t KU, const double alpha, + const double *A, const int64_t lda, const double *X, + const int64_t incX, const double beta, double *Y, const int64_t incY); +void cblas_dtrmv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + const int64_t N, const double *A, const int64_t lda, + double *X, const int64_t incX); +void cblas_dtbmv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + const int64_t N, const int64_t K, const double *A, const int64_t lda, + double *X, const int64_t incX); +void cblas_dtpmv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + const int64_t N, const double *Ap, double *X, const int64_t incX); +void cblas_dtrsv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + const int64_t N, const double *A, const int64_t lda, double *X, + const int64_t incX); +void cblas_dtbsv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + const int64_t N, const int64_t K, const double *A, const int64_t lda, + double *X, const int64_t incX); +void cblas_dtpsv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + const int64_t N, const double *Ap, double *X, const int64_t incX); + +void cblas_cgemv_64(CBLAS_LAYOUT layout, + CBLAS_TRANSPOSE TransA, const int64_t M, const int64_t N, + const void *alpha, const void *A, const int64_t lda, + const void *X, const int64_t incX, const void *beta, + void *Y, const int64_t incY); +void cblas_cgbmv_64(CBLAS_LAYOUT layout, + CBLAS_TRANSPOSE TransA, const int64_t M, const int64_t N, + const int64_t KL, const int64_t KU, const void *alpha, + const void *A, const int64_t lda, const void *X, + const int64_t incX, const void *beta, void *Y, const int64_t incY); +void cblas_ctrmv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + const int64_t N, const void *A, const int64_t lda, + void *X, const int64_t incX); +void cblas_ctbmv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + const int64_t N, const int64_t K, const void *A, const int64_t lda, + void *X, const int64_t incX); +void cblas_ctpmv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + const int64_t N, const void *Ap, void *X, const int64_t incX); +void cblas_ctrsv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + const int64_t N, const void *A, const int64_t lda, void *X, + const int64_t incX); +void cblas_ctbsv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + const int64_t N, const int64_t K, const void *A, const int64_t lda, + void *X, const int64_t incX); +void cblas_ctpsv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + const int64_t N, const void *Ap, void *X, const int64_t incX); + +void cblas_zgemv_64(CBLAS_LAYOUT layout, + CBLAS_TRANSPOSE TransA, const int64_t M, const int64_t N, + const void *alpha, const void *A, const int64_t lda, + const void *X, const int64_t incX, const void *beta, + void *Y, const int64_t incY); +void cblas_zgbmv_64(CBLAS_LAYOUT layout, + CBLAS_TRANSPOSE TransA, const int64_t M, const int64_t N, + const int64_t KL, const int64_t KU, const void *alpha, + const void *A, const int64_t lda, const void *X, + const int64_t incX, const void *beta, void *Y, const int64_t incY); +void cblas_ztrmv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + const int64_t N, const void *A, const int64_t lda, + void *X, const int64_t incX); +void cblas_ztbmv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + const int64_t N, const int64_t K, const void *A, const int64_t lda, + void *X, const int64_t incX); +void cblas_ztpmv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + const int64_t N, const void *Ap, void *X, const int64_t incX); +void cblas_ztrsv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + const int64_t N, const void *A, const int64_t lda, void *X, + const int64_t incX); +void cblas_ztbsv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + const int64_t N, const int64_t K, const void *A, const int64_t lda, + void *X, const int64_t incX); +void cblas_ztpsv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, + const int64_t N, const void *Ap, void *X, const int64_t incX); + + +/* + * Routines with S and D prefixes only + */ +void cblas_ssymv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + const int64_t N, const float alpha, const float *A, + const int64_t lda, const float *X, const int64_t incX, + const float beta, float *Y, const int64_t incY); +void cblas_ssbmv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + const int64_t N, const int64_t K, const float alpha, const float *A, + const int64_t lda, const float *X, const int64_t incX, + const float beta, float *Y, const int64_t incY); +void cblas_sspmv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + const int64_t N, const float alpha, const float *Ap, + const float *X, const int64_t incX, + const float beta, float *Y, const int64_t incY); +void cblas_sskewsymv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + const int64_t N, const float alpha, const float *A, + const int64_t lda, const float *X, const int64_t incX, + const float beta, float *Y, const int64_t incY); +void cblas_sger_64(CBLAS_LAYOUT layout, const int64_t M, const int64_t N, + const float alpha, const float *X, const int64_t incX, + const float *Y, const int64_t incY, float *A, const int64_t lda); +void cblas_ssyr_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + const int64_t N, const float alpha, const float *X, + const int64_t incX, float *A, const int64_t lda); +void cblas_sspr_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + const int64_t N, const float alpha, const float *X, + const int64_t incX, float *Ap); +void cblas_ssyr2_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + const int64_t N, const float alpha, const float *X, + const int64_t incX, const float *Y, const int64_t incY, float *A, + const int64_t lda); +void cblas_sspr2_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + const int64_t N, const float alpha, const float *X, + const int64_t incX, const float *Y, const int64_t incY, float *A); +void cblas_sskewsyr2_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + const int64_t N, const float alpha, const float *X, + const int64_t incX, const float *Y, const int64_t incY, float *A, + const int64_t lda); + +void cblas_dsymv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + const int64_t N, const double alpha, const double *A, + const int64_t lda, const double *X, const int64_t incX, + const double beta, double *Y, const int64_t incY); +void cblas_dsbmv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + const int64_t N, const int64_t K, const double alpha, const double *A, + const int64_t lda, const double *X, const int64_t incX, + const double beta, double *Y, const int64_t incY); +void cblas_dspmv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + const int64_t N, const double alpha, const double *Ap, + const double *X, const int64_t incX, + const double beta, double *Y, const int64_t incY); +void cblas_dskewsymv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + const int64_t N, const double alpha, const double *A, + const int64_t lda, const double *X, const int64_t incX, + const double beta, double *Y, const int64_t incY); +void cblas_dger_64(CBLAS_LAYOUT layout, const int64_t M, const int64_t N, + const double alpha, const double *X, const int64_t incX, + const double *Y, const int64_t incY, double *A, const int64_t lda); +void cblas_dsyr_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + const int64_t N, const double alpha, const double *X, + const int64_t incX, double *A, const int64_t lda); +void cblas_dspr_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + const int64_t N, const double alpha, const double *X, + const int64_t incX, double *Ap); +void cblas_dsyr2_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + const int64_t N, const double alpha, const double *X, + const int64_t incX, const double *Y, const int64_t incY, double *A, + const int64_t lda); +void cblas_dspr2_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + const int64_t N, const double alpha, const double *X, + const int64_t incX, const double *Y, const int64_t incY, double *A); +void cblas_dskewsyr2_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + const int64_t N, const double alpha, const double *X, + const int64_t incX, const double *Y, const int64_t incY, double *A, + const int64_t lda); + + +/* + * Routines with C and Z prefixes only + */ +void cblas_chemv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + const int64_t N, const void *alpha, const void *A, + const int64_t lda, const void *X, const int64_t incX, + const void *beta, void *Y, const int64_t incY); +void cblas_chbmv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + const int64_t N, const int64_t K, const void *alpha, const void *A, + const int64_t lda, const void *X, const int64_t incX, + const void *beta, void *Y, const int64_t incY); +void cblas_chpmv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + const int64_t N, const void *alpha, const void *Ap, + const void *X, const int64_t incX, + const void *beta, void *Y, const int64_t incY); +void cblas_cgeru_64(CBLAS_LAYOUT layout, const int64_t M, const int64_t N, + const void *alpha, const void *X, const int64_t incX, + const void *Y, const int64_t incY, void *A, const int64_t lda); +void cblas_cgerc_64(CBLAS_LAYOUT layout, const int64_t M, const int64_t N, + const void *alpha, const void *X, const int64_t incX, + const void *Y, const int64_t incY, void *A, const int64_t lda); +void cblas_cher_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + const int64_t N, const float alpha, const void *X, const int64_t incX, + void *A, const int64_t lda); +void cblas_chpr_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + const int64_t N, const float alpha, const void *X, + const int64_t incX, void *A); +void cblas_cher2_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const int64_t N, + const void *alpha, const void *X, const int64_t incX, + const void *Y, const int64_t incY, void *A, const int64_t lda); +void cblas_chpr2_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const int64_t N, + const void *alpha, const void *X, const int64_t incX, + const void *Y, const int64_t incY, void *Ap); + +void cblas_zhemv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + const int64_t N, const void *alpha, const void *A, + const int64_t lda, const void *X, const int64_t incX, + const void *beta, void *Y, const int64_t incY); +void cblas_zhbmv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + const int64_t N, const int64_t K, const void *alpha, const void *A, + const int64_t lda, const void *X, const int64_t incX, + const void *beta, void *Y, const int64_t incY); +void cblas_zhpmv_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + const int64_t N, const void *alpha, const void *Ap, + const void *X, const int64_t incX, + const void *beta, void *Y, const int64_t incY); +void cblas_zgeru_64(CBLAS_LAYOUT layout, const int64_t M, const int64_t N, + const void *alpha, const void *X, const int64_t incX, + const void *Y, const int64_t incY, void *A, const int64_t lda); +void cblas_zgerc_64(CBLAS_LAYOUT layout, const int64_t M, const int64_t N, + const void *alpha, const void *X, const int64_t incX, + const void *Y, const int64_t incY, void *A, const int64_t lda); +void cblas_zher_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + const int64_t N, const double alpha, const void *X, const int64_t incX, + void *A, const int64_t lda); +void cblas_zhpr_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + const int64_t N, const double alpha, const void *X, + const int64_t incX, void *A); +void cblas_zher2_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const int64_t N, + const void *alpha, const void *X, const int64_t incX, + const void *Y, const int64_t incY, void *A, const int64_t lda); +void cblas_zhpr2_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const int64_t N, + const void *alpha, const void *X, const int64_t incX, + const void *Y, const int64_t incY, void *Ap); + +/* + * =========================================================================== + * Prototypes for level 3 BLAS + * =========================================================================== + */ + +/* + * Routines with standard 4 prefixes (S, D, C, Z) + */ +void cblas_sgemm_64(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA, + CBLAS_TRANSPOSE TransB, const int64_t M, const int64_t N, + const int64_t K, const float alpha, const float *A, + const int64_t lda, const float *B, const int64_t ldb, + const float beta, float *C, const int64_t ldc); +void cblas_sgemmtr_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, + CBLAS_TRANSPOSE TransB, const int64_t N, + const int64_t K, const float alpha, const float *A, + const int64_t lda, const float *B, const int64_t ldb, + const float beta, float *C, const int64_t ldc); + +void cblas_ssymm_64(CBLAS_LAYOUT layout, CBLAS_SIDE Side, + CBLAS_UPLO Uplo, const int64_t M, const int64_t N, + const float alpha, const float *A, const int64_t lda, + const float *B, const int64_t ldb, const float beta, + float *C, const int64_t ldc); +void cblas_sskewsymm_64(CBLAS_LAYOUT layout, CBLAS_SIDE Side, + CBLAS_UPLO Uplo, const int64_t M, const int64_t N, + const float alpha, const float *A, const int64_t lda, + const float *B, const int64_t ldb, const float beta, + float *C, const int64_t ldc); +void cblas_ssyrk_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE Trans, const int64_t N, const int64_t K, + const float alpha, const float *A, const int64_t lda, + const float beta, float *C, const int64_t ldc); +void cblas_ssyr2k_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE Trans, const int64_t N, const int64_t K, + const float alpha, const float *A, const int64_t lda, + const float *B, const int64_t ldb, const float beta, + float *C, const int64_t ldc); +void cblas_sskewsyr2k_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE Trans, const int64_t N, const int64_t K, + const float alpha, const float *A, const int64_t lda, + const float *B, const int64_t ldb, const float beta, + float *C, const int64_t ldc); +void cblas_strmm_64(CBLAS_LAYOUT layout, CBLAS_SIDE Side, + CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, + CBLAS_DIAG Diag, const int64_t M, const int64_t N, + const float alpha, const float *A, const int64_t lda, + float *B, const int64_t ldb); +void cblas_strsm_64(CBLAS_LAYOUT layout, CBLAS_SIDE Side, + CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, + CBLAS_DIAG Diag, const int64_t M, const int64_t N, + const float alpha, const float *A, const int64_t lda, + float *B, const int64_t ldb); + +void cblas_dgemm_64(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA, + CBLAS_TRANSPOSE TransB, const int64_t M, const int64_t N, + const int64_t K, const double alpha, const double *A, + const int64_t lda, const double *B, const int64_t ldb, + const double beta, double *C, const int64_t ldc); +void cblas_dgemmtr_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, + CBLAS_TRANSPOSE TransB, const int64_t N, + const int64_t K, const double alpha, const double *A, + const int64_t lda, const double *B, const int64_t ldb, + const double beta, double *C, const int64_t ldc); +void cblas_dsymm_64(CBLAS_LAYOUT layout, CBLAS_SIDE Side, + CBLAS_UPLO Uplo, const int64_t M, const int64_t N, + const double alpha, const double *A, const int64_t lda, + const double *B, const int64_t ldb, const double beta, + double *C, const int64_t ldc); +void cblas_dskewsymm_64(CBLAS_LAYOUT layout, CBLAS_SIDE Side, + CBLAS_UPLO Uplo, const int64_t M, const int64_t N, + const double alpha, const double *A, const int64_t lda, + const double *B, const int64_t ldb, const double beta, + double *C, const int64_t ldc); +void cblas_dsyrk_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE Trans, const int64_t N, const int64_t K, + const double alpha, const double *A, const int64_t lda, + const double beta, double *C, const int64_t ldc); +void cblas_dsyr2k_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE Trans, const int64_t N, const int64_t K, + const double alpha, const double *A, const int64_t lda, + const double *B, const int64_t ldb, const double beta, + double *C, const int64_t ldc); +void cblas_dskewsyr2k_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE Trans, const int64_t N, const int64_t K, + const double alpha, const double *A, const int64_t lda, + const double *B, const int64_t ldb, const double beta, + double *C, const int64_t ldc); +void cblas_dtrmm_64(CBLAS_LAYOUT layout, CBLAS_SIDE Side, + CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, + CBLAS_DIAG Diag, const int64_t M, const int64_t N, + const double alpha, const double *A, const int64_t lda, + double *B, const int64_t ldb); +void cblas_dtrsm_64(CBLAS_LAYOUT layout, CBLAS_SIDE Side, + CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, + CBLAS_DIAG Diag, const int64_t M, const int64_t N, + const double alpha, const double *A, const int64_t lda, + double *B, const int64_t ldb); + +void cblas_cgemm_64(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA, + CBLAS_TRANSPOSE TransB, const int64_t M, const int64_t N, + const int64_t K, const void *alpha, const void *A, + const int64_t lda, const void *B, const int64_t ldb, + const void *beta, void *C, const int64_t ldc); +void cblas_cgemmtr_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, + CBLAS_TRANSPOSE TransB, const int64_t N, + const int64_t K, const void *alpha, const void *A, + const int64_t lda, const void *B, const int64_t ldb, + const void *beta, void *C, const int64_t ldc); + +void cblas_csymm_64(CBLAS_LAYOUT layout, CBLAS_SIDE Side, + CBLAS_UPLO Uplo, const int64_t M, const int64_t N, + const void *alpha, const void *A, const int64_t lda, + const void *B, const int64_t ldb, const void *beta, + void *C, const int64_t ldc); +void cblas_csyrk_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE Trans, const int64_t N, const int64_t K, + const void *alpha, const void *A, const int64_t lda, + const void *beta, void *C, const int64_t ldc); +void cblas_csyr2k_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE Trans, const int64_t N, const int64_t K, + const void *alpha, const void *A, const int64_t lda, + const void *B, const int64_t ldb, const void *beta, + void *C, const int64_t ldc); +void cblas_ctrmm_64(CBLAS_LAYOUT layout, CBLAS_SIDE Side, + CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, + CBLAS_DIAG Diag, const int64_t M, const int64_t N, + const void *alpha, const void *A, const int64_t lda, + void *B, const int64_t ldb); +void cblas_ctrsm_64(CBLAS_LAYOUT layout, CBLAS_SIDE Side, + CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, + CBLAS_DIAG Diag, const int64_t M, const int64_t N, + const void *alpha, const void *A, const int64_t lda, + void *B, const int64_t ldb); + +void cblas_zgemm_64(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA, + CBLAS_TRANSPOSE TransB, const int64_t M, const int64_t N, + const int64_t K, const void *alpha, const void *A, + const int64_t lda, const void *B, const int64_t ldb, + const void *beta, void *C, const int64_t ldc); +void cblas_zgemmtr_64(CBLAS_LAYOUT layout,CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, + CBLAS_TRANSPOSE TransB, const int64_t N, + const int64_t K, const void *alpha, const void *A, + const int64_t lda, const void *B, const int64_t ldb, + const void *beta, void *C, const int64_t ldc); +void cblas_zsymm_64(CBLAS_LAYOUT layout, CBLAS_SIDE Side, + CBLAS_UPLO Uplo, const int64_t M, const int64_t N, + const void *alpha, const void *A, const int64_t lda, + const void *B, const int64_t ldb, const void *beta, + void *C, const int64_t ldc); +void cblas_zsyrk_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE Trans, const int64_t N, const int64_t K, + const void *alpha, const void *A, const int64_t lda, + const void *beta, void *C, const int64_t ldc); +void cblas_zsyr2k_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE Trans, const int64_t N, const int64_t K, + const void *alpha, const void *A, const int64_t lda, + const void *B, const int64_t ldb, const void *beta, + void *C, const int64_t ldc); +void cblas_ztrmm_64(CBLAS_LAYOUT layout, CBLAS_SIDE Side, + CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, + CBLAS_DIAG Diag, const int64_t M, const int64_t N, + const void *alpha, const void *A, const int64_t lda, + void *B, const int64_t ldb); +void cblas_ztrsm_64(CBLAS_LAYOUT layout, CBLAS_SIDE Side, + CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, + CBLAS_DIAG Diag, const int64_t M, const int64_t N, + const void *alpha, const void *A, const int64_t lda, + void *B, const int64_t ldb); + + +/* + * Routines with prefixes C and Z only + */ +void cblas_chemm_64(CBLAS_LAYOUT layout, CBLAS_SIDE Side, + CBLAS_UPLO Uplo, const int64_t M, const int64_t N, + const void *alpha, const void *A, const int64_t lda, + const void *B, const int64_t ldb, const void *beta, + void *C, const int64_t ldc); +void cblas_cherk_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE Trans, const int64_t N, const int64_t K, + const float alpha, const void *A, const int64_t lda, + const float beta, void *C, const int64_t ldc); +void cblas_cher2k_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE Trans, const int64_t N, const int64_t K, + const void *alpha, const void *A, const int64_t lda, + const void *B, const int64_t ldb, const float beta, + void *C, const int64_t ldc); + +void cblas_zhemm_64(CBLAS_LAYOUT layout, CBLAS_SIDE Side, + CBLAS_UPLO Uplo, const int64_t M, const int64_t N, + const void *alpha, const void *A, const int64_t lda, + const void *B, const int64_t ldb, const void *beta, + void *C, const int64_t ldc); +void cblas_zherk_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE Trans, const int64_t N, const int64_t K, + const double alpha, const void *A, const int64_t lda, + const double beta, void *C, const int64_t ldc); +void cblas_zher2k_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, + CBLAS_TRANSPOSE Trans, const int64_t N, const int64_t K, + const void *alpha, const void *A, const int64_t lda, + const void *B, const int64_t ldb, const double beta, + void *C, const int64_t ldc); + +void CBLAS_WEAK_SYMBOL cblas_xerbla_64(int64_t p, const char *rout, + const char *form, ...); + +#ifdef __cplusplus +} +#endif +#endif diff --git a/CBLAS/include/cblas_f77.h b/CBLAS/include/cblas_f77.h index 36d4a71180..e20ee980f6 100644 --- a/CBLAS/include/cblas_f77.h +++ b/CBLAS/include/cblas_f77.h @@ -9,6 +9,20 @@ #ifndef CBLAS_F77_H #define CBLAS_F77_H +#include "cblas_mangling.h" + +#include +#include + +/* It seems all current Fortran compilers put strlen at end. +* Some historical compilers put strlen after the str argument +* or make the str argument into a struct. */ +#define BLAS_FORTRAN_STRLEN_END + +#ifndef FORTRAN_STRLEN + #define FORTRAN_STRLEN size_t +#endif + #ifdef CRAY #include #define F77_CHAR _fcd @@ -17,8 +31,12 @@ #define F77_STRLEN(a) (_fcdlen) #endif +#ifndef F77_INT #ifdef WeirdNEC - #define F77_INT long + #define F77_INT int64_t +#else + #define F77_INT int32_t +#endif #endif #ifdef F77_CHAR @@ -27,237 +45,665 @@ #define FCHAR char * #endif -#ifdef F77_INT - #define FINT const F77_INT * - #define FINT2 F77_INT * +#define FINT const F77_INT * +#define FINT2 F77_INT * + +/* + * Integer specific API + */ +#ifndef API_SUFFIX +#ifdef CBLAS_API64 +#define API_SUFFIX(a) a##_64 #else - #define FINT const int * - #define FINT2 int * +#define API_SUFFIX(a) a +#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) + /* * Level 1 BLAS */ -#define F77_xerbla F77_GLOBAL(xerbla,XERBLA) -#define F77_srotg F77_GLOBAL(srotg,SROTG) -#define F77_srotmg F77_GLOBAL(srotmg,SROTMG) -#define F77_srot F77_GLOBAL(srot,SROT) -#define F77_srotm F77_GLOBAL(srotm,SROTM) -#define F77_drotg F77_GLOBAL(drotg,DROTG) -#define F77_drotmg F77_GLOBAL(drotmg,DROTMG) -#define F77_drot F77_GLOBAL(drot,DROT) -#define F77_drotm F77_GLOBAL(drotm,DROTM) -#define F77_sswap F77_GLOBAL(sswap,SSWAP) -#define F77_scopy F77_GLOBAL(scopy,SCOPY) -#define F77_saxpy F77_GLOBAL(saxpy,SAXPY) -#define F77_isamax_sub F77_GLOBAL(isamaxsub,ISAMAXSUB) -#define F77_dswap F77_GLOBAL(dswap,DSWAP) -#define F77_dcopy F77_GLOBAL(dcopy,DCOPY) -#define F77_daxpy F77_GLOBAL(daxpy,DAXPY) -#define F77_idamax_sub F77_GLOBAL(idamaxsub,IDAMAXSUB) -#define F77_cswap F77_GLOBAL(cswap,CSWAP) -#define F77_ccopy F77_GLOBAL(ccopy,CCOPY) -#define F77_caxpy F77_GLOBAL(caxpy,CAXPY) -#define F77_icamax_sub F77_GLOBAL(icamaxsub,ICAMAXSUB) -#define F77_zswap F77_GLOBAL(zswap,ZSWAP) -#define F77_zcopy F77_GLOBAL(zcopy,ZCOPY) -#define F77_zaxpy F77_GLOBAL(zaxpy,ZAXPY) -#define F77_izamax_sub F77_GLOBAL(izamaxsub,IZAMAXSUB) -#define F77_sdot_sub F77_GLOBAL(sdotsub,SDOTSUB) -#define F77_ddot_sub F77_GLOBAL(ddotsub,DDOTSUB) -#define F77_dsdot_sub F77_GLOBAL(dsdotsub,DSDOTSUB) -#define F77_sscal F77_GLOBAL(sscal,SSCAL) -#define F77_dscal F77_GLOBAL(dscal,DSCAL) -#define F77_cscal F77_GLOBAL(cscal,CSCAL) -#define F77_zscal F77_GLOBAL(zscal,ZSCAL) -#define F77_csscal F77_GLOBAL(csscal,CSSCAL) -#define F77_zdscal F77_GLOBAL(zdscal,ZDSCAL) -#define F77_cdotu_sub F77_GLOBAL(cdotusub,CDOTUSUB) -#define F77_cdotc_sub F77_GLOBAL(cdotcsub,CDOTCSUB) -#define F77_zdotu_sub F77_GLOBAL(zdotusub,ZDOTUSUB) -#define F77_zdotc_sub F77_GLOBAL(zdotcsub,ZDOTCSUB) -#define F77_snrm2_sub F77_GLOBAL(snrm2sub,SNRM2SUB) -#define F77_sasum_sub F77_GLOBAL(sasumsub,SASUMSUB) -#define F77_dnrm2_sub F77_GLOBAL(dnrm2sub,DNRM2SUB) -#define F77_dasum_sub F77_GLOBAL(dasumsub,DASUMSUB) -#define F77_scnrm2_sub F77_GLOBAL(scnrm2sub,SCNRM2SUB) -#define F77_scasum_sub F77_GLOBAL(scasumsub,SCASUMSUB) -#define F77_dznrm2_sub F77_GLOBAL(dznrm2sub,DZNRM2SUB) -#define F77_dzasum_sub F77_GLOBAL(dzasumsub,DZASUMSUB) -#define F77_sdsdot_sub F77_GLOBAL(sdsdotsub,SDSDOTSUB) +#define F77_xerbla_base F77_GLOBAL_SUFFIX(xerbla,XERBLA) +#define F77_srotg_base F77_GLOBAL_SUFFIX(srotg,SROTG) +#define F77_srotmg_base F77_GLOBAL_SUFFIX(srotmg,SROTMG) +#define F77_srot_base F77_GLOBAL_SUFFIX(srot,SROT) +#define F77_srotm_base F77_GLOBAL_SUFFIX(srotm,SROTM) +#define F77_drotg_base F77_GLOBAL_SUFFIX(drotg,DROTG) +#define F77_drotmg_base F77_GLOBAL_SUFFIX(drotmg,DROTMG) +#define F77_drot_base F77_GLOBAL_SUFFIX(drot,DROT) +#define F77_drotm_base F77_GLOBAL_SUFFIX(drotm,DROTM) +#define F77_sswap_base F77_GLOBAL_SUFFIX(sswap,SSWAP) +#define F77_scopy_base F77_GLOBAL_SUFFIX(scopy,SCOPY) +#define F77_saxpy_base F77_GLOBAL_SUFFIX(saxpy,SAXPY) +#define F77_saxpby_base F77_GLOBAL_SUFFIX(saxpby,SAXPBY) +#define F77_isamax_sub_base F77_GLOBAL_SUFFIX(isamaxsub,ISAMAXSUB) +#define F77_dswap_base F77_GLOBAL_SUFFIX(dswap,DSWAP) +#define F77_dcopy_base F77_GLOBAL_SUFFIX(dcopy,DCOPY) +#define F77_daxpy_base F77_GLOBAL_SUFFIX(daxpy,DAXPY) +#define F77_daxpby_base F77_GLOBAL_SUFFIX(daxpby,DAXPBY) +#define F77_idamax_sub_base F77_GLOBAL_SUFFIX(idamaxsub,IDAMAXSUB) +#define F77_cswap_base F77_GLOBAL_SUFFIX(cswap,CSWAP) +#define F77_ccopy_base F77_GLOBAL_SUFFIX(ccopy,CCOPY) +#define F77_caxpy_base F77_GLOBAL_SUFFIX(caxpy,CAXPY) +#define F77_caxpby_base F77_GLOBAL_SUFFIX(caxpby,CAXPBY) +#define F77_icamax_sub_base F77_GLOBAL_SUFFIX(icamaxsub,ICAMAXSUB) +#define F77_zswap_base F77_GLOBAL_SUFFIX(zswap,ZSWAP) +#define F77_zcopy_base F77_GLOBAL_SUFFIX(zcopy,ZCOPY) +#define F77_zaxpy_base F77_GLOBAL_SUFFIX(zaxpy,ZAXPY) +#define F77_zaxpby_base F77_GLOBAL_SUFFIX(zaxpby,ZAXPBY) +#define F77_izamax_sub_base F77_GLOBAL_SUFFIX(izamaxsub,IZAMAXSUB) +#define F77_sdot_sub_base F77_GLOBAL_SUFFIX(sdotsub,SDOTSUB) +#define F77_ddot_sub_base F77_GLOBAL_SUFFIX(ddotsub,DDOTSUB) +#define F77_dsdot_sub_base F77_GLOBAL_SUFFIX(dsdotsub,DSDOTSUB) +#define F77_sscal_base F77_GLOBAL_SUFFIX(sscal,SSCAL) +#define F77_dscal_base F77_GLOBAL_SUFFIX(dscal,DSCAL) +#define F77_cscal_base F77_GLOBAL_SUFFIX(cscal,CSCAL) +#define F77_zscal_base F77_GLOBAL_SUFFIX(zscal,ZSCAL) +#define F77_csscal_base F77_GLOBAL_SUFFIX(csscal,CSSCAL) +#define F77_zdscal_base F77_GLOBAL_SUFFIX(zdscal,ZDSCAL) +#define F77_cdotu_sub_base F77_GLOBAL_SUFFIX(cdotusub,CDOTUSUB) +#define F77_cdotc_sub_base F77_GLOBAL_SUFFIX(cdotcsub,CDOTCSUB) +#define F77_zdotu_sub_base F77_GLOBAL_SUFFIX(zdotusub,ZDOTUSUB) +#define F77_zdotc_sub_base F77_GLOBAL_SUFFIX(zdotcsub,ZDOTCSUB) +#define F77_snrm2_sub_base F77_GLOBAL_SUFFIX(snrm2sub,SNRM2SUB) +#define F77_sasum_sub_base F77_GLOBAL_SUFFIX(sasumsub,SASUMSUB) +#define F77_dnrm2_sub_base F77_GLOBAL_SUFFIX(dnrm2sub,DNRM2SUB) +#define F77_dasum_sub_base F77_GLOBAL_SUFFIX(dasumsub,DASUMSUB) +#define F77_scnrm2_sub_base F77_GLOBAL_SUFFIX(scnrm2sub,SCNRM2SUB) +#define F77_scasum_sub_base F77_GLOBAL_SUFFIX(scasumsub,SCASUMSUB) +#define F77_dznrm2_sub_base F77_GLOBAL_SUFFIX(dznrm2sub,DZNRM2SUB) +#define F77_dzasum_sub_base F77_GLOBAL_SUFFIX(dzasumsub,DZASUMSUB) +#define F77_sdsdot_sub_base F77_GLOBAL_SUFFIX(sdsdotsub,SDSDOTSUB) +#define F77_crotg_base F77_GLOBAL_SUFFIX(crotg, CROTG) +#define F77_csrot_base F77_GLOBAL_SUFFIX(csrot, CSROT) +#define F77_zrotg_base F77_GLOBAL_SUFFIX(zrotg, ZROTG) +#define F77_zdrot_base F77_GLOBAL_SUFFIX(zdrot, ZDROT) +#define F77_scabs1_sub_base F77_GLOBAL_SUFFIX(scabs1sub, SCABS1SUB) +#define F77_dcabs1_sub_base F77_GLOBAL_SUFFIX(dcabs1sub, DCABS1SUB) + /* * Level 2 BLAS */ -#define F77_ssymv F77_GLOBAL(ssymv,SSYMV) -#define F77_ssbmv F77_GLOBAL(ssbmv,SSBMV) -#define F77_sspmv F77_GLOBAL(sspmv,SSPMV) -#define F77_sger F77_GLOBAL(sger,SGER) -#define F77_ssyr F77_GLOBAL(ssyr,SSYR) -#define F77_sspr F77_GLOBAL(sspr,SSPR) -#define F77_ssyr2 F77_GLOBAL(ssyr2,SSYR2) -#define F77_sspr2 F77_GLOBAL(sspr2,SSPR2) -#define F77_dsymv F77_GLOBAL(dsymv,DSYMV) -#define F77_dsbmv F77_GLOBAL(dsbmv,DSBMV) -#define F77_dspmv F77_GLOBAL(dspmv,DSPMV) -#define F77_dger F77_GLOBAL(dger,DGER) -#define F77_dsyr F77_GLOBAL(dsyr,DSYR) -#define F77_dspr F77_GLOBAL(dspr,DSPR) -#define F77_dsyr2 F77_GLOBAL(dsyr2,DSYR2) -#define F77_dspr2 F77_GLOBAL(dspr2,DSPR2) -#define F77_chemv F77_GLOBAL(chemv,CHEMV) -#define F77_chbmv F77_GLOBAL(chbmv,CHBMV) -#define F77_chpmv F77_GLOBAL(chpmv,CHPMV) -#define F77_cgeru F77_GLOBAL(cgeru,CGERU) -#define F77_cgerc F77_GLOBAL(cgerc,CGERC) -#define F77_cher F77_GLOBAL(cher,CHER) -#define F77_chpr F77_GLOBAL(chpr,CHPR) -#define F77_cher2 F77_GLOBAL(cher2,CHER2) -#define F77_chpr2 F77_GLOBAL(chpr2,CHPR2) -#define F77_zhemv F77_GLOBAL(zhemv,ZHEMV) -#define F77_zhbmv F77_GLOBAL(zhbmv,ZHBMV) -#define F77_zhpmv F77_GLOBAL(zhpmv,ZHPMV) -#define F77_zgeru F77_GLOBAL(zgeru,ZGERU) -#define F77_zgerc F77_GLOBAL(zgerc,ZGERC) -#define F77_zher F77_GLOBAL(zher,ZHER) -#define F77_zhpr F77_GLOBAL(zhpr,ZHPR) -#define F77_zher2 F77_GLOBAL(zher2,ZHER2) -#define F77_zhpr2 F77_GLOBAL(zhpr2,ZHPR2) -#define F77_sgemv F77_GLOBAL(sgemv,SGEMV) -#define F77_sgbmv F77_GLOBAL(sgbmv,SGBMV) -#define F77_strmv F77_GLOBAL(strmv,STRMV) -#define F77_stbmv F77_GLOBAL(stbmv,STBMV) -#define F77_stpmv F77_GLOBAL(stpmv,STPMV) -#define F77_strsv F77_GLOBAL(strsv,STRSV) -#define F77_stbsv F77_GLOBAL(stbsv,STBSV) -#define F77_stpsv F77_GLOBAL(stpsv,STPSV) -#define F77_dgemv F77_GLOBAL(dgemv,DGEMV) -#define F77_dgbmv F77_GLOBAL(dgbmv,DGBMV) -#define F77_dtrmv F77_GLOBAL(dtrmv,DTRMV) -#define F77_dtbmv F77_GLOBAL(dtbmv,DTBMV) -#define F77_dtpmv F77_GLOBAL(dtpmv,DTPMV) -#define F77_dtrsv F77_GLOBAL(dtrsv,DTRSV) -#define F77_dtbsv F77_GLOBAL(dtbsv,DTBSV) -#define F77_dtpsv F77_GLOBAL(dtpsv,DTPSV) -#define F77_cgemv F77_GLOBAL(cgemv,CGEMV) -#define F77_cgbmv F77_GLOBAL(cgbmv,CGBMV) -#define F77_ctrmv F77_GLOBAL(ctrmv,CTRMV) -#define F77_ctbmv F77_GLOBAL(ctbmv,CTBMV) -#define F77_ctpmv F77_GLOBAL(ctpmv,CTPMV) -#define F77_ctrsv F77_GLOBAL(ctrsv,CTRSV) -#define F77_ctbsv F77_GLOBAL(ctbsv,CTBSV) -#define F77_ctpsv F77_GLOBAL(ctpsv,CTPSV) -#define F77_zgemv F77_GLOBAL(zgemv,ZGEMV) -#define F77_zgbmv F77_GLOBAL(zgbmv,ZGBMV) -#define F77_ztrmv F77_GLOBAL(ztrmv,ZTRMV) -#define F77_ztbmv F77_GLOBAL(ztbmv,ZTBMV) -#define F77_ztpmv F77_GLOBAL(ztpmv,ZTPMV) -#define F77_ztrsv F77_GLOBAL(ztrsv,ZTRSV) -#define F77_ztbsv F77_GLOBAL(ztbsv,ZTBSV) -#define F77_ztpsv F77_GLOBAL(ztpsv,ZTPSV) +#define F77_ssymv_base F77_GLOBAL_SUFFIX(ssymv,SSYMV) +#define F77_ssbmv_base F77_GLOBAL_SUFFIX(ssbmv,SSBMV) +#define F77_sspmv_base F77_GLOBAL_SUFFIX(sspmv,SSPMV) +#define F77_sskewsymv_base F77_GLOBAL_SUFFIX(sskewsymv,SSKEWSYMV) +#define F77_sger_base F77_GLOBAL_SUFFIX(sger,SGER) +#define F77_ssyr_base F77_GLOBAL_SUFFIX(ssyr,SSYR) +#define F77_sspr_base F77_GLOBAL_SUFFIX(sspr,SSPR) +#define F77_ssyr2_base F77_GLOBAL_SUFFIX(ssyr2,SSYR2) +#define F77_sspr2_base F77_GLOBAL_SUFFIX(sspr2,SSPR2) +#define F77_sskewsyr2_base F77_GLOBAL_SUFFIX(sskewsyr2,SSKEWSYR2) +#define F77_dsymv_base F77_GLOBAL_SUFFIX(dsymv,DSYMV) +#define F77_dsbmv_base F77_GLOBAL_SUFFIX(dsbmv,DSBMV) +#define F77_dspmv_base F77_GLOBAL_SUFFIX(dspmv,DSPMV) +#define F77_dskewsymv_base F77_GLOBAL_SUFFIX(dskewsymv,DSKEWSYMV) +#define F77_dger_base F77_GLOBAL_SUFFIX(dger,DGER) +#define F77_dsyr_base F77_GLOBAL_SUFFIX(dsyr,DSYR) +#define F77_dspr_base F77_GLOBAL_SUFFIX(dspr,DSPR) +#define F77_dsyr2_base F77_GLOBAL_SUFFIX(dsyr2,DSYR2) +#define F77_dspr2_base F77_GLOBAL_SUFFIX(dspr2,DSPR2) +#define F77_dskewsyr2_base F77_GLOBAL_SUFFIX(dskewsyr2,DSKEWSYR2) +#define F77_chemv_base F77_GLOBAL_SUFFIX(chemv,CHEMV) +#define F77_chbmv_base F77_GLOBAL_SUFFIX(chbmv,CHBMV) +#define F77_chpmv_base F77_GLOBAL_SUFFIX(chpmv,CHPMV) +#define F77_cgeru_base F77_GLOBAL_SUFFIX(cgeru,CGERU) +#define F77_cgerc_base F77_GLOBAL_SUFFIX(cgerc,CGERC) +#define F77_cher_base F77_GLOBAL_SUFFIX(cher,CHER) +#define F77_chpr_base F77_GLOBAL_SUFFIX(chpr,CHPR) +#define F77_cher2_base F77_GLOBAL_SUFFIX(cher2,CHER2) +#define F77_chpr2_base F77_GLOBAL_SUFFIX(chpr2,CHPR2) +#define F77_zhemv_base F77_GLOBAL_SUFFIX(zhemv,ZHEMV) +#define F77_zhbmv_base F77_GLOBAL_SUFFIX(zhbmv,ZHBMV) +#define F77_zhpmv_base F77_GLOBAL_SUFFIX(zhpmv,ZHPMV) +#define F77_zgeru_base F77_GLOBAL_SUFFIX(zgeru,ZGERU) +#define F77_zgerc_base F77_GLOBAL_SUFFIX(zgerc,ZGERC) +#define F77_zher_base F77_GLOBAL_SUFFIX(zher,ZHER) +#define F77_zhpr_base F77_GLOBAL_SUFFIX(zhpr,ZHPR) +#define F77_zher2_base F77_GLOBAL_SUFFIX(zher2,ZHER2) +#define F77_zhpr2_base F77_GLOBAL_SUFFIX(zhpr2,ZHPR2) +#define F77_sgemv_base F77_GLOBAL_SUFFIX(sgemv,SGEMV) +#define F77_sgbmv_base F77_GLOBAL_SUFFIX(sgbmv,SGBMV) +#define F77_strmv_base F77_GLOBAL_SUFFIX(strmv,STRMV) +#define F77_stbmv_base F77_GLOBAL_SUFFIX(stbmv,STBMV) +#define F77_stpmv_base F77_GLOBAL_SUFFIX(stpmv,STPMV) +#define F77_strsv_base F77_GLOBAL_SUFFIX(strsv,STRSV) +#define F77_stbsv_base F77_GLOBAL_SUFFIX(stbsv,STBSV) +#define F77_stpsv_base F77_GLOBAL_SUFFIX(stpsv,STPSV) +#define F77_dgemv_base F77_GLOBAL_SUFFIX(dgemv,DGEMV) +#define F77_dgbmv_base F77_GLOBAL_SUFFIX(dgbmv,DGBMV) +#define F77_dtrmv_base F77_GLOBAL_SUFFIX(dtrmv,DTRMV) +#define F77_dtbmv_base F77_GLOBAL_SUFFIX(dtbmv,DTBMV) +#define F77_dtpmv_base F77_GLOBAL_SUFFIX(dtpmv,DTPMV) +#define F77_dtrsv_base F77_GLOBAL_SUFFIX(dtrsv,DTRSV) +#define F77_dtbsv_base F77_GLOBAL_SUFFIX(dtbsv,DTBSV) +#define F77_dtpsv_base F77_GLOBAL_SUFFIX(dtpsv,DTPSV) +#define F77_cgemv_base F77_GLOBAL_SUFFIX(cgemv,CGEMV) +#define F77_cgbmv_base F77_GLOBAL_SUFFIX(cgbmv,CGBMV) +#define F77_ctrmv_base F77_GLOBAL_SUFFIX(ctrmv,CTRMV) +#define F77_ctbmv_base F77_GLOBAL_SUFFIX(ctbmv,CTBMV) +#define F77_ctpmv_base F77_GLOBAL_SUFFIX(ctpmv,CTPMV) +#define F77_ctrsv_base F77_GLOBAL_SUFFIX(ctrsv,CTRSV) +#define F77_ctbsv_base F77_GLOBAL_SUFFIX(ctbsv,CTBSV) +#define F77_ctpsv_base F77_GLOBAL_SUFFIX(ctpsv,CTPSV) +#define F77_zgemv_base F77_GLOBAL_SUFFIX(zgemv,ZGEMV) +#define F77_zgbmv_base F77_GLOBAL_SUFFIX(zgbmv,ZGBMV) +#define F77_ztrmv_base F77_GLOBAL_SUFFIX(ztrmv,ZTRMV) +#define F77_ztbmv_base F77_GLOBAL_SUFFIX(ztbmv,ZTBMV) +#define F77_ztpmv_base F77_GLOBAL_SUFFIX(ztpmv,ZTPMV) +#define F77_ztrsv_base F77_GLOBAL_SUFFIX(ztrsv,ZTRSV) +#define F77_ztbsv_base F77_GLOBAL_SUFFIX(ztbsv,ZTBSV) +#define F77_ztpsv_base F77_GLOBAL_SUFFIX(ztpsv,ZTPSV) /* * Level 3 BLAS */ -#define F77_chemm F77_GLOBAL(chemm,CHEMM) -#define F77_cherk F77_GLOBAL(cherk,CHERK) -#define F77_cher2k F77_GLOBAL(cher2k,CHER2K) -#define F77_zhemm F77_GLOBAL(zhemm,ZHEMM) -#define F77_zherk F77_GLOBAL(zherk,ZHERK) -#define F77_zher2k F77_GLOBAL(zher2k,ZHER2K) -#define F77_sgemm F77_GLOBAL(sgemm,SGEMM) -#define F77_ssymm F77_GLOBAL(ssymm,SSYMM) -#define F77_ssyrk F77_GLOBAL(ssyrk,SSYRK) -#define F77_ssyr2k F77_GLOBAL(ssyr2k,SSYR2K) -#define F77_strmm F77_GLOBAL(strmm,STRMM) -#define F77_strsm F77_GLOBAL(strsm,STRSM) -#define F77_dgemm F77_GLOBAL(dgemm,DGEMM) -#define F77_dsymm F77_GLOBAL(dsymm,DSYMM) -#define F77_dsyrk F77_GLOBAL(dsyrk,DSYRK) -#define F77_dsyr2k F77_GLOBAL(dsyr2k,DSYR2K) -#define F77_dtrmm F77_GLOBAL(dtrmm,DTRMM) -#define F77_dtrsm F77_GLOBAL(dtrsm,DTRSM) -#define F77_cgemm F77_GLOBAL(cgemm,CGEMM) -#define F77_csymm F77_GLOBAL(csymm,CSYMM) -#define F77_csyrk F77_GLOBAL(csyrk,CSYRK) -#define F77_csyr2k F77_GLOBAL(csyr2k,CSYR2K) -#define F77_ctrmm F77_GLOBAL(ctrmm,CTRMM) -#define F77_ctrsm F77_GLOBAL(ctrsm,CTRSM) -#define F77_zgemm F77_GLOBAL(zgemm,ZGEMM) -#define F77_zsymm F77_GLOBAL(zsymm,ZSYMM) -#define F77_zsyrk F77_GLOBAL(zsyrk,ZSYRK) -#define F77_zsyr2k F77_GLOBAL(zsyr2k,ZSYR2K) -#define F77_ztrmm F77_GLOBAL(ztrmm,ZTRMM) -#define F77_ztrsm F77_GLOBAL(ztrsm,ZTRSM) +#define F77_chemm_base F77_GLOBAL_SUFFIX(chemm,CHEMM) +#define F77_cherk_base F77_GLOBAL_SUFFIX(cherk,CHERK) +#define F77_cher2k_base F77_GLOBAL_SUFFIX(cher2k,CHER2K) +#define F77_zhemm_base F77_GLOBAL_SUFFIX(zhemm,ZHEMM) +#define F77_zherk_base F77_GLOBAL_SUFFIX(zherk,ZHERK) +#define F77_zher2k_base F77_GLOBAL_SUFFIX(zher2k,ZHER2K) +#define F77_sgemm_base F77_GLOBAL_SUFFIX(sgemm,SGEMM) +#define F77_sgemmtr_base F77_GLOBAL_SUFFIX(sgemmtr,SGEMMTR) +#define F77_ssymm_base F77_GLOBAL_SUFFIX(ssymm,SSYMM) +#define F77_sskewsymm_base F77_GLOBAL_SUFFIX(sskewsymm,SSKEWSYMM) +#define F77_ssyrk_base F77_GLOBAL_SUFFIX(ssyrk,SSYRK) +#define F77_ssyr2k_base F77_GLOBAL_SUFFIX(ssyr2k,SSYR2K) +#define F77_sskewsyr2k_base F77_GLOBAL_SUFFIX(sskewsyr2k,SSKEWSYR2K) +#define F77_strmm_base F77_GLOBAL_SUFFIX(strmm,STRMM) +#define F77_strsm_base F77_GLOBAL_SUFFIX(strsm,STRSM) +#define F77_dgemm_base F77_GLOBAL_SUFFIX(dgemm,DGEMM) +#define F77_dgemmtr_base F77_GLOBAL_SUFFIX(dgemmtr,DGEMMTR) +#define F77_dsymm_base F77_GLOBAL_SUFFIX(dsymm,DSYMM) +#define F77_dskewsymm_base F77_GLOBAL_SUFFIX(dskewsymm,DSKEWSYMM) +#define F77_dsyrk_base F77_GLOBAL_SUFFIX(dsyrk,DSYRK) +#define F77_dsyr2k_base F77_GLOBAL_SUFFIX(dsyr2k,DSYR2K) +#define F77_dskewsyr2k_base F77_GLOBAL_SUFFIX(dskewsyr2k,DSKEWSYR2K) +#define F77_dtrmm_base F77_GLOBAL_SUFFIX(dtrmm,DTRMM) +#define F77_dtrsm_base F77_GLOBAL_SUFFIX(dtrsm,DTRSM) +#define F77_cgemm_base F77_GLOBAL_SUFFIX(cgemm,CGEMM) +#define F77_cgemmtr_base F77_GLOBAL_SUFFIX(cgemmtr,CGEMMTR) +#define F77_csymm_base F77_GLOBAL_SUFFIX(csymm,CSYMM) +#define F77_csyrk_base F77_GLOBAL_SUFFIX(csyrk,CSYRK) +#define F77_csyr2k_base F77_GLOBAL_SUFFIX(csyr2k,CSYR2K) +#define F77_ctrmm_base F77_GLOBAL_SUFFIX(ctrmm,CTRMM) +#define F77_ctrsm_base F77_GLOBAL_SUFFIX(ctrsm,CTRSM) +#define F77_zgemm_base F77_GLOBAL_SUFFIX(zgemm,ZGEMM) +#define F77_zgemmtr_base F77_GLOBAL_SUFFIX(zgemmtr,ZGEMMTR) +#define F77_zsymm_base F77_GLOBAL_SUFFIX(zsymm,ZSYMM) +#define F77_zsyrk_base F77_GLOBAL_SUFFIX(zsyrk,ZSYRK) +#define F77_zsyr2k_base F77_GLOBAL_SUFFIX(zsyr2k,ZSYR2K) +#define F77_ztrmm_base F77_GLOBAL_SUFFIX(ztrmm,ZTRMM) +#define F77_ztrsm_base F77_GLOBAL_SUFFIX(ztrsm,ZTRSM) + +/* + * Level 1 Fortran variadic definitions + */ + + +/* Single Precision */ + +#define F77_srot(...) F77_srot_base(__VA_ARGS__) +#define F77_srotg(...) F77_srotg_base(__VA_ARGS__) +#define F77_srotm(...) F77_srotm_base(__VA_ARGS__) +#define F77_srotmg(...) F77_srotmg_base(__VA_ARGS__) +#define F77_sswap(...) F77_sswap_base(__VA_ARGS__) +#define F77_scopy(...) F77_scopy_base(__VA_ARGS__) +#define F77_saxpy(...) F77_saxpy_base(__VA_ARGS__) +#define F77_saxpby(...) F77_saxpby_base(__VA_ARGS__) +#define F77_sdot_sub(...) F77_sdot_sub_base(__VA_ARGS__) +#define F77_sdsdot_sub(...) F77_sdsdot_sub_base(__VA_ARGS__) +#define F77_sscal(...) F77_sscal_base(__VA_ARGS__) +#define F77_snrm2_sub(...) F77_snrm2_sub_base(__VA_ARGS__) +#define F77_sasum_sub(...) F77_sasum_sub_base(__VA_ARGS__) +#define F77_isamax_sub(...) F77_isamax_sub_base(__VA_ARGS__) +#define F77_scabs1_sub(...) F77_scabs1_sub_base(__VA_ARGS__) + +/* Double Precision */ + +#define F77_drot(...) F77_drot_base(__VA_ARGS__) +#define F77_drotg(...) F77_drotg_base(__VA_ARGS__) +#define F77_drotm(...) F77_drotm_base(__VA_ARGS__) +#define F77_drotmg(...) F77_drotmg_base(__VA_ARGS__) +#define F77_dswap(...) F77_dswap_base(__VA_ARGS__) +#define F77_dcopy(...) F77_dcopy_base(__VA_ARGS__) +#define F77_daxpy(...) F77_daxpy_base(__VA_ARGS__) +#define F77_daxpby(...) F77_daxpby_base(__VA_ARGS__) +#define F77_dswap(...) F77_dswap_base(__VA_ARGS__) +#define F77_dsdot_sub(...) F77_dsdot_sub_base(__VA_ARGS__) +#define F77_ddot_sub(...) F77_ddot_sub_base(__VA_ARGS__) +#define F77_dscal(...) F77_dscal_base(__VA_ARGS__) +#define F77_dnrm2_sub(...) F77_dnrm2_sub_base(__VA_ARGS__) +#define F77_dasum_sub(...) F77_dasum_sub_base(__VA_ARGS__) +#define F77_idamax_sub(...) F77_idamax_sub_base(__VA_ARGS__) +#define F77_dcabs1_sub(...) F77_dcabs1_sub_base(__VA_ARGS__) + +/* Single Complex Precision */ + +#define F77_crotg(...) F77_crotg_base(__VA_ARGS__) +#define F77_csrot(...) F77_csrot_base(__VA_ARGS__) +#define F77_cswap(...) F77_cswap_base(__VA_ARGS__) +#define F77_ccopy(...) F77_ccopy_base(__VA_ARGS__) +#define F77_caxpy(...) F77_caxpy_base(__VA_ARGS__) +#define F77_caxpby(...) F77_caxpby_base(__VA_ARGS__) +#define F77_cswap(...) F77_cswap_base(__VA_ARGS__) +#define F77_cdotc_sub(...) F77_cdotc_sub_base(__VA_ARGS__) +#define F77_cdotu_sub(...) F77_cdotu_sub_base(__VA_ARGS__) +#define F77_cscal(...) F77_cscal_base(__VA_ARGS__) +#define F77_icamax_sub(...) F77_icamax_sub_base(__VA_ARGS__) +#define F77_csscal(...) F77_csscal_base(__VA_ARGS__) +#define F77_scnrm2_sub(...) F77_scnrm2_sub_base(__VA_ARGS__) +#define F77_scasum_sub(...) F77_scasum_sub_base(__VA_ARGS__) + +/* Double Complex Precision */ + +#define F77_zrotg(...) F77_zrotg_base(__VA_ARGS__) +#define F77_zdrot(...) F77_zdrot_base(__VA_ARGS__) +#define F77_zswap(...) F77_zswap_base(__VA_ARGS__) +#define F77_zcopy(...) F77_zcopy_base(__VA_ARGS__) +#define F77_zaxpy(...) F77_zaxpy_base(__VA_ARGS__) +#define F77_zaxpby(...) F77_zaxpby_base(__VA_ARGS__) +#define F77_zswap(...) F77_zswap_base(__VA_ARGS__) +#define F77_zdotc_sub(...) F77_zdotc_sub_base(__VA_ARGS__) +#define F77_zdotu_sub(...) F77_zdotu_sub_base(__VA_ARGS__) +#define F77_zdscal(...) F77_zdscal_base(__VA_ARGS__) +#define F77_zscal(...) F77_zscal_base(__VA_ARGS__) +#define F77_dznrm2_sub(...) F77_dznrm2_sub_base(__VA_ARGS__) +#define F77_dzasum_sub(...) F77_dzasum_sub_base(__VA_ARGS__) +#define F77_izamax_sub(...) F77_izamax_sub_base(__VA_ARGS__) + +/* + * Level 2 Fortran variadic definitions without FCHAR + */ + +#define F77_sger(...) F77_sger_base(__VA_ARGS__) +#define F77_dger(...) F77_dger_base(__VA_ARGS__) +#define F77_cgerc(...) F77_cgerc_base(__VA_ARGS__) +#define F77_cgeru(...) F77_cgeru_base(__VA_ARGS__) +#define F77_zgerc(...) F77_zgerc_base(__VA_ARGS__) +#define F77_zgeru(...) F77_zgeru_base(__VA_ARGS__) + +#ifdef BLAS_FORTRAN_STRLEN_END + + /* + * Level 2 Fortran variadic definitions with BLAS_FORTRAN_STRLEN_END + */ + + /* Single Precision */ + + #define F77_sgemv(...) F77_sgemv_base(__VA_ARGS__, 1) + #define F77_sgbmv(...) F77_sgbmv_base(__VA_ARGS__, 1) + #define F77_ssymv(...) F77_ssymv_base(__VA_ARGS__, 1) + #define F77_ssbmv(...) F77_ssbmv_base(__VA_ARGS__, 1) + #define F77_sspmv(...) F77_sspmv_base(__VA_ARGS__, 1) + #define F77_sskewsymv(...) F77_sskewsymv_base(__VA_ARGS__, 1) + #define F77_strmv(...) F77_strmv_base(__VA_ARGS__, 1, 1, 1) + #define F77_stbmv(...) F77_stbmv_base(__VA_ARGS__, 1, 1, 1) + #define F77_strsv(...) F77_strsv_base(__VA_ARGS__, 1, 1, 1) + #define F77_stbsv(...) F77_stbsv_base(__VA_ARGS__, 1, 1, 1) + #define F77_stpmv(...) F77_stpmv_base(__VA_ARGS__, 1, 1, 1) + #define F77_stpsv(...) F77_stpsv_base(__VA_ARGS__, 1, 1, 1) + #define F77_ssyr(...) F77_ssyr_base(__VA_ARGS__, 1) + #define F77_sspr(...) F77_sspr_base(__VA_ARGS__, 1) + #define F77_sspr2(...) F77_sspr2_base(__VA_ARGS__, 1) + #define F77_ssyr2(...) F77_ssyr2_base(__VA_ARGS__, 1) + #define F77_sskewsyr2(...) F77_sskewsyr2_base(__VA_ARGS__, 1) + + /* Double Precision */ + + #define F77_dgemv(...) F77_dgemv_base(__VA_ARGS__, 1) + #define F77_dgbmv(...) F77_dgbmv_base(__VA_ARGS__, 1) + #define F77_dsymv(...) F77_dsymv_base(__VA_ARGS__, 1) + #define F77_dsbmv(...) F77_dsbmv_base(__VA_ARGS__, 1) + #define F77_dspmv(...) F77_dspmv_base(__VA_ARGS__, 1) + #define F77_dskewsymv(...) F77_dskewsymv_base(__VA_ARGS__, 1) + #define F77_dtrmv(...) F77_dtrmv_base(__VA_ARGS__, 1, 1, 1) + #define F77_dtbmv(...) F77_dtbmv_base(__VA_ARGS__, 1, 1, 1) + #define F77_dtrsv(...) F77_dtrsv_base(__VA_ARGS__, 1, 1, 1) + #define F77_dtbsv(...) F77_dtbsv_base(__VA_ARGS__, 1, 1, 1) + #define F77_dtpmv(...) F77_dtpmv_base(__VA_ARGS__, 1, 1, 1) + #define F77_dtpsv(...) F77_dtpsv_base(__VA_ARGS__, 1, 1, 1) + #define F77_dsyr(...) F77_dsyr_base(__VA_ARGS__, 1) + #define F77_dspr(...) F77_dspr_base(__VA_ARGS__, 1) + #define F77_dspr2(...) F77_dspr2_base(__VA_ARGS__, 1) + #define F77_dsyr2(...) F77_dsyr2_base(__VA_ARGS__, 1) + #define F77_dskewsyr2(...) F77_dskewsyr2_base(__VA_ARGS__, 1) + + /* Single Complex Precision */ + + #define F77_cgemv(...) F77_cgemv_base(__VA_ARGS__, 1) + #define F77_cgbmv(...) F77_cgbmv_base(__VA_ARGS__, 1) + #define F77_chemv(...) F77_chemv_base(__VA_ARGS__, 1) + #define F77_chbmv(...) F77_chbmv_base(__VA_ARGS__, 1) + #define F77_chpmv(...) F77_chpmv_base(__VA_ARGS__, 1) + #define F77_ctrmv(...) F77_ctrmv_base(__VA_ARGS__, 1, 1, 1) + #define F77_ctbmv(...) F77_ctbmv_base(__VA_ARGS__, 1, 1, 1) + #define F77_ctpmv(...) F77_ctpmv_base(__VA_ARGS__, 1, 1, 1) + #define F77_ctrsv(...) F77_ctrsv_base(__VA_ARGS__, 1, 1, 1) + #define F77_ctbsv(...) F77_ctbsv_base(__VA_ARGS__, 1, 1, 1) + #define F77_ctpsv(...) F77_ctpsv_base(__VA_ARGS__, 1, 1, 1) + #define F77_cher(...) F77_cher_base(__VA_ARGS__, 1) + #define F77_cher2(...) F77_cher2_base(__VA_ARGS__, 1) + #define F77_chpr(...) F77_chpr_base(__VA_ARGS__, 1) + #define F77_chpr2(...) F77_chpr2_base(__VA_ARGS__, 1) + + /* Double Complex Precision */ + + #define F77_zgemv(...) F77_zgemv_base(__VA_ARGS__, 1) + #define F77_zgbmv(...) F77_zgbmv_base(__VA_ARGS__, 1) + #define F77_zhemv(...) F77_zhemv_base(__VA_ARGS__, 1) + #define F77_zhbmv(...) F77_zhbmv_base(__VA_ARGS__, 1) + #define F77_zhpmv(...) F77_zhpmv_base(__VA_ARGS__, 1) + #define F77_ztrmv(...) F77_ztrmv_base(__VA_ARGS__, 1, 1, 1) + #define F77_ztbmv(...) F77_ztbmv_base(__VA_ARGS__, 1, 1, 1) + #define F77_ztpmv(...) F77_ztpmv_base(__VA_ARGS__, 1, 1, 1) + #define F77_ztrsv(...) F77_ztrsv_base(__VA_ARGS__, 1, 1, 1) + #define F77_ztbsv(...) F77_ztbsv_base(__VA_ARGS__, 1, 1, 1) + #define F77_ztpsv(...) F77_ztpsv_base(__VA_ARGS__, 1, 1, 1) + #define F77_zher(...) F77_zher_base(__VA_ARGS__, 1) + #define F77_zher2(...) F77_zher2_base(__VA_ARGS__, 1) + #define F77_zhpr(...) F77_zhpr_base(__VA_ARGS__, 1) + #define F77_zhpr2(...) F77_zhpr2_base(__VA_ARGS__, 1) + + /* + * Level 3 Fortran variadic definitions with BLAS_FORTRAN_STRLEN_END + */ + + /* Single Precision */ + + #define F77_sgemm(...) F77_sgemm_base(__VA_ARGS__, 1, 1) + #define F77_sgemmtr(...) F77_sgemmtr_base(__VA_ARGS__, 1, 1, 1) + #define F77_ssymm(...) F77_ssymm_base(__VA_ARGS__, 1, 1) + #define F77_sskewsymm(...) F77_sskewsymm_base(__VA_ARGS__, 1, 1) + #define F77_ssyrk(...) F77_ssyrk_base(__VA_ARGS__, 1, 1) + #define F77_ssyr2k(...) F77_ssyr2k_base(__VA_ARGS__, 1, 1) + #define F77_sskewsyr2k(...) F77_sskewsyr2k_base(__VA_ARGS__, 1, 1) + #define F77_strmm(...) F77_strmm_base(__VA_ARGS__, 1, 1, 1, 1) + #define F77_strsm(...) F77_strsm_base(__VA_ARGS__, 1, 1, 1, 1) + + /* Double Precision */ + + #define F77_dgemm(...) F77_dgemm_base(__VA_ARGS__, 1, 1) + #define F77_dgemmtr(...) F77_dgemmtr_base(__VA_ARGS__, 1, 1, 1) + #define F77_dsymm(...) F77_dsymm_base(__VA_ARGS__, 1, 1) + #define F77_dskewsymm(...) F77_dskewsymm_base(__VA_ARGS__, 1, 1) + #define F77_dsyrk(...) F77_dsyrk_base(__VA_ARGS__, 1, 1) + #define F77_dsyr2k(...) F77_dsyr2k_base(__VA_ARGS__, 1, 1) + #define F77_dskewsyr2k(...) F77_dskewsyr2k_base(__VA_ARGS__, 1, 1) + #define F77_dtrmm(...) F77_dtrmm_base(__VA_ARGS__, 1, 1, 1, 1) + #define F77_dtrsm(...) F77_dtrsm_base(__VA_ARGS__, 1, 1, 1, 1) + + /* Single Complex Precision */ + + #define F77_cgemm(...) F77_cgemm_base(__VA_ARGS__, 1, 1) + #define F77_cgemmtr(...) F77_cgemmtr_base(__VA_ARGS__, 1, 1, 1) + #define F77_csymm(...) F77_csymm_base(__VA_ARGS__, 1, 1) + #define F77_chemm(...) F77_chemm_base(__VA_ARGS__, 1, 1) + #define F77_csyrk(...) F77_csyrk_base(__VA_ARGS__, 1, 1) + #define F77_cherk(...) F77_cherk_base(__VA_ARGS__, 1, 1) + #define F77_csyr2k(...) F77_csyr2k_base(__VA_ARGS__, 1, 1) + #define F77_cher2k(...) F77_cher2k_base(__VA_ARGS__, 1, 1) + #define F77_ctrmm(...) F77_ctrmm_base(__VA_ARGS__, 1, 1, 1, 1) + #define F77_ctrsm(...) F77_ctrsm_base(__VA_ARGS__, 1, 1, 1, 1) + + /* Double Complex Precision */ + + #define F77_zgemm(...) F77_zgemm_base(__VA_ARGS__, 1, 1) + #define F77_zgemmtr(...) F77_zgemmtr_base(__VA_ARGS__, 1, 1, 1) + #define F77_zsymm(...) F77_zsymm_base(__VA_ARGS__, 1, 1) + #define F77_zhemm(...) F77_zhemm_base(__VA_ARGS__, 1, 1) + #define F77_zsyrk(...) F77_zsyrk_base(__VA_ARGS__, 1, 1) + #define F77_zherk(...) F77_zherk_base(__VA_ARGS__, 1, 1) + #define F77_zsyr2k(...) F77_zsyr2k_base(__VA_ARGS__, 1, 1) + #define F77_zher2k(...) F77_zher2k_base(__VA_ARGS__, 1, 1) + #define F77_ztrmm(...) F77_ztrmm_base(__VA_ARGS__, 1, 1, 1, 1) + #define F77_ztrsm(...) F77_ztrsm_base(__VA_ARGS__, 1, 1, 1, 1) + +#else + + /* + * Level 2 Fortran variadic definitions without BLAS_FORTRAN_STRLEN_END + */ + + /* Single Precision */ + + #define F77_sgemv(...) F77_sgemv_base(__VA_ARGS__) + #define F77_sgbmv(...) F77_sgbmv_base(__VA_ARGS__) + #define F77_ssymv(...) F77_ssymv_base(__VA_ARGS__) + #define F77_ssbmv(...) F77_ssbmv_base(__VA_ARGS__) + #define F77_sspmv(...) F77_sspmv_base(__VA_ARGS__) + #define F77_sskewsymv(...) F77_sskewsymv_base(__VA_ARGS__) + #define F77_strmv(...) F77_strmv_base(__VA_ARGS__) + #define F77_stbmv(...) F77_stbmv_base(__VA_ARGS__) + #define F77_strsv(...) F77_strsv_base(__VA_ARGS__) + #define F77_stbsv(...) F77_stbsv_base(__VA_ARGS__) + #define F77_stpmv(...) F77_stpmv_base(__VA_ARGS__) + #define F77_stpsv(...) F77_stpsv_base(__VA_ARGS__) + #define F77_ssyr(...) F77_ssyr_base(__VA_ARGS__) + #define F77_sspr(...) F77_sspr_base(__VA_ARGS__) + #define F77_sspr2(...) F77_sspr2_base(__VA_ARGS__) + #define F77_ssyr2(...) F77_ssyr2_base(__VA_ARGS__) + #define F77_sskewsyr2(...) F77_sskewsyr2_base(__VA_ARGS__) + + /* Double Precision */ + + #define F77_dgemv(...) F77_dgemv_base(__VA_ARGS__) + #define F77_dgbmv(...) F77_dgbmv_base(__VA_ARGS__) + #define F77_dsymv(...) F77_dsymv_base(__VA_ARGS__) + #define F77_dsbmv(...) F77_dsbmv_base(__VA_ARGS__) + #define F77_dspmv(...) F77_dspmv_base(__VA_ARGS__) + #define F77_dskewsymv(...) F77_dskewsymv_base(__VA_ARGS__) + #define F77_dtrmv(...) F77_dtrmv_base(__VA_ARGS__) + #define F77_dtbmv(...) F77_dtbmv_base(__VA_ARGS__) + #define F77_dtrsv(...) F77_dtrsv_base(__VA_ARGS__) + #define F77_dtbsv(...) F77_dtbsv_base(__VA_ARGS__) + #define F77_dtpmv(...) F77_dtpmv_base(__VA_ARGS__) + #define F77_dtpsv(...) F77_dtpsv_base(__VA_ARGS__) + #define F77_dsyr(...) F77_dsyr_base(__VA_ARGS__) + #define F77_dspr(...) F77_dspr_base(__VA_ARGS__) + #define F77_dspr2(...) F77_dspr2_base(__VA_ARGS__) + #define F77_dsyr2(...) F77_dsyr2_base(__VA_ARGS__) + #define F77_dskewsyr2(...) F77_dskewsyr2_base(__VA_ARGS__) + + /* Single Complex Precision */ + + #define F77_cgemv(...) F77_cgemv_base(__VA_ARGS__) + #define F77_cgbmv(...) F77_cgbmv_base(__VA_ARGS__) + #define F77_chemv(...) F77_chemv_base(__VA_ARGS__) + #define F77_chbmv(...) F77_chbmv_base(__VA_ARGS__) + #define F77_chpmv(...) F77_chpmv_base(__VA_ARGS__) + #define F77_ctrmv(...) F77_ctrmv_base(__VA_ARGS__) + #define F77_ctbmv(...) F77_ctbmv_base(__VA_ARGS__) + #define F77_ctpmv(...) F77_ctpmv_base(__VA_ARGS__) + #define F77_ctrsv(...) F77_ctrsv_base(__VA_ARGS__) + #define F77_ctbsv(...) F77_ctbsv_base(__VA_ARGS__) + #define F77_ctpsv(...) F77_ctpsv_base(__VA_ARGS__) + #define F77_cher(...) F77_cher_base(__VA_ARGS__) + #define F77_cher2(...) F77_cher2_base(__VA_ARGS__) + #define F77_chpr(...) F77_chpr_base(__VA_ARGS__) + #define F77_chpr2(...) F77_chpr2_base(__VA_ARGS__) + + /* Double Complex Precision */ + + #define F77_zgemv(...) F77_zgemv_base(__VA_ARGS__) + #define F77_zgbmv(...) F77_zgbmv_base(__VA_ARGS__) + #define F77_zhemv(...) F77_zhemv_base(__VA_ARGS__) + #define F77_zhbmv(...) F77_zhbmv_base(__VA_ARGS__) + #define F77_zhpmv(...) F77_zhpmv_base(__VA_ARGS__) + #define F77_ztrmv(...) F77_ztrmv_base(__VA_ARGS__) + #define F77_ztbmv(...) F77_ztbmv_base(__VA_ARGS__) + #define F77_ztpmv(...) F77_ztpmv_base(__VA_ARGS__) + #define F77_ztrsv(...) F77_ztrsv_base(__VA_ARGS__) + #define F77_ztbsv(...) F77_ztbsv_base(__VA_ARGS__) + #define F77_ztpsv(...) F77_ztpsv_base(__VA_ARGS__) + #define F77_zher(...) F77_zher_base(__VA_ARGS__) + #define F77_zher2(...) F77_zher2_base(__VA_ARGS__) + #define F77_zhpr(...) F77_zhpr_base(__VA_ARGS__) + #define F77_zhpr2(...) F77_zhpr2_base(__VA_ARGS__) + + /* + * Level 3 Fortran variadic definitions without BLAS_FORTRAN_STRLEN_END + */ + + /* Single Precision */ + + #define F77_sgemm(...) F77_sgemm_base(__VA_ARGS__) + #define F77_sgemmtr(...) F77_sgemmtr_base(__VA_ARGS__) + #define F77_ssymm(...) F77_ssymm_base(__VA_ARGS__) + #define F77_sskewsymm(...) F77_sskewsymm_base(__VA_ARGS__) + #define F77_ssyrk(...) F77_ssyrk_base(__VA_ARGS__) + #define F77_ssyr2k(...) F77_ssyr2k_base(__VA_ARGS__) + #define F77_sskewsyr2k(...) F77_sskewsyr2k_base(__VA_ARGS__) + #define F77_strmm(...) F77_strmm_base(__VA_ARGS__) + #define F77_strsm(...) F77_strsm_base(__VA_ARGS__) + + /* Double Precision */ + + #define F77_dgemm(...) F77_dgemm_base(__VA_ARGS__) + #define F77_dgemmtr(...) F77_dgemmtr_base(__VA_ARGS__) + #define F77_dsymm(...) F77_dsymm_base(__VA_ARGS__) + #define F77_dskewsymm(...) F77_dskewsymm_base(__VA_ARGS__) + #define F77_dsyrk(...) F77_dsyrk_base(__VA_ARGS__) + #define F77_dsyr2k(...) F77_dsyr2k_base(__VA_ARGS__) + #define F77_dskewsyr2k(...) F77_dskewsyr2k_base(__VA_ARGS__) + #define F77_dtrmm(...) F77_dtrmm_base(__VA_ARGS__) + #define F77_dtrsm(...) F77_dtrsm_base(__VA_ARGS__) + + /* Single Complex Precision */ + + #define F77_cgemm(...) F77_cgemm_base(__VA_ARGS__) + #define F77_cgemmtr(...) F77_cgemmtr_base(__VA_ARGS__) + #define F77_csymm(...) F77_csymm_base(__VA_ARGS__) + #define F77_chemm(...) F77_chemm_base(__VA_ARGS__) + #define F77_csyrk(...) F77_csyrk_base(__VA_ARGS__) + #define F77_cherk(...) F77_cherk_base(__VA_ARGS__) + #define F77_csyr2k(...) F77_csyr2k_base(__VA_ARGS__) + #define F77_cher2k(...) F77_cher2k_base(__VA_ARGS__) + #define F77_ctrmm(...) F77_ctrmm_base(__VA_ARGS__) + #define F77_ctrsm(...) F77_ctrsm_base(__VA_ARGS__) + + /* Double Complex Precision */ + + #define F77_zgemm(...) F77_zgemm_base(__VA_ARGS__) + #define F77_zgemmtr(...) F77_zgemmtr_base(__VA_ARGS__) + #define F77_zsymm(...) F77_zsymm_base(__VA_ARGS__) + #define F77_zhemm(...) F77_zhemm_base(__VA_ARGS__) + #define F77_zsyrk(...) F77_zsyrk_base(__VA_ARGS__) + #define F77_zherk(...) F77_zherk_base(__VA_ARGS__) + #define F77_zsyr2k(...) F77_zsyr2k_base(__VA_ARGS__) + #define F77_zher2k(...) F77_zher2k_base(__VA_ARGS__) + #define F77_ztrmm(...) F77_ztrmm_base(__VA_ARGS__) + #define F77_ztrsm(...) F77_ztrsm_base(__VA_ARGS__) + +#endif + +/* + * Base function prototypes + */ #ifdef __cplusplus extern "C" { #endif -void F77_xerbla(FCHAR, void *); +#ifdef BLAS_FORTRAN_STRLEN_END + #define F77_xerbla(...) F77_xerbla_base(__VA_ARGS__, 1) +#else + #define F77_xerbla(...) F77_xerbla_base(__VA_ARGS__) +#endif +void CBLAS_WEAK_SYMBOL F77_xerbla_base(FCHAR, void * +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); + /* * Level 1 Fortran Prototypes */ /* Single Precision */ - void F77_srot(FINT, float *, FINT, float *, FINT, const float *, const float *); - void F77_srotg(float *,float *,float *,float *); - void F77_srotm( FINT, float *, FINT, float *, FINT, const float *); - void F77_srotmg(float *,float *,float *,const float *, float *); - void F77_sswap( FINT, float *, FINT, float *, FINT); - void F77_scopy( FINT, const float *, FINT, float *, FINT); - void F77_saxpy( FINT, const float *, const float *, FINT, float *, FINT); - void F77_sdot_sub(FINT, const float *, FINT, const float *, FINT, float *); - void F77_sdsdot_sub( FINT, const float *, const float *, FINT, const float *, FINT, float *); - void F77_sscal( FINT, const float *, float *, FINT); - void F77_snrm2_sub( FINT, const float *, FINT, float *); - void F77_sasum_sub( FINT, const float *, FINT, float *); - void F77_isamax_sub( FINT, const float * , FINT, FINT2); +void F77_srot_base(FINT, float *, FINT, float *, FINT, const float *, const float *); +void F77_srotg_base(float *,float *,float *,float *); +void F77_srotm_base(FINT, float *, FINT, float *, FINT, const float *); +void F77_srotmg_base(float *,float *,float *,const float *, float *); +void F77_sswap_base(FINT, float *, FINT, float *, FINT); +void F77_scopy_base(FINT, const float *, FINT, float *, FINT); +void F77_saxpy_base(FINT, const float *, const float *, FINT, float *, FINT); +void F77_saxpby_base(FINT, const float *, const float *, FINT, const float *, float *, FINT); +void F77_sdot_sub_base(FINT, const float *, FINT, const float *, FINT, float *); +void F77_sdsdot_sub_base(FINT, const float *, const float *, FINT, const float *, FINT, float *); +void F77_sscal_base(FINT, const float *, float *, FINT); +void F77_snrm2_sub_base(FINT, const float *, FINT, float *); +void F77_sasum_sub_base(FINT, const float *, FINT, float *); +void F77_isamax_sub_base(FINT, const float * , FINT, FINT2); /* Double Precision */ - void F77_drot(FINT, double *, FINT, double *, FINT, const double *, const double *); - void F77_drotg(double *,double *,double *,double *); - void F77_drotm( FINT, double *, FINT, double *, FINT, const double *); - void F77_drotmg(double *,double *,double *,const double *, double *); - void F77_dswap( FINT, double *, FINT, double *, FINT); - void F77_dcopy( FINT, const double *, FINT, double *, FINT); - void F77_daxpy( FINT, const double *, const double *, FINT, double *, FINT); - void F77_dswap( FINT, double *, FINT, double *, FINT); - void F77_dsdot_sub(FINT, const float *, FINT, const float *, FINT, double *); - void F77_ddot_sub( FINT, const double *, FINT, const double *, FINT, double *); - void F77_dscal( FINT, const double *, double *, FINT); - void F77_dnrm2_sub( FINT, const double *, FINT, double *); - void F77_dasum_sub( FINT, const double *, FINT, double *); - void F77_idamax_sub( FINT, const double * , FINT, FINT2); +void F77_drot_base(FINT, double *, FINT, double *, FINT, const double *, const double *); +void F77_drotg_base(double *,double *,double *,double *); +void F77_drotm_base(FINT, double *, FINT, double *, FINT, const double *); +void F77_drotmg_base(double *,double *,double *,const double *, double *); +void F77_dswap_base(FINT, double *, FINT, double *, FINT); +void F77_dcopy_base(FINT, const double *, FINT, double *, FINT); +void F77_daxpy_base(FINT, const double *, const double *, FINT, double *, FINT); +void F77_daxpby_base(FINT, const double *, const double *, FINT, const double *, double *, FINT); +void F77_dswap_base(FINT, double *, FINT, double *, FINT); +void F77_dsdot_sub_base(FINT, const float *, FINT, const float *, FINT, double *); +void F77_ddot_sub_base(FINT, const double *, FINT, const double *, FINT, double *); +void F77_dscal_base(FINT, const double *, double *, FINT); +void F77_dnrm2_sub_base(FINT, const double *, FINT, double *); +void F77_dasum_sub_base(FINT, const double *, FINT, double *); +void F77_idamax_sub_base(FINT, const double * , FINT, FINT2); /* Single Complex Precision */ - void F77_cswap( FINT, void *, FINT, void *, FINT); - void F77_ccopy( FINT, const void *, FINT, void *, FINT); - void F77_caxpy( FINT, const void *, const void *, FINT, void *, FINT); - void F77_cswap( FINT, void *, FINT, void *, FINT); - void F77_cdotc_sub( FINT, const void *, FINT, const void *, FINT, void *); - void F77_cdotu_sub( FINT, const void *, FINT, const void *, FINT, void *); - void F77_cscal( FINT, const void *, void *, FINT); - void F77_icamax_sub( FINT, const void *, FINT, FINT2); - void F77_csscal( FINT, const float *, void *, FINT); - void F77_scnrm2_sub( FINT, const void *, FINT, float *); - void F77_scasum_sub( FINT, const void *, FINT, float *); +void F77_crotg_base(void *, void *, float *, void *); +void F77_csrot_base(FINT, void *X, FINT, void *, FINT, const float *, const float *); +void F77_cswap_base(FINT, void *, FINT, void *, FINT); +void F77_ccopy_base(FINT, const void *, FINT, void *, FINT); +void F77_caxpy_base(FINT, const void *, const void *, FINT, void *, FINT); +void F77_caxpby_base(FINT, const void *, const void *, FINT, const void *, void *, FINT); +void F77_cswap_base(FINT, void *, FINT, void *, FINT); +void F77_cdotc_sub_base(FINT, const void *, FINT, const void *, FINT, void *); +void F77_cdotu_sub_base(FINT, const void *, FINT, const void *, FINT, void *); +void F77_cscal_base(FINT, const void *, void *, FINT); +void F77_icamax_sub_base(FINT, const void *, FINT, FINT2); +void F77_csscal_base(FINT, const float *, void *, FINT); +void F77_scnrm2_sub_base(FINT, const void *, FINT, float *); +void F77_scasum_sub_base(FINT, const void *, FINT, float *); +void F77_scabs1_sub_base(const void *, float *); /* Double Complex Precision */ - void F77_zswap( FINT, void *, FINT, void *, FINT); - void F77_zcopy( FINT, const void *, FINT, void *, FINT); - void F77_zaxpy( FINT, const void *, const void *, FINT, void *, FINT); - void F77_zswap( FINT, void *, FINT, void *, FINT); - void F77_zdotc_sub( FINT, const void *, FINT, const void *, FINT, void *); - void F77_zdotu_sub( FINT, const void *, FINT, const void *, FINT, void *); - void F77_zdscal( FINT, const double *, void *, FINT); - void F77_zscal( FINT, const void *, void *, FINT); - void F77_dznrm2_sub( FINT, const void *, FINT, double *); - void F77_dzasum_sub( FINT, const void *, FINT, double *); - void F77_izamax_sub( FINT, const void *, FINT, FINT2); +void F77_zrotg_base(void *, void *, double *, void *); +void F77_zdrot_base(FINT, void *X, FINT, void *, FINT, const double *, const double *); +void F77_zswap_base(FINT, void *, FINT, void *, FINT); +void F77_zcopy_base(FINT, const void *, FINT, void *, FINT); +void F77_zaxpy_base(FINT, const void *, const void *, FINT, void *, FINT); +void F77_zaxpby_base(FINT, const void *, const void *, FINT, const void*, void *, FINT); +void F77_zswap_base(FINT, void *, FINT, void *, FINT); +void F77_zdotc_sub_base(FINT, const void *, FINT, const void *, FINT, void *); +void F77_zdotu_sub_base(FINT, const void *, FINT, const void *, FINT, void *); +void F77_zdscal_base(FINT, const double *, void *, FINT); +void F77_zscal_base(FINT, const void *, void *, FINT); +void F77_dznrm2_sub_base(FINT, const void *, FINT, double *); +void F77_dzasum_sub_base(FINT, const void *, FINT, double *); +void F77_izamax_sub_base(FINT, const void *, FINT, FINT2); +void F77_dcabs1_sub_base(const void *, double *); /* * Level 2 Fortran Prototypes @@ -265,81 +711,341 @@ void F77_xerbla(FCHAR, void *); /* Single Precision */ - void F77_sgemv(FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT); - void F77_sgbmv(FCHAR, FINT, FINT, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT); - void F77_ssymv(FCHAR, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT); - void F77_ssbmv(FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT); - void F77_sspmv(FCHAR, FINT, const float *, const float *, const float *, FINT, const float *, float *, FINT); - void F77_strmv( FCHAR, FCHAR, FCHAR, FINT, const float *, FINT, float *, FINT); - void F77_stbmv( FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, FINT, float *, FINT); - void F77_strsv( FCHAR, FCHAR, FCHAR, FINT, const float *, FINT, float *, FINT); - void F77_stbsv( FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, FINT, float *, FINT); - void F77_stpmv( FCHAR, FCHAR, FCHAR, FINT, const float *, float *, FINT); - void F77_stpsv( FCHAR, FCHAR, FCHAR, FINT, const float *, float *, FINT); - void F77_sger( FINT, FINT, const float *, const float *, FINT, const float *, FINT, float *, FINT); - void F77_ssyr(FCHAR, FINT, const float *, const float *, FINT, float *, FINT); - void F77_sspr(FCHAR, FINT, const float *, const float *, FINT, float *); - void F77_sspr2(FCHAR, FINT, const float *, const float *, FINT, const float *, FINT, float *); - void F77_ssyr2(FCHAR, FINT, const float *, const float *, FINT, const float *, FINT, float *, FINT); +void F77_sgemv_base(FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_sgbmv_base(FCHAR, FINT, FINT, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_ssymv_base(FCHAR, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_ssbmv_base(FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_sspmv_base(FCHAR, FINT, const float *, const float *, const float *, FINT, const float *, float *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_sskewsymv_base(FCHAR, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_strmv_base(FCHAR, FCHAR, FCHAR, FINT, const float *, FINT, float *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_stbmv_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, FINT, float *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_strsv_base(FCHAR, FCHAR, FCHAR, FINT, const float *, FINT, float *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_stbsv_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, FINT, float *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_stpmv_base(FCHAR, FCHAR, FCHAR, FINT, const float *, float *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_stpsv_base(FCHAR, FCHAR, FCHAR, FINT, const float *, float *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_sger_base(FINT, FINT, const float *, const float *, FINT, const float *, FINT, float *, FINT); +void F77_ssyr_base(FCHAR, FINT, const float *, const float *, FINT, float *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_sspr_base(FCHAR, FINT, const float *, const float *, FINT, float * +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_sspr2_base(FCHAR, FINT, const float *, const float *, FINT, const float *, FINT, float * +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_ssyr2_base(FCHAR, FINT, const float *, const float *, FINT, const float *, FINT, float *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_sskewsyr2_base(FCHAR, FINT, const float *, const float *, FINT, const float *, FINT, float *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); /* Double Precision */ - void F77_dgemv(FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT); - void F77_dgbmv(FCHAR, FINT, FINT, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT); - void F77_dsymv(FCHAR, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT); - void F77_dsbmv(FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT); - void F77_dspmv(FCHAR, FINT, const double *, const double *, const double *, FINT, const double *, double *, FINT); - void F77_dtrmv( FCHAR, FCHAR, FCHAR, FINT, const double *, FINT, double *, FINT); - void F77_dtbmv( FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, FINT, double *, FINT); - void F77_dtrsv( FCHAR, FCHAR, FCHAR, FINT, const double *, FINT, double *, FINT); - void F77_dtbsv( FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, FINT, double *, FINT); - void F77_dtpmv( FCHAR, FCHAR, FCHAR, FINT, const double *, double *, FINT); - void F77_dtpsv( FCHAR, FCHAR, FCHAR, FINT, const double *, double *, FINT); - void F77_dger( FINT, FINT, const double *, const double *, FINT, const double *, FINT, double *, FINT); - void F77_dsyr(FCHAR, FINT, const double *, const double *, FINT, double *, FINT); - void F77_dspr(FCHAR, FINT, const double *, const double *, FINT, double *); - void F77_dspr2(FCHAR, FINT, const double *, const double *, FINT, const double *, FINT, double *); - void F77_dsyr2(FCHAR, FINT, const double *, const double *, FINT, const double *, FINT, double *, FINT); +void F77_dgemv_base(FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_dgbmv_base(FCHAR, FINT, FINT, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_dsymv_base(FCHAR, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_dsbmv_base(FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_dspmv_base(FCHAR, FINT, const double *, const double *, const double *, FINT, const double *, double *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_dskewsymv_base(FCHAR, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_dtrmv_base(FCHAR, FCHAR, FCHAR, FINT, const double *, FINT, double *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_dtbmv_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, FINT, double *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_dtrsv_base(FCHAR, FCHAR, FCHAR, FINT, const double *, FINT, double *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_dtbsv_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, FINT, double *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_dtpmv_base(FCHAR, FCHAR, FCHAR, FINT, const double *, double *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_dtpsv_base(FCHAR, FCHAR, FCHAR, FINT, const double *, double *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_dger_base(FINT, FINT, const double *, const double *, FINT, const double *, FINT, double *, FINT); +void F77_dsyr_base(FCHAR, FINT, const double *, const double *, FINT, double *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_dspr_base(FCHAR, FINT, const double *, const double *, FINT, double * +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_dspr2_base(FCHAR, FINT, const double *, const double *, FINT, const double *, FINT, double * +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_dsyr2_base(FCHAR, FINT, const double *, const double *, FINT, const double *, FINT, double *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_dskewsyr2_base(FCHAR, FINT, const double *, const double *, FINT, const double *, FINT, double *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); /* Single Complex Precision */ - void F77_cgemv(FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT); - void F77_cgbmv(FCHAR, FINT, FINT, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT); - void F77_chemv(FCHAR, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT); - void F77_chbmv(FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT); - void F77_chpmv(FCHAR, FINT, const void *, const void *, const void *, FINT, const void *, void *, FINT); - void F77_ctrmv( FCHAR, FCHAR, FCHAR, FINT, const void *, FINT, void *, FINT); - void F77_ctbmv( FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, FINT, void *, FINT); - void F77_ctpmv( FCHAR, FCHAR, FCHAR, FINT, const void *, void *, FINT); - void F77_ctrsv( FCHAR, FCHAR, FCHAR, FINT, const void *, FINT, void *, FINT); - void F77_ctbsv( FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, FINT, void *, FINT); - void F77_ctpsv( FCHAR, FCHAR, FCHAR, FINT, const void *, void *,FINT); - void F77_cgerc( FINT, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT); - void F77_cgeru( FINT, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT); - void F77_cher(FCHAR, FINT, const float *, const void *, FINT, void *, FINT); - void F77_cher2(FCHAR, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT); - void F77_chpr(FCHAR, FINT, const float *, const void *, FINT, void *); - void F77_chpr2(FCHAR, FINT, const float *, const void *, FINT, const void *, FINT, void *); +void F77_cgemv_base(FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_cgbmv_base(FCHAR, FINT, FINT, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_chemv_base(FCHAR, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_chbmv_base(FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_chpmv_base(FCHAR, FINT, const void *, const void *, const void *, FINT, const void *, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_ctrmv_base(FCHAR, FCHAR, FCHAR, FINT, const void *, FINT, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_ctbmv_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, FINT, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_ctpmv_base(FCHAR, FCHAR, FCHAR, FINT, const void *, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_ctrsv_base(FCHAR, FCHAR, FCHAR, FINT, const void *, FINT, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_ctbsv_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, FINT, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_ctpsv_base(FCHAR, FCHAR, FCHAR, FINT, const void *, void *,FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_cgerc_base(FINT, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT); +void F77_cgeru_base(FINT, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT); +void F77_cher_base(FCHAR, FINT, const float *, const void *, FINT, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_cher2_base(FCHAR, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_chpr_base(FCHAR, FINT, const float *, const void *, FINT, void * +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_chpr2_base(FCHAR, FINT, const void *, const void *, FINT, const void *, FINT, void * +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); /* Double Complex Precision */ - void F77_zgemv(FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT); - void F77_zgbmv(FCHAR, FINT, FINT, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT); - void F77_zhemv(FCHAR, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT); - void F77_zhbmv(FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT); - void F77_zhpmv(FCHAR, FINT, const void *, const void *, const void *, FINT, const void *, void *, FINT); - void F77_ztrmv( FCHAR, FCHAR, FCHAR, FINT, const void *, FINT, void *, FINT); - void F77_ztbmv( FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, FINT, void *, FINT); - void F77_ztpmv( FCHAR, FCHAR, FCHAR, FINT, const void *, void *, FINT); - void F77_ztrsv( FCHAR, FCHAR, FCHAR, FINT, const void *, FINT, void *, FINT); - void F77_ztbsv( FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, FINT, void *, FINT); - void F77_ztpsv( FCHAR, FCHAR, FCHAR, FINT, const void *, void *,FINT); - void F77_zgerc( FINT, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT); - void F77_zgeru( FINT, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT); - void F77_zher(FCHAR, FINT, const double *, const void *, FINT, void *, FINT); - void F77_zher2(FCHAR, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT); - void F77_zhpr(FCHAR, FINT, const double *, const void *, FINT, void *); - void F77_zhpr2(FCHAR, FINT, const double *, const void *, FINT, const void *, FINT, void *); +void F77_zgemv_base(FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_zgbmv_base(FCHAR, FINT, FINT, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_zhemv_base(FCHAR, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_zhbmv_base(FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_zhpmv_base(FCHAR, FINT, const void *, const void *, const void *, FINT, const void *, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_ztrmv_base(FCHAR, FCHAR, FCHAR, FINT, const void *, FINT, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_ztbmv_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, FINT, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_ztpmv_base(FCHAR, FCHAR, FCHAR, FINT, const void *, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_ztrsv_base(FCHAR, FCHAR, FCHAR, FINT, const void *, FINT, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_ztbsv_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, FINT, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_ztpsv_base(FCHAR, FCHAR, FCHAR, FINT, const void *, void *,FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_zgerc_base(FINT, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT); +void F77_zgeru_base(FINT, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT); +void F77_zher_base(FCHAR, FINT, const double *, const void *, FINT, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_zher2_base(FCHAR, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_zhpr_base(FCHAR, FINT, const double *, const void *, FINT, void * +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); +void F77_zhpr2_base(FCHAR, FINT, const void *, const void *, FINT, const void *, FINT, void * +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); /* * Level 3 Fortran Prototypes @@ -347,45 +1053,211 @@ void F77_xerbla(FCHAR, void *); /* Single Precision */ - void F77_sgemm(FCHAR, FCHAR, FINT, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT); - void F77_ssymm(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT); - void F77_ssyrk(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, float *, FINT); - void F77_ssyr2k(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT); - void F77_strmm(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, float *, FINT); - void F77_strsm(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, float *, FINT); +void F77_sgemm_base(FCHAR, FCHAR, FINT, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_sgemmtr_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); + +void F77_ssymm_base(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_sskewsymm_base(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_ssyrk_base(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, float *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_ssyr2k_base(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_sskewsyr2k_base(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_strmm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, float *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_strsm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, float *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); /* Double Precision */ - void F77_dgemm(FCHAR, FCHAR, FINT, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT); - void F77_dsymm(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT); - void F77_dsyrk(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, double *, FINT); - void F77_dsyr2k(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT); - void F77_dtrmm(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, double *, FINT); - void F77_dtrsm(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, double *, FINT); +void F77_dgemm_base(FCHAR, FCHAR, FINT, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_dgemmtr_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); + +void F77_dsymm_base(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_dskewsymm_base(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_dsyrk_base(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, double *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_dsyr2k_base(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_dskewsyr2k_base(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_dtrmm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, double *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_dtrsm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, double *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); /* Single Complex Precision */ - void F77_cgemm(FCHAR, FCHAR, FINT, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT); - void F77_csymm(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT); - void F77_chemm(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT); - void F77_csyrk(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, float *, FINT); - void F77_cherk(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, float *, FINT); - void F77_csyr2k(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT); - void F77_cher2k(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT); - void F77_ctrmm(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, float *, FINT); - void F77_ctrsm(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, float *, FINT); +void F77_cgemm_base(FCHAR, FCHAR, FINT, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); + +void F77_cgemmtr_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); + +void F77_csymm_base(FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_chemm_base(FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_csyrk_base(FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_cherk_base(FCHAR, FCHAR, FINT, FINT, const float *, const void *, FINT, const float *, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_csyr2k_base(FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_cher2k_base(FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const float *, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_ctrmm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_ctrsm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); /* Double Complex Precision */ - void F77_zgemm(FCHAR, FCHAR, FINT, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT); - void F77_zsymm(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT); - void F77_zhemm(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT); - void F77_zsyrk(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, double *, FINT); - void F77_zherk(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, double *, FINT); - void F77_zsyr2k(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT); - void F77_zher2k(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT); - void F77_ztrmm(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, double *, FINT); - void F77_ztrsm(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, double *, FINT); +void F77_zgemm_base(FCHAR, FCHAR, FINT, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); + +void F77_zgemmtr_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); + +void F77_zsymm_base(FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_zhemm_base(FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_zsyrk_base(FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_zherk_base(FCHAR, FCHAR, FINT, FINT, const double *, const void *, FINT, const double *, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_zsyr2k_base(FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_zher2k_base(FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const double *, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_ztrmm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); +void F77_ztrsm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); #ifdef __cplusplus } diff --git a/CBLAS/include/cblas_globals.h b/CBLAS/include/cblas_globals.h new file mode 100644 index 0000000000..819570a8d8 --- /dev/null +++ b/CBLAS/include/cblas_globals.h @@ -0,0 +1,13 @@ +#ifndef CBLAS_GLOBALS_H +#define CBLAS_GLOBALS_H + +#if defined(CBLAS_DLL_IMPORTS) + #define CBLAS_GLOBAL_SYMBOL __declspec(dllimport) +#else + #define CBLAS_GLOBAL_SYMBOL +#endif + +extern CBLAS_GLOBAL_SYMBOL int CBLAS_CallFromC; +extern CBLAS_GLOBAL_SYMBOL int RowMajorStrg; + +#endif diff --git a/CBLAS/include/cblas_test.h b/CBLAS/include/cblas_test.h index f8174ba43c..74d035d78c 100644 --- a/CBLAS/include/cblas_test.h +++ b/CBLAS/include/cblas_test.h @@ -5,182 +5,235 @@ #ifndef CBLAS_TEST_H #define CBLAS_TEST_H #include "cblas.h" +#include "cblas_globals.h" #include "cblas_mangling.h" -#define TRUE 1 -#define PASSED 1 -#define TEST_ROW_MJR 1 +#ifndef F77_GLOBAL_SUFFIX +#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) +#endif -#define FALSE 0 -#define FAILED 0 -#define TEST_COL_MJR 0 +/* It seems all current Fortran compilers put strlen at end. +* Some historical compilers put strlen after the str argument +* or make the str argument into a struct. */ +#define BLAS_FORTRAN_STRLEN_END -#define INVALID -1 -#define UNDEFINED -1 +#ifndef FORTRAN_STRLEN + #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 + +#define FALSE 0 +#define FAILED 0 +#define TEST_COL_MJR 0 + +#define INVALID ((CBLAS_INT)-1) + +/* Zero is outside the range of every CBLAS enum. Keep the enum sentinels + * explicitly typed so that compilers do not diagnose an implicit conversion + * from the signed integer sentinel above. */ +#define INVALID_LAYOUT ((CBLAS_LAYOUT)0) +#define INVALID_TRANSPOSE ((CBLAS_TRANSPOSE)0) +#define INVALID_UPLO ((CBLAS_UPLO)0) +#define INVALID_DIAG ((CBLAS_DIAG)0) +#define INVALID_SIDE ((CBLAS_SIDE)0) typedef struct { float real; float imag; } CBLAS_TEST_COMPLEX; typedef struct { double real; double imag; } CBLAS_TEST_ZOMPLEX; -#define F77_xerbla F77_GLOBAL(xerbla,XERBLA) +#define F77_xerbla F77_GLOBAL_SUFFIX(xerbla,XERBLA) /* * Level 1 BLAS */ -#define F77_srotg F77_GLOBAL(srotgtest,SROTGTEST) -#define F77_srotmg F77_GLOBAL(srotmgtest,SROTMGTEST) -#define F77_srot F77_GLOBAL(srottest,SROTTEST) -#define F77_srotm F77_GLOBAL(srotmtest,SROTMTEST) -#define F77_drotg F77_GLOBAL(drotgtest,DROTGTEST) -#define F77_drotmg F77_GLOBAL(drotmgtest,DROTMGTEST) -#define F77_drot F77_GLOBAL(drottest,DROTTEST) -#define F77_drotm F77_GLOBAL(drotmtest,DROTMTEST) -#define F77_sswap F77_GLOBAL(sswaptest,SSWAPTEST) -#define F77_scopy F77_GLOBAL(scopytest,SCOPYTEST) -#define F77_saxpy F77_GLOBAL(saxpytest,SAXPYTEST) -#define F77_isamax F77_GLOBAL(isamaxtest,ISAMAXTEST) -#define F77_dswap F77_GLOBAL(dswaptest,DSWAPTEST) -#define F77_dcopy F77_GLOBAL(dcopytest,DCOPYTEST) -#define F77_daxpy F77_GLOBAL(daxpytest,DAXPYTEST) -#define F77_idamax F77_GLOBAL(idamaxtest,IDAMAXTEST) -#define F77_cswap F77_GLOBAL(cswaptest,CSWAPTEST) -#define F77_ccopy F77_GLOBAL(ccopytest,CCOPYTEST) -#define F77_caxpy F77_GLOBAL(caxpytest,CAXPYTEST) -#define F77_icamax F77_GLOBAL(icamaxtest,ICAMAXTEST) -#define F77_zswap F77_GLOBAL(zswaptest,ZSWAPTEST) -#define F77_zcopy F77_GLOBAL(zcopytest,ZCOPYTEST) -#define F77_zaxpy F77_GLOBAL(zaxpytest,ZAXPYTEST) -#define F77_izamax F77_GLOBAL(izamaxtest,IZAMAXTEST) -#define F77_sdot F77_GLOBAL(sdottest,SDOTTEST) -#define F77_ddot F77_GLOBAL(ddottest,DDOTTEST) -#define F77_dsdot F77_GLOBAL(dsdottest,DSDOTTEST) -#define F77_sscal F77_GLOBAL(sscaltest,SSCALTEST) -#define F77_dscal F77_GLOBAL(dscaltest,DSCALTEST) -#define F77_cscal F77_GLOBAL(cscaltest,CSCALTEST) -#define F77_zscal F77_GLOBAL(zscaltest,ZSCALTEST) -#define F77_csscal F77_GLOBAL(csscaltest,CSSCALTEST) -#define F77_zdscal F77_GLOBAL(zdscaltest,ZDSCALTEST) -#define F77_cdotu F77_GLOBAL(cdotutest,CDOTUTEST) -#define F77_cdotc F77_GLOBAL(cdotctest,CDOTCTEST) -#define F77_zdotu F77_GLOBAL(zdotutest,ZDOTUTEST) -#define F77_zdotc F77_GLOBAL(zdotctest,ZDOTCTEST) -#define F77_snrm2 F77_GLOBAL(snrm2test,SNRM2TEST) -#define F77_sasum F77_GLOBAL(sasumtest,SASUMTEST) -#define F77_dnrm2 F77_GLOBAL(dnrm2test,DNRM2TEST) -#define F77_dasum F77_GLOBAL(dasumtest,DASUMTEST) -#define F77_scnrm2 F77_GLOBAL(scnrm2test,SCNRM2TEST) -#define F77_scasum F77_GLOBAL(scasumtest,SCASUMTEST) -#define F77_dznrm2 F77_GLOBAL(dznrm2test,DZNRM2TEST) -#define F77_dzasum F77_GLOBAL(dzasumtest,DZASUMTEST) -#define F77_sdsdot F77_GLOBAL(sdsdottest, SDSDOTTEST) +#define F77_srotg F77_GLOBAL_SUFFIX(srotgtest,SROTGTEST) +#define F77_srotmg F77_GLOBAL_SUFFIX(srotmgtest,SROTMGTEST) +#define F77_srot F77_GLOBAL_SUFFIX(srottest,SROTTEST) +#define F77_srotm F77_GLOBAL_SUFFIX(srotmtest,SROTMTEST) +#define F77_drotg F77_GLOBAL_SUFFIX(drotgtest,DROTGTEST) +#define F77_drotmg F77_GLOBAL_SUFFIX(drotmgtest,DROTMGTEST) +#define F77_drot F77_GLOBAL_SUFFIX(drottest,DROTTEST) +#define F77_drotm F77_GLOBAL_SUFFIX(drotmtest,DROTMTEST) +#define F77_sswap F77_GLOBAL_SUFFIX(sswaptest,SSWAPTEST) +#define F77_scopy F77_GLOBAL_SUFFIX(scopytest,SCOPYTEST) +#define F77_saxpy F77_GLOBAL_SUFFIX(saxpytest,SAXPYTEST) +#define F77_saxpby F77_GLOBAL_SUFFIX(saxpbytest,SAXPBYTEST) +#define F77_isamax F77_GLOBAL_SUFFIX(isamaxtest,ISAMAXTEST) +#define F77_dswap F77_GLOBAL_SUFFIX(dswaptest,DSWAPTEST) +#define F77_dcopy F77_GLOBAL_SUFFIX(dcopytest,DCOPYTEST) +#define F77_daxpy F77_GLOBAL_SUFFIX(daxpytest,DAXPYTEST) +#define F77_daxpby F77_GLOBAL_SUFFIX(daxpbytest,DAXPBYTEST) +#define F77_idamax F77_GLOBAL_SUFFIX(idamaxtest,IDAMAXTEST) +#define F77_cswap F77_GLOBAL_SUFFIX(cswaptest,CSWAPTEST) +#define F77_ccopy F77_GLOBAL_SUFFIX(ccopytest,CCOPYTEST) +#define F77_caxpy F77_GLOBAL_SUFFIX(caxpytest,CAXPYTEST) +#define F77_caxpby F77_GLOBAL_SUFFIX(caxpbytest,CAXPBYTEST) +#define F77_icamax F77_GLOBAL_SUFFIX(icamaxtest,ICAMAXTEST) +#define F77_zswap F77_GLOBAL_SUFFIX(zswaptest,ZSWAPTEST) +#define F77_zcopy F77_GLOBAL_SUFFIX(zcopytest,ZCOPYTEST) +#define F77_zaxpy F77_GLOBAL_SUFFIX(zaxpytest,ZAXPYTEST) +#define F77_zaxpby F77_GLOBAL_SUFFIX(zaxpbytest,ZAXPBYTEST) +#define F77_izamax F77_GLOBAL_SUFFIX(izamaxtest,IZAMAXTEST) +#define F77_sdot F77_GLOBAL_SUFFIX(sdottest,SDOTTEST) +#define F77_ddot F77_GLOBAL_SUFFIX(ddottest,DDOTTEST) +#define F77_dsdot F77_GLOBAL_SUFFIX(dsdottest,DSDOTTEST) +#define F77_sscal F77_GLOBAL_SUFFIX(sscaltest,SSCALTEST) +#define F77_dscal F77_GLOBAL_SUFFIX(dscaltest,DSCALTEST) +#define F77_cscal F77_GLOBAL_SUFFIX(cscaltest,CSCALTEST) +#define F77_zscal F77_GLOBAL_SUFFIX(zscaltest,ZSCALTEST) +#define F77_csscal F77_GLOBAL_SUFFIX(csscaltest,CSSCALTEST) +#define F77_zdscal F77_GLOBAL_SUFFIX(zdscaltest,ZDSCALTEST) +#define F77_cdotu F77_GLOBAL_SUFFIX(cdotutest,CDOTUTEST) +#define F77_cdotc F77_GLOBAL_SUFFIX(cdotctest,CDOTCTEST) +#define F77_zdotu F77_GLOBAL_SUFFIX(zdotutest,ZDOTUTEST) +#define F77_zdotc F77_GLOBAL_SUFFIX(zdotctest,ZDOTCTEST) +#define F77_snrm2 F77_GLOBAL_SUFFIX(snrm2test,SNRM2TEST) +#define F77_sasum F77_GLOBAL_SUFFIX(sasumtest,SASUMTEST) +#define F77_dnrm2 F77_GLOBAL_SUFFIX(dnrm2test,DNRM2TEST) +#define F77_dasum F77_GLOBAL_SUFFIX(dasumtest,DASUMTEST) +#define F77_scnrm2 F77_GLOBAL_SUFFIX(scnrm2test,SCNRM2TEST) +#define F77_scasum F77_GLOBAL_SUFFIX(scasumtest,SCASUMTEST) +#define F77_dznrm2 F77_GLOBAL_SUFFIX(dznrm2test,DZNRM2TEST) +#define F77_dzasum F77_GLOBAL_SUFFIX(dzasumtest,DZASUMTEST) +#define F77_sdsdot F77_GLOBAL_SUFFIX(sdsdottest, SDSDOTTEST) /* * Level 2 BLAS */ -#define F77_s2chke F77_GLOBAL(cs2chke,CS2CHKE) -#define F77_d2chke F77_GLOBAL(cd2chke,CD2CHKE) -#define F77_c2chke F77_GLOBAL(cc2chke,CC2CHKE) -#define F77_z2chke F77_GLOBAL(cz2chke,CZ2CHKE) -#define F77_ssymv F77_GLOBAL(cssymv,CSSYMV) -#define F77_ssbmv F77_GLOBAL(cssbmv,CSSBMV) -#define F77_sspmv F77_GLOBAL(csspmv,CSSPMV) -#define F77_sger F77_GLOBAL(csger,CSGER) -#define F77_ssyr F77_GLOBAL(cssyr,CSSYR) -#define F77_sspr F77_GLOBAL(csspr,CSSPR) -#define F77_ssyr2 F77_GLOBAL(cssyr2,CSSYR2) -#define F77_sspr2 F77_GLOBAL(csspr2,CSSPR2) -#define F77_dsymv F77_GLOBAL(cdsymv,CDSYMV) -#define F77_dsbmv F77_GLOBAL(cdsbmv,CDSBMV) -#define F77_dspmv F77_GLOBAL(cdspmv,CDSPMV) -#define F77_dger F77_GLOBAL(cdger,CDGER) -#define F77_dsyr F77_GLOBAL(cdsyr,CDSYR) -#define F77_dspr F77_GLOBAL(cdspr,CDSPR) -#define F77_dsyr2 F77_GLOBAL(cdsyr2,CDSYR2) -#define F77_dspr2 F77_GLOBAL(cdspr2,CDSPR2) -#define F77_chemv F77_GLOBAL(cchemv,CCHEMV) -#define F77_chbmv F77_GLOBAL(cchbmv,CCHBMV) -#define F77_chpmv F77_GLOBAL(cchpmv,CCHPMV) -#define F77_cgeru F77_GLOBAL(ccgeru,CCGERU) -#define F77_cgerc F77_GLOBAL(ccgerc,CCGERC) -#define F77_cher F77_GLOBAL(ccher,CCHER) -#define F77_chpr F77_GLOBAL(cchpr,CCHPR) -#define F77_cher2 F77_GLOBAL(ccher2,CCHER2) -#define F77_chpr2 F77_GLOBAL(cchpr2,CCHPR2) -#define F77_zhemv F77_GLOBAL(czhemv,CZHEMV) -#define F77_zhbmv F77_GLOBAL(czhbmv,CZHBMV) -#define F77_zhpmv F77_GLOBAL(czhpmv,CZHPMV) -#define F77_zgeru F77_GLOBAL(czgeru,CZGERU) -#define F77_zgerc F77_GLOBAL(czgerc,CZGERC) -#define F77_zher F77_GLOBAL(czher,CZHER) -#define F77_zhpr F77_GLOBAL(czhpr,CZHPR) -#define F77_zher2 F77_GLOBAL(czher2,CZHER2) -#define F77_zhpr2 F77_GLOBAL(czhpr2,CZHPR2) -#define F77_sgemv F77_GLOBAL(csgemv,CSGEMV) -#define F77_sgbmv F77_GLOBAL(csgbmv,CSGBMV) -#define F77_strmv F77_GLOBAL(cstrmv,CSTRMV) -#define F77_stbmv F77_GLOBAL(cstbmv,CSTBMV) -#define F77_stpmv F77_GLOBAL(cstpmv,CSTPMV) -#define F77_strsv F77_GLOBAL(cstrsv,CSTRSV) -#define F77_stbsv F77_GLOBAL(cstbsv,CSTBSV) -#define F77_stpsv F77_GLOBAL(cstpsv,CSTPSV) -#define F77_dgemv F77_GLOBAL(cdgemv,CDGEMV) -#define F77_dgbmv F77_GLOBAL(cdgbmv,CDGBMV) -#define F77_dtrmv F77_GLOBAL(cdtrmv,CDTRMV) -#define F77_dtbmv F77_GLOBAL(cdtbmv,CDTBMV) -#define F77_dtpmv F77_GLOBAL(cdtpmv,CDTPMV) -#define F77_dtrsv F77_GLOBAL(cdtrsv,CDTRSV) -#define F77_dtbsv F77_GLOBAL(cdtbsv,CDTBSV) -#define F77_dtpsv F77_GLOBAL(cdtpsv,CDTPSV) -#define F77_cgemv F77_GLOBAL(ccgemv,CCGEMV) -#define F77_cgbmv F77_GLOBAL(ccgbmv,CCGBMV) -#define F77_ctrmv F77_GLOBAL(cctrmv,CCTRMV) -#define F77_ctbmv F77_GLOBAL(cctbmv,CCTBMV) -#define F77_ctpmv F77_GLOBAL(cctpmv,CCTPMV) -#define F77_ctrsv F77_GLOBAL(cctrsv,CCTRSV) -#define F77_ctbsv F77_GLOBAL(cctbsv,CCTBSV) -#define F77_ctpsv F77_GLOBAL(cctpsv,CCTPSV) -#define F77_zgemv F77_GLOBAL(czgemv,CZGEMV) -#define F77_zgbmv F77_GLOBAL(czgbmv,CZGBMV) -#define F77_ztrmv F77_GLOBAL(cztrmv,CZTRMV) -#define F77_ztbmv F77_GLOBAL(cztbmv,CZTBMV) -#define F77_ztpmv F77_GLOBAL(cztpmv,CZTPMV) -#define F77_ztrsv F77_GLOBAL(cztrsv,CZTRSV) -#define F77_ztbsv F77_GLOBAL(cztbsv,CZTBSV) -#define F77_ztpsv F77_GLOBAL(cztpsv,CZTPSV) +#define F77_s2chke F77_GLOBAL_SUFFIX(cs2chke,CS2CHKE) +#define F77_d2chke F77_GLOBAL_SUFFIX(cd2chke,CD2CHKE) +#define F77_c2chke F77_GLOBAL_SUFFIX(cc2chke,CC2CHKE) +#define F77_z2chke F77_GLOBAL_SUFFIX(cz2chke,CZ2CHKE) +#define F77_ssymv F77_GLOBAL_SUFFIX(cssymv,CSSYMV) +#define F77_ssbmv F77_GLOBAL_SUFFIX(cssbmv,CSSBMV) +#define F77_sspmv F77_GLOBAL_SUFFIX(csspmv,CSSPMV) +#define F77_sskewsymv F77_GLOBAL_SUFFIX(csskewsymv,CSSKEWSYMV) +#define F77_sger F77_GLOBAL_SUFFIX(csger,CSGER) +#define F77_ssyr F77_GLOBAL_SUFFIX(cssyr,CSSYR) +#define F77_sspr F77_GLOBAL_SUFFIX(csspr,CSSPR) +#define F77_ssyr2 F77_GLOBAL_SUFFIX(cssyr2,CSSYR2) +#define F77_sspr2 F77_GLOBAL_SUFFIX(csspr2,CSSPR2) +#define F77_sskewsyr2 F77_GLOBAL_SUFFIX(csskewsyr2,CSSKEWSYR2) +#define F77_dsymv F77_GLOBAL_SUFFIX(cdsymv,CDSYMV) +#define F77_dsbmv F77_GLOBAL_SUFFIX(cdsbmv,CDSBMV) +#define F77_dspmv F77_GLOBAL_SUFFIX(cdspmv,CDSPMV) +#define F77_dskewsymv F77_GLOBAL_SUFFIX(cdskewsymv,CDSKEWSYMV) +#define F77_dger F77_GLOBAL_SUFFIX(cdger,CDGER) +#define F77_dsyr F77_GLOBAL_SUFFIX(cdsyr,CDSYR) +#define F77_dspr F77_GLOBAL_SUFFIX(cdspr,CDSPR) +#define F77_dsyr2 F77_GLOBAL_SUFFIX(cdsyr2,CDSYR2) +#define F77_dspr2 F77_GLOBAL_SUFFIX(cdspr2,CDSPR2) +#define F77_dskewsyr2 F77_GLOBAL_SUFFIX(cdskewsyr2,CDSKEWSYR2) +#define F77_chemv F77_GLOBAL_SUFFIX(cchemv,CCHEMV) +#define F77_chbmv F77_GLOBAL_SUFFIX(cchbmv,CCHBMV) +#define F77_chpmv F77_GLOBAL_SUFFIX(cchpmv,CCHPMV) +#define F77_cgeru F77_GLOBAL_SUFFIX(ccgeru,CCGERU) +#define F77_cgerc F77_GLOBAL_SUFFIX(ccgerc,CCGERC) +#define F77_cher F77_GLOBAL_SUFFIX(ccher,CCHER) +#define F77_chpr F77_GLOBAL_SUFFIX(cchpr,CCHPR) +#define F77_cher2 F77_GLOBAL_SUFFIX(ccher2,CCHER2) +#define F77_chpr2 F77_GLOBAL_SUFFIX(cchpr2,CCHPR2) +#define F77_zhemv F77_GLOBAL_SUFFIX(czhemv,CZHEMV) +#define F77_zhbmv F77_GLOBAL_SUFFIX(czhbmv,CZHBMV) +#define F77_zhpmv F77_GLOBAL_SUFFIX(czhpmv,CZHPMV) +#define F77_zgeru F77_GLOBAL_SUFFIX(czgeru,CZGERU) +#define F77_zgerc F77_GLOBAL_SUFFIX(czgerc,CZGERC) +#define F77_zher F77_GLOBAL_SUFFIX(czher,CZHER) +#define F77_zhpr F77_GLOBAL_SUFFIX(czhpr,CZHPR) +#define F77_zher2 F77_GLOBAL_SUFFIX(czher2,CZHER2) +#define F77_zhpr2 F77_GLOBAL_SUFFIX(czhpr2,CZHPR2) +#define F77_sgemv F77_GLOBAL_SUFFIX(csgemv,CSGEMV) +#define F77_sgbmv F77_GLOBAL_SUFFIX(csgbmv,CSGBMV) +#define F77_strmv F77_GLOBAL_SUFFIX(cstrmv,CSTRMV) +#define F77_stbmv F77_GLOBAL_SUFFIX(cstbmv,CSTBMV) +#define F77_stpmv F77_GLOBAL_SUFFIX(cstpmv,CSTPMV) +#define F77_strsv F77_GLOBAL_SUFFIX(cstrsv,CSTRSV) +#define F77_stbsv F77_GLOBAL_SUFFIX(cstbsv,CSTBSV) +#define F77_stpsv F77_GLOBAL_SUFFIX(cstpsv,CSTPSV) +#define F77_dgemv F77_GLOBAL_SUFFIX(cdgemv,CDGEMV) +#define F77_dgbmv F77_GLOBAL_SUFFIX(cdgbmv,CDGBMV) +#define F77_dtrmv F77_GLOBAL_SUFFIX(cdtrmv,CDTRMV) +#define F77_dtbmv F77_GLOBAL_SUFFIX(cdtbmv,CDTBMV) +#define F77_dtpmv F77_GLOBAL_SUFFIX(cdtpmv,CDTPMV) +#define F77_dtrsv F77_GLOBAL_SUFFIX(cdtrsv,CDTRSV) +#define F77_dtbsv F77_GLOBAL_SUFFIX(cdtbsv,CDTBSV) +#define F77_dtpsv F77_GLOBAL_SUFFIX(cdtpsv,CDTPSV) +#define F77_cgemv F77_GLOBAL_SUFFIX(ccgemv,CCGEMV) +#define F77_cgbmv F77_GLOBAL_SUFFIX(ccgbmv,CCGBMV) +#define F77_ctrmv F77_GLOBAL_SUFFIX(cctrmv,CCTRMV) +#define F77_ctbmv F77_GLOBAL_SUFFIX(cctbmv,CCTBMV) +#define F77_ctpmv F77_GLOBAL_SUFFIX(cctpmv,CCTPMV) +#define F77_ctrsv F77_GLOBAL_SUFFIX(cctrsv,CCTRSV) +#define F77_ctbsv F77_GLOBAL_SUFFIX(cctbsv,CCTBSV) +#define F77_ctpsv F77_GLOBAL_SUFFIX(cctpsv,CCTPSV) +#define F77_zgemv F77_GLOBAL_SUFFIX(czgemv,CZGEMV) +#define F77_zgbmv F77_GLOBAL_SUFFIX(czgbmv,CZGBMV) +#define F77_ztrmv F77_GLOBAL_SUFFIX(cztrmv,CZTRMV) +#define F77_ztbmv F77_GLOBAL_SUFFIX(cztbmv,CZTBMV) +#define F77_ztpmv F77_GLOBAL_SUFFIX(cztpmv,CZTPMV) +#define F77_ztrsv F77_GLOBAL_SUFFIX(cztrsv,CZTRSV) +#define F77_ztbsv F77_GLOBAL_SUFFIX(cztbsv,CZTBSV) +#define F77_ztpsv F77_GLOBAL_SUFFIX(cztpsv,CZTPSV) /* * Level 3 BLAS */ -#define F77_s3chke F77_GLOBAL(cs3chke,CS3CHKE) -#define F77_d3chke F77_GLOBAL(cd3chke,CD3CHKE) -#define F77_c3chke F77_GLOBAL(cc3chke,CC3CHKE) -#define F77_z3chke F77_GLOBAL(cz3chke,CZ3CHKE) -#define F77_chemm F77_GLOBAL(cchemm,CCHEMM) -#define F77_cherk F77_GLOBAL(ccherk,CCHERK) -#define F77_cher2k F77_GLOBAL(ccher2k,CCHER2K) -#define F77_zhemm F77_GLOBAL(czhemm,CZHEMM) -#define F77_zherk F77_GLOBAL(czherk,CZHERK) -#define F77_zher2k F77_GLOBAL(czher2k,CZHER2K) -#define F77_sgemm F77_GLOBAL(csgemm,CSGEMM) -#define F77_ssymm F77_GLOBAL(cssymm,CSSYMM) -#define F77_ssyrk F77_GLOBAL(cssyrk,CSSYRK) -#define F77_ssyr2k F77_GLOBAL(cssyr2k,CSSYR2K) -#define F77_strmm F77_GLOBAL(cstrmm,CSTRMM) -#define F77_strsm F77_GLOBAL(cstrsm,CSTRSM) -#define F77_dgemm F77_GLOBAL(cdgemm,CDGEMM) -#define F77_dsymm F77_GLOBAL(cdsymm,CDSYMM) -#define F77_dsyrk F77_GLOBAL(cdsyrk,CDSYRK) -#define F77_dsyr2k F77_GLOBAL(cdsyr2k,CDSYR2K) -#define F77_dtrmm F77_GLOBAL(cdtrmm,CDTRMM) -#define F77_dtrsm F77_GLOBAL(cdtrsm,CDTRSM) -#define F77_cgemm F77_GLOBAL(ccgemm,CCGEMM) -#define F77_csymm F77_GLOBAL(ccsymm,CCSYMM) -#define F77_csyrk F77_GLOBAL(ccsyrk,CCSYRK) -#define F77_csyr2k F77_GLOBAL(ccsyr2k,CCSYR2K) -#define F77_ctrmm F77_GLOBAL(cctrmm,CCTRMM) -#define F77_ctrsm F77_GLOBAL(cctrsm,CCTRSM) -#define F77_zgemm F77_GLOBAL(czgemm,CZGEMM) -#define F77_zsymm F77_GLOBAL(czsymm,CZSYMM) -#define F77_zsyrk F77_GLOBAL(czsyrk,CZSYRK) -#define F77_zsyr2k F77_GLOBAL(czsyr2k,CZSYR2K) -#define F77_ztrmm F77_GLOBAL(cztrmm,CZTRMM) -#define F77_ztrsm F77_GLOBAL(cztrsm, CZTRSM) +#define F77_s3chke F77_GLOBAL_SUFFIX(cs3chke,CS3CHKE) +#define F77_d3chke F77_GLOBAL_SUFFIX(cd3chke,CD3CHKE) +#define F77_c3chke F77_GLOBAL_SUFFIX(cc3chke,CC3CHKE) +#define F77_z3chke F77_GLOBAL_SUFFIX(cz3chke,CZ3CHKE) +#define F77_chemm F77_GLOBAL_SUFFIX(cchemm,CCHEMM) +#define F77_cherk F77_GLOBAL_SUFFIX(ccherk,CCHERK) +#define F77_cher2k F77_GLOBAL_SUFFIX(ccher2k,CCHER2K) +#define F77_zhemm F77_GLOBAL_SUFFIX(czhemm,CZHEMM) +#define F77_zherk F77_GLOBAL_SUFFIX(czherk,CZHERK) +#define F77_zher2k F77_GLOBAL_SUFFIX(czher2k,CZHER2K) +#define F77_sgemm F77_GLOBAL_SUFFIX(csgemm,CSGEMM) +#define F77_sgemmtr F77_GLOBAL_SUFFIX(csgemmtr,CSGEMMTR) +#define F77_ssymm F77_GLOBAL_SUFFIX(cssymm,CSSYMM) +#define F77_sskewsymm F77_GLOBAL_SUFFIX(csskewsymm,CSSKEWSYMM) +#define F77_ssyrk F77_GLOBAL_SUFFIX(cssyrk,CSSYRK) +#define F77_ssyr2k F77_GLOBAL_SUFFIX(cssyr2k,CSSYR2K) +#define F77_sskewsyr2k F77_GLOBAL_SUFFIX(csskewsyr2k,CSSKEWSYR2K) +#define F77_strmm F77_GLOBAL_SUFFIX(cstrmm,CSTRMM) +#define F77_strsm F77_GLOBAL_SUFFIX(cstrsm,CSTRSM) +#define F77_dgemm F77_GLOBAL_SUFFIX(cdgemm,CDGEMM) +#define F77_dgemmtr F77_GLOBAL_SUFFIX(cdgemmtr,CDGEMMTR) +#define F77_dsymm F77_GLOBAL_SUFFIX(cdsymm,CDSYMM) +#define F77_dskewsymm F77_GLOBAL_SUFFIX(cdskewsymm,CDSKEWSYMM) +#define F77_dsyrk F77_GLOBAL_SUFFIX(cdsyrk,CDSYRK) +#define F77_dsyr2k F77_GLOBAL_SUFFIX(cdsyr2k,CDSYR2K) +#define F77_dskewsyr2k F77_GLOBAL_SUFFIX(cdskewsyr2k,CDSKEWSYR2K) +#define F77_dtrmm F77_GLOBAL_SUFFIX(cdtrmm,CDTRMM) +#define F77_dtrsm F77_GLOBAL_SUFFIX(cdtrsm,CDTRSM) +#define F77_cgemm F77_GLOBAL_SUFFIX(ccgemm,CCGEMM) +#define F77_cgemmtr F77_GLOBAL_SUFFIX(ccgemmtr,CCGEMMTR) +#define F77_csymm F77_GLOBAL_SUFFIX(ccsymm,CCSYMM) +#define F77_csyrk F77_GLOBAL_SUFFIX(ccsyrk,CCSYRK) +#define F77_csyr2k F77_GLOBAL_SUFFIX(ccsyr2k,CCSYR2K) +#define F77_ctrmm F77_GLOBAL_SUFFIX(cctrmm,CCTRMM) +#define F77_ctrsm F77_GLOBAL_SUFFIX(cctrsm,CCTRSM) +#define F77_zgemm F77_GLOBAL_SUFFIX(czgemm,CZGEMM) +#define F77_zgemmtr F77_GLOBAL_SUFFIX(czgemmtr,CZGEMMTR) +#define F77_zsymm F77_GLOBAL_SUFFIX(czsymm,CZSYMM) +#define F77_zsyrk F77_GLOBAL_SUFFIX(czsyrk,CZSYRK) +#define F77_zsyr2k F77_GLOBAL_SUFFIX(czsyr2k,CZSYR2K) +#define F77_ztrmm F77_GLOBAL_SUFFIX(cztrmm,CZTRMM) +#define F77_ztrsm F77_GLOBAL_SUFFIX(cztrsm, CZTRSM) void get_transpose_type(char *type, CBLAS_TRANSPOSE *trans); void get_uplo_type(char *type, CBLAS_UPLO *uplo); diff --git a/CBLAS/include/cblas_xerbla_internal.h b/CBLAS/include/cblas_xerbla_internal.h new file mode 100644 index 0000000000..09575ca90e --- /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/CMakeLists.txt b/CBLAS/src/CMakeLists.txt index 90e19f8185..5e027f4710 100644 --- a/CBLAS/src/CMakeLists.txt +++ b/CBLAS/src/CMakeLists.txt @@ -1,7 +1,10 @@ # This Makefile compiles the CBLAS routines +# Sources that are shared across all APIs +set(COMMON_SOURCES cblas_globals.c) + # Error handling routines for level 2 & 3 -set(ERRHAND cblas_globals.c cblas_xerbla.c xerbla.c) +set(ERRHAND cblas_xerbla.c xerbla.c) # # @@ -12,32 +15,40 @@ set(ERRHAND cblas_globals.c cblas_xerbla.c xerbla.c) # # Files for level 1 single precision real -set(SLEV1 cblas_srotg.c cblas_srotmg.c cblas_srot.c cblas_srotm.c - cblas_sswap.c cblas_sscal.c cblas_scopy.c cblas_saxpy.c - cblas_sdot.c cblas_sdsdot.c cblas_snrm2.c cblas_sasum.c - cblas_isamax.c sdotsub.f sdsdotsub.f snrm2sub.f sasumsub.f - isamaxsub.f) +set(SLEV1_C + cblas_srotg.c cblas_srotmg.c cblas_srot.c cblas_srotm.c cblas_sswap.c + cblas_sscal.c cblas_scopy.c cblas_saxpy.c cblas_sdot.c cblas_sdsdot.c + cblas_snrm2.c cblas_sasum.c cblas_isamax.c cblas_saxpby.c) + +set(SLEV1_F + sdotsub.f sdsdotsub.f snrm2sub.f sasumsub.f isamaxsub.f) # Files for level 1 double precision real -set(DLEV1 cblas_drotg.c cblas_drotmg.c cblas_drot.c cblas_drotm.c - cblas_dswap.c cblas_dscal.c cblas_dcopy.c cblas_daxpy.c - cblas_ddot.c cblas_dsdot.c cblas_dnrm2.c cblas_dasum.c - cblas_idamax.c ddotsub.f dsdotsub.f dnrm2sub.f - dasumsub.f idamaxsub.f) +set(DLEV1_C + cblas_drotg.c cblas_drotmg.c cblas_drot.c cblas_drotm.c cblas_dswap.c + cblas_dscal.c cblas_dcopy.c cblas_daxpy.c cblas_ddot.c cblas_dsdot.c + cblas_dnrm2.c cblas_dasum.c cblas_idamax.c cblas_daxpby.c) + +set(DLEV1_F + ddotsub.f dsdotsub.f dnrm2sub.f dasumsub.f idamaxsub.f) # Files for level 1 single precision complex -set(CLEV1 cblas_cswap.c cblas_cscal.c cblas_csscal.c cblas_ccopy.c - cblas_caxpy.c cblas_cdotu_sub.c cblas_cdotc_sub.c - cblas_icamax.c cdotcsub.f cdotusub.f icamaxsub.f) +set(CLEV1_C + cblas_crotg.c cblas_csrot.c cblas_cswap.c cblas_cscal.c cblas_csscal.c + cblas_ccopy.c cblas_caxpy.c cblas_cdotu_sub.c cblas_cdotc_sub.c cblas_scnrm2.c + cblas_scasum.c cblas_icamax.c cblas_scabs1.c cblas_caxpby.c) + +set(CLEV1_F + cdotcsub.f cdotusub.f icamaxsub.f scasumsub.f scnrm2sub.f scabs1sub.f) # Files for level 1 double precision complex -set(ZLEV1 cblas_zswap.c cblas_zscal.c cblas_zdscal.c cblas_zcopy.c - cblas_zaxpy.c cblas_zdotu_sub.c cblas_zdotc_sub.c cblas_dznrm2.c - cblas_dzasum.c cblas_izamax.c zdotcsub.f zdotusub.f - dzasumsub.f dznrm2sub.f izamaxsub.f) +set(ZLEV1_C + cblas_zrotg.c cblas_zdrot.c cblas_zswap.c cblas_zscal.c cblas_zdscal.c + cblas_zcopy.c cblas_zaxpy.c cblas_zdotu_sub.c cblas_zdotc_sub.c cblas_dznrm2.c + cblas_dzasum.c cblas_izamax.c cblas_dcabs1.c cblas_zaxpby.c) -# Common files for level 1 single precision -set(SCLEV1 cblas_scasum.c scasumsub.f cblas_scnrm2.c scnrm2sub.f) +set(ZLEV1_F + zdotcsub.f zdotusub.f izamaxsub.f dzasumsub.f dznrm2sub.f dcabs1sub.f) # # @@ -48,28 +59,32 @@ set(SCLEV1 cblas_scasum.c scasumsub.f cblas_scnrm2.c scnrm2sub.f) # # Files for level 2 single precision real -set(SLEV2 cblas_sgemv.c cblas_sgbmv.c cblas_sger.c cblas_ssbmv.c cblas_sspmv.c - cblas_sspr.c cblas_sspr2.c cblas_ssymv.c cblas_ssyr.c cblas_ssyr2.c - cblas_stbmv.c cblas_stbsv.c cblas_stpmv.c cblas_stpsv.c cblas_strmv.c - cblas_strsv.c) +set(SLEV2 + cblas_sgemv.c cblas_sgbmv.c cblas_sger.c cblas_ssbmv.c cblas_sspmv.c + cblas_sspr.c cblas_sspr2.c cblas_ssymv.c cblas_ssyr.c cblas_ssyr2.c + cblas_stbmv.c cblas_stbsv.c cblas_stpmv.c cblas_stpsv.c cblas_strmv.c + cblas_strsv.c cblas_sskewsymv.c cblas_sskewsyr2.c) # Files for level 2 double precision real -set(DLEV2 cblas_dgemv.c cblas_dgbmv.c cblas_dger.c cblas_dsbmv.c cblas_dspmv.c - cblas_dspr.c cblas_dspr2.c cblas_dsymv.c cblas_dsyr.c cblas_dsyr2.c - cblas_dtbmv.c cblas_dtbsv.c cblas_dtpmv.c cblas_dtpsv.c cblas_dtrmv.c - cblas_dtrsv.c) +set(DLEV2 + cblas_dgemv.c cblas_dgbmv.c cblas_dger.c cblas_dsbmv.c cblas_dspmv.c + cblas_dspr.c cblas_dspr2.c cblas_dsymv.c cblas_dsyr.c cblas_dsyr2.c + cblas_dtbmv.c cblas_dtbsv.c cblas_dtpmv.c cblas_dtpsv.c cblas_dtrmv.c + cblas_dtrsv.c cblas_dskewsymv.c cblas_dskewsyr2.c) # Files for level 2 single precision complex -set(CLEV2 cblas_cgemv.c cblas_cgbmv.c cblas_chemv.c cblas_chbmv.c cblas_chpmv.c - cblas_ctrmv.c cblas_ctbmv.c cblas_ctpmv.c cblas_ctrsv.c cblas_ctbsv.c - cblas_ctpsv.c cblas_cgeru.c cblas_cgerc.c cblas_cher.c cblas_cher2.c - cblas_chpr.c cblas_chpr2.c) +set(CLEV2 + cblas_cgemv.c cblas_cgbmv.c cblas_chemv.c cblas_chbmv.c cblas_chpmv.c + cblas_ctrmv.c cblas_ctbmv.c cblas_ctpmv.c cblas_ctrsv.c cblas_ctbsv.c + cblas_ctpsv.c cblas_cgeru.c cblas_cgerc.c cblas_cher.c cblas_cher2.c + cblas_chpr.c cblas_chpr2.c) # Files for level 2 double precision complex -set(ZLEV2 cblas_zgemv.c cblas_zgbmv.c cblas_zhemv.c cblas_zhbmv.c cblas_zhpmv.c - cblas_ztrmv.c cblas_ztbmv.c cblas_ztpmv.c cblas_ztrsv.c cblas_ztbsv.c - cblas_ztpsv.c cblas_zgeru.c cblas_zgerc.c cblas_zher.c cblas_zher2.c - cblas_zhpr.c cblas_zhpr2.c) +set(ZLEV2 + cblas_zgemv.c cblas_zgbmv.c cblas_zhemv.c cblas_zhbmv.c cblas_zhpmv.c + cblas_ztrmv.c cblas_ztbmv.c cblas_ztpmv.c cblas_ztrsv.c cblas_ztbsv.c + cblas_ztpsv.c cblas_zgeru.c cblas_zgerc.c cblas_zher.c cblas_zher2.c + cblas_zhpr.c cblas_zhpr2.c) # # @@ -80,49 +95,87 @@ set(ZLEV2 cblas_zgemv.c cblas_zgbmv.c cblas_zhemv.c cblas_zhbmv.c cblas_zhpmv.c # # Files for level 3 single precision real -set(SLEV3 cblas_sgemm.c cblas_ssymm.c cblas_ssyrk.c cblas_ssyr2k.c cblas_strmm.c - cblas_strsm.c) +set(SLEV3 + cblas_sgemm.c cblas_ssymm.c cblas_ssyrk.c cblas_ssyr2k.c cblas_strmm.c + cblas_strsm.c cblas_sgemmtr.c cblas_sskewsymm.c cblas_sskewsyr2k.c) # Files for level 3 double precision real -set(DLEV3 cblas_dgemm.c cblas_dsymm.c cblas_dsyrk.c cblas_dsyr2k.c cblas_dtrmm.c - cblas_dtrsm.c) +set(DLEV3 + cblas_dgemm.c cblas_dsymm.c cblas_dsyrk.c cblas_dsyr2k.c cblas_dtrmm.c + cblas_dtrsm.c cblas_dgemmtr.c cblas_dskewsymm.c cblas_dskewsyr2k.c) # Files for level 3 single precision complex -set(CLEV3 cblas_cgemm.c cblas_csymm.c cblas_chemm.c cblas_cherk.c - cblas_cher2k.c cblas_ctrmm.c cblas_ctrsm.c cblas_csyrk.c - cblas_csyr2k.c) +set(CLEV3 + cblas_cgemm.c cblas_csymm.c cblas_chemm.c cblas_cherk.c cblas_cher2k.c + cblas_ctrmm.c cblas_ctrsm.c cblas_csyrk.c cblas_csyr2k.c cblas_cgemmtr.c) # Files for level 3 double precision complex -set(ZLEV3 cblas_zgemm.c cblas_zsymm.c cblas_zhemm.c cblas_zherk.c - cblas_zher2k.c cblas_ztrmm.c cblas_ztrsm.c cblas_zsyrk.c - cblas_zsyr2k.c) - +set(ZLEV3 + cblas_zgemm.c cblas_zsymm.c cblas_zhemm.c cblas_zherk.c cblas_zher2k.c + cblas_ztrmm.c cblas_ztrsm.c cblas_zsyrk.c cblas_zsyr2k.c cblas_zgemmtr.c) -set(SOURCES) +set(SOURCES_C) +set(SOURCES_F) if(BUILD_SINGLE) - list(APPEND SOURCES ${SLEV1} ${SCLEV1} ${SLEV2} ${SLEV3} ${ERRHAND}) + list(APPEND SOURCES_C ${SLEV1_C} ${SLEV2} ${SLEV3} ${ERRHAND}) + list(APPEND SOURCES_F ${SLEV1_F}) endif() if(BUILD_DOUBLE) - list(APPEND SOURCES ${DLEV1} ${DLEV2} ${DLEV3} ${ERRHAND}) + list(APPEND SOURCES_C ${DLEV1_C} ${DLEV2} ${DLEV3} ${ERRHAND}) + list(APPEND SOURCES_F ${DLEV1_F}) endif() if(BUILD_COMPLEX) - list(APPEND SOURCES ${CLEV1} ${SCLEV1} ${CLEV2} ${CLEV3} ${ERRHAND}) + list(APPEND SOURCES_C ${CLEV1_C} ${CLEV2} ${CLEV3} ${ERRHAND}) + list(APPEND SOURCES_F ${CLEV1_F}) endif() if(BUILD_COMPLEX16) - list(APPEND SOURCES ${ZLEV1} ${ZLEV2} ${ZLEV3} ${ERRHAND}) + list(APPEND SOURCES_C ${ZLEV1_C} ${ZLEV2} ${ZLEV3} ${ERRHAND}) + list(APPEND SOURCES_F ${ZLEV1_F}) endif() -list(REMOVE_DUPLICATES SOURCES) +list(REMOVE_DUPLICATES SOURCES_C) +list(REMOVE_DUPLICATES SOURCES_F) + +if(BUILD_DEFAULT_API) + add_library(${CBLASLIB}_obj OBJECT ${COMMON_SOURCES} ${SOURCES_C} ${SOURCES_F}) + if(HAS_ATTRIBUTE_WEAK_SUPPORT) + target_compile_definitions(${CBLASLIB}_obj PRIVATE + "$<$:HAS_ATTRIBUTE_WEAK_SUPPORT>") + endif() +else() + add_library(${CBLASLIB}_obj OBJECT ${COMMON_SOURCES}) +endif() +lapack_add_coverage(${CBLASLIB}_obj) + +if(BUILD_INDEX64_EXT_API) + include(ExtendedAPIHelpers) + generate_64bit_suffixed_sources(${CBLASLIB} SOURCES_F SOURCES_64_F) + + add_library(${CBLASLIB}_64_obj OBJECT ${SOURCES_C} ${SOURCES_64_F}) + target_compile_definitions(${CBLASLIB}_64_obj PRIVATE + "$<$:WeirdNEC>" "$<$:CBLAS_API64>") + target_compile_options(${CBLASLIB}_64_obj PRIVATE + "$<$:${FOPT_ILP64}>") + if(HAS_ATTRIBUTE_WEAK_SUPPORT) + target_compile_definitions(${CBLASLIB}_64_obj PRIVATE + "$<$:HAS_ATTRIBUTE_WEAK_SUPPORT>") + endif() +endif() + +add_library(${CBLASLIB} + $ + $<$: $>) -add_library(cblas ${SOURCES}) set_target_properties( - cblas PROPERTIES + ${CBLASLIB} PROPERTIES LINKER_LANGUAGE C VERSION ${LAPACK_VERSION} SOVERSION ${LAPACK_MAJOR_VERSION} ) -target_include_directories(cblas PUBLIC - $ + +target_include_directories(${CBLASLIB} PUBLIC $ ) -target_link_libraries(cblas PRIVATE ${BLAS_LIBRARIES}) -lapack_install_library(cblas) +target_link_libraries(${CBLASLIB} PUBLIC ${BLAS_LIBRARIES}) + +lapack_add_coverage(${CBLASLIB}) +lapack_install_library(${CBLASLIB}) diff --git a/CBLAS/src/Makefile b/CBLAS/src/Makefile index 6c0518ac7f..7d949e6660 100644 --- a/CBLAS/src/Makefile +++ b/CBLAS/src/Makefile @@ -1,7 +1,13 @@ # This Makefile compiles the CBLAS routines -include ../../make.inc +TOPSRCDIR = ../.. +include $(TOPSRCDIR)/make.inc +.SUFFIXES: .c .o +.c.o: + $(CC) $(CFLAGS) -I../include -c -o $@ $< + +.PHONY: all all: $(CBLASLIB) # Error handling routines for level 2 & 3 @@ -20,47 +26,52 @@ slev1 = cblas_srotg.o cblas_srotmg.o cblas_srot.o cblas_srotm.o \ cblas_sswap.o cblas_sscal.o cblas_scopy.o cblas_saxpy.o \ cblas_sdot.o cblas_sdsdot.o cblas_snrm2.o cblas_sasum.o \ cblas_isamax.o sdotsub.o sdsdotsub.o snrm2sub.o sasumsub.o \ - isamaxsub.o + isamaxsub.o cblas_saxpby.o # Files for level 1 double precision real dlev1 = cblas_drotg.o cblas_drotmg.o cblas_drot.o cblas_drotm.o \ cblas_dswap.o cblas_dscal.o cblas_dcopy.o cblas_daxpy.o \ cblas_ddot.o cblas_dsdot.o cblas_dnrm2.o cblas_dasum.o \ cblas_idamax.o ddotsub.o dsdotsub.o dnrm2sub.o \ - dasumsub.o idamaxsub.o + dasumsub.o idamaxsub.o cblas_daxpby.o # Files for level 1 single precision complex -clev1 = cblas_cswap.o cblas_cscal.o cblas_csscal.o cblas_ccopy.o \ +clev1 = cblas_crotg.o cblas_csrot.o \ + cblas_cswap.o cblas_cscal.o cblas_csscal.o cblas_ccopy.o \ cblas_caxpy.o cblas_cdotu_sub.o cblas_cdotc_sub.o \ - cblas_icamax.o cdotcsub.o cdotusub.o icamaxsub.o + cblas_icamax.o cdotcsub.o cdotusub.o icamaxsub.o \ + cblas_scabs1.o scabs1sub.o cblas_caxpby.o # Files for level 1 double precision complex -zlev1 = cblas_zswap.o cblas_zscal.o cblas_zdscal.o cblas_zcopy.o \ +zlev1 = cblas_zrotg.o cblas_zdrot.o \ + cblas_zswap.o cblas_zscal.o cblas_zdscal.o cblas_zcopy.o \ cblas_zaxpy.o cblas_zdotu_sub.o cblas_zdotc_sub.o cblas_dznrm2.o \ cblas_dzasum.o cblas_izamax.o zdotcsub.o zdotusub.o \ - dzasumsub.o dznrm2sub.o izamaxsub.o + dzasumsub.o dznrm2sub.o izamaxsub.o \ + cblas_dcabs1.o dcabs1sub.o cblas_zaxpby.o # Common files for level 1 single precision sclev1 = cblas_scasum.o scasumsub.o cblas_scnrm2.o scnrm2sub.o +.PHONY: slib1 dlib1 clib1 zlib1 # Single precision real slib1: $(slev1) $(sclev1) - $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^ + $(AR) $(ARFLAGS) $(CBLASLIB) $^ $(RANLIB) $(CBLASLIB) # Double precision real dlib1: $(dlev1) - $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^ + $(AR) $(ARFLAGS) $(CBLASLIB) $^ $(RANLIB) $(CBLASLIB) # Single precision complex clib1: $(clev1) $(sclev1) - $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^ + $(AR) $(ARFLAGS) $(CBLASLIB) $^ $(RANLIB) $(CBLASLIB) # Double precision complex zlib1: $(zlev1) - $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^ + $(AR) $(ARFLAGS) $(CBLASLIB) $^ $(RANLIB) $(CBLASLIB) # @@ -75,13 +86,13 @@ zlib1: $(zlev1) slev2 = cblas_sgemv.o cblas_sgbmv.o cblas_sger.o cblas_ssbmv.o cblas_sspmv.o \ cblas_sspr.o cblas_sspr2.o cblas_ssymv.o cblas_ssyr.o cblas_ssyr2.o \ cblas_stbmv.o cblas_stbsv.o cblas_stpmv.o cblas_stpsv.o cblas_strmv.o \ - cblas_strsv.o + cblas_strsv.o cblas_sskewsymv.o cblas_sskewsyr2.o # Files for level 2 double precision real dlev2 = cblas_dgemv.o cblas_dgbmv.o cblas_dger.o cblas_dsbmv.o cblas_dspmv.o \ cblas_dspr.o cblas_dspr2.o cblas_dsymv.o cblas_dsyr.o cblas_dsyr2.o \ cblas_dtbmv.o cblas_dtbsv.o cblas_dtpmv.o cblas_dtpsv.o cblas_dtrmv.o \ - cblas_dtrsv.o + cblas_dtrsv.o cblas_dskewsymv.o cblas_dskewsyr2.o # Files for level 2 single precision complex clev2 = cblas_cgemv.o cblas_cgbmv.o cblas_chemv.o cblas_chbmv.o cblas_chpmv.o \ @@ -95,24 +106,25 @@ zlev2 = cblas_zgemv.o cblas_zgbmv.o cblas_zhemv.o cblas_zhbmv.o cblas_zhpmv.o \ cblas_ztpsv.o cblas_zgeru.o cblas_zgerc.o cblas_zher.o cblas_zher2.o \ cblas_zhpr.o cblas_zhpr2.o +.PHONY: slib2 dlib2 clib2 zlib2 # Single precision real slib2: $(slev2) $(errhand) - $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^ + $(AR) $(ARFLAGS) $(CBLASLIB) $^ $(RANLIB) $(CBLASLIB) # Double precision real dlib2: $(dlev2) $(errhand) - $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^ + $(AR) $(ARFLAGS) $(CBLASLIB) $^ $(RANLIB) $(CBLASLIB) # Single precision complex clib2: $(clev2) $(errhand) - $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^ + $(AR) $(ARFLAGS) $(CBLASLIB) $^ $(RANLIB) $(CBLASLIB) # Double precision complex zlib2: $(zlev2) $(errhand) - $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^ + $(AR) $(ARFLAGS) $(CBLASLIB) $^ $(RANLIB) $(CBLASLIB) # @@ -125,40 +137,41 @@ zlib2: $(zlev2) $(errhand) # Files for level 3 single precision real slev3 = cblas_sgemm.o cblas_ssymm.o cblas_ssyrk.o cblas_ssyr2k.o cblas_strmm.o \ - cblas_strsm.o + cblas_strsm.o cblas_sgemmtr.o cblas_sskewsymm.o cblas_sskewsyr2k.o # Files for level 3 double precision real dlev3 = cblas_dgemm.o cblas_dsymm.o cblas_dsyrk.o cblas_dsyr2k.o cblas_dtrmm.o \ - cblas_dtrsm.o + cblas_dtrsm.o cblas_dgemmtr.o cblas_dskewsymm.o cblas_dskewsyr2k.o # Files for level 3 single precision complex clev3 = cblas_cgemm.o cblas_csymm.o cblas_chemm.o cblas_cherk.o \ cblas_cher2k.o cblas_ctrmm.o cblas_ctrsm.o cblas_csyrk.o \ - cblas_csyr2k.o + cblas_csyr2k.o cblas_cgemmtr.o # Files for level 3 double precision complex zlev3 = cblas_zgemm.o cblas_zsymm.o cblas_zhemm.o cblas_zherk.o \ cblas_zher2k.o cblas_ztrmm.o cblas_ztrsm.o cblas_zsyrk.o \ - cblas_zsyr2k.o + cblas_zsyr2k.o cblas_zgemmtr.o +.PHONY: slib3 dlib3 clib3 zlib3 # Single precision real slib3: $(slev3) $(errhand) - $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^ + $(AR) $(ARFLAGS) $(CBLASLIB) $^ $(RANLIB) $(CBLASLIB) # Double precision real dlib3: $(dlev3) $(errhand) - $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^ + $(AR) $(ARFLAGS) $(CBLASLIB) $^ $(RANLIB) $(CBLASLIB) # Single precision complex clib3: $(clev3) $(errhand) - $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^ + $(AR) $(ARFLAGS) $(CBLASLIB) $^ $(RANLIB) $(CBLASLIB) # Double precision complex zlib3: $(zlev3) $(errhand) - $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^ + $(AR) $(ARFLAGS) $(CBLASLIB) $^ $(RANLIB) $(CBLASLIB) @@ -166,36 +179,33 @@ alev1 = $(slev1) $(dlev1) $(clev1) $(zlev1) $(sclev1) alev2 = $(slev2) $(dlev2) $(clev2) $(zlev2) alev3 = $(slev3) $(dlev3) $(clev3) $(zlev3) +.PHONY: all1 all2 all3 # All level 1 all1: $(alev1) - $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^ + $(AR) $(ARFLAGS) $(CBLASLIB) $^ $(RANLIB) $(CBLASLIB) # All level 2 all2: $(alev2) $(errhand) - $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^ + $(AR) $(ARFLAGS) $(CBLASLIB) $^ $(RANLIB) $(CBLASLIB) # All level 3 all3: $(alev3) $(errhand) - $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^ + $(AR) $(ARFLAGS) $(CBLASLIB) $^ $(RANLIB) $(CBLASLIB) # All levels and precisions $(CBLASLIB): $(alev1) $(alev2) $(alev3) $(errhand) - $(ARCH) $(ARCHFLAGS) $@ $^ + $(AR) $(ARFLAGS) $@ $^ $(RANLIB) $@ FRC: @FRC=$(FRC) +.PHONY: clean cleanobj cleanlib clean: cleanobj cleanlib cleanobj: rm -f *.o cleanlib: rm -f $(CBLASLIB) - -.c.o: - $(CC) $(CFLAGS) -I../include -c -o $@ $< -.f.o: - $(FORTRAN) $(OPTS) -c -o $@ $< diff --git a/CBLAS/src/cblas_caxpby.c b/CBLAS/src/cblas_caxpby.c new file mode 100644 index 0000000000..997ba3c952 --- /dev/null +++ b/CBLAS/src/cblas_caxpby.c @@ -0,0 +1,22 @@ +/* + * cblas_caxpby.c + * + * The program is a C interface to caxpby. + * + * Written by Martin Koehler. 08/26/2024 + * + */ +#include "cblas.h" +#include "cblas_f77.h" +void API_SUFFIX(cblas_caxpby)( const CBLAS_INT N, const void *alpha, const void *X, + const CBLAS_INT incX, const void *beta, void *Y, const CBLAS_INT incY) +{ +#ifdef F77_INT + F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; +#else + #define F77_N N + #define F77_incX incX + #define F77_incY incY +#endif + F77_caxpby( &F77_N, alpha, X, &F77_incX, beta, Y, &F77_incY); +} diff --git a/CBLAS/src/cblas_caxpy.c b/CBLAS/src/cblas_caxpy.c index 73302faf24..f38ee4cb62 100644 --- a/CBLAS/src/cblas_caxpy.c +++ b/CBLAS/src/cblas_caxpy.c @@ -8,8 +8,8 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_caxpy( const int N, const void *alpha, const void *X, - const int incX, void *Y, const int incY) +void API_SUFFIX(cblas_caxpy)( const CBLAS_INT N, const void *alpha, const void *X, + const CBLAS_INT incX, void *Y, const CBLAS_INT incY) { #ifdef F77_INT F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; diff --git a/CBLAS/src/cblas_ccopy.c b/CBLAS/src/cblas_ccopy.c index d8d2367017..04ee03f860 100644 --- a/CBLAS/src/cblas_ccopy.c +++ b/CBLAS/src/cblas_ccopy.c @@ -8,8 +8,8 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_ccopy( const int N, const void *X, - const int incX, void *Y, const int incY) +void API_SUFFIX(cblas_ccopy)( const CBLAS_INT N, const void *X, + const CBLAS_INT incX, void *Y, const CBLAS_INT incY) { #ifdef F77_INT F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; diff --git a/CBLAS/src/cblas_cdotc_sub.c b/CBLAS/src/cblas_cdotc_sub.c index fca11cd05d..cd7958bda0 100644 --- a/CBLAS/src/cblas_cdotc_sub.c +++ b/CBLAS/src/cblas_cdotc_sub.c @@ -9,8 +9,8 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_cdotc_sub( const int N, const void *X, const int incX, - const void *Y, const int incY, void *dotc) +void API_SUFFIX(cblas_cdotc_sub)( const CBLAS_INT N, const void *X, const CBLAS_INT incX, + const void *Y, const CBLAS_INT incY, void *dotc) { #ifdef F77_INT F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; diff --git a/CBLAS/src/cblas_cdotu_sub.c b/CBLAS/src/cblas_cdotu_sub.c index b92e08e549..e513fed057 100644 --- a/CBLAS/src/cblas_cdotu_sub.c +++ b/CBLAS/src/cblas_cdotu_sub.c @@ -9,8 +9,8 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_cdotu_sub( const int N, const void *X, const int incX, - const void *Y, const int incY, void *dotu) +void API_SUFFIX(cblas_cdotu_sub)( const CBLAS_INT N, const void *X, const CBLAS_INT incX, + const void *Y, const CBLAS_INT incY, void *dotu) { #ifdef F77_INT F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; diff --git a/CBLAS/src/cblas_cgbmv.c b/CBLAS/src/cblas_cgbmv.c index 6d0fa4f83b..776fcbc7eb 100644 --- a/CBLAS/src/cblas_cgbmv.c +++ b/CBLAS/src/cblas_cgbmv.c @@ -7,14 +7,16 @@ */ #include #include +#include + #include "cblas.h" #include "cblas_f77.h" -void cblas_cgbmv(const CBLAS_LAYOUT layout, - const CBLAS_TRANSPOSE TransA, const int M, const int N, - const int KL, const int KU, - const void *alpha, const void *A, const int lda, - const void *X, const int incX, const void *beta, - void *Y, const int incY) +void API_SUFFIX(cblas_cgbmv)(const CBLAS_LAYOUT layout, + const CBLAS_TRANSPOSE TransA, const CBLAS_INT M, const CBLAS_INT N, + const CBLAS_INT KL, const CBLAS_INT KU, + const void *alpha, const void *A, const CBLAS_INT lda, + const void *X, const CBLAS_INT incX, const void *beta, + void *Y, const CBLAS_INT incY) { char TA; #ifdef F77_CHAR @@ -26,6 +28,7 @@ void cblas_cgbmv(const CBLAS_LAYOUT layout, F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY; F77_INT F77_KL=KL,F77_KU=KU; #else + CBLAS_INT incx=incX; #define F77_M M #define F77_N N #define F77_lda lda @@ -34,15 +37,19 @@ void cblas_cgbmv(const CBLAS_LAYOUT layout, #define F77_incX incx #define F77_incY incY #endif - int n=0, i=0, incx=incX; - const float *xx= (float *)X, *alp= (float *)alpha, *bet = (float *)beta; + CBLAS_INT n=0, i=0; + const float *xx= (const float *)X, *alp= (const float *)alpha, *bet = (const float *)beta; float ALPHA[2],BETA[2]; - int tincY, tincx; - float *x=(float *)X, *y=(float *)Y, *st=0, *tx=0; + CBLAS_INT tincY, tincx; + float *x, *y, *st=0, *tx=0; extern int CBLAS_CallFromC; extern int RowMajorStrg; RowMajorStrg = 0; + memcpy(&x, &X, sizeof(float*)); + memcpy(&y, &Y, sizeof(float*)); + + CBLAS_CallFromC = 1; if (layout == CblasColMajor) { @@ -51,7 +58,7 @@ void cblas_cgbmv(const CBLAS_LAYOUT layout, else if (TransA == CblasConjTrans) TA = 'C'; else { - cblas_xerbla(2, "cblas_cgbmv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(2, "cblas_cgbmv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -125,13 +132,13 @@ void cblas_cgbmv(const CBLAS_LAYOUT layout, y -= n; } } - else x = (float *) X; + else memcpy(&x, &X, sizeof(float*)); } else { - cblas_xerbla(2, "cblas_cgbmv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(2, "cblas_cgbmv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -159,7 +166,7 @@ void cblas_cgbmv(const CBLAS_LAYOUT layout, } } } - else cblas_xerbla(1, "cblas_cgbmv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_cgbmv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; } diff --git a/CBLAS/src/cblas_cgemm.c b/CBLAS/src/cblas_cgemm.c index a1fad4a027..5950ed1f8c 100644 --- a/CBLAS/src/cblas_cgemm.c +++ b/CBLAS/src/cblas_cgemm.c @@ -9,11 +9,11 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_cgemm(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA, - const CBLAS_TRANSPOSE TransB, const int M, const int N, - const int K, const void *alpha, const void *A, - const int lda, const void *B, const int ldb, - const void *beta, void *C, const int ldc) +void API_SUFFIX(cblas_cgemm)(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA, + const CBLAS_TRANSPOSE TransB, const CBLAS_INT M, const CBLAS_INT N, + const CBLAS_INT K, const void *alpha, const void *A, + const CBLAS_INT lda, const void *B, const CBLAS_INT ldb, + const void *beta, void *C, const CBLAS_INT ldc) { char TA, TB; #ifdef F77_CHAR @@ -47,7 +47,7 @@ void cblas_cgemm(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA, else if ( TransA == CblasNoTrans ) TA='N'; else { - cblas_xerbla(2, "cblas_cgemm", "Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(2, "cblas_cgemm", "Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -58,7 +58,7 @@ void cblas_cgemm(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA, else if ( TransB == CblasNoTrans ) TB='N'; else { - cblas_xerbla(3, "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; @@ -79,7 +79,7 @@ void cblas_cgemm(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA, else if ( TransA == CblasNoTrans ) TB='N'; else { - cblas_xerbla(2, "cblas_cgemm", "Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(2, "cblas_cgemm", "Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -89,7 +89,7 @@ void cblas_cgemm(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA, else if ( TransB == CblasNoTrans ) TA='N'; else { - 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; @@ -102,7 +102,7 @@ void cblas_cgemm(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA, F77_cgemm(F77_TA, F77_TB, &F77_N, &F77_M, &F77_K, alpha, B, &F77_ldb, A, &F77_lda, beta, C, &F77_ldc); } - else cblas_xerbla(1, "cblas_cgemm", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_cgemm", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_cgemmtr.c b/CBLAS/src/cblas_cgemmtr.c new file mode 100644 index 0000000000..5717dc4097 --- /dev/null +++ b/CBLAS/src/cblas_cgemmtr.c @@ -0,0 +1,134 @@ +/* + * + * cblas_cgemmtr.c + * This program is a C interface to cgemmtr. + * Written by Martin Koehler, MPI Magdeburg + * 06/24/2024 + * + */ + +#include "cblas.h" +#include "cblas_f77.h" +void API_SUFFIX(cblas_cgemmtr)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, + const CBLAS_TRANSPOSE TransB, const CBLAS_INT N, + const CBLAS_INT K, const void *alpha, const void *A, + const CBLAS_INT lda, const void *B, const CBLAS_INT ldb, + const void *beta, void *C, const CBLAS_INT ldc) +{ + char TA, TB; + char UL; +#ifdef F77_CHAR + F77_CHAR F77_TA, F77_TB, F77_UL; +#else +#define F77_TA &TA +#define F77_TB &TB +#define F77_UL &UL +#endif + +#ifdef F77_INT + F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb; + F77_INT F77_ldc=ldc; +#else +#define F77_N N +#define F77_K K +#define F77_lda lda +#define F77_ldb ldb +#define F77_ldc ldc +#endif + + extern int CBLAS_CallFromC; + extern int RowMajorStrg; + RowMajorStrg = 0; + CBLAS_CallFromC = 1; + + + if( layout == CblasColMajor ) + { + if ( Uplo == CblasUpper ) UL = 'U'; + else if (Uplo == CblasLower) UL= 'L'; + else { + API_SUFFIX(cblas_xerbla)(2, "cblas_cgemmtr", "Illegal Uplo setting, %d\n", Uplo); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + if(TransA == CblasTrans) TA='T'; + else if ( TransA == CblasConjTrans ) TA='C'; + else if ( TransA == CblasNoTrans ) TA='N'; + else + { + API_SUFFIX(cblas_xerbla)(3, "cblas_cgemmtr", "Illegal TransA setting, %d\n", TransA); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + if(TransB == CblasTrans) TB='T'; + else if ( TransB == CblasConjTrans ) TB='C'; + else if ( TransB == CblasNoTrans ) TB='N'; + else + { + API_SUFFIX(cblas_xerbla)(4, "cblas_cgemmtr", "Illegal TransB setting, %d\n", TransB); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + +#ifdef F77_CHAR + F77_TA = C2F_CHAR(&TA); + F77_TB = C2F_CHAR(&TB); + F77_UL = C2F_CHAR(&UL); +#endif + + F77_cgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, alpha, A, + &F77_lda, B, &F77_ldb, beta, C, &F77_ldc); + } + else if (layout == CblasRowMajor) + { + RowMajorStrg = 1; + + if ( Uplo == CblasUpper ) UL = 'L'; + else if (Uplo == CblasLower) UL= 'U'; + else { + API_SUFFIX(cblas_xerbla)(2, "cblas_cgemmtr", "Illegal Uplo setting, %d\n", Uplo); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + if(TransA == CblasTrans) TB='T'; + else if ( TransA == CblasConjTrans ) TB='C'; + else if ( TransA == CblasNoTrans ) TB='N'; + else + { + API_SUFFIX(cblas_xerbla)(3, "cblas_cgemmtr", "Illegal TransA setting, %d\n", TransA); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + if(TransB == CblasTrans) TA='T'; + else if ( TransB == CblasConjTrans ) TA='C'; + else if ( TransB == CblasNoTrans ) TA='N'; + else + { + API_SUFFIX(cblas_xerbla)(4, "cblas_cgemmtr", "Illegal TransB setting, %d\n", TransB); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } +#ifdef F77_CHAR + F77_TA = C2F_CHAR(&TA); + F77_TB = C2F_CHAR(&TB); + F77_UL = C2F_CHAR(&UL); + +#endif + + F77_cgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, alpha, B, + &F77_ldb, A, &F77_lda, beta, C, &F77_ldc); + } + else API_SUFFIX(cblas_xerbla)(1, "cblas_cgemmtr", "Illegal layout setting, %d\n", layout); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; +} diff --git a/CBLAS/src/cblas_cgemv.c b/CBLAS/src/cblas_cgemv.c index 57c9241e89..a9a27f4562 100644 --- a/CBLAS/src/cblas_cgemv.c +++ b/CBLAS/src/cblas_cgemv.c @@ -7,13 +7,14 @@ */ #include #include +#include #include "cblas.h" #include "cblas_f77.h" -void cblas_cgemv(const CBLAS_LAYOUT layout, - const CBLAS_TRANSPOSE TransA, const int M, const int N, - const void *alpha, const void *A, const int lda, - const void *X, const int incX, const void *beta, - void *Y, const int incY) +void API_SUFFIX(cblas_cgemv)(const CBLAS_LAYOUT layout, + const CBLAS_TRANSPOSE TransA, const CBLAS_INT M, const CBLAS_INT N, + const void *alpha, const void *A, const CBLAS_INT lda, + const void *X, const CBLAS_INT incX, const void *beta, + void *Y, const CBLAS_INT incY) { char TA; #ifdef F77_CHAR @@ -31,18 +32,22 @@ void cblas_cgemv(const CBLAS_LAYOUT layout, #define F77_incY incY #endif - int n=0, i=0, incx=incX; + CBLAS_INT n=0, i=0; const float *xx= (const float *)X; float ALPHA[2],BETA[2]; - int tincY, tincx; - float *x=(float *)X, *y=(float *)Y, *st=0, *tx=0; - const float *stx = x; + CBLAS_INT tincY, tincx; + float *x, *y, *st=0, *tx=0; extern int CBLAS_CallFromC; extern int RowMajorStrg; RowMajorStrg = 0; CBLAS_CallFromC = 1; + memcpy(&x, &X, sizeof(float *)); + memcpy(&y, &Y, sizeof(float *)); + + const float *stx = x; + if (layout == CblasColMajor) { if (TransA == CblasNoTrans) TA = 'N'; @@ -50,7 +55,7 @@ void cblas_cgemv(const CBLAS_LAYOUT layout, else if (TransA == CblasConjTrans) TA = 'C'; else { - cblas_xerbla(2, "cblas_cgemv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(2, "cblas_cgemv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -126,7 +131,7 @@ void cblas_cgemv(const CBLAS_LAYOUT layout, } else { - cblas_xerbla(2, "cblas_cgemv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(2, "cblas_cgemv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -155,7 +160,7 @@ void cblas_cgemv(const CBLAS_LAYOUT layout, } } } - else cblas_xerbla(1, "cblas_cgemv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_cgemv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_cgerc.c b/CBLAS/src/cblas_cgerc.c index 6d718be92c..f9e4af33cc 100644 --- a/CBLAS/src/cblas_cgerc.c +++ b/CBLAS/src/cblas_cgerc.c @@ -7,15 +7,18 @@ */ #include #include +#include + #include "cblas.h" #include "cblas_f77.h" -void cblas_cgerc(const CBLAS_LAYOUT layout, const int M, const int N, - const void *alpha, const void *X, const int incX, - const void *Y, const int incY, void *A, const int lda) +void API_SUFFIX(cblas_cgerc)(const CBLAS_LAYOUT layout, const CBLAS_INT M, const CBLAS_INT N, + const void *alpha, const void *X, const CBLAS_INT incX, + const void *Y, const CBLAS_INT incY, void *A, const CBLAS_INT lda) { #ifdef F77_INT F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY; #else + CBLAS_INT incy = incY; #define F77_M M #define F77_N N #define F77_incX incX @@ -23,8 +26,10 @@ void cblas_cgerc(const CBLAS_LAYOUT layout, const int M, const int N, #define F77_lda lda #endif - int n, i, tincy, incy=incY; - float *y=(float *)Y, *yy=(float *)Y, *ty, *st; + CBLAS_INT n, i, tincy; + float *y, *yy, *ty, *st; + memcpy(&y,&Y,sizeof(float*)); + memcpy(&yy,&Y,sizeof(float*)); extern int CBLAS_CallFromC; extern int RowMajorStrg; @@ -70,14 +75,15 @@ void cblas_cgerc(const CBLAS_LAYOUT layout, const int M, const int N, incy = 1; #endif } - else y = (float *) Y; + else + memcpy(&y,&Y,sizeof(float*)); F77_cgeru( &F77_N, &F77_M, alpha, y, &F77_incY, X, &F77_incX, A, &F77_lda); if(Y!=y) free(y); - } else cblas_xerbla(1, "cblas_cgerc", "Illegal layout setting, %d\n", layout); + } else API_SUFFIX(cblas_xerbla)(1, "cblas_cgerc", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_cgeru.c b/CBLAS/src/cblas_cgeru.c index bb0671b6ca..ea5b74bc4a 100644 --- a/CBLAS/src/cblas_cgeru.c +++ b/CBLAS/src/cblas_cgeru.c @@ -7,9 +7,9 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_cgeru(const CBLAS_LAYOUT layout, const int M, const int N, - const void *alpha, const void *X, const int incX, - const void *Y, const int incY, void *A, const int lda) +void API_SUFFIX(cblas_cgeru)(const CBLAS_LAYOUT layout, const CBLAS_INT M, const CBLAS_INT N, + const void *alpha, const void *X, const CBLAS_INT incX, + const void *Y, const CBLAS_INT incY, void *A, const CBLAS_INT lda) { #ifdef F77_INT F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY; @@ -38,7 +38,7 @@ void cblas_cgeru(const CBLAS_LAYOUT layout, const int M, const int N, F77_cgeru( &F77_N, &F77_M, alpha, Y, &F77_incY, X, &F77_incX, A, &F77_lda); } - else cblas_xerbla(1, "cblas_cgeru","Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_cgeru","Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_chbmv.c b/CBLAS/src/cblas_chbmv.c index e2ac98d079..5fab2022cd 100644 --- a/CBLAS/src/cblas_chbmv.c +++ b/CBLAS/src/cblas_chbmv.c @@ -9,11 +9,12 @@ #include "cblas_f77.h" #include #include -void cblas_chbmv(const CBLAS_LAYOUT layout, - const CBLAS_UPLO Uplo,const int N,const int K, - const void *alpha, const void *A, const int lda, - const void *X, const int incX, const void *beta, - void *Y, const int incY) +#include +void API_SUFFIX(cblas_chbmv)(const CBLAS_LAYOUT layout, + const CBLAS_UPLO Uplo,const CBLAS_INT N,const CBLAS_INT K, + const void *alpha, const void *A, const CBLAS_INT lda, + const void *X, const CBLAS_INT incX, const void *beta, + void *Y, const CBLAS_INT incY) { char UL; #ifdef F77_CHAR @@ -24,21 +25,25 @@ void cblas_chbmv(const CBLAS_LAYOUT layout, #ifdef F77_INT F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_incX=incX, F77_incY=incY; #else + CBLAS_INT incx = incX; #define F77_N N #define F77_K K #define F77_lda lda #define F77_incX incx #define F77_incY incY #endif - int n, i=0, incx=incX; - const float *xx= (float *)X, *alp= (float *)alpha, *bet = (float *)beta; + CBLAS_INT n, i=0; + const float *xx= (const float *)X, *alp= (const float *)alpha, *bet = (const float *)beta; float ALPHA[2],BETA[2]; - int tincY, tincx; - float *x=(float *)X, *y=(float *)Y, *st=0, *tx; + CBLAS_INT tincY, tincx; + float *x, *y, *st=0, *tx; extern int CBLAS_CallFromC; extern int RowMajorStrg; RowMajorStrg = 0; + memcpy(&x, &X, sizeof(float*)); + memcpy(&y, &Y, sizeof(float*)); + CBLAS_CallFromC = 1; if (layout == CblasColMajor) { @@ -46,7 +51,7 @@ void cblas_chbmv(const CBLAS_LAYOUT layout, else if (Uplo == CblasUpper) UL = 'U'; else { - cblas_xerbla(2, "cblas_chbmv","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_chbmv","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -114,13 +119,13 @@ void cblas_chbmv(const CBLAS_LAYOUT layout, } while(y != st); y -= n; } else - x = (float *) X; + memcpy(&x, &X, sizeof(float*)); if (Uplo == CblasUpper) UL = 'L'; else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_chbmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_chbmv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -133,7 +138,7 @@ void cblas_chbmv(const CBLAS_LAYOUT layout, } else { - cblas_xerbla(1, "cblas_chbmv","Illegal layout setting, %d\n", layout); + API_SUFFIX(cblas_xerbla)(1, "cblas_chbmv","Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_chemm.c b/CBLAS/src/cblas_chemm.c index 7d500dfcc0..4dd7b5c1ad 100644 --- a/CBLAS/src/cblas_chemm.c +++ b/CBLAS/src/cblas_chemm.c @@ -9,11 +9,11 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_chemm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, - const CBLAS_UPLO Uplo, const int M, const int N, - const void *alpha, const void *A, const int lda, - const void *B, const int ldb, const void *beta, - void *C, const int ldc) +void API_SUFFIX(cblas_chemm)(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, + const CBLAS_UPLO Uplo, const CBLAS_INT M, const CBLAS_INT N, + const void *alpha, const void *A, const CBLAS_INT lda, + const void *B, const CBLAS_INT ldb, const void *beta, + void *C, const CBLAS_INT ldc) { char SD, UL; #ifdef F77_CHAR @@ -45,7 +45,7 @@ void cblas_chemm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Side == CblasLeft ) SD='L'; else { - cblas_xerbla(2, "cblas_chemm", "Illegal Side setting, %d\n", Side); + API_SUFFIX(cblas_xerbla)(2, "cblas_chemm", "Illegal Side setting, %d\n", Side); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -55,7 +55,7 @@ void cblas_chemm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Uplo == CblasLower ) UL='L'; else { - cblas_xerbla(3, "cblas_chemm", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(3, "cblas_chemm", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -75,7 +75,7 @@ void cblas_chemm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Side == CblasLeft ) SD='R'; else { - cblas_xerbla(2, "cblas_chemm", "Illegal Side setting, %d\n", Side); + API_SUFFIX(cblas_xerbla)(2, "cblas_chemm", "Illegal Side setting, %d\n", Side); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -85,7 +85,7 @@ void cblas_chemm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Uplo == CblasLower ) UL='U'; else { - cblas_xerbla(3, "cblas_chemm", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(3, "cblas_chemm", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -99,7 +99,7 @@ void cblas_chemm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, F77_chemm(F77_SD, F77_UL, &F77_N, &F77_M, alpha, A, &F77_lda, B, &F77_ldb, beta, C, &F77_ldc); } - else cblas_xerbla(1, "cblas_chemm", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_chemm", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_chemv.c b/CBLAS/src/cblas_chemv.c index ad6a6d05a7..fd092be66c 100644 --- a/CBLAS/src/cblas_chemv.c +++ b/CBLAS/src/cblas_chemv.c @@ -7,13 +7,15 @@ */ #include #include +#include + #include "cblas.h" #include "cblas_f77.h" -void cblas_chemv(const CBLAS_LAYOUT layout, - const CBLAS_UPLO Uplo, const int N, - const void *alpha, const void *A, const int lda, - const void *X, const int incX, const void *beta, - void *Y, const int incY) +void API_SUFFIX(cblas_chemv)(const CBLAS_LAYOUT layout, + const CBLAS_UPLO Uplo, const CBLAS_INT N, + const void *alpha, const void *A, const CBLAS_INT lda, + const void *X, const CBLAS_INT incX, const void *beta, + void *Y, const CBLAS_INT incY) { char UL; #ifdef F77_CHAR @@ -24,20 +26,24 @@ void cblas_chemv(const CBLAS_LAYOUT layout, #ifdef F77_INT F77_INT F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY; #else + CBLAS_INT incx = incX; #define F77_N N #define F77_lda lda #define F77_incX incx #define F77_incY incY #endif - int n=0, i=0, incx=incX; - const float *xx= (float *)X, *alp= (float *)alpha, *bet = (float *)beta; + CBLAS_INT n=0, i=0; + const float *xx= (const float *)X, *alp= (const float *)alpha, *bet = (const float *)beta; float ALPHA[2],BETA[2]; - int tincY, tincx; - float *x=(float *)X, *y=(float *)Y, *st=0, *tx; + CBLAS_INT tincY, tincx; + float *x, *y, *st=0, *tx; extern int CBLAS_CallFromC; extern int RowMajorStrg; RowMajorStrg = 0; + memcpy(&x, &X, sizeof(float*)); + memcpy(&y, &Y, sizeof(float*)); + CBLAS_CallFromC = 1; if (layout == CblasColMajor) @@ -46,7 +52,7 @@ void cblas_chemv(const CBLAS_LAYOUT layout, else if (Uplo == CblasLower) UL = 'L'; else { - cblas_xerbla(2, "cblas_chemv","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_chemv","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -114,14 +120,14 @@ void cblas_chemv(const CBLAS_LAYOUT layout, } while(y != st); y -= n; } else - x = (float *) X; + memcpy(&x, &X, sizeof(float*)); if (Uplo == CblasUpper) UL = 'L'; else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_chemv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_chemv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -134,7 +140,7 @@ void cblas_chemv(const CBLAS_LAYOUT layout, } else { - cblas_xerbla(1, "cblas_chemv","Illegal layout setting, %d\n", layout); + API_SUFFIX(cblas_xerbla)(1, "cblas_chemv","Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_cher.c b/CBLAS/src/cblas_cher.c index c783073bc5..a5da13ba05 100644 --- a/CBLAS/src/cblas_cher.c +++ b/CBLAS/src/cblas_cher.c @@ -7,11 +7,12 @@ */ #include #include +#include #include "cblas.h" #include "cblas_f77.h" -void cblas_cher(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, - const int N, const float alpha, const void *X, const int incX - ,void *A, const int lda) +void API_SUFFIX(cblas_cher)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_INT N, const float alpha, const void *X, const CBLAS_INT incX + ,void *A, const CBLAS_INT lda) { char UL; #ifdef F77_CHAR @@ -23,17 +24,22 @@ void cblas_cher(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, #ifdef F77_INT F77_INT F77_N=N, F77_lda=lda, F77_incX=incX; #else + CBLAS_INT incx; #define F77_N N #define F77_lda lda #define F77_incX incx #endif - int n, i, tincx, incx=incX; - float *x=(float *)X, *xx=(float *)X, *tx, *st; + CBLAS_INT n, i, tincx; + float *x, *xx, *tx, *st; extern int CBLAS_CallFromC; extern int RowMajorStrg; RowMajorStrg = 0; + memcpy(&x,&X,sizeof(float*)); + memcpy(&xx,&X,sizeof(float*)); + + CBLAS_CallFromC = 1; if (layout == CblasColMajor) { @@ -41,7 +47,7 @@ void cblas_cher(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasUpper) UL = 'U'; else { - cblas_xerbla(2, "cblas_cher","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_cher","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -59,7 +65,7 @@ void cblas_cher(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_cher","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_cher","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -98,11 +104,13 @@ void cblas_cher(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, incx = 1; #endif } - else x = (float *) X; + else + memcpy(&x,&X,sizeof(float*)); + F77_cher(F77_UL, &F77_N, &alpha, x, &F77_incX, A, &F77_lda); } else { - cblas_xerbla(1, "cblas_cher","Illegal layout setting, %d\n", layout); + API_SUFFIX(cblas_xerbla)(1, "cblas_cher","Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_cher2.c b/CBLAS/src/cblas_cher2.c index 4bab665b82..f66c93e3d1 100644 --- a/CBLAS/src/cblas_cher2.c +++ b/CBLAS/src/cblas_cher2.c @@ -7,11 +7,12 @@ */ #include #include +#include #include "cblas.h" #include "cblas_f77.h" -void cblas_cher2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, - const int N, const void *alpha, const void *X, const int incX, - const void *Y, const int incY, void *A, const int lda) +void API_SUFFIX(cblas_cher2)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_INT N, const void *alpha, const void *X, const CBLAS_INT incX, + const void *Y, const CBLAS_INT incY, void *A, const CBLAS_INT lda) { char UL; #ifdef F77_CHAR @@ -23,19 +24,25 @@ void cblas_cher2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, #ifdef F77_INT F77_INT F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY; #else + CBLAS_INT incx = incX, incy = incY; #define F77_N N #define F77_lda lda #define F77_incX incx #define F77_incY incy #endif - int n, i, j, tincx, tincy, incx=incX, incy=incY; - float *x=(float *)X, *xx=(float *)X, *y=(float *)Y, - *yy=(float *)Y, *tx, *ty, *stx, *sty; + CBLAS_INT n, i, j, tincx, tincy; + float *x, *xx, *y, + *yy, *tx, *ty, *stx, *sty; extern int CBLAS_CallFromC; extern int RowMajorStrg; RowMajorStrg = 0; + memcpy(&x,&X,sizeof(float*)); + memcpy(&xx,&X,sizeof(float*)); + memcpy(&y,&Y,sizeof(float*)); + memcpy(&yy,&Y,sizeof(float*)); + CBLAS_CallFromC = 1; if (layout == CblasColMajor) { @@ -43,7 +50,7 @@ void cblas_cher2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasUpper) UL = 'U'; else { - cblas_xerbla(2, "cblas_cher2","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_cher2","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -62,7 +69,7 @@ void cblas_cher2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_cher2","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_cher2","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -129,14 +136,14 @@ void cblas_cher2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, #endif } else { - x = (float *) X; - y = (float *) Y; + memcpy(&x,&X,sizeof(float*)); + memcpy(&y,&Y,sizeof(float*)); } F77_cher2(F77_UL, &F77_N, alpha, y, &F77_incY, x, &F77_incX, A, &F77_lda); } else { - cblas_xerbla(1, "cblas_cher2","Illegal layout setting, %d\n", layout); + API_SUFFIX(cblas_xerbla)(1, "cblas_cher2","Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_cher2k.c b/CBLAS/src/cblas_cher2k.c index cae8c76104..374e47a8e8 100644 --- a/CBLAS/src/cblas_cher2k.c +++ b/CBLAS/src/cblas_cher2k.c @@ -9,11 +9,11 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_cher2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, - const CBLAS_TRANSPOSE Trans, const int N, const int K, - const void *alpha, const void *A, const int lda, - const void *B, const int ldb, const float beta, - void *C, const int ldc) +void API_SUFFIX(cblas_cher2k)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_TRANSPOSE Trans, const CBLAS_INT N, const CBLAS_INT K, + const void *alpha, const void *A, const CBLAS_INT lda, + const void *B, const CBLAS_INT ldb, const float beta, + void *C, const CBLAS_INT ldc) { char UL, TR; #ifdef F77_CHAR @@ -37,7 +37,7 @@ void cblas_cher2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, extern int CBLAS_CallFromC; extern int RowMajorStrg; float ALPHA[2]; - const float *alp=(float *)alpha; + const float *alp=(const float *)alpha; CBLAS_CallFromC = 1; RowMajorStrg = 0; @@ -49,7 +49,7 @@ void cblas_cher2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='L'; else { - cblas_xerbla(2, "cblas_cher2k", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_cher2k", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -60,7 +60,7 @@ void cblas_cher2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Trans == CblasNoTrans ) TR='N'; else { - cblas_xerbla(3, "cblas_cher2k", "Illegal Trans setting, %d\n", Trans); + API_SUFFIX(cblas_xerbla)(3, "cblas_cher2k", "Illegal Trans setting, %d\n", Trans); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -80,17 +80,16 @@ void cblas_cher2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='U'; else { - cblas_xerbla(2, "cblas_cher2k", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_cher2k", "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 { - cblas_xerbla(3, "cblas_cher2k", "Illegal Trans setting, %d\n", Trans); + API_SUFFIX(cblas_xerbla)(3, "cblas_cher2k", "Illegal Trans setting, %d\n", Trans); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -104,7 +103,7 @@ void cblas_cher2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, ALPHA[1]= -alp[1]; F77_cher2k(F77_UL,F77_TR, &F77_N, &F77_K, ALPHA, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc); } - else cblas_xerbla(1, "cblas_cher2k", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_cher2k", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_cherk.c b/CBLAS/src/cblas_cherk.c index 16a94db4c2..0d50a37e5d 100644 --- a/CBLAS/src/cblas_cherk.c +++ b/CBLAS/src/cblas_cherk.c @@ -9,10 +9,10 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_cherk(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, - const CBLAS_TRANSPOSE Trans, const int N, const int K, - const float alpha, const void *A, const int lda, - const float beta, void *C, const int ldc) +void API_SUFFIX(cblas_cherk)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_TRANSPOSE Trans, const CBLAS_INT N, const CBLAS_INT K, + const float alpha, const void *A, const CBLAS_INT lda, + const float beta, void *C, const CBLAS_INT ldc) { char UL, TR; #ifdef F77_CHAR @@ -43,7 +43,7 @@ void cblas_cherk(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='L'; else { - cblas_xerbla(2, "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; @@ -54,7 +54,7 @@ void cblas_cherk(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Trans == CblasNoTrans ) TR='N'; else { - cblas_xerbla(3, "cblas_cherk", "Illegal Trans setting, %d\n", Trans); + API_SUFFIX(cblas_xerbla)(3, "cblas_cherk", "Illegal Trans setting, %d\n", Trans); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -74,17 +74,16 @@ void cblas_cherk(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='U'; else { - 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 { - cblas_xerbla(3, "cblas_cherk", "Illegal Trans setting, %d\n", Trans); + API_SUFFIX(cblas_xerbla)(3, "cblas_cherk", "Illegal Trans setting, %d\n", Trans); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -98,7 +97,7 @@ void cblas_cherk(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, F77_cherk(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda, &beta, C, &F77_ldc); } - else cblas_xerbla(1, "cblas_cherk", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_cherk", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_chpmv.c b/CBLAS/src/cblas_chpmv.c index 8ec1cec96d..6c8e829dea 100644 --- a/CBLAS/src/cblas_chpmv.c +++ b/CBLAS/src/cblas_chpmv.c @@ -7,13 +7,15 @@ */ #include #include +#include + #include "cblas.h" #include "cblas_f77.h" -void cblas_chpmv(const CBLAS_LAYOUT layout, - const CBLAS_UPLO Uplo,const int N, +void API_SUFFIX(cblas_chpmv)(const CBLAS_LAYOUT layout, + const CBLAS_UPLO Uplo,const CBLAS_INT N, const void *alpha, const void *AP, - const void *X, const int incX, const void *beta, - void *Y, const int incY) + const void *X, const CBLAS_INT incX, const void *beta, + void *Y, const CBLAS_INT incY) { char UL; #ifdef F77_CHAR @@ -24,19 +26,24 @@ void cblas_chpmv(const CBLAS_LAYOUT layout, #ifdef F77_INT F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; #else + CBLAS_INT incx = incX; #define F77_N N #define F77_incX incx #define F77_incY incY #endif - int n, i=0, incx=incX; - const float *xx= (float *)X, *alp= (float *)alpha, *bet = (float *)beta; + CBLAS_INT n, i=0; + const float *xx= (const float *)X, *alp= (const float *)alpha, *bet = (const float *)beta; float ALPHA[2],BETA[2]; - int tincY, tincx; - float *x=(float *)X, *y=(float *)Y, *st=0, *tx; + CBLAS_INT tincY, tincx; + float *x, *y, *st=0, *tx; extern int CBLAS_CallFromC; extern int RowMajorStrg; RowMajorStrg = 0; + memcpy(&x,&X,sizeof(float*)); + memcpy(&y,&Y,sizeof(float*)); + + CBLAS_CallFromC = 1; if (layout == CblasColMajor) { @@ -44,7 +51,7 @@ void cblas_chpmv(const CBLAS_LAYOUT layout, else if (Uplo == CblasUpper) UL = 'U'; else { - cblas_xerbla(2, "cblas_chpmv","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_chpmv","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -112,14 +119,13 @@ void cblas_chpmv(const CBLAS_LAYOUT layout, } while(y != st); y -= n; } else - x = (float *) X; - + memcpy(&x,&X,sizeof(float*)); if (Uplo == CblasUpper) UL = 'L'; else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_chpmv","Illegal Uplo setting, %d\n", Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_chpmv","Illegal Uplo setting, %d\n", Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -133,7 +139,7 @@ void cblas_chpmv(const CBLAS_LAYOUT layout, } else { - cblas_xerbla(1, "cblas_chpmv","Illegal layout setting, %d\n", layout); + API_SUFFIX(cblas_xerbla)(1, "cblas_chpmv","Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_chpr.c b/CBLAS/src/cblas_chpr.c index 82a108d1c0..ff4220690d 100644 --- a/CBLAS/src/cblas_chpr.c +++ b/CBLAS/src/cblas_chpr.c @@ -7,11 +7,13 @@ */ #include #include +#include + #include "cblas.h" #include "cblas_f77.h" -void cblas_chpr(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, - const int N, const float alpha, const void *X, - const int incX, void *A) +void API_SUFFIX(cblas_chpr)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_INT N, const float alpha, const void *X, + const CBLAS_INT incX, void *A) { char UL; #ifdef F77_CHAR @@ -23,16 +25,20 @@ void cblas_chpr(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, #ifdef F77_INT F77_INT F77_N=N, F77_incX=incX; #else + CBLAS_INT incx = incX; #define F77_N N #define F77_incX incx #endif - int n, i, tincx, incx=incX; - float *x=(float *)X, *xx=(float *)X, *tx, *st; + CBLAS_INT n, i, tincx; + float *x, *xx, *tx, *st; extern int CBLAS_CallFromC; extern int RowMajorStrg; RowMajorStrg = 0; + memcpy(&x,&X,sizeof(float*)); + memcpy(&xx,&X,sizeof(float*)); + CBLAS_CallFromC = 1; if (layout == CblasColMajor) { @@ -40,7 +46,7 @@ void cblas_chpr(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasUpper) UL = 'U'; else { - cblas_xerbla(2, "cblas_chpr","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_chpr","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -58,7 +64,7 @@ void cblas_chpr(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_chpr","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_chpr","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -96,13 +102,14 @@ void cblas_chpr(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, incx = 1; #endif } - else x = (float *) X; + else + memcpy(&x,&X,sizeof(float*)); F77_chpr(F77_UL, &F77_N, &alpha, x, &F77_incX, A); } else { - cblas_xerbla(1, "cblas_chpr","Illegal layout setting, %d\n", layout); + API_SUFFIX(cblas_xerbla)(1, "cblas_chpr","Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_chpr2.c b/CBLAS/src/cblas_chpr2.c index 5277f878cd..435738a1c3 100644 --- a/CBLAS/src/cblas_chpr2.c +++ b/CBLAS/src/cblas_chpr2.c @@ -7,11 +7,12 @@ */ #include #include +#include #include "cblas.h" #include "cblas_f77.h" -void cblas_chpr2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, - const int N,const void *alpha, const void *X, - const int incX,const void *Y, const int incY, void *Ap) +void API_SUFFIX(cblas_chpr2)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_INT N,const void *alpha, const void *X, + const CBLAS_INT incX,const void *Y, const CBLAS_INT incY, void *Ap) { char UL; @@ -24,18 +25,25 @@ void cblas_chpr2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, #ifdef F77_INT F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; #else + CBLAS_INT incx = incX; + CBLAS_INT incy = incY; #define F77_N N #define F77_incX incx #define F77_incY incy #endif - int n, i, j, tincx, tincy, incx=incX, incy=incY; - float *x=(float *)X, *xx=(float *)X, *y=(float *)Y, - *yy=(float *)Y, *tx, *ty, *stx, *sty; + CBLAS_INT n, i, j, tincx, tincy; + float *x, *xx, *y, + *yy, *tx, *ty, *stx, *sty; extern int CBLAS_CallFromC; extern int RowMajorStrg; RowMajorStrg = 0; + memcpy(&x,&X,sizeof(float*)); + memcpy(&xx,&X,sizeof(float*)); + memcpy(&y,&Y,sizeof(float*)); + memcpy(&yy,&Y,sizeof(float*)); + CBLAS_CallFromC = 1; if (layout == CblasColMajor) { @@ -43,7 +51,7 @@ void cblas_chpr2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasUpper) UL = 'U'; else { - cblas_xerbla(2, "cblas_chpr2","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_chpr2","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -61,7 +69,7 @@ void cblas_chpr2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_chpr2","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_chpr2","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -128,13 +136,13 @@ void cblas_chpr2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, } else { - x = (float *) X; - y = (void *) Y; + memcpy(&x,&X,sizeof(float*)); + memcpy(&y,&Y,sizeof(float*)); } F77_chpr2(F77_UL, &F77_N, alpha, y, &F77_incY, x, &F77_incX, Ap); } else { - cblas_xerbla(1, "cblas_chpr2","Illegal layout setting, %d\n", layout); + API_SUFFIX(cblas_xerbla)(1, "cblas_chpr2","Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_crotg.c b/CBLAS/src/cblas_crotg.c new file mode 100644 index 0000000000..7f489ccdce --- /dev/null +++ b/CBLAS/src/cblas_crotg.c @@ -0,0 +1,13 @@ +/* + * cblas_crotg.c + * + * The program is a C interface to crotg. + * + */ +#include "cblas.h" +#include "cblas_f77.h" +void API_SUFFIX(cblas_crotg)(void *a, void *b, float *c, void *s) +{ + F77_crotg(a,b,c,s); +} + diff --git a/CBLAS/src/cblas_cscal.c b/CBLAS/src/cblas_cscal.c index 904881f1d3..6e35d5885a 100644 --- a/CBLAS/src/cblas_cscal.c +++ b/CBLAS/src/cblas_cscal.c @@ -8,8 +8,8 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_cscal( const int N, const void *alpha, void *X, - const int incX) +void API_SUFFIX(cblas_cscal)( const CBLAS_INT N, const void *alpha, void *X, + const CBLAS_INT incX) { #ifdef F77_INT F77_INT F77_N=N, F77_incX=incX; diff --git a/CBLAS/src/cblas_csrot.c b/CBLAS/src/cblas_csrot.c new file mode 100644 index 0000000000..4f6164029a --- /dev/null +++ b/CBLAS/src/cblas_csrot.c @@ -0,0 +1,21 @@ +/* + * cblas_csrot.c + * + * The program is a C interface to csrot. + * + */ +#include "cblas.h" +#include "cblas_f77.h" +void API_SUFFIX(cblas_csrot)(const CBLAS_INT N, void *X, const CBLAS_INT incX, + void *Y, const CBLAS_INT incY, const float c, const float s) +{ +#ifdef F77_INT + F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; +#else + #define F77_N N + #define F77_incX incX + #define F77_incY incY +#endif + F77_csrot(&F77_N, X, &F77_incX, Y, &F77_incY, &c, &s); + return; +} diff --git a/CBLAS/src/cblas_csscal.c b/CBLAS/src/cblas_csscal.c index 117ed40517..df6952d070 100644 --- a/CBLAS/src/cblas_csscal.c +++ b/CBLAS/src/cblas_csscal.c @@ -8,8 +8,8 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_csscal( const int N, const float alpha, void *X, - const int incX) +void API_SUFFIX(cblas_csscal)( const CBLAS_INT N, const float alpha, void *X, + const CBLAS_INT incX) { #ifdef F77_INT F77_INT F77_N=N, F77_incX=incX; diff --git a/CBLAS/src/cblas_cswap.c b/CBLAS/src/cblas_cswap.c index 738d35cf19..8a2bfe5c0f 100644 --- a/CBLAS/src/cblas_cswap.c +++ b/CBLAS/src/cblas_cswap.c @@ -8,8 +8,8 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_cswap( const int N, void *X, const int incX, void *Y, - const int incY) +void API_SUFFIX(cblas_cswap)( const CBLAS_INT N, void *X, const CBLAS_INT incX, void *Y, + const CBLAS_INT incY) { #ifdef F77_INT F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; diff --git a/CBLAS/src/cblas_csymm.c b/CBLAS/src/cblas_csymm.c index d60ebb8461..15827e7fca 100644 --- a/CBLAS/src/cblas_csymm.c +++ b/CBLAS/src/cblas_csymm.c @@ -9,11 +9,11 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_csymm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, - const CBLAS_UPLO Uplo, const int M, const int N, - const void *alpha, const void *A, const int lda, - const void *B, const int ldb, const void *beta, - void *C, const int ldc) +void API_SUFFIX(cblas_csymm)(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, + const CBLAS_UPLO Uplo, const CBLAS_INT M, const CBLAS_INT N, + const void *alpha, const void *A, const CBLAS_INT lda, + const void *B, const CBLAS_INT ldb, const void *beta, + void *C, const CBLAS_INT ldc) { char SD, UL; #ifdef F77_CHAR @@ -45,7 +45,7 @@ void cblas_csymm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Side == CblasLeft ) SD='L'; else { - cblas_xerbla(2, "cblas_csymm", "Illegal Side setting, %d\n", Side); + API_SUFFIX(cblas_xerbla)(2, "cblas_csymm", "Illegal Side setting, %d\n", Side); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -55,7 +55,7 @@ void cblas_csymm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Uplo == CblasLower ) UL='L'; else { - cblas_xerbla(3, "cblas_csymm", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(3, "cblas_csymm", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -75,7 +75,7 @@ void cblas_csymm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Side == CblasLeft ) SD='R'; else { - cblas_xerbla(2, "cblas_csymm", "Illegal Side setting, %d\n", Side); + API_SUFFIX(cblas_xerbla)(2, "cblas_csymm", "Illegal Side setting, %d\n", Side); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -85,7 +85,7 @@ void cblas_csymm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Uplo == CblasLower ) UL='U'; else { - cblas_xerbla(3, "cblas_csymm", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(3, "cblas_csymm", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -99,7 +99,7 @@ void cblas_csymm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, F77_csymm(F77_SD, F77_UL, &F77_N, &F77_M, alpha, A, &F77_lda, B, &F77_ldb, beta, C, &F77_ldc); } - else cblas_xerbla(1, "cblas_csymm", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_csymm", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_csyr2k.c b/CBLAS/src/cblas_csyr2k.c index 4bbd417a82..62c8cd033e 100644 --- a/CBLAS/src/cblas_csyr2k.c +++ b/CBLAS/src/cblas_csyr2k.c @@ -9,11 +9,11 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_csyr2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, - const CBLAS_TRANSPOSE Trans, const int N, const int K, - const void *alpha, const void *A, const int lda, - const void *B, const int ldb, const void *beta, - void *C, const int ldc) +void API_SUFFIX(cblas_csyr2k)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_TRANSPOSE Trans, const CBLAS_INT N, const CBLAS_INT K, + const void *alpha, const void *A, const CBLAS_INT lda, + const void *B, const CBLAS_INT ldb, const void *beta, + void *C, const CBLAS_INT ldc) { char UL, TR; #ifdef F77_CHAR @@ -46,7 +46,7 @@ void cblas_csyr2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='L'; else { - cblas_xerbla(2, "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; @@ -57,7 +57,7 @@ void cblas_csyr2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Trans == CblasNoTrans ) TR='N'; else { - cblas_xerbla(3, "cblas_csyr2k", "Illegal Trans setting, %d\n", Trans); + API_SUFFIX(cblas_xerbla)(3, "cblas_csyr2k", "Illegal Trans setting, %d\n", Trans); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -78,17 +78,16 @@ void cblas_csyr2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='U'; else { - 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 { - cblas_xerbla(3, "cblas_csyr2k", "Illegal Trans setting, %d\n", Trans); + API_SUFFIX(cblas_xerbla)(3, "cblas_csyr2k", "Illegal Trans setting, %d\n", Trans); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -101,7 +100,7 @@ void cblas_csyr2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, F77_csyr2k(F77_UL, F77_TR, &F77_N, &F77_K, alpha, A, &F77_lda, B, &F77_ldb, beta, C, &F77_ldc); } - else cblas_xerbla(1, "cblas_csyr2k", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_csyr2k", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_csyrk.c b/CBLAS/src/cblas_csyrk.c index 26b745bdac..f87383ddd4 100644 --- a/CBLAS/src/cblas_csyrk.c +++ b/CBLAS/src/cblas_csyrk.c @@ -9,10 +9,10 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_csyrk(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, - const CBLAS_TRANSPOSE Trans, const int N, const int K, - const void *alpha, const void *A, const int lda, - const void *beta, void *C, const int ldc) +void API_SUFFIX(cblas_csyrk)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_TRANSPOSE Trans, const CBLAS_INT N, const CBLAS_INT K, + const void *alpha, const void *A, const CBLAS_INT lda, + const void *beta, void *C, const CBLAS_INT ldc) { char UL, TR; #ifdef F77_CHAR @@ -44,7 +44,7 @@ void cblas_csyrk(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='L'; else { - cblas_xerbla(2, "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; @@ -55,7 +55,7 @@ void cblas_csyrk(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Trans == CblasNoTrans ) TR='N'; else { - cblas_xerbla(3, "cblas_csyrk", "Illegal Trans setting, %d\n", Trans); + API_SUFFIX(cblas_xerbla)(3, "cblas_csyrk", "Illegal Trans setting, %d\n", Trans); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -76,17 +76,16 @@ void cblas_csyrk(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='U'; else { - 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 { - cblas_xerbla(3, "cblas_csyrk", "Illegal Trans setting, %d\n", Trans); + API_SUFFIX(cblas_xerbla)(3, "cblas_csyrk", "Illegal Trans setting, %d\n", Trans); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -100,7 +99,7 @@ void cblas_csyrk(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, F77_csyrk(F77_UL, F77_TR, &F77_N, &F77_K, alpha, A, &F77_lda, beta, C, &F77_ldc); } - else cblas_xerbla(1, "cblas_csyrk", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_csyrk", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_ctbmv.c b/CBLAS/src/cblas_ctbmv.c index 949e074331..697bf55e67 100644 --- a/CBLAS/src/cblas_ctbmv.c +++ b/CBLAS/src/cblas_ctbmv.c @@ -7,10 +7,10 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_ctbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, +void API_SUFFIX(cblas_ctbmv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, const CBLAS_DIAG Diag, - const int N, const int K, const void *A, const int lda, - void *X, const int incX) + const CBLAS_INT N, const CBLAS_INT K, const void *A, const CBLAS_INT lda, + void *X, const CBLAS_INT incX) { char TA; char UL; @@ -30,7 +30,7 @@ void cblas_ctbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, #define F77_lda lda #define F77_incX incX #endif - int n, i=0, tincX; + CBLAS_INT n, i=0, tincX; float *st=0, *x=(float *)X; extern int CBLAS_CallFromC; extern int RowMajorStrg; @@ -43,7 +43,7 @@ void cblas_ctbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'L'; else { - cblas_xerbla(2, "cblas_ctbmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_ctbmv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -53,7 +53,7 @@ void cblas_ctbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'C'; else { - cblas_xerbla(3, "cblas_ctbmv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_ctbmv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -62,7 +62,7 @@ void cblas_ctbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_ctbmv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_ctbmv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -82,7 +82,7 @@ void cblas_ctbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_ctbmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_ctbmv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -114,7 +114,7 @@ void cblas_ctbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, } else { - cblas_xerbla(3, "cblas_ctbmv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_ctbmv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -124,7 +124,7 @@ void cblas_ctbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - 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; @@ -151,7 +151,7 @@ void cblas_ctbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, } } } - else cblas_xerbla(1, "cblas_ctbmv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_ctbmv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_ctbsv.c b/CBLAS/src/cblas_ctbsv.c index 12696e112a..5aaaabdf25 100644 --- a/CBLAS/src/cblas_ctbsv.c +++ b/CBLAS/src/cblas_ctbsv.c @@ -7,10 +7,10 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_ctbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, +void API_SUFFIX(cblas_ctbsv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, const CBLAS_DIAG Diag, - const int N, const int K, const void *A, const int lda, - void *X, const int incX) + const CBLAS_INT N, const CBLAS_INT K, const void *A, const CBLAS_INT lda, + void *X, const CBLAS_INT incX) { char TA; char UL; @@ -30,7 +30,7 @@ void cblas_ctbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, #define F77_lda lda #define F77_incX incX #endif - int n, i=0, tincX; + CBLAS_INT n, i=0, tincX; float *st=0,*x=(float *)X; extern int CBLAS_CallFromC; extern int RowMajorStrg; @@ -43,7 +43,7 @@ void cblas_ctbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'L'; else { - cblas_xerbla(2, "cblas_ctbsv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_ctbsv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -53,7 +53,7 @@ void cblas_ctbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'C'; else { - cblas_xerbla(3, "cblas_ctbsv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_ctbsv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -62,7 +62,7 @@ void cblas_ctbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_ctbsv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_ctbsv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -82,7 +82,7 @@ void cblas_ctbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_ctbsv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_ctbsv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -118,7 +118,7 @@ void cblas_ctbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, } else { - cblas_xerbla(3, "cblas_ctbsv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_ctbsv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -128,7 +128,7 @@ void cblas_ctbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_ctbsv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_ctbsv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -155,7 +155,7 @@ void cblas_ctbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, } } } - else cblas_xerbla(1, "cblas_ctbsv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_ctbsv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_ctpmv.c b/CBLAS/src/cblas_ctpmv.c index 3f73172b03..97a45d383b 100644 --- a/CBLAS/src/cblas_ctpmv.c +++ b/CBLAS/src/cblas_ctpmv.c @@ -7,9 +7,9 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_ctpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, +void API_SUFFIX(cblas_ctpmv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, const CBLAS_DIAG Diag, - const int N, const void *Ap, void *X, const int incX) + const CBLAS_INT N, const void *Ap, void *X, const CBLAS_INT incX) { char TA; char UL; @@ -27,7 +27,7 @@ void cblas_ctpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, #define F77_N N #define F77_incX incX #endif - int n, i=0, tincX; + CBLAS_INT n, i=0, tincX; float *st=0,*x=(float *)X; extern int CBLAS_CallFromC; extern int RowMajorStrg; @@ -40,7 +40,7 @@ void cblas_ctpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'L'; else { - cblas_xerbla(2, "cblas_ctpmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_ctpmv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -50,7 +50,7 @@ void cblas_ctpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'C'; else { - cblas_xerbla(3, "cblas_ctpmv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_ctpmv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -59,7 +59,7 @@ void cblas_ctpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_ctpmv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_ctpmv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -78,7 +78,7 @@ void cblas_ctpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_ctpmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_ctpmv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -110,7 +110,7 @@ void cblas_ctpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, } else { - cblas_xerbla(3, "cblas_ctpmv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_ctpmv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -120,7 +120,7 @@ void cblas_ctpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_ctpmv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_ctpmv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -145,7 +145,7 @@ void cblas_ctpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, } } } - else cblas_xerbla(1, "cblas_ctpmv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_ctpmv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_ctpsv.c b/CBLAS/src/cblas_ctpsv.c index 4791e20f9c..4b9be145af 100644 --- a/CBLAS/src/cblas_ctpsv.c +++ b/CBLAS/src/cblas_ctpsv.c @@ -7,9 +7,9 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_ctpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, +void API_SUFFIX(cblas_ctpsv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, const CBLAS_DIAG Diag, - const int N, const void *Ap, void *X, const int incX) + const CBLAS_INT N, const void *Ap, void *X, const CBLAS_INT incX) { char TA; char UL; @@ -27,7 +27,7 @@ void cblas_ctpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, #define F77_N N #define F77_incX incX #endif - int n, i=0, tincX; + CBLAS_INT n, i=0, tincX; float *st=0, *x=(float*)X; extern int CBLAS_CallFromC; extern int RowMajorStrg; @@ -40,7 +40,7 @@ void cblas_ctpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'L'; else { - cblas_xerbla(2, "cblas_ctpsv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_ctpsv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -50,7 +50,7 @@ void cblas_ctpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'C'; else { - cblas_xerbla(3, "cblas_ctpsv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_ctpsv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -59,7 +59,7 @@ void cblas_ctpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_ctpsv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_ctpsv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -78,7 +78,7 @@ void cblas_ctpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_ctpsv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_ctpsv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -114,7 +114,7 @@ void cblas_ctpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, } else { - cblas_xerbla(3, "cblas_ctpsv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_ctpsv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -124,7 +124,7 @@ void cblas_ctpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_ctpsv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_ctpsv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -150,7 +150,7 @@ void cblas_ctpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, } } } - else cblas_xerbla(1, "cblas_ctpsv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_ctpsv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_ctrmm.c b/CBLAS/src/cblas_ctrmm.c index 7a7ab36242..2ec87fbd25 100644 --- a/CBLAS/src/cblas_ctrmm.c +++ b/CBLAS/src/cblas_ctrmm.c @@ -9,11 +9,11 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_ctrmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, +void API_SUFFIX(cblas_ctrmm)(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, - const CBLAS_DIAG Diag, const int M, const int N, - const void *alpha, const void *A, const int lda, - void *B, const int ldb) + const CBLAS_DIAG Diag, const CBLAS_INT M, const CBLAS_INT N, + const void *alpha, const void *A, const CBLAS_INT lda, + void *B, const CBLAS_INT ldb) { char UL, TA, SD, DI; #ifdef F77_CHAR @@ -45,7 +45,7 @@ void cblas_ctrmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Side == CblasLeft ) SD='L'; else { - cblas_xerbla(2, "cblas_ctrmm", "Illegal Side setting, %d\n", Side); + API_SUFFIX(cblas_xerbla)(2, "cblas_ctrmm", "Illegal Side setting, %d\n", Side); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -54,7 +54,7 @@ void cblas_ctrmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Uplo == CblasLower ) UL='L'; else { - cblas_xerbla(3, "cblas_ctrmm", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(3, "cblas_ctrmm", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -65,7 +65,7 @@ void cblas_ctrmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( TransA == CblasNoTrans ) TA='N'; else { - cblas_xerbla(4, "cblas_ctrmm", "Illegal Trans setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(4, "cblas_ctrmm", "Illegal Trans setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -73,8 +73,14 @@ void cblas_ctrmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, if( Diag == CblasUnit ) DI='U'; else if ( Diag == CblasNonUnit ) DI='N'; - else cblas_xerbla(5, "cblas_ctrmm", + else + { + API_SUFFIX(cblas_xerbla)(5, "cblas_ctrmm", "Illegal Diag setting, %d\n", Diag); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } #ifdef F77_CHAR F77_UL = C2F_CHAR(&UL); @@ -91,7 +97,7 @@ void cblas_ctrmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Side == CblasLeft ) SD='R'; else { - cblas_xerbla(2, "cblas_ctrmm", "Illegal Side setting, %d\n", Side); + API_SUFFIX(cblas_xerbla)(2, "cblas_ctrmm", "Illegal Side setting, %d\n", Side); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -101,7 +107,7 @@ void cblas_ctrmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Uplo == CblasLower ) UL='U'; else { - cblas_xerbla(3, "cblas_ctrmm", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(3, "cblas_ctrmm", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -112,7 +118,7 @@ void cblas_ctrmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( TransA == CblasNoTrans ) TA='N'; else { - cblas_xerbla(4, "cblas_ctrmm", "Illegal Trans setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(4, "cblas_ctrmm", "Illegal Trans setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -122,7 +128,7 @@ void cblas_ctrmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Diag == CblasNonUnit ) DI='N'; else { - cblas_xerbla(5, "cblas_ctrmm", "Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(5, "cblas_ctrmm", "Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -137,7 +143,7 @@ void cblas_ctrmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, F77_ctrmm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, alpha, A, &F77_lda, B, &F77_ldb); } - else cblas_xerbla(1, "cblas_ctrmm", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_ctrmm", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_ctrmv.c b/CBLAS/src/cblas_ctrmv.c index 447f7081cc..32dabd786e 100644 --- a/CBLAS/src/cblas_ctrmv.c +++ b/CBLAS/src/cblas_ctrmv.c @@ -7,10 +7,10 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_ctrmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, +void API_SUFFIX(cblas_ctrmv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, const CBLAS_DIAG Diag, - const int N, const void *A, const int lda, - void *X, const int incX) + const CBLAS_INT N, const void *A, const CBLAS_INT lda, + void *X, const CBLAS_INT incX) { char TA; @@ -30,7 +30,7 @@ void cblas_ctrmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, #define F77_lda lda #define F77_incX incX #endif - int n, i=0, tincX; + CBLAS_INT n, i=0, tincX; float *st=0,*x=(float *)X; extern int CBLAS_CallFromC; extern int RowMajorStrg; @@ -43,7 +43,7 @@ void cblas_ctrmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'L'; else { - cblas_xerbla(2, "cblas_ctrmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_ctrmv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -53,7 +53,7 @@ void cblas_ctrmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'C'; else { - cblas_xerbla(3, "cblas_ctrmv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_ctrmv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -62,7 +62,7 @@ void cblas_ctrmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_ctrmv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_ctrmv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -82,7 +82,7 @@ void cblas_ctrmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_ctrmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_ctrmv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -113,7 +113,7 @@ void cblas_ctrmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, } else { - cblas_xerbla(3, "cblas_ctrmv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_ctrmv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -123,7 +123,7 @@ void cblas_ctrmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_ctrmv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_ctrmv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -148,7 +148,7 @@ void cblas_ctrmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, } } } - else cblas_xerbla(1, "cblas_ctrmv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_ctrmv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_ctrsm.c b/CBLAS/src/cblas_ctrsm.c index a95b28d68a..7d492f2ab4 100644 --- a/CBLAS/src/cblas_ctrsm.c +++ b/CBLAS/src/cblas_ctrsm.c @@ -9,11 +9,11 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_ctrsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, +void API_SUFFIX(cblas_ctrsm)(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, - const CBLAS_DIAG Diag, const int M, const int N, - const void *alpha, const void *A, const int lda, - void *B, const int ldb) + const CBLAS_DIAG Diag, const CBLAS_INT M, const CBLAS_INT N, + const void *alpha, const void *A, const CBLAS_INT lda, + void *B, const CBLAS_INT ldb) { char UL, TA, SD, DI; #ifdef F77_CHAR @@ -46,7 +46,7 @@ void cblas_ctrsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Side == CblasLeft ) SD='L'; else { - cblas_xerbla(2, "cblas_ctrsm", "Illegal Side setting, %d\n", Side); + API_SUFFIX(cblas_xerbla)(2, "cblas_ctrsm", "Illegal Side setting, %d\n", Side); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -56,7 +56,7 @@ void cblas_ctrsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Uplo == CblasLower ) UL='L'; else { - cblas_xerbla(3, "cblas_ctrsm", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(3, "cblas_ctrsm", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -67,7 +67,7 @@ void cblas_ctrsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( TransA == CblasNoTrans ) TA='N'; else { - cblas_xerbla(4, "cblas_ctrsm", "Illegal Trans setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(4, "cblas_ctrsm", "Illegal Trans setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -77,7 +77,7 @@ void cblas_ctrsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Diag == CblasNonUnit ) DI='N'; else { - cblas_xerbla(5, "cblas_ctrsm", "Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(5, "cblas_ctrsm", "Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -100,7 +100,7 @@ void cblas_ctrsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Side == CblasLeft ) SD='R'; else { - cblas_xerbla(2, "cblas_ctrsm", "Illegal Side setting, %d\n", Side); + API_SUFFIX(cblas_xerbla)(2, "cblas_ctrsm", "Illegal Side setting, %d\n", Side); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -110,7 +110,7 @@ void cblas_ctrsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Uplo == CblasLower ) UL='U'; else { - cblas_xerbla(3, "cblas_ctrsm", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(3, "cblas_ctrsm", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -121,7 +121,7 @@ void cblas_ctrsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( TransA == CblasNoTrans ) TA='N'; else { - cblas_xerbla(4, "cblas_ctrsm", "Illegal Trans setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(4, "cblas_ctrsm", "Illegal Trans setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -131,7 +131,7 @@ void cblas_ctrsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Diag == CblasNonUnit ) DI='N'; else { - cblas_xerbla(5, "cblas_ctrsm", "Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(5, "cblas_ctrsm", "Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -148,7 +148,7 @@ void cblas_ctrsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, F77_ctrsm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, alpha, A, &F77_lda, B, &F77_ldb); } - else cblas_xerbla(1, "cblas_ctrsm", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_ctrsm", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_ctrsv.c b/CBLAS/src/cblas_ctrsv.c index cd10f778a7..41a9440472 100644 --- a/CBLAS/src/cblas_ctrsv.c +++ b/CBLAS/src/cblas_ctrsv.c @@ -7,10 +7,10 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_ctrsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, +void API_SUFFIX(cblas_ctrsv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, const CBLAS_DIAG Diag, - const int N, const void *A, const int lda, void *X, - const int incX) + const CBLAS_INT N, const void *A, const CBLAS_INT lda, void *X, + const CBLAS_INT incX) { char TA; char UL; @@ -29,7 +29,7 @@ void cblas_ctrsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, #define F77_lda lda #define F77_incX incX #endif - int n, i=0, tincX; + CBLAS_INT n, i=0, tincX; float *st=0,*x=(float *)X; extern int CBLAS_CallFromC; extern int RowMajorStrg; @@ -42,7 +42,7 @@ void cblas_ctrsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'L'; else { - cblas_xerbla(2, "cblas_ctrsv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_ctrsv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -52,7 +52,7 @@ void cblas_ctrsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'C'; else { - cblas_xerbla(3, "cblas_ctrsv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_ctrsv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -61,7 +61,7 @@ void cblas_ctrsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_ctrsv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_ctrsv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -81,7 +81,7 @@ void cblas_ctrsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_ctrsv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_ctrsv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -114,7 +114,7 @@ void cblas_ctrsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, } else { - cblas_xerbla(3, "cblas_ctrsv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_ctrsv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -124,7 +124,7 @@ void cblas_ctrsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_ctrsv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_ctrsv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -149,7 +149,7 @@ void cblas_ctrsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, } } } - else cblas_xerbla(1, "cblas_ctrsv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_ctrsv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_dasum.c b/CBLAS/src/cblas_dasum.c index dbd224a91f..3b7abd06a6 100644 --- a/CBLAS/src/cblas_dasum.c +++ b/CBLAS/src/cblas_dasum.c @@ -9,7 +9,7 @@ */ #include "cblas.h" #include "cblas_f77.h" -double cblas_dasum( const int N, const double *X, const int incX) +double API_SUFFIX(cblas_dasum)( const CBLAS_INT N, const double *X, const CBLAS_INT incX) { double asum; #ifdef F77_INT diff --git a/CBLAS/src/cblas_daxpby.c b/CBLAS/src/cblas_daxpby.c new file mode 100644 index 0000000000..a4df635247 --- /dev/null +++ b/CBLAS/src/cblas_daxpby.c @@ -0,0 +1,22 @@ +/* + * cblas_daxpby.c + * + * The program is a C interface to daxpby. + * + * Written by Martin Koehler. 08/26/2024 + * + */ +#include "cblas.h" +#include "cblas_f77.h" +void API_SUFFIX(cblas_daxpby)( const CBLAS_INT N, const double alpha, const double *X, + const CBLAS_INT incX, const double beta, double *Y, const CBLAS_INT incY) +{ +#ifdef F77_INT + F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; +#else + #define F77_N N + #define F77_incX incX + #define F77_incY incY +#endif + F77_daxpby( &F77_N, &alpha, X, &F77_incX, &beta, Y, &F77_incY); +} diff --git a/CBLAS/src/cblas_daxpy.c b/CBLAS/src/cblas_daxpy.c index fdbf982f87..9ab57c79d3 100644 --- a/CBLAS/src/cblas_daxpy.c +++ b/CBLAS/src/cblas_daxpy.c @@ -8,8 +8,8 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_daxpy( const int N, const double alpha, const double *X, - const int incX, double *Y, const int incY) +void API_SUFFIX(cblas_daxpy)( const CBLAS_INT N, const double alpha, const double *X, + const CBLAS_INT incX, double *Y, const CBLAS_INT incY) { #ifdef F77_INT F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; diff --git a/CBLAS/src/cblas_dcabs1.c b/CBLAS/src/cblas_dcabs1.c new file mode 100644 index 0000000000..35e127ddf1 --- /dev/null +++ b/CBLAS/src/cblas_dcabs1.c @@ -0,0 +1,15 @@ +/* + * cblas_scabs1.c + * + * The program is a C interface to scabs1. + * + */ +#include "cblas.h" +#include "cblas_f77.h" +double API_SUFFIX(cblas_dcabs1)(const void *c) +{ + double cabs1 = 0.0; + F77_dcabs1_sub(c, &cabs1); + return cabs1; +} + diff --git a/CBLAS/src/cblas_dcopy.c b/CBLAS/src/cblas_dcopy.c index b3bb82b6e2..0eec047bea 100644 --- a/CBLAS/src/cblas_dcopy.c +++ b/CBLAS/src/cblas_dcopy.c @@ -8,8 +8,8 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_dcopy( const int N, const double *X, - const int incX, double *Y, const int incY) +void API_SUFFIX(cblas_dcopy)( const CBLAS_INT N, const double *X, + const CBLAS_INT incX, double *Y, const CBLAS_INT incY) { #ifdef F77_INT F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; diff --git a/CBLAS/src/cblas_ddot.c b/CBLAS/src/cblas_ddot.c index 650bc76e74..54afaadc25 100644 --- a/CBLAS/src/cblas_ddot.c +++ b/CBLAS/src/cblas_ddot.c @@ -9,8 +9,8 @@ */ #include "cblas.h" #include "cblas_f77.h" -double cblas_ddot( const int N, const double *X, - const int incX, const double *Y, const int incY) +double API_SUFFIX(cblas_ddot)( const CBLAS_INT N, const double *X, + const CBLAS_INT incX, const double *Y, const CBLAS_INT incY) { double dot; #ifdef F77_INT diff --git a/CBLAS/src/cblas_dgbmv.c b/CBLAS/src/cblas_dgbmv.c index 11119025b0..a0fc8d7aa1 100644 --- a/CBLAS/src/cblas_dgbmv.c +++ b/CBLAS/src/cblas_dgbmv.c @@ -8,12 +8,12 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_dgbmv(const CBLAS_LAYOUT layout, - const CBLAS_TRANSPOSE TransA, const int M, const int N, - const int KL, const int KU, - const double alpha, const double *A, const int lda, - const double *X, const int incX, const double beta, - double *Y, const int incY) +void API_SUFFIX(cblas_dgbmv)(const CBLAS_LAYOUT layout, + const CBLAS_TRANSPOSE TransA, const CBLAS_INT M, const CBLAS_INT N, + const CBLAS_INT KL, const CBLAS_INT KU, + const double alpha, const double *A, const CBLAS_INT lda, + const double *X, const CBLAS_INT incX, const double beta, + double *Y, const CBLAS_INT incY) { char TA; #ifdef F77_CHAR @@ -45,7 +45,7 @@ void cblas_dgbmv(const CBLAS_LAYOUT layout, else if (TransA == CblasConjTrans) TA = 'C'; else { - cblas_xerbla(2, "cblas_dgbmv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(2, "cblas_dgbmv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -64,7 +64,7 @@ void cblas_dgbmv(const CBLAS_LAYOUT layout, else if (TransA == CblasConjTrans) TA = 'N'; else { - cblas_xerbla(2, "cblas_dgbmv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(2, "cblas_dgbmv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -75,7 +75,7 @@ void cblas_dgbmv(const CBLAS_LAYOUT layout, F77_dgbmv(F77_TA, &F77_N, &F77_M, &F77_KU, &F77_KL, &alpha, A ,&F77_lda, X,&F77_incX, &beta, Y, &F77_incY); } - else cblas_xerbla(1, "cblas_dgbmv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_dgbmv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; } diff --git a/CBLAS/src/cblas_dgemm.c b/CBLAS/src/cblas_dgemm.c index 5f525dde7b..c4ae0275c2 100644 --- a/CBLAS/src/cblas_dgemm.c +++ b/CBLAS/src/cblas_dgemm.c @@ -9,11 +9,11 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_dgemm(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA, - const CBLAS_TRANSPOSE TransB, const int M, const int N, - const int K, const double alpha, const double *A, - const int lda, const double *B, const int ldb, - const double beta, double *C, const int ldc) +void API_SUFFIX(cblas_dgemm)(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA, + const CBLAS_TRANSPOSE TransB, const CBLAS_INT M, const CBLAS_INT N, + const CBLAS_INT K, const double alpha, const double *A, + const CBLAS_INT lda, const double *B, const CBLAS_INT ldb, + const double beta, double *C, const CBLAS_INT ldc) { char TA, TB; #ifdef F77_CHAR @@ -47,7 +47,7 @@ void cblas_dgemm(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA, else if ( TransA == CblasNoTrans ) TA='N'; else { - cblas_xerbla(2, "cblas_dgemm","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(2, "cblas_dgemm","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -58,7 +58,7 @@ void cblas_dgemm(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA, else if ( TransB == CblasNoTrans ) TB='N'; else { - cblas_xerbla(3, "cblas_dgemm","Illegal TransB setting, %d\n", TransB); + API_SUFFIX(cblas_xerbla)(3, "cblas_dgemm","Illegal TransB setting, %d\n", TransB); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -79,7 +79,7 @@ void cblas_dgemm(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA, else if ( TransA == CblasNoTrans ) TB='N'; else { - cblas_xerbla(2, "cblas_dgemm","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(2, "cblas_dgemm","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -89,7 +89,7 @@ void cblas_dgemm(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA, else if ( TransB == CblasNoTrans ) TA='N'; else { - cblas_xerbla(2, "cblas_dgemm","Illegal TransB setting, %d\n", TransB); + API_SUFFIX(cblas_xerbla)(3, "cblas_dgemm","Illegal TransB setting, %d\n", TransB); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -102,7 +102,7 @@ void cblas_dgemm(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA, F77_dgemm(F77_TA, F77_TB, &F77_N, &F77_M, &F77_K, &alpha, B, &F77_ldb, A, &F77_lda, &beta, C, &F77_ldc); } - else cblas_xerbla(1, "cblas_dgemm", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_dgemm", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_dgemmtr.c b/CBLAS/src/cblas_dgemmtr.c new file mode 100644 index 0000000000..d94cdc5cb7 --- /dev/null +++ b/CBLAS/src/cblas_dgemmtr.c @@ -0,0 +1,134 @@ +/* + * + * cblas_dgemmtr.c + * This program is a C interface to dgemmtr. + * Written by Martin Koehler, MPI Magdeburg + * 06/24/2024 + * + */ + +#include "cblas.h" +#include "cblas_f77.h" +void API_SUFFIX(cblas_dgemmtr)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, + const CBLAS_TRANSPOSE TransB, const CBLAS_INT N, + const CBLAS_INT K, const double alpha, const double *A, + const CBLAS_INT lda, const double *B, const CBLAS_INT ldb, + const double beta, double *C, const CBLAS_INT ldc) +{ + char TA, TB, UL; +#ifdef F77_CHAR + F77_CHAR F77_TA, F77_TB, F77_UL; +#else +#define F77_TA &TA +#define F77_TB &TB +#define F77_UL &UL +#endif + +#ifdef F77_INT + F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb; + F77_INT F77_ldc=ldc; +#else +#define F77_N N +#define F77_K K +#define F77_lda lda +#define F77_ldb ldb +#define F77_ldc ldc +#endif + + extern int CBLAS_CallFromC; + extern int RowMajorStrg; + RowMajorStrg = 0; + CBLAS_CallFromC = 1; + + + if( layout == CblasColMajor ) + { + if ( Uplo == CblasUpper ) UL = 'U'; + else if (Uplo == CblasLower) UL= 'L'; + else { + API_SUFFIX(cblas_xerbla)(2, "cblas_dgemmtr", "Illegal Uplo setting, %d\n", Uplo); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + + + if(TransA == CblasTrans) TA='T'; + else if ( TransA == CblasConjTrans ) TA='C'; + else if ( TransA == CblasNoTrans ) TA='N'; + else + { + API_SUFFIX(cblas_xerbla)(3, "cblas_dgemmtr","Illegal TransA setting, %d\n", TransA); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + if(TransB == CblasTrans) TB='T'; + else if ( TransB == CblasConjTrans ) TB='C'; + else if ( TransB == CblasNoTrans ) TB='N'; + else + { + API_SUFFIX(cblas_xerbla)(4, "cblas_dgemmtr","Illegal TransB setting, %d\n", TransB); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + +#ifdef F77_CHAR + F77_TA = C2F_CHAR(&TA); + F77_TB = C2F_CHAR(&TB); + F77_UL = C2F_CHAR(&UL); +#endif + + F77_dgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, &alpha, A, + &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc); + } + else if (layout == CblasRowMajor) + { + if ( Uplo == CblasUpper ) UL = 'L'; + else if (Uplo == CblasLower) UL= 'U'; + else { + API_SUFFIX(cblas_xerbla)(2, "cblas_dgemmtr", "Illegal Uplo setting, %d\n", Uplo); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + + RowMajorStrg = 1; + if(TransA == CblasTrans) TB='T'; + else if ( TransA == CblasConjTrans ) TB='C'; + else if ( TransA == CblasNoTrans ) TB='N'; + else + { + API_SUFFIX(cblas_xerbla)(3, "cblas_dgemmtr","Illegal TransA setting, %d\n", TransA); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + if(TransB == CblasTrans) TA='T'; + else if ( TransB == CblasConjTrans ) TA='C'; + else if ( TransB == CblasNoTrans ) TA='N'; + else + { + API_SUFFIX(cblas_xerbla)(4, "cblas_dgemmtr","Illegal TransB setting, %d\n", TransB); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } +#ifdef F77_CHAR + F77_TA = C2F_CHAR(&TA); + F77_TB = C2F_CHAR(&TB); + F77_UL = C2F_CHAR(&UL); +#endif + + F77_dgemmtr( F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, &alpha, B, + &F77_ldb, A, &F77_lda, &beta, C, &F77_ldc); + } + else API_SUFFIX(cblas_xerbla)(1, "cblas_dgemmtr", "Illegal layout setting, %d\n", layout); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; +} diff --git a/CBLAS/src/cblas_dgemv.c b/CBLAS/src/cblas_dgemv.c index a3f060aeb3..80edd756b0 100644 --- a/CBLAS/src/cblas_dgemv.c +++ b/CBLAS/src/cblas_dgemv.c @@ -8,11 +8,11 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_dgemv(const CBLAS_LAYOUT layout, - const CBLAS_TRANSPOSE TransA, const int M, const int N, - const double alpha, const double *A, const int lda, - const double *X, const int incX, const double beta, - double *Y, const int incY) +void API_SUFFIX(cblas_dgemv)(const CBLAS_LAYOUT layout, + const CBLAS_TRANSPOSE TransA, const CBLAS_INT M, const CBLAS_INT N, + const double alpha, const double *A, const CBLAS_INT lda, + const double *X, const CBLAS_INT incX, const double beta, + double *Y, const CBLAS_INT incY) { char TA; #ifdef F77_CHAR @@ -41,7 +41,7 @@ void cblas_dgemv(const CBLAS_LAYOUT layout, else if (TransA == CblasConjTrans) TA = 'C'; else { - cblas_xerbla(2, "cblas_dgemv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(2, "cblas_dgemv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -60,7 +60,7 @@ void cblas_dgemv(const CBLAS_LAYOUT layout, else if (TransA == CblasConjTrans) TA = 'N'; else { - cblas_xerbla(2, "cblas_dgemv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(2, "cblas_dgemv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -71,7 +71,7 @@ void cblas_dgemv(const CBLAS_LAYOUT layout, F77_dgemv(F77_TA, &F77_N, &F77_M, &alpha, A, &F77_lda, X, &F77_incX, &beta, Y, &F77_incY); } - else cblas_xerbla(1, "cblas_dgemv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_dgemv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_dger.c b/CBLAS/src/cblas_dger.c index d536537749..8e5d687791 100644 --- a/CBLAS/src/cblas_dger.c +++ b/CBLAS/src/cblas_dger.c @@ -9,9 +9,9 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_dger(const CBLAS_LAYOUT layout, const int M, const int N, - const double alpha, const double *X, const int incX, - const double *Y, const int incY, double *A, const int lda) +void API_SUFFIX(cblas_dger)(const CBLAS_LAYOUT layout, const CBLAS_INT M, const CBLAS_INT N, + const double alpha, const double *X, const CBLAS_INT incX, + const double *Y, const CBLAS_INT incY, double *A, const CBLAS_INT lda) { #ifdef F77_INT F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY; @@ -40,7 +40,7 @@ void cblas_dger(const CBLAS_LAYOUT layout, const int M, const int N, &F77_lda); } - else cblas_xerbla(1, "cblas_dger", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_dger", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_dnrm2.c b/CBLAS/src/cblas_dnrm2.c index 99f8368d24..3fafa48e5c 100644 --- a/CBLAS/src/cblas_dnrm2.c +++ b/CBLAS/src/cblas_dnrm2.c @@ -9,7 +9,7 @@ */ #include "cblas.h" #include "cblas_f77.h" -double cblas_dnrm2( const int N, const double *X, const int incX) +double API_SUFFIX(cblas_dnrm2)( const CBLAS_INT N, const double *X, const CBLAS_INT incX) { double nrm2; #ifdef F77_INT diff --git a/CBLAS/src/cblas_drot.c b/CBLAS/src/cblas_drot.c index ec1887ab05..410aece4d6 100644 --- a/CBLAS/src/cblas_drot.c +++ b/CBLAS/src/cblas_drot.c @@ -8,8 +8,8 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_drot(const int N, double *X, const int incX, - double *Y, const int incY, const double c, const double s) +void API_SUFFIX(cblas_drot)(const CBLAS_INT N, double *X, const CBLAS_INT incX, + double *Y, const CBLAS_INT incY, const double c, const double s) { #ifdef F77_INT F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; diff --git a/CBLAS/src/cblas_drotg.c b/CBLAS/src/cblas_drotg.c index a433f4844f..01e5c202ac 100644 --- a/CBLAS/src/cblas_drotg.c +++ b/CBLAS/src/cblas_drotg.c @@ -8,7 +8,7 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_drotg( double *a, double *b, double *c, double *s) +void API_SUFFIX(cblas_drotg)( double *a, double *b, double *c, double *s) { F77_drotg(a,b,c,s); } diff --git a/CBLAS/src/cblas_drotm.c b/CBLAS/src/cblas_drotm.c index 26ee53332d..a9646d775f 100644 --- a/CBLAS/src/cblas_drotm.c +++ b/CBLAS/src/cblas_drotm.c @@ -1,7 +1,7 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_drotm( const int N, double *X, const int incX, double *Y, - const int incY, const double *P) +void API_SUFFIX(cblas_drotm)( const CBLAS_INT N, double *X, const CBLAS_INT incX, double *Y, + const CBLAS_INT incY, const double *P) { #ifdef F77_INT F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; diff --git a/CBLAS/src/cblas_drotmg.c b/CBLAS/src/cblas_drotmg.c index ad33ba4fd2..f04042ee9b 100644 --- a/CBLAS/src/cblas_drotmg.c +++ b/CBLAS/src/cblas_drotmg.c @@ -8,7 +8,7 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_drotmg( double *d1, double *d2, double *b1, +void API_SUFFIX(cblas_drotmg)( double *d1, double *d2, double *b1, const double b2, double *p) { F77_drotmg(d1,d2,b1,&b2,p); diff --git a/CBLAS/src/cblas_dsbmv.c b/CBLAS/src/cblas_dsbmv.c index 84c7c1a547..7bccfae362 100644 --- a/CBLAS/src/cblas_dsbmv.c +++ b/CBLAS/src/cblas_dsbmv.c @@ -9,11 +9,11 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_dsbmv(const CBLAS_LAYOUT layout, - const CBLAS_UPLO Uplo, const int N, const int K, - const double alpha, const double *A, const int lda, - const double *X, const int incX, const double beta, - double *Y, const int incY) +void API_SUFFIX(cblas_dsbmv)(const CBLAS_LAYOUT layout, + const CBLAS_UPLO Uplo, const CBLAS_INT N, const CBLAS_INT K, + const double alpha, const double *A, const CBLAS_INT lda, + const double *X, const CBLAS_INT incX, const double beta, + double *Y, const CBLAS_INT incY) { char UL; #ifdef F77_CHAR @@ -41,7 +41,7 @@ void cblas_dsbmv(const CBLAS_LAYOUT layout, else if (Uplo == CblasLower) UL = 'L'; else { - cblas_xerbla(2, "cblas_dsbmv","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_dsbmv","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -59,7 +59,7 @@ void cblas_dsbmv(const CBLAS_LAYOUT layout, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_dsbmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_dsbmv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -70,7 +70,7 @@ void cblas_dsbmv(const CBLAS_LAYOUT layout, F77_dsbmv(F77_UL, &F77_N, &F77_K, &alpha, A ,&F77_lda, X,&F77_incX, &beta, Y, &F77_incY); } - else cblas_xerbla(1, "cblas_dsbmv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_dsbmv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_dscal.c b/CBLAS/src/cblas_dscal.c index cef902af25..b5b0d44dfc 100644 --- a/CBLAS/src/cblas_dscal.c +++ b/CBLAS/src/cblas_dscal.c @@ -8,8 +8,8 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_dscal( const int N, const double alpha, double *X, - const int incX) +void API_SUFFIX(cblas_dscal)( const CBLAS_INT N, const double alpha, double *X, + const CBLAS_INT incX) { #ifdef F77_INT F77_INT F77_N=N, F77_incX=incX; diff --git a/CBLAS/src/cblas_dsdot.c b/CBLAS/src/cblas_dsdot.c index ef776e4bec..f3ce05d244 100644 --- a/CBLAS/src/cblas_dsdot.c +++ b/CBLAS/src/cblas_dsdot.c @@ -9,8 +9,8 @@ */ #include "cblas.h" #include "cblas_f77.h" -double cblas_dsdot( const int N, const float *X, - const int incX, const float *Y, const int incY) +double API_SUFFIX(cblas_dsdot)( const CBLAS_INT N, const float *X, + const CBLAS_INT incX, const float *Y, const CBLAS_INT incY) { double dot; #ifdef F77_INT diff --git a/CBLAS/src/cblas_dskewsymm.c b/CBLAS/src/cblas_dskewsymm.c new file mode 100644 index 0000000000..a6bca76c85 --- /dev/null +++ b/CBLAS/src/cblas_dskewsymm.c @@ -0,0 +1,106 @@ +/* + * + * cblas_dskewsymm.c + * This program is a C interface to dskewsymm. + * Written by Shuo Zheng + * 11/24/2025 + * + */ + +#include "cblas.h" +#include "cblas_f77.h" +void API_SUFFIX(cblas_dskewsymm)(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, + const CBLAS_UPLO Uplo, const CBLAS_INT M, const CBLAS_INT N, + const double alpha, const double *A, const CBLAS_INT lda, + const double *B, const CBLAS_INT ldb, const double beta, + double *C, const CBLAS_INT ldc) +{ + char SD, UL; +#ifdef F77_CHAR + F77_CHAR F77_SD, F77_UL; +#else + #define F77_SD &SD + #define F77_UL &UL +#endif + +#ifdef F77_INT + F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb; + F77_INT F77_ldc=ldc; +#else + #define F77_M M + #define F77_N N + #define F77_lda lda + #define F77_ldb ldb + #define F77_ldc ldc +#endif + + extern int CBLAS_CallFromC; + extern int RowMajorStrg; + RowMajorStrg = 0; + CBLAS_CallFromC = 1; + + if( layout == CblasColMajor ) + { + if( Side == CblasRight) SD='R'; + else if ( Side == CblasLeft ) SD='L'; + else + { + API_SUFFIX(cblas_xerbla)(2, "cblas_dskewsymm","Illegal Side setting, %d\n", Side); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + if( Uplo == CblasUpper) UL='U'; + else if ( Uplo == CblasLower ) UL='L'; + else + { + API_SUFFIX(cblas_xerbla)(3, "cblas_dskewsymm","Illegal Uplo setting, %d\n", Uplo); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + #ifdef F77_CHAR + F77_UL = C2F_CHAR(&UL); + F77_SD = C2F_CHAR(&SD); + #endif + + F77_dskewsymm(F77_SD, F77_UL, &F77_M, &F77_N, &alpha, A, &F77_lda, + B, &F77_ldb, &beta, C, &F77_ldc); + } else if (layout == CblasRowMajor) + { + RowMajorStrg = 1; + if( Side == CblasRight) SD='L'; + else if ( Side == CblasLeft ) SD='R'; + else + { + API_SUFFIX(cblas_xerbla)(2, "cblas_dskewsymm","Illegal Side setting, %d\n", Side); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + if( Uplo == CblasUpper) UL='L'; + else if ( Uplo == CblasLower ) UL='U'; + else + { + API_SUFFIX(cblas_xerbla)(3, "cblas_dskewsymm","Illegal Uplo setting, %d\n", Uplo); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + #ifdef F77_CHAR + F77_UL = C2F_CHAR(&UL); + F77_SD = C2F_CHAR(&SD); + #endif + + F77_dskewsymm(F77_SD, F77_UL, &F77_N, &F77_M, &alpha, A, &F77_lda, B, + &F77_ldb, &beta, C, &F77_ldc); + } + else API_SUFFIX(cblas_xerbla)(1, "cblas_dskewsymm","Illegal layout setting, %d\n", layout); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; +} diff --git a/CBLAS/src/cblas_dskewsymv.c b/CBLAS/src/cblas_dskewsymv.c new file mode 100644 index 0000000000..4003228ea1 --- /dev/null +++ b/CBLAS/src/cblas_dskewsymv.c @@ -0,0 +1,78 @@ +/* + * + * cblas_dskewsymv.c + * This program is a C interface to dskewsymv. + * Written by Shuo Zheng + * 11/24/2025 + * + */ + +#include "cblas.h" +#include "cblas_f77.h" +void API_SUFFIX(cblas_dskewsymv)(const CBLAS_LAYOUT layout, + const CBLAS_UPLO Uplo, const CBLAS_INT N, + const double alpha, const double *A, const CBLAS_INT lda, + const double *X, const CBLAS_INT incX, const double beta, + double *Y, const CBLAS_INT incY) +{ + char UL; + double minus_alpha; +#ifdef F77_CHAR + F77_CHAR F77_UL; +#else + #define F77_UL &UL +#endif +#ifdef F77_INT + F77_INT F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY; +#else + #define F77_N N + #define F77_lda lda + #define F77_incX incX + #define F77_incY incY +#endif + extern int CBLAS_CallFromC; + extern int RowMajorStrg; + RowMajorStrg = 0; + + CBLAS_CallFromC = 1; + if (layout == CblasColMajor) + { + if (Uplo == CblasUpper) UL = 'U'; + else if (Uplo == CblasLower) UL = 'L'; + else + { + API_SUFFIX(cblas_xerbla)(2, "cblas_dskewsymv","Illegal Uplo setting, %d\n",Uplo ); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + #ifdef F77_CHAR + F77_UL = C2F_CHAR(&UL); + #endif + F77_dskewsymv(F77_UL, &F77_N, &alpha, A, &F77_lda, X, + &F77_incX, &beta, Y, &F77_incY); + } + else if (layout == CblasRowMajor) + { + RowMajorStrg = 1; + if (Uplo == CblasUpper) UL = 'L'; + else if (Uplo == CblasLower) UL = 'U'; + else + { + API_SUFFIX(cblas_xerbla)(2, "cblas_dskewsymv","Illegal Uplo setting, %d\n", Uplo); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + #ifdef F77_CHAR + F77_UL = C2F_CHAR(&UL); + #endif + minus_alpha = -alpha; + F77_dskewsymv(F77_UL, &F77_N, &minus_alpha, + A ,&F77_lda, X,&F77_incX, &beta, Y, &F77_incY); + } + else API_SUFFIX(cblas_xerbla)(1, "cblas_dskewsymv", "Illegal layout setting, %d\n", layout); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; +} diff --git a/CBLAS/src/cblas_dskewsyr2.c b/CBLAS/src/cblas_dskewsyr2.c new file mode 100644 index 0000000000..cea5b5a7c3 --- /dev/null +++ b/CBLAS/src/cblas_dskewsyr2.c @@ -0,0 +1,78 @@ +/* + * + * cblas_dskewsyr2.c + * This program is a C interface to dskewsyr2. + * Written by Shuo Zheng + * 11/24/2025 + * + */ + +#include "cblas.h" +#include "cblas_f77.h" +void API_SUFFIX(cblas_dskewsyr2)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_INT N, const double alpha, const double *X, + const CBLAS_INT incX, const double *Y, const CBLAS_INT incY, double *A, + const CBLAS_INT lda) +{ + char UL; + double minus_alpha; +#ifdef F77_CHAR + F77_CHAR F77_UL; +#else + #define F77_UL &UL +#endif + +#ifdef F77_INT + F77_INT F77_N=N, F77_incX=incX, F77_incY=incY, F77_lda=lda; +#else + #define F77_N N + #define F77_incX incX + #define F77_incY incY + #define F77_lda lda +#endif + + extern int CBLAS_CallFromC; + extern int RowMajorStrg; + RowMajorStrg = 0; + CBLAS_CallFromC = 1; + if (layout == CblasColMajor) + { + if (Uplo == CblasLower) UL = 'L'; + else if (Uplo == CblasUpper) UL = 'U'; + else + { + API_SUFFIX(cblas_xerbla)(2, "cblas_dskewsyr2","Illegal Uplo setting, %d\n",Uplo ); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + #ifdef F77_CHAR + F77_UL = C2F_CHAR(&UL); + #endif + + F77_dskewsyr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A, + &F77_lda); + + } else if (layout == CblasRowMajor) + { + RowMajorStrg = 1; + if (Uplo == CblasLower) UL = 'U'; + else if (Uplo == CblasUpper) UL = 'L'; + else + { + API_SUFFIX(cblas_xerbla)(2, "cblas_dskewsyr2","Illegal Uplo setting, %d\n",Uplo ); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + #ifdef F77_CHAR + F77_UL = C2F_CHAR(&UL); + #endif + minus_alpha = -alpha; + F77_dskewsyr2(F77_UL, &F77_N, &minus_alpha, X, &F77_incX, Y, &F77_incY, A, + &F77_lda); + } else API_SUFFIX(cblas_xerbla)(1, "cblas_dskewsyr2", "Illegal layout setting, %d\n", layout); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; +} diff --git a/CBLAS/src/cblas_dskewsyr2k.c b/CBLAS/src/cblas_dskewsyr2k.c new file mode 100644 index 0000000000..853e5451b6 --- /dev/null +++ b/CBLAS/src/cblas_dskewsyr2k.c @@ -0,0 +1,111 @@ +/* + * + * cblas_dskewsyr2k.c + * This program is a C interface to dskewsyr2k. + * Written by Shuo Zheng + * 11/24/2025 + * + */ + +#include "cblas.h" +#include "cblas_f77.h" +void API_SUFFIX(cblas_dskewsyr2k)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_TRANSPOSE Trans, const CBLAS_INT N, const CBLAS_INT K, + const double alpha, const double *A, const CBLAS_INT lda, + const double *B, const CBLAS_INT ldb, const double beta, + double *C, const CBLAS_INT ldc) +{ + char UL, TR; + double minus_alpha; +#ifdef F77_CHAR + F77_CHAR F77_TA, F77_UL; +#else + #define F77_TR &TR + #define F77_UL &UL +#endif + +#ifdef F77_INT + F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb; + F77_INT F77_ldc=ldc; +#else + #define F77_N N + #define F77_K K + #define F77_lda lda + #define F77_ldb ldb + #define F77_ldc ldc +#endif + + extern int CBLAS_CallFromC; + extern int RowMajorStrg; + RowMajorStrg = 0; + CBLAS_CallFromC = 1; + + if( layout == CblasColMajor ) + { + + if( Uplo == CblasUpper) UL='U'; + else if ( Uplo == CblasLower ) UL='L'; + else + { + API_SUFFIX(cblas_xerbla)(2, "cblas_dskewsyr2k","Illegal Uplo setting, %d\n", Uplo); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + if( Trans == CblasTrans) TR ='T'; + else if ( Trans == CblasConjTrans ) TR='C'; + else if ( Trans == CblasNoTrans ) TR='N'; + else + { + API_SUFFIX(cblas_xerbla)(3, "cblas_dskewsyr2k","Illegal Trans setting, %d\n", Trans); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + + #ifdef F77_CHAR + F77_UL = C2F_CHAR(&UL); + F77_TR = C2F_CHAR(&TR); + #endif + + F77_dskewsyr2k(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda, + B, &F77_ldb, &beta, C, &F77_ldc); + } else if (layout == CblasRowMajor) + { + RowMajorStrg = 1; + if( Uplo == CblasUpper) UL='L'; + else if ( Uplo == CblasLower ) UL='U'; + else + { + API_SUFFIX(cblas_xerbla)(2, "cblas_dskewsyr2k","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 + { + API_SUFFIX(cblas_xerbla)(3, "cblas_dskewsyr2k","Illegal Trans setting, %d\n", Trans); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + #ifdef F77_CHAR + F77_UL = C2F_CHAR(&UL); + F77_TR = C2F_CHAR(&TR); + #endif + + minus_alpha = -alpha; + F77_dskewsyr2k(F77_UL, F77_TR, &F77_N, &F77_K, &minus_alpha, A, &F77_lda, B, + &F77_ldb, &beta, C, &F77_ldc); + } + else API_SUFFIX(cblas_xerbla)(1, "cblas_dskewsyr2k","Illegal layout setting, %d\n", layout); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; +} diff --git a/CBLAS/src/cblas_dspmv.c b/CBLAS/src/cblas_dspmv.c index e0e9a3209e..14a9a8d31a 100644 --- a/CBLAS/src/cblas_dspmv.c +++ b/CBLAS/src/cblas_dspmv.c @@ -10,11 +10,11 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_dspmv(const CBLAS_LAYOUT layout, - const CBLAS_UPLO Uplo, const int N, +void API_SUFFIX(cblas_dspmv)(const CBLAS_LAYOUT layout, + const CBLAS_UPLO Uplo, const CBLAS_INT N, const double alpha, const double *AP, - const double *X, const int incX, const double beta, - double *Y, const int incY) + const double *X, const CBLAS_INT incX, const double beta, + double *Y, const CBLAS_INT incY) { char UL; #ifdef F77_CHAR @@ -40,7 +40,7 @@ void cblas_dspmv(const CBLAS_LAYOUT layout, else if (Uplo == CblasLower) UL = 'L'; else { - cblas_xerbla(2, "cblas_dspmv","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_dspmv","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -58,7 +58,7 @@ void cblas_dspmv(const CBLAS_LAYOUT layout, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_dspmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_dspmv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -69,7 +69,7 @@ void cblas_dspmv(const CBLAS_LAYOUT layout, F77_dspmv(F77_UL, &F77_N, &alpha, AP, X,&F77_incX, &beta, Y, &F77_incY); } - else cblas_xerbla(1, "cblas_dspmv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_dspmv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_dspr.c b/CBLAS/src/cblas_dspr.c index cb286a86a8..ef33968519 100644 --- a/CBLAS/src/cblas_dspr.c +++ b/CBLAS/src/cblas_dspr.c @@ -9,9 +9,9 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_dspr(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, - const int N, const double alpha, const double *X, - const int incX, double *Ap) +void API_SUFFIX(cblas_dspr)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_INT N, const double alpha, const double *X, + const CBLAS_INT incX, double *Ap) { char UL; #ifdef F77_CHAR @@ -36,7 +36,7 @@ void cblas_dspr(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasUpper) UL = 'U'; else { - cblas_xerbla(2, "cblas_dspr","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_dspr","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -54,7 +54,7 @@ void cblas_dspr(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasUpper) UL = 'L'; else { - cblas_xerbla(2, "cblas_dspr","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_dspr","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -63,7 +63,7 @@ void cblas_dspr(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, F77_UL = C2F_CHAR(&UL); #endif F77_dspr(F77_UL, &F77_N, &alpha, X, &F77_incX, Ap); - } else cblas_xerbla(1, "cblas_dspr", "Illegal layout setting, %d\n", layout); + } else API_SUFFIX(cblas_xerbla)(1, "cblas_dspr", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_dspr2.c b/CBLAS/src/cblas_dspr2.c index c4560642dc..e18c6672f1 100644 --- a/CBLAS/src/cblas_dspr2.c +++ b/CBLAS/src/cblas_dspr2.c @@ -7,9 +7,9 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_dspr2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, - const int N, const double alpha, const double *X, - const int incX, const double *Y, const int incY, double *A) +void API_SUFFIX(cblas_dspr2)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_INT N, const double alpha, const double *X, + const CBLAS_INT incX, const double *Y, const CBLAS_INT incY, double *A) { char UL; #ifdef F77_CHAR @@ -36,7 +36,7 @@ void cblas_dspr2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasUpper) UL = 'U'; else { - cblas_xerbla(2, "cblas_dspr2","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_dspr2","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -54,7 +54,7 @@ void cblas_dspr2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasUpper) UL = 'L'; else { - cblas_xerbla(2, "cblas_dspr2","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_dspr2","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -63,7 +63,7 @@ void cblas_dspr2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, F77_UL = C2F_CHAR(&UL); #endif F77_dspr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A); - } else cblas_xerbla(1, "cblas_dspr2", "Illegal layout setting, %d\n", layout); + } else API_SUFFIX(cblas_xerbla)(1, "cblas_dspr2", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_dswap.c b/CBLAS/src/cblas_dswap.c index bf78fcf9b5..e78fd2face 100644 --- a/CBLAS/src/cblas_dswap.c +++ b/CBLAS/src/cblas_dswap.c @@ -8,8 +8,8 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_dswap( const int N, double *X, const int incX, double *Y, - const int incY) +void API_SUFFIX(cblas_dswap)( const CBLAS_INT N, double *X, const CBLAS_INT incX, double *Y, + const CBLAS_INT incY) { #ifdef F77_INT F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; diff --git a/CBLAS/src/cblas_dsymm.c b/CBLAS/src/cblas_dsymm.c index 457a95fc0f..3bab6f659e 100644 --- a/CBLAS/src/cblas_dsymm.c +++ b/CBLAS/src/cblas_dsymm.c @@ -9,11 +9,11 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_dsymm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, - const CBLAS_UPLO Uplo, const int M, const int N, - const double alpha, const double *A, const int lda, - const double *B, const int ldb, const double beta, - double *C, const int ldc) +void API_SUFFIX(cblas_dsymm)(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, + const CBLAS_UPLO Uplo, const CBLAS_INT M, const CBLAS_INT N, + const double alpha, const double *A, const CBLAS_INT lda, + const double *B, const CBLAS_INT ldb, const double beta, + double *C, const CBLAS_INT ldc) { char SD, UL; #ifdef F77_CHAR @@ -45,7 +45,7 @@ void cblas_dsymm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Side == CblasLeft ) SD='L'; else { - cblas_xerbla(2, "cblas_dsymm","Illegal Side setting, %d\n", Side); + API_SUFFIX(cblas_xerbla)(2, "cblas_dsymm","Illegal Side setting, %d\n", Side); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -55,7 +55,7 @@ void cblas_dsymm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Uplo == CblasLower ) UL='L'; else { - cblas_xerbla(3, "cblas_dsymm","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(3, "cblas_dsymm","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -75,7 +75,7 @@ void cblas_dsymm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Side == CblasLeft ) SD='R'; else { - cblas_xerbla(2, "cblas_dsymm","Illegal Side setting, %d\n", Side); + API_SUFFIX(cblas_xerbla)(2, "cblas_dsymm","Illegal Side setting, %d\n", Side); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -85,7 +85,7 @@ void cblas_dsymm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Uplo == CblasLower ) UL='U'; else { - cblas_xerbla(3, "cblas_dsymm","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(3, "cblas_dsymm","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -99,7 +99,7 @@ void cblas_dsymm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, F77_dsymm(F77_SD, F77_UL, &F77_N, &F77_M, &alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc); } - else cblas_xerbla(1, "cblas_dsymm","Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_dsymm","Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_dsymv.c b/CBLAS/src/cblas_dsymv.c index e31c774988..18607d3637 100644 --- a/CBLAS/src/cblas_dsymv.c +++ b/CBLAS/src/cblas_dsymv.c @@ -9,11 +9,11 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_dsymv(const CBLAS_LAYOUT layout, - const CBLAS_UPLO Uplo, const int N, - const double alpha, const double *A, const int lda, - const double *X, const int incX, const double beta, - double *Y, const int incY) +void API_SUFFIX(cblas_dsymv)(const CBLAS_LAYOUT layout, + const CBLAS_UPLO Uplo, const CBLAS_INT N, + const double alpha, const double *A, const CBLAS_INT lda, + const double *X, const CBLAS_INT incX, const double beta, + double *Y, const CBLAS_INT incY) { char UL; #ifdef F77_CHAR @@ -40,7 +40,7 @@ void cblas_dsymv(const CBLAS_LAYOUT layout, else if (Uplo == CblasLower) UL = 'L'; else { - cblas_xerbla(2, "cblas_dsymv","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_dsymv","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -58,7 +58,7 @@ void cblas_dsymv(const CBLAS_LAYOUT layout, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_dsymv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_dsymv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -69,7 +69,7 @@ void cblas_dsymv(const CBLAS_LAYOUT layout, F77_dsymv(F77_UL, &F77_N, &alpha, A ,&F77_lda, X,&F77_incX, &beta, Y, &F77_incY); } - else cblas_xerbla(1, "cblas_dsymv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_dsymv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_dsyr.c b/CBLAS/src/cblas_dsyr.c index bc4a1e836b..383d41419c 100644 --- a/CBLAS/src/cblas_dsyr.c +++ b/CBLAS/src/cblas_dsyr.c @@ -9,9 +9,9 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_dsyr(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, - const int N, const double alpha, const double *X, - const int incX, double *A, const int lda) +void API_SUFFIX(cblas_dsyr)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_INT N, const double alpha, const double *X, + const CBLAS_INT incX, double *A, const CBLAS_INT lda) { char UL; #ifdef F77_CHAR @@ -37,7 +37,7 @@ void cblas_dsyr(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasUpper) UL = 'U'; else { - cblas_xerbla(2, "cblas_dsyr","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_dsyr","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -55,7 +55,7 @@ void cblas_dsyr(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasUpper) UL = 'L'; else { - cblas_xerbla(2, "cblas_dsyr","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_dsyr","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -64,7 +64,7 @@ void cblas_dsyr(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, F77_UL = C2F_CHAR(&UL); #endif F77_dsyr(F77_UL, &F77_N, &alpha, X, &F77_incX, A, &F77_lda); - } else cblas_xerbla(1, "cblas_dsyr", "Illegal layout setting, %d\n", layout); + } else API_SUFFIX(cblas_xerbla)(1, "cblas_dsyr", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_dsyr2.c b/CBLAS/src/cblas_dsyr2.c index 4607c7a430..db85bf5216 100644 --- a/CBLAS/src/cblas_dsyr2.c +++ b/CBLAS/src/cblas_dsyr2.c @@ -9,10 +9,10 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_dsyr2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, - const int N, const double alpha, const double *X, - const int incX, const double *Y, const int incY, double *A, - const int lda) +void API_SUFFIX(cblas_dsyr2)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_INT N, const double alpha, const double *X, + const CBLAS_INT incX, const double *Y, const CBLAS_INT incY, double *A, + const CBLAS_INT lda) { char UL; #ifdef F77_CHAR @@ -40,7 +40,7 @@ void cblas_dsyr2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasUpper) UL = 'U'; else { - cblas_xerbla(2, "cblas_dsyr2","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_dsyr2","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -59,7 +59,7 @@ void cblas_dsyr2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasUpper) UL = 'L'; else { - cblas_xerbla(2, "cblas_dsyr2","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_dsyr2","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -69,7 +69,7 @@ void cblas_dsyr2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, #endif F77_dsyr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A, &F77_lda); - } else cblas_xerbla(1, "cblas_dsyr2", "Illegal layout setting, %d\n", layout); + } else API_SUFFIX(cblas_xerbla)(1, "cblas_dsyr2", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_dsyr2k.c b/CBLAS/src/cblas_dsyr2k.c index 9e92120174..d8921af2f2 100644 --- a/CBLAS/src/cblas_dsyr2k.c +++ b/CBLAS/src/cblas_dsyr2k.c @@ -9,11 +9,11 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_dsyr2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, - const CBLAS_TRANSPOSE Trans, const int N, const int K, - const double alpha, const double *A, const int lda, - const double *B, const int ldb, const double beta, - double *C, const int ldc) +void API_SUFFIX(cblas_dsyr2k)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_TRANSPOSE Trans, const CBLAS_INT N, const CBLAS_INT K, + const double alpha, const double *A, const CBLAS_INT lda, + const double *B, const CBLAS_INT ldb, const double beta, + double *C, const CBLAS_INT ldc) { char UL, TR; #ifdef F77_CHAR @@ -46,7 +46,7 @@ void cblas_dsyr2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='L'; else { - cblas_xerbla(2, "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; @@ -57,7 +57,7 @@ void cblas_dsyr2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Trans == CblasNoTrans ) TR='N'; else { - cblas_xerbla(3, "cblas_dsyr2k","Illegal Trans setting, %d\n", Trans); + API_SUFFIX(cblas_xerbla)(3, "cblas_dsyr2k","Illegal Trans setting, %d\n", Trans); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -78,7 +78,7 @@ void cblas_dsyr2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='U'; else { - 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; @@ -88,7 +88,7 @@ void cblas_dsyr2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Trans == CblasNoTrans ) TR='T'; else { - cblas_xerbla(3, "cblas_dsyr2k","Illegal Trans setting, %d\n", Trans); + API_SUFFIX(cblas_xerbla)(3, "cblas_dsyr2k","Illegal Trans setting, %d\n", Trans); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -102,7 +102,7 @@ void cblas_dsyr2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, F77_dsyr2k(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc); } - else cblas_xerbla(1, "cblas_dsyr2k","Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_dsyr2k","Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_dsyrk.c b/CBLAS/src/cblas_dsyrk.c index d98b4705d8..059e42e522 100644 --- a/CBLAS/src/cblas_dsyrk.c +++ b/CBLAS/src/cblas_dsyrk.c @@ -9,10 +9,10 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_dsyrk(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, - const CBLAS_TRANSPOSE Trans, const int N, const int K, - const double alpha, const double *A, const int lda, - const double beta, double *C, const int ldc) +void API_SUFFIX(cblas_dsyrk)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_TRANSPOSE Trans, const CBLAS_INT N, const CBLAS_INT K, + const double alpha, const double *A, const CBLAS_INT lda, + const double beta, double *C, const CBLAS_INT ldc) { char UL, TR; #ifdef F77_CHAR @@ -44,7 +44,7 @@ void cblas_dsyrk(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='L'; else { - cblas_xerbla(2, "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; @@ -55,7 +55,7 @@ void cblas_dsyrk(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Trans == CblasNoTrans ) TR='N'; else { - cblas_xerbla(3, "cblas_dsyrk","Illegal Trans setting, %d\n", Trans); + API_SUFFIX(cblas_xerbla)(3, "cblas_dsyrk","Illegal Trans setting, %d\n", Trans); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -76,7 +76,7 @@ void cblas_dsyrk(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='U'; else { - 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; @@ -86,7 +86,7 @@ void cblas_dsyrk(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Trans == CblasNoTrans ) TR='T'; else { - cblas_xerbla(3, "cblas_dsyrk","Illegal Trans setting, %d\n", Trans); + API_SUFFIX(cblas_xerbla)(3, "cblas_dsyrk","Illegal Trans setting, %d\n", Trans); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -100,7 +100,7 @@ void cblas_dsyrk(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, F77_dsyrk(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda, &beta, C, &F77_ldc); } - else cblas_xerbla(1, "cblas_dsyrk","Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_dsyrk","Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_dtbmv.c b/CBLAS/src/cblas_dtbmv.c index 6438651ad4..eb4b59d7c3 100644 --- a/CBLAS/src/cblas_dtbmv.c +++ b/CBLAS/src/cblas_dtbmv.c @@ -7,10 +7,10 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_dtbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, +void API_SUFFIX(cblas_dtbmv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, const CBLAS_DIAG Diag, - const int N, const int K, const double *A, const int lda, - double *X, const int incX) + const CBLAS_INT N, const CBLAS_INT K, const double *A, const CBLAS_INT lda, + double *X, const CBLAS_INT incX) { char TA; char UL; @@ -41,7 +41,7 @@ void cblas_dtbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'L'; else { - cblas_xerbla(2, "cblas_dtbmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_dtbmv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -51,7 +51,7 @@ void cblas_dtbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'C'; else { - cblas_xerbla(3, "cblas_dtbmv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_dtbmv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -60,7 +60,7 @@ void cblas_dtbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_dtbmv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_dtbmv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -80,7 +80,7 @@ void cblas_dtbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_dtbmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_dtbmv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -91,7 +91,7 @@ void cblas_dtbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'N'; else { - cblas_xerbla(3, "cblas_dtbmv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_dtbmv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -101,7 +101,7 @@ void cblas_dtbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - 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; @@ -116,7 +116,7 @@ void cblas_dtbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, &F77_incX); } - else cblas_xerbla(1, "cblas_dtbmv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_dtbmv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; } diff --git a/CBLAS/src/cblas_dtbsv.c b/CBLAS/src/cblas_dtbsv.c index eac77055b5..fefca5bd43 100644 --- a/CBLAS/src/cblas_dtbsv.c +++ b/CBLAS/src/cblas_dtbsv.c @@ -7,10 +7,10 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_dtbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, +void API_SUFFIX(cblas_dtbsv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, const CBLAS_DIAG Diag, - const int N, const int K, const double *A, const int lda, - double *X, const int incX) + const CBLAS_INT N, const CBLAS_INT K, const double *A, const CBLAS_INT lda, + double *X, const CBLAS_INT incX) { char TA; char UL; @@ -41,7 +41,7 @@ void cblas_dtbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'L'; else { - cblas_xerbla(2, "cblas_dtbsv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_dtbsv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -51,7 +51,7 @@ void cblas_dtbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'C'; else { - cblas_xerbla(3, "cblas_dtbsv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_dtbsv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -60,7 +60,7 @@ void cblas_dtbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_dtbsv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_dtbsv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -80,7 +80,7 @@ void cblas_dtbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_dtbsv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_dtbsv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -91,7 +91,7 @@ void cblas_dtbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'N'; else { - cblas_xerbla(3, "cblas_dtbsv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_dtbsv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -101,7 +101,7 @@ void cblas_dtbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_dtbsv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_dtbsv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -115,7 +115,7 @@ void cblas_dtbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, F77_dtbsv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X, &F77_incX); } - else cblas_xerbla(1, "cblas_dtbsv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_dtbsv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_dtpmv.c b/CBLAS/src/cblas_dtpmv.c index 6946d9846f..bd502fea96 100644 --- a/CBLAS/src/cblas_dtpmv.c +++ b/CBLAS/src/cblas_dtpmv.c @@ -7,9 +7,9 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_dtpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, +void API_SUFFIX(cblas_dtpmv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, const CBLAS_DIAG Diag, - const int N, const double *Ap, double *X, const int incX) + const CBLAS_INT N, const double *Ap, double *X, const CBLAS_INT incX) { char TA; char UL; @@ -38,7 +38,7 @@ void cblas_dtpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'L'; else { - cblas_xerbla(2, "cblas_dtpmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_dtpmv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -48,7 +48,7 @@ void cblas_dtpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'C'; else { - cblas_xerbla(3, "cblas_dtpmv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_dtpmv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -57,7 +57,7 @@ void cblas_dtpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_dtpmv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_dtpmv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -76,7 +76,7 @@ void cblas_dtpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_dtpmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_dtpmv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -87,7 +87,7 @@ void cblas_dtpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'N'; else { - cblas_xerbla(3, "cblas_dtpmv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_dtpmv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -97,7 +97,7 @@ void cblas_dtpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_dtpmv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_dtpmv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -110,7 +110,7 @@ void cblas_dtpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, F77_dtpmv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X,&F77_incX); } - else cblas_xerbla(1, "cblas_dtpmv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_dtpmv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_dtpsv.c b/CBLAS/src/cblas_dtpsv.c index b29476767a..c7894ca744 100644 --- a/CBLAS/src/cblas_dtpsv.c +++ b/CBLAS/src/cblas_dtpsv.c @@ -7,9 +7,9 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_dtpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, +void API_SUFFIX(cblas_dtpsv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, const CBLAS_DIAG Diag, - const int N, const double *Ap, double *X, const int incX) + const CBLAS_INT N, const double *Ap, double *X, const CBLAS_INT incX) { char TA; char UL; @@ -38,7 +38,7 @@ void cblas_dtpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'L'; else { - cblas_xerbla(2, "cblas_dtpsv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_dtpsv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -48,7 +48,7 @@ void cblas_dtpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'C'; else { - cblas_xerbla(3, "cblas_dtpsv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_dtpsv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -57,7 +57,7 @@ void cblas_dtpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_dtpsv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_dtpsv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -76,7 +76,7 @@ void cblas_dtpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_dtpsv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_dtpsv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -87,7 +87,7 @@ void cblas_dtpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'N'; else { - cblas_xerbla(3, "cblas_dtpsv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_dtpsv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -97,7 +97,7 @@ void cblas_dtpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_dtpsv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_dtpsv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -111,7 +111,7 @@ void cblas_dtpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, F77_dtpsv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X,&F77_incX); } - else cblas_xerbla(1, "cblas_dtpsv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_dtpsv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_dtrmm.c b/CBLAS/src/cblas_dtrmm.c index 6ee79e42d2..1421d5d158 100644 --- a/CBLAS/src/cblas_dtrmm.c +++ b/CBLAS/src/cblas_dtrmm.c @@ -9,11 +9,11 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_dtrmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, +void API_SUFFIX(cblas_dtrmm)(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, - const CBLAS_DIAG Diag, const int M, const int N, - const double alpha, const double *A, const int lda, - double *B, const int ldb) + const CBLAS_DIAG Diag, const CBLAS_INT M, const CBLAS_INT N, + const double alpha, const double *A, const CBLAS_INT lda, + double *B, const CBLAS_INT ldb) { char UL, TA, SD, DI; #ifdef F77_CHAR @@ -45,7 +45,7 @@ void cblas_dtrmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Side == CblasLeft ) SD='L'; else { - cblas_xerbla(2, "cblas_dtrmm","Illegal Side setting, %d\n", Side); + API_SUFFIX(cblas_xerbla)(2, "cblas_dtrmm","Illegal Side setting, %d\n", Side); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -54,7 +54,7 @@ void cblas_dtrmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Uplo == CblasLower ) UL='L'; else { - cblas_xerbla(3, "cblas_dtrmm","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(3, "cblas_dtrmm","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -65,7 +65,7 @@ void cblas_dtrmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( TransA == CblasNoTrans ) TA='N'; else { - cblas_xerbla(4, "cblas_dtrmm","Illegal Trans setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(4, "cblas_dtrmm","Illegal Trans setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -75,7 +75,7 @@ void cblas_dtrmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Diag == CblasNonUnit ) DI='N'; else { - cblas_xerbla(5, "cblas_dtrmm","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(5, "cblas_dtrmm","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -96,7 +96,7 @@ void cblas_dtrmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Side == CblasLeft ) SD='R'; else { - cblas_xerbla(2, "cblas_dtrmm","Illegal Side setting, %d\n", Side); + API_SUFFIX(cblas_xerbla)(2, "cblas_dtrmm","Illegal Side setting, %d\n", Side); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -106,7 +106,7 @@ void cblas_dtrmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Uplo == CblasLower ) UL='U'; else { - cblas_xerbla(3, "cblas_dtrmm","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(3, "cblas_dtrmm","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -117,7 +117,7 @@ void cblas_dtrmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( TransA == CblasNoTrans ) TA='N'; else { - cblas_xerbla(4, "cblas_dtrmm","Illegal Trans setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(4, "cblas_dtrmm","Illegal Trans setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -127,7 +127,7 @@ void cblas_dtrmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Diag == CblasNonUnit ) DI='N'; else { - cblas_xerbla(5, "cblas_dtrmm","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(5, "cblas_dtrmm","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -141,7 +141,7 @@ void cblas_dtrmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, #endif F77_dtrmm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, &alpha, A, &F77_lda, B, &F77_ldb); } - else cblas_xerbla(1, "cblas_dtrmm", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_dtrmm", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_dtrmv.c b/CBLAS/src/cblas_dtrmv.c index 18c492142d..6ee99a5d81 100644 --- a/CBLAS/src/cblas_dtrmv.c +++ b/CBLAS/src/cblas_dtrmv.c @@ -9,10 +9,10 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_dtrmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, +void API_SUFFIX(cblas_dtrmv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, const CBLAS_DIAG Diag, - const int N, const double *A, const int lda, - double *X, const int incX) + const CBLAS_INT N, const double *A, const CBLAS_INT lda, + double *X, const CBLAS_INT incX) { char TA; @@ -43,7 +43,7 @@ void cblas_dtrmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'L'; else { - cblas_xerbla(2, "cblas_dtrmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_dtrmv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -53,7 +53,7 @@ void cblas_dtrmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'C'; else { - cblas_xerbla(3, "cblas_dtrmv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_dtrmv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -62,7 +62,7 @@ void cblas_dtrmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_dtrmv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_dtrmv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -82,7 +82,7 @@ void cblas_dtrmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_dtrmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_dtrmv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -93,7 +93,7 @@ void cblas_dtrmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'N'; else { - cblas_xerbla(3, "cblas_dtrmv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_dtrmv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -103,7 +103,7 @@ void cblas_dtrmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_dtrmv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_dtrmv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -115,7 +115,7 @@ void cblas_dtrmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, #endif F77_dtrmv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X, &F77_incX); - } else cblas_xerbla(1, "cblas_dtrmv", "Illegal layout setting, %d\n", layout); + } else API_SUFFIX(cblas_xerbla)(1, "cblas_dtrmv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_dtrsm.c b/CBLAS/src/cblas_dtrsm.c index 47396020dd..a53a8a0609 100644 --- a/CBLAS/src/cblas_dtrsm.c +++ b/CBLAS/src/cblas_dtrsm.c @@ -9,11 +9,11 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_dtrsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, +void API_SUFFIX(cblas_dtrsm)(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, - const CBLAS_DIAG Diag, const int M, const int N, - const double alpha, const double *A, const int lda, - double *B, const int ldb) + const CBLAS_DIAG Diag, const CBLAS_INT M, const CBLAS_INT N, + const double alpha, const double *A, const CBLAS_INT lda, + double *B, const CBLAS_INT ldb) { char UL, TA, SD, DI; @@ -46,7 +46,7 @@ void cblas_dtrsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Side == CblasLeft ) SD='L'; else { - cblas_xerbla(2, "cblas_dtrsm","Illegal Side setting, %d\n", Side); + API_SUFFIX(cblas_xerbla)(2, "cblas_dtrsm","Illegal Side setting, %d\n", Side); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -55,7 +55,7 @@ void cblas_dtrsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Uplo == CblasLower) UL='L'; else { - cblas_xerbla(3, "cblas_dtrsm","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(3, "cblas_dtrsm","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -66,7 +66,7 @@ void cblas_dtrsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( TransA == CblasNoTrans ) TA='N'; else { - cblas_xerbla(4, "cblas_dtrsm","Illegal Trans setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(4, "cblas_dtrsm","Illegal Trans setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -76,7 +76,7 @@ void cblas_dtrsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Diag == CblasNonUnit) DI='N'; else { - cblas_xerbla(5, "cblas_dtrsm","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(5, "cblas_dtrsm","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -99,7 +99,7 @@ void cblas_dtrsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Side == CblasLeft ) SD='R'; else { - cblas_xerbla(2, "cblas_dtrsm","Illegal Side setting, %d\n", Side); + API_SUFFIX(cblas_xerbla)(2, "cblas_dtrsm","Illegal Side setting, %d\n", Side); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -109,7 +109,7 @@ void cblas_dtrsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Uplo == CblasLower) UL='U'; else { - cblas_xerbla(3, "cblas_dtrsm","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(3, "cblas_dtrsm","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -120,7 +120,7 @@ void cblas_dtrsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( TransA == CblasNoTrans ) TA='N'; else { - cblas_xerbla(4, "cblas_dtrsm","Illegal Trans setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(4, "cblas_dtrsm","Illegal Trans setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -130,7 +130,7 @@ void cblas_dtrsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Diag == CblasNonUnit) DI='N'; else { - cblas_xerbla(5, "cblas_dtrsm","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(5, "cblas_dtrsm","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -146,7 +146,7 @@ void cblas_dtrsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, F77_dtrsm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, &alpha, A, &F77_lda, B, &F77_ldb); } - else cblas_xerbla(1, "cblas_dtrsm","Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_dtrsm","Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_dtrsv.c b/CBLAS/src/cblas_dtrsv.c index c0a51c10be..527d3c255d 100644 --- a/CBLAS/src/cblas_dtrsv.c +++ b/CBLAS/src/cblas_dtrsv.c @@ -7,10 +7,10 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_dtrsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, +void API_SUFFIX(cblas_dtrsv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, const CBLAS_DIAG Diag, - const int N, const double *A, const int lda, double *X, - const int incX) + const CBLAS_INT N, const double *A, const CBLAS_INT lda, double *X, + const CBLAS_INT incX) { char TA; @@ -41,7 +41,7 @@ void cblas_dtrsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'L'; else { - cblas_xerbla(2, "cblas_dtrsv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_dtrsv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -51,7 +51,7 @@ void cblas_dtrsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'C'; else { - cblas_xerbla(3, "cblas_dtrsv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_dtrsv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -60,7 +60,7 @@ void cblas_dtrsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_dtrsv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_dtrsv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -80,7 +80,7 @@ void cblas_dtrsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_dtrsv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_dtrsv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -91,7 +91,7 @@ void cblas_dtrsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'N'; else { - cblas_xerbla(3, "cblas_dtrsv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_dtrsv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -101,7 +101,7 @@ void cblas_dtrsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_dtrsv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_dtrsv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -114,7 +114,7 @@ void cblas_dtrsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, F77_dtrsv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X, &F77_incX); } - else cblas_xerbla(1, "cblas_dtrsv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_dtrsv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_dzasum.c b/CBLAS/src/cblas_dzasum.c index a120e00fef..d306ac6dce 100644 --- a/CBLAS/src/cblas_dzasum.c +++ b/CBLAS/src/cblas_dzasum.c @@ -9,7 +9,7 @@ */ #include "cblas.h" #include "cblas_f77.h" -double cblas_dzasum( const int N, const void *X, const int incX) +double API_SUFFIX(cblas_dzasum)( const CBLAS_INT N, const void *X, const CBLAS_INT incX) { double asum; #ifdef F77_INT diff --git a/CBLAS/src/cblas_dznrm2.c b/CBLAS/src/cblas_dznrm2.c index e44db340d6..92ba052418 100644 --- a/CBLAS/src/cblas_dznrm2.c +++ b/CBLAS/src/cblas_dznrm2.c @@ -9,7 +9,7 @@ */ #include "cblas.h" #include "cblas_f77.h" -double cblas_dznrm2( const int N, const void *X, const int incX) +double API_SUFFIX(cblas_dznrm2)( const CBLAS_INT N, const void *X, const CBLAS_INT incX) { double nrm2; #ifdef F77_INT diff --git a/CBLAS/src/cblas_globals.c b/CBLAS/src/cblas_globals.c index ebcd74db3f..1830257bea 100644 --- a/CBLAS/src/cblas_globals.c +++ b/CBLAS/src/cblas_globals.c @@ -1,2 +1,4 @@ -int CBLAS_CallFromC=0; -int RowMajorStrg=0; +#include "cblas_globals.h" + +CBLAS_GLOBAL_SYMBOL int CBLAS_CallFromC = 0; +CBLAS_GLOBAL_SYMBOL int RowMajorStrg = 0; diff --git a/CBLAS/src/cblas_icamax.c b/CBLAS/src/cblas_icamax.c index 0fe5625d94..8fc0c592b2 100644 --- a/CBLAS/src/cblas_icamax.c +++ b/CBLAS/src/cblas_icamax.c @@ -9,15 +9,17 @@ */ #include "cblas.h" #include "cblas_f77.h" -CBLAS_INDEX cblas_icamax( const int N, const void *X, const int incX) +CBLAS_INDEX API_SUFFIX(cblas_icamax)( const CBLAS_INT N, const void *X, const CBLAS_INT incX) { - CBLAS_INDEX iamax; #ifdef F77_INT - F77_INT F77_N=N, F77_incX=incX; + F77_INT F77_N=N, F77_incX=incX, F77_iamax; #else #define F77_N N #define F77_incX incX + CBLAS_INT F77_iamax; #endif - F77_icamax_sub( &F77_N, X, &F77_incX, &iamax); - return iamax ? iamax-1 : 0; + F77_icamax_sub( &F77_N, X, &F77_incX, &F77_iamax ); + return ( F77_iamax > 0 ) + ? (CBLAS_INDEX)( F77_iamax-1 ) + : (CBLAS_INDEX) 0; } diff --git a/CBLAS/src/cblas_idamax.c b/CBLAS/src/cblas_idamax.c index e0c4cd883c..4d7599f9c5 100644 --- a/CBLAS/src/cblas_idamax.c +++ b/CBLAS/src/cblas_idamax.c @@ -9,15 +9,17 @@ */ #include "cblas.h" #include "cblas_f77.h" -CBLAS_INDEX cblas_idamax( const int N, const double *X, const int incX) +CBLAS_INDEX API_SUFFIX(cblas_idamax)( const CBLAS_INT N, const double *X, const CBLAS_INT incX) { - CBLAS_INDEX iamax; #ifdef F77_INT - F77_INT F77_N=N, F77_incX=incX; + F77_INT F77_N=N, F77_incX=incX, F77_iamax; #else #define F77_N N #define F77_incX incX + CBLAS_INT F77_iamax; #endif - F77_idamax_sub( &F77_N, X, &F77_incX, &iamax); - return iamax ? iamax-1 : 0; + F77_idamax_sub( &F77_N, X, &F77_incX, &F77_iamax ); + return ( F77_iamax > 0 ) + ? (CBLAS_INDEX)( F77_iamax-1 ) + : (CBLAS_INDEX) 0; } diff --git a/CBLAS/src/cblas_isamax.c b/CBLAS/src/cblas_isamax.c index e2f3fd86ca..8b0f29a3bd 100644 --- a/CBLAS/src/cblas_isamax.c +++ b/CBLAS/src/cblas_isamax.c @@ -9,15 +9,17 @@ */ #include "cblas.h" #include "cblas_f77.h" -CBLAS_INDEX cblas_isamax( const int N, const float *X, const int incX) +CBLAS_INDEX API_SUFFIX(cblas_isamax)( const CBLAS_INT N, const float *X, const CBLAS_INT incX) { - CBLAS_INDEX iamax; #ifdef F77_INT - F77_INT F77_N=N, F77_incX=incX; + F77_INT F77_N=N, F77_incX=incX, F77_iamax; #else #define F77_N N #define F77_incX incX + CBLAS_INT F77_iamax; #endif - F77_isamax_sub( &F77_N, X, &F77_incX, &iamax); - return iamax ? iamax-1 : 0; + F77_isamax_sub( &F77_N, X, &F77_incX, &F77_iamax ); + return ( F77_iamax > 0 ) + ? (CBLAS_INDEX)( F77_iamax-1 ) + : (CBLAS_INDEX) 0; } diff --git a/CBLAS/src/cblas_izamax.c b/CBLAS/src/cblas_izamax.c index 4370d942a4..20ca0cdb7b 100644 --- a/CBLAS/src/cblas_izamax.c +++ b/CBLAS/src/cblas_izamax.c @@ -9,15 +9,17 @@ */ #include "cblas.h" #include "cblas_f77.h" -CBLAS_INDEX cblas_izamax( const int N, const void *X, const int incX) +CBLAS_INDEX API_SUFFIX(cblas_izamax)( const CBLAS_INT N, const void *X, const CBLAS_INT incX) { - CBLAS_INDEX iamax; #ifdef F77_INT - F77_INT F77_N=N, F77_incX=incX; + F77_INT F77_N=N, F77_incX=incX, F77_iamax; #else #define F77_N N #define F77_incX incX + CBLAS_INT F77_iamax; #endif - F77_izamax_sub( &F77_N, X, &F77_incX, &iamax); - return (iamax ? iamax-1 : 0); + F77_izamax_sub( &F77_N, X, &F77_incX, &F77_iamax ); + return ( F77_iamax > 0 ) + ? (CBLAS_INDEX)( F77_iamax-1 ) + : (CBLAS_INDEX) 0; } diff --git a/CBLAS/src/cblas_sasum.c b/CBLAS/src/cblas_sasum.c index 042939af48..fcdfbc01b2 100644 --- a/CBLAS/src/cblas_sasum.c +++ b/CBLAS/src/cblas_sasum.c @@ -9,7 +9,7 @@ */ #include "cblas.h" #include "cblas_f77.h" -float cblas_sasum( const int N, const float *X, const int incX) +float API_SUFFIX(cblas_sasum)( const CBLAS_INT N, const float *X, const CBLAS_INT incX) { float asum; #ifdef F77_INT diff --git a/CBLAS/src/cblas_saxpby.c b/CBLAS/src/cblas_saxpby.c new file mode 100644 index 0000000000..b8e025d766 --- /dev/null +++ b/CBLAS/src/cblas_saxpby.c @@ -0,0 +1,23 @@ +/* + * cblas_saxpby.c + * + * The program is a C interface to saxpby. + * It calls the fortran wrapper before calling saxpby. + * + * Written by Martin Koehler, 08/24/2024 + * + */ +#include "cblas.h" +#include "cblas_f77.h" +void API_SUFFIX(cblas_saxpby)( const CBLAS_INT N, const float alpha, const float *X, + const CBLAS_INT incX, const float beta, float *Y, const CBLAS_INT incY) +{ +#ifdef F77_INT + F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; +#else + #define F77_N N + #define F77_incX incX + #define F77_incY incY +#endif + F77_saxpby( &F77_N, &alpha, X, &F77_incX, &beta, Y, &F77_incY); +} diff --git a/CBLAS/src/cblas_saxpy.c b/CBLAS/src/cblas_saxpy.c index baf17a5475..8d1541d8a2 100644 --- a/CBLAS/src/cblas_saxpy.c +++ b/CBLAS/src/cblas_saxpy.c @@ -9,8 +9,8 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_saxpy( const int N, const float alpha, const float *X, - const int incX, float *Y, const int incY) +void API_SUFFIX(cblas_saxpy)( const CBLAS_INT N, const float alpha, const float *X, + const CBLAS_INT incX, float *Y, const CBLAS_INT incY) { #ifdef F77_INT F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; diff --git a/CBLAS/src/cblas_scabs1.c b/CBLAS/src/cblas_scabs1.c new file mode 100644 index 0000000000..5899603d9a --- /dev/null +++ b/CBLAS/src/cblas_scabs1.c @@ -0,0 +1,15 @@ +/* + * cblas_scabs1.c + * + * The program is a C interface to scabs1. + * + */ +#include "cblas.h" +#include "cblas_f77.h" +float API_SUFFIX(cblas_scabs1)(const void *c) +{ + float cabs1 = 0.0; + F77_scabs1_sub(c, &cabs1); + return cabs1; +} + diff --git a/CBLAS/src/cblas_scasum.c b/CBLAS/src/cblas_scasum.c index 1f5b7d4035..feda02d751 100644 --- a/CBLAS/src/cblas_scasum.c +++ b/CBLAS/src/cblas_scasum.c @@ -9,7 +9,7 @@ */ #include "cblas.h" #include "cblas_f77.h" -float cblas_scasum( const int N, const void *X, const int incX) +float API_SUFFIX(cblas_scasum)( const CBLAS_INT N, const void *X, const CBLAS_INT incX) { float asum; #ifdef F77_INT diff --git a/CBLAS/src/cblas_scnrm2.c b/CBLAS/src/cblas_scnrm2.c index c05b338cdb..a1825816c0 100644 --- a/CBLAS/src/cblas_scnrm2.c +++ b/CBLAS/src/cblas_scnrm2.c @@ -9,7 +9,7 @@ */ #include "cblas.h" #include "cblas_f77.h" -float cblas_scnrm2( const int N, const void *X, const int incX) +float API_SUFFIX(cblas_scnrm2)( const CBLAS_INT N, const void *X, const CBLAS_INT incX) { float nrm2; #ifdef F77_INT diff --git a/CBLAS/src/cblas_scopy.c b/CBLAS/src/cblas_scopy.c index 1424391f6d..7f3dcdcc9f 100644 --- a/CBLAS/src/cblas_scopy.c +++ b/CBLAS/src/cblas_scopy.c @@ -8,8 +8,8 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_scopy( const int N, const float *X, - const int incX, float *Y, const int incY) +void API_SUFFIX(cblas_scopy)( const CBLAS_INT N, const float *X, + const CBLAS_INT incX, float *Y, const CBLAS_INT incY) { #ifdef F77_INT F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; diff --git a/CBLAS/src/cblas_sdot.c b/CBLAS/src/cblas_sdot.c index 218914af84..76e56353a0 100644 --- a/CBLAS/src/cblas_sdot.c +++ b/CBLAS/src/cblas_sdot.c @@ -9,8 +9,8 @@ */ #include "cblas.h" #include "cblas_f77.h" -float cblas_sdot( const int N, const float *X, - const int incX, const float *Y, const int incY) +float API_SUFFIX(cblas_sdot)( const CBLAS_INT N, const float *X, + const CBLAS_INT incX, const float *Y, const CBLAS_INT incY) { float dot; #ifdef F77_INT diff --git a/CBLAS/src/cblas_sdsdot.c b/CBLAS/src/cblas_sdsdot.c index 65741aff4d..113dd57b65 100644 --- a/CBLAS/src/cblas_sdsdot.c +++ b/CBLAS/src/cblas_sdsdot.c @@ -9,8 +9,8 @@ */ #include "cblas.h" #include "cblas_f77.h" -float cblas_sdsdot( const int N, const float alpha, const float *X, - const int incX, const float *Y, const int incY) +float API_SUFFIX(cblas_sdsdot)( const CBLAS_INT N, const float alpha, const float *X, + const CBLAS_INT incX, const float *Y, const CBLAS_INT incY) { float dot; #ifdef F77_INT diff --git a/CBLAS/src/cblas_sgbmv.c b/CBLAS/src/cblas_sgbmv.c index 0557c10b4b..e530260e67 100644 --- a/CBLAS/src/cblas_sgbmv.c +++ b/CBLAS/src/cblas_sgbmv.c @@ -9,12 +9,12 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_sgbmv(const CBLAS_LAYOUT layout, - const CBLAS_TRANSPOSE TransA, const int M, const int N, - const int KL, const int KU, - const float alpha, const float *A, const int lda, - const float *X, const int incX, const float beta, - float *Y, const int incY) +void API_SUFFIX(cblas_sgbmv)(const CBLAS_LAYOUT layout, + const CBLAS_TRANSPOSE TransA, const CBLAS_INT M, const CBLAS_INT N, + const CBLAS_INT KL, const CBLAS_INT KU, + const float alpha, const float *A, const CBLAS_INT lda, + const float *X, const CBLAS_INT incX, const float beta, + float *Y, const CBLAS_INT incY) { char TA; #ifdef F77_CHAR @@ -46,7 +46,7 @@ void cblas_sgbmv(const CBLAS_LAYOUT layout, else if (TransA == CblasConjTrans) TA = 'C'; else { - cblas_xerbla(2, "cblas_sgbmv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(2, "cblas_sgbmv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -65,7 +65,7 @@ void cblas_sgbmv(const CBLAS_LAYOUT layout, else if (TransA == CblasConjTrans) TA = 'N'; else { - cblas_xerbla(2, "cblas_sgbmv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(2, "cblas_sgbmv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -76,7 +76,7 @@ void cblas_sgbmv(const CBLAS_LAYOUT layout, F77_sgbmv(F77_TA, &F77_N, &F77_M, &F77_KU, &F77_KL, &alpha, A ,&F77_lda, X, &F77_incX, &beta, Y, &F77_incY); } - else cblas_xerbla(1, "cblas_sgbmv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_sgbmv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_sgemm.c b/CBLAS/src/cblas_sgemm.c index c4a49a2db2..26be2a8f0a 100644 --- a/CBLAS/src/cblas_sgemm.c +++ b/CBLAS/src/cblas_sgemm.c @@ -9,11 +9,11 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_sgemm(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA, - const CBLAS_TRANSPOSE TransB, const int M, const int N, - const int K, const float alpha, const float *A, - const int lda, const float *B, const int ldb, - const float beta, float *C, const int ldc) +void API_SUFFIX(cblas_sgemm)(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA, + const CBLAS_TRANSPOSE TransB, const CBLAS_INT M, const CBLAS_INT N, + const CBLAS_INT K, const float alpha, const float *A, + const CBLAS_INT lda, const float *B, const CBLAS_INT ldb, + const float beta, float *C, const CBLAS_INT ldc) { char TA, TB; #ifdef F77_CHAR @@ -46,7 +46,7 @@ void cblas_sgemm(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA, else if ( TransA == CblasNoTrans ) TA='N'; else { - cblas_xerbla(2, "cblas_sgemm", + API_SUFFIX(cblas_xerbla)(2, "cblas_sgemm", "Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; @@ -58,7 +58,7 @@ void cblas_sgemm(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA, else if ( TransB == CblasNoTrans ) TB='N'; else { - cblas_xerbla(3, "cblas_sgemm", + API_SUFFIX(cblas_xerbla)(3, "cblas_sgemm", "Illegal TransB setting, %d\n", TransB); CBLAS_CallFromC = 0; RowMajorStrg = 0; @@ -79,7 +79,7 @@ void cblas_sgemm(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA, else if ( TransA == CblasNoTrans ) TB='N'; else { - cblas_xerbla(2, "cblas_sgemm", + API_SUFFIX(cblas_xerbla)(2, "cblas_sgemm", "Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; @@ -90,8 +90,8 @@ void cblas_sgemm(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA, else if ( TransB == CblasNoTrans ) TA='N'; else { - cblas_xerbla(2, "cblas_sgemm", - "Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_sgemm", + "Illegal TransB setting, %d\n", TransB); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -103,7 +103,7 @@ void cblas_sgemm(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA, F77_sgemm(F77_TA, F77_TB, &F77_N, &F77_M, &F77_K, &alpha, B, &F77_ldb, A, &F77_lda, &beta, C, &F77_ldc); } else - cblas_xerbla(1, "cblas_sgemm", + API_SUFFIX(cblas_xerbla)(1, "cblas_sgemm", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; diff --git a/CBLAS/src/cblas_sgemmtr.c b/CBLAS/src/cblas_sgemmtr.c new file mode 100644 index 0000000000..065a031bec --- /dev/null +++ b/CBLAS/src/cblas_sgemmtr.c @@ -0,0 +1,136 @@ + +/* + * + * cblas_sgemmtr.c + * This program is a C interface to sgemmtr. + * Written by Martin Koehler, MPI Magdeburg + * 06/24/2024 + * + */ + +#include "cblas.h" +#include "cblas_f77.h" +void API_SUFFIX(cblas_sgemmtr)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, + const CBLAS_TRANSPOSE TransB, const CBLAS_INT N, + const CBLAS_INT K, const float alpha, const float *A, + const CBLAS_INT lda, const float *B, const CBLAS_INT ldb, + const float beta, float *C, const CBLAS_INT ldc) +{ + char TA, TB, UL; +#ifdef F77_CHAR + F77_CHAR F77_TA, F77_TB, F77_UL; +#else +#define F77_TA &TA +#define F77_TB &TB +#define F77_UL &UL +#endif + +#ifdef F77_INT + F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb; + F77_INT F77_ldc=ldc; +#else +#define F77_N N +#define F77_K K +#define F77_lda lda +#define F77_ldb ldb +#define F77_ldc ldc +#endif + + extern int CBLAS_CallFromC; + extern int RowMajorStrg; + RowMajorStrg = 0; + CBLAS_CallFromC = 1; + + + if( layout == CblasColMajor ) + { + if ( Uplo == CblasUpper ) UL = 'U'; + else if (Uplo == CblasLower) UL= 'L'; + else { + API_SUFFIX(cblas_xerbla)(2, "cblas_sgemmtr", "Illegal Uplo setting, %d\n", Uplo); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + + if(TransA == CblasTrans) TA='T'; + else if ( TransA == CblasConjTrans ) TA='C'; + else if ( TransA == CblasNoTrans ) TA='N'; + else + { + API_SUFFIX(cblas_xerbla)(3, "cblas_sgemmtr", + "Illegal TransA setting, %d\n", TransA); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + if(TransB == CblasTrans) TB='T'; + else if ( TransB == CblasConjTrans ) TB='C'; + else if ( TransB == CblasNoTrans ) TB='N'; + else + { + API_SUFFIX(cblas_xerbla)(4, "cblas_sgemmtr", + "Illegal TransB setting, %d\n", TransB); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + +#ifdef F77_CHAR + F77_TA = C2F_CHAR(&TA); + F77_TB = C2F_CHAR(&TB); + F77_UL = C2F_CHAR(&UL); +#endif + + F77_sgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, &alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc); + } + else if (layout == CblasRowMajor) + { + if ( Uplo == CblasUpper ) UL = 'L'; + else if (Uplo == CblasLower) UL= 'U'; + else { + API_SUFFIX(cblas_xerbla)(2, "cblas_sgemmtr", "Illegal Uplo setting, %d\n", Uplo); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + + RowMajorStrg = 1; + if(TransA == CblasTrans) TB='T'; + else if ( TransA == CblasConjTrans ) TB='C'; + else if ( TransA == CblasNoTrans ) TB='N'; + else + { + API_SUFFIX(cblas_xerbla)(3, "cblas_sgemmtr", + "Illegal TransA setting, %d\n", TransA); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + if(TransB == CblasTrans) TA='T'; + else if ( TransB == CblasConjTrans ) TA='C'; + else if ( TransB == CblasNoTrans ) TA='N'; + else + { + API_SUFFIX(cblas_xerbla)(4, "cblas_sgemmtr", + "Illegal TransB setting, %d\n", TransB); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } +#ifdef F77_CHAR + F77_TA = C2F_CHAR(&TA); + F77_TB = C2F_CHAR(&TB); + F77_UL = C2F_CHAR(&UL); +#endif + + F77_sgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, &alpha, B, &F77_ldb, A, &F77_lda, &beta, C, &F77_ldc); + } else + API_SUFFIX(cblas_xerbla)(1, "cblas_sgemmtr", + "Illegal layout setting, %d\n", layout); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; +} diff --git a/CBLAS/src/cblas_sgemv.c b/CBLAS/src/cblas_sgemv.c index b2c2969b72..5c95151f9e 100644 --- a/CBLAS/src/cblas_sgemv.c +++ b/CBLAS/src/cblas_sgemv.c @@ -8,11 +8,11 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_sgemv(const CBLAS_LAYOUT layout, - const CBLAS_TRANSPOSE TransA, const int M, const int N, - const float alpha, const float *A, const int lda, - const float *X, const int incX, const float beta, - float *Y, const int incY) +void API_SUFFIX(cblas_sgemv)(const CBLAS_LAYOUT layout, + const CBLAS_TRANSPOSE TransA, const CBLAS_INT M, const CBLAS_INT N, + const float alpha, const float *A, const CBLAS_INT lda, + const float *X, const CBLAS_INT incX, const float beta, + float *Y, const CBLAS_INT incY) { char TA; #ifdef F77_CHAR @@ -42,7 +42,7 @@ void cblas_sgemv(const CBLAS_LAYOUT layout, else if (TransA == CblasConjTrans) TA = 'C'; else { - cblas_xerbla(2, "cblas_sgemv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(2, "cblas_sgemv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; } @@ -60,7 +60,7 @@ void cblas_sgemv(const CBLAS_LAYOUT layout, else if (TransA == CblasConjTrans) TA = 'N'; else { - cblas_xerbla(2, "cblas_sgemv", "Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(2, "cblas_sgemv", "Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -71,7 +71,7 @@ void cblas_sgemv(const CBLAS_LAYOUT layout, F77_sgemv(F77_TA, &F77_N, &F77_M, &alpha, A, &F77_lda, X, &F77_incX, &beta, Y, &F77_incY); } - else cblas_xerbla(1, "cblas_sgemv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_sgemv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_sger.c b/CBLAS/src/cblas_sger.c index 4726c861d6..b456a31ad1 100644 --- a/CBLAS/src/cblas_sger.c +++ b/CBLAS/src/cblas_sger.c @@ -9,9 +9,9 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_sger(const CBLAS_LAYOUT layout, const int M, const int N, - const float alpha, const float *X, const int incX, - const float *Y, const int incY, float *A, const int lda) +void API_SUFFIX(cblas_sger)(const CBLAS_LAYOUT layout, const CBLAS_INT M, const CBLAS_INT N, + const float alpha, const float *X, const CBLAS_INT incX, + const float *Y, const CBLAS_INT incY, float *A, const CBLAS_INT lda) { #ifdef F77_INT F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY; @@ -39,7 +39,7 @@ void cblas_sger(const CBLAS_LAYOUT layout, const int M, const int N, F77_sger( &F77_N, &F77_M, &alpha, Y, &F77_incY, X, &F77_incX, A, &F77_lda); } - else cblas_xerbla(1, "cblas_sger", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_sger", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_snrm2.c b/CBLAS/src/cblas_snrm2.c index 6b015a0ce6..d1c70be8fd 100644 --- a/CBLAS/src/cblas_snrm2.c +++ b/CBLAS/src/cblas_snrm2.c @@ -9,7 +9,7 @@ */ #include "cblas.h" #include "cblas_f77.h" -float cblas_snrm2( const int N, const float *X, const int incX) +float API_SUFFIX(cblas_snrm2)( const CBLAS_INT N, const float *X, const CBLAS_INT incX) { float nrm2; #ifdef F77_INT diff --git a/CBLAS/src/cblas_srot.c b/CBLAS/src/cblas_srot.c index 6619abd943..61c4c75042 100644 --- a/CBLAS/src/cblas_srot.c +++ b/CBLAS/src/cblas_srot.c @@ -8,8 +8,8 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_srot( const int N, float *X, const int incX, float *Y, - const int incY, const float c, const float s) +void API_SUFFIX(cblas_srot)( const CBLAS_INT N, float *X, const CBLAS_INT incX, float *Y, + const CBLAS_INT incY, const float c, const float s) { #ifdef F77_INT F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; diff --git a/CBLAS/src/cblas_srotg.c b/CBLAS/src/cblas_srotg.c index 4584a29c9a..b96ed1c5c4 100644 --- a/CBLAS/src/cblas_srotg.c +++ b/CBLAS/src/cblas_srotg.c @@ -8,7 +8,7 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_srotg( float *a, float *b, float *c, float *s) +void API_SUFFIX(cblas_srotg)( float *a, float *b, float *c, float *s) { F77_srotg(a,b,c,s); } diff --git a/CBLAS/src/cblas_srotm.c b/CBLAS/src/cblas_srotm.c index 52fae4d9af..04e3c6438b 100644 --- a/CBLAS/src/cblas_srotm.c +++ b/CBLAS/src/cblas_srotm.c @@ -8,8 +8,8 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_srotm( const int N, float *X, const int incX, float *Y, - const int incY, const float *P) +void API_SUFFIX(cblas_srotm)( const CBLAS_INT N, float *X, const CBLAS_INT incX, float *Y, + const CBLAS_INT incY, const float *P) { #ifdef F77_INT F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; diff --git a/CBLAS/src/cblas_srotmg.c b/CBLAS/src/cblas_srotmg.c index 1d84054a02..6290a6207d 100644 --- a/CBLAS/src/cblas_srotmg.c +++ b/CBLAS/src/cblas_srotmg.c @@ -8,7 +8,7 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_srotmg( float *d1, float *d2, float *b1, +void API_SUFFIX(cblas_srotmg)( float *d1, float *d2, float *b1, const float b2, float *p) { F77_srotmg(d1,d2,b1,&b2,p); diff --git a/CBLAS/src/cblas_ssbmv.c b/CBLAS/src/cblas_ssbmv.c index 9a035cd920..1c85cff6ae 100644 --- a/CBLAS/src/cblas_ssbmv.c +++ b/CBLAS/src/cblas_ssbmv.c @@ -8,10 +8,10 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_ssbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, - const int N, const int K, const float alpha, const float *A, - const int lda, const float *X, const int incX, - const float beta, float *Y, const int incY) +void API_SUFFIX(cblas_ssbmv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_INT N, const CBLAS_INT K, const float alpha, const float *A, + const CBLAS_INT lda, const float *X, const CBLAS_INT incX, + const float beta, float *Y, const CBLAS_INT incY) { char UL; #ifdef F77_CHAR @@ -41,7 +41,7 @@ void cblas_ssbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'L'; else { - cblas_xerbla(2, "cblas_ssbmv","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_ssbmv","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -58,7 +58,7 @@ void cblas_ssbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_ssbmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_ssbmv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -69,7 +69,7 @@ void cblas_ssbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, F77_ssbmv(F77_UL, &F77_N, &F77_K, &alpha, A, &F77_lda, X, &F77_incX, &beta, Y, &F77_incY); } - else cblas_xerbla(1, "cblas_ssbmv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_ssbmv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_sscal.c b/CBLAS/src/cblas_sscal.c index 6c047766d8..98aecd7133 100644 --- a/CBLAS/src/cblas_sscal.c +++ b/CBLAS/src/cblas_sscal.c @@ -8,8 +8,8 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_sscal( const int N, const float alpha, float *X, - const int incX) +void API_SUFFIX(cblas_sscal)( const CBLAS_INT N, const float alpha, float *X, + const CBLAS_INT incX) { #ifdef F77_INT F77_INT F77_N=N, F77_incX=incX; diff --git a/CBLAS/src/cblas_sskewsymm.c b/CBLAS/src/cblas_sskewsymm.c new file mode 100644 index 0000000000..aa5a495c74 --- /dev/null +++ b/CBLAS/src/cblas_sskewsymm.c @@ -0,0 +1,108 @@ +/* + * + * cblas_sskewsymm.c + * This program is a C interface to sskewsymm. + * Written by Shuo Zheng + * 11/24/2025 + * + */ + +#include "cblas.h" +#include "cblas_f77.h" +void API_SUFFIX(cblas_sskewsymm)(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, + const CBLAS_UPLO Uplo, const CBLAS_INT M, const CBLAS_INT N, + const float alpha, const float *A, const CBLAS_INT lda, + const float *B, const CBLAS_INT ldb, const float beta, + float *C, const CBLAS_INT ldc) +{ + char SD, UL; +#ifdef F77_CHAR + F77_CHAR F77_SD, F77_UL; +#else + #define F77_SD &SD + #define F77_UL &UL +#endif + +#ifdef F77_INT + F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb; + F77_INT F77_ldc=ldc; +#else + #define F77_M M + #define F77_N N + #define F77_lda lda + #define F77_ldb ldb + #define F77_ldc ldc +#endif + + extern int CBLAS_CallFromC; + extern int RowMajorStrg; + RowMajorStrg = 0; + CBLAS_CallFromC = 1; + + if( layout == CblasColMajor ) + { + if( Side == CblasRight) SD='R'; + else if ( Side == CblasLeft ) SD='L'; + else + { + API_SUFFIX(cblas_xerbla)(2, "cblas_sskewsymm", + "Illegal Side setting, %d\n", Side); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + if( Uplo == CblasUpper) UL='U'; + else if ( Uplo == CblasLower ) UL='L'; + else + { + API_SUFFIX(cblas_xerbla)(3, "cblas_sskewsymm", + "Illegal Uplo setting, %d\n", Uplo); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + #ifdef F77_CHAR + F77_UL = C2F_CHAR(&UL); + F77_SD = C2F_CHAR(&SD); + #endif + + F77_sskewsymm(F77_SD, F77_UL, &F77_M, &F77_N, &alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc); + } else if (layout == CblasRowMajor) + { + RowMajorStrg = 1; + if( Side == CblasRight) SD='L'; + else if ( Side == CblasLeft ) SD='R'; + else + { + API_SUFFIX(cblas_xerbla)(2, "cblas_sskewsymm", + "Illegal Side setting, %d\n", Side); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + if( Uplo == CblasUpper) UL='L'; + else if ( Uplo == CblasLower ) UL='U'; + else + { + API_SUFFIX(cblas_xerbla)(3, "cblas_sskewsymm", + "Illegal Uplo setting, %d\n", Uplo); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + #ifdef F77_CHAR + F77_UL = C2F_CHAR(&UL); + F77_SD = C2F_CHAR(&SD); + #endif + + F77_sskewsymm(F77_SD, F77_UL, &F77_N, &F77_M, &alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc); + } else API_SUFFIX(cblas_xerbla)(1, "cblas_sskewsymm", + "Illegal layout setting, %d\n", layout); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; +} diff --git a/CBLAS/src/cblas_sskewsymv.c b/CBLAS/src/cblas_sskewsymv.c new file mode 100644 index 0000000000..265e2eca57 --- /dev/null +++ b/CBLAS/src/cblas_sskewsymv.c @@ -0,0 +1,78 @@ +/* + * + * cblas_sskewsymv.c + * This program is a C interface to sskewsymv. + * Written by Shuo Zheng + * 11/24/2025 + * + */ + +#include "cblas.h" +#include "cblas_f77.h" +void API_SUFFIX(cblas_sskewsymv)(const CBLAS_LAYOUT layout, + const CBLAS_UPLO Uplo, const CBLAS_INT N, + const float alpha, const float *A, const CBLAS_INT lda, + const float *X, const CBLAS_INT incX, const float beta, + float *Y, const CBLAS_INT incY) +{ + char UL; + float minus_alpha; +#ifdef F77_CHAR + F77_CHAR F77_UL; +#else + #define F77_UL &UL +#endif +#ifdef F77_INT + F77_INT F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY; +#else + #define F77_N N + #define F77_lda lda + #define F77_incX incX + #define F77_incY incY +#endif + extern int CBLAS_CallFromC; + extern int RowMajorStrg; + RowMajorStrg = 0; + + CBLAS_CallFromC = 1; + if (layout == CblasColMajor) + { + if (Uplo == CblasUpper) UL = 'U'; + else if (Uplo == CblasLower) UL = 'L'; + else + { + API_SUFFIX(cblas_xerbla)(2, "cblas_sskewsymv","Illegal Uplo setting, %d\n",Uplo ); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + #ifdef F77_CHAR + F77_UL = C2F_CHAR(&UL); + #endif + F77_sskewsymv(F77_UL, &F77_N, &alpha, A, &F77_lda, X, + &F77_incX, &beta, Y, &F77_incY); + } + else if (layout == CblasRowMajor) + { + RowMajorStrg = 1; + if (Uplo == CblasUpper) UL = 'L'; + else if (Uplo == CblasLower) UL = 'U'; + else + { + API_SUFFIX(cblas_xerbla)(2, "cblas_sskewsymv","Illegal Uplo setting, %d\n", Uplo); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + #ifdef F77_CHAR + F77_UL = C2F_CHAR(&UL); + #endif + minus_alpha = -alpha; + F77_sskewsymv(F77_UL, &F77_N, &minus_alpha, + A ,&F77_lda, X,&F77_incX, &beta, Y, &F77_incY); + } + else API_SUFFIX(cblas_xerbla)(1, "cblas_sskewsymv", "Illegal layout setting, %d\n", layout); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; +} diff --git a/CBLAS/src/cblas_sskewsyr2.c b/CBLAS/src/cblas_sskewsyr2.c new file mode 100644 index 0000000000..e4cd341814 --- /dev/null +++ b/CBLAS/src/cblas_sskewsyr2.c @@ -0,0 +1,78 @@ +/* + * + * cblas_sskewsyr2.c + * This program is a C interface to sskewsyr2. + * Written by Shuo Zheng + * 11/24/2025 + * + */ + +#include "cblas.h" +#include "cblas_f77.h" +void API_SUFFIX(cblas_sskewsyr2)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_INT N, const float alpha, const float *X, + const CBLAS_INT incX, const float *Y, const CBLAS_INT incY, float *A, + const CBLAS_INT lda) +{ + char UL; + float minus_alpha; +#ifdef F77_CHAR + F77_CHAR F77_UL; +#else + #define F77_UL &UL +#endif + +#ifdef F77_INT + F77_INT F77_N=N, F77_incX=incX, F77_incY=incY, F77_lda=lda; +#else + #define F77_N N + #define F77_incX incX + #define F77_incY incY + #define F77_lda lda +#endif + + extern int CBLAS_CallFromC; + extern int RowMajorStrg; + RowMajorStrg = 0; + CBLAS_CallFromC = 1; + if (layout == CblasColMajor) + { + if (Uplo == CblasLower) UL = 'L'; + else if (Uplo == CblasUpper) UL = 'U'; + else + { + API_SUFFIX(cblas_xerbla)(2, "cblas_sskewsyr2","Illegal Uplo setting, %d\n",Uplo ); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + #ifdef F77_CHAR + F77_UL = C2F_CHAR(&UL); + #endif + + F77_sskewsyr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A, + &F77_lda); + + } else if (layout == CblasRowMajor) + { + RowMajorStrg = 1; + if (Uplo == CblasLower) UL = 'U'; + else if (Uplo == CblasUpper) UL = 'L'; + else + { + API_SUFFIX(cblas_xerbla)(2, "cblas_sskewsyr2","Illegal Uplo setting, %d\n",Uplo ); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + #ifdef F77_CHAR + F77_UL = C2F_CHAR(&UL); + #endif + minus_alpha = -alpha; + F77_sskewsyr2(F77_UL, &F77_N, &minus_alpha, X, &F77_incX, Y, &F77_incY, A, + &F77_lda); + } else API_SUFFIX(cblas_xerbla)(1, "cblas_sskewsyr2", "Illegal layout setting, %d\n", layout); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; +} diff --git a/CBLAS/src/cblas_sskewsyr2k.c b/CBLAS/src/cblas_sskewsyr2k.c new file mode 100644 index 0000000000..8cf0ac3ffc --- /dev/null +++ b/CBLAS/src/cblas_sskewsyr2k.c @@ -0,0 +1,113 @@ +/* + * + * cblas_sskewsyr2k.c + * This program is a C interface to sskewsyr2k. + * Written by Shuo Zheng + * 11/24/2025 + * + */ + +#include "cblas.h" +#include "cblas_f77.h" +void API_SUFFIX(cblas_sskewsyr2k)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_TRANSPOSE Trans, const CBLAS_INT N, const CBLAS_INT K, + const float alpha, const float *A, const CBLAS_INT lda, + const float *B, const CBLAS_INT ldb, const float beta, + float *C, const CBLAS_INT ldc) +{ + char UL, TR; + float minus_alpha; +#ifdef F77_CHAR + F77_CHAR F77_TA, F77_UL; +#else + #define F77_TR &TR + #define F77_UL &UL +#endif + +#ifdef F77_INT + F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb; + F77_INT F77_ldc=ldc; +#else + #define F77_N N + #define F77_K K + #define F77_lda lda + #define F77_ldb ldb + #define F77_ldc ldc +#endif + + extern int CBLAS_CallFromC; + extern int RowMajorStrg; + RowMajorStrg = 0; + CBLAS_CallFromC = 1; + + if( layout == CblasColMajor ) + { + + if( Uplo == CblasUpper) UL='U'; + else if ( Uplo == CblasLower ) UL='L'; + else + { + API_SUFFIX(cblas_xerbla)(2, "cblas_sskewsyr2k", + "Illegal Uplo setting, %d\n", Uplo); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + if( Trans == CblasTrans) TR ='T'; + else if ( Trans == CblasConjTrans ) TR='C'; + else if ( Trans == CblasNoTrans ) TR='N'; + else + { + API_SUFFIX(cblas_xerbla)(3, "cblas_sskewsyr2k", + "Illegal Trans setting, %d\n", Trans); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + + #ifdef F77_CHAR + F77_UL = C2F_CHAR(&UL); + F77_TR = C2F_CHAR(&TR); + #endif + + F77_sskewsyr2k(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc); + } else if (layout == CblasRowMajor) + { + RowMajorStrg = 1; + if( Uplo == CblasUpper) UL='L'; + else if ( Uplo == CblasLower ) UL='U'; + else + { + API_SUFFIX(cblas_xerbla)(2, "cblas_sskewsyr2k", + "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 + { + API_SUFFIX(cblas_xerbla)(3, "cblas_sskewsyr2k", + "Illegal Trans setting, %d\n", Trans); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + #ifdef F77_CHAR + F77_UL = C2F_CHAR(&UL); + F77_TR = C2F_CHAR(&TR); + #endif + + minus_alpha = -alpha; + F77_sskewsyr2k(F77_UL, F77_TR, &F77_N, &F77_K, &minus_alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc); + } else API_SUFFIX(cblas_xerbla)(1, "cblas_sskewsyr2k", + "Illegal layout setting, %d\n", layout); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; +} diff --git a/CBLAS/src/cblas_sspmv.c b/CBLAS/src/cblas_sspmv.c index 3fddd38a42..05e37e8f52 100644 --- a/CBLAS/src/cblas_sspmv.c +++ b/CBLAS/src/cblas_sspmv.c @@ -8,11 +8,11 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_sspmv(const CBLAS_LAYOUT layout, - const CBLAS_UPLO Uplo, const int N, +void API_SUFFIX(cblas_sspmv)(const CBLAS_LAYOUT layout, + const CBLAS_UPLO Uplo, const CBLAS_INT N, const float alpha, const float *AP, - const float *X, const int incX, const float beta, - float *Y, const int incY) + const float *X, const CBLAS_INT incX, const float beta, + float *Y, const CBLAS_INT incY) { char UL; #ifdef F77_CHAR @@ -38,7 +38,7 @@ void cblas_sspmv(const CBLAS_LAYOUT layout, else if (Uplo == CblasLower) UL = 'L'; else { - cblas_xerbla(2, "cblas_sspmv","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_sspmv","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -56,7 +56,7 @@ void cblas_sspmv(const CBLAS_LAYOUT layout, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_sspmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_sspmv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -67,7 +67,7 @@ void cblas_sspmv(const CBLAS_LAYOUT layout, F77_sspmv(F77_UL, &F77_N, &alpha, AP, X,&F77_incX, &beta, Y, &F77_incY); } - else cblas_xerbla(1, "cblas_sspmv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_sspmv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; } diff --git a/CBLAS/src/cblas_sspr.c b/CBLAS/src/cblas_sspr.c index 00ac6f99a1..de4750f167 100644 --- a/CBLAS/src/cblas_sspr.c +++ b/CBLAS/src/cblas_sspr.c @@ -9,9 +9,9 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_sspr(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, - const int N, const float alpha, const float *X, - const int incX, float *Ap) +void API_SUFFIX(cblas_sspr)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_INT N, const float alpha, const float *X, + const CBLAS_INT incX, float *Ap) { char UL; #ifdef F77_CHAR @@ -38,7 +38,7 @@ void cblas_sspr(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasUpper) UL = 'U'; else { - cblas_xerbla(2, "cblas_sspr","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_sspr","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -56,7 +56,7 @@ void cblas_sspr(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasUpper) UL = 'L'; else { - cblas_xerbla(2, "cblas_sspr","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_sspr","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -65,7 +65,7 @@ void cblas_sspr(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, F77_UL = C2F_CHAR(&UL); #endif F77_sspr(F77_UL, &F77_N, &alpha, X, &F77_incX, Ap); - } else cblas_xerbla(1, "cblas_sspr", "Illegal layout setting, %d\n", layout); + } else API_SUFFIX(cblas_xerbla)(1, "cblas_sspr", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_sspr2.c b/CBLAS/src/cblas_sspr2.c index 1d9be4f5f5..1a0e4f5205 100644 --- a/CBLAS/src/cblas_sspr2.c +++ b/CBLAS/src/cblas_sspr2.c @@ -9,9 +9,9 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_sspr2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, - const int N, const float alpha, const float *X, - const int incX, const float *Y, const int incY, float *A) +void API_SUFFIX(cblas_sspr2)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_INT N, const float alpha, const float *X, + const CBLAS_INT incX, const float *Y, const CBLAS_INT incY, float *A) { char UL; #ifdef F77_CHAR @@ -38,7 +38,7 @@ void cblas_sspr2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasUpper) UL = 'U'; else { - cblas_xerbla(2, "cblas_sspr2","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_sspr2","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -56,7 +56,7 @@ void cblas_sspr2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasUpper) UL = 'L'; else { - cblas_xerbla(2, "cblas_sspr2","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_sspr2","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -65,7 +65,7 @@ void cblas_sspr2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, F77_UL = C2F_CHAR(&UL); #endif F77_sspr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A); - } else cblas_xerbla(1, "cblas_sspr2", "Illegal layout setting, %d\n", layout); + } else API_SUFFIX(cblas_xerbla)(1, "cblas_sspr2", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; } diff --git a/CBLAS/src/cblas_sswap.c b/CBLAS/src/cblas_sswap.c index 3759a0f5ca..cc5a633b09 100644 --- a/CBLAS/src/cblas_sswap.c +++ b/CBLAS/src/cblas_sswap.c @@ -8,8 +8,8 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_sswap( const int N, float *X, const int incX, float *Y, - const int incY) +void API_SUFFIX(cblas_sswap)( const CBLAS_INT N, float *X, const CBLAS_INT incX, float *Y, + const CBLAS_INT incY) { #ifdef F77_INT F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; diff --git a/CBLAS/src/cblas_ssymm.c b/CBLAS/src/cblas_ssymm.c index d194320984..6d347f5333 100644 --- a/CBLAS/src/cblas_ssymm.c +++ b/CBLAS/src/cblas_ssymm.c @@ -9,11 +9,11 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_ssymm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, - const CBLAS_UPLO Uplo, const int M, const int N, - const float alpha, const float *A, const int lda, - const float *B, const int ldb, const float beta, - float *C, const int ldc) +void API_SUFFIX(cblas_ssymm)(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, + const CBLAS_UPLO Uplo, const CBLAS_INT M, const CBLAS_INT N, + const float alpha, const float *A, const CBLAS_INT lda, + const float *B, const CBLAS_INT ldb, const float beta, + float *C, const CBLAS_INT ldc) { char SD, UL; #ifdef F77_CHAR @@ -45,7 +45,7 @@ void cblas_ssymm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Side == CblasLeft ) SD='L'; else { - cblas_xerbla(2, "cblas_ssymm", + API_SUFFIX(cblas_xerbla)(2, "cblas_ssymm", "Illegal Side setting, %d\n", Side); CBLAS_CallFromC = 0; RowMajorStrg = 0; @@ -56,7 +56,7 @@ void cblas_ssymm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Uplo == CblasLower ) UL='L'; else { - cblas_xerbla(3, "cblas_ssymm", + API_SUFFIX(cblas_xerbla)(3, "cblas_ssymm", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; @@ -76,7 +76,7 @@ void cblas_ssymm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Side == CblasLeft ) SD='R'; else { - cblas_xerbla(2, "cblas_ssymm", + API_SUFFIX(cblas_xerbla)(2, "cblas_ssymm", "Illegal Side setting, %d\n", Side); CBLAS_CallFromC = 0; RowMajorStrg = 0; @@ -87,7 +87,7 @@ void cblas_ssymm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Uplo == CblasLower ) UL='U'; else { - cblas_xerbla(3, "cblas_ssymm", + API_SUFFIX(cblas_xerbla)(3, "cblas_ssymm", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; @@ -100,7 +100,7 @@ void cblas_ssymm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, #endif F77_ssymm(F77_SD, F77_UL, &F77_N, &F77_M, &alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc); - } else cblas_xerbla(1, "cblas_ssymm", + } else API_SUFFIX(cblas_xerbla)(1, "cblas_ssymm", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; diff --git a/CBLAS/src/cblas_ssymv.c b/CBLAS/src/cblas_ssymv.c index c0dc682d87..ecd72a12fb 100644 --- a/CBLAS/src/cblas_ssymv.c +++ b/CBLAS/src/cblas_ssymv.c @@ -9,11 +9,11 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_ssymv(const CBLAS_LAYOUT layout, - const CBLAS_UPLO Uplo, const int N, - const float alpha, const float *A, const int lda, - const float *X, const int incX, const float beta, - float *Y, const int incY) +void API_SUFFIX(cblas_ssymv)(const CBLAS_LAYOUT layout, + const CBLAS_UPLO Uplo, const CBLAS_INT N, + const float alpha, const float *A, const CBLAS_INT lda, + const float *X, const CBLAS_INT incX, const float beta, + float *Y, const CBLAS_INT incY) { char UL; #ifdef F77_CHAR @@ -40,7 +40,7 @@ void cblas_ssymv(const CBLAS_LAYOUT layout, else if (Uplo == CblasLower) UL = 'L'; else { - cblas_xerbla(2, "cblas_ssymv","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_ssymv","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -58,7 +58,7 @@ void cblas_ssymv(const CBLAS_LAYOUT layout, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_ssymv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_ssymv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -69,7 +69,7 @@ void cblas_ssymv(const CBLAS_LAYOUT layout, F77_ssymv(F77_UL, &F77_N, &alpha, A ,&F77_lda, X,&F77_incX, &beta, Y, &F77_incY); } - else cblas_xerbla(1, "cblas_ssymv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_ssymv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_ssyr.c b/CBLAS/src/cblas_ssyr.c index cc66f85c8f..2311a47094 100644 --- a/CBLAS/src/cblas_ssyr.c +++ b/CBLAS/src/cblas_ssyr.c @@ -8,9 +8,9 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_ssyr(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, - const int N, const float alpha, const float *X, - const int incX, float *A, const int lda) +void API_SUFFIX(cblas_ssyr)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_INT N, const float alpha, const float *X, + const CBLAS_INT incX, float *A, const CBLAS_INT lda) { char UL; #ifdef F77_CHAR @@ -36,7 +36,7 @@ void cblas_ssyr(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasUpper) UL = 'U'; else { - cblas_xerbla(2, "cblas_ssyr","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_ssyr","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -54,7 +54,7 @@ void cblas_ssyr(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasUpper) UL = 'L'; else { - cblas_xerbla(2, "cblas_ssyr","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_ssyr","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -63,7 +63,7 @@ void cblas_ssyr(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, F77_UL = C2F_CHAR(&UL); #endif F77_ssyr(F77_UL, &F77_N, &alpha, X, &F77_incX, A, &F77_lda); - } else cblas_xerbla(1, "cblas_ssyr", "Illegal layout setting, %d\n", layout); + } else API_SUFFIX(cblas_xerbla)(1, "cblas_ssyr", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_ssyr2.c b/CBLAS/src/cblas_ssyr2.c index 0d314eb8d1..facf1bed87 100644 --- a/CBLAS/src/cblas_ssyr2.c +++ b/CBLAS/src/cblas_ssyr2.c @@ -9,10 +9,10 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_ssyr2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, - const int N, const float alpha, const float *X, - const int incX, const float *Y, const int incY, float *A, - const int lda) +void API_SUFFIX(cblas_ssyr2)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_INT N, const float alpha, const float *X, + const CBLAS_INT incX, const float *Y, const CBLAS_INT incY, float *A, + const CBLAS_INT lda) { char UL; #ifdef F77_CHAR @@ -40,7 +40,7 @@ void cblas_ssyr2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasUpper) UL = 'U'; else { - cblas_xerbla(2, "cblas_ssyr2","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_ssyr2","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -59,7 +59,7 @@ void cblas_ssyr2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasUpper) UL = 'L'; else { - cblas_xerbla(2, "cblas_ssyr2","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_ssyr2","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -69,7 +69,7 @@ void cblas_ssyr2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, #endif F77_ssyr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A, &F77_lda); - } else cblas_xerbla(1, "cblas_ssyr2", "Illegal layout setting, %d\n", layout); + } else API_SUFFIX(cblas_xerbla)(1, "cblas_ssyr2", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_ssyr2k.c b/CBLAS/src/cblas_ssyr2k.c index e5e9575314..5b5690ba79 100644 --- a/CBLAS/src/cblas_ssyr2k.c +++ b/CBLAS/src/cblas_ssyr2k.c @@ -9,11 +9,11 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_ssyr2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, - const CBLAS_TRANSPOSE Trans, const int N, const int K, - const float alpha, const float *A, const int lda, - const float *B, const int ldb, const float beta, - float *C, const int ldc) +void API_SUFFIX(cblas_ssyr2k)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_TRANSPOSE Trans, const CBLAS_INT N, const CBLAS_INT K, + const float alpha, const float *A, const CBLAS_INT lda, + const float *B, const CBLAS_INT ldb, const float beta, + float *C, const CBLAS_INT ldc) { char UL, TR; #ifdef F77_CHAR @@ -46,7 +46,7 @@ void cblas_ssyr2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='L'; else { - cblas_xerbla(2, "cblas_ssyr2k", + API_SUFFIX(cblas_xerbla)(2, "cblas_ssyr2k", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; @@ -58,7 +58,7 @@ void cblas_ssyr2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Trans == CblasNoTrans ) TR='N'; else { - cblas_xerbla(3, "cblas_ssyr2k", + API_SUFFIX(cblas_xerbla)(3, "cblas_ssyr2k", "Illegal Trans setting, %d\n", Trans); CBLAS_CallFromC = 0; RowMajorStrg = 0; @@ -79,7 +79,7 @@ void cblas_ssyr2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='U'; else { - cblas_xerbla(3, "cblas_ssyr2k", + API_SUFFIX(cblas_xerbla)(2, "cblas_ssyr2k", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; @@ -90,7 +90,7 @@ void cblas_ssyr2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Trans == CblasNoTrans ) TR='T'; else { - cblas_xerbla(3, "cblas_ssyr2k", + API_SUFFIX(cblas_xerbla)(3, "cblas_ssyr2k", "Illegal Trans setting, %d\n", Trans); CBLAS_CallFromC = 0; RowMajorStrg = 0; @@ -103,7 +103,7 @@ void cblas_ssyr2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, #endif F77_ssyr2k(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc); - } else cblas_xerbla(1, "cblas_ssyr2k", + } else API_SUFFIX(cblas_xerbla)(1, "cblas_ssyr2k", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; diff --git a/CBLAS/src/cblas_ssyrk.c b/CBLAS/src/cblas_ssyrk.c index 81f9799ccf..f9f59241cb 100644 --- a/CBLAS/src/cblas_ssyrk.c +++ b/CBLAS/src/cblas_ssyrk.c @@ -9,10 +9,10 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_ssyrk(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, - const CBLAS_TRANSPOSE Trans, const int N, const int K, - const float alpha, const float *A, const int lda, - const float beta, float *C, const int ldc) +void API_SUFFIX(cblas_ssyrk)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_TRANSPOSE Trans, const CBLAS_INT N, const CBLAS_INT K, + const float alpha, const float *A, const CBLAS_INT lda, + const float beta, float *C, const CBLAS_INT ldc) { char UL, TR; #ifdef F77_CHAR @@ -44,7 +44,7 @@ void cblas_ssyrk(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='L'; else { - cblas_xerbla(2, "cblas_ssyrk", + API_SUFFIX(cblas_xerbla)(2, "cblas_ssyrk", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; @@ -56,7 +56,7 @@ void cblas_ssyrk(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Trans == CblasNoTrans ) TR='N'; else { - cblas_xerbla(3, "cblas_ssyrk", + API_SUFFIX(cblas_xerbla)(3, "cblas_ssyrk", "Illegal Trans setting, %d\n", Trans); CBLAS_CallFromC = 0; RowMajorStrg = 0; @@ -77,7 +77,7 @@ void cblas_ssyrk(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='U'; else { - cblas_xerbla(3, "cblas_ssyrk", + API_SUFFIX(cblas_xerbla)(2, "cblas_ssyrk", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; @@ -88,7 +88,7 @@ void cblas_ssyrk(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Trans == CblasNoTrans ) TR='T'; else { - cblas_xerbla(3, "cblas_ssyrk", + API_SUFFIX(cblas_xerbla)(3, "cblas_ssyrk", "Illegal Trans setting, %d\n", Trans); CBLAS_CallFromC = 0; RowMajorStrg = 0; @@ -101,7 +101,7 @@ void cblas_ssyrk(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, #endif F77_ssyrk(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda, &beta, C, &F77_ldc); - } else cblas_xerbla(1, "cblas_ssyrk", + } else API_SUFFIX(cblas_xerbla)(1, "cblas_ssyrk", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; diff --git a/CBLAS/src/cblas_stbmv.c b/CBLAS/src/cblas_stbmv.c index bdaaf515d5..89d9bd2d99 100644 --- a/CBLAS/src/cblas_stbmv.c +++ b/CBLAS/src/cblas_stbmv.c @@ -7,10 +7,10 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_stbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, +void API_SUFFIX(cblas_stbmv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, const CBLAS_DIAG Diag, - const int N, const int K, const float *A, const int lda, - float *X, const int incX) + const CBLAS_INT N, const CBLAS_INT K, const float *A, const CBLAS_INT lda, + float *X, const CBLAS_INT incX) { char TA; char UL; @@ -41,7 +41,7 @@ void cblas_stbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'L'; else { - cblas_xerbla(2, "cblas_stbmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_stbmv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -51,7 +51,7 @@ void cblas_stbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'C'; else { - cblas_xerbla(3, "cblas_stbmv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_stbmv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -60,7 +60,7 @@ void cblas_stbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_stbmv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_stbmv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -80,7 +80,7 @@ void cblas_stbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_stbmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_stbmv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -91,7 +91,7 @@ void cblas_stbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'N'; else { - cblas_xerbla(3, "cblas_stbmv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_stbmv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -101,7 +101,7 @@ void cblas_stbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - 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; @@ -115,7 +115,7 @@ void cblas_stbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, F77_stbmv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X, &F77_incX); } - else cblas_xerbla(1, "cblas_stbmv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_stbmv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_stbsv.c b/CBLAS/src/cblas_stbsv.c index 6317188c2e..c6ef05f8e5 100644 --- a/CBLAS/src/cblas_stbsv.c +++ b/CBLAS/src/cblas_stbsv.c @@ -7,10 +7,10 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_stbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, +void API_SUFFIX(cblas_stbsv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, const CBLAS_DIAG Diag, - const int N, const int K, const float *A, const int lda, - float *X, const int incX) + const CBLAS_INT N, const CBLAS_INT K, const float *A, const CBLAS_INT lda, + float *X, const CBLAS_INT incX) { char TA; char UL; @@ -41,7 +41,7 @@ void cblas_stbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'L'; else { - cblas_xerbla(2, "cblas_stbsv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_stbsv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -51,7 +51,7 @@ void cblas_stbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'C'; else { - cblas_xerbla(3, "cblas_stbsv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_stbsv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -60,7 +60,7 @@ void cblas_stbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_stbsv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_stbsv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -80,7 +80,7 @@ void cblas_stbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_stbsv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_stbsv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -91,7 +91,7 @@ void cblas_stbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'N'; else { - cblas_xerbla(3, "cblas_stbsv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_stbsv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -101,7 +101,7 @@ void cblas_stbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_stbsv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_stbsv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -115,7 +115,7 @@ void cblas_stbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, F77_stbsv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X, &F77_incX); } - else cblas_xerbla(1, "cblas_stbsv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_stbsv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_stpmv.c b/CBLAS/src/cblas_stpmv.c index 90a0ab7dbd..bcc5f215d4 100644 --- a/CBLAS/src/cblas_stpmv.c +++ b/CBLAS/src/cblas_stpmv.c @@ -8,9 +8,9 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_stpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, +void API_SUFFIX(cblas_stpmv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, const CBLAS_DIAG Diag, - const int N, const float *Ap, float *X, const int incX) + const CBLAS_INT N, const float *Ap, float *X, const CBLAS_INT incX) { char TA; char UL; @@ -39,7 +39,7 @@ void cblas_stpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'L'; else { - cblas_xerbla(2, "cblas_stpmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_stpmv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -49,7 +49,7 @@ void cblas_stpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'C'; else { - cblas_xerbla(3, "cblas_stpmv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_stpmv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -58,7 +58,7 @@ void cblas_stpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_stpmv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_stpmv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -77,7 +77,7 @@ void cblas_stpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_stpmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_stpmv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -88,7 +88,7 @@ void cblas_stpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'N'; else { - cblas_xerbla(3, "cblas_stpmv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_stpmv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -98,7 +98,7 @@ void cblas_stpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_stpmv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_stpmv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -111,7 +111,7 @@ void cblas_stpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, F77_stpmv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X,&F77_incX); } - else cblas_xerbla(1, "cblas_stpmv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_stpmv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_stpsv.c b/CBLAS/src/cblas_stpsv.c index 21b5be6775..c729fdbb2f 100644 --- a/CBLAS/src/cblas_stpsv.c +++ b/CBLAS/src/cblas_stpsv.c @@ -7,9 +7,9 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_stpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, +void API_SUFFIX(cblas_stpsv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, const CBLAS_DIAG Diag, - const int N, const float *Ap, float *X, const int incX) + const CBLAS_INT N, const float *Ap, float *X, const CBLAS_INT incX) { char TA; char UL; @@ -38,7 +38,7 @@ void cblas_stpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'L'; else { - cblas_xerbla(2, "cblas_stpsv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_stpsv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -48,7 +48,7 @@ void cblas_stpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'C'; else { - cblas_xerbla(3, "cblas_stpsv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_stpsv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -57,7 +57,7 @@ void cblas_stpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_stpsv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_stpsv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -76,7 +76,7 @@ void cblas_stpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_stpsv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_stpsv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -87,7 +87,7 @@ void cblas_stpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'N'; else { - cblas_xerbla(3, "cblas_stpsv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_stpsv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -97,7 +97,7 @@ void cblas_stpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_stpsv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_stpsv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -111,7 +111,7 @@ void cblas_stpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, F77_stpsv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X,&F77_incX); } - else cblas_xerbla(1, "cblas_stpsv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_stpsv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_strmm.c b/CBLAS/src/cblas_strmm.c index e42acfcc8d..49133e5c4e 100644 --- a/CBLAS/src/cblas_strmm.c +++ b/CBLAS/src/cblas_strmm.c @@ -9,11 +9,11 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_strmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, +void API_SUFFIX(cblas_strmm)(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, - const CBLAS_DIAG Diag, const int M, const int N, - const float alpha, const float *A, const int lda, - float *B, const int ldb) + const CBLAS_DIAG Diag, const CBLAS_INT M, const CBLAS_INT N, + const float alpha, const float *A, const CBLAS_INT lda, + float *B, const CBLAS_INT ldb) { char UL, TA, SD, DI; #ifdef F77_CHAR @@ -45,7 +45,7 @@ void cblas_strmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Side == CblasLeft ) SD='L'; else { - cblas_xerbla(2, "cblas_strmm","Illegal Side setting, %d\n", Side); + API_SUFFIX(cblas_xerbla)(2, "cblas_strmm","Illegal Side setting, %d\n", Side); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -54,7 +54,7 @@ void cblas_strmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Uplo == CblasLower ) UL='L'; else { - cblas_xerbla(3, "cblas_strmm","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(3, "cblas_strmm","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -65,7 +65,7 @@ void cblas_strmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( TransA == CblasNoTrans ) TA='N'; else { - cblas_xerbla(4, "cblas_strmm","Illegal Trans setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(4, "cblas_strmm","Illegal Trans setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -75,7 +75,7 @@ void cblas_strmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Diag == CblasNonUnit ) DI='N'; else { - cblas_xerbla(5, "cblas_strmm", "Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(5, "cblas_strmm", "Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -96,7 +96,7 @@ void cblas_strmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Side == CblasLeft ) SD='R'; else { - cblas_xerbla(2, "cblas_strmm","Illegal Side setting, %d\n", Side); + API_SUFFIX(cblas_xerbla)(2, "cblas_strmm","Illegal Side setting, %d\n", Side); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -106,7 +106,7 @@ void cblas_strmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Uplo == CblasLower ) UL='U'; else { - cblas_xerbla(3, "cblas_strmm", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(3, "cblas_strmm", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -117,7 +117,7 @@ void cblas_strmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( TransA == CblasNoTrans ) TA='N'; else { - cblas_xerbla(4, "cblas_strmm", "Illegal Trans setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(4, "cblas_strmm", "Illegal Trans setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -127,7 +127,7 @@ void cblas_strmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Diag == CblasNonUnit ) DI='N'; else { - cblas_xerbla(5, "cblas_strmm","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(5, "cblas_strmm","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -141,7 +141,7 @@ void cblas_strmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, F77_strmm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, &alpha, A, &F77_lda, B, &F77_ldb); } - else cblas_xerbla(1, "cblas_strmm", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_strmm", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_strmv.c b/CBLAS/src/cblas_strmv.c index 90e3cd6f8f..bd7c14d3ad 100644 --- a/CBLAS/src/cblas_strmv.c +++ b/CBLAS/src/cblas_strmv.c @@ -8,10 +8,10 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_strmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, +void API_SUFFIX(cblas_strmv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, const CBLAS_DIAG Diag, - const int N, const float *A, const int lda, - float *X, const int incX) + const CBLAS_INT N, const float *A, const CBLAS_INT lda, + float *X, const CBLAS_INT incX) { char TA; @@ -42,7 +42,7 @@ void cblas_strmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'L'; else { - cblas_xerbla(2, "cblas_strmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_strmv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -52,7 +52,7 @@ void cblas_strmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'C'; else { - cblas_xerbla(3, "cblas_strmv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_strmv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -61,7 +61,7 @@ void cblas_strmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_strmv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_strmv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -81,7 +81,7 @@ void cblas_strmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_strmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_strmv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -92,7 +92,7 @@ void cblas_strmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'N'; else { - cblas_xerbla(3, "cblas_strmv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_strmv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -102,7 +102,7 @@ void cblas_strmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_strmv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_strmv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -115,7 +115,7 @@ void cblas_strmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, F77_strmv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X, &F77_incX); } - else cblas_xerbla(1, "cblas_strmv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_strmv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_strsm.c b/CBLAS/src/cblas_strsm.c index 8276a97280..e883be1dfb 100644 --- a/CBLAS/src/cblas_strsm.c +++ b/CBLAS/src/cblas_strsm.c @@ -9,11 +9,11 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_strsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, +void API_SUFFIX(cblas_strsm)(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, - const CBLAS_DIAG Diag, const int M, const int N, - const float alpha, const float *A, const int lda, - float *B, const int ldb) + const CBLAS_DIAG Diag, const CBLAS_INT M, const CBLAS_INT N, + const float alpha, const float *A, const CBLAS_INT lda, + float *B, const CBLAS_INT ldb) { char UL, TA, SD, DI; @@ -46,7 +46,7 @@ void cblas_strsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Side == CblasLeft ) SD='L'; else { - cblas_xerbla(2, "cblas_strsm", "Illegal Side setting, %d\n", Side); + API_SUFFIX(cblas_xerbla)(2, "cblas_strsm", "Illegal Side setting, %d\n", Side); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -55,7 +55,7 @@ void cblas_strsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Uplo == CblasLower ) UL='L'; else { - cblas_xerbla(3, "cblas_strsm", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(3, "cblas_strsm", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -65,7 +65,7 @@ void cblas_strsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( TransA == CblasNoTrans ) TA='N'; else { - cblas_xerbla(4, "cblas_strsm", "Illegal Trans setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(4, "cblas_strsm", "Illegal Trans setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -74,7 +74,7 @@ void cblas_strsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Diag == CblasNonUnit ) DI='N'; else { - cblas_xerbla(5, "cblas_strsm", "Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(5, "cblas_strsm", "Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -94,7 +94,7 @@ void cblas_strsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Side == CblasLeft ) SD='R'; else { - cblas_xerbla(2, "cblas_strsm", "Illegal Side setting, %d\n", Side); + API_SUFFIX(cblas_xerbla)(2, "cblas_strsm", "Illegal Side setting, %d\n", Side); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -103,7 +103,7 @@ void cblas_strsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Uplo == CblasLower ) UL='U'; else { - cblas_xerbla(3, "cblas_strsm", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(3, "cblas_strsm", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -113,7 +113,7 @@ void cblas_strsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( TransA == CblasNoTrans ) TA='N'; else { - cblas_xerbla(4, "cblas_strsm", "Illegal Trans setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(4, "cblas_strsm", "Illegal Trans setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -122,7 +122,7 @@ void cblas_strsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Diag == CblasNonUnit ) DI='N'; else { - cblas_xerbla(5, "cblas_strsm", "Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(5, "cblas_strsm", "Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -136,7 +136,7 @@ void cblas_strsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, F77_strsm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, &alpha, A, &F77_lda, B, &F77_ldb); } - else cblas_xerbla(1, "cblas_strsm", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_strsm", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_strsv.c b/CBLAS/src/cblas_strsv.c index dcf606dd65..a98c692dfd 100644 --- a/CBLAS/src/cblas_strsv.c +++ b/CBLAS/src/cblas_strsv.c @@ -7,10 +7,10 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_strsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, +void API_SUFFIX(cblas_strsv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, const CBLAS_DIAG Diag, - const int N, const float *A, const int lda, float *X, - const int incX) + const CBLAS_INT N, const float *A, const CBLAS_INT lda, float *X, + const CBLAS_INT incX) { char TA; @@ -41,7 +41,7 @@ void cblas_strsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'L'; else { - cblas_xerbla(2, "cblas_strsv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_strsv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -51,7 +51,7 @@ void cblas_strsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'C'; else { - cblas_xerbla(3, "cblas_strsv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_strsv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -60,7 +60,7 @@ void cblas_strsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_strsv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_strsv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -80,7 +80,7 @@ void cblas_strsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_strsv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_strsv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -91,7 +91,7 @@ void cblas_strsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'N'; else { - cblas_xerbla(3, "cblas_strsv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_strsv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -101,7 +101,7 @@ void cblas_strsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_strsv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_strsv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -114,7 +114,7 @@ void cblas_strsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, F77_strsv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X, &F77_incX); } - else cblas_xerbla(1, "cblas_strsv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_strsv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_xerbla.c b/CBLAS/src/cblas_xerbla.c index 00ca9ccfe5..a4ceae3b98 100644 --- a/CBLAS/src/cblas_xerbla.c +++ b/CBLAS/src/cblas_xerbla.c @@ -1,68 +1,45 @@ +#include #include #include -#include -#include + #include "cblas.h" #include "cblas_f77.h" +#include "cblas_xerbla_internal.h" -void cblas_xerbla(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 %d 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_zaxpby.c b/CBLAS/src/cblas_zaxpby.c new file mode 100644 index 0000000000..3aebecac8b --- /dev/null +++ b/CBLAS/src/cblas_zaxpby.c @@ -0,0 +1,22 @@ +/* + * cblas_zaxpby.c + * + * The program is a C interface to zaxpby. + * + * Written by Martin Koehler, 08/26/2024 + * + */ +#include "cblas.h" +#include "cblas_f77.h" +void API_SUFFIX(cblas_zaxpby)( const CBLAS_INT N, const void *alpha, const void *X, + const CBLAS_INT incX, const void *beta, void *Y, const CBLAS_INT incY) +{ +#ifdef F77_INT + F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; +#else + #define F77_N N + #define F77_incX incX + #define F77_incY incY +#endif + F77_zaxpby( &F77_N, alpha, X, &F77_incX, beta, Y, &F77_incY); +} diff --git a/CBLAS/src/cblas_zaxpy.c b/CBLAS/src/cblas_zaxpy.c index a874ad7169..0612cb3fbc 100644 --- a/CBLAS/src/cblas_zaxpy.c +++ b/CBLAS/src/cblas_zaxpy.c @@ -8,8 +8,8 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_zaxpy( const int N, const void *alpha, const void *X, - const int incX, void *Y, const int incY) +void API_SUFFIX(cblas_zaxpy)( const CBLAS_INT N, const void *alpha, const void *X, + const CBLAS_INT incX, void *Y, const CBLAS_INT incY) { #ifdef F77_INT F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; diff --git a/CBLAS/src/cblas_zcopy.c b/CBLAS/src/cblas_zcopy.c index 78ee45131f..b02d509802 100644 --- a/CBLAS/src/cblas_zcopy.c +++ b/CBLAS/src/cblas_zcopy.c @@ -8,8 +8,8 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_zcopy( const int N, const void *X, - const int incX, void *Y, const int incY) +void API_SUFFIX(cblas_zcopy)( const CBLAS_INT N, const void *X, + const CBLAS_INT incX, void *Y, const CBLAS_INT incY) { #ifdef F77_INT F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; diff --git a/CBLAS/src/cblas_zdotc_sub.c b/CBLAS/src/cblas_zdotc_sub.c index d88a5d0327..45d87bbf64 100644 --- a/CBLAS/src/cblas_zdotc_sub.c +++ b/CBLAS/src/cblas_zdotc_sub.c @@ -9,8 +9,8 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_zdotc_sub( const int N, const void *X, const int incX, - const void *Y, const int incY, void *dotc) +void API_SUFFIX(cblas_zdotc_sub)( const CBLAS_INT N, const void *X, const CBLAS_INT incX, + const void *Y, const CBLAS_INT incY, void *dotc) { #ifdef F77_INT F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; diff --git a/CBLAS/src/cblas_zdotu_sub.c b/CBLAS/src/cblas_zdotu_sub.c index 1d05c08261..d6766e64bd 100644 --- a/CBLAS/src/cblas_zdotu_sub.c +++ b/CBLAS/src/cblas_zdotu_sub.c @@ -9,8 +9,8 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_zdotu_sub( const int N, const void *X, const int incX, - const void *Y, const int incY, void *dotu) +void API_SUFFIX(cblas_zdotu_sub)( const CBLAS_INT N, const void *X, const CBLAS_INT incX, + const void *Y, const CBLAS_INT incY, void *dotu) { #ifdef F77_INT F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; diff --git a/CBLAS/src/cblas_zdrot.c b/CBLAS/src/cblas_zdrot.c new file mode 100644 index 0000000000..d208a3034e --- /dev/null +++ b/CBLAS/src/cblas_zdrot.c @@ -0,0 +1,21 @@ +/* + * cblas_zdrot.c + * + * The program is a C interface to zdrot. + * + */ +#include "cblas.h" +#include "cblas_f77.h" +void API_SUFFIX(cblas_zdrot)(const CBLAS_INT N, void *X, const CBLAS_INT incX, + void *Y, const CBLAS_INT incY, const double c, const double s) +{ +#ifdef F77_INT + F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; +#else + #define F77_N N + #define F77_incX incX + #define F77_incY incY +#endif + F77_zdrot(&F77_N, X, &F77_incX, Y, &F77_incY, &c, &s); + return; +} diff --git a/CBLAS/src/cblas_zdscal.c b/CBLAS/src/cblas_zdscal.c index bd65c48a12..0bebcdfd9e 100644 --- a/CBLAS/src/cblas_zdscal.c +++ b/CBLAS/src/cblas_zdscal.c @@ -8,8 +8,8 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_zdscal( const int N, const double alpha, void *X, - const int incX) +void API_SUFFIX(cblas_zdscal)( const CBLAS_INT N, const double alpha, void *X, + const CBLAS_INT incX) { #ifdef F77_INT F77_INT F77_N=N, F77_incX=incX; diff --git a/CBLAS/src/cblas_zgbmv.c b/CBLAS/src/cblas_zgbmv.c index 757ea226e5..6efd9be78c 100644 --- a/CBLAS/src/cblas_zgbmv.c +++ b/CBLAS/src/cblas_zgbmv.c @@ -7,14 +7,15 @@ */ #include #include +#include #include "cblas.h" #include "cblas_f77.h" -void cblas_zgbmv(const CBLAS_LAYOUT layout, - const CBLAS_TRANSPOSE TransA, const int M, const int N, - const int KL, const int KU, - const void *alpha, const void *A, const int lda, - const void *X, const int incX, const void *beta, - void *Y, const int incY) +void API_SUFFIX(cblas_zgbmv)(const CBLAS_LAYOUT layout, + const CBLAS_TRANSPOSE TransA, const CBLAS_INT M, const CBLAS_INT N, + const CBLAS_INT KL, const CBLAS_INT KU, + const void *alpha, const void *A, const CBLAS_INT lda, + const void *X, const CBLAS_INT incX, const void *beta, + void *Y, const CBLAS_INT incY) { char TA; #ifdef F77_CHAR @@ -26,6 +27,7 @@ void cblas_zgbmv(const CBLAS_LAYOUT layout, F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY; F77_INT F77_KL=KL,F77_KU=KU; #else + CBLAS_INT incx = incX; #define F77_M M #define F77_N N #define F77_lda lda @@ -34,15 +36,18 @@ void cblas_zgbmv(const CBLAS_LAYOUT layout, #define F77_incX incx #define F77_incY incY #endif - int n, i=0, incx=incX; - const double *xx= (double *)X, *alp= (double *)alpha, *bet = (double *)beta; + CBLAS_INT n, i=0; + const double *xx= (const double *)X, *alp= (const double *)alpha, *bet = (const double *)beta; double ALPHA[2],BETA[2]; - int tincY, tincx; - double *x=(double *)X, *y=(double *)Y, *st=0, *tx; + CBLAS_INT tincY, tincx; + double *x, *y, *st=0, *tx; extern int CBLAS_CallFromC; extern int RowMajorStrg; RowMajorStrg = 0; + memcpy(&x,&X,sizeof(double*)); + memcpy(&y,&Y,sizeof(double*)); + CBLAS_CallFromC = 1; if (layout == CblasColMajor) { @@ -51,7 +56,7 @@ void cblas_zgbmv(const CBLAS_LAYOUT layout, else if (TransA == CblasConjTrans) TA = 'C'; else { - cblas_xerbla(2, "cblas_zgbmv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(2, "cblas_zgbmv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -125,13 +130,14 @@ void cblas_zgbmv(const CBLAS_LAYOUT layout, y -= n; } } - else x = (double *) X; + else + memcpy(&x,&X,sizeof(double*)); } else { - cblas_xerbla(2, "cblas_zgbmv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(2, "cblas_zgbmv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -159,7 +165,7 @@ void cblas_zgbmv(const CBLAS_LAYOUT layout, } } } - else cblas_xerbla(1, "cblas_zgbmv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_zgbmv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_zgemm.c b/CBLAS/src/cblas_zgemm.c index 7d2dcd446d..9b3b66e568 100644 --- a/CBLAS/src/cblas_zgemm.c +++ b/CBLAS/src/cblas_zgemm.c @@ -9,11 +9,11 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_zgemm(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA, - const CBLAS_TRANSPOSE TransB, const int M, const int N, - const int K, const void *alpha, const void *A, - const int lda, const void *B, const int ldb, - const void *beta, void *C, const int ldc) +void API_SUFFIX(cblas_zgemm)(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA, + const CBLAS_TRANSPOSE TransB, const CBLAS_INT M, const CBLAS_INT N, + const CBLAS_INT K, const void *alpha, const void *A, + const CBLAS_INT lda, const void *B, const CBLAS_INT ldb, + const void *beta, void *C, const CBLAS_INT ldc) { char TA, TB; #ifdef F77_CHAR @@ -47,7 +47,7 @@ void cblas_zgemm(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA, else if ( TransA == CblasNoTrans ) TA='N'; else { - cblas_xerbla(2, "cblas_zgemm","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(2, "cblas_zgemm","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -58,7 +58,7 @@ void cblas_zgemm(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA, else if ( TransB == CblasNoTrans ) TB='N'; else { - cblas_xerbla(3, "cblas_zgemm","Illegal TransB setting, %d\n", TransB); + API_SUFFIX(cblas_xerbla)(3, "cblas_zgemm","Illegal TransB setting, %d\n", TransB); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -79,7 +79,7 @@ void cblas_zgemm(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA, else if ( TransA == CblasNoTrans ) TB='N'; else { - cblas_xerbla(2, "cblas_zgemm","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(2, "cblas_zgemm","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -89,7 +89,7 @@ void cblas_zgemm(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA, else if ( TransB == CblasNoTrans ) TA='N'; else { - cblas_xerbla(2, "cblas_zgemm","Illegal TransB setting, %d\n", TransB); + API_SUFFIX(cblas_xerbla)(3, "cblas_zgemm","Illegal TransB setting, %d\n", TransB); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -102,7 +102,7 @@ void cblas_zgemm(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA, F77_zgemm(F77_TA, F77_TB, &F77_N, &F77_M, &F77_K, alpha, B, &F77_ldb, A, &F77_lda, beta, C, &F77_ldc); } - else cblas_xerbla(1, "cblas_zgemm", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_zgemm", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_zgemmtr.c b/CBLAS/src/cblas_zgemmtr.c new file mode 100644 index 0000000000..5fb7ff9f04 --- /dev/null +++ b/CBLAS/src/cblas_zgemmtr.c @@ -0,0 +1,135 @@ +/* + * + * cblas_zgemmtr.c + * This program is a C interface to zgemmtr. + * Written by Martin Koehler, MPI Magdeburg + * 06/24/2024 + * + */ + +#include "cblas.h" +#include "cblas_f77.h" +void API_SUFFIX(cblas_zgemmtr)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, + const CBLAS_TRANSPOSE TransB, const CBLAS_INT N, + const CBLAS_INT K, const void *alpha, const void *A, + const CBLAS_INT lda, const void *B, const CBLAS_INT ldb, + const void *beta, void *C, const CBLAS_INT ldc) +{ + char TA, TB, UL; +#ifdef F77_CHAR + F77_CHAR F77_TA, F77_TB, F77_UL; +#else +#define F77_TA &TA +#define F77_TB &TB +#define F77_UL &UL +#endif + +#ifdef F77_INT + F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb; + F77_INT F77_ldc=ldc; +#else +#define F77_N N +#define F77_K K +#define F77_lda lda +#define F77_ldb ldb +#define F77_ldc ldc +#endif + + extern int CBLAS_CallFromC; + extern int RowMajorStrg; + RowMajorStrg = 0; + CBLAS_CallFromC = 1; + + + if( layout == CblasColMajor ) + { + if ( Uplo == CblasUpper ) UL = 'U'; + else if (Uplo == CblasLower) UL= 'L'; + else { + API_SUFFIX(cblas_xerbla)(2, "cblas_zgemmtr", "Illegal Uplo setting, %d\n", Uplo); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + + if(TransA == CblasTrans) TA='T'; + else if ( TransA == CblasConjTrans ) TA='C'; + else if ( TransA == CblasNoTrans ) TA='N'; + else + { + API_SUFFIX(cblas_xerbla)(3, "cblas_zgemmtr","Illegal TransA setting, %d\n", TransA); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + if(TransB == CblasTrans) TB='T'; + else if ( TransB == CblasConjTrans ) TB='C'; + else if ( TransB == CblasNoTrans ) TB='N'; + else + { + API_SUFFIX(cblas_xerbla)(4, "cblas_zgemmtr","Illegal TransB setting, %d\n", TransB); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + +#ifdef F77_CHAR + F77_TA = C2F_CHAR(&TA); + F77_TB = C2F_CHAR(&TB); + F77_UL = C2F_CHAR(&UL); +#endif + + F77_zgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, alpha, A, + &F77_lda, B, &F77_ldb, beta, C, &F77_ldc); + } + else if (layout == CblasRowMajor) + { + RowMajorStrg = 1; + + if ( Uplo == CblasUpper ) UL = 'L'; + else if (Uplo == CblasLower) UL= 'U'; + else { + API_SUFFIX(cblas_xerbla)(2, "cblas_zgemmtr", "Illegal Uplo setting, %d\n", Uplo); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + if(TransA == CblasTrans) TB='T'; + else if ( TransA == CblasConjTrans ) TB='C'; + else if ( TransA == CblasNoTrans ) TB='N'; + else + { + API_SUFFIX(cblas_xerbla)(3, "cblas_zgemmtr", "Illegal TransA setting, %d\n", TransA); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + if(TransB == CblasTrans) TA='T'; + else if ( TransB == CblasConjTrans ) TA='C'; + else if ( TransB == CblasNoTrans ) TA='N'; + else + { + API_SUFFIX(cblas_xerbla)(4, "cblas_zgemmtr", "Illegal TransB setting, %d\n", TransB); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } +#ifdef F77_CHAR + F77_TA = C2F_CHAR(&TA); + F77_TB = C2F_CHAR(&TB); + F77_UL = C2F_CHAR(&UL); + +#endif + + F77_zgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, alpha, B, + &F77_ldb, A, &F77_lda, beta, C, &F77_ldc); + } + + else API_SUFFIX(cblas_xerbla)(1, "cblas_zgemmtr", "Illegal layout setting, %d\n", layout); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; +} diff --git a/CBLAS/src/cblas_zgemv.c b/CBLAS/src/cblas_zgemv.c index 3516b27eff..930f4f9cb4 100644 --- a/CBLAS/src/cblas_zgemv.c +++ b/CBLAS/src/cblas_zgemv.c @@ -7,13 +7,14 @@ */ #include #include +#include #include "cblas.h" #include "cblas_f77.h" -void cblas_zgemv(const CBLAS_LAYOUT layout, - const CBLAS_TRANSPOSE TransA, const int M, const int N, - const void *alpha, const void *A, const int lda, - const void *X, const int incX, const void *beta, - void *Y, const int incY) +void API_SUFFIX(cblas_zgemv)(const CBLAS_LAYOUT layout, + const CBLAS_TRANSPOSE TransA, const CBLAS_INT M, const CBLAS_INT N, + const void *alpha, const void *A, const CBLAS_INT lda, + const void *X, const CBLAS_INT incX, const void *beta, + void *Y, const CBLAS_INT incY) { char TA; #ifdef F77_CHAR @@ -24,6 +25,7 @@ void cblas_zgemv(const CBLAS_LAYOUT layout, #ifdef F77_INT F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY; #else + CBLAS_INT incx = incX; #define F77_M M #define F77_N N #define F77_lda lda @@ -31,15 +33,18 @@ void cblas_zgemv(const CBLAS_LAYOUT layout, #define F77_incY incY #endif - int n, i=0, incx=incX; - const double *xx= (double *)X, *alp= (double *)alpha, *bet = (double *)beta; + CBLAS_INT n, i=0; + const double *xx= (const double *)X, *alp= (const double *)alpha, *bet = (const double *)beta; double ALPHA[2],BETA[2]; - int tincY, tincx; - double *x=(double *)X, *y=(double *)Y, *st=0, *tx; + CBLAS_INT tincY, tincx; + double *x, *y, *st=0, *tx; extern int CBLAS_CallFromC; extern int RowMajorStrg; RowMajorStrg = 0; + memcpy(&x,&X,sizeof(double*)); + memcpy(&y,&Y,sizeof(double*)); + CBLAS_CallFromC = 1; if (layout == CblasColMajor) @@ -49,7 +54,7 @@ void cblas_zgemv(const CBLAS_LAYOUT layout, else if (TransA == CblasConjTrans) TA = 'C'; else { - cblas_xerbla(2, "cblas_zgemv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(2, "cblas_zgemv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -124,11 +129,12 @@ void cblas_zgemv(const CBLAS_LAYOUT layout, y -= n; } } - else x = (double *) X; + else + memcpy(&x,&X,sizeof(double*)); } else { - cblas_xerbla(2, "cblas_zgemv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(2, "cblas_zgemv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -145,7 +151,7 @@ void cblas_zgemv(const CBLAS_LAYOUT layout, if (TransA == CblasConjTrans) { - if (x != (double *)X) free(x); + if (x != X) free(x); if (N > 0) { do @@ -157,7 +163,7 @@ void cblas_zgemv(const CBLAS_LAYOUT layout, } } } - else cblas_xerbla(1, "cblas_zgemv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_zgemv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_zgerc.c b/CBLAS/src/cblas_zgerc.c index 1a59db91fe..e0f801e2e3 100644 --- a/CBLAS/src/cblas_zgerc.c +++ b/CBLAS/src/cblas_zgerc.c @@ -7,15 +7,18 @@ */ #include #include +#include + #include "cblas.h" #include "cblas_f77.h" -void cblas_zgerc(const CBLAS_LAYOUT layout, const int M, const int N, - const void *alpha, const void *X, const int incX, - const void *Y, const int incY, void *A, const int lda) +void API_SUFFIX(cblas_zgerc)(const CBLAS_LAYOUT layout, const CBLAS_INT M, const CBLAS_INT N, + const void *alpha, const void *X, const CBLAS_INT incX, + const void *Y, const CBLAS_INT incY, void *A, const CBLAS_INT lda) { #ifdef F77_INT F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY; #else + CBLAS_INT incy = incY; #define F77_M M #define F77_N N #define F77_incX incX @@ -23,13 +26,16 @@ void cblas_zgerc(const CBLAS_LAYOUT layout, const int M, const int N, #define F77_lda lda #endif - int n, i, tincy, incy=incY; - double *y=(double *)Y, *yy=(double *)Y, *ty, *st; + CBLAS_INT n, i, tincy; + double *y, *yy, *ty, *st; extern int CBLAS_CallFromC; extern int RowMajorStrg; RowMajorStrg = 0; + memcpy(&y,&Y,sizeof(double*)); + memcpy(&yy,&Y,sizeof(double*)); + CBLAS_CallFromC = 1; if (layout == CblasColMajor) { @@ -56,7 +62,7 @@ void cblas_zgerc(const CBLAS_LAYOUT layout, const int M, const int N, } do { - *y = *yy; + *y = (double) *yy; y[1] = -yy[1]; y += tincy ; yy += i; @@ -70,14 +76,15 @@ void cblas_zgerc(const CBLAS_LAYOUT layout, const int M, const int N, incy = 1; #endif } - else y = (double *) Y; + else + memcpy(&y,&Y,sizeof(double*)); F77_zgeru( &F77_N, &F77_M, alpha, y, &F77_incY, X, &F77_incX, A, &F77_lda); if(Y!=y) free(y); - } else cblas_xerbla(1, "cblas_zgerc", "Illegal layout setting, %d\n", layout); + } else API_SUFFIX(cblas_xerbla)(1, "cblas_zgerc", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_zgeru.c b/CBLAS/src/cblas_zgeru.c index 4f37ee99b4..d1a128ca2f 100644 --- a/CBLAS/src/cblas_zgeru.c +++ b/CBLAS/src/cblas_zgeru.c @@ -7,9 +7,9 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_zgeru(const CBLAS_LAYOUT layout, const int M, const int N, - const void *alpha, const void *X, const int incX, - const void *Y, const int incY, void *A, const int lda) +void API_SUFFIX(cblas_zgeru)(const CBLAS_LAYOUT layout, const CBLAS_INT M, const CBLAS_INT N, + const void *alpha, const void *X, const CBLAS_INT incX, + const void *Y, const CBLAS_INT incY, void *A, const CBLAS_INT lda) { #ifdef F77_INT F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY; @@ -37,7 +37,7 @@ void cblas_zgeru(const CBLAS_LAYOUT layout, const int M, const int N, F77_zgeru( &F77_N, &F77_M, alpha, Y, &F77_incY, X, &F77_incX, A, &F77_lda); } - else cblas_xerbla(1, "cblas_zgeru", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_zgeru", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_zhbmv.c b/CBLAS/src/cblas_zhbmv.c index ed97b7ba15..0808f57946 100644 --- a/CBLAS/src/cblas_zhbmv.c +++ b/CBLAS/src/cblas_zhbmv.c @@ -9,11 +9,13 @@ #include "cblas_f77.h" #include #include -void cblas_zhbmv(const CBLAS_LAYOUT layout, - const CBLAS_UPLO Uplo,const int N,const int K, - const void *alpha, const void *A, const int lda, - const void *X, const int incX, const void *beta, - void *Y, const int incY) +#include + +void API_SUFFIX(cblas_zhbmv)(const CBLAS_LAYOUT layout, + const CBLAS_UPLO Uplo,const CBLAS_INT N,const CBLAS_INT K, + const void *alpha, const void *A, const CBLAS_INT lda, + const void *X, const CBLAS_INT incX, const void *beta, + void *Y, const CBLAS_INT incY) { char UL; #ifdef F77_CHAR @@ -24,21 +26,25 @@ void cblas_zhbmv(const CBLAS_LAYOUT layout, #ifdef F77_INT F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_incX=incX, F77_incY=incY; #else + CBLAS_INT incx = incX; #define F77_N N #define F77_K K #define F77_lda lda #define F77_incX incx #define F77_incY incY #endif - int n, i=0, incx=incX; - const double *xx= (double *)X, *alp= (double *)alpha, *bet = (double *)beta; + CBLAS_INT n, i=0; + const double *xx= (const double *)X, *alp= (const double *)alpha, *bet = (const double *)beta; double ALPHA[2],BETA[2]; - int tincY, tincx; - double *x=(double *)X, *y=(double *)Y, *st=0, *tx; + CBLAS_INT tincY, tincx; + double *x, *y, *st=0, *tx; extern int CBLAS_CallFromC; extern int RowMajorStrg; RowMajorStrg = 0; + memcpy(&x,&X,sizeof(double*)); + memcpy(&y,&Y,sizeof(double*)); + CBLAS_CallFromC = 1; if (layout == CblasColMajor) { @@ -46,7 +52,7 @@ void cblas_zhbmv(const CBLAS_LAYOUT layout, else if (Uplo == CblasUpper) UL = 'U'; else { - cblas_xerbla(2, "cblas_zhbmv","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_zhbmv","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -114,13 +120,13 @@ void cblas_zhbmv(const CBLAS_LAYOUT layout, } while(y != st); y -= n; } else - x = (double *) X; + memcpy(&x,&X,sizeof(double*)); if (Uplo == CblasUpper) UL = 'L'; else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_zhbmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_zhbmv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -133,7 +139,7 @@ void cblas_zhbmv(const CBLAS_LAYOUT layout, } else { - cblas_xerbla(1, "cblas_zhbmv","Illegal layout setting, %d\n", layout); + API_SUFFIX(cblas_xerbla)(1, "cblas_zhbmv","Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_zhemm.c b/CBLAS/src/cblas_zhemm.c index fc53036b99..98fb7084db 100644 --- a/CBLAS/src/cblas_zhemm.c +++ b/CBLAS/src/cblas_zhemm.c @@ -9,11 +9,11 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_zhemm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, - const CBLAS_UPLO Uplo, const int M, const int N, - const void *alpha, const void *A, const int lda, - const void *B, const int ldb, const void *beta, - void *C, const int ldc) +void API_SUFFIX(cblas_zhemm)(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, + const CBLAS_UPLO Uplo, const CBLAS_INT M, const CBLAS_INT N, + const void *alpha, const void *A, const CBLAS_INT lda, + const void *B, const CBLAS_INT ldb, const void *beta, + void *C, const CBLAS_INT ldc) { char SD, UL; #ifdef F77_CHAR @@ -45,7 +45,7 @@ void cblas_zhemm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Side == CblasLeft ) SD='L'; else { - cblas_xerbla(2, "cblas_zhemm", "Illegal Side setting, %d\n", Side); + API_SUFFIX(cblas_xerbla)(2, "cblas_zhemm", "Illegal Side setting, %d\n", Side); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -55,7 +55,7 @@ void cblas_zhemm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Uplo == CblasLower ) UL='L'; else { - cblas_xerbla(3, "cblas_zhemm", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(3, "cblas_zhemm", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -75,7 +75,7 @@ void cblas_zhemm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Side == CblasLeft ) SD='R'; else { - cblas_xerbla(2, "cblas_zhemm", "Illegal Side setting, %d\n", Side); + API_SUFFIX(cblas_xerbla)(2, "cblas_zhemm", "Illegal Side setting, %d\n", Side); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -85,7 +85,7 @@ void cblas_zhemm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Uplo == CblasLower ) UL='U'; else { - cblas_xerbla(3, "cblas_zhemm", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(3, "cblas_zhemm", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -99,7 +99,7 @@ void cblas_zhemm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, F77_zhemm(F77_SD, F77_UL, &F77_N, &F77_M, alpha, A, &F77_lda, B, &F77_ldb, beta, C, &F77_ldc); } - else cblas_xerbla(1, "cblas_zhemm", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_zhemm", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_zhemv.c b/CBLAS/src/cblas_zhemv.c index 83c15b19f7..28a0a7da5f 100644 --- a/CBLAS/src/cblas_zhemv.c +++ b/CBLAS/src/cblas_zhemv.c @@ -7,13 +7,14 @@ */ #include #include +#include #include "cblas.h" #include "cblas_f77.h" -void cblas_zhemv(const CBLAS_LAYOUT layout, - const CBLAS_UPLO Uplo, const int N, - const void *alpha, const void *A, const int lda, - const void *X, const int incX, const void *beta, - void *Y, const int incY) +void API_SUFFIX(cblas_zhemv)(const CBLAS_LAYOUT layout, + const CBLAS_UPLO Uplo, const CBLAS_INT N, + const void *alpha, const void *A, const CBLAS_INT lda, + const void *X, const CBLAS_INT incX, const void *beta, + void *Y, const CBLAS_INT incY) { char UL; #ifdef F77_CHAR @@ -24,20 +25,23 @@ void cblas_zhemv(const CBLAS_LAYOUT layout, #ifdef F77_INT F77_INT F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY; #else + CBLAS_INT incx = incX; #define F77_N N #define F77_lda lda #define F77_incX incx #define F77_incY incY #endif - int n, i=0, incx=incX; - const double *xx= (double *)X, *alp= (double *)alpha, *bet = (double *)beta; + CBLAS_INT n, i=0; + const double *xx= (const double *)X, *alp= (const double *)alpha, *bet = (const double *)beta; double ALPHA[2],BETA[2]; - int tincY, tincx; - double *x=(double *)X, *y=(double *)Y, *st=0, *tx; + CBLAS_INT tincY, tincx; + double *x, *y, *st=0, *tx; extern int CBLAS_CallFromC; extern int RowMajorStrg; RowMajorStrg = 0; + memcpy(&x,&X,sizeof(double*)); + memcpy(&y,&Y,sizeof(double*)); CBLAS_CallFromC = 1; if (layout == CblasColMajor) @@ -46,7 +50,7 @@ void cblas_zhemv(const CBLAS_LAYOUT layout, else if (Uplo == CblasLower) UL = 'L'; else { - cblas_xerbla(2, "cblas_zhemv","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_zhemv","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -114,14 +118,15 @@ void cblas_zhemv(const CBLAS_LAYOUT layout, } while(y != st); y -= n; } else - x = (double *) X; + memcpy(&x,&X,sizeof(double*)); + if (Uplo == CblasUpper) UL = 'L'; else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_zhemv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_zhemv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -134,7 +139,7 @@ void cblas_zhemv(const CBLAS_LAYOUT layout, } else { - cblas_xerbla(1, "cblas_zhemv","Illegal layout setting, %d\n", layout); + API_SUFFIX(cblas_xerbla)(1, "cblas_zhemv","Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_zher.c b/CBLAS/src/cblas_zher.c index 068d722538..5af15f6b40 100644 --- a/CBLAS/src/cblas_zher.c +++ b/CBLAS/src/cblas_zher.c @@ -7,11 +7,12 @@ */ #include #include +#include #include "cblas.h" #include "cblas_f77.h" -void cblas_zher(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, - const int N, const double alpha, const void *X, const int incX - ,void *A, const int lda) +void API_SUFFIX(cblas_zher)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_INT N, const double alpha, const void *X, const CBLAS_INT incX + ,void *A, const CBLAS_INT lda) { char UL; #ifdef F77_CHAR @@ -23,17 +24,22 @@ void cblas_zher(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, #ifdef F77_INT F77_INT F77_N=N, F77_lda=lda, F77_incX=incX; #else + CBLAS_INT incx = incX; #define F77_N N #define F77_lda lda #define F77_incX incx #endif - int n, i, tincx, incx=incX; - double *x=(double *)X, *xx=(double *)X, *tx, *st; + CBLAS_INT n, i, tincx; + double *x, *xx, *tx, *st; extern int CBLAS_CallFromC; extern int RowMajorStrg; RowMajorStrg = 0; + + memcpy(&x,&X,sizeof(double*)); + memcpy(&xx,&X,sizeof(double*)); + CBLAS_CallFromC = 1; if (layout == CblasColMajor) { @@ -41,7 +47,7 @@ void cblas_zher(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasUpper) UL = 'U'; else { - cblas_xerbla(2, "cblas_zher","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_zher","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -59,7 +65,7 @@ void cblas_zher(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_zher","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_zher","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -98,9 +104,10 @@ void cblas_zher(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, incx = 1; #endif } - else x = (double *) X; + else + memcpy(&x,&X,sizeof(double*)); F77_zher(F77_UL, &F77_N, &alpha, x, &F77_incX, A, &F77_lda); - } else cblas_xerbla(1, "cblas_zher", "Illegal layout setting, %d\n", layout); + } else API_SUFFIX(cblas_xerbla)(1, "cblas_zher", "Illegal layout setting, %d\n", layout); if(X!=x) free(x); diff --git a/CBLAS/src/cblas_zher2.c b/CBLAS/src/cblas_zher2.c index debfaf7b31..1b685a98ea 100644 --- a/CBLAS/src/cblas_zher2.c +++ b/CBLAS/src/cblas_zher2.c @@ -7,11 +7,12 @@ */ #include #include +#include #include "cblas.h" #include "cblas_f77.h" -void cblas_zher2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, - const int N, const void *alpha, const void *X, const int incX, - const void *Y, const int incY, void *A, const int lda) +void API_SUFFIX(cblas_zher2)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_INT N, const void *alpha, const void *X, const CBLAS_INT incX, + const void *Y, const CBLAS_INT incY, void *A, const CBLAS_INT lda) { char UL; #ifdef F77_CHAR @@ -23,19 +24,27 @@ void cblas_zher2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, #ifdef F77_INT F77_INT F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY; #else + CBLAS_INT incx = incX, incy = incY; #define F77_N N #define F77_lda lda #define F77_incX incx #define F77_incY incy #endif - int n, i, j, tincx, tincy, incx=incX, incy=incY; - double *x=(double *)X, *xx=(double *)X, *y=(double *)Y, - *yy=(double *)Y, *tx, *ty, *stx, *sty; + CBLAS_INT n, i, j, tincx, tincy; + double *x, *xx, *y, + *yy, *tx, *ty, *stx, *sty; extern int CBLAS_CallFromC; extern int RowMajorStrg; RowMajorStrg = 0; + + memcpy(&x,&X,sizeof(double*)); + memcpy(&xx,&X,sizeof(double*)); + memcpy(&y,&Y,sizeof(double*)); + memcpy(&yy,&Y,sizeof(double*)); + + CBLAS_CallFromC = 1; if (layout == CblasColMajor) { @@ -43,7 +52,7 @@ void cblas_zher2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasUpper) UL = 'U'; else { - cblas_xerbla(2, "cblas_zher2", "Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_zher2", "Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -62,7 +71,7 @@ void cblas_zher2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_zher2", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_zher2", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -129,15 +138,16 @@ void cblas_zher2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, #endif } else { - x = (double *) X; - y = (double *) Y; + + memcpy(&x,&X,sizeof(double*)); + memcpy(&y,&Y,sizeof(double*)); } F77_zher2(F77_UL, &F77_N, alpha, y, &F77_incY, x, &F77_incX, A, &F77_lda); } else { - cblas_xerbla(1, "cblas_zher2", "Illegal layout setting, %d\n", layout); + API_SUFFIX(cblas_xerbla)(1, "cblas_zher2", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_zher2k.c b/CBLAS/src/cblas_zher2k.c index ccbd6b086b..e1ac2c64d2 100644 --- a/CBLAS/src/cblas_zher2k.c +++ b/CBLAS/src/cblas_zher2k.c @@ -9,11 +9,11 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_zher2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, - const CBLAS_TRANSPOSE Trans, const int N, const int K, - const void *alpha, const void *A, const int lda, - const void *B, const int ldb, const double beta, - void *C, const int ldc) +void API_SUFFIX(cblas_zher2k)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_TRANSPOSE Trans, const CBLAS_INT N, const CBLAS_INT K, + const void *alpha, const void *A, const CBLAS_INT lda, + const void *B, const CBLAS_INT ldb, const double beta, + void *C, const CBLAS_INT ldc) { char UL, TR; #ifdef F77_CHAR @@ -37,7 +37,7 @@ void cblas_zher2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, extern int CBLAS_CallFromC; extern int RowMajorStrg; double ALPHA[2]; - const double *alp=(double *)alpha; + const double *alp=(const double *)alpha; CBLAS_CallFromC = 1; RowMajorStrg = 0; @@ -49,7 +49,7 @@ void cblas_zher2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='L'; else { - cblas_xerbla(2, "cblas_zher2k", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_zher2k", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -60,7 +60,7 @@ void cblas_zher2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Trans == CblasNoTrans ) TR='N'; else { - cblas_xerbla(3, "cblas_zher2k", "Illegal Trans setting, %d\n", Trans); + API_SUFFIX(cblas_xerbla)(3, "cblas_zher2k", "Illegal Trans setting, %d\n", Trans); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -80,17 +80,16 @@ void cblas_zher2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='U'; else { - cblas_xerbla(2, "cblas_zher2k", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_zher2k", "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 { - cblas_xerbla(3, "cblas_zher2k", "Illegal Trans setting, %d\n", Trans); + API_SUFFIX(cblas_xerbla)(3, "cblas_zher2k", "Illegal Trans setting, %d\n", Trans); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -103,7 +102,7 @@ void cblas_zher2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, ALPHA[0]= *alp; ALPHA[1]= -alp[1]; F77_zher2k(F77_UL,F77_TR, &F77_N, &F77_K, ALPHA, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc); - } else cblas_xerbla(1, "cblas_zher2k", "Illegal layout setting, %d\n", layout); + } else API_SUFFIX(cblas_xerbla)(1, "cblas_zher2k", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_zherk.c b/CBLAS/src/cblas_zherk.c index b0bfa81d34..9016a512a6 100644 --- a/CBLAS/src/cblas_zherk.c +++ b/CBLAS/src/cblas_zherk.c @@ -9,10 +9,10 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_zherk(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, - const CBLAS_TRANSPOSE Trans, const int N, const int K, - const double alpha, const void *A, const int lda, - const double beta, void *C, const int ldc) +void API_SUFFIX(cblas_zherk)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_TRANSPOSE Trans, const CBLAS_INT N, const CBLAS_INT K, + const double alpha, const void *A, const CBLAS_INT lda, + const double beta, void *C, const CBLAS_INT ldc) { char UL, TR; #ifdef F77_CHAR @@ -43,7 +43,7 @@ void cblas_zherk(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='L'; else { - cblas_xerbla(2, "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; @@ -54,7 +54,7 @@ void cblas_zherk(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Trans == CblasNoTrans ) TR='N'; else { - cblas_xerbla(3, "cblas_zherk", "Illegal Trans setting, %d\n", Trans); + API_SUFFIX(cblas_xerbla)(3, "cblas_zherk", "Illegal Trans setting, %d\n", Trans); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -74,17 +74,16 @@ void cblas_zherk(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='U'; else { - 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 { - cblas_xerbla(3, "cblas_zherk", "Illegal Trans setting, %d\n", Trans); + API_SUFFIX(cblas_xerbla)(3, "cblas_zherk", "Illegal Trans setting, %d\n", Trans); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -98,7 +97,7 @@ void cblas_zherk(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, F77_zherk(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda, &beta, C, &F77_ldc); } - else cblas_xerbla(1, "cblas_zherk", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_zherk", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_zhpmv.c b/CBLAS/src/cblas_zhpmv.c index 35019d575c..7f6cd045b5 100644 --- a/CBLAS/src/cblas_zhpmv.c +++ b/CBLAS/src/cblas_zhpmv.c @@ -7,13 +7,15 @@ */ #include #include +#include + #include "cblas.h" #include "cblas_f77.h" -void cblas_zhpmv(const CBLAS_LAYOUT layout, - const CBLAS_UPLO Uplo,const int N, +void API_SUFFIX(cblas_zhpmv)(const CBLAS_LAYOUT layout, + const CBLAS_UPLO Uplo,const CBLAS_INT N, const void *alpha, const void *AP, - const void *X, const int incX, const void *beta, - void *Y, const int incY) + const void *X, const CBLAS_INT incX, const void *beta, + void *Y, const CBLAS_INT incY) { char UL; #ifdef F77_CHAR @@ -24,19 +26,23 @@ void cblas_zhpmv(const CBLAS_LAYOUT layout, #ifdef F77_INT F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; #else + CBLAS_INT incx = incX; #define F77_N N #define F77_incX incx #define F77_incY incY #endif - int n, i=0, incx=incX; - const double *xx= (double *)X, *alp= (double *)alpha, *bet = (double *)beta; + CBLAS_INT n, i=0; + const double *xx= (const double *)X, *alp= (const double *)alpha, *bet = (const double *)beta; double ALPHA[2],BETA[2]; - int tincY, tincx; - double *x=(double *)X, *y=(double *)Y, *st=0, *tx; + CBLAS_INT tincY, tincx; + double *x, *y, *st=0, *tx; extern int CBLAS_CallFromC; extern int RowMajorStrg; RowMajorStrg = 0; + memcpy(&x,&X,sizeof(double*)); + memcpy(&y,&Y,sizeof(double*)); + CBLAS_CallFromC = 1; if (layout == CblasColMajor) { @@ -44,7 +50,7 @@ void cblas_zhpmv(const CBLAS_LAYOUT layout, else if (Uplo == CblasUpper) UL = 'U'; else { - cblas_xerbla(2, "cblas_zhpmv","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_zhpmv","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -112,14 +118,13 @@ void cblas_zhpmv(const CBLAS_LAYOUT layout, } while(y != st); y -= n; } else - x = (double *) X; - + memcpy(&x,&X,sizeof(double*)); if (Uplo == CblasUpper) UL = 'L'; else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_zhpmv","Illegal Uplo setting, %d\n", Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_zhpmv","Illegal Uplo setting, %d\n", Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -133,7 +138,7 @@ void cblas_zhpmv(const CBLAS_LAYOUT layout, } else { - cblas_xerbla(1, "cblas_zhpmv","Illegal layout setting, %d\n", layout); + API_SUFFIX(cblas_xerbla)(1, "cblas_zhpmv","Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_zhpr.c b/CBLAS/src/cblas_zhpr.c index 9b00781c5e..9578c82f19 100644 --- a/CBLAS/src/cblas_zhpr.c +++ b/CBLAS/src/cblas_zhpr.c @@ -7,11 +7,12 @@ */ #include #include +#include #include "cblas.h" #include "cblas_f77.h" -void cblas_zhpr(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, - const int N, const double alpha, const void *X, - const int incX, void *A) +void API_SUFFIX(cblas_zhpr)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_INT N, const double alpha, const void *X, + const CBLAS_INT incX, void *A) { char UL; #ifdef F77_CHAR @@ -23,16 +24,20 @@ void cblas_zhpr(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, #ifdef F77_INT F77_INT F77_N=N, F77_incX=incX; #else + CBLAS_INT incx = incX; #define F77_N N #define F77_incX incx #endif - int n, i, tincx, incx=incX; - double *x=(double *)X, *xx=(double *)X, *tx, *st; + CBLAS_INT n, i, tincx; + double *x, *xx, *tx, *st; extern int CBLAS_CallFromC; extern int RowMajorStrg; RowMajorStrg = 0; + memcpy(&x,&X,sizeof(double*)); + memcpy(&xx,&X,sizeof(double*)); + CBLAS_CallFromC = 1; if (layout == CblasColMajor) { @@ -40,7 +45,7 @@ void cblas_zhpr(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasUpper) UL = 'U'; else { - cblas_xerbla(2, "cblas_zhpr","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_zhpr","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -58,7 +63,7 @@ void cblas_zhpr(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_zhpr","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_zhpr","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -96,13 +101,14 @@ void cblas_zhpr(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, incx = 1; #endif } - else x = (double *) X; + else + memcpy(&x,&X,sizeof(double*)); F77_zhpr(F77_UL, &F77_N, &alpha, x, &F77_incX, A); } else { - cblas_xerbla(1, "cblas_zhpr","Illegal layout setting, %d\n", layout); + API_SUFFIX(cblas_xerbla)(1, "cblas_zhpr","Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_zhpr2.c b/CBLAS/src/cblas_zhpr2.c index b7c6ca51ee..58ba7d39a7 100644 --- a/CBLAS/src/cblas_zhpr2.c +++ b/CBLAS/src/cblas_zhpr2.c @@ -7,11 +7,12 @@ */ #include #include +#include #include "cblas.h" #include "cblas_f77.h" -void cblas_zhpr2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, - const int N,const void *alpha, const void *X, - const int incX,const void *Y, const int incY, void *Ap) +void API_SUFFIX(cblas_zhpr2)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_INT N,const void *alpha, const void *X, + const CBLAS_INT incX,const void *Y, const CBLAS_INT incY, void *Ap) { char UL; @@ -24,18 +25,24 @@ void cblas_zhpr2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, #ifdef F77_INT F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; #else + CBLAS_INT incx = incX, incy = incY; #define F77_N N #define F77_incX incx #define F77_incY incy #endif - int n, i, j, incx=incX, incy=incY; - double *x=(double *)X, *xx=(double *)X, *y=(double *)Y, - *yy=(double *)Y, *stx, *sty; + CBLAS_INT n, i, j; + double *x, *xx, *y, + *yy, *stx, *sty; extern int CBLAS_CallFromC; extern int RowMajorStrg; RowMajorStrg = 0; + memcpy(&x,&X,sizeof(double*)); + memcpy(&xx,&X,sizeof(double*)); + memcpy(&y,&Y,sizeof(double*)); + memcpy(&yy,&Y,sizeof(double*)); + CBLAS_CallFromC = 1; if (layout == CblasColMajor) { @@ -43,7 +50,7 @@ void cblas_zhpr2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasUpper) UL = 'U'; else { - cblas_xerbla(2, "cblas_zhpr2","Illegal Uplo setting, %d\n",Uplo ); + API_SUFFIX(cblas_xerbla)(2, "cblas_zhpr2","Illegal Uplo setting, %d\n",Uplo ); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -61,7 +68,7 @@ void cblas_zhpr2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_zhpr2","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_zhpr2","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -128,14 +135,15 @@ void cblas_zhpr2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, } else { - x = (double *) X; - y = (void *) Y; + + memcpy(&x,&X,sizeof(double*)); + memcpy(&y,&Y,sizeof(double*)); } F77_zhpr2(F77_UL, &F77_N, alpha, y, &F77_incY, x, &F77_incX, Ap); } else { - cblas_xerbla(1, "cblas_zhpr2","Illegal layout setting, %d\n", layout); + API_SUFFIX(cblas_xerbla)(1, "cblas_zhpr2","Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_zrotg.c b/CBLAS/src/cblas_zrotg.c new file mode 100644 index 0000000000..07d9af0deb --- /dev/null +++ b/CBLAS/src/cblas_zrotg.c @@ -0,0 +1,13 @@ +/* + * cblas_zrotg.c + * + * The program is a C interface to zrotg. + * + */ +#include "cblas.h" +#include "cblas_f77.h" +void API_SUFFIX(cblas_zrotg)(void *a, void *b, double *c, void *s) +{ + F77_zrotg(a,b,c,s); +} + diff --git a/CBLAS/src/cblas_zscal.c b/CBLAS/src/cblas_zscal.c index 622e9ba160..1c146dfd8a 100644 --- a/CBLAS/src/cblas_zscal.c +++ b/CBLAS/src/cblas_zscal.c @@ -8,8 +8,8 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_zscal( const int N, const void *alpha, void *X, - const int incX) +void API_SUFFIX(cblas_zscal)( const CBLAS_INT N, const void *alpha, void *X, + const CBLAS_INT incX) { #ifdef F77_INT F77_INT F77_N=N, F77_incX=incX; diff --git a/CBLAS/src/cblas_zswap.c b/CBLAS/src/cblas_zswap.c index 4895acf48b..d1aa9fa5ef 100644 --- a/CBLAS/src/cblas_zswap.c +++ b/CBLAS/src/cblas_zswap.c @@ -8,8 +8,8 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_zswap( const int N, void *X, const int incX, void *Y, - const int incY) +void API_SUFFIX(cblas_zswap)( const CBLAS_INT N, void *X, const CBLAS_INT incX, void *Y, + const CBLAS_INT incY) { #ifdef F77_INT F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; diff --git a/CBLAS/src/cblas_zsymm.c b/CBLAS/src/cblas_zsymm.c index 16904966f3..a2550d3878 100644 --- a/CBLAS/src/cblas_zsymm.c +++ b/CBLAS/src/cblas_zsymm.c @@ -9,11 +9,11 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_zsymm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, - const CBLAS_UPLO Uplo, const int M, const int N, - const void *alpha, const void *A, const int lda, - const void *B, const int ldb, const void *beta, - void *C, const int ldc) +void API_SUFFIX(cblas_zsymm)(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, + const CBLAS_UPLO Uplo, const CBLAS_INT M, const CBLAS_INT N, + const void *alpha, const void *A, const CBLAS_INT lda, + const void *B, const CBLAS_INT ldb, const void *beta, + void *C, const CBLAS_INT ldc) { char SD, UL; #ifdef F77_CHAR @@ -45,7 +45,7 @@ void cblas_zsymm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Side == CblasLeft ) SD='L'; else { - cblas_xerbla(2, "cblas_zsymm", "Illegal Side setting, %d\n", Side); + API_SUFFIX(cblas_xerbla)(2, "cblas_zsymm", "Illegal Side setting, %d\n", Side); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -55,7 +55,7 @@ void cblas_zsymm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Uplo == CblasLower ) UL='L'; else { - cblas_xerbla(3, "cblas_zsymm", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(3, "cblas_zsymm", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -75,7 +75,7 @@ void cblas_zsymm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Side == CblasLeft ) SD='R'; else { - cblas_xerbla(2, "cblas_zsymm", "Illegal Side setting, %d\n", Side); + API_SUFFIX(cblas_xerbla)(2, "cblas_zsymm", "Illegal Side setting, %d\n", Side); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -85,7 +85,7 @@ void cblas_zsymm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Uplo == CblasLower ) UL='U'; else { - cblas_xerbla(3, "cblas_zsymm", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(3, "cblas_zsymm", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -99,7 +99,7 @@ void cblas_zsymm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, F77_zsymm(F77_SD, F77_UL, &F77_N, &F77_M, alpha, A, &F77_lda, B, &F77_ldb, beta, C, &F77_ldc); } - else cblas_xerbla(1, "cblas_zsymm", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_zsymm", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_zsyr2k.c b/CBLAS/src/cblas_zsyr2k.c index 20bb25b5da..3d09e32978 100644 --- a/CBLAS/src/cblas_zsyr2k.c +++ b/CBLAS/src/cblas_zsyr2k.c @@ -9,11 +9,11 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_zsyr2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, - const CBLAS_TRANSPOSE Trans, const int N, const int K, - const void *alpha, const void *A, const int lda, - const void *B, const int ldb, const void *beta, - void *C, const int ldc) +void API_SUFFIX(cblas_zsyr2k)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_TRANSPOSE Trans, const CBLAS_INT N, const CBLAS_INT K, + const void *alpha, const void *A, const CBLAS_INT lda, + const void *B, const CBLAS_INT ldb, const void *beta, + void *C, const CBLAS_INT ldc) { char UL, TR; #ifdef F77_CHAR @@ -46,7 +46,7 @@ void cblas_zsyr2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='L'; else { - cblas_xerbla(2, "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; @@ -57,7 +57,7 @@ void cblas_zsyr2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Trans == CblasNoTrans ) TR='N'; else { - cblas_xerbla(3, "cblas_zsyr2k", "Illegal Trans setting, %d\n", Trans); + API_SUFFIX(cblas_xerbla)(3, "cblas_zsyr2k", "Illegal Trans setting, %d\n", Trans); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -78,17 +78,16 @@ void cblas_zsyr2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='U'; else { - 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 { - cblas_xerbla(3, "cblas_zsyr2k", "Illegal Trans setting, %d\n", Trans); + API_SUFFIX(cblas_xerbla)(3, "cblas_zsyr2k", "Illegal Trans setting, %d\n", Trans); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -101,7 +100,7 @@ void cblas_zsyr2k(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, F77_zsyr2k(F77_UL, F77_TR, &F77_N, &F77_K, alpha, A, &F77_lda, B, &F77_ldb, beta, C, &F77_ldc); } - else cblas_xerbla(1, "cblas_zsyr2k", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_zsyr2k", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_zsyrk.c b/CBLAS/src/cblas_zsyrk.c index 55e350d846..885158293b 100644 --- a/CBLAS/src/cblas_zsyrk.c +++ b/CBLAS/src/cblas_zsyrk.c @@ -9,10 +9,10 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_zsyrk(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, - const CBLAS_TRANSPOSE Trans, const int N, const int K, - const void *alpha, const void *A, const int lda, - const void *beta, void *C, const int ldc) +void API_SUFFIX(cblas_zsyrk)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, + const CBLAS_TRANSPOSE Trans, const CBLAS_INT N, const CBLAS_INT K, + const void *alpha, const void *A, const CBLAS_INT lda, + const void *beta, void *C, const CBLAS_INT ldc) { char UL, TR; #ifdef F77_CHAR @@ -44,7 +44,7 @@ void cblas_zsyrk(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='L'; else { - cblas_xerbla(2, "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; @@ -55,7 +55,7 @@ void cblas_zsyrk(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Trans == CblasNoTrans ) TR='N'; else { - cblas_xerbla(3, "cblas_zsyrk", "Illegal Trans setting, %d\n", Trans); + API_SUFFIX(cblas_xerbla)(3, "cblas_zsyrk", "Illegal Trans setting, %d\n", Trans); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -76,17 +76,16 @@ void cblas_zsyrk(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='U'; else { - 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 { - cblas_xerbla(3, "cblas_zsyrk", "Illegal Trans setting, %d\n", Trans); + API_SUFFIX(cblas_xerbla)(3, "cblas_zsyrk", "Illegal Trans setting, %d\n", Trans); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -100,7 +99,7 @@ void cblas_zsyrk(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, F77_zsyrk(F77_UL, F77_TR, &F77_N, &F77_K, alpha, A, &F77_lda, beta, C, &F77_ldc); } - else cblas_xerbla(1, "cblas_zsyrk", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_zsyrk", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_ztbmv.c b/CBLAS/src/cblas_ztbmv.c index 58db9839fb..af86f60625 100644 --- a/CBLAS/src/cblas_ztbmv.c +++ b/CBLAS/src/cblas_ztbmv.c @@ -7,10 +7,10 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_ztbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, +void API_SUFFIX(cblas_ztbmv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, const CBLAS_DIAG Diag, - const int N, const int K, const void *A, const int lda, - void *X, const int incX) + const CBLAS_INT N, const CBLAS_INT K, const void *A, const CBLAS_INT lda, + void *X, const CBLAS_INT incX) { char TA; char UL; @@ -30,7 +30,7 @@ void cblas_ztbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, #define F77_lda lda #define F77_incX incX #endif - int n, i=0, tincX; + CBLAS_INT n, i=0, tincX; double *st=0, *x=(double *)X; extern int CBLAS_CallFromC; extern int RowMajorStrg; @@ -43,7 +43,7 @@ void cblas_ztbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'L'; else { - cblas_xerbla(2, "cblas_ztbmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_ztbmv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -53,7 +53,7 @@ void cblas_ztbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'C'; else { - cblas_xerbla(3, "cblas_ztbmv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_ztbmv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -62,7 +62,7 @@ void cblas_ztbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_ztbmv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_ztbmv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -82,7 +82,7 @@ void cblas_ztbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_ztbmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_ztbmv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -114,7 +114,7 @@ void cblas_ztbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, } else { - cblas_xerbla(3, "cblas_ztbmv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_ztbmv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -124,7 +124,7 @@ void cblas_ztbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - 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; @@ -151,7 +151,7 @@ void cblas_ztbmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, } } } - else cblas_xerbla(1, "cblas_ztbmv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_ztbmv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_ztbsv.c b/CBLAS/src/cblas_ztbsv.c index 2f18cdde3b..ea6b4d3b08 100644 --- a/CBLAS/src/cblas_ztbsv.c +++ b/CBLAS/src/cblas_ztbsv.c @@ -7,10 +7,10 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_ztbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, +void API_SUFFIX(cblas_ztbsv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, const CBLAS_DIAG Diag, - const int N, const int K, const void *A, const int lda, - void *X, const int incX) + const CBLAS_INT N, const CBLAS_INT K, const void *A, const CBLAS_INT lda, + void *X, const CBLAS_INT incX) { char TA; char UL; @@ -30,7 +30,7 @@ void cblas_ztbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, #define F77_lda lda #define F77_incX incX #endif - int n, i=0, tincX; + CBLAS_INT n, i=0, tincX; double *st=0,*x=(double *)X; extern int CBLAS_CallFromC; extern int RowMajorStrg; @@ -43,7 +43,7 @@ void cblas_ztbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'L'; else { - cblas_xerbla(2, "cblas_ztbsv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_ztbsv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -53,7 +53,7 @@ void cblas_ztbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'C'; else { - cblas_xerbla(3, "cblas_ztbsv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_ztbsv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -62,7 +62,7 @@ void cblas_ztbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_ztbsv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_ztbsv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -82,7 +82,7 @@ void cblas_ztbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_ztbsv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_ztbsv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -118,7 +118,7 @@ void cblas_ztbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, } else { - cblas_xerbla(3, "cblas_ztbsv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_ztbsv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -128,7 +128,7 @@ void cblas_ztbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_ztbsv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_ztbsv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -155,7 +155,7 @@ void cblas_ztbsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, } } } - else cblas_xerbla(1, "cblas_ztbsv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_ztbsv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_ztpmv.c b/CBLAS/src/cblas_ztpmv.c index e11ac69242..119b6bcdd3 100644 --- a/CBLAS/src/cblas_ztpmv.c +++ b/CBLAS/src/cblas_ztpmv.c @@ -7,9 +7,9 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_ztpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, +void API_SUFFIX(cblas_ztpmv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, const CBLAS_DIAG Diag, - const int N, const void *Ap, void *X, const int incX) + const CBLAS_INT N, const void *Ap, void *X, const CBLAS_INT incX) { char TA; char UL; @@ -27,7 +27,7 @@ void cblas_ztpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, #define F77_N N #define F77_incX incX #endif - int n, i=0, tincX; + CBLAS_INT n, i=0, tincX; double *st=0,*x=(double *)X; extern int CBLAS_CallFromC; extern int RowMajorStrg; @@ -40,7 +40,7 @@ void cblas_ztpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'L'; else { - cblas_xerbla(2, "cblas_ztpmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_ztpmv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -50,7 +50,7 @@ void cblas_ztpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'C'; else { - cblas_xerbla(3, "cblas_ztpmv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_ztpmv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -59,7 +59,7 @@ void cblas_ztpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_ztpmv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_ztpmv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -78,7 +78,7 @@ void cblas_ztpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_ztpmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_ztpmv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -110,7 +110,7 @@ void cblas_ztpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, } else { - cblas_xerbla(3, "cblas_ztpmv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_ztpmv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -120,7 +120,7 @@ void cblas_ztpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_ztpmv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_ztpmv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -145,7 +145,7 @@ void cblas_ztpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, } } } - else cblas_xerbla(1, "cblas_ztpmv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_ztpmv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_ztpsv.c b/CBLAS/src/cblas_ztpsv.c index 7c16668dc6..d907d2f706 100644 --- a/CBLAS/src/cblas_ztpsv.c +++ b/CBLAS/src/cblas_ztpsv.c @@ -7,9 +7,9 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_ztpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, +void API_SUFFIX(cblas_ztpsv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, const CBLAS_DIAG Diag, - const int N, const void *Ap, void *X, const int incX) + const CBLAS_INT N, const void *Ap, void *X, const CBLAS_INT incX) { char TA; char UL; @@ -27,7 +27,7 @@ void cblas_ztpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, #define F77_N N #define F77_incX incX #endif - int n, i=0, tincX; + CBLAS_INT n, i=0, tincX; double *st=0, *x=(double*)X; extern int CBLAS_CallFromC; extern int RowMajorStrg; @@ -40,7 +40,7 @@ void cblas_ztpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'L'; else { - cblas_xerbla(2, "cblas_ztpsv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_ztpsv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -50,7 +50,7 @@ void cblas_ztpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'C'; else { - cblas_xerbla(3, "cblas_ztpsv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_ztpsv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -59,7 +59,7 @@ void cblas_ztpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_ztpsv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_ztpsv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -78,7 +78,7 @@ void cblas_ztpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_ztpsv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_ztpsv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -114,7 +114,7 @@ void cblas_ztpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, } else { - cblas_xerbla(3, "cblas_ztpsv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_ztpsv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -124,7 +124,7 @@ void cblas_ztpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_ztpsv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_ztpsv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -150,7 +150,7 @@ void cblas_ztpsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, } } } - else cblas_xerbla(1, "cblas_ztpsv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_ztpsv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_ztrmm.c b/CBLAS/src/cblas_ztrmm.c index 573d6b7f5a..4b93f8e3a6 100644 --- a/CBLAS/src/cblas_ztrmm.c +++ b/CBLAS/src/cblas_ztrmm.c @@ -9,11 +9,11 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_ztrmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, +void API_SUFFIX(cblas_ztrmm)(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, - const CBLAS_DIAG Diag, const int M, const int N, - const void *alpha, const void *A, const int lda, - void *B, const int ldb) + const CBLAS_DIAG Diag, const CBLAS_INT M, const CBLAS_INT N, + const void *alpha, const void *A, const CBLAS_INT lda, + void *B, const CBLAS_INT ldb) { char UL, TA, SD, DI; #ifdef F77_CHAR @@ -45,7 +45,7 @@ void cblas_ztrmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Side == CblasLeft ) SD='L'; else { - cblas_xerbla(2, "cblas_ztrmm", "Illegal Side setting, %d\n", Side); + API_SUFFIX(cblas_xerbla)(2, "cblas_ztrmm", "Illegal Side setting, %d\n", Side); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -54,7 +54,7 @@ void cblas_ztrmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Uplo == CblasLower ) UL='L'; else { - cblas_xerbla(3, "cblas_ztrmm", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(3, "cblas_ztrmm", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -65,7 +65,7 @@ void cblas_ztrmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( TransA == CblasNoTrans ) TA='N'; else { - cblas_xerbla(4, "cblas_ztrmm", "Illegal Trans setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(4, "cblas_ztrmm", "Illegal Trans setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -75,7 +75,7 @@ void cblas_ztrmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Diag == CblasNonUnit ) DI='N'; else { - cblas_xerbla(5, "cblas_ztrmm", "Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(5, "cblas_ztrmm", "Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -96,7 +96,7 @@ void cblas_ztrmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Side == CblasLeft ) SD='R'; else { - cblas_xerbla(2, "cblas_ztrmm", "Illegal Side setting, %d\n", Side); + API_SUFFIX(cblas_xerbla)(2, "cblas_ztrmm", "Illegal Side setting, %d\n", Side); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -106,7 +106,7 @@ void cblas_ztrmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Uplo == CblasLower ) UL='U'; else { - cblas_xerbla(3, "cblas_ztrmm", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(3, "cblas_ztrmm", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -117,7 +117,7 @@ void cblas_ztrmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( TransA == CblasNoTrans ) TA='N'; else { - cblas_xerbla(4, "cblas_ztrmm", "Illegal Trans setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(4, "cblas_ztrmm", "Illegal Trans setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -127,7 +127,7 @@ void cblas_ztrmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Diag == CblasNonUnit ) DI='N'; else { - cblas_xerbla(5, "cblas_ztrmm", "Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(5, "cblas_ztrmm", "Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -142,7 +142,7 @@ void cblas_ztrmm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, F77_ztrmm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, alpha, A, &F77_lda, B, &F77_ldb); } - else cblas_xerbla(1, "cblas_ztrmm", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_ztrmm", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_ztrmv.c b/CBLAS/src/cblas_ztrmv.c index 462e6d8786..f28fb19db4 100644 --- a/CBLAS/src/cblas_ztrmv.c +++ b/CBLAS/src/cblas_ztrmv.c @@ -7,10 +7,10 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_ztrmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, +void API_SUFFIX(cblas_ztrmv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, const CBLAS_DIAG Diag, - const int N, const void *A, const int lda, - void *X, const int incX) + const CBLAS_INT N, const void *A, const CBLAS_INT lda, + void *X, const CBLAS_INT incX) { char TA; @@ -30,7 +30,7 @@ void cblas_ztrmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, #define F77_lda lda #define F77_incX incX #endif - int n, i=0, tincX; + CBLAS_INT n, i=0, tincX; double *st=0,*x=(double *)X; extern int CBLAS_CallFromC; extern int RowMajorStrg; @@ -43,7 +43,7 @@ void cblas_ztrmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'L'; else { - cblas_xerbla(2, "cblas_ztrmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_ztrmv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -53,7 +53,7 @@ void cblas_ztrmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'C'; else { - cblas_xerbla(3, "cblas_ztrmv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_ztrmv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -62,7 +62,7 @@ void cblas_ztrmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_ztrmv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_ztrmv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -82,7 +82,7 @@ void cblas_ztrmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_ztrmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_ztrmv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -114,7 +114,7 @@ void cblas_ztrmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, } else { - cblas_xerbla(3, "cblas_ztrmv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_ztrmv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -124,7 +124,7 @@ void cblas_ztrmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_ztrmv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_ztrmv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -149,7 +149,7 @@ void cblas_ztrmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, } } } - else cblas_xerbla(1, "cblas_ztrmv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_ztrmv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_ztrsm.c b/CBLAS/src/cblas_ztrsm.c index 89ceb067bb..f6d777e2ff 100644 --- a/CBLAS/src/cblas_ztrsm.c +++ b/CBLAS/src/cblas_ztrsm.c @@ -9,11 +9,11 @@ #include "cblas.h" #include "cblas_f77.h" -void cblas_ztrsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, +void API_SUFFIX(cblas_ztrsm)(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, - const CBLAS_DIAG Diag, const int M, const int N, - const void *alpha, const void *A, const int lda, - void *B, const int ldb) + const CBLAS_DIAG Diag, const CBLAS_INT M, const CBLAS_INT N, + const void *alpha, const void *A, const CBLAS_INT lda, + void *B, const CBLAS_INT ldb) { char UL, TA, SD, DI; #ifdef F77_CHAR @@ -46,7 +46,7 @@ void cblas_ztrsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Side == CblasLeft ) SD='L'; else { - cblas_xerbla(2, "cblas_ztrsm", "Illegal Side setting, %d\n", Side); + API_SUFFIX(cblas_xerbla)(2, "cblas_ztrsm", "Illegal Side setting, %d\n", Side); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -56,7 +56,7 @@ void cblas_ztrsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Uplo == CblasLower ) UL='L'; else { - cblas_xerbla(3, "cblas_ztrsm", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(3, "cblas_ztrsm", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -67,7 +67,7 @@ void cblas_ztrsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( TransA == CblasNoTrans ) TA='N'; else { - cblas_xerbla(4, "cblas_ztrsm", "Illegal Trans setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(4, "cblas_ztrsm", "Illegal Trans setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -77,7 +77,7 @@ void cblas_ztrsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Diag == CblasNonUnit ) DI='N'; else { - cblas_xerbla(5, "cblas_ztrsm", "Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(5, "cblas_ztrsm", "Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -100,7 +100,7 @@ void cblas_ztrsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Side == CblasLeft ) SD='R'; else { - cblas_xerbla(2, "cblas_ztrsm", "Illegal Side setting, %d\n", Side); + API_SUFFIX(cblas_xerbla)(2, "cblas_ztrsm", "Illegal Side setting, %d\n", Side); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -110,7 +110,7 @@ void cblas_ztrsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Uplo == CblasLower ) UL='U'; else { - cblas_xerbla(3, "cblas_ztrsm", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(3, "cblas_ztrsm", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -121,7 +121,7 @@ void cblas_ztrsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( TransA == CblasNoTrans ) TA='N'; else { - cblas_xerbla(4, "cblas_ztrsm", "Illegal Trans setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(4, "cblas_ztrsm", "Illegal Trans setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -131,7 +131,7 @@ void cblas_ztrsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, else if ( Diag == CblasNonUnit ) DI='N'; else { - cblas_xerbla(5, "cblas_ztrsm", "Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(5, "cblas_ztrsm", "Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -148,7 +148,7 @@ void cblas_ztrsm(const CBLAS_LAYOUT layout, const CBLAS_SIDE Side, F77_ztrsm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, alpha, A, &F77_lda, B, &F77_ldb); } - else cblas_xerbla(1, "cblas_ztrsm", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_ztrsm", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_ztrsv.c b/CBLAS/src/cblas_ztrsv.c index e7d47e812d..bbdbd8ff1a 100644 --- a/CBLAS/src/cblas_ztrsv.c +++ b/CBLAS/src/cblas_ztrsv.c @@ -7,10 +7,10 @@ */ #include "cblas.h" #include "cblas_f77.h" -void cblas_ztrsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, +void API_SUFFIX(cblas_ztrsv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, const CBLAS_DIAG Diag, - const int N, const void *A, const int lda, void *X, - const int incX) + const CBLAS_INT N, const void *A, const CBLAS_INT lda, void *X, + const CBLAS_INT incX) { char TA; char UL; @@ -29,7 +29,7 @@ void cblas_ztrsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, #define F77_lda lda #define F77_incX incX #endif - int n, i=0, tincX; + CBLAS_INT n, i=0, tincX; double *st=0,*x=(double *)X; extern int CBLAS_CallFromC; extern int RowMajorStrg; @@ -42,7 +42,7 @@ void cblas_ztrsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'L'; else { - cblas_xerbla(2, "cblas_ztrsv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_ztrsv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -52,7 +52,7 @@ void cblas_ztrsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (TransA == CblasConjTrans) TA = 'C'; else { - cblas_xerbla(3, "cblas_ztrsv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_ztrsv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -61,7 +61,7 @@ void cblas_ztrsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_ztrsv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_ztrsv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -81,7 +81,7 @@ void cblas_ztrsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Uplo == CblasLower) UL = 'U'; else { - cblas_xerbla(2, "cblas_ztrsv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_ztrsv","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -114,7 +114,7 @@ void cblas_ztrsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, } else { - cblas_xerbla(3, "cblas_ztrsv","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_ztrsv","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -124,7 +124,7 @@ void cblas_ztrsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - cblas_xerbla(4, "cblas_ztrsv","Illegal Diag setting, %d\n", Diag); + API_SUFFIX(cblas_xerbla)(4, "cblas_ztrsv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -149,7 +149,7 @@ void cblas_ztrsv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, } } } - else cblas_xerbla(1, "cblas_ztrsv", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_ztrsv", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cdotcsub.f b/CBLAS/src/cdotcsub.f index f97d7159ee..1141e9582e 100644 --- a/CBLAS/src/cdotcsub.f +++ b/CBLAS/src/cdotcsub.f @@ -4,6 +4,7 @@ c Witten by Keita Teranishi. 2/11/1998 c subroutine cdotcsub(n,x,incx,y,incy,dotc) + implicit none c external cdotc complex cdotc,dotc diff --git a/CBLAS/src/cdotusub.f b/CBLAS/src/cdotusub.f index 5107c0402b..f7168c22d9 100644 --- a/CBLAS/src/cdotusub.f +++ b/CBLAS/src/cdotusub.f @@ -4,6 +4,7 @@ c Witten by Keita Teranishi. 2/11/1998 c subroutine cdotusub(n,x,incx,y,incy,dotu) + implicit none c external cdotu complex cdotu,dotu diff --git a/CBLAS/src/dasumsub.f b/CBLAS/src/dasumsub.f index 3d64d17e67..9a8f3648a6 100644 --- a/CBLAS/src/dasumsub.f +++ b/CBLAS/src/dasumsub.f @@ -4,6 +4,7 @@ c Witten by Keita Teranishi. 2/11/1998 c subroutine dasumsub(n,x,incx,asum) + implicit none c external dasum double precision dasum,asum diff --git a/CBLAS/src/dcabs1sub.f b/CBLAS/src/dcabs1sub.f new file mode 100644 index 0000000000..5b71052dc6 --- /dev/null +++ b/CBLAS/src/dcabs1sub.f @@ -0,0 +1,14 @@ +c dcabs1.f +c +c The program is a fortran wrapper for dcabs1. +c + subroutine dcabs1sub(z, cabs1) + implicit none +c + external dcabs1 + double complex z + double precision dcabs1, cabs1 +c + cabs1=dcabs1(z) + return + end diff --git a/CBLAS/src/ddotsub.f b/CBLAS/src/ddotsub.f index 205f3b46f0..911a49e6d3 100644 --- a/CBLAS/src/ddotsub.f +++ b/CBLAS/src/ddotsub.f @@ -4,6 +4,7 @@ c Witten by Keita Teranishi. 2/11/1998 c subroutine ddotsub(n,x,incx,y,incy,dot) + implicit none c external ddot double precision ddot diff --git a/CBLAS/src/dnrm2sub.f b/CBLAS/src/dnrm2sub.f index 88f17db8bc..40beababa0 100644 --- a/CBLAS/src/dnrm2sub.f +++ b/CBLAS/src/dnrm2sub.f @@ -4,6 +4,7 @@ c Witten by Keita Teranishi. 2/11/1998 c subroutine dnrm2sub(n,x,incx,nrm2) + implicit none c external dnrm2 double precision dnrm2,nrm2 diff --git a/CBLAS/src/dsdotsub.f b/CBLAS/src/dsdotsub.f index ef53b881a2..0a5936a8de 100644 --- a/CBLAS/src/dsdotsub.f +++ b/CBLAS/src/dsdotsub.f @@ -4,6 +4,7 @@ c Witten by Keita Teranishi. 2/11/1998 c subroutine dsdotsub(n,x,incx,y,incy,dot) + implicit none c external dsdot double precision dsdot,dot diff --git a/CBLAS/src/dzasumsub.f b/CBLAS/src/dzasumsub.f index 9aaf163872..486b54dd25 100644 --- a/CBLAS/src/dzasumsub.f +++ b/CBLAS/src/dzasumsub.f @@ -4,6 +4,7 @@ c Witten by Keita Teranishi. 2/11/1998 c subroutine dzasumsub(n,x,incx,asum) + implicit none c external dzasum double precision dzasum,asum diff --git a/CBLAS/src/dznrm2sub.f b/CBLAS/src/dznrm2sub.f index 45dc599f81..c2b8128180 100644 --- a/CBLAS/src/dznrm2sub.f +++ b/CBLAS/src/dznrm2sub.f @@ -4,6 +4,7 @@ c Witten by Keita Teranishi. 2/11/1998 c subroutine dznrm2sub(n,x,incx,nrm2) + implicit none c external dznrm2 double precision dznrm2,nrm2 diff --git a/CBLAS/src/icamaxsub.f b/CBLAS/src/icamaxsub.f index 3f47071eb5..107f50d265 100644 --- a/CBLAS/src/icamaxsub.f +++ b/CBLAS/src/icamaxsub.f @@ -4,6 +4,7 @@ c Witten by Keita Teranishi. 2/11/1998 c subroutine icamaxsub(n,x,incx,iamax) + implicit none c external icamax integer icamax,iamax diff --git a/CBLAS/src/idamaxsub.f b/CBLAS/src/idamaxsub.f index 3c1ee5c325..39738e1a5e 100644 --- a/CBLAS/src/idamaxsub.f +++ b/CBLAS/src/idamaxsub.f @@ -4,6 +4,7 @@ c Witten by Keita Teranishi. 2/22/1998 c subroutine idamaxsub(n,x,incx,iamax) + implicit none c external idamax integer idamax,iamax diff --git a/CBLAS/src/isamaxsub.f b/CBLAS/src/isamaxsub.f index 0faf42fde1..345fb77431 100644 --- a/CBLAS/src/isamaxsub.f +++ b/CBLAS/src/isamaxsub.f @@ -4,6 +4,7 @@ c Witten by Keita Teranishi. 2/11/1998 c subroutine isamaxsub(n,x,incx,iamax) + implicit none c external isamax integer isamax,iamax diff --git a/CBLAS/src/izamaxsub.f b/CBLAS/src/izamaxsub.f index 5b15855a7f..a96fa57af9 100644 --- a/CBLAS/src/izamaxsub.f +++ b/CBLAS/src/izamaxsub.f @@ -4,6 +4,7 @@ c Witten by Keita Teranishi. 2/11/1998 c subroutine izamaxsub(n,x,incx,iamax) + implicit none c external izamax integer izamax,iamax diff --git a/CBLAS/src/sasumsub.f b/CBLAS/src/sasumsub.f index 955f11e8dc..f8ffdc5c8a 100644 --- a/CBLAS/src/sasumsub.f +++ b/CBLAS/src/sasumsub.f @@ -4,6 +4,7 @@ c Witten by Keita Teranishi. 2/11/1998 c subroutine sasumsub(n,x,incx,asum) + implicit none c external sasum real sasum,asum diff --git a/CBLAS/src/scabs1sub.f b/CBLAS/src/scabs1sub.f new file mode 100644 index 0000000000..07c91d0b5c --- /dev/null +++ b/CBLAS/src/scabs1sub.f @@ -0,0 +1,14 @@ +c scabs1.f +c +c The program is a fortran wrapper for scabs1. +c + subroutine scabs1sub(z, cabs1) + implicit none +c + external scabs1 + complex z + real scabs1, cabs1 +c + cabs1=scabs1(z) + return + end diff --git a/CBLAS/src/scasumsub.f b/CBLAS/src/scasumsub.f index 077ace6703..c7de3bc19a 100644 --- a/CBLAS/src/scasumsub.f +++ b/CBLAS/src/scasumsub.f @@ -4,6 +4,7 @@ c Witten by Keita Teranishi. 2/11/1998 c subroutine scasumsub(n,x,incx,asum) + implicit none c external scasum real scasum,asum diff --git a/CBLAS/src/scnrm2sub.f b/CBLAS/src/scnrm2sub.f index 7242c9742d..59999ecd23 100644 --- a/CBLAS/src/scnrm2sub.f +++ b/CBLAS/src/scnrm2sub.f @@ -4,6 +4,7 @@ c Witten by Keita Teranishi. 2/11/1998 c subroutine scnrm2sub(n,x,incx,nrm2) + implicit none c external scnrm2 real scnrm2,nrm2 diff --git a/CBLAS/src/sdotsub.f b/CBLAS/src/sdotsub.f index 33fa89a9f1..c17d140699 100644 --- a/CBLAS/src/sdotsub.f +++ b/CBLAS/src/sdotsub.f @@ -4,6 +4,7 @@ c Witten by Keita Teranishi. 2/11/1998 c subroutine sdotsub(n,x,incx,y,incy,dot) + implicit none c external sdot real sdot diff --git a/CBLAS/src/sdsdotsub.f b/CBLAS/src/sdsdotsub.f index c6b8bb2e5a..9384609c69 100644 --- a/CBLAS/src/sdsdotsub.f +++ b/CBLAS/src/sdsdotsub.f @@ -4,6 +4,7 @@ c Witten by Keita Teranishi. 2/11/1998 c subroutine sdsdotsub(n,sb,x,incx,y,incy,dot) + implicit none c external sdsdot real sb,sdsdot,dot diff --git a/CBLAS/src/snrm2sub.f b/CBLAS/src/snrm2sub.f index 871a6e49f4..7fa737c338 100644 --- a/CBLAS/src/snrm2sub.f +++ b/CBLAS/src/snrm2sub.f @@ -4,6 +4,7 @@ c Witten by Keita Teranishi. 2/11/1998 c subroutine snrm2sub(n,x,incx,nrm2) + implicit none c external snrm2 real snrm2,nrm2 diff --git a/CBLAS/src/xerbla.c b/CBLAS/src/xerbla.c index 3d8c6a69e4..197b2bd863 100644 --- a/CBLAS/src/xerbla.c +++ b/CBLAS/src/xerbla.c @@ -1,42 +1,60 @@ #include -#include + #include "cblas.h" #include "cblas_f77.h" - -#define XerblaStrLen 6 -#define XerblaStrLen1 7 - -#ifdef F77_CHAR -void F77_xerbla(F77_CHAR F77_srname, void *vinfo) -#else -void F77_xerbla(char *srname, void *vinfo) +#include "cblas_xerbla_internal.h" + +/** + * \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 #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 BLAS_FORTRAN_STRLEN_END + const size_t srname_len = len > 0 ? (size_t)len : 0; +#else + const size_t srname_len = 6; +#endif + #ifdef F77_CHAR - srname = F2C_STR(F77_srname, XerblaStrLen); + const char *srname = F2C_STR(F77_srname, srname_len); +#else + const char *srname = F77_srname; #endif - if (CBLAS_CallFromC) - { - for(i=0; i != XerblaStrLen; i++) rout[i+6] = tolower(srname[i]); - rout[XerblaStrLen+6] = '\0'; - cblas_xerbla(*info+1,rout,""); - } - else - { - fprintf(stderr, "Parameter %d to routine %s was incorrect\n", - *info, srname); + 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/src/zdotcsub.f b/CBLAS/src/zdotcsub.f index 8d483c895b..0298654ea5 100644 --- a/CBLAS/src/zdotcsub.f +++ b/CBLAS/src/zdotcsub.f @@ -4,6 +4,7 @@ c Witten by Keita Teranishi. 2/11/1998 c subroutine zdotcsub(n,x,incx,y,incy,dotc) + implicit none c external zdotc double complex zdotc,dotc diff --git a/CBLAS/src/zdotusub.f b/CBLAS/src/zdotusub.f index 23f32dec3f..8482905ac4 100644 --- a/CBLAS/src/zdotusub.f +++ b/CBLAS/src/zdotusub.f @@ -4,6 +4,7 @@ c Witten by Keita Teranishi. 2/11/1998 c subroutine zdotusub(n,x,incx,y,incy,dotu) + implicit none c external zdotu double complex zdotu,dotu diff --git a/CBLAS/testing/CMakeLists.txt b/CBLAS/testing/CMakeLists.txt index 2459695b80..d18c193db7 100644 --- a/CBLAS/testing/CMakeLists.txt +++ b/CBLAS/testing/CMakeLists.txt @@ -3,12 +3,14 @@ # ####################################################################### -macro(add_cblas_test output input target) - set(TEST_INPUT "${CMAKE_CURRENT_SOURCE_DIR}/${input}") +function(add_cblas_ctest output input target) + if(NOT "${input}" STREQUAL "") + set(TEST_INPUT "${CMAKE_CURRENT_SOURCE_DIR}/${input}") + endif() set(TEST_OUTPUT "${CMAKE_CURRENT_BINARY_DIR}/${output}") set(testName "${target}") - if(EXISTS "${TEST_INPUT}") + if(DEFINED TEST_INPUT AND EXISTS "${TEST_INPUT}") add_test(NAME CBLAS-${testName} COMMAND "${CMAKE_COMMAND}" -DTEST=$ -DINPUT=${TEST_INPUT} @@ -22,8 +24,47 @@ macro(add_cblas_test output input target) -DINTDIR=${CMAKE_CFG_INTDIR} -P "${LAPACK_SOURCE_DIR}/TESTING/runtest.cmake") endif() -endmacro() +endfunction() + +function(add_cblas_test_target target) + add_executable(${target} ${ARGN}) + lapack_add_coverage(${target}) + + if(HAS_ATTRIBUTE_WEAK_SUPPORT) + target_compile_definitions(${target} PRIVATE HAS_ATTRIBUTE_WEAK_SUPPORT) + endif() + + if(WIN32 AND BUILD_SHARED_LIBS) + target_compile_definitions(${target} PRIVATE CBLAS_DLL_IMPORTS) + endif() + target_link_libraries(${target} PRIVATE ${CBLASLIB}) +endfunction() + +function(add_cblas_test target output input f_source) + set(c_sources ${ARGN}) + + if(BUILD_DEFAULT_API) + add_cblas_test_target(${target} ${f_source} ${c_sources}) + add_cblas_ctest(${output} "${input}" ${target}) + endif() + + if(BUILD_INDEX64_EXT_API) + include(ExtendedAPIHelpers) + generate_64bit_suffixed_sources(${target} f_source f_source_64) + + add_cblas_test_target(${target}_64 ${f_source_64} ${c_sources}) + target_compile_definitions(${target}_64 PRIVATE + "$<$:WeirdNEC>" "$<$:CBLAS_API64>") + target_compile_options(${target}_64 PRIVATE + "$<$:${FOPT_ILP64}>") + + get_filename_component(output_name "${output}" NAME_WLE) + get_filename_component(output_ext "${output}" EXT) + set(output_64 "${output_name}_64${output_ext}") + add_cblas_ctest(${output_64} "${input}" ${target}_64) + endif() +endfunction() # Object files for single precision real set(STESTL1O c_sblas1.c) @@ -36,7 +77,7 @@ set(DTESTL2O c_dblas2.c c_d2chke.c auxiliary.c c_xerbla.c) set(DTESTL3O c_dblas3.c c_d3chke.c auxiliary.c c_xerbla.c) # Object files for single precision complex -set(CTESTL1O c_cblat1.f c_cblas1.c) +set(CTESTL1O c_cblas1.c) set(CTESTL2O c_cblas2.c c_c2chke.c auxiliary.c c_xerbla.c) set(CTESTL3O c_cblas3.c c_c3chke.c auxiliary.c c_xerbla.c) @@ -45,60 +86,26 @@ set(ZTESTL1O c_zblas1.c) set(ZTESTL2O c_zblas2.c c_z2chke.c auxiliary.c c_xerbla.c) set(ZTESTL3O c_zblas3.c c_z3chke.c auxiliary.c c_xerbla.c) - - if(BUILD_SINGLE) - add_executable(xscblat1 c_sblat1.f ${STESTL1O} ${LAPACK_BINARY_DIR}/include/cblas_test.h) - add_executable(xscblat2 c_sblat2.f ${STESTL2O} ${LAPACK_BINARY_DIR}/include/cblas_test.h) - add_executable(xscblat3 c_sblat3.f ${STESTL3O} ${LAPACK_BINARY_DIR}/include/cblas_test.h) - - target_link_libraries(xscblat1 cblas) - target_link_libraries(xscblat2 cblas) - target_link_libraries(xscblat3 cblas) - - add_cblas_test(stest1.out "" xscblat1) - add_cblas_test(stest2.out sin2 xscblat2) - add_cblas_test(stest3.out sin3 xscblat3) + add_cblas_test(xscblat1 stest1.out "" c_sblat1.f ${STESTL1O}) + add_cblas_test(xscblat2 stest2.out sin2 c_sblat2.f ${STESTL2O}) + add_cblas_test(xscblat3 stest3.out sin3 c_sblat3.f ${STESTL3O}) endif() if(BUILD_DOUBLE) - add_executable(xdcblat1 c_dblat1.f ${DTESTL1O} ${LAPACK_BINARY_DIR}/include/cblas_test.h) - add_executable(xdcblat2 c_dblat2.f ${DTESTL2O} ${LAPACK_BINARY_DIR}/include/cblas_test.h) - add_executable(xdcblat3 c_dblat3.f ${DTESTL3O} ${LAPACK_BINARY_DIR}/include/cblas_test.h) - - target_link_libraries(xdcblat1 cblas) - target_link_libraries(xdcblat2 cblas) - target_link_libraries(xdcblat3 cblas) - - add_cblas_test(dtest1.out "" xdcblat1) - add_cblas_test(dtest2.out din2 xdcblat2) - add_cblas_test(dtest3.out din3 xdcblat3) + add_cblas_test(xdcblat1 dtest1.out "" c_dblat1.f ${DTESTL1O}) + add_cblas_test(xdcblat2 dtest2.out din2 c_dblat2.f ${DTESTL2O}) + add_cblas_test(xdcblat3 dtest3.out din3 c_dblat3.f ${DTESTL3O}) endif() if(BUILD_COMPLEX) - add_executable(xccblat1 c_cblat1.f ${CTESTL1O} ${LAPACK_BINARY_DIR}/include/cblas_test.h) - add_executable(xccblat2 c_cblat2.f ${CTESTL2O} ${LAPACK_BINARY_DIR}/include/cblas_test.h) - add_executable(xccblat3 c_cblat3.f ${CTESTL3O} ${LAPACK_BINARY_DIR}/include/cblas_test.h) - - target_link_libraries(xccblat1 cblas ${BLAS_LIBRARIES}) - target_link_libraries(xccblat2 cblas) - target_link_libraries(xccblat3 cblas) - - add_cblas_test(ctest1.out "" xccblat1) - add_cblas_test(ctest2.out cin2 xccblat2) - add_cblas_test(ctest3.out cin3 xccblat3) + add_cblas_test(xccblat1 ctest1.out "" c_cblat1.f ${CTESTL1O}) + add_cblas_test(xccblat2 ctest2.out cin2 c_cblat2.f ${CTESTL2O}) + add_cblas_test(xccblat3 ctest3.out cin3 c_cblat3.f ${CTESTL3O}) endif() if(BUILD_COMPLEX16) - add_executable(xzcblat1 c_zblat1.f ${ZTESTL1O} ${LAPACK_BINARY_DIR}/include/cblas_test.h) - add_executable(xzcblat2 c_zblat2.f ${ZTESTL2O} ${LAPACK_BINARY_DIR}/include/cblas_test.h) - add_executable(xzcblat3 c_zblat3.f ${ZTESTL3O} ${LAPACK_BINARY_DIR}/include/cblas_test.h) - - target_link_libraries(xzcblat1 cblas) - target_link_libraries(xzcblat2 cblas) - target_link_libraries(xzcblat3 cblas) - - add_cblas_test(ztest1.out "" xzcblat1) - add_cblas_test(ztest2.out zin2 xzcblat2) - add_cblas_test(ztest3.out zin3 xzcblat3) + add_cblas_test(xzcblat1 ztest1.out "" c_zblat1.f ${ZTESTL1O}) + add_cblas_test(xzcblat2 ztest2.out zin2 c_zblat2.f ${ZTESTL2O}) + add_cblas_test(xzcblat3 ztest3.out zin3 c_zblat3.f ${ZTESTL3O}) endif() diff --git a/CBLAS/testing/Makefile b/CBLAS/testing/Makefile index 0182c3e881..e3b615b416 100644 --- a/CBLAS/testing/Makefile +++ b/CBLAS/testing/Makefile @@ -2,7 +2,12 @@ # The Makefile compiles c wrappers and testers for CBLAS. # -include ../../make.inc +TOPSRCDIR = ../.. +include $(TOPSRCDIR)/make.inc + +.SUFFIXES: .c .o +.c.o: + $(CC) $(CFLAGS) -I../include -c -o $@ $< # Archive files necessary to compile LIB = $(CBLASLIB) $(BLASLIB) @@ -27,6 +32,7 @@ ztestl1o = c_zblas1.o ztestl2o = c_zblas2.o c_z2chke.o auxiliary.o c_xerbla.o ztestl3o = c_zblas3.o c_z3chke.o auxiliary.o c_xerbla.o +.PHONY: all all1 all2 all3 all: all1 all2 all3 all1: xscblat1 xdcblat1 xccblat1 xzcblat1 all2: xscblat2 xdcblat2 xccblat2 xzcblat2 @@ -38,37 +44,38 @@ all3: xscblat3 xdcblat3 xccblat3 xzcblat3 # Single real xscblat1: c_sblat1.o $(stestl1o) $(LIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xscblat2: c_sblat2.o $(stestl2o) $(LIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xscblat3: c_sblat3.o $(stestl3o) $(LIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ # Double real xdcblat1: c_dblat1.o $(dtestl1o) $(LIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xdcblat2: c_dblat2.o $(dtestl2o) $(LIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xdcblat3: c_dblat3.o $(dtestl3o) $(LIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ # Single complex xccblat1: c_cblat1.o $(ctestl1o) $(LIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xccblat2: c_cblat2.o $(ctestl2o) $(LIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xccblat3: c_cblat3.o $(ctestl3o) $(LIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ # Double complex xzcblat1: c_zblat1.o $(ztestl1o) $(LIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xzcblat2: c_zblat2.o $(ztestl2o) $(LIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xzcblat3: c_zblat3.o $(ztestl3o) $(LIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ # RUN TESTS +.PHONY: run run: all @echo "--> TESTING CBLAS 1 - SINGLE PRECISION REAL <--" @./xscblat1 > stest1.out @@ -95,6 +102,7 @@ run: all @echo "--> TESTING CBLAS 3 - DOUBLE PRECISION COMPLEX <--" @./xzcblat3 < zin3 > ztest3.out +.PHONY: clean cleanobj cleanexe cleantest clean: cleanobj cleanexe cleantest cleanobj: rm -f *.o @@ -102,9 +110,3 @@ cleanexe: rm -f x* cleantest: rm -f *.out core - -.SUFFIXES: .o .f .c -.c.o: - $(CC) $(CFLAGS) -I../include -c -o $@ $< -.f.o: - $(FORTRAN) $(OPTS) -c -o $@ $< diff --git a/CBLAS/testing/auxiliary.c b/CBLAS/testing/auxiliary.c index 4449b33d3b..b57ebccc75 100644 --- a/CBLAS/testing/auxiliary.c +++ b/CBLAS/testing/auxiliary.c @@ -12,7 +12,7 @@ void get_transpose_type(char *type, CBLAS_TRANSPOSE *trans) { *trans = CblasTrans; else if( (strncmp( type,"c",1 )==0)||(strncmp( type,"C",1 )==0) ) *trans = CblasConjTrans; - else *trans = UNDEFINED; + else *trans = INVALID_TRANSPOSE; } void get_uplo_type(char *type, CBLAS_UPLO *uplo) { @@ -20,19 +20,19 @@ void get_uplo_type(char *type, CBLAS_UPLO *uplo) { *uplo = CblasUpper; else if( (strncmp( type,"l",1 )==0)||(strncmp( type,"L",1 )==0) ) *uplo = CblasLower; - else *uplo = UNDEFINED; + else *uplo = INVALID_UPLO; } void get_diag_type(char *type, CBLAS_DIAG *diag) { if( (strncmp( type,"u",1 )==0)||(strncmp( type,"U",1 )==0) ) *diag = CblasUnit; else if( (strncmp( type,"n",1 )==0)||(strncmp( type,"N",1 )==0) ) *diag = CblasNonUnit; - else *diag = UNDEFINED; + else *diag = INVALID_DIAG; } void get_side_type(char *type, CBLAS_SIDE *side) { if( (strncmp( type,"l",1 )==0)||(strncmp( type,"L",1 )==0) ) *side = CblasLeft; else if( (strncmp( type,"r",1 )==0)||(strncmp( type,"R",1 )==0) ) *side = CblasRight; - else *side = UNDEFINED; + else *side = INVALID_SIDE; } diff --git a/CBLAS/testing/c_c2chke.c b/CBLAS/testing/c_c2chke.c index 28b771980b..3a36512643 100644 --- a/CBLAS/testing/c_c2chke.c +++ b/CBLAS/testing/c_c2chke.c @@ -3,28 +3,43 @@ #include "cblas.h" #include "cblas_test.h" -int cblas_ok, cblas_lerr, cblas_info; -int link_xerbla=TRUE; +CBLAS_INT cblas_ok, cblas_lerr, cblas_info; +CBLAS_INT link_xerbla=TRUE; +CBLAS_INT cblas_xtests, cblas_xfails, cblas_xbad; char *cblas_rout; #ifdef F77_Char -void F77_xerbla(F77_Char F77_srname, void *vinfo); +void F77_xerbla(F77_Char F77_srname, void *vinfo #else -void F77_xerbla(char *srname, void *vinfo); +void F77_xerbla(char *srname, void *vinfo #endif +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN srname_len +#endif +); void chkxer(void) { - extern int cblas_ok, cblas_lerr, cblas_info; - extern int link_xerbla; + extern CBLAS_INT cblas_ok, cblas_lerr, cblas_info; + extern CBLAS_INT link_xerbla; + extern CBLAS_INT cblas_xtests, cblas_xfails, cblas_xbad; extern char *cblas_rout; + cblas_xtests++; if (cblas_lerr == 1 ) { - printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", 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) { + cblas_xfails++; } + cblas_xbad = 0; cblas_lerr = 1 ; } -void F77_c2chke(char *rout) { +void F77_c2chke(char *rout +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN rout_len +#endif +) { char *sf = ( rout ) ; float A[2] = {0.0,0.0}, X[2] = {0.0,0.0}, @@ -32,795 +47,808 @@ void F77_c2chke(char *rout) { ALPHA[2] = {0.0,0.0}, BETA[2] = {0.0,0.0}, RALPHA = 0.0; - extern int cblas_info, cblas_lerr, cblas_ok; - extern int RowMajorStrg; + extern CBLAS_INT cblas_info, cblas_lerr, cblas_ok; extern char *cblas_rout; +#ifndef HAS_ATTRIBUTE_WEAK_SUPPORT + #ifdef CBLAS_DLL_IMPORTS + // Since Windows does not support weak symbols, and the trick below doesn't + // work for shared libraries on Windows, we skip the xerbla tests here. + printf("***** WARNING: Skipping xerbla tests since weak symbols are not supported on Windows *****\n"); + return; + #endif + if (link_xerbla) /* call these first to link */ { - cblas_xerbla(cblas_info,cblas_rout,""); - F77_xerbla(cblas_rout,&cblas_info); + API_SUFFIX(cblas_xerbla)(cblas_info,cblas_rout,""); + F77_xerbla(cblas_rout,&cblas_info, 1); } - +#endif + link_xerbla = 0; cblas_ok = TRUE ; cblas_lerr = PASSED ; + cblas_xtests = 0; + cblas_xfails = 0; + cblas_xbad = 0; if (strncmp( sf,"cblas_cgemv",11)==0) { cblas_rout = "cblas_cgemv"; cblas_info = 1; - cblas_cgemv(INVALID, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_cgemv)(INVALID_LAYOUT, CblasNoTrans, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_cgemv(CblasColMajor, INVALID, 0, 0, + API_SUFFIX(cblas_cgemv)(CblasColMajor, INVALID_TRANSPOSE, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_cgemv(CblasColMajor, CblasNoTrans, INVALID, 0, + API_SUFFIX(cblas_cgemv)(CblasColMajor, CblasNoTrans, INVALID, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_cgemv(CblasColMajor, CblasNoTrans, 0, INVALID, + API_SUFFIX(cblas_cgemv)(CblasColMajor, CblasNoTrans, 0, INVALID, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_cgemv(CblasColMajor, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_cgemv)(CblasColMajor, CblasNoTrans, 2, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_cgemv(CblasColMajor, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_cgemv)(CblasColMajor, CblasNoTrans, 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_cgemv(CblasColMajor, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_cgemv)(CblasColMajor, CblasNoTrans, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; RowMajorStrg = TRUE; - cblas_cgemv(CblasRowMajor, INVALID, 0, 0, + API_SUFFIX(cblas_cgemv)(CblasRowMajor, INVALID_TRANSPOSE, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_cgemv(CblasRowMajor, CblasNoTrans, INVALID, 0, + API_SUFFIX(cblas_cgemv)(CblasRowMajor, CblasNoTrans, INVALID, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_cgemv(CblasRowMajor, CblasNoTrans, 0, INVALID, + API_SUFFIX(cblas_cgemv)(CblasRowMajor, CblasNoTrans, 0, INVALID, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_cgemv(CblasRowMajor, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_cgemv)(CblasRowMajor, CblasNoTrans, 0, 2, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = TRUE; - cblas_cgemv(CblasRowMajor, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_cgemv)(CblasRowMajor, CblasNoTrans, 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_cgemv(CblasRowMajor, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_cgemv)(CblasRowMajor, CblasNoTrans, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ); chkxer(); } else if (strncmp( sf,"cblas_cgbmv",11)==0) { cblas_rout = "cblas_cgbmv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_cgbmv(INVALID, CblasNoTrans, 0, 0, 0, 0, + API_SUFFIX(cblas_cgbmv)(INVALID_LAYOUT, CblasNoTrans, 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_cgbmv(CblasColMajor, INVALID, 0, 0, 0, 0, + API_SUFFIX(cblas_cgbmv)(CblasColMajor, INVALID_TRANSPOSE, 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_cgbmv(CblasColMajor, CblasNoTrans, INVALID, 0, 0, 0, + API_SUFFIX(cblas_cgbmv)(CblasColMajor, CblasNoTrans, INVALID, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_cgbmv(CblasColMajor, CblasNoTrans, 0, INVALID, 0, 0, + API_SUFFIX(cblas_cgbmv)(CblasColMajor, CblasNoTrans, 0, INVALID, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_cgbmv(CblasColMajor, CblasNoTrans, 0, 0, INVALID, 0, + API_SUFFIX(cblas_cgbmv)(CblasColMajor, CblasNoTrans, 0, 0, INVALID, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_cgbmv(CblasColMajor, CblasNoTrans, 2, 0, 0, INVALID, + API_SUFFIX(cblas_cgbmv)(CblasColMajor, CblasNoTrans, 2, 0, 0, INVALID, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_cgbmv(CblasColMajor, CblasNoTrans, 0, 0, 1, 0, + API_SUFFIX(cblas_cgbmv)(CblasColMajor, CblasNoTrans, 0, 0, 1, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_cgbmv(CblasColMajor, CblasNoTrans, 0, 0, 0, 0, + API_SUFFIX(cblas_cgbmv)(CblasColMajor, CblasNoTrans, 0, 0, 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = FALSE; - cblas_cgbmv(CblasColMajor, CblasNoTrans, 0, 0, 0, 0, + API_SUFFIX(cblas_cgbmv)(CblasColMajor, CblasNoTrans, 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_cgbmv(CblasRowMajor, INVALID, 0, 0, 0, 0, + API_SUFFIX(cblas_cgbmv)(CblasRowMajor, INVALID_TRANSPOSE, 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_cgbmv(CblasRowMajor, CblasNoTrans, INVALID, 0, 0, 0, + API_SUFFIX(cblas_cgbmv)(CblasRowMajor, CblasNoTrans, INVALID, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_cgbmv(CblasRowMajor, CblasNoTrans, 0, INVALID, 0, 0, + API_SUFFIX(cblas_cgbmv)(CblasRowMajor, CblasNoTrans, 0, INVALID, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_cgbmv(CblasRowMajor, CblasNoTrans, 0, 0, INVALID, 0, + API_SUFFIX(cblas_cgbmv)(CblasRowMajor, CblasNoTrans, 0, 0, INVALID, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_cgbmv(CblasRowMajor, CblasNoTrans, 2, 0, 0, INVALID, + API_SUFFIX(cblas_cgbmv)(CblasRowMajor, CblasNoTrans, 2, 0, 0, INVALID, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = TRUE; - cblas_cgbmv(CblasRowMajor, CblasNoTrans, 0, 0, 1, 0, + API_SUFFIX(cblas_cgbmv)(CblasRowMajor, CblasNoTrans, 0, 0, 1, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_cgbmv(CblasRowMajor, CblasNoTrans, 0, 0, 0, 0, + API_SUFFIX(cblas_cgbmv)(CblasRowMajor, CblasNoTrans, 0, 0, 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = TRUE; - cblas_cgbmv(CblasRowMajor, CblasNoTrans, 0, 0, 0, 0, + API_SUFFIX(cblas_cgbmv)(CblasRowMajor, CblasNoTrans, 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ); chkxer(); } else if (strncmp( sf,"cblas_chemv",11)==0) { cblas_rout = "cblas_chemv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_chemv(INVALID, CblasUpper, 0, + API_SUFFIX(cblas_chemv)(INVALID_LAYOUT, CblasUpper, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_chemv(CblasColMajor, INVALID, 0, + API_SUFFIX(cblas_chemv)(CblasColMajor, INVALID_UPLO, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_chemv(CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_chemv)(CblasColMajor, CblasUpper, INVALID, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_chemv(CblasColMajor, CblasUpper, 2, + API_SUFFIX(cblas_chemv)(CblasColMajor, CblasUpper, 2, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_chemv(CblasColMajor, CblasUpper, 0, + API_SUFFIX(cblas_chemv)(CblasColMajor, CblasUpper, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_chemv(CblasColMajor, CblasUpper, 0, + API_SUFFIX(cblas_chemv)(CblasColMajor, CblasUpper, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_chemv(CblasRowMajor, INVALID, 0, + API_SUFFIX(cblas_chemv)(CblasRowMajor, INVALID_UPLO, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_chemv(CblasRowMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_chemv)(CblasRowMajor, CblasUpper, INVALID, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_chemv(CblasRowMajor, CblasUpper, 2, + API_SUFFIX(cblas_chemv)(CblasRowMajor, CblasUpper, 2, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_chemv(CblasRowMajor, CblasUpper, 0, + API_SUFFIX(cblas_chemv)(CblasRowMajor, CblasUpper, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_chemv(CblasRowMajor, CblasUpper, 0, + API_SUFFIX(cblas_chemv)(CblasRowMajor, CblasUpper, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ); chkxer(); } else if (strncmp( sf,"cblas_chbmv",11)==0) { cblas_rout = "cblas_chbmv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_chbmv(INVALID, CblasUpper, 0, 0, + API_SUFFIX(cblas_chbmv)(INVALID_LAYOUT, CblasUpper, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_chbmv(CblasColMajor, INVALID, 0, 0, + API_SUFFIX(cblas_chbmv)(CblasColMajor, INVALID_UPLO, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_chbmv(CblasColMajor, CblasUpper, INVALID, 0, + API_SUFFIX(cblas_chbmv)(CblasColMajor, CblasUpper, INVALID, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_chbmv(CblasColMajor, CblasUpper, 0, INVALID, + API_SUFFIX(cblas_chbmv)(CblasColMajor, CblasUpper, 0, INVALID, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_chbmv(CblasColMajor, CblasUpper, 0, 1, + API_SUFFIX(cblas_chbmv)(CblasColMajor, CblasUpper, 0, 1, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_chbmv(CblasColMajor, CblasUpper, 0, 0, + API_SUFFIX(cblas_chbmv)(CblasColMajor, CblasUpper, 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_chbmv(CblasColMajor, CblasUpper, 0, 0, + API_SUFFIX(cblas_chbmv)(CblasColMajor, CblasUpper, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_chbmv(CblasRowMajor, INVALID, 0, 0, + API_SUFFIX(cblas_chbmv)(CblasRowMajor, INVALID_UPLO, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_chbmv(CblasRowMajor, CblasUpper, INVALID, 0, + API_SUFFIX(cblas_chbmv)(CblasRowMajor, CblasUpper, INVALID, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_chbmv(CblasRowMajor, CblasUpper, 0, INVALID, + API_SUFFIX(cblas_chbmv)(CblasRowMajor, CblasUpper, 0, INVALID, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_chbmv(CblasRowMajor, CblasUpper, 0, 1, + API_SUFFIX(cblas_chbmv)(CblasRowMajor, CblasUpper, 0, 1, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = TRUE; - cblas_chbmv(CblasRowMajor, CblasUpper, 0, 0, + API_SUFFIX(cblas_chbmv)(CblasRowMajor, CblasUpper, 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_chbmv(CblasRowMajor, CblasUpper, 0, 0, + API_SUFFIX(cblas_chbmv)(CblasRowMajor, CblasUpper, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ); chkxer(); } else if (strncmp( sf,"cblas_chpmv",11)==0) { cblas_rout = "cblas_chpmv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_chpmv(INVALID, CblasUpper, 0, + API_SUFFIX(cblas_chpmv)(INVALID_LAYOUT, CblasUpper, 0, ALPHA, A, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_chpmv(CblasColMajor, INVALID, 0, + API_SUFFIX(cblas_chpmv)(CblasColMajor, INVALID_UPLO, 0, ALPHA, A, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_chpmv(CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_chpmv)(CblasColMajor, CblasUpper, INVALID, ALPHA, A, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_chpmv(CblasColMajor, CblasUpper, 0, + API_SUFFIX(cblas_chpmv)(CblasColMajor, CblasUpper, 0, ALPHA, A, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_chpmv(CblasColMajor, CblasUpper, 0, + API_SUFFIX(cblas_chpmv)(CblasColMajor, CblasUpper, 0, ALPHA, A, X, 1, BETA, Y, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_chpmv(CblasRowMajor, INVALID, 0, + API_SUFFIX(cblas_chpmv)(CblasRowMajor, INVALID_UPLO, 0, ALPHA, A, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_chpmv(CblasRowMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_chpmv)(CblasRowMajor, CblasUpper, INVALID, ALPHA, A, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_chpmv(CblasRowMajor, CblasUpper, 0, + API_SUFFIX(cblas_chpmv)(CblasRowMajor, CblasUpper, 0, ALPHA, A, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_chpmv(CblasRowMajor, CblasUpper, 0, + API_SUFFIX(cblas_chpmv)(CblasRowMajor, CblasUpper, 0, ALPHA, A, X, 1, BETA, Y, 0 ); chkxer(); } else if (strncmp( sf,"cblas_ctrmv",11)==0) { cblas_rout = "cblas_ctrmv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_ctrmv(INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrmv)(INVALID_LAYOUT, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_ctrmv(CblasColMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_ctrmv)(CblasColMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_ctrmv(CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_ctrmv)(CblasColMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_ctrmv(CblasColMajor, CblasUpper, CblasNoTrans, - INVALID, 0, A, 1, X, 1 ); + API_SUFFIX(cblas_ctrmv)(CblasColMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, A, 1, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_ctrmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, A, 1, X, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ctrmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 2, A, 1, X, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_ctrmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_ctrmv(CblasRowMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_ctrmv)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_ctrmv(CblasRowMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_ctrmv)(CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_ctrmv(CblasRowMajor, CblasUpper, CblasNoTrans, - INVALID, 0, A, 1, X, 1 ); + API_SUFFIX(cblas_ctrmv)(CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, A, 1, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_ctrmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, A, 1, X, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ctrmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 2, A, 1, X, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = TRUE; - cblas_ctrmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 0 ); chkxer(); } else if (strncmp( sf,"cblas_ctbmv",11)==0) { cblas_rout = "cblas_ctbmv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_ctbmv(INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctbmv)(INVALID_LAYOUT, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_ctbmv(CblasColMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_ctbmv)(CblasColMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_ctbmv(CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_ctbmv)(CblasColMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_ctbmv(CblasColMajor, CblasUpper, CblasNoTrans, - INVALID, 0, 0, A, 1, X, 1 ); + API_SUFFIX(cblas_ctbmv)(CblasColMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_ctbmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctbmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, A, 1, X, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ctbmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctbmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, A, 1, X, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_ctbmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctbmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 1, A, 1, X, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ctbmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctbmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_ctbmv(CblasRowMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_ctbmv)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_ctbmv(CblasRowMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_ctbmv)(CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_ctbmv(CblasRowMajor, CblasUpper, CblasNoTrans, - INVALID, 0, 0, A, 1, X, 1 ); + API_SUFFIX(cblas_ctbmv)(CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_ctbmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctbmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, A, 1, X, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ctbmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctbmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, A, 1, X, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_ctbmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctbmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 1, A, 1, X, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ctbmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctbmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 0 ); chkxer(); } else if (strncmp( sf,"cblas_ctpmv",11)==0) { cblas_rout = "cblas_ctpmv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_ctpmv(INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctpmv)(INVALID_LAYOUT, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_ctpmv(CblasColMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_ctpmv)(CblasColMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_ctpmv(CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_ctpmv)(CblasColMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_ctpmv(CblasColMajor, CblasUpper, CblasNoTrans, - INVALID, 0, A, X, 1 ); + API_SUFFIX(cblas_ctpmv)(CblasColMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, A, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_ctpmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctpmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, A, X, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_ctpmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctpmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, X, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_ctpmv(CblasRowMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_ctpmv)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_ctpmv(CblasRowMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_ctpmv)(CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_ctpmv(CblasRowMajor, CblasUpper, CblasNoTrans, - INVALID, 0, A, X, 1 ); + API_SUFFIX(cblas_ctpmv)(CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, A, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_ctpmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctpmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, A, X, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_ctpmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctpmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, X, 0 ); chkxer(); } else if (strncmp( sf,"cblas_ctrsv",11)==0) { cblas_rout = "cblas_ctrsv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_ctrsv(INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrsv)(INVALID_LAYOUT, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_ctrsv(CblasColMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_ctrsv)(CblasColMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_ctrsv(CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_ctrsv)(CblasColMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_ctrsv(CblasColMajor, CblasUpper, CblasNoTrans, - INVALID, 0, A, 1, X, 1 ); + API_SUFFIX(cblas_ctrsv)(CblasColMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, A, 1, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_ctrsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, A, 1, X, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ctrsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 2, A, 1, X, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_ctrsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_ctrsv(CblasRowMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_ctrsv)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_ctrsv(CblasRowMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_ctrsv)(CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_ctrsv(CblasRowMajor, CblasUpper, CblasNoTrans, - INVALID, 0, A, 1, X, 1 ); + API_SUFFIX(cblas_ctrsv)(CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, A, 1, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_ctrsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, A, 1, X, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ctrsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 2, A, 1, X, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = TRUE; - cblas_ctrsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 0 ); chkxer(); } else if (strncmp( sf,"cblas_ctbsv",11)==0) { cblas_rout = "cblas_ctbsv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_ctbsv(INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctbsv)(INVALID_LAYOUT, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_ctbsv(CblasColMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_ctbsv)(CblasColMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_ctbsv(CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_ctbsv)(CblasColMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_ctbsv(CblasColMajor, CblasUpper, CblasNoTrans, - INVALID, 0, 0, A, 1, X, 1 ); + API_SUFFIX(cblas_ctbsv)(CblasColMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_ctbsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctbsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, A, 1, X, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ctbsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctbsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, A, 1, X, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_ctbsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctbsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 1, A, 1, X, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ctbsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctbsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_ctbsv(CblasRowMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_ctbsv)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_ctbsv(CblasRowMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_ctbsv)(CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_ctbsv(CblasRowMajor, CblasUpper, CblasNoTrans, - INVALID, 0, 0, A, 1, X, 1 ); + API_SUFFIX(cblas_ctbsv)(CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_ctbsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctbsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, A, 1, X, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ctbsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctbsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, A, 1, X, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_ctbsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctbsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 1, A, 1, X, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ctbsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctbsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 0 ); chkxer(); } else if (strncmp( sf,"cblas_ctpsv",11)==0) { cblas_rout = "cblas_ctpsv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_ctpsv(INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctpsv)(INVALID_LAYOUT, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_ctpsv(CblasColMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_ctpsv)(CblasColMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_ctpsv(CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_ctpsv)(CblasColMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_ctpsv(CblasColMajor, CblasUpper, CblasNoTrans, - INVALID, 0, A, X, 1 ); + API_SUFFIX(cblas_ctpsv)(CblasColMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, A, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_ctpsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctpsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, A, X, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_ctpsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctpsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, X, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_ctpsv(CblasRowMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_ctpsv)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_ctpsv(CblasRowMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_ctpsv)(CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_ctpsv(CblasRowMajor, CblasUpper, CblasNoTrans, - INVALID, 0, A, X, 1 ); + API_SUFFIX(cblas_ctpsv)(CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, A, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_ctpsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctpsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, A, X, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_ctpsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctpsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, X, 0 ); chkxer(); } else if (strncmp( sf,"cblas_cgeru",10)==0) { cblas_rout = "cblas_cgeru"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_cgeru(INVALID, 0, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_cgeru)(INVALID_LAYOUT, 0, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_cgeru(CblasColMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_cgeru)(CblasColMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_cgeru(CblasColMajor, 0, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_cgeru)(CblasColMajor, 0, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_cgeru(CblasColMajor, 0, 0, ALPHA, X, 0, Y, 1, A, 1 ); + API_SUFFIX(cblas_cgeru)(CblasColMajor, 0, 0, ALPHA, X, 0, Y, 1, A, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_cgeru(CblasColMajor, 0, 0, ALPHA, X, 1, Y, 0, A, 1 ); + API_SUFFIX(cblas_cgeru)(CblasColMajor, 0, 0, ALPHA, X, 1, Y, 0, A, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_cgeru(CblasColMajor, 2, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_cgeru)(CblasColMajor, 2, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_cgeru(CblasRowMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_cgeru)(CblasRowMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_cgeru(CblasRowMajor, 0, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_cgeru)(CblasRowMajor, 0, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_cgeru(CblasRowMajor, 0, 0, ALPHA, X, 0, Y, 1, A, 1 ); + API_SUFFIX(cblas_cgeru)(CblasRowMajor, 0, 0, ALPHA, X, 0, Y, 1, A, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_cgeru(CblasRowMajor, 0, 0, ALPHA, X, 1, Y, 0, A, 1 ); + API_SUFFIX(cblas_cgeru)(CblasRowMajor, 0, 0, ALPHA, X, 1, Y, 0, A, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_cgeru(CblasRowMajor, 0, 2, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_cgeru)(CblasRowMajor, 0, 2, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); } else if (strncmp( sf,"cblas_cgerc",10)==0) { cblas_rout = "cblas_cgerc"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_cgerc(INVALID, 0, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_cgerc)(INVALID_LAYOUT, 0, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_cgerc(CblasColMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_cgerc)(CblasColMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_cgerc(CblasColMajor, 0, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_cgerc)(CblasColMajor, 0, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_cgerc(CblasColMajor, 0, 0, ALPHA, X, 0, Y, 1, A, 1 ); + API_SUFFIX(cblas_cgerc)(CblasColMajor, 0, 0, ALPHA, X, 0, Y, 1, A, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_cgerc(CblasColMajor, 0, 0, ALPHA, X, 1, Y, 0, A, 1 ); + API_SUFFIX(cblas_cgerc)(CblasColMajor, 0, 0, ALPHA, X, 1, Y, 0, A, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_cgerc(CblasColMajor, 2, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_cgerc)(CblasColMajor, 2, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_cgerc(CblasRowMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_cgerc)(CblasRowMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_cgerc(CblasRowMajor, 0, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_cgerc)(CblasRowMajor, 0, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_cgerc(CblasRowMajor, 0, 0, ALPHA, X, 0, Y, 1, A, 1 ); + API_SUFFIX(cblas_cgerc)(CblasRowMajor, 0, 0, ALPHA, X, 0, Y, 1, A, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_cgerc(CblasRowMajor, 0, 0, ALPHA, X, 1, Y, 0, A, 1 ); + API_SUFFIX(cblas_cgerc)(CblasRowMajor, 0, 0, ALPHA, X, 1, Y, 0, A, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_cgerc(CblasRowMajor, 0, 2, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_cgerc)(CblasRowMajor, 0, 2, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); } else if (strncmp( sf,"cblas_cher2",11)==0) { cblas_rout = "cblas_cher2"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_cher2(INVALID, CblasUpper, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_cher2)(INVALID_LAYOUT, CblasUpper, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_cher2(CblasColMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_cher2)(CblasColMajor, INVALID_UPLO, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_cher2(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_cher2)(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_cher2(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A, 1 ); + API_SUFFIX(cblas_cher2)(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_cher2(CblasColMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A, 1 ); + API_SUFFIX(cblas_cher2)(CblasColMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_cher2(CblasColMajor, CblasUpper, 2, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_cher2)(CblasColMajor, CblasUpper, 2, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_cher2(CblasRowMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_cher2)(CblasRowMajor, INVALID_UPLO, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_cher2(CblasRowMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_cher2)(CblasRowMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_cher2(CblasRowMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A, 1 ); + API_SUFFIX(cblas_cher2)(CblasRowMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_cher2(CblasRowMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A, 1 ); + API_SUFFIX(cblas_cher2)(CblasRowMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_cher2(CblasRowMajor, CblasUpper, 2, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_cher2)(CblasRowMajor, CblasUpper, 2, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); } else if (strncmp( sf,"cblas_chpr2",11)==0) { cblas_rout = "cblas_chpr2"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_chpr2(INVALID, CblasUpper, 0, ALPHA, X, 1, Y, 1, A ); + API_SUFFIX(cblas_chpr2)(INVALID_LAYOUT, CblasUpper, 0, ALPHA, X, 1, Y, 1, A ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_chpr2(CblasColMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A ); + API_SUFFIX(cblas_chpr2)(CblasColMajor, INVALID_UPLO, 0, ALPHA, X, 1, Y, 1, A ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_chpr2(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A ); + API_SUFFIX(cblas_chpr2)(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_chpr2(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A ); + API_SUFFIX(cblas_chpr2)(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_chpr2(CblasColMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A ); + API_SUFFIX(cblas_chpr2)(CblasColMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_chpr2(CblasRowMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A ); + API_SUFFIX(cblas_chpr2)(CblasRowMajor, INVALID_UPLO, 0, ALPHA, X, 1, Y, 1, A ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_chpr2(CblasRowMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A ); + API_SUFFIX(cblas_chpr2)(CblasRowMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_chpr2(CblasRowMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A ); + API_SUFFIX(cblas_chpr2)(CblasRowMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_chpr2(CblasRowMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A ); + API_SUFFIX(cblas_chpr2)(CblasRowMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A ); chkxer(); } else if (strncmp( sf,"cblas_cher",10)==0) { cblas_rout = "cblas_cher"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_cher(INVALID, CblasUpper, 0, RALPHA, X, 1, A, 1 ); + API_SUFFIX(cblas_cher)(INVALID_LAYOUT, CblasUpper, 0, RALPHA, X, 1, A, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_cher(CblasColMajor, INVALID, 0, RALPHA, X, 1, A, 1 ); + API_SUFFIX(cblas_cher)(CblasColMajor, INVALID_UPLO, 0, RALPHA, X, 1, A, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_cher(CblasColMajor, CblasUpper, INVALID, RALPHA, X, 1, A, 1 ); + API_SUFFIX(cblas_cher)(CblasColMajor, CblasUpper, INVALID, RALPHA, X, 1, A, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_cher(CblasColMajor, CblasUpper, 0, RALPHA, X, 0, A, 1 ); + API_SUFFIX(cblas_cher)(CblasColMajor, CblasUpper, 0, RALPHA, X, 0, A, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_cher(CblasColMajor, CblasUpper, 2, RALPHA, X, 1, A, 1 ); + API_SUFFIX(cblas_cher)(CblasColMajor, CblasUpper, 2, RALPHA, X, 1, A, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_cher(CblasRowMajor, INVALID, 0, RALPHA, X, 1, A, 1 ); + API_SUFFIX(cblas_cher)(CblasRowMajor, INVALID_UPLO, 0, RALPHA, X, 1, A, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_cher(CblasRowMajor, CblasUpper, INVALID, RALPHA, X, 1, A, 1 ); + API_SUFFIX(cblas_cher)(CblasRowMajor, CblasUpper, INVALID, RALPHA, X, 1, A, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_cher(CblasRowMajor, CblasUpper, 0, RALPHA, X, 0, A, 1 ); + API_SUFFIX(cblas_cher)(CblasRowMajor, CblasUpper, 0, RALPHA, X, 0, A, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_cher(CblasRowMajor, CblasUpper, 2, RALPHA, X, 1, A, 1 ); + API_SUFFIX(cblas_cher)(CblasRowMajor, CblasUpper, 2, RALPHA, X, 1, A, 1 ); chkxer(); } else if (strncmp( sf,"cblas_chpr",10)==0) { cblas_rout = "cblas_chpr"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_chpr(INVALID, CblasUpper, 0, RALPHA, X, 1, A ); + API_SUFFIX(cblas_chpr)(INVALID_LAYOUT, CblasUpper, 0, RALPHA, X, 1, A ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_chpr(CblasColMajor, INVALID, 0, RALPHA, X, 1, A ); + API_SUFFIX(cblas_chpr)(CblasColMajor, INVALID_UPLO, 0, RALPHA, X, 1, A ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_chpr(CblasColMajor, CblasUpper, INVALID, RALPHA, X, 1, A ); + API_SUFFIX(cblas_chpr)(CblasColMajor, CblasUpper, INVALID, RALPHA, X, 1, A ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_chpr(CblasColMajor, CblasUpper, 0, RALPHA, X, 0, A ); + API_SUFFIX(cblas_chpr)(CblasColMajor, CblasUpper, 0, RALPHA, X, 0, A ); chkxer(); - cblas_info = 2; RowMajorStrg = FALSE; - cblas_chpr(CblasColMajor, INVALID, 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; - 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; - 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) printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout); else printf("******* %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout); + printf(" %-12s ERROR-EXIT TESTS:%9d RUN,%9d FAILED\n", + cblas_rout, (int) cblas_xtests, (int) cblas_xfails); } diff --git a/CBLAS/testing/c_c3chke.c b/CBLAS/testing/c_c3chke.c index 1be0c3fd10..b146098e77 100644 --- a/CBLAS/testing/c_c3chke.c +++ b/CBLAS/testing/c_c3chke.c @@ -3,28 +3,43 @@ #include "cblas.h" #include "cblas_test.h" -int cblas_ok, cblas_lerr, cblas_info; -int link_xerbla=TRUE; +CBLAS_INT cblas_ok, cblas_lerr, cblas_info; +CBLAS_INT link_xerbla=TRUE; +CBLAS_INT cblas_xtests, cblas_xfails, cblas_xbad; char *cblas_rout; #ifdef F77_Char -void F77_xerbla(F77_Char F77_srname, void *vinfo); +void F77_xerbla(F77_Char F77_srname, void *vinfo #else -void F77_xerbla(char *srname, void *vinfo); +void F77_xerbla(char *srname, void *vinfo #endif +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN srname_len +#endif +); void chkxer(void) { - extern int cblas_ok, cblas_lerr, cblas_info; - extern int link_xerbla; + extern CBLAS_INT cblas_ok, cblas_lerr, cblas_info; + extern CBLAS_INT link_xerbla; + extern CBLAS_INT cblas_xtests, cblas_xfails, cblas_xbad; extern char *cblas_rout; + cblas_xtests++; if (cblas_lerr == 1 ) { - printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", 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) { + cblas_xfails++; } + cblas_xbad = 0; cblas_lerr = 1 ; } -void F77_c3chke(char * rout) { +void F77_c3chke(char * rout +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN rout_len +#endif +) { char *sf = ( rout ) ; float A[4] = {0.0,0.0,0.0,0.0}, B[4] = {0.0,0.0,0.0,0.0}, @@ -32,420 +47,718 @@ void F77_c3chke(char * rout) { ALPHA[2] = {0.0,0.0}, BETA[2] = {0.0,0.0}, RALPHA = 0.0, RBETA = 0.0; - extern int cblas_info, cblas_lerr, cblas_ok; - extern int RowMajorStrg; + extern CBLAS_INT cblas_info, cblas_lerr, cblas_ok; extern char *cblas_rout; cblas_ok = TRUE ; cblas_lerr = PASSED ; + cblas_xtests = 0; + cblas_xfails = 0; + cblas_xbad = 0; + +#ifndef HAS_ATTRIBUTE_WEAK_SUPPORT + #ifdef CBLAS_DLL_IMPORTS + // Since Windows does not support weak symbols, and the trick below doesn't + // work for shared libraries on Windows, we skip the xerbla tests here. + printf("***** WARNING: Skipping xerbla tests since weak symbols are not supported on Windows *****\n"); + return; + #endif if (link_xerbla) /* call these first to link */ { - cblas_xerbla(cblas_info,cblas_rout,""); - F77_xerbla(cblas_rout,&cblas_info); + API_SUFFIX(cblas_xerbla)(cblas_info,cblas_rout,""); + F77_xerbla(cblas_rout,&cblas_info, 1); } +#endif + + link_xerbla = 0; + if (strncmp( sf,"cblas_cgemmtr" ,13)==0) { + cblas_rout = "cblas_cgemmtr" ; + + cblas_info = 1; + API_SUFFIX(cblas_cgemmtr)( INVALID_LAYOUT, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + API_SUFFIX(cblas_cgemmtr)( INVALID_LAYOUT, CblasUpper, CblasNoTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + API_SUFFIX(cblas_cgemmtr)( INVALID_LAYOUT, CblasUpper,CblasTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + API_SUFFIX(cblas_cgemmtr)( INVALID_LAYOUT, CblasUpper, CblasTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 1; + API_SUFFIX(cblas_cgemmtr)( INVALID_LAYOUT, CblasLower, CblasNoTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + API_SUFFIX(cblas_cgemmtr)( INVALID_LAYOUT, CblasLower, CblasNoTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + API_SUFFIX(cblas_cgemmtr)( INVALID_LAYOUT, CblasLower,CblasTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + API_SUFFIX(cblas_cgemmtr)( INVALID_LAYOUT, CblasLower, CblasTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 2; RowMajorStrg = FALSE; + API_SUFFIX(cblas_cgemmtr)( CblasColMajor, INVALID_UPLO, CblasNoTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = FALSE; + API_SUFFIX(cblas_cgemmtr)( CblasColMajor, INVALID_UPLO, CblasNoTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 3; RowMajorStrg = FALSE; + API_SUFFIX(cblas_cgemmtr)( CblasColMajor, CblasUpper, INVALID_TRANSPOSE, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = FALSE; + API_SUFFIX(cblas_cgemmtr)( CblasColMajor, CblasUpper, INVALID_TRANSPOSE, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 4; RowMajorStrg = FALSE; + API_SUFFIX(cblas_cgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, INVALID_TRANSPOSE, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = FALSE; + API_SUFFIX(cblas_cgemmtr)( CblasColMajor, CblasUpper, CblasTrans, INVALID_TRANSPOSE, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + + cblas_info = 5; RowMajorStrg = FALSE; + API_SUFFIX(cblas_cgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + API_SUFFIX(cblas_cgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + API_SUFFIX(cblas_cgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + API_SUFFIX(cblas_cgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 6; RowMajorStrg = FALSE; + API_SUFFIX(cblas_cgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = FALSE; + API_SUFFIX(cblas_cgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = FALSE; + API_SUFFIX(cblas_cgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = FALSE; + API_SUFFIX(cblas_cgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + + cblas_info = 9; RowMajorStrg = FALSE; + API_SUFFIX(cblas_cgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = FALSE; + API_SUFFIX(cblas_cgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = FALSE; + API_SUFFIX(cblas_cgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2, + ALPHA, A, 1, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 9; RowMajorStrg = FALSE; + API_SUFFIX(cblas_cgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 11; RowMajorStrg = FALSE; + API_SUFFIX(cblas_cgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = FALSE; + API_SUFFIX(cblas_cgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = FALSE; + API_SUFFIX(cblas_cgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 14; RowMajorStrg = FALSE; + API_SUFFIX(cblas_cgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = FALSE; + API_SUFFIX(cblas_cgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + + cblas_info = 14; RowMajorStrg = FALSE; + API_SUFFIX(cblas_cgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = FALSE; + API_SUFFIX(cblas_cgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + 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 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 6; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 9; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, 2, + ALPHA, A, 1, B, 2, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0, + ALPHA, A, 1, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); - if (strncmp( sf,"cblas_cgemm" ,11)==0) { + cblas_info = 11; RowMajorStrg = TRUE; + 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)( 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)( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 14; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + + } else if (strncmp( sf,"cblas_cgemm" ,11)==0) { cblas_rout = "cblas_cgemm" ; cblas_info = 1; - cblas_cgemm( INVALID, CblasNoTrans, CblasNoTrans, 0, 0, 0, + API_SUFFIX(cblas_cgemm)( INVALID_LAYOUT, CblasNoTrans, CblasNoTrans, 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 1; - cblas_cgemm( INVALID, CblasNoTrans, CblasTrans, 0, 0, 0, + API_SUFFIX(cblas_cgemm)( INVALID_LAYOUT, CblasNoTrans, CblasTrans, 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 1; - cblas_cgemm( INVALID, CblasTrans, CblasNoTrans, 0, 0, 0, + API_SUFFIX(cblas_cgemm)( INVALID_LAYOUT, CblasTrans, CblasNoTrans, 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 1; - cblas_cgemm( INVALID, CblasTrans, CblasTrans, 0, 0, 0, + API_SUFFIX(cblas_cgemm)( INVALID_LAYOUT, CblasTrans, CblasTrans, 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, INVALID, CblasNoTrans, 0, 0, 0, + API_SUFFIX(cblas_cgemm)( CblasColMajor, INVALID_TRANSPOSE, CblasNoTrans, 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, INVALID, CblasTrans, 0, 0, 0, + API_SUFFIX(cblas_cgemm)( CblasColMajor, INVALID_TRANSPOSE, CblasTrans, 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasNoTrans, INVALID, 0, 0, 0, + API_SUFFIX(cblas_cgemm)( CblasColMajor, CblasNoTrans, INVALID_TRANSPOSE, 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasTrans, INVALID, 0, 0, 0, + API_SUFFIX(cblas_cgemm)( CblasColMajor, CblasTrans, INVALID_TRANSPOSE, 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, INVALID, 0, 0, + API_SUFFIX(cblas_cgemm)( CblasColMajor, CblasNoTrans, CblasNoTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasNoTrans, CblasTrans, INVALID, 0, 0, + API_SUFFIX(cblas_cgemm)( CblasColMajor, CblasNoTrans, CblasTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasTrans, CblasNoTrans, INVALID, 0, 0, + API_SUFFIX(cblas_cgemm)( CblasColMajor, CblasTrans, CblasNoTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasTrans, CblasTrans, INVALID, 0, 0, + API_SUFFIX(cblas_cgemm)( CblasColMajor, CblasTrans, CblasTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, 0, INVALID, 0, + API_SUFFIX(cblas_cgemm)( CblasColMajor, CblasNoTrans, CblasNoTrans, 0, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasNoTrans, CblasTrans, 0, INVALID, 0, + API_SUFFIX(cblas_cgemm)( CblasColMajor, CblasNoTrans, CblasTrans, 0, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasTrans, CblasNoTrans, 0, INVALID, 0, + API_SUFFIX(cblas_cgemm)( CblasColMajor, CblasTrans, CblasNoTrans, 0, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasTrans, CblasTrans, 0, INVALID, 0, + API_SUFFIX(cblas_cgemm)( CblasColMajor, CblasTrans, CblasTrans, 0, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, 0, 0, INVALID, + API_SUFFIX(cblas_cgemm)( CblasColMajor, CblasNoTrans, CblasNoTrans, 0, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasNoTrans, CblasTrans, 0, 0, INVALID, + API_SUFFIX(cblas_cgemm)( CblasColMajor, CblasNoTrans, CblasTrans, 0, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasTrans, CblasNoTrans, 0, 0, INVALID, + API_SUFFIX(cblas_cgemm)( CblasColMajor, CblasTrans, CblasNoTrans, 0, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasTrans, CblasTrans, 0, 0, INVALID, + API_SUFFIX(cblas_cgemm)( CblasColMajor, CblasTrans, CblasTrans, 0, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, 2, 0, 0, + API_SUFFIX(cblas_cgemm)( CblasColMajor, CblasNoTrans, CblasNoTrans, 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasNoTrans, CblasTrans, 2, 0, 0, + API_SUFFIX(cblas_cgemm)( CblasColMajor, CblasNoTrans, CblasTrans, 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasTrans, CblasNoTrans, 0, 0, 2, + API_SUFFIX(cblas_cgemm)( CblasColMajor, CblasTrans, CblasNoTrans, 0, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasTrans, CblasTrans, 0, 0, 2, + API_SUFFIX(cblas_cgemm)( CblasColMajor, CblasTrans, CblasTrans, 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, 0, 0, 2, + API_SUFFIX(cblas_cgemm)( CblasColMajor, CblasNoTrans, CblasNoTrans, 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasTrans, CblasNoTrans, 0, 0, 2, + API_SUFFIX(cblas_cgemm)( CblasColMajor, CblasTrans, CblasNoTrans, 0, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasNoTrans, CblasTrans, 0, 2, 0, + API_SUFFIX(cblas_cgemm)( CblasColMajor, CblasNoTrans, CblasTrans, 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasTrans, CblasTrans, 0, 2, 0, + API_SUFFIX(cblas_cgemm)( CblasColMajor, CblasTrans, CblasTrans, 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, 2, 0, 0, + API_SUFFIX(cblas_cgemm)( CblasColMajor, CblasNoTrans, CblasNoTrans, 2, 0, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasNoTrans, CblasTrans, 2, 0, 0, + API_SUFFIX(cblas_cgemm)( CblasColMajor, CblasNoTrans, CblasTrans, 2, 0, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasTrans, CblasNoTrans, 2, 0, 0, + API_SUFFIX(cblas_cgemm)( CblasColMajor, CblasTrans, CblasNoTrans, 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasTrans, CblasTrans, 2, 0, 0, + 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; - cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, INVALID, 0, 0, + API_SUFFIX(cblas_cgemm)( CblasRowMajor, CblasNoTrans, CblasNoTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasTrans, INVALID, 0, 0, + API_SUFFIX(cblas_cgemm)( CblasRowMajor, CblasNoTrans, CblasTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasTrans, CblasNoTrans, INVALID, 0, 0, + API_SUFFIX(cblas_cgemm)( CblasRowMajor, CblasTrans, CblasNoTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasTrans, CblasTrans, INVALID, 0, 0, + API_SUFFIX(cblas_cgemm)( CblasRowMajor, CblasTrans, CblasTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, INVALID, 0, + API_SUFFIX(cblas_cgemm)( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasTrans, 0, INVALID, 0, + API_SUFFIX(cblas_cgemm)( CblasRowMajor, CblasNoTrans, CblasTrans, 0, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasTrans, CblasNoTrans, 0, INVALID, 0, + API_SUFFIX(cblas_cgemm)( CblasRowMajor, CblasTrans, CblasNoTrans, 0, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasTrans, CblasTrans, 0, INVALID, 0, + API_SUFFIX(cblas_cgemm)( CblasRowMajor, CblasTrans, CblasTrans, 0, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 0, INVALID, + API_SUFFIX(cblas_cgemm)( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 0, INVALID, + API_SUFFIX(cblas_cgemm)( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasTrans, CblasNoTrans, 0, 0, INVALID, + API_SUFFIX(cblas_cgemm)( CblasRowMajor, CblasTrans, CblasNoTrans, 0, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasTrans, CblasTrans, 0, 0, INVALID, + API_SUFFIX(cblas_cgemm)( CblasRowMajor, CblasTrans, CblasTrans, 0, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 0, 2, + API_SUFFIX(cblas_cgemm)( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 9; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 0, 2, + API_SUFFIX(cblas_cgemm)( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 9; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasTrans, CblasNoTrans, 2, 0, 0, + API_SUFFIX(cblas_cgemm)( CblasRowMajor, CblasTrans, CblasNoTrans, 2, 0, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasTrans, CblasTrans, 2, 0, 0, + API_SUFFIX(cblas_cgemm)( CblasRowMajor, CblasTrans, CblasTrans, 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 2, 0, + API_SUFFIX(cblas_cgemm)( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasTrans, CblasNoTrans, 0, 2, 0, + API_SUFFIX(cblas_cgemm)( CblasRowMajor, CblasTrans, CblasNoTrans, 0, 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 0, 2, + API_SUFFIX(cblas_cgemm)( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasTrans, CblasTrans, 0, 0, 2, + API_SUFFIX(cblas_cgemm)( CblasRowMajor, CblasTrans, CblasTrans, 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 2, 0, + API_SUFFIX(cblas_cgemm)( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 2, 0, + API_SUFFIX(cblas_cgemm)( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasTrans, CblasNoTrans, 0, 2, 0, + API_SUFFIX(cblas_cgemm)( CblasRowMajor, CblasTrans, CblasNoTrans, 0, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasTrans, CblasTrans, 0, 2, 0, + API_SUFFIX(cblas_cgemm)( CblasRowMajor, CblasTrans, CblasTrans, 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); - } else if (strncmp( sf,"cblas_chemm" ,11)==0) { cblas_rout = "cblas_chemm" ; cblas_info = 1; - cblas_chemm( INVALID, CblasRight, CblasLower, 0, 0, + API_SUFFIX(cblas_chemm)( INVALID_LAYOUT, CblasRight, CblasLower, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_chemm( CblasColMajor, INVALID, CblasUpper, 0, 0, + API_SUFFIX(cblas_chemm)( CblasColMajor, INVALID_SIDE, CblasUpper, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_chemm( CblasColMajor, CblasLeft, INVALID, 0, 0, + API_SUFFIX(cblas_chemm)( CblasColMajor, CblasLeft, INVALID_UPLO, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_chemm( CblasColMajor, CblasLeft, CblasUpper, INVALID, 0, + API_SUFFIX(cblas_chemm)( CblasColMajor, CblasLeft, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_chemm( CblasColMajor, CblasRight, CblasUpper, INVALID, 0, + API_SUFFIX(cblas_chemm)( CblasColMajor, CblasRight, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_chemm( CblasColMajor, CblasLeft, CblasLower, INVALID, 0, + API_SUFFIX(cblas_chemm)( CblasColMajor, CblasLeft, CblasLower, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_chemm( CblasColMajor, CblasRight, CblasLower, INVALID, 0, + API_SUFFIX(cblas_chemm)( CblasColMajor, CblasRight, CblasLower, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_chemm( CblasColMajor, CblasLeft, CblasUpper, 0, INVALID, + API_SUFFIX(cblas_chemm)( CblasColMajor, CblasLeft, CblasUpper, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_chemm( CblasColMajor, CblasRight, CblasUpper, 0, INVALID, + API_SUFFIX(cblas_chemm)( CblasColMajor, CblasRight, CblasUpper, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_chemm( CblasColMajor, CblasLeft, CblasLower, 0, INVALID, + API_SUFFIX(cblas_chemm)( CblasColMajor, CblasLeft, CblasLower, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_chemm( CblasColMajor, CblasRight, CblasLower, 0, INVALID, + API_SUFFIX(cblas_chemm)( CblasColMajor, CblasRight, CblasLower, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_chemm( CblasColMajor, CblasLeft, CblasUpper, 2, 0, + API_SUFFIX(cblas_chemm)( CblasColMajor, CblasLeft, CblasUpper, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_chemm( CblasColMajor, CblasRight, CblasUpper, 0, 2, + API_SUFFIX(cblas_chemm)( CblasColMajor, CblasRight, CblasUpper, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_chemm( CblasColMajor, CblasLeft, CblasLower, 2, 0, + API_SUFFIX(cblas_chemm)( CblasColMajor, CblasLeft, CblasLower, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_chemm( CblasColMajor, CblasRight, CblasLower, 0, 2, + API_SUFFIX(cblas_chemm)( CblasColMajor, CblasRight, CblasLower, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_chemm( CblasColMajor, CblasLeft, CblasUpper, 2, 0, + API_SUFFIX(cblas_chemm)( CblasColMajor, CblasLeft, CblasUpper, 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_chemm( CblasColMajor, CblasRight, CblasUpper, 2, 0, + API_SUFFIX(cblas_chemm)( CblasColMajor, CblasRight, CblasUpper, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_chemm( CblasColMajor, CblasLeft, CblasLower, 2, 0, + API_SUFFIX(cblas_chemm)( CblasColMajor, CblasLeft, CblasLower, 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_chemm( CblasColMajor, CblasRight, CblasLower, 2, 0, + API_SUFFIX(cblas_chemm)( CblasColMajor, CblasRight, CblasLower, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_chemm( CblasColMajor, CblasLeft, CblasUpper, 2, 0, + API_SUFFIX(cblas_chemm)( CblasColMajor, CblasLeft, CblasUpper, 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_chemm( CblasColMajor, CblasRight, CblasUpper, 2, 0, + API_SUFFIX(cblas_chemm)( CblasColMajor, CblasRight, CblasUpper, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_chemm( CblasColMajor, CblasLeft, CblasLower, 2, 0, + API_SUFFIX(cblas_chemm)( CblasColMajor, CblasLeft, CblasLower, 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_chemm( CblasColMajor, CblasRight, CblasLower, 2, 0, + 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; - cblas_chemm( CblasRowMajor, CblasLeft, CblasUpper, INVALID, 0, + API_SUFFIX(cblas_chemm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_chemm( CblasRowMajor, CblasRight, CblasUpper, INVALID, 0, + API_SUFFIX(cblas_chemm)( CblasRowMajor, CblasRight, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_chemm( CblasRowMajor, CblasLeft, CblasLower, INVALID, 0, + API_SUFFIX(cblas_chemm)( CblasRowMajor, CblasLeft, CblasLower, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_chemm( CblasRowMajor, CblasRight, CblasLower, INVALID, 0, + API_SUFFIX(cblas_chemm)( CblasRowMajor, CblasRight, CblasLower, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_chemm( CblasRowMajor, CblasLeft, CblasUpper, 0, INVALID, + API_SUFFIX(cblas_chemm)( CblasRowMajor, CblasLeft, CblasUpper, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_chemm( CblasRowMajor, CblasRight, CblasUpper, 0, INVALID, + API_SUFFIX(cblas_chemm)( CblasRowMajor, CblasRight, CblasUpper, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_chemm( CblasRowMajor, CblasLeft, CblasLower, 0, INVALID, + API_SUFFIX(cblas_chemm)( CblasRowMajor, CblasLeft, CblasLower, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_chemm( CblasRowMajor, CblasRight, CblasLower, 0, INVALID, + API_SUFFIX(cblas_chemm)( CblasRowMajor, CblasRight, CblasLower, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_chemm( CblasRowMajor, CblasLeft, CblasUpper, 2, 0, + API_SUFFIX(cblas_chemm)( CblasRowMajor, CblasLeft, CblasUpper, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_chemm( CblasRowMajor, CblasRight, CblasUpper, 0, 2, + API_SUFFIX(cblas_chemm)( CblasRowMajor, CblasRight, CblasUpper, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_chemm( CblasRowMajor, CblasLeft, CblasLower, 2, 0, + API_SUFFIX(cblas_chemm)( CblasRowMajor, CblasLeft, CblasLower, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_chemm( CblasRowMajor, CblasRight, CblasLower, 0, 2, + API_SUFFIX(cblas_chemm)( CblasRowMajor, CblasRight, CblasLower, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_chemm( CblasRowMajor, CblasLeft, CblasUpper, 0, 2, + API_SUFFIX(cblas_chemm)( CblasRowMajor, CblasLeft, CblasUpper, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_chemm( CblasRowMajor, CblasRight, CblasUpper, 0, 2, + API_SUFFIX(cblas_chemm)( CblasRowMajor, CblasRight, CblasUpper, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_chemm( CblasRowMajor, CblasLeft, CblasLower, 0, 2, + API_SUFFIX(cblas_chemm)( CblasRowMajor, CblasLeft, CblasLower, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_chemm( CblasRowMajor, CblasRight, CblasLower, 0, 2, + API_SUFFIX(cblas_chemm)( CblasRowMajor, CblasRight, CblasLower, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_chemm( CblasRowMajor, CblasLeft, CblasUpper, 0, 2, + API_SUFFIX(cblas_chemm)( CblasRowMajor, CblasLeft, CblasUpper, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_chemm( CblasRowMajor, CblasRight, CblasUpper, 0, 2, + API_SUFFIX(cblas_chemm)( CblasRowMajor, CblasRight, CblasUpper, 0, 2, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_chemm( CblasRowMajor, CblasLeft, CblasLower, 0, 2, + API_SUFFIX(cblas_chemm)( CblasRowMajor, CblasLeft, CblasLower, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_chemm( CblasRowMajor, CblasRight, CblasLower, 0, 2, + API_SUFFIX(cblas_chemm)( CblasRowMajor, CblasRight, CblasLower, 0, 2, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); @@ -453,175 +766,184 @@ void F77_c3chke(char * rout) { cblas_rout = "cblas_csymm" ; cblas_info = 1; - cblas_csymm( INVALID, CblasRight, CblasLower, 0, 0, + API_SUFFIX(cblas_csymm)( INVALID_LAYOUT, CblasRight, CblasLower, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_csymm( CblasColMajor, INVALID, CblasUpper, 0, 0, + API_SUFFIX(cblas_csymm)( CblasColMajor, INVALID_SIDE, CblasUpper, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_csymm( CblasColMajor, CblasLeft, INVALID, 0, 0, + API_SUFFIX(cblas_csymm)( CblasColMajor, CblasLeft, INVALID_UPLO, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_csymm( CblasColMajor, CblasLeft, CblasUpper, INVALID, 0, + API_SUFFIX(cblas_csymm)( CblasColMajor, CblasLeft, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_csymm( CblasColMajor, CblasRight, CblasUpper, INVALID, 0, + API_SUFFIX(cblas_csymm)( CblasColMajor, CblasRight, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_csymm( CblasColMajor, CblasLeft, CblasLower, INVALID, 0, + API_SUFFIX(cblas_csymm)( CblasColMajor, CblasLeft, CblasLower, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_csymm( CblasColMajor, CblasRight, CblasLower, INVALID, 0, + API_SUFFIX(cblas_csymm)( CblasColMajor, CblasRight, CblasLower, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_csymm( CblasColMajor, CblasLeft, CblasUpper, 0, INVALID, + API_SUFFIX(cblas_csymm)( CblasColMajor, CblasLeft, CblasUpper, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_csymm( CblasColMajor, CblasRight, CblasUpper, 0, INVALID, + API_SUFFIX(cblas_csymm)( CblasColMajor, CblasRight, CblasUpper, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_csymm( CblasColMajor, CblasLeft, CblasLower, 0, INVALID, + API_SUFFIX(cblas_csymm)( CblasColMajor, CblasLeft, CblasLower, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_csymm( CblasColMajor, CblasRight, CblasLower, 0, INVALID, + API_SUFFIX(cblas_csymm)( CblasColMajor, CblasRight, CblasLower, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_csymm( CblasColMajor, CblasLeft, CblasUpper, 2, 0, + API_SUFFIX(cblas_csymm)( CblasColMajor, CblasLeft, CblasUpper, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_csymm( CblasColMajor, CblasRight, CblasUpper, 0, 2, + API_SUFFIX(cblas_csymm)( CblasColMajor, CblasRight, CblasUpper, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_csymm( CblasColMajor, CblasLeft, CblasLower, 2, 0, + API_SUFFIX(cblas_csymm)( CblasColMajor, CblasLeft, CblasLower, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_csymm( CblasColMajor, CblasRight, CblasLower, 0, 2, + API_SUFFIX(cblas_csymm)( CblasColMajor, CblasRight, CblasLower, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_csymm( CblasColMajor, CblasLeft, CblasUpper, 2, 0, + API_SUFFIX(cblas_csymm)( CblasColMajor, CblasLeft, CblasUpper, 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_csymm( CblasColMajor, CblasRight, CblasUpper, 2, 0, + API_SUFFIX(cblas_csymm)( CblasColMajor, CblasRight, CblasUpper, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_csymm( CblasColMajor, CblasLeft, CblasLower, 2, 0, + API_SUFFIX(cblas_csymm)( CblasColMajor, CblasLeft, CblasLower, 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_csymm( CblasColMajor, CblasRight, CblasLower, 2, 0, + API_SUFFIX(cblas_csymm)( CblasColMajor, CblasRight, CblasLower, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_csymm( CblasColMajor, CblasLeft, CblasUpper, 2, 0, + API_SUFFIX(cblas_csymm)( CblasColMajor, CblasLeft, CblasUpper, 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_csymm( CblasColMajor, CblasRight, CblasUpper, 2, 0, + API_SUFFIX(cblas_csymm)( CblasColMajor, CblasRight, CblasUpper, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_csymm( CblasColMajor, CblasLeft, CblasLower, 2, 0, + API_SUFFIX(cblas_csymm)( CblasColMajor, CblasLeft, CblasLower, 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_csymm( CblasColMajor, CblasRight, CblasLower, 2, 0, + 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; - cblas_csymm( CblasRowMajor, CblasLeft, CblasUpper, INVALID, 0, + API_SUFFIX(cblas_csymm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_csymm( CblasRowMajor, CblasRight, CblasUpper, INVALID, 0, + API_SUFFIX(cblas_csymm)( CblasRowMajor, CblasRight, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_csymm( CblasRowMajor, CblasLeft, CblasLower, INVALID, 0, + API_SUFFIX(cblas_csymm)( CblasRowMajor, CblasLeft, CblasLower, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_csymm( CblasRowMajor, CblasRight, CblasLower, INVALID, 0, + API_SUFFIX(cblas_csymm)( CblasRowMajor, CblasRight, CblasLower, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_csymm( CblasRowMajor, CblasLeft, CblasUpper, 0, INVALID, + API_SUFFIX(cblas_csymm)( CblasRowMajor, CblasLeft, CblasUpper, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_csymm( CblasRowMajor, CblasRight, CblasUpper, 0, INVALID, + API_SUFFIX(cblas_csymm)( CblasRowMajor, CblasRight, CblasUpper, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_csymm( CblasRowMajor, CblasLeft, CblasLower, 0, INVALID, + API_SUFFIX(cblas_csymm)( CblasRowMajor, CblasLeft, CblasLower, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_csymm( CblasRowMajor, CblasRight, CblasLower, 0, INVALID, + API_SUFFIX(cblas_csymm)( CblasRowMajor, CblasRight, CblasLower, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_csymm( CblasRowMajor, CblasLeft, CblasUpper, 2, 0, + API_SUFFIX(cblas_csymm)( CblasRowMajor, CblasLeft, CblasUpper, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_csymm( CblasRowMajor, CblasRight, CblasUpper, 0, 2, + API_SUFFIX(cblas_csymm)( CblasRowMajor, CblasRight, CblasUpper, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_csymm( CblasRowMajor, CblasLeft, CblasLower, 2, 0, + API_SUFFIX(cblas_csymm)( CblasRowMajor, CblasLeft, CblasLower, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_csymm( CblasRowMajor, CblasRight, CblasLower, 0, 2, + API_SUFFIX(cblas_csymm)( CblasRowMajor, CblasRight, CblasLower, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_csymm( CblasRowMajor, CblasLeft, CblasUpper, 0, 2, + API_SUFFIX(cblas_csymm)( CblasRowMajor, CblasLeft, CblasUpper, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_csymm( CblasRowMajor, CblasRight, CblasUpper, 0, 2, + API_SUFFIX(cblas_csymm)( CblasRowMajor, CblasRight, CblasUpper, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_csymm( CblasRowMajor, CblasLeft, CblasLower, 0, 2, + API_SUFFIX(cblas_csymm)( CblasRowMajor, CblasLeft, CblasLower, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_csymm( CblasRowMajor, CblasRight, CblasLower, 0, 2, + API_SUFFIX(cblas_csymm)( CblasRowMajor, CblasRight, CblasLower, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_csymm( CblasRowMajor, CblasLeft, CblasUpper, 0, 2, + API_SUFFIX(cblas_csymm)( CblasRowMajor, CblasLeft, CblasUpper, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_csymm( CblasRowMajor, CblasRight, CblasUpper, 0, 2, + API_SUFFIX(cblas_csymm)( CblasRowMajor, CblasRight, CblasUpper, 0, 2, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_csymm( CblasRowMajor, CblasLeft, CblasLower, 0, 2, + API_SUFFIX(cblas_csymm)( CblasRowMajor, CblasLeft, CblasLower, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_csymm( CblasRowMajor, CblasRight, CblasLower, 0, 2, + API_SUFFIX(cblas_csymm)( CblasRowMajor, CblasRight, CblasLower, 0, 2, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); @@ -629,279 +951,296 @@ void F77_c3chke(char * rout) { cblas_rout = "cblas_ctrmm" ; cblas_info = 1; - cblas_ctrmm( INVALID, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( INVALID_LAYOUT, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, INVALID_SIDE, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasLeft, INVALID, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasLeft, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasLeft, CblasUpper, INVALID, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasLeft, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, - INVALID, 0, 0, ALPHA, A, 1, B, 1 ); + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ctrmm( CblasColMajor, CblasRight, CblasLower, CblasTrans, + 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; - cblas_ctrmm( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ctrmm( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ctrmm( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ctrmm( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ctrmm( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ctrmm( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ctrmm( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ctrmm( CblasRowMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ctrmm( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ctrmm( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ctrmm( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ctrmm( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ctrmm( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ctrmm( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ctrmm( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ctrmm( CblasRowMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ctrmm( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ctrmm( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ctrmm( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ctrmm( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ctrmm( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ctrmm( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ctrmm( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ctrmm( CblasRowMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ctrmm( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ctrmm( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ctrmm( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ctrmm( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ctrmm( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ctrmm( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ctrmm( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ctrmm( CblasRowMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 2, B, 1 ); chkxer(); @@ -909,279 +1248,296 @@ void F77_c3chke(char * rout) { cblas_rout = "cblas_ctrsm" ; cblas_info = 1; - cblas_ctrsm( INVALID, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( INVALID_LAYOUT, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, INVALID_SIDE, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasLeft, INVALID, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasLeft, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasLeft, CblasUpper, INVALID, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasLeft, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, - INVALID, 0, 0, ALPHA, A, 1, B, 1 ); + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ctrsm( CblasColMajor, CblasRight, CblasLower, CblasTrans, + 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; - cblas_ctrsm( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ctrsm( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ctrsm( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ctrsm( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ctrsm( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ctrsm( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ctrsm( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ctrsm( CblasRowMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ctrsm( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ctrsm( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ctrsm( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ctrsm( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ctrsm( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ctrsm( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ctrsm( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ctrsm( CblasRowMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ctrsm( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ctrsm( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ctrsm( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ctrsm( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ctrsm( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ctrsm( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ctrsm( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ctrsm( CblasRowMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ctrsm( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ctrsm( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ctrsm( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ctrsm( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ctrsm( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ctrsm( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ctrsm( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ctrsm( CblasRowMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 2, B, 1 ); chkxer(); @@ -1189,111 +1545,152 @@ void F77_c3chke(char * rout) { cblas_rout = "cblas_cherk" ; cblas_info = 1; - cblas_cherk(INVALID, CblasUpper, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_cherk)(INVALID_LAYOUT, CblasUpper, CblasNoTrans, 0, 0, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_cherk(CblasColMajor, INVALID, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_cherk)(CblasColMajor, INVALID_UPLO, CblasNoTrans, 0, 0, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_cherk(CblasColMajor, CblasUpper, CblasTrans, 0, 0, + API_SUFFIX(cblas_cherk)(CblasColMajor, CblasUpper, CblasTrans, 0, 0, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_cherk(CblasColMajor, CblasUpper, CblasNoTrans, INVALID, 0, + API_SUFFIX(cblas_cherk)(CblasColMajor, CblasUpper, CblasNoTrans, INVALID, 0, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_cherk(CblasColMajor, CblasUpper, CblasConjTrans, INVALID, 0, + API_SUFFIX(cblas_cherk)(CblasColMajor, CblasUpper, CblasConjTrans, INVALID, 0, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_cherk(CblasColMajor, CblasLower, CblasNoTrans, INVALID, 0, + API_SUFFIX(cblas_cherk)(CblasColMajor, CblasLower, CblasNoTrans, INVALID, 0, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_cherk(CblasColMajor, CblasLower, CblasConjTrans, INVALID, 0, + API_SUFFIX(cblas_cherk)(CblasColMajor, CblasLower, CblasConjTrans, INVALID, 0, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_cherk(CblasColMajor, CblasUpper, CblasNoTrans, 0, INVALID, + API_SUFFIX(cblas_cherk)(CblasColMajor, CblasUpper, CblasNoTrans, 0, INVALID, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_cherk(CblasColMajor, CblasUpper, CblasConjTrans, 0, INVALID, + API_SUFFIX(cblas_cherk)(CblasColMajor, CblasUpper, CblasConjTrans, 0, INVALID, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_cherk(CblasColMajor, CblasLower, CblasNoTrans, 0, INVALID, + API_SUFFIX(cblas_cherk)(CblasColMajor, CblasLower, CblasNoTrans, 0, INVALID, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_cherk(CblasColMajor, CblasLower, CblasConjTrans, 0, INVALID, + 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; - cblas_cherk(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_cherk)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, RALPHA, A, 1, RBETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_cherk(CblasRowMajor, CblasUpper, CblasConjTrans, 2, 0, + API_SUFFIX(cblas_cherk)(CblasRowMajor, CblasUpper, CblasConjTrans, 2, 0, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_cherk(CblasRowMajor, CblasLower, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_cherk)(CblasRowMajor, CblasLower, CblasNoTrans, 0, 2, RALPHA, A, 1, RBETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_cherk(CblasRowMajor, CblasLower, CblasConjTrans, 2, 0, + API_SUFFIX(cblas_cherk)(CblasRowMajor, CblasLower, CblasConjTrans, 2, 0, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_cherk(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_cherk)(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, RALPHA, A, 1, RBETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_cherk(CblasColMajor, CblasUpper, CblasConjTrans, 0, 2, + API_SUFFIX(cblas_cherk)(CblasColMajor, CblasUpper, CblasConjTrans, 0, 2, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_cherk(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_cherk)(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, RALPHA, A, 1, RBETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_cherk(CblasColMajor, CblasLower, CblasConjTrans, 0, 2, + API_SUFFIX(cblas_cherk)(CblasColMajor, CblasLower, CblasConjTrans, 0, 2, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_cherk(CblasRowMajor, CblasUpper, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_cherk)(CblasRowMajor, CblasUpper, CblasNoTrans, 2, 0, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_cherk(CblasRowMajor, CblasUpper, CblasConjTrans, 2, 0, + API_SUFFIX(cblas_cherk)(CblasRowMajor, CblasUpper, CblasConjTrans, 2, 0, RALPHA, A, 2, RBETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_cherk(CblasRowMajor, CblasLower, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_cherk)(CblasRowMajor, CblasLower, CblasNoTrans, 2, 0, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_cherk(CblasRowMajor, CblasLower, CblasConjTrans, 2, 0, + API_SUFFIX(cblas_cherk)(CblasRowMajor, CblasLower, CblasConjTrans, 2, 0, RALPHA, A, 2, RBETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_cherk(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_cherk)(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, RALPHA, A, 2, RBETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_cherk(CblasColMajor, CblasUpper, CblasConjTrans, 2, 0, + API_SUFFIX(cblas_cherk)(CblasColMajor, CblasUpper, CblasConjTrans, 2, 0, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_cherk(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_cherk)(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, RALPHA, A, 2, RBETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_cherk(CblasColMajor, CblasLower, CblasConjTrans, 2, 0, + API_SUFFIX(cblas_cherk)(CblasColMajor, CblasLower, CblasConjTrans, 2, 0, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); @@ -1301,111 +1698,152 @@ void F77_c3chke(char * rout) { cblas_rout = "cblas_csyrk" ; cblas_info = 1; - cblas_csyrk(INVALID, CblasUpper, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_csyrk)(INVALID_LAYOUT, CblasUpper, CblasNoTrans, 0, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_csyrk(CblasColMajor, INVALID, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_csyrk)(CblasColMajor, INVALID_UPLO, CblasNoTrans, 0, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_csyrk(CblasColMajor, CblasUpper, CblasConjTrans, 0, 0, + API_SUFFIX(cblas_csyrk)(CblasColMajor, CblasUpper, CblasConjTrans, 0, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_csyrk(CblasColMajor, CblasUpper, CblasNoTrans, INVALID, 0, + API_SUFFIX(cblas_csyrk)(CblasColMajor, CblasUpper, CblasNoTrans, INVALID, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_csyrk(CblasColMajor, CblasUpper, CblasTrans, INVALID, 0, + API_SUFFIX(cblas_csyrk)(CblasColMajor, CblasUpper, CblasTrans, INVALID, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_csyrk(CblasColMajor, CblasLower, CblasNoTrans, INVALID, 0, + API_SUFFIX(cblas_csyrk)(CblasColMajor, CblasLower, CblasNoTrans, INVALID, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_csyrk(CblasColMajor, CblasLower, CblasTrans, INVALID, 0, + API_SUFFIX(cblas_csyrk)(CblasColMajor, CblasLower, CblasTrans, INVALID, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_csyrk(CblasColMajor, CblasUpper, CblasNoTrans, 0, INVALID, + API_SUFFIX(cblas_csyrk)(CblasColMajor, CblasUpper, CblasNoTrans, 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_csyrk(CblasColMajor, CblasUpper, CblasTrans, 0, INVALID, + API_SUFFIX(cblas_csyrk)(CblasColMajor, CblasUpper, CblasTrans, 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_csyrk(CblasColMajor, CblasLower, CblasNoTrans, 0, INVALID, + API_SUFFIX(cblas_csyrk)(CblasColMajor, CblasLower, CblasNoTrans, 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_csyrk(CblasColMajor, CblasLower, CblasTrans, 0, INVALID, + 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; - cblas_csyrk(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_csyrk)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_csyrk(CblasRowMajor, CblasUpper, CblasTrans, 2, 0, + API_SUFFIX(cblas_csyrk)(CblasRowMajor, CblasUpper, CblasTrans, 2, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_csyrk(CblasRowMajor, CblasLower, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_csyrk)(CblasRowMajor, CblasLower, CblasNoTrans, 0, 2, ALPHA, A, 1, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_csyrk(CblasRowMajor, CblasLower, CblasTrans, 2, 0, + API_SUFFIX(cblas_csyrk)(CblasRowMajor, CblasLower, CblasTrans, 2, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_csyrk(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_csyrk)(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 1, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_csyrk(CblasColMajor, CblasUpper, CblasTrans, 0, 2, + API_SUFFIX(cblas_csyrk)(CblasColMajor, CblasUpper, CblasTrans, 0, 2, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_csyrk(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_csyrk)(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 1, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_csyrk(CblasColMajor, CblasLower, CblasTrans, 0, 2, + API_SUFFIX(cblas_csyrk)(CblasColMajor, CblasLower, CblasTrans, 0, 2, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_csyrk(CblasRowMajor, CblasUpper, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_csyrk)(CblasRowMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_csyrk(CblasRowMajor, CblasUpper, CblasTrans, 2, 0, + API_SUFFIX(cblas_csyrk)(CblasRowMajor, CblasUpper, CblasTrans, 2, 0, ALPHA, A, 2, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_csyrk(CblasRowMajor, CblasLower, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_csyrk)(CblasRowMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_csyrk(CblasRowMajor, CblasLower, CblasTrans, 2, 0, + API_SUFFIX(cblas_csyrk)(CblasRowMajor, CblasLower, CblasTrans, 2, 0, ALPHA, A, 2, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_csyrk(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_csyrk)(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 2, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_csyrk(CblasColMajor, CblasUpper, CblasTrans, 2, 0, + API_SUFFIX(cblas_csyrk)(CblasColMajor, CblasUpper, CblasTrans, 2, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_csyrk(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_csyrk)(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 2, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_csyrk(CblasColMajor, CblasLower, CblasTrans, 2, 0, + API_SUFFIX(cblas_csyrk)(CblasColMajor, CblasLower, CblasTrans, 2, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); @@ -1413,143 +1851,184 @@ void F77_c3chke(char * rout) { cblas_rout = "cblas_cher2k" ; cblas_info = 1; - cblas_cher2k(INVALID, CblasUpper, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_cher2k)(INVALID_LAYOUT, CblasUpper, CblasNoTrans, 0, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_cher2k(CblasColMajor, INVALID, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_cher2k)(CblasColMajor, INVALID_UPLO, CblasNoTrans, 0, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_cher2k(CblasColMajor, CblasUpper, CblasTrans, 0, 0, + API_SUFFIX(cblas_cher2k)(CblasColMajor, CblasUpper, CblasTrans, 0, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_cher2k(CblasColMajor, CblasUpper, CblasNoTrans, INVALID, 0, + API_SUFFIX(cblas_cher2k)(CblasColMajor, CblasUpper, CblasNoTrans, INVALID, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_cher2k(CblasColMajor, CblasUpper, CblasConjTrans, INVALID, 0, + API_SUFFIX(cblas_cher2k)(CblasColMajor, CblasUpper, CblasConjTrans, INVALID, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_cher2k(CblasColMajor, CblasLower, CblasNoTrans, INVALID, 0, + API_SUFFIX(cblas_cher2k)(CblasColMajor, CblasLower, CblasNoTrans, INVALID, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_cher2k(CblasColMajor, CblasLower, CblasConjTrans, INVALID, 0, + API_SUFFIX(cblas_cher2k)(CblasColMajor, CblasLower, CblasConjTrans, INVALID, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_cher2k(CblasColMajor, CblasUpper, CblasNoTrans, 0, INVALID, + API_SUFFIX(cblas_cher2k)(CblasColMajor, CblasUpper, CblasNoTrans, 0, INVALID, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_cher2k(CblasColMajor, CblasUpper, CblasConjTrans, 0, INVALID, + API_SUFFIX(cblas_cher2k)(CblasColMajor, CblasUpper, CblasConjTrans, 0, INVALID, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_cher2k(CblasColMajor, CblasLower, CblasNoTrans, 0, INVALID, + API_SUFFIX(cblas_cher2k)(CblasColMajor, CblasLower, CblasNoTrans, 0, INVALID, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_cher2k(CblasColMajor, CblasLower, CblasConjTrans, 0, INVALID, + 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; - cblas_cher2k(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_cher2k)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, B, 2, RBETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_cher2k(CblasRowMajor, CblasUpper, CblasConjTrans, 2, 0, + API_SUFFIX(cblas_cher2k)(CblasRowMajor, CblasUpper, CblasConjTrans, 2, 0, ALPHA, A, 1, B, 2, RBETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_cher2k(CblasRowMajor, CblasLower, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_cher2k)(CblasRowMajor, CblasLower, CblasNoTrans, 0, 2, ALPHA, A, 1, B, 2, RBETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_cher2k(CblasRowMajor, CblasLower, CblasConjTrans, 2, 0, + API_SUFFIX(cblas_cher2k)(CblasRowMajor, CblasLower, CblasConjTrans, 2, 0, ALPHA, A, 1, B, 2, RBETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_cher2k(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_cher2k)(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_cher2k(CblasColMajor, CblasUpper, CblasConjTrans, 0, 2, + API_SUFFIX(cblas_cher2k)(CblasColMajor, CblasUpper, CblasConjTrans, 0, 2, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_cher2k(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_cher2k)(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_cher2k(CblasColMajor, CblasLower, CblasConjTrans, 0, 2, + API_SUFFIX(cblas_cher2k)(CblasColMajor, CblasLower, CblasConjTrans, 0, 2, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_cher2k(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_cher2k)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 2, B, 1, RBETA, C, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_cher2k(CblasRowMajor, CblasUpper, CblasConjTrans, 2, 0, + API_SUFFIX(cblas_cher2k)(CblasRowMajor, CblasUpper, CblasConjTrans, 2, 0, ALPHA, A, 2, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_cher2k(CblasRowMajor, CblasLower, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_cher2k)(CblasRowMajor, CblasLower, CblasNoTrans, 0, 2, ALPHA, A, 2, B, 1, RBETA, C, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_cher2k(CblasRowMajor, CblasLower, CblasConjTrans, 2, 0, + API_SUFFIX(cblas_cher2k)(CblasRowMajor, CblasLower, CblasConjTrans, 2, 0, ALPHA, A, 2, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_cher2k(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_cher2k)(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 2, B, 1, RBETA, C, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_cher2k(CblasColMajor, CblasUpper, CblasConjTrans, 0, 2, + API_SUFFIX(cblas_cher2k)(CblasColMajor, CblasUpper, CblasConjTrans, 0, 2, ALPHA, A, 2, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_cher2k(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_cher2k)(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 2, B, 1, RBETA, C, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_cher2k(CblasColMajor, CblasLower, CblasConjTrans, 0, 2, + API_SUFFIX(cblas_cher2k)(CblasColMajor, CblasLower, CblasConjTrans, 0, 2, ALPHA, A, 2, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_cher2k(CblasRowMajor, CblasUpper, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_cher2k)(CblasRowMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_cher2k(CblasRowMajor, CblasUpper, CblasConjTrans, 2, 0, + API_SUFFIX(cblas_cher2k)(CblasRowMajor, CblasUpper, CblasConjTrans, 2, 0, ALPHA, A, 2, B, 2, RBETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_cher2k(CblasRowMajor, CblasLower, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_cher2k)(CblasRowMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_cher2k(CblasRowMajor, CblasLower, CblasConjTrans, 2, 0, + API_SUFFIX(cblas_cher2k)(CblasRowMajor, CblasLower, CblasConjTrans, 2, 0, ALPHA, A, 2, B, 2, RBETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_cher2k(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_cher2k)(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 2, B, 2, RBETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_cher2k(CblasColMajor, CblasUpper, CblasConjTrans, 2, 0, + API_SUFFIX(cblas_cher2k)(CblasColMajor, CblasUpper, CblasConjTrans, 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_cher2k(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_cher2k)(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 2, B, 2, RBETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_cher2k(CblasColMajor, CblasLower, CblasConjTrans, 2, 0, + API_SUFFIX(cblas_cher2k)(CblasColMajor, CblasLower, CblasConjTrans, 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); @@ -1557,150 +2036,193 @@ void F77_c3chke(char * rout) { cblas_rout = "cblas_csyr2k" ; cblas_info = 1; - cblas_csyr2k(INVALID, CblasUpper, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_csyr2k)(INVALID_LAYOUT, CblasUpper, CblasNoTrans, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_csyr2k(CblasColMajor, INVALID, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_csyr2k)(CblasColMajor, INVALID_UPLO, CblasNoTrans, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_csyr2k(CblasColMajor, CblasUpper, CblasConjTrans, 0, 0, + API_SUFFIX(cblas_csyr2k)(CblasColMajor, CblasUpper, CblasConjTrans, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_csyr2k(CblasColMajor, CblasUpper, CblasNoTrans, INVALID, 0, + API_SUFFIX(cblas_csyr2k)(CblasColMajor, CblasUpper, CblasNoTrans, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_csyr2k(CblasColMajor, CblasUpper, CblasTrans, INVALID, 0, + API_SUFFIX(cblas_csyr2k)(CblasColMajor, CblasUpper, CblasTrans, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_csyr2k(CblasColMajor, CblasLower, CblasNoTrans, INVALID, 0, + API_SUFFIX(cblas_csyr2k)(CblasColMajor, CblasLower, CblasNoTrans, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_csyr2k(CblasColMajor, CblasLower, CblasTrans, INVALID, 0, + API_SUFFIX(cblas_csyr2k)(CblasColMajor, CblasLower, CblasTrans, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_csyr2k(CblasColMajor, CblasUpper, CblasNoTrans, 0, INVALID, + API_SUFFIX(cblas_csyr2k)(CblasColMajor, CblasUpper, CblasNoTrans, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_csyr2k(CblasColMajor, CblasUpper, CblasTrans, 0, INVALID, + API_SUFFIX(cblas_csyr2k)(CblasColMajor, CblasUpper, CblasTrans, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_csyr2k(CblasColMajor, CblasLower, CblasNoTrans, 0, INVALID, + API_SUFFIX(cblas_csyr2k)(CblasColMajor, CblasLower, CblasNoTrans, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_csyr2k(CblasColMajor, CblasLower, CblasTrans, 0, INVALID, + 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; - cblas_csyr2k(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_csyr2k(CblasRowMajor, CblasUpper, CblasTrans, 2, 0, + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, CblasUpper, CblasTrans, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_csyr2k(CblasRowMajor, CblasLower, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, CblasLower, CblasNoTrans, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_csyr2k(CblasRowMajor, CblasLower, CblasTrans, 2, 0, + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, CblasLower, CblasTrans, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_csyr2k(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_csyr2k)(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_csyr2k(CblasColMajor, CblasUpper, CblasTrans, 0, 2, + API_SUFFIX(cblas_csyr2k)(CblasColMajor, CblasUpper, CblasTrans, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_csyr2k(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_csyr2k)(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_csyr2k(CblasColMajor, CblasLower, CblasTrans, 0, 2, + API_SUFFIX(cblas_csyr2k)(CblasColMajor, CblasLower, CblasTrans, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_csyr2k(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_csyr2k(CblasRowMajor, CblasUpper, CblasTrans, 2, 0, + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, CblasUpper, CblasTrans, 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_csyr2k(CblasRowMajor, CblasLower, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, CblasLower, CblasNoTrans, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_csyr2k(CblasRowMajor, CblasLower, CblasTrans, 2, 0, + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, CblasLower, CblasTrans, 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_csyr2k(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_csyr2k)(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_csyr2k(CblasColMajor, CblasUpper, CblasTrans, 0, 2, + API_SUFFIX(cblas_csyr2k)(CblasColMajor, CblasUpper, CblasTrans, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_csyr2k(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_csyr2k)(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_csyr2k(CblasColMajor, CblasLower, CblasTrans, 0, 2, + API_SUFFIX(cblas_csyr2k)(CblasColMajor, CblasLower, CblasTrans, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_csyr2k(CblasRowMajor, CblasUpper, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_csyr2k(CblasRowMajor, CblasUpper, CblasTrans, 2, 0, + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, CblasUpper, CblasTrans, 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_csyr2k(CblasRowMajor, CblasLower, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_csyr2k(CblasRowMajor, CblasLower, CblasTrans, 2, 0, + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, CblasLower, CblasTrans, 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_csyr2k(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_csyr2k)(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_csyr2k(CblasColMajor, CblasUpper, CblasTrans, 2, 0, + API_SUFFIX(cblas_csyr2k)(CblasColMajor, CblasUpper, CblasTrans, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_csyr2k(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_csyr2k)(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_csyr2k(CblasColMajor, CblasLower, CblasTrans, 2, 0, + API_SUFFIX(cblas_csyr2k)(CblasColMajor, CblasLower, CblasTrans, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); } if (cblas_ok == 1 ) - printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout); + printf(" %-13s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout); else printf("***** %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout); + printf(" %-13s ERROR-EXIT TESTS:%9d RUN,%9d FAILED\n", + cblas_rout, (int) cblas_xtests, (int) cblas_xfails); } diff --git a/CBLAS/testing/c_cblas1.c b/CBLAS/testing/c_cblas1.c index 81a5b843b5..7761f32e4c 100644 --- a/CBLAS/testing/c_cblas1.c +++ b/CBLAS/testing/c_cblas1.c @@ -8,67 +8,75 @@ */ #include "cblas_test.h" #include "cblas.h" -void F77_caxpy(const int *N, const void *alpha, void *X, - const int *incX, void *Y, const int *incY) +void F77_caxpy(const CBLAS_INT *N, const void *alpha, void *X, + const CBLAS_INT *incX, void *Y, const CBLAS_INT *incY) { - cblas_caxpy(*N, alpha, X, *incX, Y, *incY); + API_SUFFIX(cblas_caxpy)(*N, alpha, X, *incX, Y, *incY); return; } -void F77_ccopy(const int *N, void *X, const int *incX, - void *Y, const int *incY) +void F77_caxpby(const CBLAS_INT *N, const void *alpha, void *X, + const CBLAS_INT *incX, const void *beta, void *Y, const CBLAS_INT *incY) { - cblas_ccopy(*N, X, *incX, Y, *incY); + API_SUFFIX(cblas_caxpby)(*N, alpha, X, *incX, beta, Y, *incY); return; } -void F77_cdotc(const int *N, void *X, const int *incX, - void *Y, const int *incY, void *dotc) + +void F77_ccopy(const CBLAS_INT *N, void *X, const CBLAS_INT *incX, + void *Y, const CBLAS_INT *incY) +{ + API_SUFFIX(cblas_ccopy)(*N, X, *incX, Y, *incY); + return; +} + +void F77_cdotc(const CBLAS_INT *N, void *X, const CBLAS_INT *incX, + void *Y, const CBLAS_INT *incY, void *dotc) { - cblas_cdotc_sub(*N, X, *incX, Y, *incY, dotc); + API_SUFFIX(cblas_cdotc_sub)(*N, X, *incX, Y, *incY, dotc); return; } -void F77_cdotu(const int *N, void *X, const int *incX, - void *Y, const int *incY,void *dotu) +void F77_cdotu(const CBLAS_INT *N, void *X, const CBLAS_INT *incX, + void *Y, const CBLAS_INT *incY,void *dotu) { - cblas_cdotu_sub(*N, X, *incX, Y, *incY, dotu); + API_SUFFIX(cblas_cdotu_sub)(*N, X, *incX, Y, *incY, dotu); return; } -void F77_cscal(const int *N, const void * *alpha, void *X, - const int *incX) +void F77_cscal(const CBLAS_INT *N, const void * *alpha, void *X, + const CBLAS_INT *incX) { - cblas_cscal(*N, alpha, X, *incX); + API_SUFFIX(cblas_cscal)(*N, alpha, X, *incX); return; } -void F77_csscal(const int *N, const float *alpha, void *X, - const int *incX) +void F77_csscal(const CBLAS_INT *N, const float *alpha, void *X, + const CBLAS_INT *incX) { - cblas_csscal(*N, *alpha, X, *incX); + API_SUFFIX(cblas_csscal)(*N, *alpha, X, *incX); return; } -void F77_cswap( const int *N, void *X, const int *incX, - void *Y, const int *incY) +void F77_cswap( const CBLAS_INT *N, void *X, const CBLAS_INT *incX, + void *Y, const CBLAS_INT *incY) { - cblas_cswap(*N,X,*incX,Y,*incY); + API_SUFFIX(cblas_cswap)(*N,X,*incX,Y,*incY); return; } -int F77_icamax(const int *N, const void *X, const int *incX) +CBLAS_INT F77_icamax(const CBLAS_INT *N, const void *X, const CBLAS_INT *incX) { if (*N < 1 || *incX < 1) return(0); - return (cblas_icamax(*N, X, *incX)+1); + return (API_SUFFIX(cblas_icamax)(*N, X, *incX)+1); } -float F77_scnrm2(const int *N, const void *X, const int *incX) +float F77_scnrm2(const CBLAS_INT *N, const void *X, const CBLAS_INT *incX) { - return cblas_scnrm2(*N, X, *incX); + return API_SUFFIX(cblas_scnrm2)(*N, X, *incX); } -float F77_scasum(const int *N, void *X, const int *incX) +float F77_scasum(const CBLAS_INT *N, void *X, const CBLAS_INT *incX) { - return cblas_scasum(*N, X, *incX); + return API_SUFFIX(cblas_scasum)(*N, X, *incX); } diff --git a/CBLAS/testing/c_cblas2.c b/CBLAS/testing/c_cblas2.c index bb7e644854..80c3d47f94 100644 --- a/CBLAS/testing/c_cblas2.c +++ b/CBLAS/testing/c_cblas2.c @@ -8,13 +8,17 @@ #include "cblas.h" #include "cblas_test.h" -void F77_cgemv(int *layout, char *transp, int *m, int *n, +void F77_cgemv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, const void *alpha, - CBLAS_TEST_COMPLEX *a, int *lda, const void *x, int *incx, - const void *beta, void *y, int *incy) { + CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, const void *x, CBLAS_INT *incx, + const void *beta, void *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN transp_len +#endif +) { CBLAS_TEST_COMPLEX *A; - int i,j,LDA; + CBLAS_INT i,j,LDA; CBLAS_TRANSPOSE trans; get_transpose_type(transp, &trans); @@ -26,25 +30,29 @@ void F77_cgemv(int *layout, char *transp, int *m, int *n, A[ LDA*i+j ].real=a[ (*lda)*j+i ].real; A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag; } - cblas_cgemv( CblasRowMajor, trans, *m, *n, alpha, A, LDA, x, *incx, + API_SUFFIX(cblas_cgemv)( CblasRowMajor, trans, *m, *n, alpha, A, LDA, x, *incx, beta, y, *incy ); free(A); } else if (*layout == TEST_COL_MJR) - cblas_cgemv( CblasColMajor, trans, + API_SUFFIX(cblas_cgemv)( CblasColMajor, trans, *m, *n, alpha, a, *lda, x, *incx, beta, y, *incy ); else - cblas_cgemv( UNDEFINED, trans, + API_SUFFIX(cblas_cgemv)( INVALID_LAYOUT, trans, *m, *n, alpha, a, *lda, x, *incx, beta, y, *incy ); } -void F77_cgbmv(int *layout, char *transp, int *m, int *n, int *kl, int *ku, - CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda, - CBLAS_TEST_COMPLEX *x, int *incx, - CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, int *incy) { +void F77_cgbmv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, CBLAS_INT *kl, CBLAS_INT *ku, + CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, + CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, + CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN transp_len +#endif +) { CBLAS_TEST_COMPLEX *A; - int i,j,irow,jcol,LDA; + CBLAS_INT i,j,irow,jcol,LDA; CBLAS_TRANSPOSE trans; get_transpose_type(transp, &trans); @@ -73,24 +81,24 @@ void F77_cgbmv(int *layout, char *transp, int *m, int *n, int *kl, int *ku, A[ LDA*j+irow ].imag=a[ (*lda)*(j-jcol)+i ].imag; } } - cblas_cgbmv( CblasRowMajor, trans, *m, *n, *kl, *ku, alpha, A, LDA, x, + API_SUFFIX(cblas_cgbmv)( CblasRowMajor, trans, *m, *n, *kl, *ku, alpha, A, LDA, x, *incx, beta, y, *incy ); free(A); } else if (*layout == TEST_COL_MJR) - cblas_cgbmv( CblasColMajor, trans, *m, *n, *kl, *ku, alpha, a, *lda, x, + API_SUFFIX(cblas_cgbmv)( CblasColMajor, trans, *m, *n, *kl, *ku, alpha, a, *lda, x, *incx, beta, y, *incy ); else - cblas_cgbmv( UNDEFINED, trans, *m, *n, *kl, *ku, alpha, a, *lda, x, + API_SUFFIX(cblas_cgbmv)( INVALID_LAYOUT, trans, *m, *n, *kl, *ku, alpha, a, *lda, x, *incx, beta, y, *incy ); } -void F77_cgeru(int *layout, int *m, int *n, CBLAS_TEST_COMPLEX *alpha, - CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *y, int *incy, - CBLAS_TEST_COMPLEX *a, int *lda){ +void F77_cgeru(CBLAS_INT *layout, CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha, + CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy, + CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda){ CBLAS_TEST_COMPLEX *A; - int i,j,LDA; + CBLAS_INT i,j,LDA; if (*layout == TEST_ROW_MJR) { LDA = *n+1; @@ -100,7 +108,7 @@ void F77_cgeru(int *layout, int *m, int *n, CBLAS_TEST_COMPLEX *alpha, A[ LDA*i+j ].real=a[ (*lda)*j+i ].real; A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag; } - cblas_cgeru( CblasRowMajor, *m, *n, alpha, x, *incx, y, *incy, A, LDA ); + API_SUFFIX(cblas_cgeru)( CblasRowMajor, *m, *n, alpha, x, *incx, y, *incy, A, LDA ); for( i=0; i<*m; i++ ) for( j=0; j<*n; j++ ){ a[ (*lda)*j+i ].real=A[ LDA*i+j ].real; @@ -109,16 +117,16 @@ void F77_cgeru(int *layout, int *m, int *n, CBLAS_TEST_COMPLEX *alpha, free(A); } else if (*layout == TEST_COL_MJR) - cblas_cgeru( CblasColMajor, *m, *n, alpha, x, *incx, y, *incy, a, *lda ); + API_SUFFIX(cblas_cgeru)( CblasColMajor, *m, *n, alpha, x, *incx, y, *incy, a, *lda ); else - cblas_cgeru( UNDEFINED, *m, *n, alpha, x, *incx, y, *incy, a, *lda ); + API_SUFFIX(cblas_cgeru)( INVALID_LAYOUT, *m, *n, alpha, x, *incx, y, *incy, a, *lda ); } -void F77_cgerc(int *layout, int *m, int *n, CBLAS_TEST_COMPLEX *alpha, - CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *y, int *incy, - CBLAS_TEST_COMPLEX *a, int *lda) { +void F77_cgerc(CBLAS_INT *layout, CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha, + CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy, + CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda) { CBLAS_TEST_COMPLEX *A; - int i,j,LDA; + CBLAS_INT i,j,LDA; if (*layout == TEST_ROW_MJR) { LDA = *n+1; @@ -128,7 +136,7 @@ void F77_cgerc(int *layout, int *m, int *n, CBLAS_TEST_COMPLEX *alpha, A[ LDA*i+j ].real=a[ (*lda)*j+i ].real; A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag; } - cblas_cgerc( CblasRowMajor, *m, *n, alpha, x, *incx, y, *incy, A, LDA ); + API_SUFFIX(cblas_cgerc)( CblasRowMajor, *m, *n, alpha, x, *incx, y, *incy, A, LDA ); for( i=0; i<*m; i++ ) for( j=0; j<*n; j++ ){ a[ (*lda)*j+i ].real=A[ LDA*i+j ].real; @@ -137,17 +145,21 @@ void F77_cgerc(int *layout, int *m, int *n, CBLAS_TEST_COMPLEX *alpha, free(A); } else if (*layout == TEST_COL_MJR) - cblas_cgerc( CblasColMajor, *m, *n, alpha, x, *incx, y, *incy, a, *lda ); + API_SUFFIX(cblas_cgerc)( CblasColMajor, *m, *n, alpha, x, *incx, y, *incy, a, *lda ); else - cblas_cgerc( UNDEFINED, *m, *n, alpha, x, *incx, y, *incy, a, *lda ); + API_SUFFIX(cblas_cgerc)( INVALID_LAYOUT, *m, *n, alpha, x, *incx, y, *incy, a, *lda ); } -void F77_chemv(int *layout, char *uplow, int *n, CBLAS_TEST_COMPLEX *alpha, - CBLAS_TEST_COMPLEX *a, int *lda, CBLAS_TEST_COMPLEX *x, - int *incx, CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, int *incy){ +void F77_chemv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha, + CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *x, + CBLAS_INT *incx, CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len +#endif +){ CBLAS_TEST_COMPLEX *A; - int i,j,LDA; + CBLAS_INT i,j,LDA; CBLAS_UPLO uplo; get_uplo_type(uplow,&uplo); @@ -160,25 +172,29 @@ void F77_chemv(int *layout, char *uplow, int *n, CBLAS_TEST_COMPLEX *alpha, A[ LDA*i+j ].real=a[ (*lda)*j+i ].real; A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag; } - cblas_chemv( CblasRowMajor, uplo, *n, alpha, A, LDA, x, *incx, + API_SUFFIX(cblas_chemv)( CblasRowMajor, uplo, *n, alpha, A, LDA, x, *incx, beta, y, *incy ); free(A); } else if (*layout == TEST_COL_MJR) - cblas_chemv( CblasColMajor, uplo, *n, alpha, a, *lda, x, *incx, + API_SUFFIX(cblas_chemv)( CblasColMajor, uplo, *n, alpha, a, *lda, x, *incx, beta, y, *incy ); else - cblas_chemv( UNDEFINED, uplo, *n, alpha, a, *lda, x, *incx, + API_SUFFIX(cblas_chemv)( INVALID_LAYOUT, uplo, *n, alpha, a, *lda, x, *incx, beta, y, *incy ); } -void F77_chbmv(int *layout, char *uplow, int *n, int *k, - CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda, - CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *beta, - CBLAS_TEST_COMPLEX *y, int *incy){ +void F77_chbmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_INT *k, + CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, + CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *beta, + CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len +#endif +){ CBLAS_TEST_COMPLEX *A; -int i,irow,j,jcol,LDA; +CBLAS_INT i,irow,j,jcol,LDA; CBLAS_UPLO uplo; @@ -186,7 +202,7 @@ int i,irow,j,jcol,LDA; if (*layout == TEST_ROW_MJR) { if (uplo != CblasUpper && uplo != CblasLower ) - cblas_chbmv(CblasRowMajor, UNDEFINED, *n, *k, alpha, a, *lda, x, + API_SUFFIX(cblas_chbmv)(CblasRowMajor, INVALID_UPLO, *n, *k, alpha, a, *lda, x, *incx, beta, y, *incy ); else { LDA = *k+2; @@ -223,31 +239,35 @@ int i,irow,j,jcol,LDA; } } } - cblas_chbmv( CblasRowMajor, uplo, *n, *k, alpha, A, LDA, x, *incx, + API_SUFFIX(cblas_chbmv)( CblasRowMajor, uplo, *n, *k, alpha, A, LDA, x, *incx, beta, y, *incy ); free(A); } } else if (*layout == TEST_COL_MJR) - cblas_chbmv(CblasColMajor, uplo, *n, *k, alpha, a, *lda, x, *incx, + API_SUFFIX(cblas_chbmv)(CblasColMajor, uplo, *n, *k, alpha, a, *lda, x, *incx, beta, y, *incy ); else - cblas_chbmv(UNDEFINED, uplo, *n, *k, alpha, a, *lda, x, *incx, + API_SUFFIX(cblas_chbmv)(INVALID_LAYOUT, uplo, *n, *k, alpha, a, *lda, x, *incx, beta, y, *incy ); } -void F77_chpmv(int *layout, char *uplow, int *n, CBLAS_TEST_COMPLEX *alpha, - CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, int *incx, - CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, int *incy){ +void F77_chpmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha, + CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, + CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len +#endif +){ CBLAS_TEST_COMPLEX *A, *AP; - int i,j,k,LDA; + CBLAS_INT i,j,k,LDA; CBLAS_UPLO uplo; get_uplo_type(uplow,&uplo); if (*layout == TEST_ROW_MJR) { if (uplo != CblasUpper && uplo != CblasLower ) - cblas_chpmv(CblasRowMajor, UNDEFINED, *n, alpha, ap, x, *incx, + API_SUFFIX(cblas_chpmv)(CblasRowMajor, INVALID_UPLO, *n, alpha, ap, x, *incx, beta, y, *incy); else { LDA = *n; @@ -278,25 +298,29 @@ void F77_chpmv(int *layout, char *uplow, int *n, CBLAS_TEST_COMPLEX *alpha, AP[ k ].imag=A[ LDA*i+j ].imag; } } - cblas_chpmv( CblasRowMajor, uplo, *n, alpha, AP, x, *incx, beta, y, + API_SUFFIX(cblas_chpmv)( CblasRowMajor, uplo, *n, alpha, AP, x, *incx, beta, y, *incy ); free(A); free(AP); } } else if (*layout == TEST_COL_MJR) - cblas_chpmv( CblasColMajor, uplo, *n, alpha, ap, x, *incx, beta, y, + API_SUFFIX(cblas_chpmv)( CblasColMajor, uplo, *n, alpha, ap, x, *incx, beta, y, *incy ); else - cblas_chpmv( UNDEFINED, uplo, *n, alpha, ap, x, *incx, beta, y, + API_SUFFIX(cblas_chpmv)( INVALID_LAYOUT, uplo, *n, alpha, ap, x, *incx, beta, y, *incy ); } -void F77_ctbmv(int *layout, char *uplow, char *transp, char *diagn, - int *n, int *k, CBLAS_TEST_COMPLEX *a, int *lda, CBLAS_TEST_COMPLEX *x, - int *incx) { +void F77_ctbmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, + CBLAS_INT *n, CBLAS_INT *k, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *x, + CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len +#endif +) { CBLAS_TEST_COMPLEX *A; - int irow, jcol, i, j, LDA; + CBLAS_INT irow, jcol, i, j, LDA; CBLAS_TRANSPOSE trans; CBLAS_UPLO uplo; CBLAS_DIAG diag; @@ -307,7 +331,7 @@ void F77_ctbmv(int *layout, char *uplow, char *transp, char *diagn, if (*layout == TEST_ROW_MJR) { if (uplo != CblasUpper && uplo != CblasLower ) - cblas_ctbmv(CblasRowMajor, UNDEFINED, trans, diag, *n, *k, a, *lda, + API_SUFFIX(cblas_ctbmv)(CblasRowMajor, INVALID_UPLO, trans, diag, *n, *k, a, *lda, x, *incx); else { LDA = *k+2; @@ -344,23 +368,27 @@ void F77_ctbmv(int *layout, char *uplow, char *transp, char *diagn, } } } - cblas_ctbmv(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, x, + API_SUFFIX(cblas_ctbmv)(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, x, *incx); free(A); } } else if (*layout == TEST_COL_MJR) - cblas_ctbmv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx); + API_SUFFIX(cblas_ctbmv)(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx); else - cblas_ctbmv(UNDEFINED, uplo, trans, diag, *n, *k, a, *lda, x, *incx); + API_SUFFIX(cblas_ctbmv)(INVALID_LAYOUT, uplo, trans, diag, *n, *k, a, *lda, x, *incx); } -void F77_ctbsv(int *layout, char *uplow, char *transp, char *diagn, - int *n, int *k, CBLAS_TEST_COMPLEX *a, int *lda, CBLAS_TEST_COMPLEX *x, - int *incx) { +void F77_ctbsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, + CBLAS_INT *n, CBLAS_INT *k, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *x, + CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len +#endif +) { CBLAS_TEST_COMPLEX *A; - int irow, jcol, i, j, LDA; + CBLAS_INT irow, jcol, i, j, LDA; CBLAS_TRANSPOSE trans; CBLAS_UPLO uplo; CBLAS_DIAG diag; @@ -371,7 +399,7 @@ void F77_ctbsv(int *layout, char *uplow, char *transp, char *diagn, if (*layout == TEST_ROW_MJR) { if (uplo != CblasUpper && uplo != CblasLower ) - cblas_ctbsv(CblasRowMajor, UNDEFINED, trans, diag, *n, *k, a, *lda, x, + API_SUFFIX(cblas_ctbsv)(CblasRowMajor, INVALID_UPLO, trans, diag, *n, *k, a, *lda, x, *incx); else { LDA = *k+2; @@ -408,21 +436,25 @@ void F77_ctbsv(int *layout, char *uplow, char *transp, char *diagn, } } } - cblas_ctbsv(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, + API_SUFFIX(cblas_ctbsv)(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, x, *incx); free(A); } } else if (*layout == TEST_COL_MJR) - cblas_ctbsv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx); + API_SUFFIX(cblas_ctbsv)(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx); else - cblas_ctbsv(UNDEFINED, uplo, trans, diag, *n, *k, a, *lda, x, *incx); + API_SUFFIX(cblas_ctbsv)(INVALID_LAYOUT, uplo, trans, diag, *n, *k, a, *lda, x, *incx); } -void F77_ctpmv(int *layout, char *uplow, char *transp, char *diagn, - int *n, CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, int *incx) { +void F77_ctpmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, + CBLAS_INT *n, CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len , FORTRAN_STRLEN diagn_len +#endif +) { CBLAS_TEST_COMPLEX *A, *AP; - int i, j, k, LDA; + CBLAS_INT i, j, k, LDA; CBLAS_TRANSPOSE trans; CBLAS_UPLO uplo; CBLAS_DIAG diag; @@ -433,7 +465,7 @@ void F77_ctpmv(int *layout, char *uplow, char *transp, char *diagn, if (*layout == TEST_ROW_MJR) { if (uplo != CblasUpper && uplo != CblasLower ) - cblas_ctpmv( CblasRowMajor, UNDEFINED, trans, diag, *n, ap, x, *incx ); + API_SUFFIX(cblas_ctpmv)( CblasRowMajor, INVALID_UPLO, trans, diag, *n, ap, x, *incx ); else { LDA = *n; A=(CBLAS_TEST_COMPLEX*)malloc(LDA*LDA*sizeof(CBLAS_TEST_COMPLEX)); @@ -463,21 +495,25 @@ void F77_ctpmv(int *layout, char *uplow, char *transp, char *diagn, AP[ k ].imag=A[ LDA*i+j ].imag; } } - cblas_ctpmv( CblasRowMajor, uplo, trans, diag, *n, AP, x, *incx ); + API_SUFFIX(cblas_ctpmv)( CblasRowMajor, uplo, trans, diag, *n, AP, x, *incx ); free(A); free(AP); } } else if (*layout == TEST_COL_MJR) - cblas_ctpmv( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx ); + API_SUFFIX(cblas_ctpmv)( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx ); else - cblas_ctpmv( UNDEFINED, uplo, trans, diag, *n, ap, x, *incx ); + API_SUFFIX(cblas_ctpmv)( INVALID_LAYOUT, uplo, trans, diag, *n, ap, x, *incx ); } -void F77_ctpsv(int *layout, char *uplow, char *transp, char *diagn, - int *n, CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, int *incx) { +void F77_ctpsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, + CBLAS_INT *n, CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len +#endif +) { CBLAS_TEST_COMPLEX *A, *AP; - int i, j, k, LDA; + CBLAS_INT i, j, k, LDA; CBLAS_TRANSPOSE trans; CBLAS_UPLO uplo; CBLAS_DIAG diag; @@ -488,7 +524,7 @@ void F77_ctpsv(int *layout, char *uplow, char *transp, char *diagn, if (*layout == TEST_ROW_MJR) { if (uplo != CblasUpper && uplo != CblasLower ) - cblas_ctpsv( CblasRowMajor, UNDEFINED, trans, diag, *n, ap, x, *incx ); + API_SUFFIX(cblas_ctpsv)( CblasRowMajor, INVALID_UPLO, trans, diag, *n, ap, x, *incx ); else { LDA = *n; A=(CBLAS_TEST_COMPLEX*)malloc(LDA*LDA*sizeof(CBLAS_TEST_COMPLEX)); @@ -518,22 +554,26 @@ void F77_ctpsv(int *layout, char *uplow, char *transp, char *diagn, AP[ k ].imag=A[ LDA*i+j ].imag; } } - cblas_ctpsv( CblasRowMajor, uplo, trans, diag, *n, AP, x, *incx ); + API_SUFFIX(cblas_ctpsv)( CblasRowMajor, uplo, trans, diag, *n, AP, x, *incx ); free(A); free(AP); } } else if (*layout == TEST_COL_MJR) - cblas_ctpsv( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx ); + API_SUFFIX(cblas_ctpsv)( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx ); else - cblas_ctpsv( UNDEFINED, uplo, trans, diag, *n, ap, x, *incx ); + API_SUFFIX(cblas_ctpsv)( INVALID_LAYOUT, uplo, trans, diag, *n, ap, x, *incx ); } -void F77_ctrmv(int *layout, char *uplow, char *transp, char *diagn, - int *n, CBLAS_TEST_COMPLEX *a, int *lda, CBLAS_TEST_COMPLEX *x, - int *incx) { +void F77_ctrmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, + CBLAS_INT *n, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *x, + CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len +#endif +) { CBLAS_TEST_COMPLEX *A; - int i,j,LDA; + CBLAS_INT i,j,LDA; CBLAS_TRANSPOSE trans; CBLAS_UPLO uplo; CBLAS_DIAG diag; @@ -550,19 +590,23 @@ void F77_ctrmv(int *layout, char *uplow, char *transp, char *diagn, A[ LDA*i+j ].real=a[ (*lda)*j+i ].real; A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag; } - cblas_ctrmv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx); + API_SUFFIX(cblas_ctrmv)(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx); free(A); } else if (*layout == TEST_COL_MJR) - cblas_ctrmv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx); + API_SUFFIX(cblas_ctrmv)(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx); else - cblas_ctrmv(UNDEFINED, uplo, trans, diag, *n, a, *lda, x, *incx); + API_SUFFIX(cblas_ctrmv)(INVALID_LAYOUT, uplo, trans, diag, *n, a, *lda, x, *incx); } -void F77_ctrsv(int *layout, char *uplow, char *transp, char *diagn, - int *n, CBLAS_TEST_COMPLEX *a, int *lda, CBLAS_TEST_COMPLEX *x, - int *incx) { +void F77_ctrsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, + CBLAS_INT *n, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *x, + CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len +#endif +) { CBLAS_TEST_COMPLEX *A; - int i,j,LDA; + CBLAS_INT i,j,LDA; CBLAS_TRANSPOSE trans; CBLAS_UPLO uplo; CBLAS_DIAG diag; @@ -579,26 +623,30 @@ void F77_ctrsv(int *layout, char *uplow, char *transp, char *diagn, A[ LDA*i+j ].real=a[ (*lda)*j+i ].real; A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag; } - cblas_ctrsv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx ); + API_SUFFIX(cblas_ctrsv)(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx ); free(A); } else if (*layout == TEST_COL_MJR) - cblas_ctrsv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx ); + API_SUFFIX(cblas_ctrsv)(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx ); else - cblas_ctrsv(UNDEFINED, uplo, trans, diag, *n, a, *lda, x, *incx ); + API_SUFFIX(cblas_ctrsv)(INVALID_LAYOUT, uplo, trans, diag, *n, a, *lda, x, *incx ); } -void F77_chpr(int *layout, char *uplow, int *n, float *alpha, - CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *ap) { +void F77_chpr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, + CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *ap +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len +#endif +) { CBLAS_TEST_COMPLEX *A, *AP; - int i,j,k,LDA; + CBLAS_INT i,j,k,LDA; CBLAS_UPLO uplo; get_uplo_type(uplow,&uplo); if (*layout == TEST_ROW_MJR) { if (uplo != CblasUpper && uplo != CblasLower ) - cblas_chpr(CblasRowMajor, UNDEFINED, *n, *alpha, x, *incx, ap ); + API_SUFFIX(cblas_chpr)(CblasRowMajor, INVALID_UPLO, *n, *alpha, x, *incx, ap ); else { LDA = *n; A = (CBLAS_TEST_COMPLEX* )malloc(LDA*LDA*sizeof(CBLAS_TEST_COMPLEX ) ); @@ -628,7 +676,7 @@ void F77_chpr(int *layout, char *uplow, int *n, float *alpha, AP[ k ].imag=A[ LDA*i+j ].imag; } } - cblas_chpr(CblasRowMajor, uplo, *n, *alpha, x, *incx, AP ); + API_SUFFIX(cblas_chpr)(CblasRowMajor, uplo, *n, *alpha, x, *incx, AP ); if (uplo == CblasUpper) { for( i=0, k=0; i<*n; i++ ) for( j=i; j<*n; j++, k++ ){ @@ -658,23 +706,27 @@ void F77_chpr(int *layout, char *uplow, int *n, float *alpha, } } else if (*layout == TEST_COL_MJR) - cblas_chpr(CblasColMajor, uplo, *n, *alpha, x, *incx, ap ); + API_SUFFIX(cblas_chpr)(CblasColMajor, uplo, *n, *alpha, x, *incx, ap ); else - cblas_chpr(UNDEFINED, uplo, *n, *alpha, x, *incx, ap ); + API_SUFFIX(cblas_chpr)(INVALID_LAYOUT, uplo, *n, *alpha, x, *incx, ap ); } -void F77_chpr2(int *layout, char *uplow, int *n, CBLAS_TEST_COMPLEX *alpha, - CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *y, int *incy, - CBLAS_TEST_COMPLEX *ap) { +void F77_chpr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha, + CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy, + CBLAS_TEST_COMPLEX *ap +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len +#endif +) { CBLAS_TEST_COMPLEX *A, *AP; - int i,j,k,LDA; + CBLAS_INT i,j,k,LDA; CBLAS_UPLO uplo; get_uplo_type(uplow,&uplo); if (*layout == TEST_ROW_MJR) { if (uplo != CblasUpper && uplo != CblasLower ) - cblas_chpr2( CblasRowMajor, UNDEFINED, *n, alpha, x, *incx, y, + API_SUFFIX(cblas_chpr2)( CblasRowMajor, INVALID_UPLO, *n, alpha, x, *incx, y, *incy, ap ); else { LDA = *n; @@ -705,7 +757,7 @@ void F77_chpr2(int *layout, char *uplow, int *n, CBLAS_TEST_COMPLEX *alpha, AP[ k ].imag=A[ LDA*i+j ].imag; } } - cblas_chpr2( CblasRowMajor, uplo, *n, alpha, x, *incx, y, *incy, AP ); + API_SUFFIX(cblas_chpr2)( CblasRowMajor, uplo, *n, alpha, x, *incx, y, *incy, AP ); if (uplo == CblasUpper) { for( i=0, k=0; i<*n; i++ ) for( j=i; j<*n; j++, k++ ) { @@ -735,15 +787,19 @@ void F77_chpr2(int *layout, char *uplow, int *n, CBLAS_TEST_COMPLEX *alpha, } } else if (*layout == TEST_COL_MJR) - cblas_chpr2( CblasColMajor, uplo, *n, alpha, x, *incx, y, *incy, ap ); + API_SUFFIX(cblas_chpr2)( CblasColMajor, uplo, *n, alpha, x, *incx, y, *incy, ap ); else - cblas_chpr2( UNDEFINED, uplo, *n, alpha, x, *incx, y, *incy, ap ); + API_SUFFIX(cblas_chpr2)( INVALID_LAYOUT, uplo, *n, alpha, x, *incx, y, *incy, ap ); } -void F77_cher(int *layout, char *uplow, int *n, float *alpha, - CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *a, int *lda) { +void F77_cher(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, + CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len +#endif +) { CBLAS_TEST_COMPLEX *A; - int i,j,LDA; + CBLAS_INT i,j,LDA; CBLAS_UPLO uplo; get_uplo_type(uplow,&uplo); @@ -758,7 +814,7 @@ void F77_cher(int *layout, char *uplow, int *n, float *alpha, A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag; } - cblas_cher(CblasRowMajor, uplo, *n, *alpha, x, *incx, A, LDA ); + API_SUFFIX(cblas_cher)(CblasRowMajor, uplo, *n, *alpha, x, *incx, A, LDA ); for( i=0; i<*n; i++ ) for( j=0; j<*n; j++ ) { a[ (*lda)*j+i ].real=A[ LDA*i+j ].real; @@ -767,17 +823,21 @@ void F77_cher(int *layout, char *uplow, int *n, float *alpha, free(A); } else if (*layout == TEST_COL_MJR) - cblas_cher( CblasColMajor, uplo, *n, *alpha, x, *incx, a, *lda ); + API_SUFFIX(cblas_cher)( CblasColMajor, uplo, *n, *alpha, x, *incx, a, *lda ); else - cblas_cher( UNDEFINED, uplo, *n, *alpha, x, *incx, a, *lda ); + API_SUFFIX(cblas_cher)( INVALID_LAYOUT, uplo, *n, *alpha, x, *incx, a, *lda ); } -void F77_cher2(int *layout, char *uplow, int *n, CBLAS_TEST_COMPLEX *alpha, - CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *y, int *incy, - CBLAS_TEST_COMPLEX *a, int *lda) { +void F77_cher2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha, + CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy, + CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len +#endif +) { CBLAS_TEST_COMPLEX *A; - int i,j,LDA; + CBLAS_INT i,j,LDA; CBLAS_UPLO uplo; get_uplo_type(uplow,&uplo); @@ -792,7 +852,7 @@ void F77_cher2(int *layout, char *uplow, int *n, CBLAS_TEST_COMPLEX *alpha, A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag; } - cblas_cher2(CblasRowMajor, uplo, *n, alpha, x, *incx, y, *incy, A, LDA ); + API_SUFFIX(cblas_cher2)(CblasRowMajor, uplo, *n, alpha, x, *incx, y, *incy, A, LDA ); for( i=0; i<*n; i++ ) for( j=0; j<*n; j++ ) { a[ (*lda)*j+i ].real=A[ LDA*i+j ].real; @@ -801,7 +861,7 @@ void F77_cher2(int *layout, char *uplow, int *n, CBLAS_TEST_COMPLEX *alpha, free(A); } else if (*layout == TEST_COL_MJR) - cblas_cher2( CblasColMajor, uplo, *n, alpha, x, *incx, y, *incy, a, *lda); + API_SUFFIX(cblas_cher2)( CblasColMajor, uplo, *n, alpha, x, *incx, y, *incy, a, *lda); else - cblas_cher2( UNDEFINED, uplo, *n, alpha, x, *incx, y, *incy, a, *lda); + API_SUFFIX(cblas_cher2)( INVALID_LAYOUT, uplo, *n, alpha, x, *incx, y, *incy, a, *lda); } diff --git a/CBLAS/testing/c_cblas3.c b/CBLAS/testing/c_cblas3.c index e0e41230f4..99ac80e64a 100644 --- a/CBLAS/testing/c_cblas3.c +++ b/CBLAS/testing/c_cblas3.c @@ -7,17 +7,18 @@ #include #include "cblas.h" #include "cblas_test.h" -#define TEST_COL_MJR 0 -#define TEST_ROW_MJR 1 -#define UNDEFINED -1 -void F77_cgemm(int *layout, char *transpa, char *transpb, int *m, int *n, - int *k, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda, - CBLAS_TEST_COMPLEX *b, int *ldb, CBLAS_TEST_COMPLEX *beta, - CBLAS_TEST_COMPLEX *c, int *ldc ) { +void F77_cgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CBLAS_INT *n, + CBLAS_INT *k, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, + CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_COMPLEX *beta, + CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN transpa_len, FORTRAN_STRLEN transpb_len +#endif +) { CBLAS_TEST_COMPLEX *A, *B, *C; - int i,j,LDA, LDB, LDC; + CBLAS_INT i,j,LDA, LDB, LDC; CBLAS_TRANSPOSE transa, transb; get_transpose_type(transpa, &transa); @@ -69,7 +70,7 @@ void F77_cgemm(int *layout, char *transpa, char *transpb, int *m, int *n, C[i*LDC+j].real=c[j*(*ldc)+i].real; C[i*LDC+j].imag=c[j*(*ldc)+i].imag; } - cblas_cgemm( CblasRowMajor, transa, transb, *m, *n, *k, alpha, A, LDA, + API_SUFFIX(cblas_cgemm)( CblasRowMajor, transa, transb, *m, *n, *k, alpha, A, LDA, B, LDB, beta, C, LDC ); for( j=0; j<*n; j++ ) for( i=0; i<*m; i++ ) { @@ -81,19 +82,104 @@ void F77_cgemm(int *layout, char *transpa, char *transpb, int *m, int *n, free(C); } else if (*layout == TEST_COL_MJR) - cblas_cgemm( CblasColMajor, transa, transb, *m, *n, *k, alpha, a, *lda, + API_SUFFIX(cblas_cgemm)( CblasColMajor, transa, transb, *m, *n, *k, alpha, a, *lda, b, *ldb, beta, c, *ldc ); else - cblas_cgemm( UNDEFINED, transa, transb, *m, *n, *k, alpha, a, *lda, + API_SUFFIX(cblas_cgemm)( INVALID_LAYOUT, transa, transb, *m, *n, *k, alpha, a, *lda, b, *ldb, beta, c, *ldc ); } -void F77_chemm(int *layout, char *rtlf, char *uplow, int *m, int *n, - CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda, - CBLAS_TEST_COMPLEX *b, int *ldb, CBLAS_TEST_COMPLEX *beta, - CBLAS_TEST_COMPLEX *c, int *ldc ) { + +void F77_cgemmtr(CBLAS_INT *layout, char *uplop, char *transpa, char *transpb, CBLAS_INT *n, + CBLAS_INT *k, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, + CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_COMPLEX *beta, + CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc ) { + + CBLAS_TEST_COMPLEX *A, *B, *C; + CBLAS_INT i,j,LDA, LDB, LDC; + CBLAS_TRANSPOSE transa, transb; + CBLAS_UPLO uplo; + + get_transpose_type(transpa, &transa); + get_transpose_type(transpb, &transb); + get_uplo_type(uplop, &uplo); + + if (*layout == TEST_ROW_MJR) { + if (transa == CblasNoTrans) { + LDA = *k+1; + A=(CBLAS_TEST_COMPLEX*)malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX)); + for( i=0; i<*n; i++ ) + for( j=0; j<*k; j++ ) { + A[i*LDA+j].real=a[j*(*lda)+i].real; + A[i*LDA+j].imag=a[j*(*lda)+i].imag; + } + } + else { + LDA = *n+1; + A=(CBLAS_TEST_COMPLEX* )malloc(LDA*(*k)*sizeof(CBLAS_TEST_COMPLEX)); + for( i=0; i<*k; i++ ) + for( j=0; j<*n; j++ ) { + A[i*LDA+j].real=a[j*(*lda)+i].real; + A[i*LDA+j].imag=a[j*(*lda)+i].imag; + } + } + + if (transb == CblasNoTrans) { + LDB = *n+1; + B=(CBLAS_TEST_COMPLEX* )malloc((*k)*LDB*sizeof(CBLAS_TEST_COMPLEX) ); + for( i=0; i<*k; i++ ) + for( j=0; j<*n; j++ ) { + B[i*LDB+j].real=b[j*(*ldb)+i].real; + B[i*LDB+j].imag=b[j*(*ldb)+i].imag; + } + } + else { + LDB = *k+1; + B=(CBLAS_TEST_COMPLEX* )malloc(LDB*(*n)*sizeof(CBLAS_TEST_COMPLEX)); + for( i=0; i<*n; i++ ) + for( j=0; j<*k; j++ ) { + B[i*LDB+j].real=b[j*(*ldb)+i].real; + B[i*LDB+j].imag=b[j*(*ldb)+i].imag; + } + } + + LDC = *n+1; + C=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDC*sizeof(CBLAS_TEST_COMPLEX)); + for( j=0; j<*n; j++ ) + for( i=0; i<*n; i++ ) { + C[i*LDC+j].real=c[j*(*ldc)+i].real; + C[i*LDC+j].imag=c[j*(*ldc)+i].imag; + } + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, uplo, transa, transb, *n, *k, alpha, A, LDA, + B, LDB, beta, C, LDC ); + for( j=0; j<*n; j++ ) + for( i=0; i<*n; i++ ) { + c[j*(*ldc)+i].real=C[i*LDC+j].real; + c[j*(*ldc)+i].imag=C[i*LDC+j].imag; + } + free(A); + free(B); + free(C); + } + else if (*layout == TEST_COL_MJR) + API_SUFFIX(cblas_cgemmtr)( CblasColMajor, uplo, transa, transb, *n, *k, alpha, a, *lda, + b, *ldb, beta, c, *ldc ); + else + API_SUFFIX(cblas_cgemmtr)( INVALID_LAYOUT, uplo, transa, transb, *n, *k, alpha, a, *lda, + b, *ldb, beta, c, *ldc ); +} + + +void F77_chemm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_INT *n, + CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, + CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_COMPLEX *beta, + CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len +#endif +) { CBLAS_TEST_COMPLEX *A, *B, *C; - int i,j,LDA, LDB, LDC; + CBLAS_INT i,j,LDA, LDB, LDC; CBLAS_UPLO uplo; CBLAS_SIDE side; @@ -133,7 +219,7 @@ void F77_chemm(int *layout, char *rtlf, char *uplow, int *m, int *n, C[i*LDC+j].real=c[j*(*ldc)+i].real; C[i*LDC+j].imag=c[j*(*ldc)+i].imag; } - cblas_chemm( CblasRowMajor, side, uplo, *m, *n, alpha, A, LDA, B, LDB, + API_SUFFIX(cblas_chemm)( CblasRowMajor, side, uplo, *m, *n, alpha, A, LDA, B, LDB, beta, C, LDC ); for( j=0; j<*n; j++ ) for( i=0; i<*m; i++ ) { @@ -145,19 +231,23 @@ void F77_chemm(int *layout, char *rtlf, char *uplow, int *m, int *n, free(C); } else if (*layout == TEST_COL_MJR) - cblas_chemm( CblasColMajor, side, uplo, *m, *n, alpha, a, *lda, b, *ldb, + API_SUFFIX(cblas_chemm)( CblasColMajor, side, uplo, *m, *n, alpha, a, *lda, b, *ldb, beta, c, *ldc ); else - cblas_chemm( UNDEFINED, side, uplo, *m, *n, alpha, a, *lda, b, *ldb, + API_SUFFIX(cblas_chemm)( INVALID_LAYOUT, side, uplo, *m, *n, alpha, a, *lda, b, *ldb, beta, c, *ldc ); } -void F77_csymm(int *layout, char *rtlf, char *uplow, int *m, int *n, - CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda, - CBLAS_TEST_COMPLEX *b, int *ldb, CBLAS_TEST_COMPLEX *beta, - CBLAS_TEST_COMPLEX *c, int *ldc ) { +void F77_csymm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_INT *n, + CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, + CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_COMPLEX *beta, + CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len +#endif +) { CBLAS_TEST_COMPLEX *A, *B, *C; - int i,j,LDA, LDB, LDC; + CBLAS_INT i,j,LDA, LDB, LDC; CBLAS_UPLO uplo; CBLAS_SIDE side; @@ -189,7 +279,7 @@ void F77_csymm(int *layout, char *rtlf, char *uplow, int *m, int *n, for( j=0; j<*n; j++ ) for( i=0; i<*m; i++ ) C[i*LDC+j]=c[j*(*ldc)+i]; - cblas_csymm( CblasRowMajor, side, uplo, *m, *n, alpha, A, LDA, B, LDB, + API_SUFFIX(cblas_csymm)( CblasRowMajor, side, uplo, *m, *n, alpha, A, LDA, B, LDB, beta, C, LDC ); for( j=0; j<*n; j++ ) for( i=0; i<*m; i++ ) @@ -199,18 +289,22 @@ void F77_csymm(int *layout, char *rtlf, char *uplow, int *m, int *n, free(C); } else if (*layout == TEST_COL_MJR) - cblas_csymm( CblasColMajor, side, uplo, *m, *n, alpha, a, *lda, b, *ldb, + API_SUFFIX(cblas_csymm)( CblasColMajor, side, uplo, *m, *n, alpha, a, *lda, b, *ldb, beta, c, *ldc ); else - cblas_csymm( UNDEFINED, side, uplo, *m, *n, alpha, a, *lda, b, *ldb, + API_SUFFIX(cblas_csymm)( INVALID_LAYOUT, side, uplo, *m, *n, alpha, a, *lda, b, *ldb, beta, c, *ldc ); } -void F77_cherk(int *layout, char *uplow, char *transp, int *n, int *k, - float *alpha, CBLAS_TEST_COMPLEX *a, int *lda, - float *beta, CBLAS_TEST_COMPLEX *c, int *ldc ) { +void F77_cherk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k, + float *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, + float *beta, CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len +#endif +) { - int i,j,LDA,LDC; + CBLAS_INT i,j,LDA,LDC; CBLAS_TEST_COMPLEX *A, *C; CBLAS_UPLO uplo; CBLAS_TRANSPOSE trans; @@ -244,7 +338,7 @@ void F77_cherk(int *layout, char *uplow, char *transp, int *n, int *k, C[i*LDC+j].real=c[j*(*ldc)+i].real; C[i*LDC+j].imag=c[j*(*ldc)+i].imag; } - cblas_cherk(CblasRowMajor, uplo, trans, *n, *k, *alpha, A, LDA, *beta, + API_SUFFIX(cblas_cherk)(CblasRowMajor, uplo, trans, *n, *k, *alpha, A, LDA, *beta, C, LDC ); for( j=0; j<*n; j++ ) for( i=0; i<*n; i++ ) { @@ -255,18 +349,22 @@ void F77_cherk(int *layout, char *uplow, char *transp, int *n, int *k, free(C); } else if (*layout == TEST_COL_MJR) - cblas_cherk(CblasColMajor, uplo, trans, *n, *k, *alpha, a, *lda, *beta, + API_SUFFIX(cblas_cherk)(CblasColMajor, uplo, trans, *n, *k, *alpha, a, *lda, *beta, c, *ldc ); else - cblas_cherk(UNDEFINED, uplo, trans, *n, *k, *alpha, a, *lda, *beta, + API_SUFFIX(cblas_cherk)(INVALID_LAYOUT, uplo, trans, *n, *k, *alpha, a, *lda, *beta, c, *ldc ); } -void F77_csyrk(int *layout, char *uplow, char *transp, int *n, int *k, - CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda, - CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *c, int *ldc ) { +void F77_csyrk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k, + CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, + CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len +#endif +) { - int i,j,LDA,LDC; + CBLAS_INT i,j,LDA,LDC; CBLAS_TEST_COMPLEX *A, *C; CBLAS_UPLO uplo; CBLAS_TRANSPOSE trans; @@ -300,7 +398,7 @@ void F77_csyrk(int *layout, char *uplow, char *transp, int *n, int *k, C[i*LDC+j].real=c[j*(*ldc)+i].real; C[i*LDC+j].imag=c[j*(*ldc)+i].imag; } - cblas_csyrk(CblasRowMajor, uplo, trans, *n, *k, alpha, A, LDA, beta, + API_SUFFIX(cblas_csyrk)(CblasRowMajor, uplo, trans, *n, *k, alpha, A, LDA, beta, C, LDC ); for( j=0; j<*n; j++ ) for( i=0; i<*n; i++ ) { @@ -311,17 +409,21 @@ void F77_csyrk(int *layout, char *uplow, char *transp, int *n, int *k, free(C); } else if (*layout == TEST_COL_MJR) - cblas_csyrk(CblasColMajor, uplo, trans, *n, *k, alpha, a, *lda, beta, + API_SUFFIX(cblas_csyrk)(CblasColMajor, uplo, trans, *n, *k, alpha, a, *lda, beta, c, *ldc ); else - cblas_csyrk(UNDEFINED, uplo, trans, *n, *k, alpha, a, *lda, beta, + API_SUFFIX(cblas_csyrk)(INVALID_LAYOUT, uplo, trans, *n, *k, alpha, a, *lda, beta, c, *ldc ); } -void F77_cher2k(int *layout, char *uplow, char *transp, int *n, int *k, - CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda, - CBLAS_TEST_COMPLEX *b, int *ldb, float *beta, - CBLAS_TEST_COMPLEX *c, int *ldc ) { - int i,j,LDA,LDB,LDC; +void F77_cher2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k, + CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, + CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb, float *beta, + CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len +#endif +) { + CBLAS_INT i,j,LDA,LDB,LDC; CBLAS_TEST_COMPLEX *A, *B, *C; CBLAS_UPLO uplo; CBLAS_TRANSPOSE trans; @@ -363,7 +465,7 @@ void F77_cher2k(int *layout, char *uplow, char *transp, int *n, int *k, C[i*LDC+j].real=c[j*(*ldc)+i].real; C[i*LDC+j].imag=c[j*(*ldc)+i].imag; } - cblas_cher2k(CblasRowMajor, uplo, trans, *n, *k, alpha, A, LDA, + API_SUFFIX(cblas_cher2k)(CblasRowMajor, uplo, trans, *n, *k, alpha, A, LDA, B, LDB, *beta, C, LDC ); for( j=0; j<*n; j++ ) for( i=0; i<*n; i++ ) { @@ -375,17 +477,21 @@ void F77_cher2k(int *layout, char *uplow, char *transp, int *n, int *k, free(C); } else if (*layout == TEST_COL_MJR) - cblas_cher2k(CblasColMajor, uplo, trans, *n, *k, alpha, a, *lda, + API_SUFFIX(cblas_cher2k)(CblasColMajor, uplo, trans, *n, *k, alpha, a, *lda, b, *ldb, *beta, c, *ldc ); else - cblas_cher2k(UNDEFINED, uplo, trans, *n, *k, alpha, a, *lda, + API_SUFFIX(cblas_cher2k)(INVALID_LAYOUT, uplo, trans, *n, *k, alpha, a, *lda, b, *ldb, *beta, c, *ldc ); } -void F77_csyr2k(int *layout, char *uplow, char *transp, int *n, int *k, - CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda, - CBLAS_TEST_COMPLEX *b, int *ldb, CBLAS_TEST_COMPLEX *beta, - CBLAS_TEST_COMPLEX *c, int *ldc ) { - int i,j,LDA,LDB,LDC; +void F77_csyr2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k, + CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, + CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_COMPLEX *beta, + CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len +#endif +) { + CBLAS_INT i,j,LDA,LDB,LDC; CBLAS_TEST_COMPLEX *A, *B, *C; CBLAS_UPLO uplo; CBLAS_TRANSPOSE trans; @@ -427,7 +533,7 @@ void F77_csyr2k(int *layout, char *uplow, char *transp, int *n, int *k, C[i*LDC+j].real=c[j*(*ldc)+i].real; C[i*LDC+j].imag=c[j*(*ldc)+i].imag; } - cblas_csyr2k(CblasRowMajor, uplo, trans, *n, *k, alpha, A, LDA, + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, uplo, trans, *n, *k, alpha, A, LDA, B, LDB, beta, C, LDC ); for( j=0; j<*n; j++ ) for( i=0; i<*n; i++ ) { @@ -439,16 +545,20 @@ void F77_csyr2k(int *layout, char *uplow, char *transp, int *n, int *k, free(C); } else if (*layout == TEST_COL_MJR) - cblas_csyr2k(CblasColMajor, uplo, trans, *n, *k, alpha, a, *lda, + API_SUFFIX(cblas_csyr2k)(CblasColMajor, uplo, trans, *n, *k, alpha, a, *lda, b, *ldb, beta, c, *ldc ); else - cblas_csyr2k(UNDEFINED, uplo, trans, *n, *k, alpha, a, *lda, + API_SUFFIX(cblas_csyr2k)(INVALID_LAYOUT, uplo, trans, *n, *k, alpha, a, *lda, b, *ldb, beta, c, *ldc ); } -void F77_ctrmm(int *layout, char *rtlf, char *uplow, char *transp, char *diagn, - int *m, int *n, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, - int *lda, CBLAS_TEST_COMPLEX *b, int *ldb) { - int i,j,LDA,LDB; +void F77_ctrmm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *diagn, + CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, + CBLAS_INT *lda, CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len +#endif +) { + CBLAS_INT i,j,LDA,LDB; CBLAS_TEST_COMPLEX *A, *B; CBLAS_SIDE side; CBLAS_DIAG diag; @@ -486,7 +596,7 @@ void F77_ctrmm(int *layout, char *rtlf, char *uplow, char *transp, char *diagn, B[i*LDB+j].real=b[j*(*ldb)+i].real; B[i*LDB+j].imag=b[j*(*ldb)+i].imag; } - cblas_ctrmm(CblasRowMajor, side, uplo, trans, diag, *m, *n, alpha, + API_SUFFIX(cblas_ctrmm)(CblasRowMajor, side, uplo, trans, diag, *m, *n, alpha, A, LDA, B, LDB ); for( j=0; j<*n; j++ ) for( i=0; i<*m; i++ ) { @@ -497,17 +607,21 @@ void F77_ctrmm(int *layout, char *rtlf, char *uplow, char *transp, char *diagn, free(B); } else if (*layout == TEST_COL_MJR) - cblas_ctrmm(CblasColMajor, side, uplo, trans, diag, *m, *n, alpha, + API_SUFFIX(cblas_ctrmm)(CblasColMajor, side, uplo, trans, diag, *m, *n, alpha, a, *lda, b, *ldb); else - cblas_ctrmm(UNDEFINED, side, uplo, trans, diag, *m, *n, alpha, + API_SUFFIX(cblas_ctrmm)(INVALID_LAYOUT, side, uplo, trans, diag, *m, *n, alpha, a, *lda, b, *ldb); } -void F77_ctrsm(int *layout, char *rtlf, char *uplow, char *transp, char *diagn, - int *m, int *n, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, - int *lda, CBLAS_TEST_COMPLEX *b, int *ldb) { - int i,j,LDA,LDB; +void F77_ctrsm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *diagn, + CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, + CBLAS_INT *lda, CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len +#endif +) { + CBLAS_INT i,j,LDA,LDB; CBLAS_TEST_COMPLEX *A, *B; CBLAS_SIDE side; CBLAS_DIAG diag; @@ -545,7 +659,7 @@ void F77_ctrsm(int *layout, char *rtlf, char *uplow, char *transp, char *diagn, B[i*LDB+j].real=b[j*(*ldb)+i].real; B[i*LDB+j].imag=b[j*(*ldb)+i].imag; } - cblas_ctrsm(CblasRowMajor, side, uplo, trans, diag, *m, *n, alpha, + API_SUFFIX(cblas_ctrsm)(CblasRowMajor, side, uplo, trans, diag, *m, *n, alpha, A, LDA, B, LDB ); for( j=0; j<*n; j++ ) for( i=0; i<*m; i++ ) { @@ -556,9 +670,9 @@ void F77_ctrsm(int *layout, char *rtlf, char *uplow, char *transp, char *diagn, free(B); } else if (*layout == TEST_COL_MJR) - cblas_ctrsm(CblasColMajor, side, uplo, trans, diag, *m, *n, alpha, + API_SUFFIX(cblas_ctrsm)(CblasColMajor, side, uplo, trans, diag, *m, *n, alpha, a, *lda, b, *ldb); else - cblas_ctrsm(UNDEFINED, side, uplo, trans, diag, *m, *n, alpha, + API_SUFFIX(cblas_ctrsm)(INVALID_LAYOUT, side, uplo, trans, diag, *m, *n, alpha, a, *lda, b, *ldb); } diff --git a/CBLAS/testing/c_cblat1.f b/CBLAS/testing/c_cblat1.f index c741ce5064..930ccdbea3 100644 --- a/CBLAS/testing/c_cblat1.f +++ b/CBLAS/testing/c_cblat1.f @@ -1,4 +1,6 @@ +* ===================================================================== PROGRAM CCBLAT1 + IMPLICIT NONE * Test program for the COMPLEX Level 1 CBLAS. * Based upon the original CBLAS test routine together with: * F06GAF Example Program Text @@ -6,20 +8,26 @@ PROGRAM CCBLAT1 INTEGER NOUT PARAMETER (NOUT=6) * .. Scalars in Common .. + INTEGER NTESTS, NFAILS + CHARACTER*15 SUBNAM INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Scalars .. + REAL S1, S2 REAL SFAC INTEGER IC * .. External Subroutines .. EXTERNAL CHECK1, CHECK2, HEADER * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS + COMMON /CNTBLA/NTESTS, NFAILS + COMMON /NAMBLA/SUBNAM * .. Data statements .. DATA SFAC/9.765625E-4/ * .. Executable Statements .. + CALL CPU_TIME( S1 ) WRITE (NOUT,99999) - DO 20 IC = 1, 10 + DO 20 IC = 1, 11 ICASE = IC CALL HEADER * @@ -29,33 +37,46 @@ PROGRAM CCBLAT1 * these parameters. * PASS = .TRUE. + NTESTS = 0 + NFAILS = 0 INCX = 9999 INCY = 9999 MODE = 9999 - IF (ICASE.LE.5) THEN + IF (ICASE.LE.5 .OR. ICASE.EQ.11) THEN CALL CHECK2(SFAC) ELSE IF (ICASE.GE.6) THEN CALL CHECK1(SFAC) END IF * -- Print IF (PASS) WRITE (NOUT,99998) + WRITE (NOUT,99997) SUBNAM, NTESTS, NFAILS 20 CONTINUE + CALL CPU_TIME( S2 ) + WRITE (NOUT,99996) S2 - S1 STOP * 99999 FORMAT (' Complex CBLAS Test Program Results',/1X) 99998 FORMAT (' ----- PASS -----') +99997 FORMAT (1X,A15,' COMPUTATIONAL TESTS:',I9,' RUN,',I9, + + ' FAILED') +99996 FORMAT (' Total time used = ',F12.2,' seconds',/) END + +* ===================================================================== SUBROUTINE HEADER + IMPLICIT NONE * .. Parameters .. INTEGER NOUT PARAMETER (NOUT=6) * .. Scalars in Common .. + CHARACTER*15 SUBNAM INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Arrays .. - CHARACTER*15 L(10) + CHARACTER*15 L(11) * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS + COMMON /NAMBLA/SUBNAM * .. Data statements .. DATA L(1)/'CBLAS_CDOTC'/ DATA L(2)/'CBLAS_CDOTU'/ @@ -67,13 +88,19 @@ SUBROUTINE HEADER DATA L(8)/'CBLAS_CSCAL'/ DATA L(9)/'CBLAS_CSSCAL'/ DATA L(10)/'CBLAS_ICAMAX'/ + DATA L(11)/'CBLAS_CAXPBY'/ + * .. Executable Statements .. + SUBNAM = L(ICASE) WRITE (NOUT,99999) ICASE, L(ICASE) RETURN * 99999 FORMAT (/' Test of subprogram number',I3,9X,A15) END + +* ===================================================================== SUBROUTINE CHECK1(SFAC) + IMPLICIT NONE * .. Parameters .. INTEGER NOUT PARAMETER (NOUT=6) @@ -274,7 +301,10 @@ SUBROUTINE CHECK1(SFAC) END IF RETURN END + +* ===================================================================== SUBROUTINE CHECK2(SFAC) + IMPLICIT NONE * .. Parameters .. INTEGER NOUT PARAMETER (NOUT=6) @@ -284,23 +314,26 @@ SUBROUTINE CHECK2(SFAC) INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Scalars .. - COMPLEX CA,CTEMP + COMPLEX CA,CB,CTEMP INTEGER I, J, KI, KN, KSIZE, LENX, LENY, MX, MY * .. Local Arrays .. COMPLEX CDOT(1), CSIZE1(4), CSIZE2(7,2), CSIZE3(14), + CT10X(7,4,4), CT10Y(7,4,4), CT6(4,4), CT7(4,4), - + CT8(7,4,4), CX(7), CX1(7), CY(7), CY1(7) + + CT8(7,4,4), CX(7), CX1(7), CY(7), CY1(7), + + CT11(7,4,4) INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4) * .. External Functions .. EXTERNAL CDOTCTEST, CDOTUTEST * .. External Subroutines .. - EXTERNAL CAXPYTEST, CCOPYTEST, CSWAPTEST, CTEST + EXTERNAL CAXPYTEST, CCOPYTEST, CSWAPTEST, CTEST, + + CAXPBYTEST * .. Intrinsic Functions .. INTRINSIC ABS, MIN * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS * .. Data statements .. DATA CA/(0.4E0,-0.7E0)/ + DATA CB/(0.7E0,-0.4E0)/ DATA INCXS/1, 2, -2, -1/ DATA INCYS/1, -2, 1, -2/ DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/ @@ -470,6 +503,54 @@ SUBROUTINE CHECK2(SFAC) + (1.54E0,1.54E0), (1.54E0,1.54E0), + (1.54E0,1.54E0), (1.54E0,1.54E0), + (1.54E0,1.54E0), (1.54E0,1.54E0)/ + + DATA ((CT11(I,J,1),I=1,7),J=1,4)/(0.6E0,-0.6E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (-0.1E0,-1.47E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (-0.1E0,-1.47E0), + + (-1.08E0,0.71E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (-0.1E0,-1.47E0), (-1.08E0,0.71E0), + + (-0.42E0,-0.99E0), (-0.61E0,-0.85E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/ + DATA ((CT11(I,J,2),I=1,7),J=1,4)/(0.6E0,-0.6E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (-0.1E0,-1.47E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (-0.49E0,-0.95E0), + + (-0.9E0,0.5E0),(-0.03E0,-1.51E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.36E0,0.00E0), (-0.9E0,0.5E0), + + (-0.39E0,-0.23E0), (0.1E0,-0.5E0), + + (-0.82E0,-0.39E0), (-0.5E0,-0.3E0), + + (0.0E0,-1.62E0)/ + DATA ((CT11(I,J,3),I=1,7),J=1,4)/(0.6E0,-0.6E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (-0.1E0,-1.47E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (-0.49E0,-0.95E0), + + (-0.71E0,-0.1E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.36E0,0.00E0), (-1.07E0,1.18E0), + + (-0.42E0,-0.99E0), (-0.41E0,-1.2E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/ + DATA ((CT11(I,J,4),I=1,7),J=1,4)/(0.6E0,-0.6E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (-0.1E0,-1.47E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (-0.1E0,-1.47E0), (-0.9E0,0.5E0), + + (-0.4E0,-0.7E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (-0.1E0,-1.47E0), + + (-0.9E0,0.5E0),(-0.4E0,-0.7E0), (0.1E0,-0.5E0), + + (-0.82E0,-0.39E0), (-0.5E0,-0.3E0), + + (-0.2E0,-1.27E0)/ + + * .. Executable Statements .. DO 60 KI = 1, 4 INCX = INCXS(KI) @@ -510,6 +591,10 @@ SUBROUTINE CHECK2(SFAC) CALL CSWAPTEST(N,CX,INCX,CY,INCY) CALL CTEST(LENX,CX,CT10X(1,KN,KI),CSIZE3,1.0E0) CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0E0) + ELSE IF (ICASE.EQ.11) THEN +* .. CAXPBYTEST .. + CALL CAXPBYTEST(N,CA,CX,INCX,CB,CY,INCY) + CALL CTEST(LENY,CY,CT11(1,KN,KI),CSIZE2(1,KSIZE),SFAC) ELSE WRITE (NOUT,*) ' Shouldn''t be here in CHECK2' STOP @@ -519,7 +604,10 @@ SUBROUTINE CHECK2(SFAC) 60 CONTINUE RETURN END + +* ===================================================================== SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC) + IMPLICIT NONE * ********************************* STEST ************************** * * THIS SUBR COMPARES ARRAYS SCOMP() AND STRUE() OF LENGTH LEN TO @@ -537,6 +625,7 @@ SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC) * .. Array Arguments .. REAL SCOMP(LEN), SSIZE(LEN), STRUE(LEN) * .. Scalars in Common .. + INTEGER NTESTS, NFAILS INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Scalars .. @@ -549,12 +638,15 @@ SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC) INTRINSIC ABS * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS + COMMON /CNTBLA/NTESTS, NFAILS * .. Executable Statements .. * DO 40 I = 1, LEN + NTESTS = NTESTS + 1 SD = SCOMP(I) - STRUE(I) IF (SDIFF(ABS(SSIZE(I))+ABS(SFAC*SD),ABS(SSIZE(I))).EQ.0.0E0) + GO TO 40 + NFAILS = NFAILS + 1 * * HERE SCOMP(I) IS NOT CLOSE TO STRUE(I). * @@ -574,10 +666,13 @@ SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC) + ' SIZE(I)',/1X) 99997 FORMAT (1X,I4,I3,3I5,I3,2E36.8,2E12.4) END + +* ===================================================================== SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC) + IMPLICIT NONE * ************************* STEST1 ***************************** * -* THIS IS AN INTERFACE SUBROUTINE TO ACCOMODATE THE FORTRAN +* THIS IS AN INTERFACE SUBROUTINE TO ACCOMMODATE THE FORTRAN * REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE * ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT. * @@ -599,7 +694,10 @@ SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC) * RETURN END + +* ===================================================================== REAL FUNCTION SDIFF(SA,SB) + IMPLICIT NONE * ********************************* SDIFF ************************** * COMPUTES DIFFERENCE OF TWO NUMBERS. C. L. LAWSON, JPL 1974 FEB 15 * @@ -609,7 +707,10 @@ REAL FUNCTION SDIFF(SA,SB) SDIFF = SA - SB RETURN END + +* ===================================================================== SUBROUTINE CTEST(LEN,CCOMP,CTRUE,CSIZE,SFAC) + IMPLICIT NONE * **************************** CTEST ***************************** * * C.L. LAWSON, JPL, 1978 DEC 6 @@ -640,7 +741,10 @@ SUBROUTINE CTEST(LEN,CCOMP,CTRUE,CSIZE,SFAC) CALL STEST(2*LEN,SCOMP,STRUE,SSIZE,SFAC) RETURN END + +* ===================================================================== SUBROUTINE ITEST1(ICOMP,ITRUE) + IMPLICIT NONE * ********************************* ITEST1 ************************* * * THIS SUBROUTINE COMPARES THE VARIABLES ICOMP AND ITRUE FOR @@ -653,14 +757,18 @@ SUBROUTINE ITEST1(ICOMP,ITRUE) * .. Scalar Arguments .. INTEGER ICOMP, ITRUE * .. Scalars in Common .. + INTEGER NTESTS, NFAILS INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Scalars .. INTEGER ID * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS + COMMON /CNTBLA/NTESTS, NFAILS * .. Executable Statements .. + NTESTS = NTESTS + 1 IF (ICOMP.EQ.ITRUE) GO TO 40 + NFAILS = NFAILS + 1 * * HERE ICOMP IS NOT EQUAL TO ITRUE. * diff --git a/CBLAS/testing/c_cblat2.f b/CBLAS/testing/c_cblat2.f index d934ebb49d..8815809665 100644 --- a/CBLAS/testing/c_cblat2.f +++ b/CBLAS/testing/c_cblat2.f @@ -1,4 +1,6 @@ +* ===================================================================== PROGRAM CBLAT2 + IMPLICIT NONE * * Test program for the COMPLEX Level 2 Blas. * @@ -78,6 +80,7 @@ PROGRAM CBLAT2 PARAMETER ( NINMAX = 7, NIDMAX = 9, NKBMAX = 7, $ NALMAX = 7, NBEMAX = 7 ) * .. Local Scalars .. + REAL S1, S2 REAL EPS, ERR, THRESH INTEGER I, ISNUM, J, N, NALF, NBET, NIDIM, NINC, NKB, $ NTRA, LAYOUT @@ -121,6 +124,7 @@ PROGRAM CBLAT2 $ 'cblas_cgerc ','cblas_cgeru ','cblas_cher ', $ 'cblas_chpr ','cblas_cher2 ','cblas_chpr2 '/ * .. Executable Statements .. + CALL CPU_TIME( S1 ) * NOUTC = NOUT * @@ -267,13 +271,14 @@ PROGRAM CBLAT2 N = MIN( 32, NMAX ) DO 120 J = 1, N DO 110 I = 1, N - A( I, J ) = MAX( I - J + 1, 0 ) + A( I, J ) = REAL( MAX( I - J + 1, 0 ) ) 110 CONTINUE - X( J ) = J + X( J ) = REAL( J ) Y( J ) = ZERO 120 CONTINUE DO 130 J = 1, N - YY( J ) = J*( ( J + 1 )*J )/2 - ( ( J + 1 )*J*( J - 1 ) )/3 + YY( J ) = REAL( J*( ( J + 1 )*J )/2 - + $ ( ( J + 1 )*J*( J - 1 ) )/3 ) 130 CONTINUE * YY holds the exact result. On exit from CMVCH YT holds * the result computed by CMVCH. @@ -349,13 +354,13 @@ PROGRAM CBLAT2 CALL CCHK3( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NKB, KB, NINC, INC, $ NMAX, INCMAX, A, AA, AS, Y, YY, YS, YT, G, Z, - $ 0 ) + $ 0 ) END IF IF (RORDER) THEN CALL CCHK3( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NKB, KB, NINC, INC, $ NMAX, INCMAX, A, AA, AS, Y, YY, YS, YT, G, Z, - $ 1 ) + $ 1 ) END IF GO TO 200 * Test CGERC, 12, CGERU, 13. @@ -417,6 +422,8 @@ PROGRAM CBLAT2 240 CONTINUE IF( TRACE ) $ CLOSE ( NTRA ) + CALL CPU_TIME( S2 ) + WRITE( NOUT, FMT = 9979 )S2 - S1 CLOSE ( NOUT ) STOP * @@ -455,14 +462,18 @@ PROGRAM CBLAT2 9982 FORMAT( /' END OF TESTS' ) 9981 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' ) 9980 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' ) + 9979 FORMAT( ' Total time used = ', F12.2, ' seconds', / ) * * End of CBLAT2. * END + +* ===================================================================== SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, NBET, $ BET, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX, $ XS, Y, YY, YS, YT, G, IORDER ) + IMPLICIT NONE * * Tests CGEMV and CGBMV. * @@ -494,6 +505,7 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX ALPHA, ALS, BETA, BLS, TRANSL REAL ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, IC, IKU, IM, IN, INCX, INCXS, INCY, $ INCYS, IX, IY, KL, KLS, KU, KUS, LAA, LDA, $ LDAS, LX, LY, M, ML, MS, N, NARGS, NC, ND, NK, @@ -531,6 +543,8 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 120 IN = 1, NIDIM N = IDIM( IN ) @@ -679,6 +693,8 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9993 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 130 END IF * @@ -733,6 +749,8 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 130 END IF * @@ -745,6 +763,9 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ INCY, YT, G, YY, EPS, ERR, $ FATAL, NOUT, .TRUE. ) ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -775,9 +796,11 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * Report result. * IF( ERRMAX.LT.THRESH )THEN - WRITE( NOUT, FMT = 9999 )SNAME, NC + IF( IORDER.EQ.0 )WRITE( NOUT, FMT = 10000 )SNAME, NC + IF( IORDER.EQ.1 )WRITE( NOUT, FMT = 10001 )SNAME, NC ELSE - WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX + IF( IORDER.EQ.0 )WRITE( NOUT, FMT = 10002 )SNAME, NC, ERRMAX + IF( IORDER.EQ.1 )WRITE( NOUT, FMT = 10003 )SNAME, NC, ERRMAX END IF GO TO 140 * @@ -792,8 +815,22 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 140 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * +10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) +10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) +10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) +10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) 9999 FORMAT(' ',A12, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', $ 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', @@ -810,14 +847,21 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ F4.1, ',', F4.1, '), Y,', I2, ') .' ) 9993 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A12,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A12,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of CCHK1. * END + +* ===================================================================== SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, NBET, $ BET, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX, $ XS, Y, YY, YS, YT, G, IORDER ) + IMPLICIT NONE * * Tests CHEMV, CHBMV and CHPMV. * @@ -849,6 +893,7 @@ SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX ALPHA, ALS, BETA, BLS, TRANSL REAL ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, IC, IK, IN, INCX, INCXS, INCY, $ INCYS, IX, IY, K, KS, LAA, LDA, LDAS, LX, LY, $ N, NARGS, NC, NK, NS @@ -888,6 +933,8 @@ SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 110 IN = 1, NIDIM N = IDIM( IN ) @@ -1025,6 +1072,8 @@ SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1087,6 +1136,8 @@ SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1099,6 +1150,9 @@ SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ YY, EPS, ERR, FATAL, NOUT, $ .TRUE. ) ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -1125,9 +1179,11 @@ SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * Report result. * IF( ERRMAX.LT.THRESH )THEN - WRITE( NOUT, FMT = 9999 )SNAME, NC + IF( IORDER.EQ.0 )WRITE( NOUT, FMT = 10000 )SNAME, NC + IF( IORDER.EQ.1 )WRITE( NOUT, FMT = 10001 )SNAME, NC ELSE - WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX + IF( IORDER.EQ.0 )WRITE( NOUT, FMT = 10002 )SNAME, NC, ERRMAX + IF( IORDER.EQ.1 )WRITE( NOUT, FMT = 10003 )SNAME, NC, ERRMAX END IF GO TO 130 * @@ -1145,8 +1201,22 @@ SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 130 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * +10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) +10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) +10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) +10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) 9999 FORMAT(' ',A12, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', $ 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', @@ -1166,13 +1236,20 @@ SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ F4.1, '), ', 'Y,', I2, ') .' ) 9992 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A12,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A12,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of CCHK2. * END + +* ===================================================================== SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NKB, KB, NINC, INC, NMAX, $ INCMAX, A, AA, AS, X, XX, XS, XT, G, Z, IORDER ) + IMPLICIT NONE * * Tests CTRMV, CTBMV, CTPMV, CTRSV, CTBSV and CTPSV. * @@ -1203,6 +1280,7 @@ SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX TRANSL REAL ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, ICD, ICT, ICU, IK, IN, INCX, INCXS, IX, K, $ KS, LAA, LDA, LDAS, LX, N, NARGS, NC, NK, NS LOGICAL BANDED, FULL, NULL, PACKED, RESET, SAME @@ -1243,6 +1321,8 @@ SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * Set up zero vector for CMVCH. DO 10 I = 1, NMAX Z( I ) = ZERO @@ -1406,6 +1486,8 @@ SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1458,6 +1540,8 @@ SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1486,6 +1570,9 @@ SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ .FALSE. ) END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and return. IF( FATAL ) $ GO TO 120 @@ -1509,9 +1596,11 @@ SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * Report result. * IF( ERRMAX.LT.THRESH )THEN - WRITE( NOUT, FMT = 9999 )SNAME, NC + IF( IORDER.EQ.0 )WRITE( NOUT, FMT = 10000 )SNAME, NC + IF( IORDER.EQ.1 )WRITE( NOUT, FMT = 10001 )SNAME, NC ELSE - WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX + IF( IORDER.EQ.0 )WRITE( NOUT, FMT = 10002 )SNAME, NC, ERRMAX + IF( IORDER.EQ.1 )WRITE( NOUT, FMT = 10003 )SNAME, NC, ERRMAX END IF GO TO 130 * @@ -1529,8 +1618,22 @@ SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 130 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * +10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) +10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) +10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) +10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) 9999 FORMAT(' ',A12, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', $ 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', @@ -1547,14 +1650,21 @@ SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ I3, ', X,', I2, ') .' ) 9992 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A12,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A12,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of CCHK3. * END + +* ===================================================================== SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX, $ INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G, $ Z, IORDER ) + IMPLICIT NONE * * Tests CGERC and CGERU. * @@ -1587,6 +1697,7 @@ SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX ALPHA, ALS, TRANSL REAL ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IM, IN, INCX, INCXS, INCY, INCYS, IX, $ IY, J, LAA, LDA, LDAS, LX, LY, M, MS, N, NARGS, $ NC, ND, NS @@ -1614,6 +1725,8 @@ SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 120 IN = 1, NIDIM N = IDIM( IN ) @@ -1714,6 +1827,8 @@ SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9993 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 140 END IF * @@ -1744,6 +1859,8 @@ SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 140 END IF * @@ -1773,6 +1890,9 @@ SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ AA( 1 + ( J - 1 )*LDA ), EPS, $ ERR, FATAL, NOUT, .TRUE. ) ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and return. IF( FATAL ) $ GO TO 130 @@ -1795,9 +1915,11 @@ SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * Report result. * IF( ERRMAX.LT.THRESH )THEN - WRITE( NOUT, FMT = 9999 )SNAME, NC + IF( IORDER.EQ.0 )WRITE( NOUT, FMT = 10000 )SNAME, NC + IF( IORDER.EQ.1 )WRITE( NOUT, FMT = 10001 )SNAME, NC ELSE - WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX + IF( IORDER.EQ.0 )WRITE( NOUT, FMT = 10002 )SNAME, NC, ERRMAX + IF( IORDER.EQ.1 )WRITE( NOUT, FMT = 10003 )SNAME, NC, ERRMAX END IF GO TO 150 * @@ -1809,8 +1931,22 @@ SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, WRITE( NOUT, FMT = 9994 )NC, SNAME, M, N, ALPHA, INCX, INCY, LDA * 150 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * +10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) +10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) +10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) +10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) 9999 FORMAT(' ',A12, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', $ 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', @@ -1824,14 +1960,21 @@ SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ '), X,', I2, ', Y,', I2, ', A,', I3, ') .' ) 9993 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A12,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A12,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of CCHK4. * END + +* ===================================================================== SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX, $ INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G, $ Z, IORDER ) + IMPLICIT NONE * * Tests CHER and CHPR. * @@ -1864,6 +2007,7 @@ SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX ALPHA, TRANSL REAL ERR, ERRMAX, RALPHA, RALS + INTEGER NTESTS, NFAILS INTEGER I, IA, IC, IN, INCX, INCXS, IX, J, JA, JJ, LAA, $ LDA, LDAS, LJ, LX, N, NARGS, NC, NS LOGICAL FULL, NULL, PACKED, RESET, SAME, UPPER @@ -1900,6 +2044,8 @@ SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 100 IN = 1, NIDIM N = IDIM( IN ) @@ -1991,6 +2137,8 @@ SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -2021,6 +2169,8 @@ SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 30 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -2061,6 +2211,9 @@ SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, JA = JA + LJ END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and return. IF( FATAL ) $ GO TO 110 @@ -2082,9 +2235,11 @@ SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * Report result. * IF( ERRMAX.LT.THRESH )THEN - WRITE( NOUT, FMT = 9999 )SNAME, NC + IF( IORDER.EQ.0 )WRITE( NOUT, FMT = 10000 )SNAME, NC + IF( IORDER.EQ.1 )WRITE( NOUT, FMT = 10001 )SNAME, NC ELSE - WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX + IF( IORDER.EQ.0 )WRITE( NOUT, FMT = 10002 )SNAME, NC, ERRMAX + IF( IORDER.EQ.1 )WRITE( NOUT, FMT = 10003 )SNAME, NC, ERRMAX END IF GO TO 130 * @@ -2100,8 +2255,22 @@ SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 130 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * +10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) +10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) +10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) +10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) 9999 FORMAT(' ',A12, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', $ 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', @@ -2117,14 +2286,21 @@ SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ I2, ', A,', I3, ') .' ) 9992 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A12,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A12,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of CCHK5. * END + +* ===================================================================== SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX, $ INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G, $ Z, IORDER ) + IMPLICIT NONE * * Tests CHER2 and CHPR2. * @@ -2157,6 +2333,7 @@ SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX ALPHA, ALS, TRANSL REAL ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IC, IN, INCX, INCXS, INCY, INCYS, IX, $ IY, J, JA, JJ, LAA, LDA, LDAS, LJ, LX, LY, N, $ NARGS, NC, NS @@ -2194,6 +2371,8 @@ SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 140 IN = 1, NIDIM N = IDIM( IN ) @@ -2303,6 +2482,8 @@ SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 160 END IF * @@ -2335,6 +2516,8 @@ SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 160 END IF * @@ -2385,6 +2568,9 @@ SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, JA = JA + LJ END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and return. IF( FATAL ) $ GO TO 150 @@ -2408,9 +2594,11 @@ SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * Report result. * IF( ERRMAX.LT.THRESH )THEN - WRITE( NOUT, FMT = 9999 )SNAME, NC + IF( IORDER.EQ.0 )WRITE( NOUT, FMT = 10000 )SNAME, NC + IF( IORDER.EQ.1 )WRITE( NOUT, FMT = 10001 )SNAME, NC ELSE - WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX + IF( IORDER.EQ.0 )WRITE( NOUT, FMT = 10002 )SNAME, NC, ERRMAX + IF( IORDER.EQ.1 )WRITE( NOUT, FMT = 10003 )SNAME, NC, ERRMAX END IF GO TO 170 * @@ -2427,8 +2615,22 @@ SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 170 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * +10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) +10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) +10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) +10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) 9999 FORMAT(' ',A12, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', $ 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', @@ -2444,12 +2646,19 @@ SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ F4.1, '), X,', I2, ', Y,', I2, ', A,', I3, ') .' ) 9992 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A12,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A12,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of CCHK6. * END + +* ===================================================================== SUBROUTINE CMVCH( TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y, $ INCY, YT, G, YY, EPS, ERR, FATAL, NOUT, MV ) + IMPLICIT NONE * * Checks the results of the computational tests. * @@ -2481,9 +2690,9 @@ SUBROUTINE CMVCH( TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y, * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, CONJG, MAX, REAL, SQRT * .. Statement Functions .. - REAL ABS1 + REAL CABS1 * .. Statement Function definitions .. - ABS1( C ) = ABS( REAL( C ) ) + ABS( AIMAG( C ) ) + CABS1( C ) = ABS( REAL( C ) ) + ABS( AIMAG( C ) ) * .. Executable Statements .. TRAN = TRANS.EQ.'T' CTRAN = TRANS.EQ.'C' @@ -2520,24 +2729,25 @@ SUBROUTINE CMVCH( TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y, IF( TRAN )THEN DO 10 J = 1, NL YT( IY ) = YT( IY ) + A( J, I )*X( JX ) - G( IY ) = G( IY ) + ABS1( A( J, I ) )*ABS1( X( JX ) ) + G( IY ) = G( IY ) + CABS1( A( J, I ) )*CABS1( X( JX ) ) JX = JX + INCXL 10 CONTINUE ELSE IF( CTRAN )THEN DO 20 J = 1, NL YT( IY ) = YT( IY ) + CONJG( A( J, I ) )*X( JX ) - G( IY ) = G( IY ) + ABS1( A( J, I ) )*ABS1( X( JX ) ) + G( IY ) = G( IY ) + CABS1( A( J, I ) )*CABS1( X( JX ) ) JX = JX + INCXL 20 CONTINUE ELSE DO 30 J = 1, NL YT( IY ) = YT( IY ) + A( I, J )*X( JX ) - G( IY ) = G( IY ) + ABS1( A( I, J ) )*ABS1( X( JX ) ) + G( IY ) = G( IY ) + CABS1( A( I, J ) )*CABS1( X( JX ) ) JX = JX + INCXL 30 CONTINUE END IF YT( IY ) = ALPHA*YT( IY ) + BETA*Y( IY ) - G( IY ) = ABS1( ALPHA )*G( IY ) + ABS1( BETA )*ABS1( Y( IY ) ) + G( IY ) = CABS1( ALPHA )*G( IY ) + $ + CABS1( BETA )*CABS1( Y( IY ) ) IY = IY + INCYL 40 CONTINUE * @@ -2580,7 +2790,10 @@ SUBROUTINE CMVCH( TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y, * End of CMVCH. * END + +* ===================================================================== LOGICAL FUNCTION LCE( RI, RJ, LR ) + IMPLICIT NONE * * Tests if two arrays are identical. * @@ -2610,7 +2823,10 @@ LOGICAL FUNCTION LCE( RI, RJ, LR ) * End of LCE. * END + +* ===================================================================== LOGICAL FUNCTION LCERES( TYPE, UPLO, M, N, AA, AS, LDA ) + IMPLICIT NONE * * Tests if selected elements in two arrays are equal. * @@ -2670,7 +2886,10 @@ LOGICAL FUNCTION LCERES( TYPE, UPLO, M, N, AA, AS, LDA ) * End of LCERES. * END + +* ===================================================================== COMPLEX FUNCTION CBEG( RESET ) + IMPLICIT NONE * * Generates complex numbers as pairs of random numbers uniformly * distributed between -0.5 and 0.5. @@ -2716,13 +2935,16 @@ COMPLEX FUNCTION CBEG( RESET ) IC = 0 GO TO 10 END IF - CBEG = CMPLX( ( I - 500 )/1001.0, ( J - 500 )/1001.0 ) + CBEG = CMPLX( REAL( I - 500 )/1001.0, REAL( J - 500 )/1001.0 ) RETURN * * End of CBEG. * END + +* ===================================================================== REAL FUNCTION SDIFF( X, Y ) + IMPLICIT NONE * * Auxiliary routine for test program for Level 2 Blas. * @@ -2738,8 +2960,11 @@ REAL FUNCTION SDIFF( X, Y ) * End of SDIFF. * END + +* ===================================================================== SUBROUTINE CMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, $ KU, RESET, TRANSL ) + IMPLICIT NONE * * Generates values for an M by N matrix A within the bandwidth * defined by KL and KU. diff --git a/CBLAS/testing/c_cblat3.f b/CBLAS/testing/c_cblat3.f index 94144b8750..3b6c4ba62a 100644 --- a/CBLAS/testing/c_cblat3.f +++ b/CBLAS/testing/c_cblat3.f @@ -1,12 +1,14 @@ +* ===================================================================== PROGRAM CBLAT3 + IMPLICIT NONE * * Test program for the COMPLEX Level 3 Blas. * * The program must be driven by a short data file. The first 13 records -* of the file are read using list-directed input, the last 9 records -* are read using the format ( A12, L2 ). An annotated example of a data +* of the file are read using list-directed input, the last 10 records +* are read using the format ( A13, L2 ). An annotated example of a data * file can be obtained by deleting the first 3 characters from the -* following 22 lines: +* following 23 lines: * 'CBLAT3.SNAP' NAME OF SNAPSHOT OUTPUT FILE * -1 UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0) * F LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD. @@ -20,15 +22,16 @@ PROGRAM CBLAT3 * (0.0,0.0) (1.0,0.0) (0.7,-0.9) VALUES OF ALPHA * 3 NUMBER OF VALUES OF BETA * (0.0,0.0) (1.0,0.0) (1.3,-1.1) VALUES OF BETA -* cblas_cgemm T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_chemm T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_csymm T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_ctrmm T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_ctrsm T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_cherk T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_csyrk T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_cher2k T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_csyr2k T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_cgemm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_chemm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_csymm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_ctrmm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_ctrsm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_cherk T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_csyrk T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_cher2k T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_csyr2k T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_cgemmtr T PUT F FOR NO TEST. SAME COLUMNS. * * See: * @@ -49,7 +52,7 @@ PROGRAM CBLAT3 INTEGER NIN, NOUT PARAMETER ( NIN = 5, NOUT = 6 ) INTEGER NSUBS - PARAMETER ( NSUBS = 9 ) + PARAMETER ( NSUBS = 10 ) COMPLEX ZERO, ONE PARAMETER ( ZERO = ( 0.0, 0.0 ), ONE = ( 1.0, 0.0 ) ) REAL RZERO, RHALF, RONE @@ -59,13 +62,14 @@ PROGRAM CBLAT3 INTEGER NIDMAX, NALMAX, NBEMAX PARAMETER ( NIDMAX = 9, NALMAX = 7, NBEMAX = 7 ) * .. Local Scalars .. + REAL S1, S2 REAL EPS, ERR, THRESH INTEGER I, ISNUM, J, N, NALF, NBET, NIDIM, NTRA, $ LAYOUT LOGICAL FATAL, LTESTT, REWI, SAME, SFATAL, TRACE, $ TSTERR, CORDER, RORDER CHARACTER*1 TRANSA, TRANSB - CHARACTER*12 SNAMET + CHARACTER*13 SNAMET CHARACTER*32 SNAPS * .. Local Arrays .. COMPLEX AA( NMAX*NMAX ), AB( NMAX, 2*NMAX ), @@ -77,19 +81,20 @@ PROGRAM CBLAT3 REAL G( NMAX ) INTEGER IDIM( NIDMAX ) LOGICAL LTEST( NSUBS ) - CHARACTER*12 SNAMES( NSUBS ) + CHARACTER*13 SNAMES( NSUBS ) * .. External Functions .. REAL SDIFF LOGICAL LCE EXTERNAL SDIFF, LCE * .. External Subroutines .. - EXTERNAL CCHK1, CCHK2, CCHK3, CCHK4, CCHK5, CMMCH + EXTERNAL CCHK1, CCHK2, CCHK3, CCHK4, + $ CCHK5, CCHK6, CC3CHKE, CMMCH * .. Intrinsic Functions .. INTRINSIC MAX, MIN * .. Scalars in Common .. INTEGER INFOT, NOUTC LOGICAL LERR, OK - CHARACTER*12 SRNAMT + CHARACTER*13 SRNAMT * .. Common blocks .. COMMON /INFOC/INFOT, NOUTC, OK, LERR COMMON /SRNAMC/SRNAMT @@ -97,8 +102,9 @@ PROGRAM CBLAT3 DATA SNAMES/'cblas_cgemm ', 'cblas_chemm ', $ 'cblas_csymm ', 'cblas_ctrmm ', 'cblas_ctrsm ', $ 'cblas_cherk ', 'cblas_csyrk ', 'cblas_cher2k', - $ 'cblas_csyr2k'/ + $ 'cblas_csyr2k', 'cblas_cgemmtr' / * .. Executable Statements .. + CALL CPU_TIME( S1 ) * NOUTC = NOUT * @@ -218,14 +224,15 @@ PROGRAM CBLAT3 N = MIN( 32, NMAX ) DO 100 J = 1, N DO 90 I = 1, N - AB( I, J ) = MAX( I - J + 1, 0 ) + AB( I, J ) = REAL( MAX( I - J + 1, 0 ) ) 90 CONTINUE - AB( J, NMAX + 1 ) = J - AB( 1, NMAX + J ) = J + AB( J, NMAX + 1 ) = REAL( J ) + AB( 1, NMAX + J ) = REAL( J ) C( J, 1 ) = ZERO 100 CONTINUE DO 110 J = 1, N - CC( J ) = J*( ( J + 1 )*J )/2 - ( ( J + 1 )*J*( J - 1 ) )/3 + CC( J ) = REAL( J*( ( J + 1 )*J )/2 - + $ ( ( J + 1 )*J*( J - 1 ) )/3 ) 110 CONTINUE * CC holds the exact result. On exit from CMMCH CT holds * the result computed by CMMCH. @@ -249,12 +256,12 @@ PROGRAM CBLAT3 STOP END IF DO 120 J = 1, N - AB( J, NMAX + 1 ) = N - J + 1 - AB( 1, NMAX + J ) = N - J + 1 + AB( J, NMAX + 1 ) = REAL( N - J + 1 ) + AB( 1, NMAX + J ) = REAL( N - J + 1 ) 120 CONTINUE DO 130 J = 1, N - CC( N - J + 1 ) = J*( ( J + 1 )*J )/2 - - $ ( ( J + 1 )*J*( J - 1 ) )/3 + CC( N - J + 1 ) = REAL( J*( ( J + 1 )*J )/2 - + $ ( ( J + 1 )*J*( J - 1 ) )/3 ) 130 CONTINUE TRANSA = 'C' TRANSB = 'N' @@ -295,7 +302,7 @@ PROGRAM CBLAT3 OK = .TRUE. FATAL = .FALSE. GO TO ( 140, 150, 150, 160, 160, 170, 170, - $ 180, 180 )ISNUM + $ 180, 180, 185 )ISNUM * Test CGEMM, 01. 140 IF (CORDER) THEN CALL CCHK1(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, @@ -329,13 +336,13 @@ PROGRAM CBLAT3 CALL CCHK3(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NMAX, AB, $ AA, AS, AB( 1, NMAX + 1 ), BB, BS, CT, G, C, - $ 0 ) + $ 0 ) END IF IF (RORDER) THEN CALL CCHK3(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NMAX, AB, $ AA, AS, AB( 1, NMAX + 1 ), BB, BS, CT, G, C, - $ 1 ) + $ 1 ) END IF GO TO 190 * Test CHERK, 06, CSYRK, 07. @@ -357,15 +364,30 @@ PROGRAM CBLAT3 CALL CCHK5(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W, - $ 0 ) + $ 0 ) END IF IF (RORDER) THEN CALL CCHK5(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W, - $ 1 ) + $ 1 ) END IF GO TO 190 +* Test CGEMMTR, 10. + 185 IF (CORDER) THEN + CALL CCHK6(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, + $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, + $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, + $ CC, CS, CT, G, 0 ) + END IF + IF (RORDER) THEN + CALL CCHK6(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, + $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, + $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, + $ CC, CS, CT, G, 1 ) + END IF + GO TO 190 + * 190 IF( FATAL.AND.SFATAL ) $ GO TO 210 @@ -384,6 +406,8 @@ PROGRAM CBLAT3 230 CONTINUE IF( TRACE ) $ CLOSE ( NTRA ) + CALL CPU_TIME( S2 ) + WRITE( NOUT, FMT = 9983 )S2 - S1 CLOSE ( NOUT ) STOP * @@ -405,7 +429,7 @@ PROGRAM CBLAT3 $ 7( '(', F4.1, ',', F4.1, ') ', : ) ) 9991 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM', $ /' ******* TESTS ABANDONED *******' ) - 9990 FORMAT(' SUBPROGRAM NAME ', A12,' NOT RECOGNIZED', /' ******* T', + 9990 FORMAT(' SUBPROGRAM NAME ', A13,' NOT RECOGNIZED', /' ******* T', $ 'ESTS ABANDONED *******' ) 9989 FORMAT(' ERROR IN CMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALU', $ 'ATED WRONGLY.', /' CMMCH WAS CALLED WITH TRANSA = ', A1, @@ -413,19 +437,23 @@ PROGRAM CBLAT3 $ ' ERR = ', F12.3, '.', /' THIS MAY BE DUE TO FAULTS IN THE ', $ 'ARITHMETIC OR THE COMPILER.', /' ******* TESTS ABANDONED ', $ '*******' ) - 9988 FORMAT( A12,L2 ) - 9987 FORMAT( 1X, A12,' WAS NOT TESTED' ) + 9988 FORMAT( A13,L2 ) + 9987 FORMAT( 1X, A13,' WAS NOT TESTED' ) 9986 FORMAT( /' END OF TESTS' ) 9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' ) 9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' ) + 9983 FORMAT( ' Total time used = ', F12.2, ' seconds', / ) * * End of CBLAT3. * END + +* ===================================================================== SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G, $ IORDER ) + IMPLICIT NONE * * Tests CGEMM. * @@ -446,7 +474,7 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*13 SNAME * .. Array Arguments .. COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -458,6 +486,7 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX ALPHA, ALS, BETA, BLS REAL ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, ICA, ICB, IK, IM, IN, K, KS, LAA, $ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, M, $ MA, MB, MS, N, NA, NARGS, NB, NC, NS @@ -486,6 +515,8 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 110 IM = 1, NIDIM M = IDIM( IM ) @@ -608,6 +639,8 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9994 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -643,6 +676,8 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -655,6 +690,9 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ C, NMAX, CT, G, CC, LDC, EPS, $ ERR, FATAL, NOUT, .TRUE. ) ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -692,37 +730,48 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ M, N, K, ALPHA, LDA, LDB, BETA, LDC) * 130 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A12,'(''', A1, ''',''', A1, ''',', + 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A13,'(''', A1, ''',''', A1, ''',', $ 3( I3, ',' ), '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, $ ',(', F4.1, ',', F4.1, '), C,', I3, ').' ) 9994 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A13,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A13,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of CCHK1. * END -* + +* ===================================================================== SUBROUTINE CPRCN1(NOUT, NC, SNAME, IORDER, TRANSA, TRANSB, M, N, $ K, ALPHA, LDA, LDB, BETA, LDC) + IMPLICIT NONE + INTEGER NOUT, NC, IORDER, M, N, K, LDA, LDB, LDC COMPLEX ALPHA, BETA CHARACTER*1 TRANSA, TRANSB - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CTA,CTB IF (TRANSA.EQ.'N')THEN @@ -747,15 +796,17 @@ SUBROUTINE CPRCN1(NOUT, NC, SNAME, IORDER, TRANSA, TRANSB, M, N, WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CTA,CTB WRITE(NOUT, FMT = 9994)M, N, K, ALPHA, LDA, LDB, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',') + 9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',') 9994 FORMAT( 10X, 3( I3, ',' ) ,' (', F4.1,',',F4.1,') , A,', $ I3, ', B,', I3, ', (', F4.1,',',F4.1,') , C,', I3, ').' ) END -* + +* ===================================================================== SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G, $ IORDER ) + IMPLICIT NONE * * Tests CHEMM and CSYMM. * @@ -776,7 +827,7 @@ SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*13 SNAME * .. Array Arguments .. COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -788,6 +839,7 @@ SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX ALPHA, ALS, BETA, BLS REAL ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, ICS, ICU, IM, IN, LAA, LBB, LCC, $ LDA, LDAS, LDB, LDBS, LDC, LDCS, M, MS, N, NA, $ NARGS, NC, NS @@ -817,6 +869,8 @@ SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 100 IM = 1, NIDIM M = IDIM( IM ) @@ -930,6 +984,8 @@ SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9994 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 110 END IF * @@ -964,6 +1020,8 @@ SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 110 END IF * @@ -983,6 +1041,9 @@ SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NOUT, .TRUE. ) END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -1018,37 +1079,48 @@ SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ LDB, BETA, LDC) * 120 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) - 9995 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' ) + 9995 FORMAT(1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1, $ ',', F4.1, '), C,', I3, ') .' ) 9994 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A13,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A13,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of CCHK2. * END -* + +* ===================================================================== SUBROUTINE CPRCN2(NOUT, NC, SNAME, IORDER, SIDE, UPLO, M, N, $ ALPHA, LDA, LDB, BETA, LDC) + IMPLICIT NONE + INTEGER NOUT, NC, IORDER, M, N, LDA, LDB, LDC COMPLEX ALPHA, BETA CHARACTER*1 SIDE, UPLO - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CS,CU IF (SIDE.EQ.'L')THEN @@ -1069,14 +1141,16 @@ SUBROUTINE CPRCN2(NOUT, NC, SNAME, IORDER, SIDE, UPLO, M, N, WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CS,CU WRITE(NOUT, FMT = 9994)M, N, ALPHA, LDA, LDB, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',') + 9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',') 9994 FORMAT( 10X, 2( I3, ',' ),' (',F4.1,',',F4.1, '), A,', I3, $ ', B,', I3, ', (',F4.1,',',F4.1, '), ', 'C,', I3, ').' ) END -* + +* ===================================================================== SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NMAX, A, AA, AS, $ B, BB, BS, CT, G, C, IORDER ) + IMPLICIT NONE * * Tests CTRMM and CTRSM. * @@ -1097,7 +1171,7 @@ SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*13 SNAME * .. Array Arguments .. COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -1108,6 +1182,7 @@ SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX ALPHA, ALS REAL ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, ICD, ICS, ICT, ICU, IM, IN, J, LAA, LBB, $ LDA, LDAS, LDB, LDBS, M, MS, N, NA, NARGS, NC, $ NS @@ -1138,6 +1213,8 @@ SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * Set up zero matrix for CMMCH. DO 20 J = 1, NMAX DO 10 I = 1, NMAX @@ -1249,6 +1326,8 @@ SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9994 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 150 END IF * @@ -1282,6 +1361,8 @@ SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 50 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 150 END IF * @@ -1332,6 +1413,9 @@ SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -1370,37 +1454,48 @@ SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ M, N, ALPHA, LDA, LDB) * 160 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT(' ******* ', A12,' FAILED ON CALL NUMBER:' ) - 9995 FORMAT(1X, I6, ': ', A12,'(', 4( '''', A1, ''',' ), 2( I3, ',' ), + 9996 FORMAT(' ******* ', A13,' FAILED ON CALL NUMBER:' ) + 9995 FORMAT(1X, I6, ': ', A13,'(', 4( '''', A1, ''',' ), 2( I3, ',' ), $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ') ', $ ' .' ) 9994 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A13,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A13,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of CCHK3. * END -* + +* ===================================================================== SUBROUTINE CPRCN3(NOUT, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, $ DIAG, M, N, ALPHA, LDA, LDB) + IMPLICIT NONE + INTEGER NOUT, NC, IORDER, M, N, LDA, LDB COMPLEX ALPHA CHARACTER*1 SIDE, UPLO, TRANSA, DIAG - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CS, CU, CA, CD IF (SIDE.EQ.'L')THEN @@ -1433,15 +1528,17 @@ SUBROUTINE CPRCN3(NOUT, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CS,CU WRITE(NOUT, FMT = 9994)CA, CD, M, N, ALPHA, LDA, LDB - 9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',') + 9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',') 9994 FORMAT( 10X, 2( A14, ',') , 2( I3, ',' ), ' (', F4.1, ',', $ F4.1, '), A,', I3, ', B,', I3, ').' ) END -* + +* ===================================================================== SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G, $ IORDER ) + IMPLICIT NONE * * Tests CHERK and CSYRK. * @@ -1462,7 +1559,7 @@ SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*13 SNAME * .. Array Arguments .. COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -1474,6 +1571,7 @@ SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX ALPHA, ALS, BETA, BETS REAL ERR, ERRMAX, RALPHA, RALS, RBETA, RBETS + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, K, KS, $ LAA, LCC, LDA, LDAS, LDC, LDCS, LJ, MA, N, NA, $ NARGS, NC, NS @@ -1503,6 +1601,8 @@ SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 100 IN = 1, NIDIM N = IDIM( IN ) @@ -1625,6 +1725,8 @@ SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1665,6 +1767,8 @@ SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 30 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1707,6 +1811,9 @@ SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, JC = JC + LDC + 1 END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -1752,41 +1859,52 @@ SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 130 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9994 FORMAT(1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ') ', $ ' .' ) - 9993 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9993 FORMAT(1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ '(', F4.1, ',', F4.1, ') , A,', I3, ',(', F4.1, ',', F4.1, $ '), C,', I3, ') .' ) 9992 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A13,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A13,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of CCHK4. * END -* + +* ===================================================================== SUBROUTINE CPRCN4(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, $ N, K, ALPHA, LDA, BETA, LDC) + IMPLICIT NONE + INTEGER NOUT, NC, IORDER, N, K, LDA, LDC COMPLEX ALPHA, BETA CHARACTER*1 UPLO, TRANSA - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CU, CA IF (UPLO.EQ.'U')THEN @@ -1809,18 +1927,20 @@ SUBROUTINE CPRCN4(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') ) + 9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') ) 9994 FORMAT( 10X, 2( I3, ',' ), ' (', F4.1, ',', F4.1 ,'), A,', $ I3, ', (', F4.1,',', F4.1, '), C,', I3, ').' ) END -* -* + +* ===================================================================== SUBROUTINE CPRCN6(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, $ N, K, ALPHA, LDA, BETA, LDC) + IMPLICIT NONE + INTEGER NOUT, NC, IORDER, N, K, LDA, LDC REAL ALPHA, BETA CHARACTER*1 UPLO, TRANSA - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CU, CA IF (UPLO.EQ.'U')THEN @@ -1843,15 +1963,17 @@ SUBROUTINE CPRCN6(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') ) + 9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') ) 9994 FORMAT( 10X, 2( I3, ',' ), $ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ').' ) END -* + +* ===================================================================== SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, $ AB, AA, AS, BB, BS, C, CC, CS, CT, G, W, $ IORDER ) + IMPLICIT NONE * * Tests CHER2K and CSYR2K. * @@ -1872,7 +1994,7 @@ SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*13 SNAME * .. Array Arguments .. COMPLEX AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ), $ ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ), @@ -1884,6 +2006,7 @@ SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX ALPHA, ALS, BETA, BETS REAL ERR, ERRMAX, RBETA, RBETS + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, JJAB, $ K, KS, LAA, LBB, LCC, LDA, LDAS, LDB, LDBS, $ LDC, LDCS, LJ, MA, N, NA, NARGS, NC, NS @@ -1913,6 +2036,8 @@ SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 130 IN = 1, NIDIM N = IDIM( IN ) @@ -2050,6 +2175,8 @@ SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 150 END IF * @@ -2088,6 +2215,8 @@ SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 150 END IF * @@ -2160,6 +2289,9 @@ SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ JJAB = JJAB + 2*NMAX END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -2205,41 +2337,52 @@ SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 160 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9994 FORMAT(1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',', F4.1, $ ', C,', I3, ') .' ) - 9993 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9993 FORMAT(1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1, $ ',', F4.1, '), C,', I3, ') .' ) 9992 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A13,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A13,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of CCHK5. * END -* + +* ===================================================================== SUBROUTINE CPRCN5(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, $ N, K, ALPHA, LDA, LDB, BETA, LDC) + IMPLICIT NONE + INTEGER NOUT, NC, IORDER, N, K, LDA, LDB, LDC COMPLEX ALPHA, BETA CHARACTER*1 UPLO, TRANSA - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CU, CA IF (UPLO.EQ.'U')THEN @@ -2262,19 +2405,21 @@ SUBROUTINE CPRCN5(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, LDB, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') ) + 9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') ) 9994 FORMAT( 10X, 2( I3, ',' ), ' (', F4.1, ',', F4.1, '), A,', $ I3, ', B', I3, ', (', F4.1, ',', F4.1, '), C,', I3, ').' ) END -* -* + +* ===================================================================== SUBROUTINE CPRCN7(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, $ N, K, ALPHA, LDA, LDB, BETA, LDC) + IMPLICIT NONE + INTEGER NOUT, NC, IORDER, N, K, LDA, LDB, LDC COMPLEX ALPHA REAL BETA CHARACTER*1 UPLO, TRANSA - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CU, CA IF (UPLO.EQ.'U')THEN @@ -2297,13 +2442,15 @@ SUBROUTINE CPRCN7(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, LDB, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') ) + 9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') ) 9994 FORMAT( 10X, 2( I3, ',' ), ' (', F4.1, ',', F4.1, '), A,', $ I3, ', B', I3, ',', F4.1, ', C,', I3, ').' ) END -* + +* ===================================================================== SUBROUTINE CMAKE(TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET, $ TRANSL ) + IMPLICIT NONE * * Generates values for an M by N matrix A. * Stores the values in the array AA in the data structure required @@ -2430,9 +2577,12 @@ SUBROUTINE CMAKE(TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET, * End of CMAKE. * END + +* ===================================================================== SUBROUTINE CMMCH(TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, $ BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, FATAL, $ NOUT, MV ) + IMPLICIT NONE * * Checks the results of the computational tests. * @@ -2467,9 +2617,9 @@ SUBROUTINE CMMCH(TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, CONJG, MAX, REAL, SQRT * .. Statement Functions .. - REAL ABS1 + REAL CABS1 * .. Statement Function definitions .. - ABS1( CL ) = ABS( REAL( CL ) ) + ABS( AIMAG( CL ) ) + CABS1( CL ) = ABS( REAL( CL ) ) + ABS( AIMAG( CL ) ) * .. Executable Statements .. TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' @@ -2490,7 +2640,8 @@ SUBROUTINE CMMCH(TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, DO 30 K = 1, KK DO 20 I = 1, M CT( I ) = CT( I ) + A( I, K )*B( K, J ) - G( I ) = G( I ) + ABS1( A( I, K ) )*ABS1( B( K, J ) ) + G( I ) = G( I ) + $ + CABS1( A( I, K ) )*CABS1( B( K, J ) ) 20 CONTINUE 30 CONTINUE ELSE IF( TRANA.AND..NOT.TRANB )THEN @@ -2498,16 +2649,16 @@ SUBROUTINE CMMCH(TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, DO 50 K = 1, KK DO 40 I = 1, M CT( I ) = CT( I ) + CONJG( A( K, I ) )*B( K, J ) - G( I ) = G( I ) + ABS1( A( K, I ) )* - $ ABS1( B( K, J ) ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( K, J ) ) 40 CONTINUE 50 CONTINUE ELSE DO 70 K = 1, KK DO 60 I = 1, M CT( I ) = CT( I ) + A( K, I )*B( K, J ) - G( I ) = G( I ) + ABS1( A( K, I ) )* - $ ABS1( B( K, J ) ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( K, J ) ) 60 CONTINUE 70 CONTINUE END IF @@ -2516,16 +2667,16 @@ SUBROUTINE CMMCH(TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, DO 90 K = 1, KK DO 80 I = 1, M CT( I ) = CT( I ) + A( I, K )*CONJG( B( J, K ) ) - G( I ) = G( I ) + ABS1( A( I, K ) )* - $ ABS1( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( I, K ) )* + $ CABS1( B( J, K ) ) 80 CONTINUE 90 CONTINUE ELSE DO 110 K = 1, KK DO 100 I = 1, M CT( I ) = CT( I ) + A( I, K )*B( J, K ) - G( I ) = G( I ) + ABS1( A( I, K ) )* - $ ABS1( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( I, K ) )* + $ CABS1( B( J, K ) ) 100 CONTINUE 110 CONTINUE END IF @@ -2536,16 +2687,16 @@ SUBROUTINE CMMCH(TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, DO 120 I = 1, M CT( I ) = CT( I ) + CONJG( A( K, I ) )* $ CONJG( B( J, K ) ) - G( I ) = G( I ) + ABS1( A( K, I ) )* - $ ABS1( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( J, K ) ) 120 CONTINUE 130 CONTINUE ELSE DO 150 K = 1, KK DO 140 I = 1, M CT( I ) = CT( I ) + CONJG( A( K, I ) )*B( J, K ) - G( I ) = G( I ) + ABS1( A( K, I ) )* - $ ABS1( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( J, K ) ) 140 CONTINUE 150 CONTINUE END IF @@ -2554,16 +2705,16 @@ SUBROUTINE CMMCH(TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, DO 170 K = 1, KK DO 160 I = 1, M CT( I ) = CT( I ) + A( K, I )*CONJG( B( J, K ) ) - G( I ) = G( I ) + ABS1( A( K, I ) )* - $ ABS1( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( J, K ) ) 160 CONTINUE 170 CONTINUE ELSE DO 190 K = 1, KK DO 180 I = 1, M CT( I ) = CT( I ) + A( K, I )*B( J, K ) - G( I ) = G( I ) + ABS1( A( K, I ) )* - $ ABS1( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( J, K ) ) 180 CONTINUE 190 CONTINUE END IF @@ -2571,15 +2722,15 @@ SUBROUTINE CMMCH(TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, END IF DO 200 I = 1, M CT( I ) = ALPHA*CT( I ) + BETA*C( I, J ) - G( I ) = ABS1( ALPHA )*G( I ) + - $ ABS1( BETA )*ABS1( C( I, J ) ) + G( I ) = CABS1( ALPHA )*G( I ) + + $ CABS1( BETA )*CABS1( C( I, J ) ) 200 CONTINUE * * Compute the error ratio for this result. * ERR = ZERO DO 210 I = 1, M - ERRI = ABS1( CT( I ) - CC( I, J ) )/EPS + ERRI = CABS1( CT( I ) - CC( I, J ) )/EPS IF( G( I ).NE.RZERO ) $ ERRI = ERRI/G( I ) ERR = MAX( ERR, ERRI ) @@ -2618,7 +2769,10 @@ SUBROUTINE CMMCH(TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, * End of CMMCH. * END + +* ===================================================================== LOGICAL FUNCTION LCE( RI, RJ, LR ) + IMPLICIT NONE * * Tests if two arrays are identical. * @@ -2650,7 +2804,10 @@ LOGICAL FUNCTION LCE( RI, RJ, LR ) * End of LCE. * END + +* ===================================================================== LOGICAL FUNCTION LCERES( TYPE, UPLO, M, N, AA, AS, LDA ) + IMPLICIT NONE * * Tests if selected elements in two arrays are equal. * @@ -2712,7 +2869,10 @@ LOGICAL FUNCTION LCERES( TYPE, UPLO, M, N, AA, AS, LDA ) * End of LCERES. * END + +* ===================================================================== COMPLEX FUNCTION CBEG( RESET ) + IMPLICIT NONE * * Generates complex numbers as pairs of random numbers uniformly * distributed between -0.5 and 0.5. @@ -2760,13 +2920,16 @@ COMPLEX FUNCTION CBEG( RESET ) IC = 0 GO TO 10 END IF - CBEG = CMPLX( ( I - 500 )/1001.0, ( J - 500 )/1001.0 ) + CBEG = CMPLX( REAL( I - 500 )/1001.0, REAL( J - 500 )/1001.0 ) RETURN * * End of CBEG. * END + +* ===================================================================== REAL FUNCTION SDIFF( X, Y ) + IMPLICIT NONE * * Auxiliary routine for test program for Level 3 Blas. * @@ -2785,3 +2948,565 @@ REAL FUNCTION SDIFF( X, Y ) * End of SDIFF. * END + +* ===================================================================== + SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, + $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, + $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G, + $ IORDER ) + IMPLICIT NONE +* +* Tests CGEMMTR. +* +* Auxiliary routine for test program for Level 3 Blas. +* +* -- Written on 24-June-2024. +* Martin Koehler, Max Planck Institute Magdeburg +* +* .. Parameters .. + COMPLEX ZERO + PARAMETER ( ZERO = ( 0.0, 0.0 ) ) + REAL RZERO + PARAMETER ( RZERO = 0.0 ) +* .. Scalar Arguments .. + REAL EPS, THRESH + INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER + LOGICAL FATAL, REWI, TRACE + CHARACTER*13 SNAME +* .. Array Arguments .. + COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), + $ AS( NMAX*NMAX ), B( NMAX, NMAX ), + $ BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ), + $ C( NMAX, NMAX ), CC( NMAX*NMAX ), + $ CS( NMAX*NMAX ), CT( NMAX ) + REAL G( NMAX ) + INTEGER IDIM( NIDIM ) +* .. Local Scalars .. + COMPLEX ALPHA, ALS, BETA, BLS + REAL ERR, ERRMAX + INTEGER NTESTS, NFAILS + INTEGER I, IA, IB, ICA, ICB, IK, IM, IN, K, KS, LAA, + $ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, + $ MA, MB, N, NA, NARGS, NB, NC, NS, IS + LOGICAL NULL, RESET, SAME, TRANA, TRANB + CHARACTER*1 TRANAS, TRANBS, TRANSA, TRANSB, UPLO, UPLOS + CHARACTER*3 ICH + CHARACTER*2 ISHAPE +* .. Local Arrays .. + LOGICAL ISAME( 13 ) +* .. External Functions .. + LOGICAL LCE, LCERES + EXTERNAL LCE, LCERES +* .. External Subroutines .. + EXTERNAL CCGEMMTR, CMAKE, CMMTCH, CPRCN8 +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. Scalars in Common .. + INTEGER INFOT, NOUTC + LOGICAL LERR, OK +* .. Common blocks .. + COMMON /INFOC/INFOT, NOUTC, OK, LERR +* .. Data statements .. + DATA ICH/'NTC'/ + DATA ISHAPE/'UL'/ +* .. Executable Statements .. +* + NARGS = 13 + NC = 0 + RESET = .TRUE. + ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 +* + DO 100 IN = 1, NIDIM + N = IDIM( IN ) +* Set LDC to 1 more than minimum value if room. + LDC = N + IF( LDC.LT.NMAX ) + $ LDC = LDC + 1 +* Skip tests if not enough room. + IF( LDC.GT.NMAX ) + $ GO TO 100 + LCC = LDC*N + NULL = N.LE.0 +* + DO 90 IK = 1, NIDIM + K = IDIM( IK ) +* + DO 80 ICA = 1, 3 + TRANSA = ICH( ICA: ICA ) + TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' +* + IF( TRANA )THEN + MA = K + NA = N + ELSE + MA = N + NA = K + END IF +* Set LDA to 1 more than minimum value if room. + LDA = MA + IF( LDA.LT.NMAX ) + $ LDA = LDA + 1 +* Skip tests if not enough room. + IF( LDA.GT.NMAX ) + $ GO TO 80 + LAA = LDA*NA +* +* Generate the matrix A. +* + CALL CMAKE( 'ge', ' ', ' ', MA, NA, A, NMAX, AA, LDA, + $ RESET, ZERO ) +* + DO 70 ICB = 1, 3 + TRANSB = ICH( ICB: ICB ) + TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' +* + IF( TRANB )THEN + MB = N + NB = K + ELSE + MB = K + NB = N + END IF +* Set LDB to 1 more than minimum value if room. + LDB = MB + IF( LDB.LT.NMAX ) + $ LDB = LDB + 1 +* Skip tests if not enough room. + IF( LDB.GT.NMAX ) + $ GO TO 70 + LBB = LDB*NB +* +* Generate the matrix B. +* + CALL CMAKE( 'ge', ' ', ' ', MB, NB, B, NMAX, BB, + $ LDB, RESET, ZERO ) +* + DO 60 IA = 1, NALF + ALPHA = ALF( IA ) +* + DO 50 IB = 1, NBET + BETA = BET( IB ) + DO 45 IS = 1, 2 + UPLO = ISHAPE(IS:IS) +* +* Generate the matrix C. +* + CALL CMAKE( 'ge', UPLO, ' ', N, N, C, NMAX, + $ CC, LDC, RESET, ZERO ) +* + NC = NC + 1 +* +* Save every datum before calling the +* subroutine. +* + UPLOS = UPLO + TRANAS = TRANSA + TRANBS = TRANSB + NS = N + KS = K + ALS = ALPHA + DO 10 I = 1, LAA + AS( I ) = AA( I ) + 10 CONTINUE + LDAS = LDA + DO 20 I = 1, LBB + BS( I ) = BB( I ) + 20 CONTINUE + LDBS = LDB + BLS = BETA + DO 30 I = 1, LCC + CS( I ) = CC( I ) + 30 CONTINUE + LDCS = LDC +* +* Call the subroutine. +* + IF( TRACE ) + $ CALL CPRCN8(NTRA, NC, SNAME, IORDER, UPLO, + $ TRANSA, TRANSB, N, K, ALPHA, LDA, + $ LDB, BETA, LDC) + IF( REWI ) + $ REWIND NTRA + CALL CCGEMMTR(IORDER, UPLO, TRANSA, TRANSB, + $ N, K, ALPHA, AA, LDA, BB, LDB, + $ BETA, CC, LDC ) +* +* Check if error-exit was taken incorrectly. +* + IF( .NOT.OK )THEN + WRITE( NOUT, FMT = 9994 ) + FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 + GO TO 120 + END IF +* +* See what data changed inside subroutines. +* + ISAME( 1 ) = UPLO .EQ. UPLOS + ISAME( 2 ) = TRANSA.EQ.TRANAS + ISAME( 3 ) = TRANSB.EQ.TRANBS + ISAME( 4 ) = NS.EQ.N + ISAME( 5 ) = KS.EQ.K + ISAME( 6 ) = ALS.EQ.ALPHA + ISAME( 7 ) = LCE( AS, AA, LAA ) + ISAME( 8 ) = LDAS.EQ.LDA + ISAME( 9 ) = LCE( BS, BB, LBB ) + ISAME( 10 ) = LDBS.EQ.LDB + ISAME( 11 ) = BLS.EQ.BETA + IF( NULL )THEN + ISAME( 12 ) = LCE( CS, CC, LCC ) + ELSE + ISAME( 12 ) = LCERES( 'ge', ' ', N, N, CS, + $ CC, LDC ) + END IF + ISAME( 13 ) = LDCS.EQ.LDC +* +* If data was incorrectly changed, report +* and return. +* + SAME = .TRUE. + DO 40 I = 1, NARGS + SAME = SAME.AND.ISAME( I ) + IF( .NOT.ISAME( I ) ) + $ WRITE( NOUT, FMT = 9998 )I + 40 CONTINUE + IF( .NOT.SAME )THEN + FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 + GO TO 120 + END IF +* + IF( .NOT.NULL )THEN +* +* Check the result. +* + CALL CMMTCH( UPLO, TRANSA, TRANSB, N, K, + $ ALPHA, A, NMAX, B, NMAX, BETA, + $ C, NMAX, CT, G, CC, LDC, EPS, + $ ERR, FATAL, NOUT, .TRUE. ) + ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 +* If got really bad answer, report and +* return. + IF( FATAL ) + $ GO TO 120 + END IF +* + 45 CONTINUE +* + 50 CONTINUE +* + 60 CONTINUE +* + 70 CONTINUE +* + 80 CONTINUE +* + 90 CONTINUE +* + 100 CONTINUE +* +* +* Report result. +* + IF( ERRMAX.LT.THRESH )THEN + IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10000 )SNAME, NC + IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10001 )SNAME, NC + ELSE + IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10002 )SNAME, NC, ERRMAX + IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10003 )SNAME, NC, ERRMAX + END IF + GO TO 130 +* + 120 CONTINUE + WRITE( NOUT, FMT = 9996 )SNAME + CALL CPRCN8(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, TRANSB, + $ N, K, ALPHA, LDA, LDB, BETA, LDC) +* + 130 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS + RETURN +* +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) + 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', + $ 'ANGED INCORRECTLY *******' ) + 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A13,'(''', A1, ''',''', A1, ''',', + $ 3( I3, ',' ), '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, + $ ',(', F4.1, ',', F4.1, '), C,', I3, ').' ) + 9994 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', + $ '******' ) + 9979 FORMAT( ' ', A13,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A13,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) +* +* End of CCHK6. +* + END + +* ===================================================================== + SUBROUTINE CPRCN8(NOUT, NC, SNAME, IORDER, UPLO, + $ TRANSA, TRANSB, N, + $ K, ALPHA, LDA, LDB, BETA, LDC) + IMPLICIT NONE + + INTEGER NOUT, NC, IORDER, N, K, LDA, LDB, LDC + COMPLEX ALPHA, BETA + CHARACTER*1 TRANSA, TRANSB, UPLO + CHARACTER*13 SNAME + CHARACTER*14 CRC, CTA,CTB,CUPLO + + IF (UPLO.EQ.'U') THEN + CUPLO = 'CblasUpper' + ELSE + CUPLO = 'CblasLower' + END IF + IF (TRANSA.EQ.'N')THEN + CTA = ' CblasNoTrans' + ELSE IF (TRANSA.EQ.'T')THEN + CTA = ' CblasTrans' + ELSE + CTA = 'CblasConjTrans' + END IF + IF (TRANSB.EQ.'N')THEN + CTB = ' CblasNoTrans' + ELSE IF (TRANSB.EQ.'T')THEN + CTB = ' CblasTrans' + ELSE + CTB = 'CblasConjTrans' + END IF + IF (IORDER.EQ.1)THEN + CRC = ' CblasRowMajor' + ELSE + CRC = ' CblasColMajor' + END IF + WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CUPLO, CTA,CTB + WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, LDB, BETA, LDC + + 9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',', + $ A14, ',') + 9994 FORMAT( 10X, 2( I3, ',' ) ,' (', F4.1,',',F4.1,') , A,', + $ I3, ', B,', I3, ', (', F4.1,',',F4.1,') , C,', I3, ').' ) + END + +* ===================================================================== + SUBROUTINE CMMTCH(UPLO, TRANSA, TRANSB, N, KK, ALPHA, A, LDA, + $ B, LDB, + $ BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, FATAL, + $ NOUT, MV ) + IMPLICIT NONE +* +* Checks the results of the computational tests for GEMMTR. +* +* Auxiliary routine for test program for Level 3 Blas. +* +* -- Written on 24-June-2024. +* Martin Koehler, Max Planck Institute, Magdeburg +* +* .. Parameters .. + COMPLEX ZERO + PARAMETER ( ZERO = ( 0.0, 0.0 ) ) + REAL RZERO, RONE + PARAMETER ( RZERO = 0.0, RONE = 1.0 ) +* .. Scalar Arguments .. + COMPLEX ALPHA, BETA + REAL EPS, ERR + INTEGER KK, LDA, LDB, LDC, LDCC, N, NOUT + LOGICAL FATAL, MV + CHARACTER*1 TRANSA, TRANSB, UPLO +* .. Array Arguments .. + COMPLEX A( LDA, * ), B( LDB, * ), C( LDC, * ), + $ CC( LDCC, * ), CT( * ) + REAL G( * ) +* .. Local Scalars .. + COMPLEX CL + REAL ERRI + INTEGER I, J, K, ISTART, ISTOP + LOGICAL CTRANA, CTRANB, TRANA, TRANB, UPPER +* .. Intrinsic Functions .. + INTRINSIC ABS, AIMAG, CONJG, MAX, REAL, SQRT +* .. Statement Functions .. + REAL CABS1 +* .. Statement Function definitions .. + CABS1( CL ) = ABS( REAL( CL ) ) + ABS( AIMAG( CL ) ) +* .. Executable Statements .. + + UPPER = UPLO.EQ.'U' + TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' + TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' + CTRANA = TRANSA.EQ.'C' + CTRANB = TRANSB.EQ.'C' + + ISTART = 1 + ISTOP = N +* +* Compute expected result, one column at a time, in CT using data +* in A, B and C. +* Compute gauges in G. +* + DO 220 J = 1, N +* + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + DO 10 I = ISTART, ISTOP + CT( I ) = ZERO + G( I ) = RZERO + 10 CONTINUE + IF( .NOT.TRANA.AND..NOT.TRANB )THEN + DO 30 K = 1, KK + DO 20 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*B( K, J ) + G( I ) = G( I ) + $ + CABS1( A( I, K ) )*CABS1( B( K, J ) ) + 20 CONTINUE + 30 CONTINUE + ELSE IF( TRANA.AND..NOT.TRANB )THEN + IF( CTRANA )THEN + DO 50 K = 1, KK + DO 40 I = ISTART, ISTOP + CT( I ) = CT( I ) + CONJG( A( K, I ) )*B( K, J ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( K, J ) ) + 40 CONTINUE + 50 CONTINUE + ELSE + DO 70 K = 1, KK + DO 60 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*B( K, J ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( K, J ) ) + 60 CONTINUE + 70 CONTINUE + END IF + ELSE IF( .NOT.TRANA.AND.TRANB )THEN + IF( CTRANB )THEN + DO 90 K = 1, KK + DO 80 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*CONJG( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( I, K ) )* + $ CABS1( B( J, K ) ) + 80 CONTINUE + 90 CONTINUE + ELSE + DO 110 K = 1, KK + DO 100 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*B( J, K ) + G( I ) = G( I ) + CABS1( A( I, K ) )* + $ CABS1( B( J, K ) ) + 100 CONTINUE + 110 CONTINUE + END IF + ELSE IF( TRANA.AND.TRANB )THEN + IF( CTRANA )THEN + IF( CTRANB )THEN + DO 130 K = 1, KK + DO 120 I = ISTART, ISTOP + CT( I ) = CT( I ) + CONJG( A( K, I ) )* + $ CONJG( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( J, K ) ) + 120 CONTINUE + 130 CONTINUE + ELSE + DO 150 K = 1, KK + DO 140 I = ISTART, ISTOP + CT( I ) = CT( I ) + CONJG( A( K, I ) )*B( J, K ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( J, K ) ) + 140 CONTINUE + 150 CONTINUE + END IF + ELSE + IF( CTRANB )THEN + DO 170 K = 1, KK + DO 160 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*CONJG( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( J, K ) ) + 160 CONTINUE + 170 CONTINUE + ELSE + DO 190 K = 1, KK + DO 180 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*B( J, K ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( J, K ) ) + 180 CONTINUE + 190 CONTINUE + END IF + END IF + END IF + DO 200 I = ISTART, ISTOP + CT( I ) = ALPHA*CT( I ) + BETA*C( I, J ) + G( I ) = CABS1( ALPHA )*G( I ) + + $ CABS1( BETA )*CABS1( C( I, J ) ) + 200 CONTINUE +* +* Compute the error ratio for this result. +* + ERR = ZERO + DO 210 I = ISTART, ISTOP + ERRI = CABS1( CT( I ) - CC( I, J ) )/EPS + IF( G( I ).NE.RZERO ) + $ ERRI = ERRI/G( I ) + ERR = MAX( ERR, ERRI ) + IF( ERR*SQRT( EPS ).GE.RONE ) + $ GO TO 230 + 210 CONTINUE +* + 220 CONTINUE +* +* If the loop completes, all results are at least half accurate. + GO TO 250 +* +* Report fatal error. +* + 230 FATAL = .TRUE. + WRITE( NOUT, FMT = 9999 ) + DO 240 I = ISTART, ISTOP + IF( MV )THEN + WRITE( NOUT, FMT = 9998 )I, CT( I ), CC( I, J ) + ELSE + WRITE( NOUT, FMT = 9998 )I, CC( I, J ), CT( I ) + END IF + 240 CONTINUE + IF( N.GT.1 ) + $ WRITE( NOUT, FMT = 9997 )J +* + 250 CONTINUE + RETURN +* + 9999 FORMAT(' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL', + $ 'F ACCURATE *******', /' EXPECTED RE', + $ 'SULT COMPUTED RESULT' ) + 9998 FORMAT( 1X, I7, 2( ' (', G15.6, ',', G15.6, ')' ) ) + 9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) +* +* End of CMMTCH. +* + END + diff --git a/CBLAS/testing/c_d2chke.c b/CBLAS/testing/c_d2chke.c index d989811d28..f251151b99 100644 --- a/CBLAS/testing/c_d2chke.c +++ b/CBLAS/testing/c_d2chke.c @@ -3,787 +3,897 @@ #include "cblas.h" #include "cblas_test.h" -int cblas_ok, cblas_lerr, cblas_info; -int link_xerbla=TRUE; +CBLAS_INT cblas_ok, cblas_lerr, cblas_info; +CBLAS_INT link_xerbla=TRUE; +CBLAS_INT cblas_xtests, cblas_xfails, cblas_xbad; char *cblas_rout; #ifdef F77_Char -void F77_xerbla(F77_Char F77_srname, void *vinfo); +void F77_xerbla(F77_Char F77_srname, void *vinfo #else -void F77_xerbla(char *srname, void *vinfo); +void F77_xerbla(char *srname, void *vinfo #endif +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN srname_len +#endif +); void chkxer(void) { - extern int cblas_ok, cblas_lerr, cblas_info; - extern int link_xerbla; + extern CBLAS_INT cblas_ok, cblas_lerr, cblas_info; + extern CBLAS_INT link_xerbla; + extern CBLAS_INT cblas_xtests, cblas_xfails, cblas_xbad; extern char *cblas_rout; + cblas_xtests++; if (cblas_lerr == 1 ) { - printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", 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) { + cblas_xfails++; } + cblas_xbad = 0; cblas_lerr = 1 ; } -void F77_d2chke(char *rout) { +void F77_d2chke(char *rout +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN rout_len +#endif +) { char *sf = ( rout ) ; double A[2] = {0.0,0.0}, X[2] = {0.0,0.0}, Y[2] = {0.0,0.0}, ALPHA=0.0, BETA=0.0; - extern int cblas_info, cblas_lerr, cblas_ok; - extern int RowMajorStrg; + extern CBLAS_INT cblas_info, cblas_lerr, cblas_ok; extern char *cblas_rout; +#ifndef HAS_ATTRIBUTE_WEAK_SUPPORT + #ifdef CBLAS_DLL_IMPORTS + // Since Windows does not support weak symbols, and the trick below doesn't + // work for shared libraries on Windows, we skip the xerbla tests here. + printf("***** WARNING: Skipping xerbla tests since weak symbols are not supported on Windows *****\n"); + return; + #endif + if (link_xerbla) /* call these first to link */ { - cblas_xerbla(cblas_info,cblas_rout,""); - F77_xerbla(cblas_rout,&cblas_info); + API_SUFFIX(cblas_xerbla)(cblas_info,cblas_rout,""); + F77_xerbla(cblas_rout,&cblas_info, 1); } +#endif + link_xerbla = 0; cblas_ok = TRUE ; cblas_lerr = PASSED ; + cblas_xtests = 0; + cblas_xfails = 0; + cblas_xbad = 0; if (strncmp( sf,"cblas_dgemv",11)==0) { cblas_rout = "cblas_dgemv"; cblas_info = 1; - cblas_dgemv(INVALID, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_dgemv)(INVALID_LAYOUT, CblasNoTrans, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_dgemv(CblasColMajor, INVALID, 0, 0, + API_SUFFIX(cblas_dgemv)(CblasColMajor, INVALID_TRANSPOSE, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_dgemv(CblasColMajor, CblasNoTrans, INVALID, 0, + API_SUFFIX(cblas_dgemv)(CblasColMajor, CblasNoTrans, INVALID, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_dgemv(CblasColMajor, CblasNoTrans, 0, INVALID, + API_SUFFIX(cblas_dgemv)(CblasColMajor, CblasNoTrans, 0, INVALID, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_dgemv(CblasColMajor, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_dgemv)(CblasColMajor, CblasNoTrans, 2, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_dgemv(CblasColMajor, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_dgemv)(CblasColMajor, CblasNoTrans, 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_dgemv(CblasColMajor, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_dgemv)(CblasColMajor, CblasNoTrans, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; RowMajorStrg = TRUE; - cblas_dgemv(CblasRowMajor, INVALID, 0, 0, + API_SUFFIX(cblas_dgemv)(CblasRowMajor, INVALID_TRANSPOSE, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_dgemv(CblasRowMajor, CblasNoTrans, INVALID, 0, + API_SUFFIX(cblas_dgemv)(CblasRowMajor, CblasNoTrans, INVALID, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_dgemv(CblasRowMajor, CblasNoTrans, 0, INVALID, + API_SUFFIX(cblas_dgemv)(CblasRowMajor, CblasNoTrans, 0, INVALID, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_dgemv(CblasRowMajor, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_dgemv)(CblasRowMajor, CblasNoTrans, 0, 2, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = TRUE; - cblas_dgemv(CblasRowMajor, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_dgemv)(CblasRowMajor, CblasNoTrans, 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_dgemv(CblasRowMajor, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_dgemv)(CblasRowMajor, CblasNoTrans, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ); chkxer(); } else if (strncmp( sf,"cblas_dgbmv",11)==0) { cblas_rout = "cblas_dgbmv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_dgbmv(INVALID, CblasNoTrans, 0, 0, 0, 0, + API_SUFFIX(cblas_dgbmv)(INVALID_LAYOUT, CblasNoTrans, 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_dgbmv(CblasColMajor, INVALID, 0, 0, 0, 0, + API_SUFFIX(cblas_dgbmv)(CblasColMajor, INVALID_TRANSPOSE, 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_dgbmv(CblasColMajor, CblasNoTrans, INVALID, 0, 0, 0, + API_SUFFIX(cblas_dgbmv)(CblasColMajor, CblasNoTrans, INVALID, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_dgbmv(CblasColMajor, CblasNoTrans, 0, INVALID, 0, 0, + API_SUFFIX(cblas_dgbmv)(CblasColMajor, CblasNoTrans, 0, INVALID, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_dgbmv(CblasColMajor, CblasNoTrans, 0, 0, INVALID, 0, + API_SUFFIX(cblas_dgbmv)(CblasColMajor, CblasNoTrans, 0, 0, INVALID, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_dgbmv(CblasColMajor, CblasNoTrans, 2, 0, 0, INVALID, + API_SUFFIX(cblas_dgbmv)(CblasColMajor, CblasNoTrans, 2, 0, 0, INVALID, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_dgbmv(CblasColMajor, CblasNoTrans, 0, 0, 1, 0, + API_SUFFIX(cblas_dgbmv)(CblasColMajor, CblasNoTrans, 0, 0, 1, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_dgbmv(CblasColMajor, CblasNoTrans, 0, 0, 0, 0, + API_SUFFIX(cblas_dgbmv)(CblasColMajor, CblasNoTrans, 0, 0, 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = FALSE; - cblas_dgbmv(CblasColMajor, CblasNoTrans, 0, 0, 0, 0, + API_SUFFIX(cblas_dgbmv)(CblasColMajor, CblasNoTrans, 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_dgbmv(CblasRowMajor, INVALID, 0, 0, 0, 0, + API_SUFFIX(cblas_dgbmv)(CblasRowMajor, INVALID_TRANSPOSE, 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_dgbmv(CblasRowMajor, CblasNoTrans, INVALID, 0, 0, 0, + API_SUFFIX(cblas_dgbmv)(CblasRowMajor, CblasNoTrans, INVALID, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_dgbmv(CblasRowMajor, CblasNoTrans, 0, INVALID, 0, 0, + API_SUFFIX(cblas_dgbmv)(CblasRowMajor, CblasNoTrans, 0, INVALID, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_dgbmv(CblasRowMajor, CblasNoTrans, 0, 0, INVALID, 0, + API_SUFFIX(cblas_dgbmv)(CblasRowMajor, CblasNoTrans, 0, 0, INVALID, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_dgbmv(CblasRowMajor, CblasNoTrans, 2, 0, 0, INVALID, + API_SUFFIX(cblas_dgbmv)(CblasRowMajor, CblasNoTrans, 2, 0, 0, INVALID, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = TRUE; - cblas_dgbmv(CblasRowMajor, CblasNoTrans, 0, 0, 1, 0, + API_SUFFIX(cblas_dgbmv)(CblasRowMajor, CblasNoTrans, 0, 0, 1, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_dgbmv(CblasRowMajor, CblasNoTrans, 0, 0, 0, 0, + API_SUFFIX(cblas_dgbmv)(CblasRowMajor, CblasNoTrans, 0, 0, 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = TRUE; - cblas_dgbmv(CblasRowMajor, CblasNoTrans, 0, 0, 0, 0, + API_SUFFIX(cblas_dgbmv)(CblasRowMajor, CblasNoTrans, 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ); chkxer(); } else if (strncmp( sf,"cblas_dsymv",11)==0) { cblas_rout = "cblas_dsymv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_dsymv(INVALID, CblasUpper, 0, + API_SUFFIX(cblas_dsymv)(INVALID_LAYOUT, CblasUpper, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_dsymv(CblasColMajor, INVALID, 0, + API_SUFFIX(cblas_dsymv)(CblasColMajor, INVALID_UPLO, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_dsymv(CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_dsymv)(CblasColMajor, CblasUpper, INVALID, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_dsymv(CblasColMajor, CblasUpper, 2, + API_SUFFIX(cblas_dsymv)(CblasColMajor, CblasUpper, 2, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_dsymv(CblasColMajor, CblasUpper, 0, + API_SUFFIX(cblas_dsymv)(CblasColMajor, CblasUpper, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_dsymv(CblasColMajor, CblasUpper, 0, + API_SUFFIX(cblas_dsymv)(CblasColMajor, CblasUpper, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_dsymv(CblasRowMajor, INVALID, 0, + API_SUFFIX(cblas_dsymv)(CblasRowMajor, INVALID_UPLO, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_dsymv(CblasRowMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_dsymv)(CblasRowMajor, CblasUpper, INVALID, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_dsymv(CblasRowMajor, CblasUpper, 2, + API_SUFFIX(cblas_dsymv)(CblasRowMajor, CblasUpper, 2, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_dsymv(CblasRowMajor, CblasUpper, 0, + API_SUFFIX(cblas_dsymv)(CblasRowMajor, CblasUpper, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_dsymv(CblasRowMajor, CblasUpper, 0, + API_SUFFIX(cblas_dsymv)(CblasRowMajor, CblasUpper, 0, + ALPHA, A, 1, X, 1, BETA, Y, 0 ); + chkxer(); + } else if (strncmp( sf,"cblas_dskewsymv",15)==0) { + cblas_rout = "cblas_dskewsymv"; + cblas_info = 1; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dskewsymv)(INVALID_LAYOUT, CblasUpper, 0, + ALPHA, A, 1, X, 1, BETA, Y, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dskewsymv)(CblasColMajor, INVALID_UPLO, 0, + ALPHA, A, 1, X, 1, BETA, Y, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dskewsymv)(CblasColMajor, CblasUpper, INVALID, + ALPHA, A, 1, X, 1, BETA, Y, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dskewsymv)(CblasColMajor, CblasUpper, 2, + ALPHA, A, 1, X, 1, BETA, Y, 1 ); + chkxer(); + cblas_info = 8; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dskewsymv)(CblasColMajor, CblasUpper, 0, + ALPHA, A, 1, X, 0, BETA, Y, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dskewsymv)(CblasColMajor, CblasUpper, 0, + ALPHA, A, 1, X, 1, BETA, Y, 0 ); + chkxer(); + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dskewsymv)(CblasRowMajor, INVALID_UPLO, 0, + ALPHA, A, 1, X, 1, BETA, Y, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dskewsymv)(CblasRowMajor, CblasUpper, INVALID, + ALPHA, A, 1, X, 1, BETA, Y, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dskewsymv)(CblasRowMajor, CblasUpper, 2, + ALPHA, A, 1, X, 1, BETA, Y, 1 ); + chkxer(); + cblas_info = 8; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dskewsymv)(CblasRowMajor, CblasUpper, 0, + ALPHA, A, 1, X, 0, BETA, Y, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dskewsymv)(CblasRowMajor, CblasUpper, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ); chkxer(); } else if (strncmp( sf,"cblas_dsbmv",11)==0) { cblas_rout = "cblas_dsbmv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_dsbmv(INVALID, CblasUpper, 0, 0, + API_SUFFIX(cblas_dsbmv)(INVALID_LAYOUT, CblasUpper, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_dsbmv(CblasColMajor, INVALID, 0, 0, + API_SUFFIX(cblas_dsbmv)(CblasColMajor, INVALID_UPLO, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_dsbmv(CblasColMajor, CblasUpper, INVALID, 0, + API_SUFFIX(cblas_dsbmv)(CblasColMajor, CblasUpper, INVALID, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_dsbmv(CblasColMajor, CblasUpper, 0, INVALID, + API_SUFFIX(cblas_dsbmv)(CblasColMajor, CblasUpper, 0, INVALID, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_dsbmv(CblasColMajor, CblasUpper, 0, 1, + API_SUFFIX(cblas_dsbmv)(CblasColMajor, CblasUpper, 0, 1, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_dsbmv(CblasColMajor, CblasUpper, 0, 0, + API_SUFFIX(cblas_dsbmv)(CblasColMajor, CblasUpper, 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_dsbmv(CblasColMajor, CblasUpper, 0, 0, + API_SUFFIX(cblas_dsbmv)(CblasColMajor, CblasUpper, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_dsbmv(CblasRowMajor, INVALID, 0, 0, + API_SUFFIX(cblas_dsbmv)(CblasRowMajor, INVALID_UPLO, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_dsbmv(CblasRowMajor, CblasUpper, INVALID, 0, + API_SUFFIX(cblas_dsbmv)(CblasRowMajor, CblasUpper, INVALID, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_dsbmv(CblasRowMajor, CblasUpper, 0, INVALID, + API_SUFFIX(cblas_dsbmv)(CblasRowMajor, CblasUpper, 0, INVALID, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_dsbmv(CblasRowMajor, CblasUpper, 0, 1, + API_SUFFIX(cblas_dsbmv)(CblasRowMajor, CblasUpper, 0, 1, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = TRUE; - cblas_dsbmv(CblasRowMajor, CblasUpper, 0, 0, + API_SUFFIX(cblas_dsbmv)(CblasRowMajor, CblasUpper, 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_dsbmv(CblasRowMajor, CblasUpper, 0, 0, + API_SUFFIX(cblas_dsbmv)(CblasRowMajor, CblasUpper, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ); chkxer(); } else if (strncmp( sf,"cblas_dspmv",11)==0) { cblas_rout = "cblas_dspmv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_dspmv(INVALID, CblasUpper, 0, + API_SUFFIX(cblas_dspmv)(INVALID_LAYOUT, CblasUpper, 0, ALPHA, A, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_dspmv(CblasColMajor, INVALID, 0, + API_SUFFIX(cblas_dspmv)(CblasColMajor, INVALID_UPLO, 0, ALPHA, A, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_dspmv(CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_dspmv)(CblasColMajor, CblasUpper, INVALID, ALPHA, A, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_dspmv(CblasColMajor, CblasUpper, 0, + API_SUFFIX(cblas_dspmv)(CblasColMajor, CblasUpper, 0, ALPHA, A, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_dspmv(CblasColMajor, CblasUpper, 0, + API_SUFFIX(cblas_dspmv)(CblasColMajor, CblasUpper, 0, ALPHA, A, X, 1, BETA, Y, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_dspmv(CblasRowMajor, INVALID, 0, + API_SUFFIX(cblas_dspmv)(CblasRowMajor, INVALID_UPLO, 0, ALPHA, A, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_dspmv(CblasRowMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_dspmv)(CblasRowMajor, CblasUpper, INVALID, ALPHA, A, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_dspmv(CblasRowMajor, CblasUpper, 0, + API_SUFFIX(cblas_dspmv)(CblasRowMajor, CblasUpper, 0, ALPHA, A, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_dspmv(CblasRowMajor, CblasUpper, 0, + API_SUFFIX(cblas_dspmv)(CblasRowMajor, CblasUpper, 0, ALPHA, A, X, 1, BETA, Y, 0 ); chkxer(); } else if (strncmp( sf,"cblas_dtrmv",11)==0) { cblas_rout = "cblas_dtrmv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_dtrmv(INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrmv)(INVALID_LAYOUT, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_dtrmv(CblasColMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_dtrmv)(CblasColMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_dtrmv(CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_dtrmv)(CblasColMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_dtrmv(CblasColMajor, CblasUpper, CblasNoTrans, - INVALID, 0, A, 1, X, 1 ); + API_SUFFIX(cblas_dtrmv)(CblasColMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, A, 1, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_dtrmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, A, 1, X, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_dtrmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 2, A, 1, X, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_dtrmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_dtrmv(CblasRowMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_dtrmv)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_dtrmv(CblasRowMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_dtrmv)(CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_dtrmv(CblasRowMajor, CblasUpper, CblasNoTrans, - INVALID, 0, A, 1, X, 1 ); + API_SUFFIX(cblas_dtrmv)(CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, A, 1, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_dtrmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, A, 1, X, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_dtrmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 2, A, 1, X, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = TRUE; - cblas_dtrmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 0 ); chkxer(); } else if (strncmp( sf,"cblas_dtbmv",11)==0) { cblas_rout = "cblas_dtbmv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_dtbmv(INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtbmv)(INVALID_LAYOUT, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_dtbmv(CblasColMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_dtbmv)(CblasColMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_dtbmv(CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_dtbmv)(CblasColMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_dtbmv(CblasColMajor, CblasUpper, CblasNoTrans, - INVALID, 0, 0, A, 1, X, 1 ); + API_SUFFIX(cblas_dtbmv)(CblasColMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_dtbmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtbmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, A, 1, X, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_dtbmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtbmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, A, 1, X, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_dtbmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtbmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 1, A, 1, X, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_dtbmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtbmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_dtbmv(CblasRowMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_dtbmv)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_dtbmv(CblasRowMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_dtbmv)(CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_dtbmv(CblasRowMajor, CblasUpper, CblasNoTrans, - INVALID, 0, 0, A, 1, X, 1 ); + API_SUFFIX(cblas_dtbmv)(CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_dtbmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtbmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, A, 1, X, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_dtbmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtbmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, A, 1, X, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_dtbmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtbmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 1, A, 1, X, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_dtbmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtbmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 0 ); chkxer(); } else if (strncmp( sf,"cblas_dtpmv",11)==0) { cblas_rout = "cblas_dtpmv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_dtpmv(INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtpmv)(INVALID_LAYOUT, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_dtpmv(CblasColMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_dtpmv)(CblasColMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_dtpmv(CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_dtpmv)(CblasColMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_dtpmv(CblasColMajor, CblasUpper, CblasNoTrans, - INVALID, 0, A, X, 1 ); + API_SUFFIX(cblas_dtpmv)(CblasColMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, A, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_dtpmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtpmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, A, X, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_dtpmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtpmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, X, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_dtpmv(CblasRowMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_dtpmv)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_dtpmv(CblasRowMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_dtpmv)(CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_dtpmv(CblasRowMajor, CblasUpper, CblasNoTrans, - INVALID, 0, A, X, 1 ); + API_SUFFIX(cblas_dtpmv)(CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, A, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_dtpmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtpmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, A, X, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_dtpmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtpmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, X, 0 ); chkxer(); } else if (strncmp( sf,"cblas_dtrsv",11)==0) { cblas_rout = "cblas_dtrsv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_dtrsv(INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrsv)(INVALID_LAYOUT, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_dtrsv(CblasColMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_dtrsv)(CblasColMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_dtrsv(CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_dtrsv)(CblasColMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_dtrsv(CblasColMajor, CblasUpper, CblasNoTrans, - INVALID, 0, A, 1, X, 1 ); + API_SUFFIX(cblas_dtrsv)(CblasColMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, A, 1, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_dtrsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, A, 1, X, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_dtrsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 2, A, 1, X, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_dtrsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_dtrsv(CblasRowMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_dtrsv)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_dtrsv(CblasRowMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_dtrsv)(CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_dtrsv(CblasRowMajor, CblasUpper, CblasNoTrans, - INVALID, 0, A, 1, X, 1 ); + API_SUFFIX(cblas_dtrsv)(CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, A, 1, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_dtrsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, A, 1, X, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_dtrsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 2, A, 1, X, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = TRUE; - cblas_dtrsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 0 ); chkxer(); } else if (strncmp( sf,"cblas_dtbsv",11)==0) { cblas_rout = "cblas_dtbsv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_dtbsv(INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtbsv)(INVALID_LAYOUT, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_dtbsv(CblasColMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_dtbsv)(CblasColMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_dtbsv(CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_dtbsv)(CblasColMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_dtbsv(CblasColMajor, CblasUpper, CblasNoTrans, - INVALID, 0, 0, A, 1, X, 1 ); + API_SUFFIX(cblas_dtbsv)(CblasColMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_dtbsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtbsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, A, 1, X, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_dtbsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtbsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, A, 1, X, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_dtbsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtbsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 1, A, 1, X, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_dtbsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtbsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_dtbsv(CblasRowMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_dtbsv)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_dtbsv(CblasRowMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_dtbsv)(CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_dtbsv(CblasRowMajor, CblasUpper, CblasNoTrans, - INVALID, 0, 0, A, 1, X, 1 ); + API_SUFFIX(cblas_dtbsv)(CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_dtbsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtbsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, A, 1, X, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_dtbsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtbsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, A, 1, X, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_dtbsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtbsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 1, A, 1, X, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_dtbsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtbsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 0 ); chkxer(); } else if (strncmp( sf,"cblas_dtpsv",11)==0) { cblas_rout = "cblas_dtpsv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_dtpsv(INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtpsv)(INVALID_LAYOUT, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_dtpsv(CblasColMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_dtpsv)(CblasColMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_dtpsv(CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_dtpsv)(CblasColMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_dtpsv(CblasColMajor, CblasUpper, CblasNoTrans, - INVALID, 0, A, X, 1 ); + API_SUFFIX(cblas_dtpsv)(CblasColMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, A, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_dtpsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtpsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, A, X, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_dtpsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtpsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, X, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_dtpsv(CblasRowMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_dtpsv)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_dtpsv(CblasRowMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_dtpsv)(CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_dtpsv(CblasRowMajor, CblasUpper, CblasNoTrans, - INVALID, 0, A, X, 1 ); + API_SUFFIX(cblas_dtpsv)(CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, A, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_dtpsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtpsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, A, X, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_dtpsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtpsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, X, 0 ); chkxer(); } else if (strncmp( sf,"cblas_dger",10)==0) { cblas_rout = "cblas_dger"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_dger(INVALID, 0, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_dger)(INVALID_LAYOUT, 0, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_dger(CblasColMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_dger)(CblasColMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_dger(CblasColMajor, 0, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_dger)(CblasColMajor, 0, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_dger(CblasColMajor, 0, 0, ALPHA, X, 0, Y, 1, A, 1 ); + API_SUFFIX(cblas_dger)(CblasColMajor, 0, 0, ALPHA, X, 0, Y, 1, A, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_dger(CblasColMajor, 0, 0, ALPHA, X, 1, Y, 0, A, 1 ); + API_SUFFIX(cblas_dger)(CblasColMajor, 0, 0, ALPHA, X, 1, Y, 0, A, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_dger(CblasColMajor, 2, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_dger)(CblasColMajor, 2, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_dger(CblasRowMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_dger)(CblasRowMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_dger(CblasRowMajor, 0, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_dger)(CblasRowMajor, 0, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_dger(CblasRowMajor, 0, 0, ALPHA, X, 0, Y, 1, A, 1 ); + API_SUFFIX(cblas_dger)(CblasRowMajor, 0, 0, ALPHA, X, 0, Y, 1, A, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_dger(CblasRowMajor, 0, 0, ALPHA, X, 1, Y, 0, A, 1 ); + API_SUFFIX(cblas_dger)(CblasRowMajor, 0, 0, ALPHA, X, 1, Y, 0, A, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_dger(CblasRowMajor, 0, 2, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_dger)(CblasRowMajor, 0, 2, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); } else if (strncmp( sf,"cblas_dsyr2",11)==0) { cblas_rout = "cblas_dsyr2"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_dsyr2(INVALID, CblasUpper, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_dsyr2)(INVALID_LAYOUT, CblasUpper, 0, ALPHA, X, 1, Y, 1, A, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsyr2)(CblasColMajor, INVALID_UPLO, 0, ALPHA, X, 1, Y, 1, A, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsyr2)(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsyr2)(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A, 1 ); + chkxer(); + cblas_info = 8; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsyr2)(CblasColMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A, 1 ); + chkxer(); + cblas_info = 10; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsyr2)(CblasColMajor, CblasUpper, 2, ALPHA, X, 1, Y, 1, A, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2)(CblasRowMajor, INVALID_UPLO, 0, ALPHA, X, 1, Y, 1, A, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2)(CblasRowMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2)(CblasRowMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A, 1 ); + chkxer(); + cblas_info = 8; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2)(CblasRowMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A, 1 ); + chkxer(); + cblas_info = 10; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2)(CblasRowMajor, CblasUpper, 2, ALPHA, X, 1, Y, 1, A, 1 ); + chkxer(); + } else if (strncmp( sf,"cblas_dskewsyr2",15)==0) { + cblas_rout = "cblas_dskewsyr2"; + cblas_info = 1; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dskewsyr2)(INVALID_LAYOUT, CblasUpper, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_dsyr2(CblasColMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_dskewsyr2)(CblasColMajor, INVALID_UPLO, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_dsyr2(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_dskewsyr2)(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_dsyr2(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A, 1 ); + API_SUFFIX(cblas_dskewsyr2)(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_dsyr2(CblasColMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A, 1 ); + API_SUFFIX(cblas_dskewsyr2)(CblasColMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_dsyr2(CblasColMajor, CblasUpper, 2, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_dskewsyr2)(CblasColMajor, CblasUpper, 2, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_dsyr2(CblasRowMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_dskewsyr2)(CblasRowMajor, INVALID_UPLO, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_dsyr2(CblasRowMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_dskewsyr2)(CblasRowMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_dsyr2(CblasRowMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A, 1 ); + API_SUFFIX(cblas_dskewsyr2)(CblasRowMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_dsyr2(CblasRowMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A, 1 ); + API_SUFFIX(cblas_dskewsyr2)(CblasRowMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_dsyr2(CblasRowMajor, CblasUpper, 2, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_dskewsyr2)(CblasRowMajor, CblasUpper, 2, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); } else if (strncmp( sf,"cblas_dspr2",11)==0) { cblas_rout = "cblas_dspr2"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_dspr2(INVALID, CblasUpper, 0, ALPHA, X, 1, Y, 1, A ); + API_SUFFIX(cblas_dspr2)(INVALID_LAYOUT, CblasUpper, 0, ALPHA, X, 1, Y, 1, A ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_dspr2(CblasColMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A ); + API_SUFFIX(cblas_dspr2)(CblasColMajor, INVALID_UPLO, 0, ALPHA, X, 1, Y, 1, A ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_dspr2(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A ); + API_SUFFIX(cblas_dspr2)(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_dspr2(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A ); + API_SUFFIX(cblas_dspr2)(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_dspr2(CblasColMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A ); + API_SUFFIX(cblas_dspr2)(CblasColMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_dspr2(CblasRowMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A ); + API_SUFFIX(cblas_dspr2)(CblasRowMajor, INVALID_UPLO, 0, ALPHA, X, 1, Y, 1, A ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_dspr2(CblasRowMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A ); + API_SUFFIX(cblas_dspr2)(CblasRowMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_dspr2(CblasRowMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A ); + API_SUFFIX(cblas_dspr2)(CblasRowMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_dspr2(CblasRowMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A ); + API_SUFFIX(cblas_dspr2)(CblasRowMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A ); chkxer(); } else if (strncmp( sf,"cblas_dsyr",10)==0) { cblas_rout = "cblas_dsyr"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_dsyr(INVALID, CblasUpper, 0, ALPHA, X, 1, A, 1 ); + API_SUFFIX(cblas_dsyr)(INVALID_LAYOUT, CblasUpper, 0, ALPHA, X, 1, A, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_dsyr(CblasColMajor, INVALID, 0, ALPHA, X, 1, A, 1 ); + API_SUFFIX(cblas_dsyr)(CblasColMajor, INVALID_UPLO, 0, ALPHA, X, 1, A, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_dsyr(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, A, 1 ); + API_SUFFIX(cblas_dsyr)(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, A, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_dsyr(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, A, 1 ); + API_SUFFIX(cblas_dsyr)(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, A, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_dsyr(CblasColMajor, CblasUpper, 2, ALPHA, X, 1, A, 1 ); + API_SUFFIX(cblas_dsyr)(CblasColMajor, CblasUpper, 2, ALPHA, X, 1, A, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_dsyr(CblasRowMajor, INVALID, 0, ALPHA, X, 1, A, 1 ); + API_SUFFIX(cblas_dsyr)(CblasRowMajor, INVALID_UPLO, 0, ALPHA, X, 1, A, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_dsyr(CblasRowMajor, CblasUpper, INVALID, ALPHA, X, 1, A, 1 ); + API_SUFFIX(cblas_dsyr)(CblasRowMajor, CblasUpper, INVALID, ALPHA, X, 1, A, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_dsyr(CblasRowMajor, CblasUpper, 0, ALPHA, X, 0, A, 1 ); + API_SUFFIX(cblas_dsyr)(CblasRowMajor, CblasUpper, 0, ALPHA, X, 0, A, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_dsyr(CblasRowMajor, CblasUpper, 2, ALPHA, X, 1, A, 1 ); + API_SUFFIX(cblas_dsyr)(CblasRowMajor, CblasUpper, 2, ALPHA, X, 1, A, 1 ); chkxer(); } else if (strncmp( sf,"cblas_dspr",10)==0) { cblas_rout = "cblas_dspr"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_dspr(INVALID, CblasUpper, 0, ALPHA, X, 1, A ); + API_SUFFIX(cblas_dspr)(INVALID_LAYOUT, CblasUpper, 0, ALPHA, X, 1, A ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_dspr(CblasColMajor, INVALID, 0, ALPHA, X, 1, A ); + API_SUFFIX(cblas_dspr)(CblasColMajor, INVALID_UPLO, 0, ALPHA, X, 1, A ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_dspr(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, A ); + API_SUFFIX(cblas_dspr)(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, A ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_dspr(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, A ); + API_SUFFIX(cblas_dspr)(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, A ); chkxer(); - cblas_info = 2; RowMajorStrg = FALSE; - cblas_dspr(CblasColMajor, INVALID, 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; - 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; - 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) - printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout); + printf(" %-16s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout); else printf("******* %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout); + printf(" %-16s ERROR-EXIT TESTS:%9d RUN,%9d FAILED\n", + cblas_rout, (int) cblas_xtests, (int) cblas_xfails); } diff --git a/CBLAS/testing/c_d3chke.c b/CBLAS/testing/c_d3chke.c index e41901e79c..441cd7813d 100644 --- a/CBLAS/testing/c_d3chke.c +++ b/CBLAS/testing/c_d3chke.c @@ -3,447 +3,946 @@ #include "cblas.h" #include "cblas_test.h" -int cblas_ok, cblas_lerr, cblas_info; -int link_xerbla=TRUE; +CBLAS_INT cblas_ok, cblas_lerr, cblas_info; +CBLAS_INT link_xerbla=TRUE; +CBLAS_INT cblas_xtests, cblas_xfails, cblas_xbad; char *cblas_rout; #ifdef F77_Char -void F77_xerbla(F77_Char F77_srname, void *vinfo); +void F77_xerbla(F77_Char F77_srname, void *vinfo #else -void F77_xerbla(char *srname, void *vinfo); +void F77_xerbla(char *srname, void *vinfo #endif +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN srname_len +#endif +); void chkxer(void) { - extern int cblas_ok, cblas_lerr, cblas_info; - extern int link_xerbla; + extern CBLAS_INT cblas_ok, cblas_lerr, cblas_info; + extern CBLAS_INT link_xerbla; + extern CBLAS_INT cblas_xtests, cblas_xfails, cblas_xbad; extern char *cblas_rout; + cblas_xtests++; if (cblas_lerr == 1 ) { - printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", 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) { + cblas_xfails++; } + cblas_xbad = 0; cblas_lerr = 1 ; } -void F77_d3chke(char *rout) { +void F77_d3chke(char *rout +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN rout_len +#endif +) { char *sf = ( rout ) ; double A[2] = {0.0,0.0}, B[2] = {0.0,0.0}, C[2] = {0.0,0.0}, ALPHA=0.0, BETA=0.0; - extern int cblas_info, cblas_lerr, cblas_ok; - extern int RowMajorStrg; + extern CBLAS_INT cblas_info, cblas_lerr, cblas_ok; extern char *cblas_rout; +#ifndef HAS_ATTRIBUTE_WEAK_SUPPORT + #ifdef CBLAS_DLL_IMPORTS + // Since Windows does not support weak symbols, and the trick below doesn't + // work for shared libraries on Windows, we skip the xerbla tests here. + printf("***** WARNING: Skipping xerbla tests since weak symbols are not supported on Windows *****\n"); + return; + #endif + if (link_xerbla) /* call these first to link */ { - cblas_xerbla(cblas_info,cblas_rout,""); - F77_xerbla(cblas_rout,&cblas_info); + API_SUFFIX(cblas_xerbla)(cblas_info,cblas_rout,""); + F77_xerbla(cblas_rout,&cblas_info, 1); } +#endif + link_xerbla = 0; cblas_ok = TRUE ; cblas_lerr = PASSED ; + cblas_xtests = 0; + cblas_xfails = 0; + cblas_xbad = 0; + + if (strncmp( sf,"cblas_dgemmtr" ,13)==0) { + cblas_rout = "cblas_dgemmtr" ; + + cblas_info = 1; + API_SUFFIX(cblas_dgemmtr)( INVALID_LAYOUT, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + API_SUFFIX(cblas_dgemmtr)( INVALID_LAYOUT, CblasUpper, CblasNoTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + API_SUFFIX(cblas_dgemmtr)( INVALID_LAYOUT, CblasUpper,CblasTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + API_SUFFIX(cblas_dgemmtr)( INVALID_LAYOUT, CblasUpper, CblasTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 1; + API_SUFFIX(cblas_dgemmtr)( INVALID_LAYOUT, CblasLower, CblasNoTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + API_SUFFIX(cblas_dgemmtr)( INVALID_LAYOUT, CblasLower, CblasNoTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + API_SUFFIX(cblas_dgemmtr)( INVALID_LAYOUT, CblasLower,CblasTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + API_SUFFIX(cblas_dgemmtr)( INVALID_LAYOUT, CblasLower, CblasTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 2; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dgemmtr)( CblasColMajor, INVALID_UPLO, CblasNoTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dgemmtr)( CblasColMajor, INVALID_UPLO, CblasNoTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 3; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dgemmtr)( CblasColMajor, CblasUpper, INVALID_TRANSPOSE, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dgemmtr)( CblasColMajor, CblasUpper, INVALID_TRANSPOSE, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 4; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, INVALID_TRANSPOSE, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dgemmtr)( CblasColMajor, CblasUpper, CblasTrans, INVALID_TRANSPOSE, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + + cblas_info = 5; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 6; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + + cblas_info = 9; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2, + ALPHA, A, 1, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 9; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 11; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 14; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + + cblas_info = 14; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + 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 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); - if (strncmp( sf,"cblas_dgemm" ,11)==0) { + cblas_info = 6; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 9; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, 2, + ALPHA, A, 1, B, 2, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0, + ALPHA, A, 1, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 11; RowMajorStrg = TRUE; + 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)( 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)( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 14; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + + } else if (strncmp( sf,"cblas_dgemm" ,11)==0) { cblas_rout = "cblas_dgemm" ; cblas_info = 1; - cblas_dgemm( INVALID, CblasNoTrans, CblasNoTrans, 0, 0, 0, + API_SUFFIX(cblas_dgemm)( INVALID_LAYOUT, CblasNoTrans, CblasNoTrans, 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 1; - cblas_dgemm( INVALID, CblasNoTrans, CblasTrans, 0, 0, 0, + API_SUFFIX(cblas_dgemm)( INVALID_LAYOUT, CblasNoTrans, CblasTrans, 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 1; - cblas_dgemm( INVALID, CblasTrans, CblasNoTrans, 0, 0, 0, + API_SUFFIX(cblas_dgemm)( INVALID_LAYOUT, CblasTrans, CblasNoTrans, 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 1; - cblas_dgemm( INVALID, CblasTrans, CblasTrans, 0, 0, 0, + API_SUFFIX(cblas_dgemm)( INVALID_LAYOUT, CblasTrans, CblasTrans, 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_dgemm( CblasColMajor, INVALID, CblasNoTrans, 0, 0, 0, + API_SUFFIX(cblas_dgemm)( CblasColMajor, INVALID_TRANSPOSE, CblasNoTrans, 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_dgemm( CblasColMajor, INVALID, CblasTrans, 0, 0, 0, + API_SUFFIX(cblas_dgemm)( CblasColMajor, INVALID_TRANSPOSE, CblasTrans, 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_dgemm( CblasColMajor, CblasNoTrans, INVALID, 0, 0, 0, + API_SUFFIX(cblas_dgemm)( CblasColMajor, CblasNoTrans, INVALID_TRANSPOSE, 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_dgemm( CblasColMajor, CblasTrans, INVALID, 0, 0, 0, + API_SUFFIX(cblas_dgemm)( CblasColMajor, CblasTrans, INVALID_TRANSPOSE, 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_dgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, INVALID, 0, 0, + API_SUFFIX(cblas_dgemm)( CblasColMajor, CblasNoTrans, CblasNoTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_dgemm( CblasColMajor, CblasNoTrans, CblasTrans, INVALID, 0, 0, + API_SUFFIX(cblas_dgemm)( CblasColMajor, CblasNoTrans, CblasTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_dgemm( CblasColMajor, CblasTrans, CblasNoTrans, INVALID, 0, 0, + API_SUFFIX(cblas_dgemm)( CblasColMajor, CblasTrans, CblasNoTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_dgemm( CblasColMajor, CblasTrans, CblasTrans, INVALID, 0, 0, + API_SUFFIX(cblas_dgemm)( CblasColMajor, CblasTrans, CblasTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_dgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, 0, INVALID, 0, + API_SUFFIX(cblas_dgemm)( CblasColMajor, CblasNoTrans, CblasNoTrans, 0, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_dgemm( CblasColMajor, CblasNoTrans, CblasTrans, 0, INVALID, 0, + API_SUFFIX(cblas_dgemm)( CblasColMajor, CblasNoTrans, CblasTrans, 0, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_dgemm( CblasColMajor, CblasTrans, CblasNoTrans, 0, INVALID, 0, + API_SUFFIX(cblas_dgemm)( CblasColMajor, CblasTrans, CblasNoTrans, 0, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_dgemm( CblasColMajor, CblasTrans, CblasTrans, 0, INVALID, 0, + API_SUFFIX(cblas_dgemm)( CblasColMajor, CblasTrans, CblasTrans, 0, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_dgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, 0, 0, INVALID, + API_SUFFIX(cblas_dgemm)( CblasColMajor, CblasNoTrans, CblasNoTrans, 0, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_dgemm( CblasColMajor, CblasNoTrans, CblasTrans, 0, 0, INVALID, + API_SUFFIX(cblas_dgemm)( CblasColMajor, CblasNoTrans, CblasTrans, 0, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_dgemm( CblasColMajor, CblasTrans, CblasNoTrans, 0, 0, INVALID, + API_SUFFIX(cblas_dgemm)( CblasColMajor, CblasTrans, CblasNoTrans, 0, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_dgemm( CblasColMajor, CblasTrans, CblasTrans, 0, 0, INVALID, + API_SUFFIX(cblas_dgemm)( CblasColMajor, CblasTrans, CblasTrans, 0, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_dgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, 2, 0, 0, + API_SUFFIX(cblas_dgemm)( CblasColMajor, CblasNoTrans, CblasNoTrans, 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_dgemm( CblasColMajor, CblasNoTrans, CblasTrans, 2, 0, 0, + API_SUFFIX(cblas_dgemm)( CblasColMajor, CblasNoTrans, CblasTrans, 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_dgemm( CblasColMajor, CblasTrans, CblasNoTrans, 0, 0, 2, + API_SUFFIX(cblas_dgemm)( CblasColMajor, CblasTrans, CblasNoTrans, 0, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_dgemm( CblasColMajor, CblasTrans, CblasTrans, 0, 0, 2, + API_SUFFIX(cblas_dgemm)( CblasColMajor, CblasTrans, CblasTrans, 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_dgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, 0, 0, 2, + API_SUFFIX(cblas_dgemm)( CblasColMajor, CblasNoTrans, CblasNoTrans, 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_dgemm( CblasColMajor, CblasTrans, CblasNoTrans, 0, 0, 2, + API_SUFFIX(cblas_dgemm)( CblasColMajor, CblasTrans, CblasNoTrans, 0, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_dgemm( CblasColMajor, CblasNoTrans, CblasTrans, 0, 2, 0, + API_SUFFIX(cblas_dgemm)( CblasColMajor, CblasNoTrans, CblasTrans, 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_dgemm( CblasColMajor, CblasTrans, CblasTrans, 0, 2, 0, + API_SUFFIX(cblas_dgemm)( CblasColMajor, CblasTrans, CblasTrans, 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = FALSE; - cblas_dgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, 2, 0, 0, + API_SUFFIX(cblas_dgemm)( CblasColMajor, CblasNoTrans, CblasNoTrans, 2, 0, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = FALSE; - cblas_dgemm( CblasColMajor, CblasNoTrans, CblasTrans, 2, 0, 0, + API_SUFFIX(cblas_dgemm)( CblasColMajor, CblasNoTrans, CblasTrans, 2, 0, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = FALSE; - cblas_dgemm( CblasColMajor, CblasTrans, CblasNoTrans, 2, 0, 0, + API_SUFFIX(cblas_dgemm)( CblasColMajor, CblasTrans, CblasNoTrans, 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = FALSE; - cblas_dgemm( CblasColMajor, CblasTrans, CblasTrans, 2, 0, 0, + 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; - cblas_dgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, INVALID, 0, 0, + API_SUFFIX(cblas_dgemm)( CblasRowMajor, CblasNoTrans, CblasNoTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_dgemm( CblasRowMajor, CblasNoTrans, CblasTrans, INVALID, 0, 0, + API_SUFFIX(cblas_dgemm)( CblasRowMajor, CblasNoTrans, CblasTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_dgemm( CblasRowMajor, CblasTrans, CblasNoTrans, INVALID, 0, 0, + API_SUFFIX(cblas_dgemm)( CblasRowMajor, CblasTrans, CblasNoTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_dgemm( CblasRowMajor, CblasTrans, CblasTrans, INVALID, 0, 0, + API_SUFFIX(cblas_dgemm)( CblasRowMajor, CblasTrans, CblasTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_dgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, INVALID, 0, + API_SUFFIX(cblas_dgemm)( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_dgemm( CblasRowMajor, CblasNoTrans, CblasTrans, 0, INVALID, 0, + API_SUFFIX(cblas_dgemm)( CblasRowMajor, CblasNoTrans, CblasTrans, 0, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_dgemm( CblasRowMajor, CblasTrans, CblasNoTrans, 0, INVALID, 0, + API_SUFFIX(cblas_dgemm)( CblasRowMajor, CblasTrans, CblasNoTrans, 0, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_dgemm( CblasRowMajor, CblasTrans, CblasTrans, 0, INVALID, 0, + API_SUFFIX(cblas_dgemm)( CblasRowMajor, CblasTrans, CblasTrans, 0, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemm)( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemm)( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_dgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 0, INVALID, + API_SUFFIX(cblas_dgemm)( CblasRowMajor, CblasTrans, CblasNoTrans, 0, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_dgemm( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 0, INVALID, + API_SUFFIX(cblas_dgemm)( CblasRowMajor, CblasTrans, CblasTrans, 0, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemm)( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemm)( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 0, 2, + ALPHA, A, 1, B, 2, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemm)( CblasRowMajor, CblasTrans, CblasNoTrans, 2, 0, 0, + ALPHA, A, 1, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemm)( CblasRowMajor, CblasTrans, CblasTrans, 2, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemm)( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemm)( CblasRowMajor, CblasTrans, CblasNoTrans, 0, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemm)( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 0, 2, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemm)( CblasRowMajor, CblasTrans, CblasTrans, 0, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemm)( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 2, 0, + ALPHA, A, 1, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemm)( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemm)( CblasRowMajor, CblasTrans, CblasNoTrans, 0, 2, 0, + ALPHA, A, 1, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemm)( CblasRowMajor, CblasTrans, CblasTrans, 0, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + } else if (strncmp( sf,"cblas_dsymm" ,11)==0) { + cblas_rout = "cblas_dsymm" ; + + cblas_info = 1; + API_SUFFIX(cblas_dsymm)( INVALID_LAYOUT, CblasRight, CblasLower, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsymm)( CblasColMajor, INVALID_SIDE, CblasUpper, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsymm)( CblasColMajor, CblasLeft, INVALID_UPLO, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsymm)( CblasColMajor, CblasLeft, CblasUpper, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsymm)( CblasColMajor, CblasRight, CblasUpper, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsymm)( CblasColMajor, CblasLeft, CblasLower, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsymm)( CblasColMajor, CblasRight, CblasLower, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsymm)( CblasColMajor, CblasLeft, CblasUpper, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsymm)( CblasColMajor, CblasRight, CblasUpper, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsymm)( CblasColMajor, CblasLeft, CblasLower, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsymm)( CblasColMajor, CblasRight, CblasLower, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 8; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsymm)( CblasColMajor, CblasLeft, CblasUpper, 2, 0, + ALPHA, A, 1, B, 2, BETA, C, 2 ); + chkxer(); + cblas_info = 8; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsymm)( CblasColMajor, CblasRight, CblasUpper, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 8; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsymm)( CblasColMajor, CblasLeft, CblasLower, 2, 0, + ALPHA, A, 1, B, 2, BETA, C, 2 ); + chkxer(); + cblas_info = 8; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsymm)( CblasColMajor, CblasRight, CblasLower, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 10; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsymm)( CblasColMajor, CblasLeft, CblasUpper, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 10; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsymm)( CblasColMajor, CblasRight, CblasUpper, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 10; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsymm)( CblasColMajor, CblasLeft, CblasLower, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 10; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsymm)( CblasColMajor, CblasRight, CblasLower, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 13; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsymm)( CblasColMajor, CblasLeft, CblasUpper, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 13; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsymm)( CblasColMajor, CblasRight, CblasUpper, 2, 0, + ALPHA, A, 1, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 13; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsymm)( CblasColMajor, CblasLeft, CblasLower, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 13; RowMajorStrg = FALSE; + 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 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsymm)( CblasRowMajor, CblasRight, CblasUpper, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsymm)( CblasRowMajor, CblasLeft, CblasLower, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsymm)( CblasRowMajor, CblasRight, CblasLower, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsymm)( CblasRowMajor, CblasLeft, CblasUpper, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsymm)( CblasRowMajor, CblasRight, CblasUpper, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); - cblas_info = 6; RowMajorStrg = TRUE; - cblas_dgemm( CblasRowMajor, CblasTrans, CblasNoTrans, 0, 0, INVALID, + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsymm)( CblasRowMajor, CblasLeft, CblasLower, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); - cblas_info = 6; RowMajorStrg = TRUE; - cblas_dgemm( CblasRowMajor, CblasTrans, CblasTrans, 0, 0, INVALID, + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsymm)( CblasRowMajor, CblasRight, CblasLower, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); - cblas_info = 9; RowMajorStrg = TRUE; - cblas_dgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 0, 2, - ALPHA, A, 1, B, 1, BETA, C, 2 ); - chkxer(); - cblas_info = 9; RowMajorStrg = TRUE; - cblas_dgemm( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 0, 2, + cblas_info = 8; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsymm)( CblasRowMajor, CblasLeft, CblasUpper, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); - cblas_info = 9; RowMajorStrg = TRUE; - cblas_dgemm( CblasRowMajor, CblasTrans, CblasNoTrans, 2, 0, 0, - ALPHA, A, 1, B, 2, BETA, C, 1 ); - chkxer(); - cblas_info = 9; RowMajorStrg = TRUE; - cblas_dgemm( CblasRowMajor, CblasTrans, CblasTrans, 2, 0, 0, + cblas_info = 8; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsymm)( CblasRowMajor, CblasRight, CblasUpper, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); - cblas_info = 11; RowMajorStrg = TRUE; - cblas_dgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 2, 0, + cblas_info = 8; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsymm)( CblasRowMajor, CblasLeft, CblasLower, 2, 0, + ALPHA, A, 1, B, 2, BETA, C, 2 ); + chkxer(); + cblas_info = 8; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsymm)( CblasRowMajor, CblasRight, CblasLower, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); - cblas_info = 11; RowMajorStrg = TRUE; - cblas_dgemm( CblasRowMajor, CblasTrans, CblasNoTrans, 0, 2, 0, + cblas_info = 10; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsymm)( CblasRowMajor, CblasLeft, CblasUpper, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); - cblas_info = 11; RowMajorStrg = TRUE; - cblas_dgemm( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 0, 2, + cblas_info = 10; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsymm)( CblasRowMajor, CblasRight, CblasUpper, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); - cblas_info = 11; RowMajorStrg = TRUE; - cblas_dgemm( CblasRowMajor, CblasTrans, CblasTrans, 0, 0, 2, - ALPHA, A, 1, B, 1, BETA, C, 1 ); + cblas_info = 10; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsymm)( CblasRowMajor, CblasLeft, CblasLower, 0, 2, + ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); - cblas_info = 14; RowMajorStrg = TRUE; - cblas_dgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 2, 0, + cblas_info = 10; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsymm)( CblasRowMajor, CblasRight, CblasLower, 0, 2, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 13; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsymm)( CblasRowMajor, CblasLeft, CblasUpper, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); - cblas_info = 14; RowMajorStrg = TRUE; - cblas_dgemm( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 2, 0, - ALPHA, A, 1, B, 1, BETA, C, 1 ); + cblas_info = 13; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsymm)( CblasRowMajor, CblasRight, CblasUpper, 0, 2, + ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); - cblas_info = 14; RowMajorStrg = TRUE; - cblas_dgemm( CblasRowMajor, CblasTrans, CblasNoTrans, 0, 2, 0, + cblas_info = 13; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsymm)( CblasRowMajor, CblasLeft, CblasLower, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); - cblas_info = 14; RowMajorStrg = TRUE; - cblas_dgemm( CblasRowMajor, CblasTrans, CblasTrans, 0, 2, 0, - ALPHA, A, 1, B, 1, BETA, C, 1 ); + cblas_info = 13; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsymm)( CblasRowMajor, CblasRight, CblasLower, 0, 2, + ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); - } else if (strncmp( sf,"cblas_dsymm" ,11)==0) { - cblas_rout = "cblas_dsymm" ; + } else if (strncmp( sf,"cblas_dskewsymm" ,15)==0) { + cblas_rout = "cblas_dskewsymm" ; cblas_info = 1; - cblas_dsymm( INVALID, CblasRight, CblasLower, 0, 0, + API_SUFFIX(cblas_dskewsymm)( INVALID_LAYOUT, CblasRight, CblasLower, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_dsymm( CblasColMajor, INVALID, CblasUpper, 0, 0, + API_SUFFIX(cblas_dskewsymm)( CblasColMajor, INVALID_SIDE, CblasUpper, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_dsymm( CblasColMajor, CblasLeft, INVALID, 0, 0, + API_SUFFIX(cblas_dskewsymm)( CblasColMajor, CblasLeft, INVALID_UPLO, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_dsymm( CblasColMajor, CblasLeft, CblasUpper, INVALID, 0, + API_SUFFIX(cblas_dskewsymm)( CblasColMajor, CblasLeft, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_dsymm( CblasColMajor, CblasRight, CblasUpper, INVALID, 0, + API_SUFFIX(cblas_dskewsymm)( CblasColMajor, CblasRight, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_dsymm( CblasColMajor, CblasLeft, CblasLower, INVALID, 0, + API_SUFFIX(cblas_dskewsymm)( CblasColMajor, CblasLeft, CblasLower, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_dsymm( CblasColMajor, CblasRight, CblasLower, INVALID, 0, + API_SUFFIX(cblas_dskewsymm)( CblasColMajor, CblasRight, CblasLower, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_dsymm( CblasColMajor, CblasLeft, CblasUpper, 0, INVALID, + API_SUFFIX(cblas_dskewsymm)( CblasColMajor, CblasLeft, CblasUpper, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_dsymm( CblasColMajor, CblasRight, CblasUpper, 0, INVALID, + API_SUFFIX(cblas_dskewsymm)( CblasColMajor, CblasRight, CblasUpper, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_dsymm( CblasColMajor, CblasLeft, CblasLower, 0, INVALID, + API_SUFFIX(cblas_dskewsymm)( CblasColMajor, CblasLeft, CblasLower, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_dsymm( CblasColMajor, CblasRight, CblasLower, 0, INVALID, + API_SUFFIX(cblas_dskewsymm)( CblasColMajor, CblasRight, CblasLower, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_dsymm( CblasColMajor, CblasLeft, CblasUpper, 2, 0, + API_SUFFIX(cblas_dskewsymm)( CblasColMajor, CblasLeft, CblasUpper, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_dsymm( CblasColMajor, CblasRight, CblasUpper, 0, 2, + API_SUFFIX(cblas_dskewsymm)( CblasColMajor, CblasRight, CblasUpper, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_dsymm( CblasColMajor, CblasLeft, CblasLower, 2, 0, + API_SUFFIX(cblas_dskewsymm)( CblasColMajor, CblasLeft, CblasLower, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_dsymm( CblasColMajor, CblasRight, CblasLower, 0, 2, + API_SUFFIX(cblas_dskewsymm)( CblasColMajor, CblasRight, CblasLower, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_dsymm( CblasColMajor, CblasLeft, CblasUpper, 2, 0, + API_SUFFIX(cblas_dskewsymm)( CblasColMajor, CblasLeft, CblasUpper, 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_dsymm( CblasColMajor, CblasRight, CblasUpper, 2, 0, + API_SUFFIX(cblas_dskewsymm)( CblasColMajor, CblasRight, CblasUpper, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_dsymm( CblasColMajor, CblasLeft, CblasLower, 2, 0, + API_SUFFIX(cblas_dskewsymm)( CblasColMajor, CblasLeft, CblasLower, 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_dsymm( CblasColMajor, CblasRight, CblasLower, 2, 0, + API_SUFFIX(cblas_dskewsymm)( CblasColMajor, CblasRight, CblasLower, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_dsymm( CblasColMajor, CblasLeft, CblasUpper, 2, 0, + API_SUFFIX(cblas_dskewsymm)( CblasColMajor, CblasLeft, CblasUpper, 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_dsymm( CblasColMajor, CblasRight, CblasUpper, 2, 0, + API_SUFFIX(cblas_dskewsymm)( CblasColMajor, CblasRight, CblasUpper, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_dsymm( CblasColMajor, CblasLeft, CblasLower, 2, 0, + API_SUFFIX(cblas_dskewsymm)( CblasColMajor, CblasLeft, CblasLower, 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_dsymm( CblasColMajor, CblasRight, CblasLower, 2, 0, + 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; - cblas_dsymm( CblasRowMajor, CblasLeft, CblasUpper, INVALID, 0, + API_SUFFIX(cblas_dskewsymm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_dsymm( CblasRowMajor, CblasRight, CblasUpper, INVALID, 0, + API_SUFFIX(cblas_dskewsymm)( CblasRowMajor, CblasRight, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_dsymm( CblasRowMajor, CblasLeft, CblasLower, INVALID, 0, + API_SUFFIX(cblas_dskewsymm)( CblasRowMajor, CblasLeft, CblasLower, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_dsymm( CblasRowMajor, CblasRight, CblasLower, INVALID, 0, + API_SUFFIX(cblas_dskewsymm)( CblasRowMajor, CblasRight, CblasLower, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_dsymm( CblasRowMajor, CblasLeft, CblasUpper, 0, INVALID, + API_SUFFIX(cblas_dskewsymm)( CblasRowMajor, CblasLeft, CblasUpper, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_dsymm( CblasRowMajor, CblasRight, CblasUpper, 0, INVALID, + API_SUFFIX(cblas_dskewsymm)( CblasRowMajor, CblasRight, CblasUpper, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_dsymm( CblasRowMajor, CblasLeft, CblasLower, 0, INVALID, + API_SUFFIX(cblas_dskewsymm)( CblasRowMajor, CblasLeft, CblasLower, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_dsymm( CblasRowMajor, CblasRight, CblasLower, 0, INVALID, + API_SUFFIX(cblas_dskewsymm)( CblasRowMajor, CblasRight, CblasLower, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_dsymm( CblasRowMajor, CblasLeft, CblasUpper, 2, 0, + API_SUFFIX(cblas_dskewsymm)( CblasRowMajor, CblasLeft, CblasUpper, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_dsymm( CblasRowMajor, CblasRight, CblasUpper, 0, 2, + API_SUFFIX(cblas_dskewsymm)( CblasRowMajor, CblasRight, CblasUpper, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_dsymm( CblasRowMajor, CblasLeft, CblasLower, 2, 0, + API_SUFFIX(cblas_dskewsymm)( CblasRowMajor, CblasLeft, CblasLower, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_dsymm( CblasRowMajor, CblasRight, CblasLower, 0, 2, + API_SUFFIX(cblas_dskewsymm)( CblasRowMajor, CblasRight, CblasLower, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_dsymm( CblasRowMajor, CblasLeft, CblasUpper, 0, 2, + API_SUFFIX(cblas_dskewsymm)( CblasRowMajor, CblasLeft, CblasUpper, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_dsymm( CblasRowMajor, CblasRight, CblasUpper, 0, 2, + API_SUFFIX(cblas_dskewsymm)( CblasRowMajor, CblasRight, CblasUpper, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_dsymm( CblasRowMajor, CblasLeft, CblasLower, 0, 2, + API_SUFFIX(cblas_dskewsymm)( CblasRowMajor, CblasLeft, CblasLower, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_dsymm( CblasRowMajor, CblasRight, CblasLower, 0, 2, + API_SUFFIX(cblas_dskewsymm)( CblasRowMajor, CblasRight, CblasLower, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_dsymm( CblasRowMajor, CblasLeft, CblasUpper, 0, 2, + API_SUFFIX(cblas_dskewsymm)( CblasRowMajor, CblasLeft, CblasUpper, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_dsymm( CblasRowMajor, CblasRight, CblasUpper, 0, 2, + API_SUFFIX(cblas_dskewsymm)( CblasRowMajor, CblasRight, CblasUpper, 0, 2, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_dsymm( CblasRowMajor, CblasLeft, CblasLower, 0, 2, + API_SUFFIX(cblas_dskewsymm)( CblasRowMajor, CblasLeft, CblasLower, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_dsymm( CblasRowMajor, CblasRight, CblasLower, 0, 2, + API_SUFFIX(cblas_dskewsymm)( CblasRowMajor, CblasRight, CblasLower, 0, 2, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); @@ -451,279 +950,296 @@ void F77_d3chke(char *rout) { cblas_rout = "cblas_dtrmm" ; cblas_info = 1; - cblas_dtrmm( INVALID, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( INVALID_LAYOUT, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, INVALID_SIDE, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasLeft, INVALID, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasLeft, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasLeft, CblasUpper, INVALID, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasLeft, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, - INVALID, 0, 0, ALPHA, A, 1, B, 1 ); + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_dtrmm( CblasColMajor, CblasRight, CblasLower, CblasTrans, + 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; - cblas_dtrmm( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_dtrmm( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_dtrmm( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_dtrmm( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_dtrmm( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_dtrmm( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_dtrmm( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_dtrmm( CblasRowMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_dtrmm( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_dtrmm( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_dtrmm( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_dtrmm( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_dtrmm( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_dtrmm( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_dtrmm( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_dtrmm( CblasRowMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_dtrmm( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_dtrmm( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_dtrmm( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_dtrmm( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_dtrmm( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_dtrmm( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_dtrmm( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_dtrmm( CblasRowMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_dtrmm( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_dtrmm( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_dtrmm( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_dtrmm( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_dtrmm( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_dtrmm( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_dtrmm( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_dtrmm( CblasRowMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 2, B, 1 ); chkxer(); @@ -731,280 +1247,297 @@ void F77_d3chke(char *rout) { cblas_rout = "cblas_dtrsm" ; cblas_info = 1; - cblas_dtrsm( INVALID, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( INVALID_LAYOUT, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, INVALID_SIDE, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasLeft, INVALID, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasLeft, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasLeft, CblasUpper, INVALID, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasLeft, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, - INVALID, 0, 0, ALPHA, A, 1, B, 1 ); + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_dtrsm( CblasColMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_dtrsm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, 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; - cblas_dtrsm( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_dtrsm( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_dtrsm( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_dtrsm( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_dtrsm( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_dtrsm( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_dtrsm( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_dtrsm( CblasRowMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_dtrsm( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_dtrsm( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_dtrsm( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_dtrsm( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_dtrsm( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_dtrsm( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_dtrsm( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_dtrsm( CblasRowMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_dtrsm( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_dtrsm( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_dtrsm( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_dtrsm( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_dtrsm( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_dtrsm( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_dtrsm( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_dtrsm( CblasRowMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_dtrsm( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_dtrsm( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_dtrsm( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_dtrsm( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_dtrsm( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_dtrsm( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_dtrsm( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_dtrsm( CblasRowMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 2, B, 1 ); chkxer(); @@ -1012,111 +1545,152 @@ void F77_d3chke(char *rout) { cblas_rout = "cblas_dsyrk" ; cblas_info = 1; - cblas_dsyrk( INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dsyrk)( INVALID_LAYOUT, CblasUpper, CblasNoTrans, 0, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_dsyrk( CblasColMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_dsyrk)( CblasColMajor, INVALID_UPLO, CblasNoTrans, 0, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_dsyrk( CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_dsyrk)( CblasColMajor, CblasUpper, INVALID_TRANSPOSE, 0, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_dsyrk( CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dsyrk)( CblasColMajor, CblasUpper, CblasNoTrans, INVALID, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_dsyrk( CblasColMajor, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dsyrk)( CblasColMajor, CblasUpper, CblasTrans, INVALID, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_dsyrk( CblasColMajor, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dsyrk)( CblasColMajor, CblasLower, CblasNoTrans, INVALID, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_dsyrk( CblasColMajor, CblasLower, CblasTrans, + API_SUFFIX(cblas_dsyrk)( CblasColMajor, CblasLower, CblasTrans, INVALID, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_dsyrk( CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dsyrk)( CblasColMajor, CblasUpper, CblasNoTrans, 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_dsyrk( CblasColMajor, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dsyrk)( CblasColMajor, CblasUpper, CblasTrans, 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_dsyrk( CblasColMajor, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dsyrk)( CblasColMajor, CblasLower, CblasNoTrans, 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_dsyrk( CblasColMajor, CblasLower, CblasTrans, + 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; - cblas_dsyrk( CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dsyrk)( CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_dsyrk( CblasRowMajor, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dsyrk)( CblasRowMajor, CblasUpper, CblasTrans, 2, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_dsyrk( CblasRowMajor, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dsyrk)( CblasRowMajor, CblasLower, CblasNoTrans, 0, 2, ALPHA, A, 1, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_dsyrk( CblasRowMajor, CblasLower, CblasTrans, + API_SUFFIX(cblas_dsyrk)( CblasRowMajor, CblasLower, CblasTrans, 2, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_dsyrk( CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dsyrk)( CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 1, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_dsyrk( CblasColMajor, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dsyrk)( CblasColMajor, CblasUpper, CblasTrans, 0, 2, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_dsyrk( CblasColMajor, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dsyrk)( CblasColMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 1, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_dsyrk( CblasColMajor, CblasLower, CblasTrans, + API_SUFFIX(cblas_dsyrk)( CblasColMajor, CblasLower, CblasTrans, 0, 2, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_dsyrk( CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dsyrk)( CblasRowMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_dsyrk( CblasRowMajor, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dsyrk)( CblasRowMajor, CblasUpper, CblasTrans, 2, 0, ALPHA, A, 2, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_dsyrk( CblasRowMajor, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dsyrk)( CblasRowMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_dsyrk( CblasRowMajor, CblasLower, CblasTrans, + API_SUFFIX(cblas_dsyrk)( CblasRowMajor, CblasLower, CblasTrans, 2, 0, ALPHA, A, 2, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_dsyrk( CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dsyrk)( CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 2, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_dsyrk( CblasColMajor, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dsyrk)( CblasColMajor, CblasUpper, CblasTrans, 2, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_dsyrk( CblasColMajor, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dsyrk)( CblasColMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 2, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_dsyrk( CblasColMajor, CblasLower, CblasTrans, + API_SUFFIX(cblas_dsyrk)( CblasColMajor, CblasLower, CblasTrans, 2, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); @@ -1124,148 +1698,375 @@ void F77_d3chke(char *rout) { cblas_rout = "cblas_dsyr2k" ; cblas_info = 1; - cblas_dsyr2k( INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dsyr2k)( INVALID_LAYOUT, CblasUpper, CblasNoTrans, + 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsyr2k)( CblasColMajor, INVALID_UPLO, CblasNoTrans, + 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsyr2k)( CblasColMajor, CblasUpper, INVALID_TRANSPOSE, + 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsyr2k)( CblasColMajor, CblasUpper, CblasNoTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsyr2k)( CblasColMajor, CblasUpper, CblasTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsyr2k)( CblasColMajor, CblasLower, CblasNoTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsyr2k)( CblasColMajor, CblasLower, CblasTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsyr2k)( CblasColMajor, CblasUpper, CblasNoTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsyr2k)( CblasColMajor, CblasUpper, CblasTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsyr2k)( CblasColMajor, CblasLower, CblasNoTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + 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 ); + chkxer(); + cblas_info = 8; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, CblasUpper, CblasTrans, + 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 8; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, CblasLower, CblasNoTrans, + 0, 2, ALPHA, A, 1, B, 2, BETA, C, 2 ); + chkxer(); + cblas_info = 8; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, CblasLower, CblasTrans, + 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 8; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsyr2k)( CblasColMajor, CblasUpper, CblasNoTrans, + 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 8; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsyr2k)( CblasColMajor, CblasUpper, CblasTrans, + 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 8; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsyr2k)( CblasColMajor, CblasLower, CblasNoTrans, + 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 8; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsyr2k)( CblasColMajor, CblasLower, CblasTrans, + 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 10; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, + 0, 2, ALPHA, A, 2, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 10; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, CblasUpper, CblasTrans, + 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 10; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, CblasLower, CblasNoTrans, + 0, 2, ALPHA, A, 2, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 10; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, CblasLower, CblasTrans, + 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 10; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsyr2k)( CblasColMajor, CblasUpper, CblasNoTrans, + 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 10; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsyr2k)( CblasColMajor, CblasUpper, CblasTrans, + 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 10; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsyr2k)( CblasColMajor, CblasLower, CblasNoTrans, + 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 10; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsyr2k)( CblasColMajor, CblasLower, CblasTrans, + 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 13; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, + 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 13; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, CblasUpper, CblasTrans, + 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 13; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, CblasLower, CblasNoTrans, + 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 13; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, CblasLower, CblasTrans, + 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 13; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsyr2k)( CblasColMajor, CblasUpper, CblasNoTrans, + 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 13; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsyr2k)( CblasColMajor, CblasUpper, CblasTrans, + 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 13; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsyr2k)( CblasColMajor, CblasLower, CblasNoTrans, + 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 13; RowMajorStrg = FALSE; + API_SUFFIX(cblas_dsyr2k)( CblasColMajor, CblasLower, CblasTrans, + 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + } else if (strncmp( sf,"cblas_dskewsyr2k" ,16)==0) { + cblas_rout = "cblas_dskewsyr2k" ; + + cblas_info = 1; + API_SUFFIX(cblas_dskewsyr2k)( INVALID_LAYOUT, CblasUpper, CblasNoTrans, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_dsyr2k( CblasColMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_dskewsyr2k)( CblasColMajor, INVALID_UPLO, CblasNoTrans, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_dsyr2k( CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_dskewsyr2k)( CblasColMajor, CblasUpper, INVALID_TRANSPOSE, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_dsyr2k( CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dskewsyr2k)( CblasColMajor, CblasUpper, CblasNoTrans, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_dsyr2k( CblasColMajor, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dskewsyr2k)( CblasColMajor, CblasUpper, CblasTrans, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_dsyr2k( CblasColMajor, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dskewsyr2k)( CblasColMajor, CblasLower, CblasNoTrans, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_dsyr2k( CblasColMajor, CblasLower, CblasTrans, + API_SUFFIX(cblas_dskewsyr2k)( CblasColMajor, CblasLower, CblasTrans, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_dsyr2k( CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dskewsyr2k)( CblasColMajor, CblasUpper, CblasNoTrans, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_dsyr2k( CblasColMajor, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dskewsyr2k)( CblasColMajor, CblasUpper, CblasTrans, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_dsyr2k( CblasColMajor, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dskewsyr2k)( CblasColMajor, CblasLower, CblasNoTrans, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_dsyr2k( CblasColMajor, CblasLower, CblasTrans, + 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; - cblas_dsyr2k( CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_dsyr2k( CblasRowMajor, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, CblasUpper, CblasTrans, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_dsyr2k( CblasRowMajor, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, CblasLower, CblasNoTrans, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_dsyr2k( CblasRowMajor, CblasLower, CblasTrans, + API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, CblasLower, CblasTrans, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_dsyr2k( CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dskewsyr2k)( CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_dsyr2k( CblasColMajor, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dskewsyr2k)( CblasColMajor, CblasUpper, CblasTrans, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_dsyr2k( CblasColMajor, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dskewsyr2k)( CblasColMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_dsyr2k( CblasColMajor, CblasLower, CblasTrans, + API_SUFFIX(cblas_dskewsyr2k)( CblasColMajor, CblasLower, CblasTrans, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_dsyr2k( CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_dsyr2k( CblasRowMajor, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, CblasUpper, CblasTrans, 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_dsyr2k( CblasRowMajor, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, CblasLower, CblasNoTrans, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_dsyr2k( CblasRowMajor, CblasLower, CblasTrans, + API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, CblasLower, CblasTrans, 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_dsyr2k( CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dskewsyr2k)( CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_dsyr2k( CblasColMajor, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dskewsyr2k)( CblasColMajor, CblasUpper, CblasTrans, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_dsyr2k( CblasColMajor, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dskewsyr2k)( CblasColMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_dsyr2k( CblasColMajor, CblasLower, CblasTrans, + API_SUFFIX(cblas_dskewsyr2k)( CblasColMajor, CblasLower, CblasTrans, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_dsyr2k( CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_dsyr2k( CblasRowMajor, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, CblasUpper, CblasTrans, 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_dsyr2k( CblasRowMajor, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_dsyr2k( CblasRowMajor, CblasLower, CblasTrans, + API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, CblasLower, CblasTrans, 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_dsyr2k( CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_dskewsyr2k)( CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_dsyr2k( CblasColMajor, CblasUpper, CblasTrans, + API_SUFFIX(cblas_dskewsyr2k)( CblasColMajor, CblasUpper, CblasTrans, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_dsyr2k( CblasColMajor, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_dskewsyr2k)( CblasColMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_dsyr2k( CblasColMajor, CblasLower, CblasTrans, + API_SUFFIX(cblas_dskewsyr2k)( CblasColMajor, CblasLower, CblasTrans, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); } if (cblas_ok == TRUE ) - printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout); + printf(" %-17s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout); else printf("***** %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout); + printf(" %-17s ERROR-EXIT TESTS:%9d RUN,%9d FAILED\n", + cblas_rout, (int) cblas_xtests, (int) cblas_xfails); } diff --git a/CBLAS/testing/c_dblas1.c b/CBLAS/testing/c_dblas1.c index deb7851257..66b89fea8c 100644 --- a/CBLAS/testing/c_dblas1.c +++ b/CBLAS/testing/c_dblas1.c @@ -8,76 +8,74 @@ */ #include "cblas_test.h" #include "cblas.h" -double F77_dasum(const int *N, double *X, const int *incX) +double F77_dasum(const CBLAS_INT *N, double *X, const CBLAS_INT *incX) { - return cblas_dasum(*N, X, *incX); + return API_SUFFIX(cblas_dasum)(*N, X, *incX); } -void F77_daxpy(const int *N, const double *alpha, const double *X, - const int *incX, double *Y, const int *incY) +void F77_daxpy(const CBLAS_INT *N, const double *alpha, const double *X, + const CBLAS_INT *incX, double *Y, const CBLAS_INT *incY) { - cblas_daxpy(*N, *alpha, X, *incX, Y, *incY); + API_SUFFIX(cblas_daxpy)(*N, *alpha, X, *incX, Y, *incY); return; } -void F77_dcopy(const int *N, double *X, const int *incX, - double *Y, const int *incY) +void F77_daxpby(const CBLAS_INT *N, const double *alpha, const double *X, + const CBLAS_INT *incX, const double *beta, double *Y, const CBLAS_INT *incY) { - cblas_dcopy(*N, X, *incX, Y, *incY); + API_SUFFIX(cblas_daxpby)(*N, *alpha, X, *incX, *beta, Y, *incY); return; } -double F77_ddot(const int *N, const double *X, const int *incX, - const double *Y, const int *incY) -{ - return cblas_ddot(*N, X, *incX, Y, *incY); -} -double F77_dnrm2(const int *N, const double *X, const int *incX) +void F77_dcopy(const CBLAS_INT *N, double *X, const CBLAS_INT *incX, + double *Y, const CBLAS_INT *incY) { - return cblas_dnrm2(*N, X, *incX); + API_SUFFIX(cblas_dcopy)(*N, X, *incX, Y, *incY); + return; } -void F77_drotg( double *a, double *b, double *c, double *s) +double F77_ddot(const CBLAS_INT *N, const double *X, const CBLAS_INT *incX, + const double *Y, const CBLAS_INT *incY) { - cblas_drotg(a,b,c,s); - return; + return API_SUFFIX(cblas_ddot)(*N, X, *incX, Y, *incY); } -void F77_drot( const int *N, double *X, const int *incX, double *Y, - const int *incY, const double *c, const double *s) +double F77_dnrm2(const CBLAS_INT *N, const double *X, const CBLAS_INT *incX) { - - cblas_drot(*N,X,*incX,Y,*incY,*c,*s); - return; + return API_SUFFIX(cblas_dnrm2)(*N, X, *incX); } -void F77_dscal(const int *N, const double *alpha, double *X, - const int *incX) +void F77_drotg( double *a, double *b, double *c, double *s) { - cblas_dscal(*N, *alpha, X, *incX); + API_SUFFIX(cblas_drotg)(a,b,c,s); return; } -void F77_dswap( const int *N, double *X, const int *incX, - double *Y, const int *incY) +void F77_drot( const CBLAS_INT *N, double *X, const CBLAS_INT *incX, double *Y, + const CBLAS_INT *incY, const double *c, const double *s) { - cblas_dswap(*N,X,*incX,Y,*incY); + + API_SUFFIX(cblas_drot)(*N,X,*incX,Y,*incY,*c,*s); return; } -double F77_dzasum(const int *N, void *X, const int *incX) +void F77_dscal(const CBLAS_INT *N, const double *alpha, double *X, + const CBLAS_INT *incX) { - return cblas_dzasum(*N, X, *incX); + API_SUFFIX(cblas_dscal)(*N, *alpha, X, *incX); + return; } -double F77_dznrm2(const int *N, const void *X, const int *incX) +void F77_dswap( const CBLAS_INT *N, double *X, const CBLAS_INT *incX, + double *Y, const CBLAS_INT *incY) { - return cblas_dznrm2(*N, X, *incX); + API_SUFFIX(cblas_dswap)(*N,X,*incX,Y,*incY); + return; } -int F77_idamax(const int *N, const double *X, const int *incX) +CBLAS_INT F77_idamax(const CBLAS_INT *N, const double *X, const CBLAS_INT *incX) { if (*N < 1 || *incX < 1) return(0); - return (cblas_idamax(*N, X, *incX)+1); + return (API_SUFFIX(cblas_idamax)(*N, X, *incX)+1); } diff --git a/CBLAS/testing/c_dblas2.c b/CBLAS/testing/c_dblas2.c index 835ba19f34..69e138fad4 100644 --- a/CBLAS/testing/c_dblas2.c +++ b/CBLAS/testing/c_dblas2.c @@ -8,12 +8,16 @@ #include "cblas.h" #include "cblas_test.h" -void F77_dgemv(int *layout, char *transp, int *m, int *n, double *alpha, - double *a, int *lda, double *x, int *incx, double *beta, - double *y, int *incy ) { +void F77_dgemv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, double *alpha, + double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx, double *beta, + double *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN transp_len +#endif +) { double *A; - int i,j,LDA; + CBLAS_INT i,j,LDA; CBLAS_TRANSPOSE trans; get_transpose_type(transp, &trans); @@ -23,23 +27,23 @@ void F77_dgemv(int *layout, char *transp, int *m, int *n, double *alpha, for( i=0; i<*m; i++ ) for( j=0; j<*n; j++ ) A[ LDA*i+j ]=a[ (*lda)*j+i ]; - cblas_dgemv( CblasRowMajor, trans, + API_SUFFIX(cblas_dgemv)( CblasRowMajor, trans, *m, *n, *alpha, A, LDA, x, *incx, *beta, y, *incy ); free(A); } else if (*layout == TEST_COL_MJR) - cblas_dgemv( CblasColMajor, trans, + API_SUFFIX(cblas_dgemv)( CblasColMajor, trans, *m, *n, *alpha, a, *lda, x, *incx, *beta, y, *incy ); else - cblas_dgemv( UNDEFINED, trans, + API_SUFFIX(cblas_dgemv)( INVALID_LAYOUT, trans, *m, *n, *alpha, a, *lda, x, *incx, *beta, y, *incy ); } -void F77_dger(int *layout, int *m, int *n, double *alpha, double *x, int *incx, - double *y, int *incy, double *a, int *lda ) { +void F77_dger(CBLAS_INT *layout, CBLAS_INT *m, CBLAS_INT *n, double *alpha, double *x, CBLAS_INT *incx, + double *y, CBLAS_INT *incy, double *a, CBLAS_INT *lda ) { double *A; - int i,j,LDA; + CBLAS_INT i,j,LDA; if (*layout == TEST_ROW_MJR) { LDA = *n+1; @@ -50,20 +54,24 @@ void F77_dger(int *layout, int *m, int *n, double *alpha, double *x, int *incx, A[ LDA*i+j ]=a[ (*lda)*j+i ]; } - cblas_dger(CblasRowMajor, *m, *n, *alpha, x, *incx, y, *incy, A, LDA ); + API_SUFFIX(cblas_dger)(CblasRowMajor, *m, *n, *alpha, x, *incx, y, *incy, A, LDA ); for( i=0; i<*m; i++ ) for( j=0; j<*n; j++ ) a[ (*lda)*j+i ]=A[ LDA*i+j ]; free(A); } else - cblas_dger( CblasColMajor, *m, *n, *alpha, x, *incx, y, *incy, a, *lda ); + API_SUFFIX(cblas_dger)( CblasColMajor, *m, *n, *alpha, x, *incx, y, *incy, a, *lda ); } -void F77_dtrmv(int *layout, char *uplow, char *transp, char *diagn, - int *n, double *a, int *lda, double *x, int *incx) { +void F77_dtrmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, + CBLAS_INT *n, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len +#endif +) { double *A; - int i,j,LDA; + CBLAS_INT i,j,LDA; CBLAS_TRANSPOSE trans; CBLAS_UPLO uplo; CBLAS_DIAG diag; @@ -78,20 +86,24 @@ void F77_dtrmv(int *layout, char *uplow, char *transp, char *diagn, for( i=0; i<*n; i++ ) for( j=0; j<*n; j++ ) A[ LDA*i+j ]=a[ (*lda)*j+i ]; - cblas_dtrmv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx); + API_SUFFIX(cblas_dtrmv)(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx); free(A); } else if (*layout == TEST_COL_MJR) - cblas_dtrmv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx); + API_SUFFIX(cblas_dtrmv)(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx); else { - cblas_dtrmv(UNDEFINED, uplo, trans, diag, *n, a, *lda, x, *incx); + API_SUFFIX(cblas_dtrmv)(INVALID_LAYOUT, uplo, trans, diag, *n, a, *lda, x, *incx); } } -void F77_dtrsv(int *layout, char *uplow, char *transp, char *diagn, - int *n, double *a, int *lda, double *x, int *incx ) { +void F77_dtrsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, + CBLAS_INT *n, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len +#endif +) { double *A; - int i,j,LDA; + CBLAS_INT i,j,LDA; CBLAS_TRANSPOSE trans; CBLAS_UPLO uplo; CBLAS_DIAG diag; @@ -106,17 +118,21 @@ void F77_dtrsv(int *layout, char *uplow, char *transp, char *diagn, for( i=0; i<*n; i++ ) for( j=0; j<*n; j++ ) A[ LDA*i+j ]=a[ (*lda)*j+i ]; - cblas_dtrsv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx ); + API_SUFFIX(cblas_dtrsv)(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx ); free(A); } else - cblas_dtrsv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx ); + API_SUFFIX(cblas_dtrsv)(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx ); } -void F77_dsymv(int *layout, char *uplow, int *n, double *alpha, double *a, - int *lda, double *x, int *incx, double *beta, double *y, - int *incy) { +void F77_dsymv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, double *a, + CBLAS_INT *lda, double *x, CBLAS_INT *incx, double *beta, double *y, + CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len +#endif +) { double *A; - int i,j,LDA; + CBLAS_INT i,j,LDA; CBLAS_UPLO uplo; get_uplo_type(uplow,&uplo); @@ -127,19 +143,24 @@ void F77_dsymv(int *layout, char *uplow, int *n, double *alpha, double *a, for( i=0; i<*n; i++ ) for( j=0; j<*n; j++ ) A[ LDA*i+j ]=a[ (*lda)*j+i ]; - cblas_dsymv(CblasRowMajor, uplo, *n, *alpha, A, LDA, x, *incx, + API_SUFFIX(cblas_dsymv)(CblasRowMajor, uplo, *n, *alpha, A, LDA, x, *incx, *beta, y, *incy ); free(A); } else - cblas_dsymv(CblasColMajor, uplo, *n, *alpha, a, *lda, x, *incx, + API_SUFFIX(cblas_dsymv)(CblasColMajor, uplo, *n, *alpha, a, *lda, x, *incx, *beta, y, *incy ); } -void F77_dsyr(int *layout, char *uplow, int *n, double *alpha, double *x, - int *incx, double *a, int *lda) { +void F77_dskewsymv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, double *a, + CBLAS_INT *lda, double *x, CBLAS_INT *incx, double *beta, double *y, + CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len +#endif +) { double *A; - int i,j,LDA; + CBLAS_INT i,j,LDA; CBLAS_UPLO uplo; get_uplo_type(uplow,&uplo); @@ -150,20 +171,79 @@ void F77_dsyr(int *layout, char *uplow, int *n, double *alpha, double *x, for( i=0; i<*n; i++ ) for( j=0; j<*n; j++ ) A[ LDA*i+j ]=a[ (*lda)*j+i ]; - cblas_dsyr(CblasRowMajor, uplo, *n, *alpha, x, *incx, A, LDA); + API_SUFFIX(cblas_dskewsymv)(CblasRowMajor, uplo, *n, *alpha, A, LDA, x, *incx, + *beta, y, *incy ); + free(A); + } + else + API_SUFFIX(cblas_dskewsymv)(CblasColMajor, uplo, *n, *alpha, a, *lda, x, *incx, + *beta, y, *incy ); +} + +void F77_dsyr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, double *x, + CBLAS_INT *incx, double *a, CBLAS_INT *lda +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len +#endif +) { + double *A; + CBLAS_INT i,j,LDA; + CBLAS_UPLO uplo; + + get_uplo_type(uplow,&uplo); + + if (*layout == TEST_ROW_MJR) { + LDA = *n+1; + A = ( double* )malloc( (*n)*LDA*sizeof( double ) ); + for( i=0; i<*n; i++ ) + for( j=0; j<*n; j++ ) + A[ LDA*i+j ]=a[ (*lda)*j+i ]; + API_SUFFIX(cblas_dsyr)(CblasRowMajor, uplo, *n, *alpha, x, *incx, A, LDA); + for( i=0; i<*n; i++ ) + for( j=0; j<*n; j++ ) + a[ (*lda)*j+i ]=A[ LDA*i+j ]; + free(A); + } + else + API_SUFFIX(cblas_dsyr)(CblasColMajor, uplo, *n, *alpha, x, *incx, a, *lda); +} + +void F77_dsyr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, double *x, + CBLAS_INT *incx, double *y, CBLAS_INT *incy, double *a, CBLAS_INT *lda +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len +#endif +) { + double *A; + CBLAS_INT i,j,LDA; + CBLAS_UPLO uplo; + + get_uplo_type(uplow,&uplo); + + if (*layout == TEST_ROW_MJR) { + LDA = *n+1; + A = ( double* )malloc( (*n)*LDA*sizeof( double ) ); + for( i=0; i<*n; i++ ) + for( j=0; j<*n; j++ ) + A[ LDA*i+j ]=a[ (*lda)*j+i ]; + API_SUFFIX(cblas_dsyr2)(CblasRowMajor, uplo, *n, *alpha, x, *incx, y, *incy, A, LDA); for( i=0; i<*n; i++ ) for( j=0; j<*n; j++ ) a[ (*lda)*j+i ]=A[ LDA*i+j ]; free(A); } else - cblas_dsyr(CblasColMajor, uplo, *n, *alpha, x, *incx, a, *lda); + API_SUFFIX(cblas_dsyr2)(CblasColMajor, uplo, *n, *alpha, x, *incx, y, *incy, a, *lda); } -void F77_dsyr2(int *layout, char *uplow, int *n, double *alpha, double *x, - int *incx, double *y, int *incy, double *a, int *lda) { +void F77_dskewsyr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, double *x, + CBLAS_INT *incx, double *y, CBLAS_INT *incy, double *a, CBLAS_INT *lda +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len +#endif +) { double *A; - int i,j,LDA; + CBLAS_INT i,j,LDA; CBLAS_UPLO uplo; get_uplo_type(uplow,&uplo); @@ -174,22 +254,26 @@ void F77_dsyr2(int *layout, char *uplow, int *n, double *alpha, double *x, for( i=0; i<*n; i++ ) for( j=0; j<*n; j++ ) A[ LDA*i+j ]=a[ (*lda)*j+i ]; - cblas_dsyr2(CblasRowMajor, uplo, *n, *alpha, x, *incx, y, *incy, A, LDA); + API_SUFFIX(cblas_dskewsyr2)(CblasRowMajor, uplo, *n, *alpha, x, *incx, y, *incy, A, LDA); for( i=0; i<*n; i++ ) for( j=0; j<*n; j++ ) a[ (*lda)*j+i ]=A[ LDA*i+j ]; free(A); } else - cblas_dsyr2(CblasColMajor, uplo, *n, *alpha, x, *incx, y, *incy, a, *lda); + API_SUFFIX(cblas_dskewsyr2)(CblasColMajor, uplo, *n, *alpha, x, *incx, y, *incy, a, *lda); } -void F77_dgbmv(int *layout, char *transp, int *m, int *n, int *kl, int *ku, - double *alpha, double *a, int *lda, double *x, int *incx, - double *beta, double *y, int *incy ) { +void F77_dgbmv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, CBLAS_INT *kl, CBLAS_INT *ku, + double *alpha, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx, + double *beta, double *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN transp_len +#endif +) { double *A; - int i,irow,j,jcol,LDA; + CBLAS_INT i,irow,j,jcol,LDA; CBLAS_TRANSPOSE trans; get_transpose_type(transp, &trans); @@ -213,19 +297,23 @@ void F77_dgbmv(int *layout, char *transp, int *m, int *n, int *kl, int *ku, for( j=jcol; j<(*n+*kl); j++ ) A[ LDA*j+irow ]=a[ (*lda)*(j-jcol)+i ]; } - cblas_dgbmv( CblasRowMajor, trans, *m, *n, *kl, *ku, *alpha, + API_SUFFIX(cblas_dgbmv)( CblasRowMajor, trans, *m, *n, *kl, *ku, *alpha, A, LDA, x, *incx, *beta, y, *incy ); free(A); } else - cblas_dgbmv( CblasColMajor, trans, *m, *n, *kl, *ku, *alpha, + API_SUFFIX(cblas_dgbmv)( CblasColMajor, trans, *m, *n, *kl, *ku, *alpha, a, *lda, x, *incx, *beta, y, *incy ); } -void F77_dtbmv(int *layout, char *uplow, char *transp, char *diagn, - int *n, int *k, double *a, int *lda, double *x, int *incx) { +void F77_dtbmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, + CBLAS_INT *n, CBLAS_INT *k, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len +#endif +) { double *A; - int irow, jcol, i, j, LDA; + CBLAS_INT irow, jcol, i, j, LDA; CBLAS_TRANSPOSE trans; CBLAS_UPLO uplo; CBLAS_DIAG diag; @@ -261,17 +349,21 @@ void F77_dtbmv(int *layout, char *uplow, char *transp, char *diagn, A[ LDA*j+irow ]=a[ (*lda)*(j-jcol)+i ]; } } - cblas_dtbmv(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, x, *incx); + API_SUFFIX(cblas_dtbmv)(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, x, *incx); free(A); } else - cblas_dtbmv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx); + API_SUFFIX(cblas_dtbmv)(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx); } -void F77_dtbsv(int *layout, char *uplow, char *transp, char *diagn, - int *n, int *k, double *a, int *lda, double *x, int *incx) { +void F77_dtbsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, + CBLAS_INT *n, CBLAS_INT *k, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len +#endif +) { double *A; - int irow, jcol, i, j, LDA; + CBLAS_INT irow, jcol, i, j, LDA; CBLAS_TRANSPOSE trans; CBLAS_UPLO uplo; CBLAS_DIAG diag; @@ -307,18 +399,22 @@ void F77_dtbsv(int *layout, char *uplow, char *transp, char *diagn, A[ LDA*j+irow ]=a[ (*lda)*(j-jcol)+i ]; } } - cblas_dtbsv(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, x, *incx); + API_SUFFIX(cblas_dtbsv)(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, x, *incx); free(A); } else - cblas_dtbsv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx); + API_SUFFIX(cblas_dtbsv)(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx); } -void F77_dsbmv(int *layout, char *uplow, int *n, int *k, double *alpha, - double *a, int *lda, double *x, int *incx, double *beta, - double *y, int *incy) { +void F77_dsbmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_INT *k, double *alpha, + double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx, double *beta, + double *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len +#endif +) { double *A; - int i,j,irow,jcol,LDA; + CBLAS_INT i,j,irow,jcol,LDA; CBLAS_UPLO uplo; get_uplo_type(uplow,&uplo); @@ -350,19 +446,23 @@ void F77_dsbmv(int *layout, char *uplow, int *n, int *k, double *alpha, A[ LDA*j+irow ]=a[ (*lda)*(j-jcol)+i ]; } } - cblas_dsbmv(CblasRowMajor, uplo, *n, *k, *alpha, A, LDA, x, *incx, + API_SUFFIX(cblas_dsbmv)(CblasRowMajor, uplo, *n, *k, *alpha, A, LDA, x, *incx, *beta, y, *incy ); free(A); } else - cblas_dsbmv(CblasColMajor, uplo, *n, *k, *alpha, a, *lda, x, *incx, + API_SUFFIX(cblas_dsbmv)(CblasColMajor, uplo, *n, *k, *alpha, a, *lda, x, *incx, *beta, y, *incy ); } -void F77_dspmv(int *layout, char *uplow, int *n, double *alpha, double *ap, - double *x, int *incx, double *beta, double *y, int *incy) { +void F77_dspmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, double *ap, + double *x, CBLAS_INT *incx, double *beta, double *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len +#endif +) { double *A,*AP; - int i,j,k,LDA; + CBLAS_INT i,j,k,LDA; CBLAS_UPLO uplo; get_uplo_type(uplow,&uplo); @@ -387,20 +487,24 @@ void F77_dspmv(int *layout, char *uplow, int *n, double *alpha, double *ap, for( j=0; j #include "cblas.h" #include "cblas_test.h" -#define TEST_COL_MJR 0 -#define TEST_ROW_MJR 1 -#define UNDEFINED -1 -void F77_dgemm(int *layout, char *transpa, char *transpb, int *m, int *n, - int *k, double *alpha, double *a, int *lda, double *b, int *ldb, - double *beta, double *c, int *ldc ) { +void F77_dgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CBLAS_INT *n, + CBLAS_INT *k, double *alpha, double *a, CBLAS_INT *lda, double *b, CBLAS_INT *ldb, + double *beta, double *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN transpa_len, FORTRAN_STRLEN transpb_len +#endif +) { double *A, *B, *C; - int i,j,LDA, LDB, LDC; + CBLAS_INT i,j,LDA, LDB, LDC; CBLAS_TRANSPOSE transa, transb; get_transpose_type(transpa, &transa); @@ -57,7 +58,7 @@ void F77_dgemm(int *layout, char *transpa, char *transpb, int *m, int *n, for( i=0; i<*m; i++ ) C[i*LDC+j]=c[j*(*ldc)+i]; - cblas_dgemm( CblasRowMajor, transa, transb, *m, *n, *k, *alpha, A, LDA, + API_SUFFIX(cblas_dgemm)( CblasRowMajor, transa, transb, *m, *n, *k, *alpha, A, LDA, B, LDB, *beta, C, LDC ); for( j=0; j<*n; j++ ) for( i=0; i<*m; i++ ) @@ -67,18 +68,101 @@ void F77_dgemm(int *layout, char *transpa, char *transpb, int *m, int *n, free(C); } else if (*layout == TEST_COL_MJR) - cblas_dgemm( CblasColMajor, transa, transb, *m, *n, *k, *alpha, a, *lda, + API_SUFFIX(cblas_dgemm)( CblasColMajor, transa, transb, *m, *n, *k, *alpha, a, *lda, b, *ldb, *beta, c, *ldc ); else - cblas_dgemm( UNDEFINED, transa, transb, *m, *n, *k, *alpha, a, *lda, + API_SUFFIX(cblas_dgemm)( INVALID_LAYOUT, transa, transb, *m, *n, *k, *alpha, a, *lda, b, *ldb, *beta, c, *ldc ); } -void F77_dsymm(int *layout, char *rtlf, char *uplow, int *m, int *n, - double *alpha, double *a, int *lda, double *b, int *ldb, - double *beta, double *c, int *ldc ) { + +void F77_dgemmtr(CBLAS_INT *layout, char *uplop, char *transpa, char *transpb, CBLAS_INT *n, + CBLAS_INT *k, double *alpha, double *a, CBLAS_INT *lda, + double *b, CBLAS_INT *ldb, double *beta, + double *c, CBLAS_INT *ldc ) { double *A, *B, *C; - int i,j,LDA, LDB, LDC; + CBLAS_INT i,j,LDA, LDB, LDC; + CBLAS_TRANSPOSE transa, transb; + CBLAS_UPLO uplo; + + get_transpose_type(transpa, &transa); + get_transpose_type(transpb, &transb); + get_uplo_type(uplop, &uplo); + + if (*layout == TEST_ROW_MJR) { + if (transa == CblasNoTrans) { + LDA = *k+1; + A=(double*)malloc((*n)*LDA*sizeof(double)); + for( i=0; i<*n; i++ ) + for( j=0; j<*k; j++ ) { + A[i*LDA+j]=a[j*(*lda)+i]; + } + } + else { + LDA = *n+1; + A=(double* )malloc(LDA*(*k)*sizeof(double)); + for( i=0; i<*k; i++ ) + for( j=0; j<*n; j++ ) { + A[i*LDA+j]=a[j*(*lda)+i]; + } + } + + if (transb == CblasNoTrans) { + LDB = *n+1; + B=(double* )malloc((*k)*LDB*sizeof(double) ); + for( i=0; i<*k; i++ ) + for( j=0; j<*n; j++ ) { + B[i*LDB+j]=b[j*(*ldb)+i]; + } + } + else { + LDB = *k+1; + B=(double* )malloc(LDB*(*n)*sizeof(double)); + for( i=0; i<*n; i++ ) + for( j=0; j<*k; j++ ) { + B[i*LDB+j]=b[j*(*ldb)+i]; + } + } + + LDC = *n+1; + C=(double* )malloc((*n)*LDC*sizeof(double)); + for( j=0; j<*n; j++ ) + for( i=0; i<*n; i++ ) { + C[i*LDC+j]=c[j*(*ldc)+i]; + } + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, uplo, transa, transb, *n, *k, *alpha, A, LDA, + B, LDB, *beta, C, LDC ); + for( j=0; j<*n; j++ ) + for( i=0; i<*n; i++ ) { + c[j*(*ldc)+i]=C[i*LDC+j]; + } + free(A); + free(B); + free(C); + } + else if (*layout == TEST_COL_MJR){ + API_SUFFIX(cblas_dgemmtr)( CblasColMajor, uplo, transa, transb, *n, *k, *alpha, a, *lda, + b, *ldb, *beta, c, *ldc ); + } + else + API_SUFFIX(cblas_dgemmtr)( INVALID_LAYOUT, uplo, transa, transb, *n, *k, *alpha, a, *lda, + b, *ldb, *beta, c, *ldc ); +} + + + + + +void F77_dsymm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_INT *n, + double *alpha, double *a, CBLAS_INT *lda, double *b, CBLAS_INT *ldb, + double *beta, double *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len +#endif +) { + + double *A, *B, *C; + CBLAS_INT i,j,LDA, LDB, LDC; CBLAS_UPLO uplo; CBLAS_SIDE side; @@ -110,7 +194,7 @@ void F77_dsymm(int *layout, char *rtlf, char *uplow, int *m, int *n, for( j=0; j<*n; j++ ) for( i=0; i<*m; i++ ) C[i*LDC+j]=c[j*(*ldc)+i]; - cblas_dsymm( CblasRowMajor, side, uplo, *m, *n, *alpha, A, LDA, B, LDB, + API_SUFFIX(cblas_dsymm)( CblasRowMajor, side, uplo, *m, *n, *alpha, A, LDA, B, LDB, *beta, C, LDC ); for( j=0; j<*n; j++ ) for( i=0; i<*m; i++ ) @@ -120,18 +204,80 @@ void F77_dsymm(int *layout, char *rtlf, char *uplow, int *m, int *n, free(C); } else if (*layout == TEST_COL_MJR) - cblas_dsymm( CblasColMajor, side, uplo, *m, *n, *alpha, a, *lda, b, *ldb, + API_SUFFIX(cblas_dsymm)( CblasColMajor, side, uplo, *m, *n, *alpha, a, *lda, b, *ldb, *beta, c, *ldc ); else - cblas_dsymm( UNDEFINED, side, uplo, *m, *n, *alpha, a, *lda, b, *ldb, + API_SUFFIX(cblas_dsymm)( INVALID_LAYOUT, side, uplo, *m, *n, *alpha, a, *lda, b, *ldb, *beta, c, *ldc ); } -void F77_dsyrk(int *layout, char *uplow, char *transp, int *n, int *k, - double *alpha, double *a, int *lda, - double *beta, double *c, int *ldc ) { +void F77_dskewsymm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_INT *n, + double *alpha, double *a, CBLAS_INT *lda, double *b, CBLAS_INT *ldb, + double *beta, double *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len +#endif +) { - int i,j,LDA,LDC; + double *A, *B, *C; + CBLAS_INT i,j,LDA, LDB, LDC; + CBLAS_UPLO uplo; + CBLAS_SIDE side; + + get_uplo_type(uplow,&uplo); + get_side_type(rtlf,&side); + + if (*layout == TEST_ROW_MJR) { + if (side == CblasLeft) { + LDA = *m+1; + A = ( double* )malloc( (*m)*LDA*sizeof( double ) ); + for( i=0; i<*m; i++ ) + for( j=0; j<*m; j++ ) + A[i*LDA+j]=a[j*(*lda)+i]; + } + else{ + LDA = *n+1; + A = ( double* )malloc( (*n)*LDA*sizeof( double ) ); + for( i=0; i<*n; i++ ) + for( j=0; j<*n; j++ ) + A[i*LDA+j]=a[j*(*lda)+i]; + } + LDB = *n+1; + B = ( double* )malloc( (*m)*LDB*sizeof( double ) ); + for( i=0; i<*m; i++ ) + for( j=0; j<*n; j++ ) + B[i*LDB+j]=b[j*(*ldb)+i]; + LDC = *n+1; + C = ( double* )malloc( (*m)*LDC*sizeof( double ) ); + for( j=0; j<*n; j++ ) + for( i=0; i<*m; i++ ) + C[i*LDC+j]=c[j*(*ldc)+i]; + API_SUFFIX(cblas_dskewsymm)( CblasRowMajor, side, uplo, *m, *n, *alpha, A, LDA, B, LDB, + *beta, C, LDC ); + for( j=0; j<*n; j++ ) + for( i=0; i<*m; i++ ) + c[j*(*ldc)+i]=C[i*LDC+j]; + free(A); + free(B); + free(C); + } + else if (*layout == TEST_COL_MJR) + API_SUFFIX(cblas_dskewsymm)( CblasColMajor, side, uplo, *m, *n, *alpha, a, *lda, b, *ldb, + *beta, c, *ldc ); + else + API_SUFFIX(cblas_dskewsymm)( INVALID_LAYOUT, side, uplo, *m, *n, *alpha, a, *lda, b, *ldb, + *beta, c, *ldc ); +} + +void F77_dsyrk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k, + double *alpha, double *a, CBLAS_INT *lda, + double *beta, double *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len +#endif +) { + + CBLAS_INT i,j,LDA,LDC; double *A, *C; CBLAS_UPLO uplo; CBLAS_TRANSPOSE trans; @@ -159,7 +305,7 @@ void F77_dsyrk(int *layout, char *uplow, char *transp, int *n, int *k, for( i=0; i<*n; i++ ) for( j=0; j<*n; j++ ) C[i*LDC+j]=c[j*(*ldc)+i]; - cblas_dsyrk(CblasRowMajor, uplo, trans, *n, *k, *alpha, A, LDA, *beta, + API_SUFFIX(cblas_dsyrk)(CblasRowMajor, uplo, trans, *n, *k, *alpha, A, LDA, *beta, C, LDC ); for( j=0; j<*n; j++ ) for( i=0; i<*n; i++ ) @@ -168,17 +314,80 @@ void F77_dsyrk(int *layout, char *uplow, char *transp, int *n, int *k, free(C); } else if (*layout == TEST_COL_MJR) - cblas_dsyrk(CblasColMajor, uplo, trans, *n, *k, *alpha, a, *lda, *beta, + API_SUFFIX(cblas_dsyrk)(CblasColMajor, uplo, trans, *n, *k, *alpha, a, *lda, *beta, c, *ldc ); else - cblas_dsyrk(UNDEFINED, uplo, trans, *n, *k, *alpha, a, *lda, *beta, + API_SUFFIX(cblas_dsyrk)(INVALID_LAYOUT, uplo, trans, *n, *k, *alpha, a, *lda, *beta, c, *ldc ); } -void F77_dsyr2k(int *layout, char *uplow, char *transp, int *n, int *k, - double *alpha, double *a, int *lda, double *b, int *ldb, - double *beta, double *c, int *ldc ) { - int i,j,LDA,LDB,LDC; +void F77_dsyr2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k, + double *alpha, double *a, CBLAS_INT *lda, double *b, CBLAS_INT *ldb, + double *beta, double *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len +#endif +) { + CBLAS_INT i,j,LDA,LDB,LDC; + double *A, *B, *C; + CBLAS_UPLO uplo; + CBLAS_TRANSPOSE trans; + + get_uplo_type(uplow,&uplo); + get_transpose_type(transp,&trans); + + if (*layout == TEST_ROW_MJR) { + if (trans == CblasNoTrans) { + LDA = *k+1; + LDB = *k+1; + A = ( double* )malloc( (*n)*LDA*sizeof( double ) ); + B = ( double* )malloc( (*n)*LDB*sizeof( double ) ); + for( i=0; i<*n; i++ ) + for( j=0; j<*k; j++ ) { + A[i*LDA+j]=a[j*(*lda)+i]; + B[i*LDB+j]=b[j*(*ldb)+i]; + } + } + else { + LDA = *n+1; + LDB = *n+1; + A = ( double* )malloc( LDA*(*k)*sizeof( double ) ); + B = ( double* )malloc( LDB*(*k)*sizeof( double ) ); + for( i=0; i<*k; i++ ) + for( j=0; j<*n; j++ ){ + A[i*LDA+j]=a[j*(*lda)+i]; + B[i*LDB+j]=b[j*(*ldb)+i]; + } + } + LDC = *n+1; + C = ( double* )malloc( (*n)*LDC*sizeof( double ) ); + for( i=0; i<*n; i++ ) + for( j=0; j<*n; j++ ) + C[i*LDC+j]=c[j*(*ldc)+i]; + API_SUFFIX(cblas_dsyr2k)(CblasRowMajor, uplo, trans, *n, *k, *alpha, A, LDA, + B, LDB, *beta, C, LDC ); + for( j=0; j<*n; j++ ) + for( i=0; i<*n; i++ ) + c[j*(*ldc)+i]=C[i*LDC+j]; + free(A); + free(B); + free(C); + } + else if (*layout == TEST_COL_MJR) + API_SUFFIX(cblas_dsyr2k)(CblasColMajor, uplo, trans, *n, *k, *alpha, a, *lda, + b, *ldb, *beta, c, *ldc ); + else + API_SUFFIX(cblas_dsyr2k)(INVALID_LAYOUT, uplo, trans, *n, *k, *alpha, a, *lda, + b, *ldb, *beta, c, *ldc ); +} +void F77_dskewsyr2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k, + double *alpha, double *a, CBLAS_INT *lda, double *b, CBLAS_INT *ldb, + double *beta, double *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len +#endif +) { + CBLAS_INT i,j,LDA,LDB,LDC; double *A, *B, *C; CBLAS_UPLO uplo; CBLAS_TRANSPOSE trans; @@ -214,7 +423,7 @@ void F77_dsyr2k(int *layout, char *uplow, char *transp, int *n, int *k, for( i=0; i<*n; i++ ) for( j=0; j<*n; j++ ) C[i*LDC+j]=c[j*(*ldc)+i]; - cblas_dsyr2k(CblasRowMajor, uplo, trans, *n, *k, *alpha, A, LDA, + API_SUFFIX(cblas_dskewsyr2k)(CblasRowMajor, uplo, trans, *n, *k, *alpha, A, LDA, B, LDB, *beta, C, LDC ); for( j=0; j<*n; j++ ) for( i=0; i<*n; i++ ) @@ -224,16 +433,20 @@ void F77_dsyr2k(int *layout, char *uplow, char *transp, int *n, int *k, free(C); } else if (*layout == TEST_COL_MJR) - cblas_dsyr2k(CblasColMajor, uplo, trans, *n, *k, *alpha, a, *lda, + API_SUFFIX(cblas_dskewsyr2k)(CblasColMajor, uplo, trans, *n, *k, *alpha, a, *lda, b, *ldb, *beta, c, *ldc ); else - cblas_dsyr2k(UNDEFINED, uplo, trans, *n, *k, *alpha, a, *lda, + API_SUFFIX(cblas_dskewsyr2k)(INVALID_LAYOUT, uplo, trans, *n, *k, *alpha, a, *lda, b, *ldb, *beta, c, *ldc ); } -void F77_dtrmm(int *layout, char *rtlf, char *uplow, char *transp, char *diagn, - int *m, int *n, double *alpha, double *a, int *lda, double *b, - int *ldb) { - int i,j,LDA,LDB; +void F77_dtrmm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *diagn, + CBLAS_INT *m, CBLAS_INT *n, double *alpha, double *a, CBLAS_INT *lda, double *b, + CBLAS_INT *ldb +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diag_len +#endif +) { + CBLAS_INT i,j,LDA,LDB; double *A, *B; CBLAS_SIDE side; CBLAS_DIAG diag; @@ -265,7 +478,7 @@ void F77_dtrmm(int *layout, char *rtlf, char *uplow, char *transp, char *diagn, for( i=0; i<*m; i++ ) for( j=0; j<*n; j++ ) B[i*LDB+j]=b[j*(*ldb)+i]; - cblas_dtrmm(CblasRowMajor, side, uplo, trans, diag, *m, *n, *alpha, + API_SUFFIX(cblas_dtrmm)(CblasRowMajor, side, uplo, trans, diag, *m, *n, *alpha, A, LDA, B, LDB ); for( j=0; j<*n; j++ ) for( i=0; i<*m; i++ ) @@ -274,17 +487,21 @@ void F77_dtrmm(int *layout, char *rtlf, char *uplow, char *transp, char *diagn, free(B); } else if (*layout == TEST_COL_MJR) - cblas_dtrmm(CblasColMajor, side, uplo, trans, diag, *m, *n, *alpha, + API_SUFFIX(cblas_dtrmm)(CblasColMajor, side, uplo, trans, diag, *m, *n, *alpha, a, *lda, b, *ldb); else - cblas_dtrmm(UNDEFINED, side, uplo, trans, diag, *m, *n, *alpha, + API_SUFFIX(cblas_dtrmm)(INVALID_LAYOUT, side, uplo, trans, diag, *m, *n, *alpha, a, *lda, b, *ldb); } -void F77_dtrsm(int *layout, char *rtlf, char *uplow, char *transp, char *diagn, - int *m, int *n, double *alpha, double *a, int *lda, double *b, - int *ldb) { - int i,j,LDA,LDB; +void F77_dtrsm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *diagn, + CBLAS_INT *m, CBLAS_INT *n, double *alpha, double *a, CBLAS_INT *lda, double *b, + CBLAS_INT *ldb +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len +#endif +) { + CBLAS_INT i,j,LDA,LDB; double *A, *B; CBLAS_SIDE side; CBLAS_DIAG diag; @@ -316,7 +533,7 @@ void F77_dtrsm(int *layout, char *rtlf, char *uplow, char *transp, char *diagn, for( i=0; i<*m; i++ ) for( j=0; j<*n; j++ ) B[i*LDB+j]=b[j*(*ldb)+i]; - cblas_dtrsm(CblasRowMajor, side, uplo, trans, diag, *m, *n, *alpha, + API_SUFFIX(cblas_dtrsm)(CblasRowMajor, side, uplo, trans, diag, *m, *n, *alpha, A, LDA, B, LDB ); for( j=0; j<*n; j++ ) for( i=0; i<*m; i++ ) @@ -325,9 +542,9 @@ void F77_dtrsm(int *layout, char *rtlf, char *uplow, char *transp, char *diagn, free(B); } else if (*layout == TEST_COL_MJR) - cblas_dtrsm(CblasColMajor, side, uplo, trans, diag, *m, *n, *alpha, + API_SUFFIX(cblas_dtrsm)(CblasColMajor, side, uplo, trans, diag, *m, *n, *alpha, a, *lda, b, *ldb); else - cblas_dtrsm(UNDEFINED, side, uplo, trans, diag, *m, *n, *alpha, + API_SUFFIX(cblas_dtrsm)(INVALID_LAYOUT, side, uplo, trans, diag, *m, *n, *alpha, a, *lda, b, *ldb); } diff --git a/CBLAS/testing/c_dblat1.f b/CBLAS/testing/c_dblat1.f index c570a91408..c6f0744658 100644 --- a/CBLAS/testing/c_dblat1.f +++ b/CBLAS/testing/c_dblat1.f @@ -1,4 +1,6 @@ +* ===================================================================== PROGRAM DCBLAT1 + IMPLICIT NONE * Test program for the DOUBLE PRECISION Level 1 CBLAS. * Based upon the original CBLAS test routine together with: * F06EAF Example Program Text @@ -6,20 +8,26 @@ PROGRAM DCBLAT1 INTEGER NOUT PARAMETER (NOUT=6) * .. Scalars in Common .. + INTEGER NTESTS, NFAILS + CHARACTER*15 SUBNAM INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Scalars .. + DOUBLE PRECISION S1, S2 DOUBLE PRECISION SFAC INTEGER IC * .. External Subroutines .. EXTERNAL CHECK0, CHECK1, CHECK2, CHECK3, HEADER * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS + COMMON /CNTBLA/NTESTS, NFAILS + COMMON /NAMBLA/SUBNAM * .. Data statements .. DATA SFAC/9.765625D-4/ * .. Executable Statements .. + CALL CPU_TIME( S1 ) WRITE (NOUT,99999) - DO 20 IC = 1, 10 + DO 20 IC = 1, 11 ICASE = IC CALL HEADER * @@ -29,6 +37,8 @@ PROGRAM DCBLAT1 * .. these parameters .. * PASS = .TRUE. + NTESTS = 0 + NFAILS = 0 INCX = 9999 INCY = 9999 MODE = 9999 @@ -38,30 +48,42 @@ PROGRAM DCBLAT1 + ICASE.EQ.10) THEN CALL CHECK1(SFAC) ELSE IF (ICASE.EQ.1 .OR. ICASE.EQ.2 .OR. ICASE.EQ.5 .OR. - + ICASE.EQ.6) THEN + + ICASE.EQ.6 .OR. ICASE.EQ.11 ) THEN CALL CHECK2(SFAC) ELSE IF (ICASE.EQ.4) THEN CALL CHECK3(SFAC) END IF * -- Print IF (PASS) WRITE (NOUT,99998) + WRITE (NOUT,99997) SUBNAM, NTESTS, NFAILS 20 CONTINUE + CALL CPU_TIME( S2 ) + WRITE (NOUT,99996) S2 - S1 STOP * 99999 FORMAT (' Real CBLAS Test Program Results',/1X) 99998 FORMAT (' ----- PASS -----') +99997 FORMAT (1X,A15,' COMPUTATIONAL TESTS:',I9,' RUN,',I9, + + ' FAILED') +99996 FORMAT (' Total time used = ',F12.2,' seconds',/) END + +* ===================================================================== SUBROUTINE HEADER + IMPLICIT NONE + * .. Parameters .. INTEGER NOUT PARAMETER (NOUT=6) * .. Scalars in Common .. + CHARACTER*15 SUBNAM INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Arrays .. - CHARACTER*15 L(10) + CHARACTER*15 L(11) * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS + COMMON /NAMBLA/SUBNAM * .. Data statements .. DATA L(1)/'CBLAS_DDOT'/ DATA L(2)/'CBLAS_DAXPY '/ @@ -73,13 +95,19 @@ SUBROUTINE HEADER DATA L(8)/'CBLAS_DASUM '/ DATA L(9)/'CBLAS_DSCAL '/ DATA L(10)/'CBLAS_IDAMAX'/ + DATA L(11)/'CBLAS_DAXPBY'/ + * .. Executable Statements .. + SUBNAM = L(ICASE) WRITE (NOUT,99999) ICASE, L(ICASE) RETURN * 99999 FORMAT (/' Test of subprogram number',I3,9X,A15) END + +* ===================================================================== SUBROUTINE CHECK0(SFAC) + IMPLICIT NONE * .. Parameters .. INTEGER NOUT PARAMETER (NOUT=6) @@ -140,7 +168,10 @@ SUBROUTINE CHECK0(SFAC) 20 CONTINUE 40 RETURN END + +* ===================================================================== SUBROUTINE CHECK1(SFAC) + IMPLICIT NONE * .. Parameters .. INTEGER NOUT PARAMETER (NOUT=6) @@ -234,7 +265,10 @@ SUBROUTINE CHECK1(SFAC) 80 CONTINUE RETURN END + +* ===================================================================== SUBROUTINE CHECK2(SFAC) + IMPLICIT NONE * .. Parameters .. INTEGER NOUT PARAMETER (NOUT=6) @@ -244,25 +278,27 @@ SUBROUTINE CHECK2(SFAC) INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Scalars .. - DOUBLE PRECISION SA + DOUBLE PRECISION SA, SB INTEGER I, J, KI, KN, KSIZE, LENX, LENY, MX, MY * .. Local Arrays .. DOUBLE PRECISION DT10X(7,4,4), DT10Y(7,4,4), DT7(4,4), + DT8(7,4,4), DX1(7), + DY1(7), SSIZE1(4), SSIZE2(14,2), STX(7), STY(7), - + SX(7), SY(7) + + SX(7), SY(7), DT20(7,4,4) INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4) * .. External Functions .. EXTERNAL DDOTTEST DOUBLE PRECISION DDOTTEST * .. External Subroutines .. - EXTERNAL DAXPYTEST, DCOPYTEST, DSWAPTEST, STEST, STEST1 + EXTERNAL DAXPYTEST, DCOPYTEST, DSWAPTEST, STEST, STEST1, + + DAXPBYTEST * .. Intrinsic Functions .. INTRINSIC ABS, MIN * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS * .. Data statements .. DATA SA/0.3D0/ + DATA SB/0.5D0/ DATA INCXS/1, 2, -2, -1/ DATA INCYS/1, -2, 1, -2/ DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/ @@ -335,6 +371,27 @@ SUBROUTINE CHECK2(SFAC) + 0.0D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, + 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, + 1.17D0, 1.17D0, 1.17D0/ + DATA DT20/0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, + + 0.0D0, 0.43D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, + + 0.0D0, 0.0D0, 0.43D0, -0.42D0, 0.0D0, 0.0D0, + + 0.0D0, 0.0D0, 0.0D0, 0.43D0, -0.42D0, 0.0D0, + + 0.59D0, 0.0D0, 0.0D0, 0.0D0, 0.5D0, 0.0D0, + + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.43D0, + + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, + + 0.1D0, -0.9D0, 0.33D0, 0.0D0, 0.0D0, 0.0D0, + + 0.0D0, 0.13D0, -0.9D0, 0.42D0, 0.7D0, -0.45D0, + + 0.2D0, 0.58D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, + + 0.0D0, 0.0D0, 0.0D0, 0.43D0, 0.0D0, 0.0D0, + + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.1D0, -0.27D0, + + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.13D0, + + -0.18D0, 0.00D0, 0.53D0, 0.0D0, 0.0D0, 0.0D0, + + 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, + + 0.43D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, + + 0.0D0, 0.43D0, -0.9D0, 0.18D0, 0.0D0, 0.0D0, + + 0.0D0, 0.0D0, 0.43D0, -0.9D0, 0.18D0, 0.7D0, + + -0.45D0, 0.2D0, 0.64D0/ + + * .. Executable Statements .. * DO 120 KI = 1, 4 @@ -365,6 +422,14 @@ SUBROUTINE CHECK2(SFAC) STY(J) = DT8(J,KN,KI) 40 CONTINUE CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC) + ELSE IF (ICASE.EQ.11) THEN +* .. DAXPBYTEST .. + CALL DAXPBYTEST(N,SA,SX,INCX,SB,SY,INCY) + DO 50 J = 1, LENY + STY(J) = DT20(J,KN,KI) + 50 CONTINUE + CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC) + ELSE IF (ICASE.EQ.5) THEN * .. DCOPYTEST .. DO 60 I = 1, 7 @@ -389,7 +454,10 @@ SUBROUTINE CHECK2(SFAC) 120 CONTINUE RETURN END + +* ===================================================================== SUBROUTINE CHECK3(SFAC) + IMPLICIT NONE * .. Parameters .. INTEGER NOUT PARAMETER (NOUT=6) @@ -595,7 +663,10 @@ SUBROUTINE CHECK3(SFAC) 200 CONTINUE RETURN END + +* ===================================================================== SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC) + IMPLICIT NONE * ********************************* STEST ************************** * * THIS SUBR COMPARES ARRAYS SCOMP() AND STRUE() OF LENGTH LEN TO @@ -613,6 +684,7 @@ SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC) * .. Array Arguments .. DOUBLE PRECISION SCOMP(LEN), SSIZE(LEN), STRUE(LEN) * .. Scalars in Common .. + INTEGER NTESTS, NFAILS INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Scalars .. @@ -625,12 +697,15 @@ SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC) INTRINSIC ABS * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS + COMMON /CNTBLA/NTESTS, NFAILS * .. Executable Statements .. * DO 40 I = 1, LEN + NTESTS = NTESTS + 1 SD = SCOMP(I) - STRUE(I) IF (SDIFF(ABS(SSIZE(I))+ABS(SFAC*SD),ABS(SSIZE(I))).EQ.0.0D0) + GO TO 40 + NFAILS = NFAILS + 1 * * HERE SCOMP(I) IS NOT CLOSE TO STRUE(I). * @@ -650,10 +725,13 @@ SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC) + ' SIZE(I)',/1X) 99997 FORMAT (1X,I4,I3,3I5,I3,2D36.8,2D12.4) END + +* ===================================================================== SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC) + IMPLICIT NONE * ************************* STEST1 ***************************** * -* THIS IS AN INTERFACE SUBROUTINE TO ACCOMODATE THE FORTRAN +* THIS IS AN INTERFACE SUBROUTINE TO ACCOMMODATE THE FORTRAN * REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE * ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT. * @@ -675,7 +753,10 @@ SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC) * RETURN END + +* ===================================================================== DOUBLE PRECISION FUNCTION SDIFF(SA,SB) + IMPLICIT NONE * ********************************* SDIFF ************************** * COMPUTES DIFFERENCE OF TWO NUMBERS. C. L. LAWSON, JPL 1974 FEB 15 * @@ -685,7 +766,10 @@ DOUBLE PRECISION FUNCTION SDIFF(SA,SB) SDIFF = SA - SB RETURN END + +* ===================================================================== SUBROUTINE ITEST1(ICOMP,ITRUE) + IMPLICIT NONE * ********************************* ITEST1 ************************* * * THIS SUBROUTINE COMPARES THE VARIABLES ICOMP AND ITRUE FOR @@ -698,15 +782,19 @@ SUBROUTINE ITEST1(ICOMP,ITRUE) * .. Scalar Arguments .. INTEGER ICOMP, ITRUE * .. Scalars in Common .. + INTEGER NTESTS, NFAILS INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Scalars .. INTEGER ID * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS + COMMON /CNTBLA/NTESTS, NFAILS * .. Executable Statements .. * + NTESTS = NTESTS + 1 IF (ICOMP.EQ.ITRUE) GO TO 40 + NFAILS = NFAILS + 1 * * HERE ICOMP IS NOT EQUAL TO ITRUE. * diff --git a/CBLAS/testing/c_dblat2.f b/CBLAS/testing/c_dblat2.f index 27ceda622f..232f01f20b 100644 --- a/CBLAS/testing/c_dblat2.f +++ b/CBLAS/testing/c_dblat2.f @@ -1,10 +1,12 @@ +* ===================================================================== PROGRAM DBLAT2 + IMPLICIT NONE * * Test program for the DOUBLE PRECISION Level 2 Blas. * * The program must be driven by a short data file. The first 17 records -* of the file are read using list-directed input, the last 16 records -* are read using the format ( A12, L2 ). An annotated example of a data +* of the file are read using list-directed input, the last 18 records +* are read using the format ( A16, L2 ). An annotated example of a data * file can be obtained by deleting the first 3 characters from the * following 33 lines: * 'DBLAT2.SNAP' NAME OF SNAPSHOT OUTPUT FILE @@ -24,22 +26,24 @@ PROGRAM DBLAT2 * 0.0 1.0 0.7 VALUES OF ALPHA * 3 NUMBER OF VALUES OF BETA * 0.0 1.0 0.9 VALUES OF BETA -* cblas_dgemv T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_dgbmv T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_dsymv T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_dsbmv T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_dspmv T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_dtrmv T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_dtbmv T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_dtpmv T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_dtrsv T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_dtbsv T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_dtpsv T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_dger T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_dsyr T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_dspr T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_dsyr2 T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_dspr2 T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dgemv T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dgbmv T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dsymv T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dsbmv T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dspmv T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dskewsymv T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dtrmv T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dtbmv T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dtpmv T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dtrsv T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dtbsv T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dtpsv T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dger T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dsyr T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dspr T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dsyr2 T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dspr2 T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dskewsyr2 T PUT F FOR NO TEST. SAME COLUMNS. * * See: * @@ -66,7 +70,7 @@ PROGRAM DBLAT2 INTEGER NIN, NOUT PARAMETER ( NIN = 5, NOUT = 6 ) INTEGER NSUBS - PARAMETER ( NSUBS = 16 ) + PARAMETER ( NSUBS = 18 ) DOUBLE PRECISION ZERO, HALF, ONE PARAMETER ( ZERO = 0.0D0, HALF = 0.5D0, ONE = 1.0D0 ) INTEGER NMAX, INCMAX @@ -75,13 +79,14 @@ PROGRAM DBLAT2 PARAMETER ( NINMAX = 7, NIDMAX = 9, NKBMAX = 7, $ NALMAX = 7, NBEMAX = 7 ) * .. Local Scalars .. + DOUBLE PRECISION S1, S2 DOUBLE PRECISION EPS, ERR, THRESH INTEGER I, ISNUM, J, N, NALF, NBET, NIDIM, NINC, NKB, $ NTRA, LAYOUT LOGICAL FATAL, LTESTT, REWI, SAME, SFATAL, TRACE, $ TSTERR, CORDER, RORDER CHARACTER*1 TRANS - CHARACTER*12 SNAMET + CHARACTER*16 SNAMET CHARACTER*32 SNAPS * .. Local Arrays .. DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), @@ -92,7 +97,7 @@ PROGRAM DBLAT2 $ YY( NMAX*INCMAX ), Z( 2*NMAX ) INTEGER IDIM( NIDMAX ), INC( NINMAX ), KB( NKBMAX ) LOGICAL LTEST( NSUBS ) - CHARACTER*12 SNAMES( NSUBS ) + CHARACTER*16 SNAMES( NSUBS ) * .. External Functions .. DOUBLE PRECISION DDIFF LOGICAL LDE @@ -105,18 +110,31 @@ PROGRAM DBLAT2 * .. Scalars in Common .. INTEGER INFOT, NOUTC LOGICAL OK - CHARACTER*12 SRNAMT + CHARACTER*16 SRNAMT * .. Common blocks .. COMMON /INFOC/INFOT, NOUTC, OK COMMON /SRNAMC/SRNAMT * .. Data statements .. - DATA SNAMES/'cblas_dgemv ', 'cblas_dgbmv ', - $ 'cblas_dsymv ','cblas_dsbmv ','cblas_dspmv ', - $ 'cblas_dtrmv ','cblas_dtbmv ','cblas_dtpmv ', - $ 'cblas_dtrsv ','cblas_dtbsv ','cblas_dtpsv ', - $ 'cblas_dger ','cblas_dsyr ','cblas_dspr ', - $ 'cblas_dsyr2 ','cblas_dspr2 '/ + DATA SNAMES/'cblas_dgemv ', + $ 'cblas_dgbmv ', + $ 'cblas_dsymv ', + $ 'cblas_dsbmv ', + $ 'cblas_dspmv ', + $ 'cblas_dtrmv ', + $ 'cblas_dtbmv ', + $ 'cblas_dtpmv ', + $ 'cblas_dtrsv ', + $ 'cblas_dtbsv ', + $ 'cblas_dtpsv ', + $ 'cblas_dger ', + $ 'cblas_dsyr ', + $ 'cblas_dspr ', + $ 'cblas_dsyr2 ', + $ 'cblas_dspr2 ', + $ 'cblas_dskewsymv ', + $ 'cblas_dskewsyr2 '/ * .. Executable Statements .. + CALL CPU_TIME( S1 ) * NOUTC = NOUT * @@ -310,7 +328,7 @@ PROGRAM DBLAT2 FATAL = .FALSE. GO TO ( 140, 140, 150, 150, 150, 160, 160, $ 160, 160, 160, 160, 170, 180, 180, - $ 190, 190 )ISNUM + $ 190, 190, 150, 190 )ISNUM * Test DGEMV, 01, and DGBMV, 02. 140 IF (CORDER) THEN CALL DCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, @@ -325,7 +343,7 @@ PROGRAM DBLAT2 $ X, XX, XS, Y, YY, YS, YT, G, 1 ) END IF GO TO 200 -* Test DSYMV, 03, DSBMV, 04, and DSPMV, 05. +* Test DSYMV, 03, DSBMV, 04, and DSPMV, 05, and DSKEWSYMV, 17. 150 IF (CORDER) THEN CALL DCHK2( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, @@ -382,7 +400,7 @@ PROGRAM DBLAT2 $ YT, G, Z, 1 ) END IF GO TO 200 -* Test DSYR2, 15, and DSPR2, 16. +* Test DSYR2, 15, and DSPR2, 16, and DSKEWSYR2, 18. 190 IF (CORDER) THEN CALL DCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, @@ -413,6 +431,8 @@ PROGRAM DBLAT2 240 CONTINUE IF( TRACE ) $ CLOSE ( NTRA ) + CALL CPU_TIME( S2 ) + WRITE( NOUT, FMT = 9979 )S2 - S1 CLOSE ( NOUT ) STOP * @@ -437,26 +457,30 @@ PROGRAM DBLAT2 9988 FORMAT( ' FOR BETA ', 7F6.1 ) 9987 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM', $ /' ******* TESTS ABANDONED *******' ) - 9986 FORMAT( ' SUBPROGRAM NAME ',A12, ' NOT RECOGNIZED', /' ******* T', + 9986 FORMAT( ' SUBPROGRAM NAME ',A16, ' NOT RECOGNIZED', /' ******* T', $ 'ESTS ABANDONED *******' ) 9985 FORMAT( ' ERROR IN DMVCH - IN-LINE DOT PRODUCTS ARE BEING EVALU', $ 'ATED WRONGLY.', /' DMVCH WAS CALLED WITH TRANS = ', A1, $ ' AND RETURNED SAME = ', L1, ' AND ERR = ', F12.3, '.', / $ ' THIS MAY BE DUE TO FAULTS IN THE ARITHMETIC OR THE COMPILER.' $ , /' ******* TESTS ABANDONED *******' ) - 9984 FORMAT(A12, L2 ) - 9983 FORMAT( 1X,A12, ' WAS NOT TESTED' ) + 9984 FORMAT(A16, L2 ) + 9983 FORMAT( 1X,A16, ' WAS NOT TESTED' ) 9982 FORMAT( /' END OF TESTS' ) 9981 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' ) 9980 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' ) + 9979 FORMAT( ' Total time used = ', F12.2, ' seconds', / ) * * End of DBLAT2. * END + +* ===================================================================== SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, NBET, $ BET, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX, $ XS, Y, YY, YS, YT, G, IORDER ) + IMPLICIT NONE * * Tests DGEMV and DGBMV. * @@ -474,7 +498,7 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER INCMAX, NALF, NBET, NIDIM, NINC, NKB, NMAX, $ NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*16 SNAME * .. Array Arguments .. DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), BET( NBET ), G( NMAX ), @@ -485,6 +509,7 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ), INC( NINC ), KB( NKB ) * .. Local Scalars .. DOUBLE PRECISION ALPHA, ALS, BETA, BLS, ERR, ERRMAX, TRANSL + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, IC, IKU, IM, IN, INCX, INCXS, INCY, $ INCYS, IX, IY, KL, KLS, KU, KUS, LAA, LDA, $ LDAS, LX, LY, M, ML, MS, N, NARGS, NC, ND, NK, @@ -522,6 +547,8 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * DO 120 IN = 1, NIDIM N = IDIM( IN ) @@ -670,6 +697,8 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9993 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 130 END IF * @@ -723,6 +752,8 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 130 END IF * @@ -735,6 +766,9 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ INCY, YT, G, YY, EPS, ERR, $ FATAL, NOUT, .TRUE. ) ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -783,42 +817,53 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 140 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A16,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A16,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A16,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A16,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ',A12, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', + 9997 FORMAT( ' ',A16, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ',A12, ' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ',A12, '(', A14, ',', 4( I3, ',' ), F4.1, + 9996 FORMAT( ' ******* ',A16, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ',A16, '(', A14, ',', 4( I3, ',' ), F4.1, $ ', A,', I3, ',',/ 10x,'X,', I2, ',', F4.1, ', Y,', $ I2, ') .' ) - 9994 FORMAT( 1X, I6, ': ',A12, '(', A14, ',', 2( I3, ',' ), F4.1, + 9994 FORMAT( 1X, I6, ': ',A16, '(', A14, ',', 2( I3, ',' ), F4.1, $ ', A,', I3, ', X,', I2, ',', F4.1, ', Y,', I2, $ ') .' ) 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A16,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A16,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of DCHK1. * END + +* ===================================================================== SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, NBET, $ BET, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX, $ XS, Y, YY, YS, YT, G, IORDER ) + IMPLICIT NONE * -* Tests DSYMV, DSBMV and DSPMV. +* Tests DSYMV, DSBMV and DSPMV, DSKEWSYMV. * * Auxiliary routine for test program for Level 2 Blas. * @@ -834,7 +879,7 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER INCMAX, NALF, NBET, NIDIM, NINC, NKB, NMAX, $ NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*16 SNAME * .. Array Arguments .. DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), BET( NBET ), G( NMAX ), @@ -845,10 +890,12 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ), INC( NINC ), KB( NKB ) * .. Local Scalars .. DOUBLE PRECISION ALPHA, ALS, BETA, BLS, ERR, ERRMAX, TRANSL + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, IC, IK, IN, INCX, INCXS, INCY, $ INCYS, IX, IY, K, KS, LAA, LDA, LDAS, LX, LY, $ N, NARGS, NC, NK, NS - LOGICAL BANDED, FULL, NULL, PACKED, RESET, SAME + LOGICAL BANDED, FULL, NULL, PACKED, RESET, SAME, + $ SKEWFULL CHARACTER*1 UPLO, UPLOS CHARACTER*14 CUPLO CHARACTER*2 ICH @@ -858,7 +905,8 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, LOGICAL LDE, LDERES EXTERNAL LDE, LDERES * .. External Subroutines .. - EXTERNAL DMAKE, DMVCH, CDSBMV, CDSPMV, CDSYMV + EXTERNAL DMAKE, DMVCH, CDSBMV, CDSPMV, CDSYMV, + $ CDSKEWSYMV * .. Intrinsic Functions .. INTRINSIC ABS, MAX * .. Scalars in Common .. @@ -872,8 +920,9 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, FULL = SNAME( 9: 9 ).EQ.'y' BANDED = SNAME( 9: 9 ).EQ.'b' PACKED = SNAME( 9: 9 ).EQ.'p' + SKEWFULL = SNAME( 8: 11 ).EQ.'skew' * Define the number of arguments. - IF( FULL )THEN + IF( FULL.OR.SKEWFULL )THEN NARGS = 10 ELSE IF( BANDED )THEN NARGS = 11 @@ -884,6 +933,8 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * DO 110 IN = 1, NIDIM N = IDIM( IN ) @@ -995,6 +1046,15 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ REWIND NTRA CALL CDSYMV( IORDER, UPLO, N, ALPHA, AA, $ LDA, XX, INCX, BETA, YY, INCY ) + ELSE IF( SKEWFULL )THEN + IF( TRACE ) + $ WRITE( NTRA, FMT = 9993 )NC, SNAME, + $ CUPLO, N, ALPHA, LDA, INCX, BETA, INCY + IF( REWI ) + $ REWIND NTRA + CALL CDSKEWSYMV( IORDER, UPLO, N, ALPHA, + $ AA, LDA, XX, INCX, BETA, YY, + $ INCY ) ELSE IF( BANDED )THEN IF( TRACE ) $ WRITE( NTRA, FMT = 9994 )NC, SNAME, @@ -1020,6 +1080,8 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1027,7 +1089,7 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * ISAME( 1 ) = UPLO.EQ.UPLOS ISAME( 2 ) = NS.EQ.N - IF( FULL )THEN + IF( FULL.OR.SKEWFULL )THEN ISAME( 3 ) = ALS.EQ.ALPHA ISAME( 4 ) = LDE( AS, AA, LAA ) ISAME( 5 ) = LDAS.EQ.LDA @@ -1082,6 +1144,8 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1094,6 +1158,9 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ YY, EPS, ERR, FATAL, NOUT, $ .TRUE. ) ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -1142,40 +1209,51 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 130 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A16,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A16,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A16,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A16,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ',A12, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', + 9997 FORMAT( ' ',A16, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ',A12, ' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ',A12, '(', A14, ',', I3, ',', F4.1, ', AP', + 9996 FORMAT( ' ******* ',A16, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ',A16, '(', A14, ',', I3, ',', F4.1, ', AP', $ ', X,', I2, ',', F4.1, ', Y,', I2, ') .' ) - 9994 FORMAT( 1X, I6, ': ',A12, '(', A14, ',', 2( I3, ',' ), F4.1, + 9994 FORMAT( 1X, I6, ': ',A16, '(', A14, ',', 2( I3, ',' ), F4.1, $ ', A,', I3, ', X,', I2, ',', F4.1, ', Y,', I2, $ ') .' ) - 9993 FORMAT( 1X, I6, ': ',A12, '(', A14, ',', I3, ',', F4.1, ', A,', + 9993 FORMAT( 1X, I6, ': ',A16, '(', A14, ',', I3, ',', F4.1, ', A,', $ I3, ', X,', I2, ',', F4.1, ', Y,', I2, ') .' ) 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A16,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A16,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of DCHK2. * END + +* ===================================================================== SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NKB, KB, NINC, INC, NMAX, $ INCMAX, A, AA, AS, X, XX, XS, XT, G, Z, IORDER ) + IMPLICIT NONE * * Tests DTRMV, DTBMV, DTPMV, DTRSV, DTBSV and DTPSV. * @@ -1193,7 +1271,7 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER INCMAX, NIDIM, NINC, NKB, NMAX, NOUT, NTRA, $ IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*16 SNAME * .. Array Arguments .. DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), $ AS( NMAX*NMAX ), G( NMAX ), X( NMAX ), @@ -1202,6 +1280,7 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ), INC( NINC ), KB( NKB ) * .. Local Scalars .. DOUBLE PRECISION ERR, ERRMAX, TRANSL + INTEGER NTESTS, NFAILS INTEGER I, ICD, ICT, ICU, IK, IN, INCX, INCXS, IX, K, $ KS, LAA, LDA, LDAS, LX, N, NARGS, NC, NK, NS LOGICAL BANDED, FULL, NULL, PACKED, RESET, SAME @@ -1242,6 +1321,8 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * Set up zero vector for DMVCH. DO 10 I = 1, NMAX Z( I ) = ZERO @@ -1405,6 +1486,8 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1457,6 +1540,8 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1485,6 +1570,9 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ .FALSE. ) END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and return. IF( FATAL ) $ GO TO 120 @@ -1530,40 +1618,51 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 130 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A16,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A16,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A16,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A16,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ',A12, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', + 9997 FORMAT( ' ',A16, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ',A12, ' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ',A12, '(', 3( A14,',' ),/ 10x, I3, ', AP, ', + 9996 FORMAT( ' ******* ',A16, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ',A16, '(', 3( A14,',' ),/ 10x, I3, ', AP, ', $ 'X,', I2, ') .' ) - 9994 FORMAT( 1X, I6, ': ',A12, '(', 3( A14,',' ),/ 10x, 2( I3, ',' ), + 9994 FORMAT( 1X, I6, ': ',A16, '(', 3( A14,',' ),/ 10x, 2( I3, ',' ), $ ' A,', I3, ', X,', I2, ') .' ) - 9993 FORMAT( 1X, I6, ': ',A12, '(', 3( A14,',' ),/ 10x, I3, ', A,', + 9993 FORMAT( 1X, I6, ': ',A16, '(', 3( A14,',' ),/ 10x, I3, ', A,', $ I3, ', X,', I2, ') .' ) 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A16,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A16,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of DCHK3. * END + +* ===================================================================== SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX, $ INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G, $ Z, IORDER ) + IMPLICIT NONE * * Tests DGER. * @@ -1581,7 +1680,7 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER INCMAX, NALF, NIDIM, NINC, NMAX, NOUT, NTRA, $ IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*16 SNAME * .. Array Arguments .. DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), G( NMAX ), X( NMAX ), @@ -1591,6 +1690,7 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ), INC( NINC ) * .. Local Scalars .. DOUBLE PRECISION ALPHA, ALS, ERR, ERRMAX, TRANSL + INTEGER NTESTS, NFAILS INTEGER I, IA, IM, IN, INCX, INCXS, INCY, INCYS, IX, $ IY, J, LAA, LDA, LDAS, LX, LY, M, MS, N, NARGS, $ NC, ND, NS @@ -1602,7 +1702,7 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, LOGICAL LDE, LDERES EXTERNAL LDE, LDERES * .. External Subroutines .. - EXTERNAL DGER, DMAKE, DMVCH + EXTERNAL CDGER, DMAKE, DMVCH * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN * .. Scalars in Common .. @@ -1617,6 +1717,8 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * DO 120 IN = 1, NIDIM N = IDIM( IN ) @@ -1710,6 +1812,8 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9993 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 140 END IF * @@ -1740,6 +1844,8 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 140 END IF * @@ -1767,6 +1873,9 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ AA( 1 + ( J - 1 )*LDA ), EPS, $ ERR, FATAL, NOUT, .TRUE. ) ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and return. IF( FATAL ) $ GO TO 130 @@ -1805,37 +1914,48 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, WRITE( NOUT, FMT = 9994 )NC, SNAME, M, N, ALPHA, INCX, INCY, LDA * 150 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A16,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A16,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A16,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A16,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ',A12, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', + 9997 FORMAT( ' ',A16, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ',A12, ' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ',A16, ' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT( 1X, I6, ': ',A12, '(', 2( I3, ',' ), F4.1, ', X,', I2, + 9994 FORMAT( 1X, I6, ': ',A16, '(', 2( I3, ',' ), F4.1, ', X,', I2, $ ', Y,', I2, ', A,', I3, ') .' ) 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A16,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A16,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of DCHK4. * END + +* ===================================================================== SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX, $ INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G, $ Z, IORDER ) + IMPLICIT NONE * * Tests DSYR and DSPR. * @@ -1853,7 +1973,7 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER INCMAX, NALF, NIDIM, NINC, NMAX, NOUT, NTRA, $ IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*16 SNAME * .. Array Arguments .. DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), G( NMAX ), X( NMAX ), @@ -1863,6 +1983,7 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ), INC( NINC ) * .. Local Scalars .. DOUBLE PRECISION ALPHA, ALS, ERR, ERRMAX, TRANSL + INTEGER NTESTS, NFAILS INTEGER I, IA, IC, IN, INCX, INCXS, IX, J, JA, JJ, LAA, $ LDA, LDAS, LJ, LX, N, NARGS, NC, NS LOGICAL FULL, NULL, PACKED, RESET, SAME, UPPER @@ -1899,6 +2020,8 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * DO 100 IN = 1, NIDIM N = IDIM( IN ) @@ -1988,6 +2111,8 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -2018,6 +2143,8 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 30 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -2058,6 +2185,9 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, JA = JA + LJ END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and return. IF( FATAL ) $ GO TO 110 @@ -2099,41 +2229,52 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 130 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A16,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A16,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A16,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A16,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ',A12, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', + 9997 FORMAT( ' ',A16, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ',A12, ' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ',A16, ' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT( 1X, I6, ': ',A12, '(', A14, ',', I3, ',', F4.1, ', X,', + 9994 FORMAT( 1X, I6, ': ',A16, '(', A14, ',', I3, ',', F4.1, ', X,', $ I2, ', AP) .' ) - 9993 FORMAT( 1X, I6, ': ',A12, '(', A14, ',', I3, ',', F4.1, ', X,', + 9993 FORMAT( 1X, I6, ': ',A16, '(', A14, ',', I3, ',', F4.1, ', X,', $ I2, ', A,', I3, ') .' ) 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A16,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A16,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of DCHK5. * END + +* ===================================================================== SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX, $ INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G, $ Z, IORDER ) + IMPLICIT NONE * -* Tests DSYR2 and DSPR2. +* Tests DSYR2 and DSPR2, DSKEWSYR2. * * Auxiliary routine for test program for Level 2 Blas. * @@ -2149,7 +2290,7 @@ SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER INCMAX, NALF, NIDIM, NINC, NMAX, NOUT, NTRA, $ IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*16 SNAME * .. Array Arguments .. DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), G( NMAX ), X( NMAX ), @@ -2159,10 +2300,12 @@ SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ), INC( NINC ) * .. Local Scalars .. DOUBLE PRECISION ALPHA, ALS, ERR, ERRMAX, TRANSL + INTEGER NTESTS, NFAILS INTEGER I, IA, IC, IN, INCX, INCXS, INCY, INCYS, IX, $ IY, J, JA, JJ, LAA, LDA, LDAS, LJ, LX, LY, N, $ NARGS, NC, NS - LOGICAL FULL, NULL, PACKED, RESET, SAME, UPPER + LOGICAL FULL, NULL, PACKED, RESET, SAME, UPPER, + $ SKEWFULL CHARACTER*1 UPLO, UPLOS CHARACTER*14 CUPLO CHARACTER*2 ICH @@ -2173,7 +2316,7 @@ SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, LOGICAL LDE, LDERES EXTERNAL LDE, LDERES * .. External Subroutines .. - EXTERNAL DMAKE, DMVCH, CDSPR2, CDSYR2 + EXTERNAL DMAKE, DMVCH, CDSPR2, CDSYR2, CDSKEWSYR2 * .. Intrinsic Functions .. INTRINSIC ABS, MAX * .. Scalars in Common .. @@ -2186,8 +2329,9 @@ SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Executable Statements .. FULL = SNAME( 9: 9 ).EQ.'y' PACKED = SNAME( 9: 9 ).EQ.'p' + SKEWFULL = SNAME( 8: 11 ).EQ.'skew' * Define the number of arguments. - IF( FULL )THEN + IF( FULL.OR.SKEWFULL )THEN NARGS = 9 ELSE IF( PACKED )THEN NARGS = 8 @@ -2196,6 +2340,8 @@ SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * DO 140 IN = 1, NIDIM N = IDIM( IN ) @@ -2290,6 +2436,14 @@ SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ REWIND NTRA CALL CDSYR2( IORDER, UPLO, N, ALPHA, XX, INCX, $ YY, INCY, AA, LDA ) + ELSE IF( SKEWFULL )THEN + IF( TRACE ) + $ WRITE( NTRA, FMT = 9993 )NC, SNAME, CUPLO, N, + $ ALPHA, INCX, INCY, LDA + IF( REWI ) + $ REWIND NTRA + CALL CDSKEWSYR2( IORDER, UPLO, N, ALPHA, XX, + $ INCX, YY, INCY, AA, LDA ) ELSE IF( PACKED )THEN IF( TRACE ) $ WRITE( NTRA, FMT = 9994 )NC, SNAME, CUPLO, N, @@ -2305,6 +2459,8 @@ SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 160 END IF * @@ -2337,6 +2493,8 @@ SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 160 END IF * @@ -2362,22 +2520,36 @@ SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, Z( I, 2 ) = Y( N - I + 1 ) 80 CONTINUE END IF - JA = 1 + IF( .NOT.SKEWFULL.OR.UPPER )THEN + JA = 1 + ELSE + JA = 2 + END IF DO 90 J = 1, N + IF( .NOT.SKEWFULL )THEN W( 1 ) = Z( J, 2 ) + ELSE + W( 1 ) = -Z( J, 2 ) + END IF W( 2 ) = Z( J, 1 ) - IF( UPPER )THEN + IF( .NOT.SKEWFULL.AND.UPPER )THEN JJ = 1 LJ = J - ELSE + ELSE IF( .NOT.SKEWFULL.AND..NOT.UPPER )THEN JJ = J LJ = N - J + 1 + ELSE IF( SKEWFULL.AND.UPPER )THEN + JJ = 1 + LJ = J - 1 + ELSE + JJ = J + 1 + LJ = N - J END IF CALL DMVCH( 'N', LJ, 2, ALPHA, Z( JJ, 1 ), $ NMAX, W, 1, ONE, A( JJ, J ), 1, $ YT, G, AA( JA ), EPS, ERR, FATAL, $ NOUT, .TRUE. ) - IF( FULL )THEN + IF( FULL.OR.SKEWFULL )THEN IF( UPPER )THEN JA = JA + LDA ELSE @@ -2387,6 +2559,9 @@ SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, JA = JA + LJ END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and return. IF( FATAL ) $ GO TO 150 @@ -2423,7 +2598,7 @@ SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * 160 CONTINUE WRITE( NOUT, FMT = 9996 )SNAME - IF( FULL )THEN + IF( FULL.OR.SKEWFULL )THEN WRITE( NOUT, FMT = 9993 )NC, SNAME, CUPLO, N, ALPHA, INCX, $ INCY, LDA ELSE IF( PACKED )THEN @@ -2431,44 +2606,55 @@ SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 170 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A16,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A16,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A16,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A16,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ',A12, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', + 9997 FORMAT( ' ',A16, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ',A12, ' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ',A16, ' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT( 1X, I6, ': ',A12, '(', A14, ',', I3, ',', F4.1, ', X,', + 9994 FORMAT( 1X, I6, ': ',A16, '(', A14, ',', I3, ',', F4.1, ', X,', $ I2, ', Y,', I2, ', AP) .' ) - 9993 FORMAT( 1X, I6, ': ',A12, '(', A14, ',', I3, ',', F4.1, ', X,', + 9993 FORMAT( 1X, I6, ': ',A16, '(', A14, ',', I3, ',', F4.1, ', X,', $ I2, ', Y,', I2, ', A,', I3, ') .' ) 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A16,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A16,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of DCHK6. * END + +* ===================================================================== SUBROUTINE DMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, $ KU, RESET, TRANSL ) + IMPLICIT NONE * * Generates values for an M by N matrix A within the bandwidth * defined by KL and KU. * Stores the values in the array AA in the data structure required * by the routine, with unwanted elements set to rogue value. * -* TYPE is 'ge', 'gb', 'sy', 'sb', 'sp', 'tr', 'tb' OR 'tp'. +* TYPE is 'ge', 'gb', 'sy', 'sb', 'sp', 'skewsy', 'tr', 'tb' OR 'tp'. * * Auxiliary routine for test program for Level 2 Blas. * @@ -2491,7 +2677,7 @@ SUBROUTINE DMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, DOUBLE PRECISION A( NMAX, * ), AA( * ) * .. Local Scalars .. INTEGER I, I1, I2, I3, IBEG, IEND, IOFF, J, KK - LOGICAL GEN, LOWER, SYM, TRI, UNIT, UPPER + LOGICAL GEN, LOWER, SYM, TRI, UNIT, UPPER, SKEW * .. External Functions .. DOUBLE PRECISION DBEG EXTERNAL DBEG @@ -2499,10 +2685,11 @@ SUBROUTINE DMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, INTRINSIC MAX, MIN * .. Executable Statements .. GEN = TYPE( 1: 1 ).EQ.'g' - SYM = TYPE( 1: 1 ).EQ.'s' + SYM = TYPE( 1: 1 ).EQ.'s'.AND.TYPE( 2: 2 ).NE.'k' + SKEW = TYPE( 1: 1 ).EQ.'s'.AND.TYPE( 2: 2 ).EQ.'k' TRI = TYPE( 1: 1 ).EQ.'t' - UPPER = ( SYM.OR.TRI ).AND.UPLO.EQ.'U' - LOWER = ( SYM.OR.TRI ).AND.UPLO.EQ.'L' + UPPER = ( SYM.OR.SKEW.OR.TRI ).AND.UPLO.EQ.'U' + LOWER = ( SYM.OR.SKEW.OR.TRI ).AND.UPLO.EQ.'L' UNIT = TRI.AND.DIAG.EQ.'U' * * Generate data in array A. @@ -2520,6 +2707,8 @@ SUBROUTINE DMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, IF( I.NE.J )THEN IF( SYM )THEN A( J, I ) = A( I, J ) + ELSE IF( SKEW )THEN + A( J, I ) = -A( I, J ) ELSE IF( TRI )THEN A( J, I ) = ZERO END IF @@ -2530,6 +2719,8 @@ SUBROUTINE DMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, $ A( J, J ) = A( J, J ) + ONE IF( UNIT ) $ A( J, J ) = ONE + IF( SKEW ) + $ A( J, J ) = ZERO 20 CONTINUE * * Store elements in array AS in data structure required by routine. @@ -2555,17 +2746,17 @@ SUBROUTINE DMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, AA( I3 + ( J - 1 )*LDA ) = ROGUE 80 CONTINUE 90 CONTINUE - ELSE IF( TYPE.EQ.'sy'.OR.TYPE.EQ.'tr' )THEN + ELSE IF( TYPE.EQ.'sy'.OR.TYPE.EQ.'sk'.OR.TYPE.EQ.'tr' )THEN DO 130 J = 1, N IF( UPPER )THEN IBEG = 1 - IF( UNIT )THEN + IF( UNIT.OR.SKEW )THEN IEND = J - 1 ELSE IEND = J END IF ELSE - IF( UNIT )THEN + IF( UNIT.OR.SKEW )THEN IBEG = J + 1 ELSE IBEG = J @@ -2636,8 +2827,11 @@ SUBROUTINE DMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, * End of DMAKE. * END + +* ===================================================================== SUBROUTINE DMVCH( TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y, $ INCY, YT, G, YY, EPS, ERR, FATAL, NOUT, MV ) + IMPLICIT NONE * * Checks the results of the computational tests. * @@ -2753,7 +2947,10 @@ SUBROUTINE DMVCH( TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y, * End of DMVCH. * END + +* ===================================================================== LOGICAL FUNCTION LDE( RI, RJ, LR ) + IMPLICIT NONE * * Tests if two arrays are identical. * @@ -2783,7 +2980,10 @@ LOGICAL FUNCTION LDE( RI, RJ, LR ) * End of LDE. * END + +* ===================================================================== LOGICAL FUNCTION LDERES( TYPE, UPLO, M, N, AA, AS, LDA ) + IMPLICIT NONE * * Tests if selected elements in two arrays are equal. * @@ -2813,14 +3013,20 @@ LOGICAL FUNCTION LDERES( TYPE, UPLO, M, N, AA, AS, LDA ) $ GO TO 70 10 CONTINUE 20 CONTINUE - ELSE IF( TYPE.EQ.'sy' )THEN + ELSE IF( TYPE.EQ.'sy'.OR.TYPE.EQ.'sk' )THEN DO 50 J = 1, N - IF( UPPER )THEN + IF( UPPER.AND.TYPE.EQ.'sy' )THEN IBEG = 1 IEND = J - ELSE + ELSE IF( .NOT.UPPER.AND.TYPE.EQ.'sy' )THEN IBEG = J IEND = N + ELSE IF( UPPER.AND.TYPE.EQ.'sk' )THEN + IBEG = 1 + IEND = J - 1 + ELSE + IBEG = J + 1 + IEND = N END IF DO 30 I = 1, IBEG - 1 IF( AA( I, J ).NE.AS( I, J ) ) @@ -2843,7 +3049,10 @@ LOGICAL FUNCTION LDERES( TYPE, UPLO, M, N, AA, AS, LDA ) * End of LDERES. * END + +* ===================================================================== DOUBLE PRECISION FUNCTION DBEG( RESET ) + IMPLICIT NONE * * Generates random numbers uniformly distributed between -0.5 and 0.5. * @@ -2889,7 +3098,10 @@ DOUBLE PRECISION FUNCTION DBEG( RESET ) * End of DBEG. * END + +* ===================================================================== DOUBLE PRECISION FUNCTION DDIFF( X, Y ) + IMPLICIT NONE * * Auxiliary routine for test program for Level 2 Blas. * diff --git a/CBLAS/testing/c_dblat3.f b/CBLAS/testing/c_dblat3.f index 72ad80c925..87a6f69b92 100644 --- a/CBLAS/testing/c_dblat3.f +++ b/CBLAS/testing/c_dblat3.f @@ -1,10 +1,12 @@ +* ===================================================================== PROGRAM DBLAT3 + IMPLICIT NONE * * Test program for the DOUBLE PRECISION Level 3 Blas. * * The program must be driven by a short data file. The first 13 records -* of the file are read using list-directed input, the last 6 records -* are read using the format ( A12, L2 ). An annotated example of a data +* of the file are read using list-directed input, the last 8 records +* are read using the format ( A17, L2 ). An annotated example of a data * file can be obtained by deleting the first 3 characters from the * following 19 lines: * 'DBLAT3.SNAP' NAME OF SNAPSHOT OUTPUT FILE @@ -20,12 +22,15 @@ PROGRAM DBLAT3 * 0.0 1.0 0.7 VALUES OF ALPHA * 3 NUMBER OF VALUES OF BETA * 0.0 1.0 1.3 VALUES OF BETA -* cblas_dgemm T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_dsymm T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_dtrmm T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_dtrsm T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_dsyrk T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_dsyr2k T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dgemm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dsymm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dskewsymm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dtrmm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dtrsm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dsyrk T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dsyr2k T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dskewsyr2k T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dgemmtr T PUT F FOR NO TEST. SAME COLUMNS. * * See: * @@ -46,7 +51,7 @@ PROGRAM DBLAT3 INTEGER NIN, NOUT PARAMETER ( NIN = 5, NOUT = 6 ) INTEGER NSUBS - PARAMETER ( NSUBS = 6 ) + PARAMETER ( NSUBS = 9 ) DOUBLE PRECISION ZERO, HALF, ONE PARAMETER ( ZERO = 0.0D0, HALF = 0.5D0, ONE = 1.0D0 ) INTEGER NMAX @@ -54,13 +59,14 @@ PROGRAM DBLAT3 INTEGER NIDMAX, NALMAX, NBEMAX PARAMETER ( NIDMAX = 9, NALMAX = 7, NBEMAX = 7 ) * .. Local Scalars .. + DOUBLE PRECISION S1, S2 DOUBLE PRECISION EPS, ERR, THRESH INTEGER I, ISNUM, J, N, NALF, NBET, NIDIM, NTRA, - $ LAYOUT + $ LAYOUT LOGICAL FATAL, LTESTT, REWI, SAME, SFATAL, TRACE, $ TSTERR, CORDER, RORDER CHARACTER*1 TRANSA, TRANSB - CHARACTER*12 SNAMET + CHARACTER*17 SNAMET CHARACTER*32 SNAPS * .. Local Arrays .. DOUBLE PRECISION AA( NMAX*NMAX ), AB( NMAX, 2*NMAX ), @@ -71,28 +77,35 @@ PROGRAM DBLAT3 $ G( NMAX ), W( 2*NMAX ) INTEGER IDIM( NIDMAX ) LOGICAL LTEST( NSUBS ) - CHARACTER*12 SNAMES( NSUBS ) + CHARACTER*17 SNAMES( NSUBS ) * .. External Functions .. DOUBLE PRECISION DDIFF LOGICAL LDE EXTERNAL DDIFF, LDE * .. External Subroutines .. EXTERNAL DCHK1, DCHK2, DCHK3, DCHK4, DCHK5, CD3CHKE, - $ DMMCH + $ DMMCH * .. Intrinsic Functions .. INTRINSIC MAX, MIN * .. Scalars in Common .. INTEGER INFOT, NOUTC - LOGICAL OK - CHARACTER*12 SRNAMT + LOGICAL LERR, OK + CHARACTER*17 SRNAMT * .. Common blocks .. - COMMON /INFOC/INFOT, NOUTC, OK + COMMON /INFOC/INFOT, NOUTC, OK, LERR COMMON /SRNAMC/SRNAMT * .. Data statements .. - DATA SNAMES/'cblas_dgemm ', 'cblas_dsymm ', - $ 'cblas_dtrmm ', 'cblas_dtrsm ','cblas_dsyrk ', - $ 'cblas_dsyr2k'/ + DATA SNAMES/'cblas_dgemm ', + $ 'cblas_dsymm ', + $ 'cblas_dtrmm ', + $ 'cblas_dtrsm ', + $ 'cblas_dsyrk ', + $ 'cblas_dsyr2k ', + $ 'cblas_dgemmtr ', + $ 'cblas_dskewsymm ', + $ 'cblas_dskewsyr2k '/ * .. Executable Statements .. + CALL CPU_TIME( S1 ) * * Read name and unit number for summary output file and open file. * @@ -289,7 +302,7 @@ PROGRAM DBLAT3 INFOT = 0 OK = .TRUE. FATAL = .FALSE. - GO TO ( 140, 150, 160, 160, 170, 180 )ISNUM + GO TO ( 140, 150, 160, 160, 170, 180, 185, 150, 180 )ISNUM * Test DGEMM, 01. 140 IF (CORDER) THEN CALL DCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, @@ -304,7 +317,7 @@ PROGRAM DBLAT3 $ CC, CS, CT, G, 1 ) END IF GO TO 190 -* Test DSYMM, 02. +* Test DSYMM, 02 and DSKEWSYMM, 08. 150 IF (CORDER) THEN CALL DCHK2( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, @@ -323,13 +336,13 @@ PROGRAM DBLAT3 CALL DCHK3( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NMAX, AB, $ AA, AS, AB( 1, NMAX + 1 ), BB, BS, CT, G, C, - $ 0 ) + $ 0 ) END IF IF (RORDER) THEN CALL DCHK3( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NMAX, AB, $ AA, AS, AB( 1, NMAX + 1 ), BB, BS, CT, G, C, - $ 1 ) + $ 1 ) END IF GO TO 190 * Test DSYRK, 05. @@ -346,20 +359,35 @@ PROGRAM DBLAT3 $ CC, CS, CT, G, 1 ) END IF GO TO 190 -* Test DSYR2K, 06. +* Test DSYR2K, 06 and DSKEWSYR2K, 09. 180 IF (CORDER) THEN CALL DCHK5( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W, - $ 0 ) + $ 0 ) END IF IF (RORDER) THEN CALL DCHK5( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W, - $ 1 ) + $ 1 ) END IF GO TO 190 +* Test DGEMMTR, 07. + 185 IF (CORDER) THEN + CALL DCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, + $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, + $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, + $ CC, CS, CT, G, 0 ) + END IF + IF (RORDER) THEN + CALL DCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, + $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, + $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, + $ CC, CS, CT, G, 1 ) + END IF + GO TO 190 + * 190 IF( FATAL.AND.SFATAL ) $ GO TO 210 @@ -378,6 +406,8 @@ PROGRAM DBLAT3 230 CONTINUE IF( TRACE ) $ CLOSE ( NTRA ) + CALL CPU_TIME( S2 ) + WRITE( NOUT, FMT = 9983 )S2 - S1 CLOSE ( NOUT ) STOP * @@ -397,7 +427,7 @@ PROGRAM DBLAT3 9992 FORMAT( ' FOR BETA ', 7F6.1 ) 9991 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM', $ /' ******* TESTS ABANDONED *******' ) - 9990 FORMAT( ' SUBPROGRAM NAME ', A12,' NOT RECOGNIZED', /' ******* T', + 9990 FORMAT( ' SUBPROGRAM NAME ', A17,' NOT RECOGNIZED', /' ******* T', $ 'ESTS ABANDONED *******' ) 9989 FORMAT( ' ERROR IN DMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALU', $ 'ATED WRONGLY.', /' DMMCH WAS CALLED WITH TRANSA = ', A1, @@ -405,18 +435,22 @@ PROGRAM DBLAT3 $ 'ERR = ', F12.3, '.', /' THIS MAY BE DUE TO FAULTS IN THE ', $ 'ARITHMETIC OR THE COMPILER.', /' ******* TESTS ABANDONED ', $ '*******' ) - 9988 FORMAT( A12,L2 ) - 9987 FORMAT( 1X, A12,' WAS NOT TESTED' ) + 9988 FORMAT( A17,L2 ) + 9987 FORMAT( 1X, A17,' WAS NOT TESTED' ) 9986 FORMAT( /' END OF TESTS' ) 9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' ) 9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' ) + 9983 FORMAT( ' Total time used = ', F12.2, ' seconds', / ) * * End of DBLAT3. * END + +* ===================================================================== SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G, IORDER) + IMPLICIT NONE * * Tests DGEMM. * @@ -435,7 +469,7 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*17 SNAME * .. Array Arguments .. DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -445,6 +479,7 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ) * .. Local Scalars .. DOUBLE PRECISION ALPHA, ALS, BETA, BLS, ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, ICA, ICB, IK, IM, IN, K, KS, LAA, $ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, M, $ MA, MB, MS, N, NA, NARGS, NB, NC, NS @@ -462,9 +497,9 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTRINSIC MAX * .. Scalars in Common .. INTEGER INFOT, NOUTC - LOGICAL OK + LOGICAL LERR, OK * .. Common blocks .. - COMMON /INFOC/INFOT, NOUTC, OK + COMMON /INFOC/INFOT, NOUTC, OK, LERR * .. Data statements .. DATA ICH/'NTC'/ * .. Executable Statements .. @@ -473,6 +508,8 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * DO 110 IM = 1, NIDIM M = IDIM( IM ) @@ -588,13 +625,15 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ REWIND NTRA CALL CDGEMM( IORDER, TRANSA, TRANSB, M, N, $ K, ALPHA, AA, LDA, BB, LDB, - $ BETA, CC, LDC ) + $ BETA, CC, LDC ) * * Check if error-exit was taken incorrectly. * IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9994 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -630,6 +669,8 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -642,6 +683,9 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ C, NMAX, CT, G, CC, LDC, EPS, $ ERR, FATAL, NOUT, .TRUE. ) ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -679,36 +723,48 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ M, N, K, ALPHA, LDA, LDB, BETA, LDC) * 130 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A17,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A17,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A17,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A17,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A12,'(''', A1, ''',''', A1, ''',', + 9996 FORMAT( ' ******* ', A17,' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A17,'(''', A1, ''',''', A1, ''',', $ 3( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', ', $ 'C,', I3, ').' ) 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A17,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A17,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of DCHK1. * END + +* ===================================================================== SUBROUTINE DPRCN1(NOUT, NC, SNAME, IORDER, TRANSA, TRANSB, M, N, $ K, ALPHA, LDA, LDB, BETA, LDC) + IMPLICIT NONE + INTEGER NOUT, NC, IORDER, M, N, K, LDA, LDB, LDC DOUBLE PRECISION ALPHA, BETA CHARACTER*1 TRANSA, TRANSB - CHARACTER*12 SNAME + CHARACTER*17 SNAME CHARACTER*14 CRC, CTA,CTB IF (TRANSA.EQ.'N')THEN @@ -733,14 +789,16 @@ SUBROUTINE DPRCN1(NOUT, NC, SNAME, IORDER, TRANSA, TRANSB, M, N, WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CTA,CTB WRITE(NOUT, FMT = 9994)M, N, K, ALPHA, LDA, LDB, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',') + 9995 FORMAT( 1X, I6, ': ', A17,'(', A14, ',', A14, ',', A14, ',') 9994 FORMAT( 20X, 3( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', $ F4.1, ', ', 'C,', I3, ').' ) END -* + +* ===================================================================== SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G, IORDER) + IMPLICIT NONE * * Tests DSYMM. * @@ -759,7 +817,7 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*17 SNAME * .. Array Arguments .. DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -769,10 +827,11 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ) * .. Local Scalars .. DOUBLE PRECISION ALPHA, ALS, BETA, BLS, ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, ICS, ICU, IM, IN, LAA, LBB, LCC, $ LDA, LDAS, LDB, LDBS, LDC, LDCS, M, MS, N, NA, $ NARGS, NC, NS - LOGICAL LEFT, NULL, RESET, SAME + LOGICAL LEFT, NULL, RESET, SAME, SKEWFULL CHARACTER*1 SIDE, SIDES, UPLO, UPLOS CHARACTER*2 ICHS, ICHU * .. Local Arrays .. @@ -781,22 +840,25 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, LOGICAL LDE, LDERES EXTERNAL LDE, LDERES * .. External Subroutines .. - EXTERNAL DMAKE, DMMCH, CDSYMM + EXTERNAL DMAKE, DMMCH, CDSYMM, CDSKEWSYMM * .. Intrinsic Functions .. INTRINSIC MAX * .. Scalars in Common .. INTEGER INFOT, NOUTC - LOGICAL OK + LOGICAL LERR, OK * .. Common blocks .. - COMMON /INFOC/INFOT, NOUTC, OK + COMMON /INFOC/INFOT, NOUTC, OK, LERR * .. Data statements .. DATA ICHS/'LR'/, ICHU/'UL'/ * .. Executable Statements .. * + SKEWFULL = SNAME( 8: 11 ).EQ.'skew' NARGS = 12 NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * DO 100 IM = 1, NIDIM M = IDIM( IM ) @@ -850,8 +912,13 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * * Generate the symmetric matrix A. * - CALL DMAKE( 'SY', UPLO, ' ', NA, NA, A, NMAX, AA, LDA, - $ RESET, ZERO ) + IF(.NOT.SKEWFULL) THEN + CALL DMAKE( 'SY', UPLO, ' ', NA, NA, A, NMAX, + $ AA, LDA, RESET, ZERO ) + ELSE + CALL DMAKE( 'SK', UPLO, ' ', NA, NA, A, NMAX, + $ AA, LDA, RESET, ZERO ) + END IF * DO 60 IA = 1, NALF ALPHA = ALF( IA ) @@ -896,14 +963,23 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ BETA, LDC) IF( REWI ) $ REWIND NTRA - CALL CDSYMM( IORDER, SIDE, UPLO, M, N, ALPHA, - $ AA, LDA, BB, LDB, BETA, CC, LDC ) + IF(.NOT.SKEWFULL) THEN + CALL CDSYMM( IORDER, SIDE, UPLO, M, N, + $ ALPHA, AA, LDA, BB, LDB, BETA, CC, + $ LDC ) + ELSE + CALL CDSKEWSYMM( IORDER, SIDE, UPLO, M, N, + $ ALPHA, AA, LDA, BB, LDB, BETA, CC, + $ LDC ) + END IF * * Check if error-exit was taken incorrectly. * IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9994 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 110 END IF * @@ -938,6 +1014,8 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 110 END IF * @@ -957,6 +1035,9 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NOUT, .TRUE. ) END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -992,37 +1073,48 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ LDB, BETA, LDC) * 120 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A17,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A17,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A17,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A17,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9996 FORMAT( ' ******* ', A17,' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A17,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', C,', I3, ') ', $ ' .' ) 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A17,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A17,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of DCHK2. * END -* + +* ===================================================================== SUBROUTINE DPRCN2(NOUT, NC, SNAME, IORDER, SIDE, UPLO, M, N, $ ALPHA, LDA, LDB, BETA, LDC) + IMPLICIT NONE + INTEGER NOUT, NC, IORDER, M, N, LDA, LDB, LDC DOUBLE PRECISION ALPHA, BETA CHARACTER*1 SIDE, UPLO - CHARACTER*12 SNAME + CHARACTER*17 SNAME CHARACTER*14 CRC, CS,CU IF (SIDE.EQ.'L')THEN @@ -1043,14 +1135,16 @@ SUBROUTINE DPRCN2(NOUT, NC, SNAME, IORDER, SIDE, UPLO, M, N, WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CS,CU WRITE(NOUT, FMT = 9994)M, N, ALPHA, LDA, LDB, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',') + 9995 FORMAT( 1X, I6, ': ', A17,'(', A14, ',', A14, ',', A14, ',') 9994 FORMAT( 20X, 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', $ F4.1, ', ', 'C,', I3, ').' ) END -* + +* ===================================================================== SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NMAX, A, AA, AS, $ B, BB, BS, CT, G, C, IORDER ) + IMPLICIT NONE * * Tests DTRMM and DTRSM. * @@ -1069,7 +1163,7 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*17 SNAME * .. Array Arguments .. DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -1078,6 +1172,7 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ) * .. Local Scalars .. DOUBLE PRECISION ALPHA, ALS, ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, ICD, ICS, ICT, ICU, IM, IN, J, LAA, LBB, $ LDA, LDAS, LDB, LDBS, M, MS, N, NA, NARGS, NC, $ NS @@ -1097,9 +1192,9 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTRINSIC MAX * .. Scalars in Common .. INTEGER INFOT, NOUTC - LOGICAL OK + LOGICAL LERR, OK * .. Common blocks .. - COMMON /INFOC/INFOT, NOUTC, OK + COMMON /INFOC/INFOT, NOUTC, OK, LERR * .. Data statements .. DATA ICHU/'UL'/, ICHT/'NTC'/, ICHD/'UN'/, ICHS/'LR'/ * .. Executable Statements .. @@ -1108,6 +1203,8 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * Set up zero matrix for DMMCH. DO 20 J = 1, NMAX DO 10 I = 1, NMAX @@ -1201,7 +1298,7 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ REWIND NTRA CALL CDTRMM( IORDER, SIDE, UPLO, TRANSA, $ DIAG, M, N, ALPHA, AA, LDA, - $ BB, LDB ) + $ BB, LDB ) ELSE IF( SNAME( 10: 11 ).EQ.'sm' )THEN IF( TRACE ) $ CALL DPRCN3( NTRA, NC, SNAME, IORDER, @@ -1211,7 +1308,7 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ REWIND NTRA CALL CDTRSM( IORDER, SIDE, UPLO, TRANSA, $ DIAG, M, N, ALPHA, AA, LDA, - $ BB, LDB ) + $ BB, LDB ) END IF * * Check if error-exit was taken incorrectly. @@ -1219,6 +1316,8 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9994 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 150 END IF * @@ -1252,6 +1351,8 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 50 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 150 END IF * @@ -1302,6 +1403,9 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -1340,36 +1444,47 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ M, N, ALPHA, LDA, LDB) * 160 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A17,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A17,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A17,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A17,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A12,'(', 4( '''', A1, ''',' ), 2( I3, ',' ), + 9996 FORMAT( ' ******* ', A17,' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A17,'(', 4( '''', A1, ''',' ), 2( I3, ',' ), $ F4.1, ', A,', I3, ', B,', I3, ') .' ) 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A17,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A17,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of DCHK3. * END -* + +* ===================================================================== SUBROUTINE DPRCN3(NOUT, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, $ DIAG, M, N, ALPHA, LDA, LDB) + IMPLICIT NONE + INTEGER NOUT, NC, IORDER, M, N, LDA, LDB DOUBLE PRECISION ALPHA CHARACTER*1 SIDE, UPLO, TRANSA, DIAG - CHARACTER*12 SNAME + CHARACTER*17 SNAME CHARACTER*14 CRC, CS, CU, CA, CD IF (SIDE.EQ.'L')THEN @@ -1402,14 +1517,16 @@ SUBROUTINE DPRCN3(NOUT, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CS,CU WRITE(NOUT, FMT = 9994)CA, CD, M, N, ALPHA, LDA, LDB - 9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',') + 9995 FORMAT( 1X, I6, ': ', A17,'(', A14, ',', A14, ',', A14, ',') 9994 FORMAT( 22X, 2( A14, ',') , 2( I3, ',' ), $ F4.1, ', A,', I3, ', B,', I3, ').' ) END -* + +* ===================================================================== SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G, IORDER) + IMPLICIT NONE * * Tests DSYRK. * @@ -1428,7 +1545,7 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*17 SNAME * .. Array Arguments .. DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -1438,6 +1555,7 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ) * .. Local Scalars .. DOUBLE PRECISION ALPHA, ALS, BETA, BETS, ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, K, KS, $ LAA, LCC, LDA, LDAS, LDC, LDCS, LJ, MA, N, NA, $ NARGS, NC, NS @@ -1456,9 +1574,9 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTRINSIC MAX * .. Scalars in Common .. INTEGER INFOT, NOUTC - LOGICAL OK + LOGICAL LERR, OK * .. Common blocks .. - COMMON /INFOC/INFOT, NOUTC, OK + COMMON /INFOC/INFOT, NOUTC, OK, LERR * .. Data statements .. DATA ICHT/'NTC'/, ICHU/'UL'/ * .. Executable Statements .. @@ -1467,6 +1585,8 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * DO 100 IN = 1, NIDIM N = IDIM( IN ) @@ -1556,6 +1676,8 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9993 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1588,6 +1710,8 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 30 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1625,6 +1749,9 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, JC = JC + LDC + 1 END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -1665,37 +1792,48 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ LDA, BETA, LDC) * 130 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A17,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A17,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A17,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A17,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ', A17,' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT( 1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9994 FORMAT( 1X, I6, ': ', A17,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ') .' ) 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A17,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A17,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of DCHK4. * END -* + +* ===================================================================== SUBROUTINE DPRCN4(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, $ N, K, ALPHA, LDA, BETA, LDC) + IMPLICIT NONE + INTEGER NOUT, NC, IORDER, N, K, LDA, LDC DOUBLE PRECISION ALPHA, BETA CHARACTER*1 UPLO, TRANSA - CHARACTER*12 SNAME + CHARACTER*17 SNAME CHARACTER*14 CRC, CU, CA IF (UPLO.EQ.'U')THEN @@ -1718,15 +1856,17 @@ SUBROUTINE DPRCN4(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') ) + 9995 FORMAT( 1X, I6, ': ', A17,'(', 3( A14, ',') ) 9994 FORMAT( 20X, 2( I3, ',' ), $ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ').' ) END -* + +* ===================================================================== SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, $ AB, AA, AS, BB, BS, C, CC, CS, CT, G, W, - $ IORDER ) + $ IORDER ) + IMPLICIT NONE * * Tests DSYR2K. * @@ -1745,7 +1885,7 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*17 SNAME * .. Array Arguments .. DOUBLE PRECISION AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ), $ ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ), @@ -1755,10 +1895,11 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTEGER IDIM( NIDIM ) * .. Local Scalars .. DOUBLE PRECISION ALPHA, ALS, BETA, BETS, ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, JJAB, $ K, KS, LAA, LBB, LCC, LDA, LDAS, LDB, LDBS, $ LDC, LDCS, LJ, MA, N, NA, NARGS, NC, NS - LOGICAL NULL, RESET, SAME, TRAN, UPPER + LOGICAL NULL, RESET, SAME, TRAN, UPPER, SKEWFULL CHARACTER*1 TRANS, TRANSS, UPLO, UPLOS CHARACTER*2 ICHU CHARACTER*3 ICHT @@ -1768,22 +1909,25 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, LOGICAL LDE, LDERES EXTERNAL LDE, LDERES * .. External Subroutines .. - EXTERNAL DMAKE, DMMCH, CDSYR2K + EXTERNAL DMAKE, DMMCH, CDSYR2K, CDSKEWSYR2K * .. Intrinsic Functions .. INTRINSIC MAX * .. Scalars in Common .. INTEGER INFOT, NOUTC - LOGICAL OK + LOGICAL LERR, OK * .. Common blocks .. - COMMON /INFOC/INFOT, NOUTC, OK + COMMON /INFOC/INFOT, NOUTC, OK, LERR * .. Data statements .. DATA ICHT/'NTC'/, ICHU/'UL'/ * .. Executable Statements .. * + SKEWFULL = SNAME( 8: 11 ).EQ.'skew' NARGS = 12 NC = 0 RESET = .TRUE. ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 * DO 130 IN = 1, NIDIM N = IDIM( IN ) @@ -1853,8 +1997,13 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * * Generate the matrix C. * - CALL DMAKE( 'SY', UPLO, ' ', N, N, C, NMAX, CC, - $ LDC, RESET, ZERO ) + IF(.NOT.SKEWFULL) THEN + CALL DMAKE( 'SY', UPLO, ' ', N, N, C, + $ NMAX, CC, LDC, RESET, ZERO ) + ELSE + CALL DMAKE( 'SK', UPLO, ' ', N, N, C, + $ NMAX, CC, LDC, RESET, ZERO ) + END IF * NC = NC + 1 * @@ -1886,15 +2035,23 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ TRANS, N, K, ALPHA, LDA, LDB, BETA, LDC) IF( REWI ) $ REWIND NTRA - CALL CDSYR2K( IORDER, UPLO, TRANS, N, K, - $ ALPHA, AA, LDA, BB, LDB, BETA, - $ CC, LDC ) + IF(.NOT.SKEWFULL) THEN + CALL CDSYR2K( IORDER, UPLO, TRANS, N, K, + $ ALPHA, AA, LDA, BB, LDB, BETA, CC, + $ LDC ) + ELSE + CALL CDSKEWSYR2K( IORDER, UPLO, TRANS, + $ N, K, ALPHA, AA, LDA, BB, LDB, BETA, + $ CC, LDC ) + END IF * * Check if error-exit was taken incorrectly. * IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9993 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 150 END IF * @@ -1913,8 +2070,13 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( NULL )THEN ISAME( 11 ) = LDE( CS, CC, LCC ) ELSE - ISAME( 11 ) = LDERES( 'SY', UPLO, N, N, CS, - $ CC, LDC ) + IF(.NOT.SKEWFULL) THEN + ISAME( 11 ) = LDERES( 'SY', UPLO, N, + $ N, CS, CC, LDC ) + ELSE + ISAME( 11 ) = LDERES( 'SK', UPLO, N, + $ N, CS, CC, LDC ) + END IF END IF ISAME( 12 ) = LDCS.EQ.LDC * @@ -1929,6 +2091,8 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 150 END IF * @@ -1936,20 +2100,37 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * * Check the result column by column. * - JJAB = 1 - JC = 1 + IF( .NOT.SKEWFULL.OR.UPPER )THEN + JJAB = 1 + JC = 1 + ELSE + JJAB = 1 + 2*NMAX + JC = 2 + END IF DO 70 J = 1, N - IF( UPPER )THEN + IF( .NOT.SKEWFULL.AND.UPPER )THEN JJ = 1 LJ = J - ELSE + ELSE IF( .NOT.SKEWFULL.AND..NOT.UPPER + $ )THEN JJ = J LJ = N - J + 1 + ELSE IF( SKEWFULL.AND.UPPER )THEN + JJ = 1 + LJ = J - 1 + ELSE + JJ = J + 1 + LJ = N - J END IF IF( TRAN )THEN DO 50 I = 1, K - W( I ) = AB( ( J - 1 )*2*NMAX + K + - $ I ) + IF(.NOT.SKEWFULL) THEN + W( I ) = AB( ( J - 1 )*2*NMAX + $ + K + I ) + ELSE + W( I ) = -AB( ( J - 1 )*2*NMAX + $ + K + I ) + END IF W( K + I ) = AB( ( J - 1 )*2*NMAX + $ I ) 50 CONTINUE @@ -1961,8 +2142,13 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NOUT, .TRUE. ) ELSE DO 60 I = 1, K - W( I ) = AB( ( K + I - 1 )*NMAX + - $ J ) + IF(.NOT.SKEWFULL) THEN + W( I ) = AB( ( K + I - 1 )*NMAX + $ + J ) + ELSE + W( I ) = -AB( ( K + I - 1 )*NMAX + $ + J ) + END IF W( K + I ) = AB( ( I - 1 )*NMAX + $ J ) 60 CONTINUE @@ -1981,6 +2167,9 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ JJAB = JJAB + 2*NMAX END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -2021,38 +2210,49 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ LDA, LDB, BETA, LDC) * 160 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A17,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A17,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A17,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A17,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ', A17,' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT( 1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9994 FORMAT( 1X, I6, ': ', A17,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', C,', I3, ') ', $ ' .' ) 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A17,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A17,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of DCHK5. * END -* + +* ===================================================================== SUBROUTINE DPRCN5(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, $ N, K, ALPHA, LDA, LDB, BETA, LDC) + IMPLICIT NONE + INTEGER NOUT, NC, IORDER, N, K, LDA, LDB, LDC DOUBLE PRECISION ALPHA, BETA CHARACTER*1 UPLO, TRANSA - CHARACTER*12 SNAME + CHARACTER*17 SNAME CHARACTER*14 CRC, CU, CA IF (UPLO.EQ.'U')THEN @@ -2075,19 +2275,21 @@ SUBROUTINE DPRCN5(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, LDB, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') ) + 9995 FORMAT( 1X, I6, ': ', A17,'(', 3( A14, ',') ) 9994 FORMAT( 20X, 2( I3, ',' ), $ F4.1, ', A,', I3, ', B', I3, ',', F4.1, ', C,', I3, ').' ) END -* + +* ===================================================================== SUBROUTINE DMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET, $ TRANSL ) + IMPLICIT NONE * * Generates values for an M by N matrix A. * Stores the values in the array AA in the data structure required * by the routine, with unwanted elements set to rogue value. * -* TYPE is 'GE', 'SY' or 'TR'. +* TYPE is 'GE', 'SY', 'SK' or 'TR'. * * Auxiliary routine for test program for Level 3 Blas. * @@ -2112,16 +2314,17 @@ SUBROUTINE DMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET, DOUBLE PRECISION A( NMAX, * ), AA( * ) * .. Local Scalars .. INTEGER I, IBEG, IEND, J - LOGICAL GEN, LOWER, SYM, TRI, UNIT, UPPER + LOGICAL GEN, LOWER, SYM, TRI, UNIT, UPPER, SKEW * .. External Functions .. DOUBLE PRECISION DBEG EXTERNAL DBEG * .. Executable Statements .. GEN = TYPE.EQ.'GE' SYM = TYPE.EQ.'SY' + SKEW = TYPE.EQ.'SK' TRI = TYPE.EQ.'TR' - UPPER = ( SYM.OR.TRI ).AND.UPLO.EQ.'U' - LOWER = ( SYM.OR.TRI ).AND.UPLO.EQ.'L' + UPPER = ( SYM.OR.SKEW.OR.TRI ).AND.UPLO.EQ.'U' + LOWER = ( SYM.OR.SKEW.OR.TRI ).AND.UPLO.EQ.'L' UNIT = TRI.AND.DIAG.EQ.'U' * * Generate data in array A. @@ -2137,6 +2340,8 @@ SUBROUTINE DMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET, $ A( I, J ) = ZERO IF( SYM )THEN A( J, I ) = A( I, J ) + ELSE IF( SKEW )THEN + A( J, I ) = -A( I, J ) ELSE IF( TRI )THEN A( J, I ) = ZERO END IF @@ -2147,6 +2352,8 @@ SUBROUTINE DMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET, $ A( J, J ) = A( J, J ) + ONE IF( UNIT ) $ A( J, J ) = ONE + IF( SKEW ) + $ A( J, J ) = ZERO 20 CONTINUE * * Store elements in array AS in data structure required by routine. @@ -2160,17 +2367,17 @@ SUBROUTINE DMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET, AA( I + ( J - 1 )*LDA ) = ROGUE 40 CONTINUE 50 CONTINUE - ELSE IF( TYPE.EQ.'SY'.OR.TYPE.EQ.'TR' )THEN + ELSE IF( TYPE.EQ.'SY'.OR.TYPE.EQ.'SK'.OR.TYPE.EQ.'TR' )THEN DO 90 J = 1, N IF( UPPER )THEN IBEG = 1 - IF( UNIT )THEN + IF( UNIT.OR.SKEW )THEN IEND = J - 1 ELSE IEND = J END IF ELSE - IF( UNIT )THEN + IF( UNIT.OR.SKEW )THEN IBEG = J + 1 ELSE IBEG = J @@ -2193,9 +2400,12 @@ SUBROUTINE DMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET, * End of DMAKE. * END + +* ===================================================================== SUBROUTINE DMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, $ BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, FATAL, $ NOUT, MV ) + IMPLICIT NONE * * Checks the results of the computational tests. * @@ -2315,7 +2525,10 @@ SUBROUTINE DMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, * End of DMMCH. * END + +* ===================================================================== LOGICAL FUNCTION LDE( RI, RJ, LR ) + IMPLICIT NONE * * Tests if two arrays are identical. * @@ -2347,11 +2560,14 @@ LOGICAL FUNCTION LDE( RI, RJ, LR ) * End of LDE. * END + +* ===================================================================== LOGICAL FUNCTION LDERES( TYPE, UPLO, M, N, AA, AS, LDA ) + IMPLICIT NONE * * Tests if selected elements in two arrays are equal. * -* TYPE is 'GE' or 'SY'. +* TYPE is 'GE' or 'SY' or 'SK'. * * Auxiliary routine for test program for Level 3 Blas. * @@ -2379,14 +2595,20 @@ LOGICAL FUNCTION LDERES( TYPE, UPLO, M, N, AA, AS, LDA ) $ GO TO 70 10 CONTINUE 20 CONTINUE - ELSE IF( TYPE.EQ.'SY' )THEN + ELSE IF( TYPE.EQ.'SY'.OR.TYPE.EQ.'SK' )THEN DO 50 J = 1, N - IF( UPPER )THEN + IF( UPPER.AND.TYPE.EQ.'SY' )THEN IBEG = 1 IEND = J - ELSE + ELSE IF( .NOT.UPPER.AND.TYPE.EQ.'SY' )THEN IBEG = J IEND = N + ELSE IF( UPPER.AND.TYPE.EQ.'SK' )THEN + IBEG = 1 + IEND = J - 1 + ELSE + IBEG = J + 1 + IEND = N END IF DO 30 I = 1, IBEG - 1 IF( AA( I, J ).NE.AS( I, J ) ) @@ -2409,7 +2631,10 @@ LOGICAL FUNCTION LDERES( TYPE, UPLO, M, N, AA, AS, LDA ) * End of LDERES. * END + +* ===================================================================== DOUBLE PRECISION FUNCTION DBEG( RESET ) + IMPLICIT NONE * * Generates random numbers uniformly distributed between -0.5 and 0.5. * @@ -2455,7 +2680,10 @@ DOUBLE PRECISION FUNCTION DBEG( RESET ) * End of DBEG. * END + +* ===================================================================== DOUBLE PRECISION FUNCTION DDIFF( X, Y ) + IMPLICIT NONE * * Auxiliary routine for test program for Level 3 Blas. * @@ -2474,3 +2702,500 @@ DOUBLE PRECISION FUNCTION DDIFF( X, Y ) * End of DDIFF. * END + +* ===================================================================== + SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, + $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, + $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G, + $ IORDER) + IMPLICIT NONE +* +* Tests DGEMMTR. +* +* Auxiliary routine for test program for Level 3 Blas. +* +* -- Written on 19-July-2023. +* Martin Koehler, MPI Magdeburg +* +* .. Parameters .. + DOUBLE PRECISION ZERO + PARAMETER ( ZERO = 0.0D0 ) +* .. Scalar Arguments .. + DOUBLE PRECISION EPS, THRESH + INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER + LOGICAL FATAL, REWI, TRACE + CHARACTER*17 SNAME +* .. Array Arguments .. + DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), + $ AS( NMAX*NMAX ), B( NMAX, NMAX ), + $ BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ), + $ C( NMAX, NMAX ), CC( NMAX*NMAX ), + $ CS( NMAX*NMAX ), CT( NMAX ), G( NMAX ) + INTEGER IDIM( NIDIM ) +* .. Local Scalars .. + DOUBLE PRECISION ALPHA, ALS, BETA, BLS, ERR, ERRMAX + INTEGER NTESTS, NFAILS + INTEGER I, IA, IB, ICA, ICB, IK, IN, K, KS, LAA, + $ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, + $ MA, MB, N, NA, NARGS, NB, NC, NS, IS + LOGICAL NULL, RESET, SAME, TRANA, TRANB + CHARACTER*1 TRANAS, TRANBS, TRANSA, TRANSB, UPLO, UPLOS + CHARACTER*3 ICH + CHARACTER*2 ISHAPE +* .. Local Arrays .. + LOGICAL ISAME( 13 ) +* .. External Functions .. + LOGICAL LDE, LDERES + EXTERNAL LDE, LDERES +* .. External Subroutines .. + EXTERNAL CDGEMMTR, DMAKE, DMMTCH +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. Scalars in Common .. + INTEGER INFOT, NOUTC + LOGICAL LERR, OK +* .. Common blocks .. + COMMON /INFOC/INFOT, NOUTC, OK, LERR +* .. Data statements .. + DATA ICH/'NTC'/ + DATA ISHAPE/'UL'/ +* .. Executable Statements .. +* + NARGS = 13 + NC = 0 + RESET = .TRUE. + ERRMAX = ZERO + NTESTS = 0 + NFAILS = 0 +* + DO 100 IN = 1, NIDIM + N = IDIM( IN ) +* Set LDC to 1 more than minimum value if room. + LDC = N + IF( LDC.LT.NMAX ) + $ LDC = LDC + 1 +* Skip tests if not enough room. + IF( LDC.GT.NMAX ) + $ GO TO 100 + LCC = LDC*N + NULL = N.LE.0 +* + DO 90 IK = 1, NIDIM + K = IDIM( IK ) +* + DO 80 ICA = 1, 3 + TRANSA = ICH( ICA: ICA ) + TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' +* + IF( TRANA )THEN + MA = K + NA = N + ELSE + MA = N + NA = K + END IF +* Set LDA to 1 more than minimum value if room. + LDA = MA + IF( LDA.LT.NMAX ) + $ LDA = LDA + 1 +* Skip tests if not enough room. + IF( LDA.GT.NMAX ) + $ GO TO 80 + LAA = LDA*NA +* +* Generate the matrix A. +* + CALL DMAKE( 'GE', ' ', ' ', MA, NA, A, NMAX, AA, LDA, + $ RESET, ZERO ) +* + DO 70 ICB = 1, 3 + TRANSB = ICH( ICB: ICB ) + TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' +* + IF( TRANB )THEN + MB = N + NB = K + ELSE + MB = K + NB = N + END IF +* Set LDB to 1 more than minimum value if room. + LDB = MB + IF( LDB.LT.NMAX ) + $ LDB = LDB + 1 +* Skip tests if not enough room. + IF( LDB.GT.NMAX ) + $ GO TO 70 + LBB = LDB*NB +* +* Generate the matrix B. +* + CALL DMAKE( 'GE', ' ', ' ', MB, NB, B, NMAX, BB, + $ LDB, RESET, ZERO ) +* + DO 60 IA = 1, NALF + ALPHA = ALF( IA ) +* + DO 50 IB = 1, NBET + BETA = BET( IB ) + + DO 45 IS = 1, 2 + UPLO = ISHAPE( IS: IS ) + +* +* Generate the matrix C. +* + CALL DMAKE( 'GE', UPLO, ' ', N, N, C, + $ NMAX, CC, LDC, RESET, ZERO ) +* + NC = NC + 1 +* +* Save every datum before calling the +* subroutine. +* + UPLOS = UPLO + TRANAS = TRANSA + TRANBS = TRANSB + NS = N + KS = K + ALS = ALPHA + DO 10 I = 1, LAA + AS( I ) = AA( I ) + 10 CONTINUE + LDAS = LDA + DO 20 I = 1, LBB + BS( I ) = BB( I ) + 20 CONTINUE + LDBS = LDB + BLS = BETA + DO 30 I = 1, LCC + CS( I ) = CC( I ) + 30 CONTINUE + LDCS = LDC +* +* Call the subroutine. +* + IF( TRACE ) + $ CALL DPRCN8(NTRA, NC, SNAME, IORDER, UPLO, + $ TRANSA, TRANSB, N, K, ALPHA, LDA, + $ LDB, BETA, LDC) + IF( REWI ) + $ REWIND NTRA + CALL CDGEMMTR( IORDER, UPLO, TRANSA, TRANSB, + $ N, K, ALPHA, AA, LDA, BB, LDB, + $ BETA, CC, LDC ) +* +* Check if error-exit was taken incorrectly. +* + IF( .NOT.OK )THEN + WRITE( NOUT, FMT = 9994 ) + FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 + GO TO 120 + END IF +* +* See what data changed inside subroutines. +* + ISAME( 1 ) = UPLO.EQ.UPLOS + ISAME( 2 ) = TRANSA.EQ.TRANAS + ISAME( 3 ) = TRANSB.EQ.TRANBS + ISAME( 4 ) = NS.EQ.N + ISAME( 5 ) = KS.EQ.K + ISAME( 6 ) = ALS.EQ.ALPHA + ISAME( 7 ) = LDE( AS, AA, LAA ) + ISAME( 8 ) = LDAS.EQ.LDA + ISAME( 9 ) = LDE( BS, BB, LBB ) + ISAME( 10 ) = LDBS.EQ.LDB + ISAME( 11 ) = BLS.EQ.BETA + IF( NULL )THEN + ISAME( 12 ) = LDE( CS, CC, LCC ) + ELSE + ISAME( 12 ) = LDERES( 'GE', ' ', N, N, + $ CS, CC, LDC ) + END IF + ISAME( 13 ) = LDCS.EQ.LDC +* +* If data was incorrectly changed, report +* and return. +* + SAME = .TRUE. + DO 40 I = 1, NARGS + SAME = SAME.AND.ISAME( I ) + IF( .NOT.ISAME( I ) ) + $ WRITE( NOUT, FMT = 9998 )I + 40 CONTINUE + IF( .NOT.SAME )THEN + FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 + GO TO 120 + END IF +* + IF( .NOT.NULL )THEN +* +* Check the result. +* + CALL DMMTCH( UPLO, TRANSA, TRANSB, + $ N, K, + $ ALPHA, A, NMAX, B, NMAX, BETA, + $ C, NMAX, CT, G, CC, LDC, EPS, + $ ERR, FATAL, NOUT, .TRUE. ) + ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 +* If got really bad answer, report and +* return. + IF( FATAL ) + $ GO TO 120 + END IF +* + 45 CONTINUE +* + 50 CONTINUE +* + 60 CONTINUE +* + 70 CONTINUE +* + 80 CONTINUE +* + 90 CONTINUE +* + 100 CONTINUE +* +* +* Report result. +* + IF( ERRMAX.LT.THRESH )THEN + IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10000 )SNAME, NC + IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10001 )SNAME, NC + ELSE + IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10002 )SNAME, NC, ERRMAX + IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10003 )SNAME, NC, ERRMAX + END IF + GO TO 130 +* + 120 CONTINUE + WRITE( NOUT, FMT = 9996 )SNAME + CALL DPRCN8(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, TRANSB, + $ N, K, ALPHA, LDA, LDB, BETA, LDC) +* + 130 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS + RETURN +* +10003 FORMAT( ' ', A17,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) +10002 FORMAT( ' ', A17,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) +10001 FORMAT( ' ', A17,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) +10000 FORMAT( ' ', A17,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) + 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', + $ 'ANGED INCORRECTLY *******' ) + 9997 FORMAT( ' ', A17, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, + $ ' C', 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', + $ F8.2, ' - SUSPECT *******' ) + 9996 FORMAT( ' ******* ', A17, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A17, '(''',A1, ''',''',A1, ''',''', A1, + $ ''',', 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', + $ F4.1, ', ', 'C,', I3, ').' ) + 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', + $ '******' ) + 9979 FORMAT( ' ', A17,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A17,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) +* +* End of DCHK6 +* + END + + +* ===================================================================== + SUBROUTINE DPRCN8(NOUT, NC, SNAME, IORDER, UPLO, + $ TRANSA, TRANSB, N, + $ K, ALPHA, LDA, LDB, BETA, LDC) + IMPLICIT NONE + + INTEGER NOUT, NC, IORDER, N, K, LDA, LDB, LDC + DOUBLE PRECISION ALPHA, BETA + CHARACTER*1 TRANSA, TRANSB, UPLO + CHARACTER*17 SNAME + CHARACTER*14 CRC, CTA,CTB,CUPLO + + IF (UPLO.EQ.'U') THEN + CUPLO = 'CblasUpper' + ELSE + CUPLO = 'CblasLower' + END IF + IF (TRANSA.EQ.'N')THEN + CTA = ' CblasNoTrans' + ELSE IF (TRANSA.EQ.'T')THEN + CTA = ' CblasTrans' + ELSE + CTA = 'CblasConjTrans' + END IF + IF (TRANSB.EQ.'N')THEN + CTB = ' CblasNoTrans' + ELSE IF (TRANSB.EQ.'T')THEN + CTB = ' CblasTrans' + ELSE + CTB = 'CblasConjTrans' + END IF + IF (IORDER.EQ.1)THEN + CRC = ' CblasRowMajor' + ELSE + CRC = ' CblasColMajor' + END IF + WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CUPLO, CTA,CTB + WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, LDB, BETA, LDC + + 9995 FORMAT( 1X, I6, ': ', A17,'(', A14, ',', A14, ',', A14, ',', + $ A14, ',') + 9994 FORMAT( 10X, 2( I3, ',' ) ,' ', F4.1,' , A,', + $ I3, ', B,', I3, ', ', F4.1,' , C,', I3, ').' ) + END + +* ===================================================================== + SUBROUTINE DMMTCH( UPLO, TRANSA, TRANSB, N, KK, ALPHA, A, LDA, + $ B, LDB, BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, + $ FATAL, NOUT, MV ) + IMPLICIT NONE +* +* Checks the results of the computational tests. +* +* Auxiliary routine for test program for Level 3 Blas. (DGEMMTR) +* +* -- Written on 19-July-2023. +* Martin Koehler, MPI Magdeburg +* +* .. Parameters .. + DOUBLE PRECISION ZERO, ONE + PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) +* .. Scalar Arguments .. + DOUBLE PRECISION ALPHA, BETA, EPS, ERR + INTEGER KK, LDA, LDB, LDC, LDCC, N, NOUT + LOGICAL FATAL, MV + CHARACTER*1 UPLO, TRANSA, TRANSB +* .. Array Arguments .. + DOUBLE PRECISION A( LDA, * ), B( LDB, * ), C( LDC, * ), + $ CC( LDCC, * ), CT( * ), G( * ) +* .. Local Scalars .. + DOUBLE PRECISION ERRI + INTEGER I, J, K, ISTART, ISTOP + LOGICAL TRANA, TRANB, UPPER +* .. Intrinsic Functions .. + INTRINSIC ABS, MAX, SQRT +* .. Executable Statements .. + UPPER = UPLO.EQ.'U' + TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' + TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' +* +* Compute expected result, one column at a time, in CT using data +* in A, B and C. +* Compute gauges in G. +* + ISTART = 1 + ISTOP = N + + DO 120 J = 1, N +* + IF ( UPPER ) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + DO 10 I = ISTART, ISTOP + CT( I ) = ZERO + G( I ) = ZERO + 10 CONTINUE + IF( .NOT.TRANA.AND..NOT.TRANB )THEN + DO 30 K = 1, KK + DO 20 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*B( K, J ) + G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( K, J ) ) + 20 CONTINUE + 30 CONTINUE + ELSE IF( TRANA.AND..NOT.TRANB )THEN + DO 50 K = 1, KK + DO 40 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*B( K, J ) + G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( K, J ) ) + 40 CONTINUE + 50 CONTINUE + ELSE IF( .NOT.TRANA.AND.TRANB )THEN + DO 70 K = 1, KK + DO 60 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*B( J, K ) + G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( J, K ) ) + 60 CONTINUE + 70 CONTINUE + ELSE IF( TRANA.AND.TRANB )THEN + DO 90 K = 1, KK + DO 80 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*B( J, K ) + G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( J, K ) ) + 80 CONTINUE + 90 CONTINUE + END IF + DO 100 I = ISTART, ISTOP + CT( I ) = ALPHA*CT( I ) + BETA*C( I, J ) + G( I ) = ABS( ALPHA )*G( I ) + ABS( BETA )*ABS( C( I, J ) ) + 100 CONTINUE +* +* Compute the error ratio for this result. +* + ERR = ZERO + DO 110 I = ISTART, ISTOP + ERRI = ABS( CT( I ) - CC( I, J ) )/EPS + IF( G( I ).NE.ZERO ) + $ ERRI = ERRI/G( I ) + ERR = MAX( ERR, ERRI ) + IF( ERR*SQRT( EPS ).GE.ONE ) + $ GO TO 130 + 110 CONTINUE +* + 120 CONTINUE +* +* If the loop completes, all results are at least half accurate. + GO TO 150 +* +* Report fatal error. +* + 130 FATAL = .TRUE. + WRITE( NOUT, FMT = 9999 ) + DO 140 I = ISTART, ISTOP + IF( MV )THEN + WRITE( NOUT, FMT = 9998 )I, CT( I ), CC( I, J ) + ELSE + WRITE( NOUT, FMT = 9998 )I, CC( I, J ), CT( I ) + END IF + 140 CONTINUE + IF( N.GT.1 ) + $ WRITE( NOUT, FMT = 9997 )J +* + 150 CONTINUE + RETURN +* + 9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL', + $ 'F ACCURATE *******', /' EXPECTED RESULT COMPU', + $ 'TED RESULT' ) + 9998 FORMAT( 1X, I7, 2G18.6 ) + 9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) +* +* End of DMMTCH +* + END + + diff --git a/CBLAS/testing/c_s2chke.c b/CBLAS/testing/c_s2chke.c index 63f1671524..24158dac6f 100644 --- a/CBLAS/testing/c_s2chke.c +++ b/CBLAS/testing/c_s2chke.c @@ -3,787 +3,897 @@ #include "cblas.h" #include "cblas_test.h" -int cblas_ok, cblas_lerr, cblas_info; -int link_xerbla=TRUE; +CBLAS_INT cblas_ok, cblas_lerr, cblas_info; +CBLAS_INT link_xerbla=TRUE; +CBLAS_INT cblas_xtests, cblas_xfails, cblas_xbad; char *cblas_rout; #ifdef F77_Char -void F77_xerbla(F77_Char F77_srname, void *vinfo); +void F77_xerbla(F77_Char F77_srname, void *vinfo #else -void F77_xerbla(char *srname, void *vinfo); +void F77_xerbla(char *srname, void *vinfo #endif +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); void chkxer(void) { - extern int cblas_ok, cblas_lerr, cblas_info; - extern int link_xerbla; + extern CBLAS_INT cblas_ok, cblas_lerr, cblas_info; + extern CBLAS_INT link_xerbla; + extern CBLAS_INT cblas_xtests, cblas_xfails, cblas_xbad; extern char *cblas_rout; + cblas_xtests++; if (cblas_lerr == 1 ) { - printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", 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) { + cblas_xfails++; } + cblas_xbad = 0; cblas_lerr = 1 ; } -void F77_s2chke(char *rout) { +void F77_s2chke(char *rout +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN rout_len +#endif +) { char *sf = ( rout ) ; float A[2] = {0.0,0.0}, X[2] = {0.0,0.0}, Y[2] = {0.0,0.0}, ALPHA=0.0, BETA=0.0; - extern int cblas_info, cblas_lerr, cblas_ok; - extern int RowMajorStrg; + extern CBLAS_INT cblas_info, cblas_lerr, cblas_ok; extern char *cblas_rout; +#ifndef HAS_ATTRIBUTE_WEAK_SUPPORT + #ifdef CBLAS_DLL_IMPORTS + // Since Windows does not support weak symbols, and the trick below doesn't + // work for shared libraries on Windows, we skip the xerbla tests here. + printf("***** WARNING: Skipping xerbla tests since weak symbols are not supported on Windows *****\n"); + return; + #endif + if (link_xerbla) /* call these first to link */ { - cblas_xerbla(cblas_info,cblas_rout,""); - F77_xerbla(cblas_rout,&cblas_info); + API_SUFFIX(cblas_xerbla)(cblas_info,cblas_rout,""); + F77_xerbla(cblas_rout,&cblas_info, 1); } +#endif + link_xerbla = 0; cblas_ok = TRUE ; cblas_lerr = PASSED ; + cblas_xtests = 0; + cblas_xfails = 0; + cblas_xbad = 0; if (strncmp( sf,"cblas_sgemv",11)==0) { cblas_rout = "cblas_sgemv"; cblas_info = 1; - cblas_sgemv(INVALID, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_sgemv)(INVALID_LAYOUT, CblasNoTrans, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_sgemv(CblasColMajor, INVALID, 0, 0, + API_SUFFIX(cblas_sgemv)(CblasColMajor, INVALID_TRANSPOSE, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_sgemv(CblasColMajor, CblasNoTrans, INVALID, 0, + API_SUFFIX(cblas_sgemv)(CblasColMajor, CblasNoTrans, INVALID, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_sgemv(CblasColMajor, CblasNoTrans, 0, INVALID, + API_SUFFIX(cblas_sgemv)(CblasColMajor, CblasNoTrans, 0, INVALID, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_sgemv(CblasColMajor, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_sgemv)(CblasColMajor, CblasNoTrans, 2, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_sgemv(CblasColMajor, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_sgemv)(CblasColMajor, CblasNoTrans, 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_sgemv(CblasColMajor, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_sgemv)(CblasColMajor, CblasNoTrans, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; RowMajorStrg = TRUE; - cblas_sgemv(CblasRowMajor, INVALID, 0, 0, + API_SUFFIX(cblas_sgemv)(CblasRowMajor, INVALID_TRANSPOSE, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_sgemv(CblasRowMajor, CblasNoTrans, INVALID, 0, + API_SUFFIX(cblas_sgemv)(CblasRowMajor, CblasNoTrans, INVALID, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_sgemv(CblasRowMajor, CblasNoTrans, 0, INVALID, + API_SUFFIX(cblas_sgemv)(CblasRowMajor, CblasNoTrans, 0, INVALID, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_sgemv(CblasRowMajor, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_sgemv)(CblasRowMajor, CblasNoTrans, 0, 2, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = TRUE; - cblas_sgemv(CblasRowMajor, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_sgemv)(CblasRowMajor, CblasNoTrans, 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_sgemv(CblasRowMajor, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_sgemv)(CblasRowMajor, CblasNoTrans, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ); chkxer(); } else if (strncmp( sf,"cblas_sgbmv",11)==0) { cblas_rout = "cblas_sgbmv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_sgbmv(INVALID, CblasNoTrans, 0, 0, 0, 0, + API_SUFFIX(cblas_sgbmv)(INVALID_LAYOUT, CblasNoTrans, 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_sgbmv(CblasColMajor, INVALID, 0, 0, 0, 0, + API_SUFFIX(cblas_sgbmv)(CblasColMajor, INVALID_TRANSPOSE, 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_sgbmv(CblasColMajor, CblasNoTrans, INVALID, 0, 0, 0, + API_SUFFIX(cblas_sgbmv)(CblasColMajor, CblasNoTrans, INVALID, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_sgbmv(CblasColMajor, CblasNoTrans, 0, INVALID, 0, 0, + API_SUFFIX(cblas_sgbmv)(CblasColMajor, CblasNoTrans, 0, INVALID, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_sgbmv(CblasColMajor, CblasNoTrans, 0, 0, INVALID, 0, + API_SUFFIX(cblas_sgbmv)(CblasColMajor, CblasNoTrans, 0, 0, INVALID, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_sgbmv(CblasColMajor, CblasNoTrans, 2, 0, 0, INVALID, + API_SUFFIX(cblas_sgbmv)(CblasColMajor, CblasNoTrans, 2, 0, 0, INVALID, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_sgbmv(CblasColMajor, CblasNoTrans, 0, 0, 1, 0, + API_SUFFIX(cblas_sgbmv)(CblasColMajor, CblasNoTrans, 0, 0, 1, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_sgbmv(CblasColMajor, CblasNoTrans, 0, 0, 0, 0, + API_SUFFIX(cblas_sgbmv)(CblasColMajor, CblasNoTrans, 0, 0, 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = FALSE; - cblas_sgbmv(CblasColMajor, CblasNoTrans, 0, 0, 0, 0, + API_SUFFIX(cblas_sgbmv)(CblasColMajor, CblasNoTrans, 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_sgbmv(CblasRowMajor, INVALID, 0, 0, 0, 0, + API_SUFFIX(cblas_sgbmv)(CblasRowMajor, INVALID_TRANSPOSE, 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_sgbmv(CblasRowMajor, CblasNoTrans, INVALID, 0, 0, 0, + API_SUFFIX(cblas_sgbmv)(CblasRowMajor, CblasNoTrans, INVALID, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_sgbmv(CblasRowMajor, CblasNoTrans, 0, INVALID, 0, 0, + API_SUFFIX(cblas_sgbmv)(CblasRowMajor, CblasNoTrans, 0, INVALID, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_sgbmv(CblasRowMajor, CblasNoTrans, 0, 0, INVALID, 0, + API_SUFFIX(cblas_sgbmv)(CblasRowMajor, CblasNoTrans, 0, 0, INVALID, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_sgbmv(CblasRowMajor, CblasNoTrans, 2, 0, 0, INVALID, + API_SUFFIX(cblas_sgbmv)(CblasRowMajor, CblasNoTrans, 2, 0, 0, INVALID, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = TRUE; - cblas_sgbmv(CblasRowMajor, CblasNoTrans, 0, 0, 1, 0, + API_SUFFIX(cblas_sgbmv)(CblasRowMajor, CblasNoTrans, 0, 0, 1, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_sgbmv(CblasRowMajor, CblasNoTrans, 0, 0, 0, 0, + API_SUFFIX(cblas_sgbmv)(CblasRowMajor, CblasNoTrans, 0, 0, 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = TRUE; - cblas_sgbmv(CblasRowMajor, CblasNoTrans, 0, 0, 0, 0, + API_SUFFIX(cblas_sgbmv)(CblasRowMajor, CblasNoTrans, 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ); chkxer(); } else if (strncmp( sf,"cblas_ssymv",11)==0) { cblas_rout = "cblas_ssymv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_ssymv(INVALID, CblasUpper, 0, + API_SUFFIX(cblas_ssymv)(INVALID_LAYOUT, CblasUpper, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_ssymv(CblasColMajor, INVALID, 0, + API_SUFFIX(cblas_ssymv)(CblasColMajor, INVALID_UPLO, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_ssymv(CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_ssymv)(CblasColMajor, CblasUpper, INVALID, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ssymv(CblasColMajor, CblasUpper, 2, + API_SUFFIX(cblas_ssymv)(CblasColMajor, CblasUpper, 2, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_ssymv(CblasColMajor, CblasUpper, 0, + API_SUFFIX(cblas_ssymv)(CblasColMajor, CblasUpper, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_ssymv(CblasColMajor, CblasUpper, 0, + API_SUFFIX(cblas_ssymv)(CblasColMajor, CblasUpper, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_ssymv(CblasRowMajor, INVALID, 0, + API_SUFFIX(cblas_ssymv)(CblasRowMajor, INVALID_UPLO, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_ssymv(CblasRowMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_ssymv)(CblasRowMajor, CblasUpper, INVALID, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ssymv(CblasRowMajor, CblasUpper, 2, + API_SUFFIX(cblas_ssymv)(CblasRowMajor, CblasUpper, 2, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_ssymv(CblasRowMajor, CblasUpper, 0, + API_SUFFIX(cblas_ssymv)(CblasRowMajor, CblasUpper, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_ssymv(CblasRowMajor, CblasUpper, 0, + API_SUFFIX(cblas_ssymv)(CblasRowMajor, CblasUpper, 0, + ALPHA, A, 1, X, 1, BETA, Y, 0 ); + chkxer(); + } else if (strncmp( sf,"cblas_sskewsymv",15)==0) { + cblas_rout = "cblas_sskewsymv"; + cblas_info = 1; RowMajorStrg = FALSE; + API_SUFFIX(cblas_sskewsymv)(INVALID_LAYOUT, CblasUpper, 0, + ALPHA, A, 1, X, 1, BETA, Y, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = FALSE; + API_SUFFIX(cblas_sskewsymv)(CblasColMajor, INVALID_UPLO, 0, + ALPHA, A, 1, X, 1, BETA, Y, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = FALSE; + API_SUFFIX(cblas_sskewsymv)(CblasColMajor, CblasUpper, INVALID, + ALPHA, A, 1, X, 1, BETA, Y, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = FALSE; + API_SUFFIX(cblas_sskewsymv)(CblasColMajor, CblasUpper, 2, + ALPHA, A, 1, X, 1, BETA, Y, 1 ); + chkxer(); + cblas_info = 8; RowMajorStrg = FALSE; + API_SUFFIX(cblas_sskewsymv)(CblasColMajor, CblasUpper, 0, + ALPHA, A, 1, X, 0, BETA, Y, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = FALSE; + API_SUFFIX(cblas_sskewsymv)(CblasColMajor, CblasUpper, 0, + ALPHA, A, 1, X, 1, BETA, Y, 0 ); + chkxer(); + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sskewsymv)(CblasRowMajor, INVALID_UPLO, 0, + ALPHA, A, 1, X, 1, BETA, Y, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sskewsymv)(CblasRowMajor, CblasUpper, INVALID, + ALPHA, A, 1, X, 1, BETA, Y, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sskewsymv)(CblasRowMajor, CblasUpper, 2, + ALPHA, A, 1, X, 1, BETA, Y, 1 ); + chkxer(); + cblas_info = 8; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sskewsymv)(CblasRowMajor, CblasUpper, 0, + ALPHA, A, 1, X, 0, BETA, Y, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sskewsymv)(CblasRowMajor, CblasUpper, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ); chkxer(); } else if (strncmp( sf,"cblas_ssbmv",11)==0) { cblas_rout = "cblas_ssbmv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_ssbmv(INVALID, CblasUpper, 0, 0, + API_SUFFIX(cblas_ssbmv)(INVALID_LAYOUT, CblasUpper, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_ssbmv(CblasColMajor, INVALID, 0, 0, + API_SUFFIX(cblas_ssbmv)(CblasColMajor, INVALID_UPLO, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_ssbmv(CblasColMajor, CblasUpper, INVALID, 0, + API_SUFFIX(cblas_ssbmv)(CblasColMajor, CblasUpper, INVALID, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_ssbmv(CblasColMajor, CblasUpper, 0, INVALID, + API_SUFFIX(cblas_ssbmv)(CblasColMajor, CblasUpper, 0, INVALID, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ssbmv(CblasColMajor, CblasUpper, 0, 1, + API_SUFFIX(cblas_ssbmv)(CblasColMajor, CblasUpper, 0, 1, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_ssbmv(CblasColMajor, CblasUpper, 0, 0, + API_SUFFIX(cblas_ssbmv)(CblasColMajor, CblasUpper, 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ssbmv(CblasColMajor, CblasUpper, 0, 0, + API_SUFFIX(cblas_ssbmv)(CblasColMajor, CblasUpper, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_ssbmv(CblasRowMajor, INVALID, 0, 0, + API_SUFFIX(cblas_ssbmv)(CblasRowMajor, INVALID_UPLO, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_ssbmv(CblasRowMajor, CblasUpper, INVALID, 0, + API_SUFFIX(cblas_ssbmv)(CblasRowMajor, CblasUpper, INVALID, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_ssbmv(CblasRowMajor, CblasUpper, 0, INVALID, + API_SUFFIX(cblas_ssbmv)(CblasRowMajor, CblasUpper, 0, INVALID, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ssbmv(CblasRowMajor, CblasUpper, 0, 1, + API_SUFFIX(cblas_ssbmv)(CblasRowMajor, CblasUpper, 0, 1, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = TRUE; - cblas_ssbmv(CblasRowMajor, CblasUpper, 0, 0, + API_SUFFIX(cblas_ssbmv)(CblasRowMajor, CblasUpper, 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ssbmv(CblasRowMajor, CblasUpper, 0, 0, + API_SUFFIX(cblas_ssbmv)(CblasRowMajor, CblasUpper, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ); chkxer(); } else if (strncmp( sf,"cblas_sspmv",11)==0) { cblas_rout = "cblas_sspmv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_sspmv(INVALID, CblasUpper, 0, + API_SUFFIX(cblas_sspmv)(INVALID_LAYOUT, CblasUpper, 0, ALPHA, A, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_sspmv(CblasColMajor, INVALID, 0, + API_SUFFIX(cblas_sspmv)(CblasColMajor, INVALID_UPLO, 0, ALPHA, A, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_sspmv(CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_sspmv)(CblasColMajor, CblasUpper, INVALID, ALPHA, A, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_sspmv(CblasColMajor, CblasUpper, 0, + API_SUFFIX(cblas_sspmv)(CblasColMajor, CblasUpper, 0, ALPHA, A, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_sspmv(CblasColMajor, CblasUpper, 0, + API_SUFFIX(cblas_sspmv)(CblasColMajor, CblasUpper, 0, ALPHA, A, X, 1, BETA, Y, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_sspmv(CblasRowMajor, INVALID, 0, + API_SUFFIX(cblas_sspmv)(CblasRowMajor, INVALID_UPLO, 0, ALPHA, A, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_sspmv(CblasRowMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_sspmv)(CblasRowMajor, CblasUpper, INVALID, ALPHA, A, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_sspmv(CblasRowMajor, CblasUpper, 0, + API_SUFFIX(cblas_sspmv)(CblasRowMajor, CblasUpper, 0, ALPHA, A, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_sspmv(CblasRowMajor, CblasUpper, 0, + API_SUFFIX(cblas_sspmv)(CblasRowMajor, CblasUpper, 0, ALPHA, A, X, 1, BETA, Y, 0 ); chkxer(); } else if (strncmp( sf,"cblas_strmv",11)==0) { cblas_rout = "cblas_strmv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_strmv(INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strmv)(INVALID_LAYOUT, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_strmv(CblasColMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_strmv)(CblasColMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_strmv(CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_strmv)(CblasColMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_strmv(CblasColMajor, CblasUpper, CblasNoTrans, - INVALID, 0, A, 1, X, 1 ); + API_SUFFIX(cblas_strmv)(CblasColMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, A, 1, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_strmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, A, 1, X, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_strmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 2, A, 1, X, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_strmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_strmv(CblasRowMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_strmv)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_strmv(CblasRowMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_strmv)(CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_strmv(CblasRowMajor, CblasUpper, CblasNoTrans, - INVALID, 0, A, 1, X, 1 ); + API_SUFFIX(cblas_strmv)(CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, A, 1, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_strmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, A, 1, X, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_strmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 2, A, 1, X, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = TRUE; - cblas_strmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 0 ); chkxer(); } else if (strncmp( sf,"cblas_stbmv",11)==0) { cblas_rout = "cblas_stbmv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_stbmv(INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_stbmv)(INVALID_LAYOUT, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_stbmv(CblasColMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_stbmv)(CblasColMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_stbmv(CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_stbmv)(CblasColMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_stbmv(CblasColMajor, CblasUpper, CblasNoTrans, - INVALID, 0, 0, A, 1, X, 1 ); + API_SUFFIX(cblas_stbmv)(CblasColMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_stbmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_stbmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, A, 1, X, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_stbmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_stbmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, A, 1, X, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_stbmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_stbmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 1, A, 1, X, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_stbmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_stbmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_stbmv(CblasRowMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_stbmv)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_stbmv(CblasRowMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_stbmv)(CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_stbmv(CblasRowMajor, CblasUpper, CblasNoTrans, - INVALID, 0, 0, A, 1, X, 1 ); + API_SUFFIX(cblas_stbmv)(CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_stbmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_stbmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, A, 1, X, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_stbmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_stbmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, A, 1, X, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_stbmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_stbmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 1, A, 1, X, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_stbmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_stbmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 0 ); chkxer(); } else if (strncmp( sf,"cblas_stpmv",11)==0) { cblas_rout = "cblas_stpmv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_stpmv(INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_stpmv)(INVALID_LAYOUT, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_stpmv(CblasColMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_stpmv)(CblasColMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_stpmv(CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_stpmv)(CblasColMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_stpmv(CblasColMajor, CblasUpper, CblasNoTrans, - INVALID, 0, A, X, 1 ); + API_SUFFIX(cblas_stpmv)(CblasColMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, A, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_stpmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_stpmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, A, X, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_stpmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_stpmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, X, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_stpmv(CblasRowMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_stpmv)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_stpmv(CblasRowMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_stpmv)(CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_stpmv(CblasRowMajor, CblasUpper, CblasNoTrans, - INVALID, 0, A, X, 1 ); + API_SUFFIX(cblas_stpmv)(CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, A, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_stpmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_stpmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, A, X, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_stpmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_stpmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, X, 0 ); chkxer(); } else if (strncmp( sf,"cblas_strsv",11)==0) { cblas_rout = "cblas_strsv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_strsv(INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strsv)(INVALID_LAYOUT, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_strsv(CblasColMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_strsv)(CblasColMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_strsv(CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_strsv)(CblasColMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_strsv(CblasColMajor, CblasUpper, CblasNoTrans, - INVALID, 0, A, 1, X, 1 ); + API_SUFFIX(cblas_strsv)(CblasColMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, A, 1, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_strsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, A, 1, X, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_strsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 2, A, 1, X, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_strsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_strsv(CblasRowMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_strsv)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_strsv(CblasRowMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_strsv)(CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_strsv(CblasRowMajor, CblasUpper, CblasNoTrans, - INVALID, 0, A, 1, X, 1 ); + API_SUFFIX(cblas_strsv)(CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, A, 1, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_strsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, A, 1, X, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_strsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 2, A, 1, X, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = TRUE; - cblas_strsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 0 ); chkxer(); } else if (strncmp( sf,"cblas_stbsv",11)==0) { cblas_rout = "cblas_stbsv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_stbsv(INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_stbsv)(INVALID_LAYOUT, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_stbsv(CblasColMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_stbsv)(CblasColMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_stbsv(CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_stbsv)(CblasColMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_stbsv(CblasColMajor, CblasUpper, CblasNoTrans, - INVALID, 0, 0, A, 1, X, 1 ); + API_SUFFIX(cblas_stbsv)(CblasColMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_stbsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_stbsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, A, 1, X, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_stbsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_stbsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, A, 1, X, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_stbsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_stbsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 1, A, 1, X, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_stbsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_stbsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_stbsv(CblasRowMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_stbsv)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_stbsv(CblasRowMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_stbsv)(CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_stbsv(CblasRowMajor, CblasUpper, CblasNoTrans, - INVALID, 0, 0, A, 1, X, 1 ); + API_SUFFIX(cblas_stbsv)(CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_stbsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_stbsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, A, 1, X, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_stbsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_stbsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, A, 1, X, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_stbsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_stbsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 1, A, 1, X, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_stbsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_stbsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 0 ); chkxer(); } else if (strncmp( sf,"cblas_stpsv",11)==0) { cblas_rout = "cblas_stpsv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_stpsv(INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_stpsv)(INVALID_LAYOUT, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_stpsv(CblasColMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_stpsv)(CblasColMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_stpsv(CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_stpsv)(CblasColMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_stpsv(CblasColMajor, CblasUpper, CblasNoTrans, - INVALID, 0, A, X, 1 ); + API_SUFFIX(cblas_stpsv)(CblasColMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, A, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_stpsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_stpsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, A, X, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_stpsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_stpsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, X, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_stpsv(CblasRowMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_stpsv)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_stpsv(CblasRowMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_stpsv)(CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_stpsv(CblasRowMajor, CblasUpper, CblasNoTrans, - INVALID, 0, A, X, 1 ); + API_SUFFIX(cblas_stpsv)(CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, A, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_stpsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_stpsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, A, X, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_stpsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_stpsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, X, 0 ); chkxer(); } else if (strncmp( sf,"cblas_sger",10)==0) { cblas_rout = "cblas_sger"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_sger(INVALID, 0, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_sger)(INVALID_LAYOUT, 0, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_sger(CblasColMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_sger)(CblasColMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_sger(CblasColMajor, 0, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_sger)(CblasColMajor, 0, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_sger(CblasColMajor, 0, 0, ALPHA, X, 0, Y, 1, A, 1 ); + API_SUFFIX(cblas_sger)(CblasColMajor, 0, 0, ALPHA, X, 0, Y, 1, A, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_sger(CblasColMajor, 0, 0, ALPHA, X, 1, Y, 0, A, 1 ); + API_SUFFIX(cblas_sger)(CblasColMajor, 0, 0, ALPHA, X, 1, Y, 0, A, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_sger(CblasColMajor, 2, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_sger)(CblasColMajor, 2, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_sger(CblasRowMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_sger)(CblasRowMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_sger(CblasRowMajor, 0, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_sger)(CblasRowMajor, 0, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_sger(CblasRowMajor, 0, 0, ALPHA, X, 0, Y, 1, A, 1 ); + API_SUFFIX(cblas_sger)(CblasRowMajor, 0, 0, ALPHA, X, 0, Y, 1, A, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_sger(CblasRowMajor, 0, 0, ALPHA, X, 1, Y, 0, A, 1 ); + API_SUFFIX(cblas_sger)(CblasRowMajor, 0, 0, ALPHA, X, 1, Y, 0, A, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_sger(CblasRowMajor, 0, 2, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_sger)(CblasRowMajor, 0, 2, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); } else if (strncmp( sf,"cblas_ssyr2",11)==0) { cblas_rout = "cblas_ssyr2"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_ssyr2(INVALID, CblasUpper, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_ssyr2)(INVALID_LAYOUT, CblasUpper, 0, ALPHA, X, 1, Y, 1, A, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssyr2)(CblasColMajor, INVALID_UPLO, 0, ALPHA, X, 1, Y, 1, A, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssyr2)(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssyr2)(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A, 1 ); + chkxer(); + cblas_info = 8; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssyr2)(CblasColMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A, 1 ); + chkxer(); + cblas_info = 10; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssyr2)(CblasColMajor, CblasUpper, 2, ALPHA, X, 1, Y, 1, A, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2)(CblasRowMajor, INVALID_UPLO, 0, ALPHA, X, 1, Y, 1, A, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2)(CblasRowMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2)(CblasRowMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A, 1 ); + chkxer(); + cblas_info = 8; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2)(CblasRowMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A, 1 ); + chkxer(); + cblas_info = 10; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2)(CblasRowMajor, CblasUpper, 2, ALPHA, X, 1, Y, 1, A, 1 ); + chkxer(); + } else if (strncmp( sf,"cblas_sskewsyr2",15)==0) { + cblas_rout = "cblas_sskewsyr2"; + cblas_info = 1; RowMajorStrg = FALSE; + API_SUFFIX(cblas_sskewsyr2)(INVALID_LAYOUT, CblasUpper, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_ssyr2(CblasColMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_sskewsyr2)(CblasColMajor, INVALID_UPLO, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_ssyr2(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_sskewsyr2)(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ssyr2(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A, 1 ); + API_SUFFIX(cblas_sskewsyr2)(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_ssyr2(CblasColMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A, 1 ); + API_SUFFIX(cblas_sskewsyr2)(CblasColMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ssyr2(CblasColMajor, CblasUpper, 2, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_sskewsyr2)(CblasColMajor, CblasUpper, 2, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_ssyr2(CblasRowMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_sskewsyr2)(CblasRowMajor, INVALID_UPLO, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_ssyr2(CblasRowMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_sskewsyr2)(CblasRowMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ssyr2(CblasRowMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A, 1 ); + API_SUFFIX(cblas_sskewsyr2)(CblasRowMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_ssyr2(CblasRowMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A, 1 ); + API_SUFFIX(cblas_sskewsyr2)(CblasRowMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ssyr2(CblasRowMajor, CblasUpper, 2, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_sskewsyr2)(CblasRowMajor, CblasUpper, 2, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); } else if (strncmp( sf,"cblas_sspr2",11)==0) { cblas_rout = "cblas_sspr2"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_sspr2(INVALID, CblasUpper, 0, ALPHA, X, 1, Y, 1, A ); + API_SUFFIX(cblas_sspr2)(INVALID_LAYOUT, CblasUpper, 0, ALPHA, X, 1, Y, 1, A ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_sspr2(CblasColMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A ); + API_SUFFIX(cblas_sspr2)(CblasColMajor, INVALID_UPLO, 0, ALPHA, X, 1, Y, 1, A ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_sspr2(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A ); + API_SUFFIX(cblas_sspr2)(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_sspr2(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A ); + API_SUFFIX(cblas_sspr2)(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_sspr2(CblasColMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A ); + API_SUFFIX(cblas_sspr2)(CblasColMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_sspr2(CblasRowMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A ); + API_SUFFIX(cblas_sspr2)(CblasRowMajor, INVALID_UPLO, 0, ALPHA, X, 1, Y, 1, A ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_sspr2(CblasRowMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A ); + API_SUFFIX(cblas_sspr2)(CblasRowMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_sspr2(CblasRowMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A ); + API_SUFFIX(cblas_sspr2)(CblasRowMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_sspr2(CblasRowMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A ); + API_SUFFIX(cblas_sspr2)(CblasRowMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A ); chkxer(); } else if (strncmp( sf,"cblas_ssyr",10)==0) { cblas_rout = "cblas_ssyr"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_ssyr(INVALID, CblasUpper, 0, ALPHA, X, 1, A, 1 ); + API_SUFFIX(cblas_ssyr)(INVALID_LAYOUT, CblasUpper, 0, ALPHA, X, 1, A, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_ssyr(CblasColMajor, INVALID, 0, ALPHA, X, 1, A, 1 ); + API_SUFFIX(cblas_ssyr)(CblasColMajor, INVALID_UPLO, 0, ALPHA, X, 1, A, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_ssyr(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, A, 1 ); + API_SUFFIX(cblas_ssyr)(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, A, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ssyr(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, A, 1 ); + API_SUFFIX(cblas_ssyr)(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, A, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_ssyr(CblasColMajor, CblasUpper, 2, ALPHA, X, 1, A, 1 ); + API_SUFFIX(cblas_ssyr)(CblasColMajor, CblasUpper, 2, ALPHA, X, 1, A, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_ssyr(CblasRowMajor, INVALID, 0, ALPHA, X, 1, A, 1 ); + API_SUFFIX(cblas_ssyr)(CblasRowMajor, INVALID_UPLO, 0, ALPHA, X, 1, A, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_ssyr(CblasRowMajor, CblasUpper, INVALID, ALPHA, X, 1, A, 1 ); + API_SUFFIX(cblas_ssyr)(CblasRowMajor, CblasUpper, INVALID, ALPHA, X, 1, A, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ssyr(CblasRowMajor, CblasUpper, 0, ALPHA, X, 0, A, 1 ); + API_SUFFIX(cblas_ssyr)(CblasRowMajor, CblasUpper, 0, ALPHA, X, 0, A, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_ssyr(CblasRowMajor, CblasUpper, 2, ALPHA, X, 1, A, 1 ); + API_SUFFIX(cblas_ssyr)(CblasRowMajor, CblasUpper, 2, ALPHA, X, 1, A, 1 ); chkxer(); } else if (strncmp( sf,"cblas_sspr",10)==0) { cblas_rout = "cblas_sspr"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_sspr(INVALID, CblasUpper, 0, ALPHA, X, 1, A ); + API_SUFFIX(cblas_sspr)(INVALID_LAYOUT, CblasUpper, 0, ALPHA, X, 1, A ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_sspr(CblasColMajor, INVALID, 0, ALPHA, X, 1, A ); + API_SUFFIX(cblas_sspr)(CblasColMajor, INVALID_UPLO, 0, ALPHA, X, 1, A ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_sspr(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, A ); + API_SUFFIX(cblas_sspr)(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, A ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_sspr(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, A ); + API_SUFFIX(cblas_sspr)(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, A ); chkxer(); - cblas_info = 2; RowMajorStrg = FALSE; - cblas_sspr(CblasColMajor, INVALID, 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; - 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; - 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) - printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout); + printf(" %-16s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout); else printf("******* %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout); + printf(" %-16s ERROR-EXIT TESTS:%9d RUN,%9d FAILED\n", + cblas_rout, (int) cblas_xtests, (int) cblas_xfails); } diff --git a/CBLAS/testing/c_s3chke.c b/CBLAS/testing/c_s3chke.c index 1872f005c6..7e3704fd70 100644 --- a/CBLAS/testing/c_s3chke.c +++ b/CBLAS/testing/c_s3chke.c @@ -3,448 +3,949 @@ #include "cblas.h" #include "cblas_test.h" -int cblas_ok, cblas_lerr, cblas_info; -int link_xerbla=TRUE; +CBLAS_INT cblas_ok, cblas_lerr, cblas_info; +CBLAS_INT link_xerbla=TRUE; +CBLAS_INT cblas_xtests, cblas_xfails, cblas_xbad; char *cblas_rout; #ifdef F77_Char -void F77_xerbla(F77_Char F77_srname, void *vinfo); +void F77_xerbla(F77_Char F77_srname, void *vinfo #else -void F77_xerbla(char *srname, void *vinfo); +void F77_xerbla(char *srname, void *vinfo #endif +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN srname_len +#endif +); void chkxer(void) { - extern int cblas_ok, cblas_lerr, cblas_info; - extern int link_xerbla; + extern CBLAS_INT cblas_ok, cblas_lerr, cblas_info; + extern CBLAS_INT link_xerbla; + extern CBLAS_INT cblas_xtests, cblas_xfails, cblas_xbad; extern char *cblas_rout; + cblas_xtests++; if (cblas_lerr == 1 ) { - printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", 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) { + cblas_xfails++; } + cblas_xbad = 0; cblas_lerr = 1 ; + } -void F77_s3chke(char *rout) { +void F77_s3chke(char *rout +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN rout_len +#endif +) { char *sf = ( rout ) ; float A[2] = {0.0,0.0}, B[2] = {0.0,0.0}, C[2] = {0.0,0.0}, ALPHA=0.0, BETA=0.0; - extern int cblas_info, cblas_lerr, cblas_ok; - extern int RowMajorStrg; + extern CBLAS_INT cblas_info, cblas_lerr, cblas_ok; extern char *cblas_rout; +#ifndef HAS_ATTRIBUTE_WEAK_SUPPORT + #ifdef CBLAS_DLL_IMPORTS + // Since Windows does not support weak symbols, and the trick below doesn't + // work for shared libraries on Windows, we skip the xerbla tests here. + printf("***** WARNING: Skipping xerbla tests since weak symbols are not supported on Windows *****\n"); + return; + #endif + if (link_xerbla) /* call these first to link */ { - cblas_xerbla(cblas_info,cblas_rout,""); - F77_xerbla(cblas_rout,&cblas_info); + API_SUFFIX(cblas_xerbla)(cblas_info,cblas_rout,""); + F77_xerbla(cblas_rout,&cblas_info, 1); } +#endif + link_xerbla = 0; cblas_ok = TRUE ; cblas_lerr = PASSED ; + cblas_xtests = 0; + cblas_xfails = 0; + cblas_xbad = 0; + + if (strncmp( sf,"cblas_sgemmtr" ,13)==0) { + cblas_rout = "cblas_sgemmtr" ; + + cblas_info = 1; + API_SUFFIX(cblas_sgemmtr)( INVALID_LAYOUT, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + API_SUFFIX(cblas_sgemmtr)( INVALID_LAYOUT, CblasUpper, CblasNoTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + API_SUFFIX(cblas_sgemmtr)( INVALID_LAYOUT, CblasUpper,CblasTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + API_SUFFIX(cblas_sgemmtr)( INVALID_LAYOUT, CblasUpper, CblasTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 1; + API_SUFFIX(cblas_sgemmtr)( INVALID_LAYOUT, CblasLower, CblasNoTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + API_SUFFIX(cblas_sgemmtr)( INVALID_LAYOUT, CblasLower, CblasNoTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + API_SUFFIX(cblas_sgemmtr)( INVALID_LAYOUT, CblasLower,CblasTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + API_SUFFIX(cblas_sgemmtr)( INVALID_LAYOUT, CblasLower, CblasTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 2; RowMajorStrg = FALSE; + API_SUFFIX(cblas_sgemmtr)( CblasColMajor, INVALID_UPLO, CblasNoTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = FALSE; + API_SUFFIX(cblas_sgemmtr)( CblasColMajor, INVALID_UPLO, CblasNoTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 3; RowMajorStrg = FALSE; + API_SUFFIX(cblas_sgemmtr)( CblasColMajor, CblasUpper, INVALID_TRANSPOSE, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = FALSE; + API_SUFFIX(cblas_sgemmtr)( CblasColMajor, CblasUpper, INVALID_TRANSPOSE, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 4; RowMajorStrg = FALSE; + API_SUFFIX(cblas_sgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, INVALID_TRANSPOSE, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = FALSE; + API_SUFFIX(cblas_sgemmtr)( CblasColMajor, CblasUpper, CblasTrans, INVALID_TRANSPOSE, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + + cblas_info = 5; RowMajorStrg = FALSE; + API_SUFFIX(cblas_sgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + API_SUFFIX(cblas_sgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + API_SUFFIX(cblas_sgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + API_SUFFIX(cblas_sgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 6; RowMajorStrg = FALSE; + API_SUFFIX(cblas_sgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = FALSE; + API_SUFFIX(cblas_sgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = FALSE; + API_SUFFIX(cblas_sgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = FALSE; + API_SUFFIX(cblas_sgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + + cblas_info = 9; RowMajorStrg = FALSE; + API_SUFFIX(cblas_sgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = FALSE; + API_SUFFIX(cblas_sgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = FALSE; + API_SUFFIX(cblas_sgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2, + ALPHA, A, 1, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 9; RowMajorStrg = FALSE; + API_SUFFIX(cblas_sgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 11; RowMajorStrg = FALSE; + API_SUFFIX(cblas_sgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = FALSE; + API_SUFFIX(cblas_sgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = FALSE; + API_SUFFIX(cblas_sgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 14; RowMajorStrg = FALSE; + API_SUFFIX(cblas_sgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = FALSE; + API_SUFFIX(cblas_sgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + + cblas_info = 14; RowMajorStrg = FALSE; + API_SUFFIX(cblas_sgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = FALSE; + API_SUFFIX(cblas_sgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + 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 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 6; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 9; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, 2, + ALPHA, A, 1, B, 2, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0, + ALPHA, A, 1, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 11; RowMajorStrg = TRUE; + 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)( 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)( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); - if (strncmp( sf,"cblas_sgemm" ,11)==0) { + cblas_info = 14; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + + } else if (strncmp( sf,"cblas_sgemm" ,11)==0) { cblas_rout = "cblas_sgemm" ; cblas_info = 1; - cblas_sgemm( INVALID, CblasNoTrans, CblasNoTrans, 0, 0, 0, + API_SUFFIX(cblas_sgemm)( INVALID_LAYOUT, CblasNoTrans, CblasNoTrans, 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 1; - cblas_sgemm( INVALID, CblasNoTrans, CblasTrans, 0, 0, 0, + API_SUFFIX(cblas_sgemm)( INVALID_LAYOUT, CblasNoTrans, CblasTrans, 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 1; - cblas_sgemm( INVALID, CblasTrans, CblasNoTrans, 0, 0, 0, + API_SUFFIX(cblas_sgemm)( INVALID_LAYOUT, CblasTrans, CblasNoTrans, 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 1; - cblas_sgemm( INVALID, CblasTrans, CblasTrans, 0, 0, 0, + API_SUFFIX(cblas_sgemm)( INVALID_LAYOUT, CblasTrans, CblasTrans, 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_sgemm( CblasColMajor, INVALID, CblasNoTrans, 0, 0, 0, + API_SUFFIX(cblas_sgemm)( CblasColMajor, INVALID_TRANSPOSE, CblasNoTrans, 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_sgemm( CblasColMajor, INVALID, CblasTrans, 0, 0, 0, + API_SUFFIX(cblas_sgemm)( CblasColMajor, INVALID_TRANSPOSE, CblasTrans, 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_sgemm( CblasColMajor, CblasNoTrans, INVALID, 0, 0, 0, + API_SUFFIX(cblas_sgemm)( CblasColMajor, CblasNoTrans, INVALID_TRANSPOSE, 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_sgemm( CblasColMajor, CblasTrans, INVALID, 0, 0, 0, + API_SUFFIX(cblas_sgemm)( CblasColMajor, CblasTrans, INVALID_TRANSPOSE, 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_sgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, INVALID, 0, 0, + API_SUFFIX(cblas_sgemm)( CblasColMajor, CblasNoTrans, CblasNoTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_sgemm( CblasColMajor, CblasNoTrans, CblasTrans, INVALID, 0, 0, + API_SUFFIX(cblas_sgemm)( CblasColMajor, CblasNoTrans, CblasTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_sgemm( CblasColMajor, CblasTrans, CblasNoTrans, INVALID, 0, 0, + API_SUFFIX(cblas_sgemm)( CblasColMajor, CblasTrans, CblasNoTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_sgemm( CblasColMajor, CblasTrans, CblasTrans, INVALID, 0, 0, + API_SUFFIX(cblas_sgemm)( CblasColMajor, CblasTrans, CblasTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_sgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, 0, INVALID, 0, + API_SUFFIX(cblas_sgemm)( CblasColMajor, CblasNoTrans, CblasNoTrans, 0, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_sgemm( CblasColMajor, CblasNoTrans, CblasTrans, 0, INVALID, 0, + API_SUFFIX(cblas_sgemm)( CblasColMajor, CblasNoTrans, CblasTrans, 0, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_sgemm( CblasColMajor, CblasTrans, CblasNoTrans, 0, INVALID, 0, + API_SUFFIX(cblas_sgemm)( CblasColMajor, CblasTrans, CblasNoTrans, 0, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_sgemm( CblasColMajor, CblasTrans, CblasTrans, 0, INVALID, 0, + API_SUFFIX(cblas_sgemm)( CblasColMajor, CblasTrans, CblasTrans, 0, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_sgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, 0, 0, INVALID, + API_SUFFIX(cblas_sgemm)( CblasColMajor, CblasNoTrans, CblasNoTrans, 0, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_sgemm( CblasColMajor, CblasNoTrans, CblasTrans, 0, 0, INVALID, + API_SUFFIX(cblas_sgemm)( CblasColMajor, CblasNoTrans, CblasTrans, 0, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_sgemm( CblasColMajor, CblasTrans, CblasNoTrans, 0, 0, INVALID, + API_SUFFIX(cblas_sgemm)( CblasColMajor, CblasTrans, CblasNoTrans, 0, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_sgemm( CblasColMajor, CblasTrans, CblasTrans, 0, 0, INVALID, + API_SUFFIX(cblas_sgemm)( CblasColMajor, CblasTrans, CblasTrans, 0, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_sgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, 2, 0, 0, + API_SUFFIX(cblas_sgemm)( CblasColMajor, CblasNoTrans, CblasNoTrans, 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_sgemm( CblasColMajor, CblasNoTrans, CblasTrans, 2, 0, 0, + API_SUFFIX(cblas_sgemm)( CblasColMajor, CblasNoTrans, CblasTrans, 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_sgemm( CblasColMajor, CblasTrans, CblasNoTrans, 0, 0, 2, + API_SUFFIX(cblas_sgemm)( CblasColMajor, CblasTrans, CblasNoTrans, 0, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_sgemm( CblasColMajor, CblasTrans, CblasTrans, 0, 0, 2, + API_SUFFIX(cblas_sgemm)( CblasColMajor, CblasTrans, CblasTrans, 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_sgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, 0, 0, 2, + API_SUFFIX(cblas_sgemm)( CblasColMajor, CblasNoTrans, CblasNoTrans, 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_sgemm( CblasColMajor, CblasTrans, CblasNoTrans, 0, 0, 2, + API_SUFFIX(cblas_sgemm)( CblasColMajor, CblasTrans, CblasNoTrans, 0, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_sgemm( CblasColMajor, CblasNoTrans, CblasTrans, 0, 2, 0, + API_SUFFIX(cblas_sgemm)( CblasColMajor, CblasNoTrans, CblasTrans, 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_sgemm( CblasColMajor, CblasTrans, CblasTrans, 0, 2, 0, + API_SUFFIX(cblas_sgemm)( CblasColMajor, CblasTrans, CblasTrans, 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = FALSE; - cblas_sgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, 2, 0, 0, + API_SUFFIX(cblas_sgemm)( CblasColMajor, CblasNoTrans, CblasNoTrans, 2, 0, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = FALSE; - cblas_sgemm( CblasColMajor, CblasNoTrans, CblasTrans, 2, 0, 0, + API_SUFFIX(cblas_sgemm)( CblasColMajor, CblasNoTrans, CblasTrans, 2, 0, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = FALSE; - cblas_sgemm( CblasColMajor, CblasTrans, CblasNoTrans, 2, 0, 0, + API_SUFFIX(cblas_sgemm)( CblasColMajor, CblasTrans, CblasNoTrans, 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = FALSE; - cblas_sgemm( CblasColMajor, CblasTrans, CblasTrans, 2, 0, 0, + API_SUFFIX(cblas_sgemm)( 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_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; - cblas_sgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, INVALID, 0, 0, + API_SUFFIX(cblas_sgemm)( CblasRowMajor, CblasNoTrans, CblasNoTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_sgemm( CblasRowMajor, CblasNoTrans, CblasTrans, INVALID, 0, 0, + API_SUFFIX(cblas_sgemm)( CblasRowMajor, CblasNoTrans, CblasTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_sgemm( CblasRowMajor, CblasTrans, CblasNoTrans, INVALID, 0, 0, + API_SUFFIX(cblas_sgemm)( CblasRowMajor, CblasTrans, CblasNoTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_sgemm( CblasRowMajor, CblasTrans, CblasTrans, INVALID, 0, 0, + API_SUFFIX(cblas_sgemm)( CblasRowMajor, CblasTrans, CblasTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_sgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, INVALID, 0, + API_SUFFIX(cblas_sgemm)( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_sgemm( CblasRowMajor, CblasNoTrans, CblasTrans, 0, INVALID, 0, + API_SUFFIX(cblas_sgemm)( CblasRowMajor, CblasNoTrans, CblasTrans, 0, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_sgemm( CblasRowMajor, CblasTrans, CblasNoTrans, 0, INVALID, 0, + API_SUFFIX(cblas_sgemm)( CblasRowMajor, CblasTrans, CblasNoTrans, 0, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_sgemm( CblasRowMajor, CblasTrans, CblasTrans, 0, INVALID, 0, + API_SUFFIX(cblas_sgemm)( CblasRowMajor, CblasTrans, CblasTrans, 0, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_sgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 0, INVALID, + API_SUFFIX(cblas_sgemm)( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_sgemm( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 0, INVALID, + API_SUFFIX(cblas_sgemm)( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_sgemm( CblasRowMajor, CblasTrans, CblasNoTrans, 0, 0, INVALID, + API_SUFFIX(cblas_sgemm)( CblasRowMajor, CblasTrans, CblasNoTrans, 0, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_sgemm( CblasRowMajor, CblasTrans, CblasTrans, 0, 0, INVALID, + API_SUFFIX(cblas_sgemm)( CblasRowMajor, CblasTrans, CblasTrans, 0, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemm)( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemm)( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 0, 2, + ALPHA, A, 1, B, 2, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemm)( CblasRowMajor, CblasTrans, CblasNoTrans, 2, 0, 0, + ALPHA, A, 1, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemm)( CblasRowMajor, CblasTrans, CblasTrans, 2, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemm)( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemm)( CblasRowMajor, CblasTrans, CblasNoTrans, 0, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemm)( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 0, 2, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemm)( CblasRowMajor, CblasTrans, CblasTrans, 0, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemm)( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 2, 0, + ALPHA, A, 1, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemm)( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemm)( CblasRowMajor, CblasTrans, CblasNoTrans, 0, 2, 0, + ALPHA, A, 1, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemm)( CblasRowMajor, CblasTrans, CblasTrans, 0, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + } else if (strncmp( sf,"cblas_ssymm" ,11)==0) { + cblas_rout = "cblas_ssymm" ; + + cblas_info = 1; + API_SUFFIX(cblas_ssymm)( INVALID_LAYOUT, CblasRight, CblasLower, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssymm)( CblasColMajor, INVALID_SIDE, CblasUpper, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssymm)( CblasColMajor, CblasLeft, INVALID_UPLO, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssymm)( CblasColMajor, CblasLeft, CblasUpper, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssymm)( CblasColMajor, CblasRight, CblasUpper, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssymm)( CblasColMajor, CblasLeft, CblasLower, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssymm)( CblasColMajor, CblasRight, CblasLower, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssymm)( CblasColMajor, CblasLeft, CblasUpper, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssymm)( CblasColMajor, CblasRight, CblasUpper, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssymm)( CblasColMajor, CblasLeft, CblasLower, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssymm)( CblasColMajor, CblasRight, CblasLower, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 8; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssymm)( CblasColMajor, CblasLeft, CblasUpper, 2, 0, + ALPHA, A, 1, B, 2, BETA, C, 2 ); + chkxer(); + cblas_info = 8; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssymm)( CblasColMajor, CblasRight, CblasUpper, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 8; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssymm)( CblasColMajor, CblasLeft, CblasLower, 2, 0, + ALPHA, A, 1, B, 2, BETA, C, 2 ); + chkxer(); + cblas_info = 8; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssymm)( CblasColMajor, CblasRight, CblasLower, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 10; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssymm)( CblasColMajor, CblasLeft, CblasUpper, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 10; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssymm)( CblasColMajor, CblasRight, CblasUpper, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 10; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssymm)( CblasColMajor, CblasLeft, CblasLower, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 10; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssymm)( CblasColMajor, CblasRight, CblasLower, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 13; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssymm)( CblasColMajor, CblasLeft, CblasUpper, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 13; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssymm)( CblasColMajor, CblasRight, CblasUpper, 2, 0, + ALPHA, A, 1, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 13; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssymm)( CblasColMajor, CblasLeft, CblasLower, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 13; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssymm)( CblasColMajor, CblasRight, CblasLower, 2, 0, + 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 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssymm)( CblasRowMajor, CblasRight, CblasUpper, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssymm)( CblasRowMajor, CblasLeft, CblasLower, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssymm)( CblasRowMajor, CblasRight, CblasLower, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssymm)( CblasRowMajor, CblasLeft, CblasUpper, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssymm)( CblasRowMajor, CblasRight, CblasUpper, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssymm)( CblasRowMajor, CblasLeft, CblasLower, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); - cblas_info = 9; RowMajorStrg = TRUE; - cblas_sgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 0, 2, - ALPHA, A, 1, B, 1, BETA, C, 2 ); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssymm)( CblasRowMajor, CblasRight, CblasLower, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); - cblas_info = 9; RowMajorStrg = TRUE; - cblas_sgemm( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 0, 2, + cblas_info = 8; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssymm)( CblasRowMajor, CblasLeft, CblasUpper, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); - cblas_info = 9; RowMajorStrg = TRUE; - cblas_sgemm( CblasRowMajor, CblasTrans, CblasNoTrans, 2, 0, 0, - ALPHA, A, 1, B, 2, BETA, C, 1 ); - chkxer(); - cblas_info = 9; RowMajorStrg = TRUE; - cblas_sgemm( CblasRowMajor, CblasTrans, CblasTrans, 2, 0, 0, + cblas_info = 8; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssymm)( CblasRowMajor, CblasRight, CblasUpper, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); - cblas_info = 11; RowMajorStrg = TRUE; - cblas_sgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 2, 0, + cblas_info = 8; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssymm)( CblasRowMajor, CblasLeft, CblasLower, 2, 0, + ALPHA, A, 1, B, 2, BETA, C, 2 ); + chkxer(); + cblas_info = 8; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssymm)( CblasRowMajor, CblasRight, CblasLower, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); - cblas_info = 11; RowMajorStrg = TRUE; - cblas_sgemm( CblasRowMajor, CblasTrans, CblasNoTrans, 0, 2, 0, + cblas_info = 10; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssymm)( CblasRowMajor, CblasLeft, CblasUpper, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); - cblas_info = 11; RowMajorStrg = TRUE; - cblas_sgemm( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 0, 2, + cblas_info = 10; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssymm)( CblasRowMajor, CblasRight, CblasUpper, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); - cblas_info = 11; RowMajorStrg = TRUE; - cblas_sgemm( CblasRowMajor, CblasTrans, CblasTrans, 0, 0, 2, - ALPHA, A, 1, B, 1, BETA, C, 1 ); + cblas_info = 10; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssymm)( CblasRowMajor, CblasLeft, CblasLower, 0, 2, + ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); - cblas_info = 14; RowMajorStrg = TRUE; - cblas_sgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 2, 0, + cblas_info = 10; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssymm)( CblasRowMajor, CblasRight, CblasLower, 0, 2, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 13; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssymm)( CblasRowMajor, CblasLeft, CblasUpper, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); - cblas_info = 14; RowMajorStrg = TRUE; - cblas_sgemm( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 2, 0, - ALPHA, A, 1, B, 1, BETA, C, 1 ); + cblas_info = 13; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssymm)( CblasRowMajor, CblasRight, CblasUpper, 0, 2, + ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); - cblas_info = 14; RowMajorStrg = TRUE; - cblas_sgemm( CblasRowMajor, CblasTrans, CblasNoTrans, 0, 2, 0, + cblas_info = 13; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssymm)( CblasRowMajor, CblasLeft, CblasLower, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); - cblas_info = 14; RowMajorStrg = TRUE; - cblas_sgemm( CblasRowMajor, CblasTrans, CblasTrans, 0, 2, 0, - ALPHA, A, 1, B, 1, BETA, C, 1 ); + cblas_info = 13; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssymm)( CblasRowMajor, CblasRight, CblasLower, 0, 2, + ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); - } else if (strncmp( sf,"cblas_ssymm" ,11)==0) { - cblas_rout = "cblas_ssymm" ; + } else if (strncmp( sf,"cblas_sskewsymm" ,15)==0) { + cblas_rout = "cblas_sskewsymm" ; cblas_info = 1; - cblas_ssymm( INVALID, CblasRight, CblasLower, 0, 0, + API_SUFFIX(cblas_sskewsymm)( INVALID_LAYOUT, CblasRight, CblasLower, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_ssymm( CblasColMajor, INVALID, CblasUpper, 0, 0, + API_SUFFIX(cblas_sskewsymm)( CblasColMajor, INVALID_SIDE, CblasUpper, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_ssymm( CblasColMajor, CblasLeft, INVALID, 0, 0, + API_SUFFIX(cblas_sskewsymm)( CblasColMajor, CblasLeft, INVALID_UPLO, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_ssymm( CblasColMajor, CblasLeft, CblasUpper, INVALID, 0, + API_SUFFIX(cblas_sskewsymm)( CblasColMajor, CblasLeft, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_ssymm( CblasColMajor, CblasRight, CblasUpper, INVALID, 0, + API_SUFFIX(cblas_sskewsymm)( CblasColMajor, CblasRight, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_ssymm( CblasColMajor, CblasLeft, CblasLower, INVALID, 0, + API_SUFFIX(cblas_sskewsymm)( CblasColMajor, CblasLeft, CblasLower, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_ssymm( CblasColMajor, CblasRight, CblasLower, INVALID, 0, + API_SUFFIX(cblas_sskewsymm)( CblasColMajor, CblasRight, CblasLower, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_ssymm( CblasColMajor, CblasLeft, CblasUpper, 0, INVALID, + API_SUFFIX(cblas_sskewsymm)( CblasColMajor, CblasLeft, CblasUpper, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_ssymm( CblasColMajor, CblasRight, CblasUpper, 0, INVALID, + API_SUFFIX(cblas_sskewsymm)( CblasColMajor, CblasRight, CblasUpper, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_ssymm( CblasColMajor, CblasLeft, CblasLower, 0, INVALID, + API_SUFFIX(cblas_sskewsymm)( CblasColMajor, CblasLeft, CblasLower, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_ssymm( CblasColMajor, CblasRight, CblasLower, 0, INVALID, + API_SUFFIX(cblas_sskewsymm)( CblasColMajor, CblasRight, CblasLower, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_ssymm( CblasColMajor, CblasLeft, CblasUpper, 2, 0, + API_SUFFIX(cblas_sskewsymm)( CblasColMajor, CblasLeft, CblasUpper, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_ssymm( CblasColMajor, CblasRight, CblasUpper, 0, 2, + API_SUFFIX(cblas_sskewsymm)( CblasColMajor, CblasRight, CblasUpper, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_ssymm( CblasColMajor, CblasLeft, CblasLower, 2, 0, + API_SUFFIX(cblas_sskewsymm)( CblasColMajor, CblasLeft, CblasLower, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_ssymm( CblasColMajor, CblasRight, CblasLower, 0, 2, + API_SUFFIX(cblas_sskewsymm)( CblasColMajor, CblasRight, CblasLower, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ssymm( CblasColMajor, CblasLeft, CblasUpper, 2, 0, + API_SUFFIX(cblas_sskewsymm)( CblasColMajor, CblasLeft, CblasUpper, 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ssymm( CblasColMajor, CblasRight, CblasUpper, 2, 0, + API_SUFFIX(cblas_sskewsymm)( CblasColMajor, CblasRight, CblasUpper, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ssymm( CblasColMajor, CblasLeft, CblasLower, 2, 0, + API_SUFFIX(cblas_sskewsymm)( CblasColMajor, CblasLeft, CblasLower, 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ssymm( CblasColMajor, CblasRight, CblasLower, 2, 0, + API_SUFFIX(cblas_sskewsymm)( CblasColMajor, CblasRight, CblasLower, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_ssymm( CblasColMajor, CblasLeft, CblasUpper, 2, 0, + API_SUFFIX(cblas_sskewsymm)( CblasColMajor, CblasLeft, CblasUpper, 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_ssymm( CblasColMajor, CblasRight, CblasUpper, 2, 0, + API_SUFFIX(cblas_sskewsymm)( CblasColMajor, CblasRight, CblasUpper, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_ssymm( CblasColMajor, CblasLeft, CblasLower, 2, 0, + API_SUFFIX(cblas_sskewsymm)( CblasColMajor, CblasLeft, CblasLower, 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_ssymm( CblasColMajor, CblasRight, CblasLower, 2, 0, + API_SUFFIX(cblas_sskewsymm)( CblasColMajor, CblasRight, CblasLower, 2, 0, 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; - cblas_ssymm( CblasRowMajor, CblasLeft, CblasUpper, INVALID, 0, + API_SUFFIX(cblas_sskewsymm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_ssymm( CblasRowMajor, CblasRight, CblasUpper, INVALID, 0, + API_SUFFIX(cblas_sskewsymm)( CblasRowMajor, CblasRight, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_ssymm( CblasRowMajor, CblasLeft, CblasLower, INVALID, 0, + API_SUFFIX(cblas_sskewsymm)( CblasRowMajor, CblasLeft, CblasLower, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_ssymm( CblasRowMajor, CblasRight, CblasLower, INVALID, 0, + API_SUFFIX(cblas_sskewsymm)( CblasRowMajor, CblasRight, CblasLower, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_ssymm( CblasRowMajor, CblasLeft, CblasUpper, 0, INVALID, + API_SUFFIX(cblas_sskewsymm)( CblasRowMajor, CblasLeft, CblasUpper, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_ssymm( CblasRowMajor, CblasRight, CblasUpper, 0, INVALID, + API_SUFFIX(cblas_sskewsymm)( CblasRowMajor, CblasRight, CblasUpper, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_ssymm( CblasRowMajor, CblasLeft, CblasLower, 0, INVALID, + API_SUFFIX(cblas_sskewsymm)( CblasRowMajor, CblasLeft, CblasLower, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_ssymm( CblasRowMajor, CblasRight, CblasLower, 0, INVALID, + API_SUFFIX(cblas_sskewsymm)( CblasRowMajor, CblasRight, CblasLower, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_ssymm( CblasRowMajor, CblasLeft, CblasUpper, 2, 0, + API_SUFFIX(cblas_sskewsymm)( CblasRowMajor, CblasLeft, CblasUpper, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_ssymm( CblasRowMajor, CblasRight, CblasUpper, 0, 2, + API_SUFFIX(cblas_sskewsymm)( CblasRowMajor, CblasRight, CblasUpper, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_ssymm( CblasRowMajor, CblasLeft, CblasLower, 2, 0, + API_SUFFIX(cblas_sskewsymm)( CblasRowMajor, CblasLeft, CblasLower, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_ssymm( CblasRowMajor, CblasRight, CblasLower, 0, 2, + API_SUFFIX(cblas_sskewsymm)( CblasRowMajor, CblasRight, CblasLower, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ssymm( CblasRowMajor, CblasLeft, CblasUpper, 0, 2, + API_SUFFIX(cblas_sskewsymm)( CblasRowMajor, CblasLeft, CblasUpper, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ssymm( CblasRowMajor, CblasRight, CblasUpper, 0, 2, + API_SUFFIX(cblas_sskewsymm)( CblasRowMajor, CblasRight, CblasUpper, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ssymm( CblasRowMajor, CblasLeft, CblasLower, 0, 2, + API_SUFFIX(cblas_sskewsymm)( CblasRowMajor, CblasLeft, CblasLower, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ssymm( CblasRowMajor, CblasRight, CblasLower, 0, 2, + API_SUFFIX(cblas_sskewsymm)( CblasRowMajor, CblasRight, CblasLower, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_ssymm( CblasRowMajor, CblasLeft, CblasUpper, 0, 2, + API_SUFFIX(cblas_sskewsymm)( CblasRowMajor, CblasLeft, CblasUpper, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_ssymm( CblasRowMajor, CblasRight, CblasUpper, 0, 2, + API_SUFFIX(cblas_sskewsymm)( CblasRowMajor, CblasRight, CblasUpper, 0, 2, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_ssymm( CblasRowMajor, CblasLeft, CblasLower, 0, 2, + API_SUFFIX(cblas_sskewsymm)( CblasRowMajor, CblasLeft, CblasLower, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_ssymm( CblasRowMajor, CblasRight, CblasLower, 0, 2, + API_SUFFIX(cblas_sskewsymm)( CblasRowMajor, CblasRight, CblasLower, 0, 2, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); @@ -452,280 +953,297 @@ void F77_s3chke(char *rout) { cblas_rout = "cblas_strmm" ; cblas_info = 1; - cblas_strmm( INVALID, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strmm)( INVALID_LAYOUT, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, INVALID_SIDE, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasLeft, INVALID, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasLeft, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasLeft, CblasUpper, INVALID, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasLeft, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, - INVALID, 0, 0, ALPHA, A, 1, B, 1 ); + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_strmm( CblasColMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_strmm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, 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; - cblas_strmm( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_strmm( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_strmm( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_strmm( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_strmm( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_strmm( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_strmm( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_strmm( CblasRowMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_strmm( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_strmm( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_strmm( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_strmm( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_strmm( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_strmm( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_strmm( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_strmm( CblasRowMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_strmm( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_strmm( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_strmm( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_strmm( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_strmm( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_strmm( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_strmm( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_strmm( CblasRowMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_strmm( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_strmm( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_strmm( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_strmm( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_strmm( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_strmm( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_strmm( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_strmm( CblasRowMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 2, B, 1 ); chkxer(); @@ -733,280 +1251,297 @@ void F77_s3chke(char *rout) { cblas_rout = "cblas_strsm" ; cblas_info = 1; - cblas_strsm( INVALID, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strsm)( INVALID_LAYOUT, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, INVALID_SIDE, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasLeft, INVALID, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasLeft, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasLeft, CblasUpper, INVALID, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasLeft, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, - INVALID, 0, 0, ALPHA, A, 1, B, 1 ); + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_strsm( CblasColMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_strsm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, 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; - cblas_strsm( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_strsm( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_strsm( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_strsm( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_strsm( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_strsm( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_strsm( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_strsm( CblasRowMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_strsm( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_strsm( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_strsm( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_strsm( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_strsm( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_strsm( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_strsm( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_strsm( CblasRowMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_strsm( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_strsm( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_strsm( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_strsm( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_strsm( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_strsm( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_strsm( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_strsm( CblasRowMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_strsm( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_strsm( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_strsm( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_strsm( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_strsm( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_strsm( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_strsm( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_strsm( CblasRowMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 2, B, 1 ); chkxer(); @@ -1014,111 +1549,153 @@ void F77_s3chke(char *rout) { cblas_rout = "cblas_ssyrk" ; cblas_info = 1; - cblas_ssyrk( INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ssyrk)( INVALID_LAYOUT, CblasUpper, CblasNoTrans, 0, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_ssyrk( CblasColMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_ssyrk)( CblasColMajor, INVALID_UPLO, CblasNoTrans, 0, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_ssyrk( CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_ssyrk)( CblasColMajor, CblasUpper, INVALID_TRANSPOSE, 0, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_ssyrk( CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ssyrk)( CblasColMajor, CblasUpper, CblasNoTrans, INVALID, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_ssyrk( CblasColMajor, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ssyrk)( CblasColMajor, CblasUpper, CblasTrans, INVALID, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_ssyrk( CblasColMajor, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ssyrk)( CblasColMajor, CblasLower, CblasNoTrans, INVALID, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_ssyrk( CblasColMajor, CblasLower, CblasTrans, + API_SUFFIX(cblas_ssyrk)( CblasColMajor, CblasLower, CblasTrans, INVALID, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_ssyrk( CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ssyrk)( CblasColMajor, CblasUpper, CblasNoTrans, 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_ssyrk( CblasColMajor, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ssyrk)( CblasColMajor, CblasUpper, CblasTrans, 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_ssyrk( CblasColMajor, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ssyrk)( CblasColMajor, CblasLower, CblasNoTrans, 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_ssyrk( CblasColMajor, CblasLower, CblasTrans, + 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; - cblas_ssyrk( CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ssyrk)( CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_ssyrk( CblasRowMajor, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ssyrk)( CblasRowMajor, CblasUpper, CblasTrans, 2, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_ssyrk( CblasRowMajor, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ssyrk)( CblasRowMajor, CblasLower, CblasNoTrans, 0, 2, ALPHA, A, 1, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_ssyrk( CblasRowMajor, CblasLower, CblasTrans, + API_SUFFIX(cblas_ssyrk)( CblasRowMajor, CblasLower, CblasTrans, 2, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_ssyrk( CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ssyrk)( CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 1, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_ssyrk( CblasColMajor, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ssyrk)( CblasColMajor, CblasUpper, CblasTrans, 0, 2, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_ssyrk( CblasColMajor, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ssyrk)( CblasColMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 1, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_ssyrk( CblasColMajor, CblasLower, CblasTrans, + API_SUFFIX(cblas_ssyrk)( CblasColMajor, CblasLower, CblasTrans, 0, 2, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_ssyrk( CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ssyrk)( CblasRowMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_ssyrk( CblasRowMajor, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ssyrk)( CblasRowMajor, CblasUpper, CblasTrans, 2, 0, ALPHA, A, 2, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_ssyrk( CblasRowMajor, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ssyrk)( CblasRowMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_ssyrk( CblasRowMajor, CblasLower, CblasTrans, + API_SUFFIX(cblas_ssyrk)( CblasRowMajor, CblasLower, CblasTrans, 2, 0, ALPHA, A, 2, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_ssyrk( CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ssyrk)( CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 2, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_ssyrk( CblasColMajor, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ssyrk)( CblasColMajor, CblasUpper, CblasTrans, 2, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_ssyrk( CblasColMajor, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ssyrk)( CblasColMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 2, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_ssyrk( CblasColMajor, CblasLower, CblasTrans, + API_SUFFIX(cblas_ssyrk)( CblasColMajor, CblasLower, CblasTrans, 2, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); @@ -1126,148 +1703,377 @@ void F77_s3chke(char *rout) { cblas_rout = "cblas_ssyr2k" ; cblas_info = 1; - cblas_ssyr2k( INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ssyr2k)( INVALID_LAYOUT, CblasUpper, CblasNoTrans, + 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssyr2k)( CblasColMajor, INVALID_UPLO, CblasNoTrans, + 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssyr2k)( CblasColMajor, CblasUpper, INVALID_TRANSPOSE, + 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssyr2k)( CblasColMajor, CblasUpper, CblasNoTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssyr2k)( CblasColMajor, CblasUpper, CblasTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssyr2k)( CblasColMajor, CblasLower, CblasNoTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssyr2k)( CblasColMajor, CblasLower, CblasTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssyr2k)( CblasColMajor, CblasUpper, CblasNoTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssyr2k)( CblasColMajor, CblasUpper, CblasTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssyr2k)( CblasColMajor, CblasLower, CblasNoTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + 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 ); + chkxer(); + cblas_info = 8; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, CblasUpper, CblasTrans, + 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 8; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, CblasLower, CblasNoTrans, + 0, 2, ALPHA, A, 1, B, 2, BETA, C, 2 ); + chkxer(); + cblas_info = 8; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, CblasLower, CblasTrans, + 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 8; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssyr2k)( CblasColMajor, CblasUpper, CblasNoTrans, + 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 8; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssyr2k)( CblasColMajor, CblasUpper, CblasTrans, + 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 8; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssyr2k)( CblasColMajor, CblasLower, CblasNoTrans, + 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 8; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssyr2k)( CblasColMajor, CblasLower, CblasTrans, + 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 10; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, + 0, 2, ALPHA, A, 2, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 10; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, CblasUpper, CblasTrans, + 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 10; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, CblasLower, CblasNoTrans, + 0, 2, ALPHA, A, 2, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 10; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, CblasLower, CblasTrans, + 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 10; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssyr2k)( CblasColMajor, CblasUpper, CblasNoTrans, + 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 10; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssyr2k)( CblasColMajor, CblasUpper, CblasTrans, + 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 10; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssyr2k)( CblasColMajor, CblasLower, CblasNoTrans, + 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 10; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssyr2k)( CblasColMajor, CblasLower, CblasTrans, + 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 13; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, + 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 13; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, CblasUpper, CblasTrans, + 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 13; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, CblasLower, CblasNoTrans, + 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 13; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, CblasLower, CblasTrans, + 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 13; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssyr2k)( CblasColMajor, CblasUpper, CblasNoTrans, + 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 13; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssyr2k)( CblasColMajor, CblasUpper, CblasTrans, + 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 13; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssyr2k)( CblasColMajor, CblasLower, CblasNoTrans, + 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 13; RowMajorStrg = FALSE; + API_SUFFIX(cblas_ssyr2k)( CblasColMajor, CblasLower, CblasTrans, + 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + } else if (strncmp( sf,"cblas_sskewsyr2k" ,16)==0) { + cblas_rout = "cblas_sskewsyr2k" ; + + cblas_info = 1; + API_SUFFIX(cblas_sskewsyr2k)( INVALID_LAYOUT, CblasUpper, CblasNoTrans, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_ssyr2k( CblasColMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_sskewsyr2k)( CblasColMajor, INVALID_UPLO, CblasNoTrans, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_ssyr2k( CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_sskewsyr2k)( CblasColMajor, CblasUpper, INVALID_TRANSPOSE, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_ssyr2k( CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_sskewsyr2k)( CblasColMajor, CblasUpper, CblasNoTrans, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_ssyr2k( CblasColMajor, CblasUpper, CblasTrans, + API_SUFFIX(cblas_sskewsyr2k)( CblasColMajor, CblasUpper, CblasTrans, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_ssyr2k( CblasColMajor, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_sskewsyr2k)( CblasColMajor, CblasLower, CblasNoTrans, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_ssyr2k( CblasColMajor, CblasLower, CblasTrans, + API_SUFFIX(cblas_sskewsyr2k)( CblasColMajor, CblasLower, CblasTrans, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_ssyr2k( CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_sskewsyr2k)( CblasColMajor, CblasUpper, CblasNoTrans, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_ssyr2k( CblasColMajor, CblasUpper, CblasTrans, + API_SUFFIX(cblas_sskewsyr2k)( CblasColMajor, CblasUpper, CblasTrans, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_ssyr2k( CblasColMajor, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_sskewsyr2k)( CblasColMajor, CblasLower, CblasNoTrans, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_ssyr2k( CblasColMajor, CblasLower, CblasTrans, + 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; - cblas_ssyr2k( CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_ssyr2k( CblasRowMajor, CblasUpper, CblasTrans, + API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, CblasUpper, CblasTrans, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_ssyr2k( CblasRowMajor, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, CblasLower, CblasNoTrans, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_ssyr2k( CblasRowMajor, CblasLower, CblasTrans, + API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, CblasLower, CblasTrans, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_ssyr2k( CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_sskewsyr2k)( CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_ssyr2k( CblasColMajor, CblasUpper, CblasTrans, + API_SUFFIX(cblas_sskewsyr2k)( CblasColMajor, CblasUpper, CblasTrans, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_ssyr2k( CblasColMajor, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_sskewsyr2k)( CblasColMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_ssyr2k( CblasColMajor, CblasLower, CblasTrans, + API_SUFFIX(cblas_sskewsyr2k)( CblasColMajor, CblasLower, CblasTrans, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ssyr2k( CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ssyr2k( CblasRowMajor, CblasUpper, CblasTrans, + API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, CblasUpper, CblasTrans, 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ssyr2k( CblasRowMajor, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, CblasLower, CblasNoTrans, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ssyr2k( CblasRowMajor, CblasLower, CblasTrans, + API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, CblasLower, CblasTrans, 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ssyr2k( CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_sskewsyr2k)( CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ssyr2k( CblasColMajor, CblasUpper, CblasTrans, + API_SUFFIX(cblas_sskewsyr2k)( CblasColMajor, CblasUpper, CblasTrans, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ssyr2k( CblasColMajor, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_sskewsyr2k)( CblasColMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ssyr2k( CblasColMajor, CblasLower, CblasTrans, + API_SUFFIX(cblas_sskewsyr2k)( CblasColMajor, CblasLower, CblasTrans, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_ssyr2k( CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_ssyr2k( CblasRowMajor, CblasUpper, CblasTrans, + API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, CblasUpper, CblasTrans, 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_ssyr2k( CblasRowMajor, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_ssyr2k( CblasRowMajor, CblasLower, CblasTrans, + API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, CblasLower, CblasTrans, 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_ssyr2k( CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_sskewsyr2k)( CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_ssyr2k( CblasColMajor, CblasUpper, CblasTrans, + API_SUFFIX(cblas_sskewsyr2k)( CblasColMajor, CblasUpper, CblasTrans, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_ssyr2k( CblasColMajor, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_sskewsyr2k)( CblasColMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_ssyr2k( CblasColMajor, CblasLower, CblasTrans, + API_SUFFIX(cblas_sskewsyr2k)( CblasColMajor, CblasLower, CblasTrans, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); } if (cblas_ok == TRUE ) - printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout); + printf(" %-17s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout); else printf("***** %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout); + printf(" %-17s ERROR-EXIT TESTS:%9d RUN,%9d FAILED\n", + cblas_rout, (int) cblas_xtests, (int) cblas_xfails); } diff --git a/CBLAS/testing/c_sblas1.c b/CBLAS/testing/c_sblas1.c index 2e63d98148..401e9f2af5 100644 --- a/CBLAS/testing/c_sblas1.c +++ b/CBLAS/testing/c_sblas1.c @@ -8,75 +8,72 @@ */ #include "cblas_test.h" #include "cblas.h" -float F77_sasum(const int *N, float *X, const int *incX) +float F77_sasum(const CBLAS_INT *N, float *X, const CBLAS_INT *incX) { - return cblas_sasum(*N, X, *incX); + return API_SUFFIX(cblas_sasum)(*N, X, *incX); } -void F77_saxpy(const int *N, const float *alpha, const float *X, - const int *incX, float *Y, const int *incY) +void F77_saxpy(const CBLAS_INT *N, const float *alpha, const float *X, + const CBLAS_INT *incX, float *Y, const CBLAS_INT *incY) { - cblas_saxpy(*N, *alpha, X, *incX, Y, *incY); + API_SUFFIX(cblas_saxpy)(*N, *alpha, X, *incX, Y, *incY); return; } -float F77_scasum(const int *N, void *X, const int *incX) +void F77_saxpby(const CBLAS_INT *N, const float *alpha, const float *X, + const CBLAS_INT *incX, const float *beta, float *Y, const CBLAS_INT *incY) { - return cblas_scasum(*N, X, *incX); -} - -float F77_scnrm2(const int *N, const void *X, const int *incX) -{ - return cblas_scnrm2(*N, X, *incX); + API_SUFFIX(cblas_saxpby)(*N, *alpha, X, *incX, *beta, Y, *incY); + return; } -void F77_scopy(const int *N, const float *X, const int *incX, - float *Y, const int *incY) +void F77_scopy(const CBLAS_INT *N, const float *X, const CBLAS_INT *incX, + float *Y, const CBLAS_INT *incY) { - cblas_scopy(*N, X, *incX, Y, *incY); + API_SUFFIX(cblas_scopy)(*N, X, *incX, Y, *incY); return; } -float F77_sdot(const int *N, const float *X, const int *incX, - const float *Y, const int *incY) +float F77_sdot(const CBLAS_INT *N, const float *X, const CBLAS_INT *incX, + const float *Y, const CBLAS_INT *incY) { - return cblas_sdot(*N, X, *incX, Y, *incY); + return API_SUFFIX(cblas_sdot)(*N, X, *incX, Y, *incY); } -float F77_snrm2(const int *N, const float *X, const int *incX) +float F77_snrm2(const CBLAS_INT *N, const float *X, const CBLAS_INT *incX) { - return cblas_snrm2(*N, X, *incX); + return API_SUFFIX(cblas_snrm2)(*N, X, *incX); } void F77_srotg( float *a, float *b, float *c, float *s) { - cblas_srotg(a,b,c,s); + API_SUFFIX(cblas_srotg)(a,b,c,s); return; } -void F77_srot( const int *N, float *X, const int *incX, float *Y, - const int *incY, const float *c, const float *s) +void F77_srot( const CBLAS_INT *N, float *X, const CBLAS_INT *incX, float *Y, + const CBLAS_INT *incY, const float *c, const float *s) { - cblas_srot(*N,X,*incX,Y,*incY,*c,*s); + API_SUFFIX(cblas_srot)(*N,X,*incX,Y,*incY,*c,*s); return; } -void F77_sscal(const int *N, const float *alpha, float *X, - const int *incX) +void F77_sscal(const CBLAS_INT *N, const float *alpha, float *X, + const CBLAS_INT *incX) { - cblas_sscal(*N, *alpha, X, *incX); + API_SUFFIX(cblas_sscal)(*N, *alpha, X, *incX); return; } -void F77_sswap( const int *N, float *X, const int *incX, - float *Y, const int *incY) +void F77_sswap( const CBLAS_INT *N, float *X, const CBLAS_INT *incX, + float *Y, const CBLAS_INT *incY) { - cblas_sswap(*N,X,*incX,Y,*incY); + API_SUFFIX(cblas_sswap)(*N,X,*incX,Y,*incY); return; } -int F77_isamax(const int *N, const float *X, const int *incX) +CBLAS_INT F77_isamax(const CBLAS_INT *N, const float *X, const CBLAS_INT *incX) { if (*N < 1 || *incX < 1) return(0); - return (cblas_isamax(*N, X, *incX)+1); + return (API_SUFFIX(cblas_isamax)(*N, X, *incX)+1); } diff --git a/CBLAS/testing/c_sblas2.c b/CBLAS/testing/c_sblas2.c index f119504872..682c904780 100644 --- a/CBLAS/testing/c_sblas2.c +++ b/CBLAS/testing/c_sblas2.c @@ -8,12 +8,16 @@ #include "cblas.h" #include "cblas_test.h" -void F77_sgemv(int *layout, char *transp, int *m, int *n, float *alpha, - float *a, int *lda, float *x, int *incx, float *beta, - float *y, int *incy ) { +void F77_sgemv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, float *alpha, + float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx, float *beta, + float *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN transp_len +#endif +) { float *A; - int i,j,LDA; + CBLAS_INT i,j,LDA; CBLAS_TRANSPOSE trans; get_transpose_type(transp, &trans); @@ -23,23 +27,23 @@ void F77_sgemv(int *layout, char *transp, int *m, int *n, float *alpha, for( i=0; i<*m; i++ ) for( j=0; j<*n; j++ ) A[ LDA*i+j ]=a[ (*lda)*j+i ]; - cblas_sgemv( CblasRowMajor, trans, + API_SUFFIX(cblas_sgemv)( CblasRowMajor, trans, *m, *n, *alpha, A, LDA, x, *incx, *beta, y, *incy ); free(A); } else if (*layout == TEST_COL_MJR) - cblas_sgemv( CblasColMajor, trans, + API_SUFFIX(cblas_sgemv)( CblasColMajor, trans, *m, *n, *alpha, a, *lda, x, *incx, *beta, y, *incy ); else - cblas_sgemv( UNDEFINED, trans, + API_SUFFIX(cblas_sgemv)( INVALID_LAYOUT, trans, *m, *n, *alpha, a, *lda, x, *incx, *beta, y, *incy ); } -void F77_sger(int *layout, int *m, int *n, float *alpha, float *x, int *incx, - float *y, int *incy, float *a, int *lda ) { +void F77_sger(CBLAS_INT *layout, CBLAS_INT *m, CBLAS_INT *n, float *alpha, float *x, CBLAS_INT *incx, + float *y, CBLAS_INT *incy, float *a, CBLAS_INT *lda ) { float *A; - int i,j,LDA; + CBLAS_INT i,j,LDA; if (*layout == TEST_ROW_MJR) { LDA = *n+1; @@ -50,20 +54,24 @@ void F77_sger(int *layout, int *m, int *n, float *alpha, float *x, int *incx, A[ LDA*i+j ]=a[ (*lda)*j+i ]; } - cblas_sger(CblasRowMajor, *m, *n, *alpha, x, *incx, y, *incy, A, LDA ); + API_SUFFIX(cblas_sger)(CblasRowMajor, *m, *n, *alpha, x, *incx, y, *incy, A, LDA ); for( i=0; i<*m; i++ ) for( j=0; j<*n; j++ ) a[ (*lda)*j+i ]=A[ LDA*i+j ]; free(A); } else - cblas_sger( CblasColMajor, *m, *n, *alpha, x, *incx, y, *incy, a, *lda ); + API_SUFFIX(cblas_sger)( CblasColMajor, *m, *n, *alpha, x, *incx, y, *incy, a, *lda ); } -void F77_strmv(int *layout, char *uplow, char *transp, char *diagn, - int *n, float *a, int *lda, float *x, int *incx) { +void F77_strmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, + CBLAS_INT *n, float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len +#endif +) { float *A; - int i,j,LDA; + CBLAS_INT i,j,LDA; CBLAS_TRANSPOSE trans; CBLAS_UPLO uplo; CBLAS_DIAG diag; @@ -78,20 +86,24 @@ void F77_strmv(int *layout, char *uplow, char *transp, char *diagn, for( i=0; i<*n; i++ ) for( j=0; j<*n; j++ ) A[ LDA*i+j ]=a[ (*lda)*j+i ]; - cblas_strmv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx); + API_SUFFIX(cblas_strmv)(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx); free(A); } else if (*layout == TEST_COL_MJR) - cblas_strmv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx); + API_SUFFIX(cblas_strmv)(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx); else { - cblas_strmv(UNDEFINED, uplo, trans, diag, *n, a, *lda, x, *incx); + API_SUFFIX(cblas_strmv)(INVALID_LAYOUT, uplo, trans, diag, *n, a, *lda, x, *incx); } } -void F77_strsv(int *layout, char *uplow, char *transp, char *diagn, - int *n, float *a, int *lda, float *x, int *incx ) { +void F77_strsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, + CBLAS_INT *n, float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len +#endif +) { float *A; - int i,j,LDA; + CBLAS_INT i,j,LDA; CBLAS_TRANSPOSE trans; CBLAS_UPLO uplo; CBLAS_DIAG diag; @@ -106,17 +118,21 @@ void F77_strsv(int *layout, char *uplow, char *transp, char *diagn, for( i=0; i<*n; i++ ) for( j=0; j<*n; j++ ) A[ LDA*i+j ]=a[ (*lda)*j+i ]; - cblas_strsv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx ); + API_SUFFIX(cblas_strsv)(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx ); free(A); } else - cblas_strsv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx ); + API_SUFFIX(cblas_strsv)(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx ); } -void F77_ssymv(int *layout, char *uplow, int *n, float *alpha, float *a, - int *lda, float *x, int *incx, float *beta, float *y, - int *incy) { +void F77_ssymv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float *a, + CBLAS_INT *lda, float *x, CBLAS_INT *incx, float *beta, float *y, + CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len +#endif +) { float *A; - int i,j,LDA; + CBLAS_INT i,j,LDA; CBLAS_UPLO uplo; get_uplo_type(uplow,&uplo); @@ -127,19 +143,24 @@ void F77_ssymv(int *layout, char *uplow, int *n, float *alpha, float *a, for( i=0; i<*n; i++ ) for( j=0; j<*n; j++ ) A[ LDA*i+j ]=a[ (*lda)*j+i ]; - cblas_ssymv(CblasRowMajor, uplo, *n, *alpha, A, LDA, x, *incx, + API_SUFFIX(cblas_ssymv)(CblasRowMajor, uplo, *n, *alpha, A, LDA, x, *incx, *beta, y, *incy ); free(A); } else - cblas_ssymv(CblasColMajor, uplo, *n, *alpha, a, *lda, x, *incx, + API_SUFFIX(cblas_ssymv)(CblasColMajor, uplo, *n, *alpha, a, *lda, x, *incx, *beta, y, *incy ); } -void F77_ssyr(int *layout, char *uplow, int *n, float *alpha, float *x, - int *incx, float *a, int *lda) { +void F77_sskewsymv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float *a, + CBLAS_INT *lda, float *x, CBLAS_INT *incx, float *beta, float *y, + CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len +#endif +) { float *A; - int i,j,LDA; + CBLAS_INT i,j,LDA; CBLAS_UPLO uplo; get_uplo_type(uplow,&uplo); @@ -150,20 +171,79 @@ void F77_ssyr(int *layout, char *uplow, int *n, float *alpha, float *x, for( i=0; i<*n; i++ ) for( j=0; j<*n; j++ ) A[ LDA*i+j ]=a[ (*lda)*j+i ]; - cblas_ssyr(CblasRowMajor, uplo, *n, *alpha, x, *incx, A, LDA); + API_SUFFIX(cblas_sskewsymv)(CblasRowMajor, uplo, *n, *alpha, A, LDA, x, *incx, + *beta, y, *incy ); + free(A); + } + else + API_SUFFIX(cblas_sskewsymv)(CblasColMajor, uplo, *n, *alpha, a, *lda, x, *incx, + *beta, y, *incy ); +} + +void F77_ssyr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float *x, + CBLAS_INT *incx, float *a, CBLAS_INT *lda +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len +#endif +) { + float *A; + CBLAS_INT i,j,LDA; + CBLAS_UPLO uplo; + + get_uplo_type(uplow,&uplo); + + if (*layout == TEST_ROW_MJR) { + LDA = *n+1; + A = ( float* )malloc( (*n)*LDA*sizeof( float ) ); + for( i=0; i<*n; i++ ) + for( j=0; j<*n; j++ ) + A[ LDA*i+j ]=a[ (*lda)*j+i ]; + API_SUFFIX(cblas_ssyr)(CblasRowMajor, uplo, *n, *alpha, x, *incx, A, LDA); + for( i=0; i<*n; i++ ) + for( j=0; j<*n; j++ ) + a[ (*lda)*j+i ]=A[ LDA*i+j ]; + free(A); + } + else + API_SUFFIX(cblas_ssyr)(CblasColMajor, uplo, *n, *alpha, x, *incx, a, *lda); +} + +void F77_ssyr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float *x, + CBLAS_INT *incx, float *y, CBLAS_INT *incy, float *a, CBLAS_INT *lda +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len +#endif +) { + float *A; + CBLAS_INT i,j,LDA; + CBLAS_UPLO uplo; + + get_uplo_type(uplow,&uplo); + + if (*layout == TEST_ROW_MJR) { + LDA = *n+1; + A = ( float* )malloc( (*n)*LDA*sizeof( float ) ); + for( i=0; i<*n; i++ ) + for( j=0; j<*n; j++ ) + A[ LDA*i+j ]=a[ (*lda)*j+i ]; + API_SUFFIX(cblas_ssyr2)(CblasRowMajor, uplo, *n, *alpha, x, *incx, y, *incy, A, LDA); for( i=0; i<*n; i++ ) for( j=0; j<*n; j++ ) a[ (*lda)*j+i ]=A[ LDA*i+j ]; free(A); } else - cblas_ssyr(CblasColMajor, uplo, *n, *alpha, x, *incx, a, *lda); + API_SUFFIX(cblas_ssyr2)(CblasColMajor, uplo, *n, *alpha, x, *incx, y, *incy, a, *lda); } -void F77_ssyr2(int *layout, char *uplow, int *n, float *alpha, float *x, - int *incx, float *y, int *incy, float *a, int *lda) { +void F77_sskewsyr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float *x, + CBLAS_INT *incx, float *y, CBLAS_INT *incy, float *a, CBLAS_INT *lda +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len +#endif +) { float *A; - int i,j,LDA; + CBLAS_INT i,j,LDA; CBLAS_UPLO uplo; get_uplo_type(uplow,&uplo); @@ -174,22 +254,26 @@ void F77_ssyr2(int *layout, char *uplow, int *n, float *alpha, float *x, for( i=0; i<*n; i++ ) for( j=0; j<*n; j++ ) A[ LDA*i+j ]=a[ (*lda)*j+i ]; - cblas_ssyr2(CblasRowMajor, uplo, *n, *alpha, x, *incx, y, *incy, A, LDA); + API_SUFFIX(cblas_sskewsyr2)(CblasRowMajor, uplo, *n, *alpha, x, *incx, y, *incy, A, LDA); for( i=0; i<*n; i++ ) for( j=0; j<*n; j++ ) a[ (*lda)*j+i ]=A[ LDA*i+j ]; free(A); } else - cblas_ssyr2(CblasColMajor, uplo, *n, *alpha, x, *incx, y, *incy, a, *lda); + API_SUFFIX(cblas_sskewsyr2)(CblasColMajor, uplo, *n, *alpha, x, *incx, y, *incy, a, *lda); } -void F77_sgbmv(int *layout, char *transp, int *m, int *n, int *kl, int *ku, - float *alpha, float *a, int *lda, float *x, int *incx, - float *beta, float *y, int *incy ) { +void F77_sgbmv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, CBLAS_INT *kl, CBLAS_INT *ku, + float *alpha, float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx, + float *beta, float *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN transp_len +#endif +) { float *A; - int i,irow,j,jcol,LDA; + CBLAS_INT i,irow,j,jcol,LDA; CBLAS_TRANSPOSE trans; get_transpose_type(transp, &trans); @@ -213,19 +297,23 @@ void F77_sgbmv(int *layout, char *transp, int *m, int *n, int *kl, int *ku, for( j=jcol; j<(*n+*kl); j++ ) A[ LDA*j+irow ]=a[ (*lda)*(j-jcol)+i ]; } - cblas_sgbmv( CblasRowMajor, trans, *m, *n, *kl, *ku, *alpha, + API_SUFFIX(cblas_sgbmv)( CblasRowMajor, trans, *m, *n, *kl, *ku, *alpha, A, LDA, x, *incx, *beta, y, *incy ); free(A); } else - cblas_sgbmv( CblasColMajor, trans, *m, *n, *kl, *ku, *alpha, + API_SUFFIX(cblas_sgbmv)( CblasColMajor, trans, *m, *n, *kl, *ku, *alpha, a, *lda, x, *incx, *beta, y, *incy ); } -void F77_stbmv(int *layout, char *uplow, char *transp, char *diagn, - int *n, int *k, float *a, int *lda, float *x, int *incx) { +void F77_stbmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, + CBLAS_INT *n, CBLAS_INT *k, float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len +#endif +) { float *A; - int irow, jcol, i, j, LDA; + CBLAS_INT irow, jcol, i, j, LDA; CBLAS_TRANSPOSE trans; CBLAS_UPLO uplo; CBLAS_DIAG diag; @@ -261,17 +349,21 @@ void F77_stbmv(int *layout, char *uplow, char *transp, char *diagn, A[ LDA*j+irow ]=a[ (*lda)*(j-jcol)+i ]; } } - cblas_stbmv(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, x, *incx); + API_SUFFIX(cblas_stbmv)(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, x, *incx); free(A); } else - cblas_stbmv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx); + API_SUFFIX(cblas_stbmv)(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx); } -void F77_stbsv(int *layout, char *uplow, char *transp, char *diagn, - int *n, int *k, float *a, int *lda, float *x, int *incx) { +void F77_stbsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, + CBLAS_INT *n, CBLAS_INT *k, float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len +#endif +) { float *A; - int irow, jcol, i, j, LDA; + CBLAS_INT irow, jcol, i, j, LDA; CBLAS_TRANSPOSE trans; CBLAS_UPLO uplo; CBLAS_DIAG diag; @@ -307,18 +399,22 @@ void F77_stbsv(int *layout, char *uplow, char *transp, char *diagn, A[ LDA*j+irow ]=a[ (*lda)*(j-jcol)+i ]; } } - cblas_stbsv(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, x, *incx); + API_SUFFIX(cblas_stbsv)(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, x, *incx); free(A); } else - cblas_stbsv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx); + API_SUFFIX(cblas_stbsv)(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx); } -void F77_ssbmv(int *layout, char *uplow, int *n, int *k, float *alpha, - float *a, int *lda, float *x, int *incx, float *beta, - float *y, int *incy) { +void F77_ssbmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_INT *k, float *alpha, + float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx, float *beta, + float *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len +#endif +) { float *A; - int i,j,irow,jcol,LDA; + CBLAS_INT i,j,irow,jcol,LDA; CBLAS_UPLO uplo; get_uplo_type(uplow,&uplo); @@ -350,19 +446,23 @@ void F77_ssbmv(int *layout, char *uplow, int *n, int *k, float *alpha, A[ LDA*j+irow ]=a[ (*lda)*(j-jcol)+i ]; } } - cblas_ssbmv(CblasRowMajor, uplo, *n, *k, *alpha, A, LDA, x, *incx, + API_SUFFIX(cblas_ssbmv)(CblasRowMajor, uplo, *n, *k, *alpha, A, LDA, x, *incx, *beta, y, *incy ); free(A); } else - cblas_ssbmv(CblasColMajor, uplo, *n, *k, *alpha, a, *lda, x, *incx, + API_SUFFIX(cblas_ssbmv)(CblasColMajor, uplo, *n, *k, *alpha, a, *lda, x, *incx, *beta, y, *incy ); } -void F77_sspmv(int *layout, char *uplow, int *n, float *alpha, float *ap, - float *x, int *incx, float *beta, float *y, int *incy) { +void F77_sspmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float *ap, + float *x, CBLAS_INT *incx, float *beta, float *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len +#endif +) { float *A,*AP; - int i,j,k,LDA; + CBLAS_INT i,j,k,LDA; CBLAS_UPLO uplo; get_uplo_type(uplow,&uplo); @@ -387,19 +487,23 @@ void F77_sspmv(int *layout, char *uplow, int *n, float *alpha, float *ap, for( j=0; j #include #include +#include #include + #include "cblas.h" #include "cblas_test.h" +#include "cblas_xerbla_internal.h" -void cblas_xerbla(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 int cblas_lerr, cblas_info, cblas_ok; - extern int link_xerbla; - extern int RowMajorStrg; + extern CBLAS_INT cblas_lerr, cblas_info, cblas_ok; + extern CBLAS_INT link_xerbla; + extern CBLAS_INT cblas_xbad; extern char *cblas_rout; - /* Initially, c__3chke will call this routine with + (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 * instead of ones in the CBLAS or the legacy BLAS library. */ 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. The + * expected name goes through the same normalisation, since the testers + * spell it without the extended API suffix. + */ + char reported[CBLAS_XERBLA_ROUT_BUFFER_SIZE]; + cblas_xerbla_apply_api_suffix(reported, sizeof(reported), rout); + + char expected[CBLAS_XERBLA_ROUT_BUFFER_SIZE]; + cblas_xerbla_apply_api_suffix(expected, sizeof(expected), cblas_rout); + + if (cblas_rout != NULL && strcmp(expected, reported) != 0) { + printf( + "***** XERBLA WAS CALLED WITH SRNAME = <%s> INSTEAD OF <%s> *******\n", + reported, expected); 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) - { - 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; - } - } + info = cblas_xerbla_map_info(info, rout, RowMajorStrg); - if (info != cblas_info){ - printf("***** XERBLA WAS CALLED WITH INFO = %d INSTEAD OF %d in %s *******\n",info, 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) +/** + * \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 len #endif +) { -#ifdef F77_Char - char *srname; -#endif - - char rout[] = {'c','b','l','a','s','_','\0','\0','\0','\0','\0','\0','\0'}; + /* See the comment in API_SUFFIX(cblas_xerbla)() above */ + extern CBLAS_INT link_xerbla; + if (link_xerbla) { + link_xerbla = 0; + return; + } -#ifdef F77_Integer - F77_Integer *info=vinfo; - F77_Integer i; - extern F77_Integer link_xerbla; +#ifdef BLAS_FORTRAN_STRLEN_END + const size_t srname_len = len > 0 ? (size_t)len : 0; #else - int *info=vinfo; - int i; - extern int link_xerbla; + const size_t srname_len = 6; #endif -#ifdef F77_Char - srname = F2C_STR(F77_srname, XerblaStrLen); + +#ifdef F77_CHAR + const char *srname = F2C_STR(F77_srname, srname_len); +#else + const char *srname = F77_srname; #endif - /* See the comment in cblas_xerbla() above */ - if (link_xerbla) - { - link_xerbla = 0; - return; - } - for(i=0; i < 6; i++) rout[i+6] = tolower(srname[i]); - for(i=11; i >= 9; i--) if (rout[i] == ' ') rout[i] = '\0'; + 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. */ - 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 d51c7c2674..fd2bd6b02e 100644 --- a/CBLAS/testing/c_z2chke.c +++ b/CBLAS/testing/c_z2chke.c @@ -3,28 +3,43 @@ #include "cblas.h" #include "cblas_test.h" -int cblas_ok, cblas_lerr, cblas_info; -int link_xerbla=TRUE; +CBLAS_INT cblas_ok, cblas_lerr, cblas_info; +CBLAS_INT link_xerbla=TRUE; +CBLAS_INT cblas_xtests, cblas_xfails, cblas_xbad; char *cblas_rout; #ifdef F77_Char -void F77_xerbla(F77_Char F77_srname, void *vinfo); +void F77_xerbla(F77_Char F77_srname, void *vinfo #else -void F77_xerbla(char *srname, void *vinfo); +void F77_xerbla(char *srname, void *vinfo #endif +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN srname_len +#endif +); void chkxer(void) { - extern int cblas_ok, cblas_lerr, cblas_info; - extern int link_xerbla; + extern CBLAS_INT cblas_ok, cblas_lerr, cblas_info; + extern CBLAS_INT link_xerbla; + extern CBLAS_INT cblas_xtests, cblas_xfails, cblas_xbad; extern char *cblas_rout; + cblas_xtests++; if (cblas_lerr == 1 ) { - printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", 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) { + cblas_xfails++; } + cblas_xbad = 0; cblas_lerr = 1 ; } -void F77_z2chke(char *rout) { +void F77_z2chke(char *rout +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN rout_len +#endif +) { char *sf = ( rout ) ; double A[2] = {0.0,0.0}, X[2] = {0.0,0.0}, @@ -32,795 +47,809 @@ void F77_z2chke(char *rout) { ALPHA[2] = {0.0,0.0}, BETA[2] = {0.0,0.0}, RALPHA = 0.0; - extern int cblas_info, cblas_lerr, cblas_ok; - extern int RowMajorStrg; + extern CBLAS_INT cblas_info, cblas_lerr, cblas_ok; extern char *cblas_rout; +#ifndef HAS_ATTRIBUTE_WEAK_SUPPORT + #ifdef CBLAS_DLL_IMPORTS + // Since Windows does not support weak symbols, and the trick below doesn't + // work for shared libraries on Windows, we skip the xerbla tests here. + printf("***** WARNING: Skipping xerbla tests since weak symbols are not supported on Windows *****\n"); + return; + #endif + if (link_xerbla) /* call these first to link */ { - cblas_xerbla(cblas_info,cblas_rout,""); - F77_xerbla(cblas_rout,&cblas_info); + API_SUFFIX(cblas_xerbla)(cblas_info,cblas_rout,""); + F77_xerbla(cblas_rout,&cblas_info, 1); } +#endif + link_xerbla = 0; cblas_ok = TRUE ; cblas_lerr = PASSED ; + cblas_xtests = 0; + cblas_xfails = 0; + cblas_xbad = 0; if (strncmp( sf,"cblas_zgemv",11)==0) { cblas_rout = "cblas_zgemv"; cblas_info = 1; - cblas_zgemv(INVALID, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_zgemv)(INVALID_LAYOUT, CblasNoTrans, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_zgemv(CblasColMajor, INVALID, 0, 0, + API_SUFFIX(cblas_zgemv)(CblasColMajor, INVALID_TRANSPOSE, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_zgemv(CblasColMajor, CblasNoTrans, INVALID, 0, + API_SUFFIX(cblas_zgemv)(CblasColMajor, CblasNoTrans, INVALID, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_zgemv(CblasColMajor, CblasNoTrans, 0, INVALID, + API_SUFFIX(cblas_zgemv)(CblasColMajor, CblasNoTrans, 0, INVALID, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_zgemv(CblasColMajor, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_zgemv)(CblasColMajor, CblasNoTrans, 2, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_zgemv(CblasColMajor, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_zgemv)(CblasColMajor, CblasNoTrans, 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_zgemv(CblasColMajor, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_zgemv)(CblasColMajor, CblasNoTrans, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; RowMajorStrg = TRUE; - cblas_zgemv(CblasRowMajor, INVALID, 0, 0, + API_SUFFIX(cblas_zgemv)(CblasRowMajor, INVALID_TRANSPOSE, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_zgemv(CblasRowMajor, CblasNoTrans, INVALID, 0, + API_SUFFIX(cblas_zgemv)(CblasRowMajor, CblasNoTrans, INVALID, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_zgemv(CblasRowMajor, CblasNoTrans, 0, INVALID, + API_SUFFIX(cblas_zgemv)(CblasRowMajor, CblasNoTrans, 0, INVALID, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_zgemv(CblasRowMajor, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_zgemv)(CblasRowMajor, CblasNoTrans, 0, 2, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = TRUE; - cblas_zgemv(CblasRowMajor, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_zgemv)(CblasRowMajor, CblasNoTrans, 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_zgemv(CblasRowMajor, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_zgemv)(CblasRowMajor, CblasNoTrans, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ); chkxer(); } else if (strncmp( sf,"cblas_zgbmv",11)==0) { cblas_rout = "cblas_zgbmv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_zgbmv(INVALID, CblasNoTrans, 0, 0, 0, 0, + API_SUFFIX(cblas_zgbmv)(INVALID_LAYOUT, CblasNoTrans, 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_zgbmv(CblasColMajor, INVALID, 0, 0, 0, 0, + API_SUFFIX(cblas_zgbmv)(CblasColMajor, INVALID_TRANSPOSE, 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_zgbmv(CblasColMajor, CblasNoTrans, INVALID, 0, 0, 0, + API_SUFFIX(cblas_zgbmv)(CblasColMajor, CblasNoTrans, INVALID, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_zgbmv(CblasColMajor, CblasNoTrans, 0, INVALID, 0, 0, + API_SUFFIX(cblas_zgbmv)(CblasColMajor, CblasNoTrans, 0, INVALID, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_zgbmv(CblasColMajor, CblasNoTrans, 0, 0, INVALID, 0, + API_SUFFIX(cblas_zgbmv)(CblasColMajor, CblasNoTrans, 0, 0, INVALID, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_zgbmv(CblasColMajor, CblasNoTrans, 2, 0, 0, INVALID, + API_SUFFIX(cblas_zgbmv)(CblasColMajor, CblasNoTrans, 2, 0, 0, INVALID, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_zgbmv(CblasColMajor, CblasNoTrans, 0, 0, 1, 0, + API_SUFFIX(cblas_zgbmv)(CblasColMajor, CblasNoTrans, 0, 0, 1, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_zgbmv(CblasColMajor, CblasNoTrans, 0, 0, 0, 0, + API_SUFFIX(cblas_zgbmv)(CblasColMajor, CblasNoTrans, 0, 0, 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = FALSE; - cblas_zgbmv(CblasColMajor, CblasNoTrans, 0, 0, 0, 0, + API_SUFFIX(cblas_zgbmv)(CblasColMajor, CblasNoTrans, 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_zgbmv(CblasRowMajor, INVALID, 0, 0, 0, 0, + API_SUFFIX(cblas_zgbmv)(CblasRowMajor, INVALID_TRANSPOSE, 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_zgbmv(CblasRowMajor, CblasNoTrans, INVALID, 0, 0, 0, + API_SUFFIX(cblas_zgbmv)(CblasRowMajor, CblasNoTrans, INVALID, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_zgbmv(CblasRowMajor, CblasNoTrans, 0, INVALID, 0, 0, + API_SUFFIX(cblas_zgbmv)(CblasRowMajor, CblasNoTrans, 0, INVALID, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_zgbmv(CblasRowMajor, CblasNoTrans, 0, 0, INVALID, 0, + API_SUFFIX(cblas_zgbmv)(CblasRowMajor, CblasNoTrans, 0, 0, INVALID, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_zgbmv(CblasRowMajor, CblasNoTrans, 2, 0, 0, INVALID, + API_SUFFIX(cblas_zgbmv)(CblasRowMajor, CblasNoTrans, 2, 0, 0, INVALID, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = TRUE; - cblas_zgbmv(CblasRowMajor, CblasNoTrans, 0, 0, 1, 0, + API_SUFFIX(cblas_zgbmv)(CblasRowMajor, CblasNoTrans, 0, 0, 1, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_zgbmv(CblasRowMajor, CblasNoTrans, 0, 0, 0, 0, + API_SUFFIX(cblas_zgbmv)(CblasRowMajor, CblasNoTrans, 0, 0, 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = TRUE; - cblas_zgbmv(CblasRowMajor, CblasNoTrans, 0, 0, 0, 0, + API_SUFFIX(cblas_zgbmv)(CblasRowMajor, CblasNoTrans, 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ); chkxer(); } else if (strncmp( sf,"cblas_zhemv",11)==0) { cblas_rout = "cblas_zhemv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_zhemv(INVALID, CblasUpper, 0, + API_SUFFIX(cblas_zhemv)(INVALID_LAYOUT, CblasUpper, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_zhemv(CblasColMajor, INVALID, 0, + API_SUFFIX(cblas_zhemv)(CblasColMajor, INVALID_UPLO, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_zhemv(CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_zhemv)(CblasColMajor, CblasUpper, INVALID, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_zhemv(CblasColMajor, CblasUpper, 2, + API_SUFFIX(cblas_zhemv)(CblasColMajor, CblasUpper, 2, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_zhemv(CblasColMajor, CblasUpper, 0, + API_SUFFIX(cblas_zhemv)(CblasColMajor, CblasUpper, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_zhemv(CblasColMajor, CblasUpper, 0, + API_SUFFIX(cblas_zhemv)(CblasColMajor, CblasUpper, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_zhemv(CblasRowMajor, INVALID, 0, + API_SUFFIX(cblas_zhemv)(CblasRowMajor, INVALID_UPLO, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_zhemv(CblasRowMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_zhemv)(CblasRowMajor, CblasUpper, INVALID, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_zhemv(CblasRowMajor, CblasUpper, 2, + API_SUFFIX(cblas_zhemv)(CblasRowMajor, CblasUpper, 2, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_zhemv(CblasRowMajor, CblasUpper, 0, + API_SUFFIX(cblas_zhemv)(CblasRowMajor, CblasUpper, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_zhemv(CblasRowMajor, CblasUpper, 0, + API_SUFFIX(cblas_zhemv)(CblasRowMajor, CblasUpper, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ); chkxer(); } else if (strncmp( sf,"cblas_zhbmv",11)==0) { cblas_rout = "cblas_zhbmv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_zhbmv(INVALID, CblasUpper, 0, 0, + API_SUFFIX(cblas_zhbmv)(INVALID_LAYOUT, CblasUpper, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_zhbmv(CblasColMajor, INVALID, 0, 0, + API_SUFFIX(cblas_zhbmv)(CblasColMajor, INVALID_UPLO, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_zhbmv(CblasColMajor, CblasUpper, INVALID, 0, + API_SUFFIX(cblas_zhbmv)(CblasColMajor, CblasUpper, INVALID, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_zhbmv(CblasColMajor, CblasUpper, 0, INVALID, + API_SUFFIX(cblas_zhbmv)(CblasColMajor, CblasUpper, 0, INVALID, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_zhbmv(CblasColMajor, CblasUpper, 0, 1, + API_SUFFIX(cblas_zhbmv)(CblasColMajor, CblasUpper, 0, 1, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_zhbmv(CblasColMajor, CblasUpper, 0, 0, + API_SUFFIX(cblas_zhbmv)(CblasColMajor, CblasUpper, 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_zhbmv(CblasColMajor, CblasUpper, 0, 0, + API_SUFFIX(cblas_zhbmv)(CblasColMajor, CblasUpper, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_zhbmv(CblasRowMajor, INVALID, 0, 0, + API_SUFFIX(cblas_zhbmv)(CblasRowMajor, INVALID_UPLO, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_zhbmv(CblasRowMajor, CblasUpper, INVALID, 0, + API_SUFFIX(cblas_zhbmv)(CblasRowMajor, CblasUpper, INVALID, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_zhbmv(CblasRowMajor, CblasUpper, 0, INVALID, + API_SUFFIX(cblas_zhbmv)(CblasRowMajor, CblasUpper, 0, INVALID, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_zhbmv(CblasRowMajor, CblasUpper, 0, 1, + API_SUFFIX(cblas_zhbmv)(CblasRowMajor, CblasUpper, 0, 1, ALPHA, A, 1, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = TRUE; - cblas_zhbmv(CblasRowMajor, CblasUpper, 0, 0, + API_SUFFIX(cblas_zhbmv)(CblasRowMajor, CblasUpper, 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_zhbmv(CblasRowMajor, CblasUpper, 0, 0, + API_SUFFIX(cblas_zhbmv)(CblasRowMajor, CblasUpper, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 ); chkxer(); } else if (strncmp( sf,"cblas_zhpmv",11)==0) { cblas_rout = "cblas_zhpmv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_zhpmv(INVALID, CblasUpper, 0, + API_SUFFIX(cblas_zhpmv)(INVALID_LAYOUT, CblasUpper, 0, ALPHA, A, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_zhpmv(CblasColMajor, INVALID, 0, + API_SUFFIX(cblas_zhpmv)(CblasColMajor, INVALID_UPLO, 0, ALPHA, A, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_zhpmv(CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_zhpmv)(CblasColMajor, CblasUpper, INVALID, ALPHA, A, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_zhpmv(CblasColMajor, CblasUpper, 0, + API_SUFFIX(cblas_zhpmv)(CblasColMajor, CblasUpper, 0, ALPHA, A, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_zhpmv(CblasColMajor, CblasUpper, 0, + API_SUFFIX(cblas_zhpmv)(CblasColMajor, CblasUpper, 0, ALPHA, A, X, 1, BETA, Y, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_zhpmv(CblasRowMajor, INVALID, 0, + API_SUFFIX(cblas_zhpmv)(CblasRowMajor, INVALID_UPLO, 0, ALPHA, A, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_zhpmv(CblasRowMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_zhpmv)(CblasRowMajor, CblasUpper, INVALID, ALPHA, A, X, 1, BETA, Y, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_zhpmv(CblasRowMajor, CblasUpper, 0, + API_SUFFIX(cblas_zhpmv)(CblasRowMajor, CblasUpper, 0, ALPHA, A, X, 0, BETA, Y, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_zhpmv(CblasRowMajor, CblasUpper, 0, + API_SUFFIX(cblas_zhpmv)(CblasRowMajor, CblasUpper, 0, ALPHA, A, X, 1, BETA, Y, 0 ); chkxer(); } else if (strncmp( sf,"cblas_ztrmv",11)==0) { cblas_rout = "cblas_ztrmv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_ztrmv(INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrmv)(INVALID_LAYOUT, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_ztrmv(CblasColMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_ztrmv)(CblasColMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_ztrmv(CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_ztrmv)(CblasColMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_ztrmv(CblasColMajor, CblasUpper, CblasNoTrans, - INVALID, 0, A, 1, X, 1 ); + API_SUFFIX(cblas_ztrmv)(CblasColMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, A, 1, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_ztrmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, A, 1, X, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ztrmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 2, A, 1, X, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_ztrmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_ztrmv(CblasRowMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_ztrmv)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_ztrmv(CblasRowMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_ztrmv)(CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_ztrmv(CblasRowMajor, CblasUpper, CblasNoTrans, - INVALID, 0, A, 1, X, 1 ); + API_SUFFIX(cblas_ztrmv)(CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, A, 1, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_ztrmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, A, 1, X, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ztrmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 2, A, 1, X, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = TRUE; - cblas_ztrmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 0 ); chkxer(); } else if (strncmp( sf,"cblas_ztbmv",11)==0) { cblas_rout = "cblas_ztbmv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_ztbmv(INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztbmv)(INVALID_LAYOUT, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_ztbmv(CblasColMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_ztbmv)(CblasColMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_ztbmv(CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_ztbmv)(CblasColMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_ztbmv(CblasColMajor, CblasUpper, CblasNoTrans, - INVALID, 0, 0, A, 1, X, 1 ); + API_SUFFIX(cblas_ztbmv)(CblasColMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_ztbmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztbmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, A, 1, X, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ztbmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztbmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, A, 1, X, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_ztbmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztbmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 1, A, 1, X, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ztbmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztbmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_ztbmv(CblasRowMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_ztbmv)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_ztbmv(CblasRowMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_ztbmv)(CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_ztbmv(CblasRowMajor, CblasUpper, CblasNoTrans, - INVALID, 0, 0, A, 1, X, 1 ); + API_SUFFIX(cblas_ztbmv)(CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_ztbmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztbmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, A, 1, X, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ztbmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztbmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, A, 1, X, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_ztbmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztbmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 1, A, 1, X, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ztbmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztbmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 0 ); chkxer(); } else if (strncmp( sf,"cblas_ztpmv",11)==0) { cblas_rout = "cblas_ztpmv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_ztpmv(INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztpmv)(INVALID_LAYOUT, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_ztpmv(CblasColMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_ztpmv)(CblasColMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_ztpmv(CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_ztpmv)(CblasColMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_ztpmv(CblasColMajor, CblasUpper, CblasNoTrans, - INVALID, 0, A, X, 1 ); + API_SUFFIX(cblas_ztpmv)(CblasColMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, A, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_ztpmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztpmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, A, X, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_ztpmv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztpmv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, X, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_ztpmv(CblasRowMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_ztpmv)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_ztpmv(CblasRowMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_ztpmv)(CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_ztpmv(CblasRowMajor, CblasUpper, CblasNoTrans, - INVALID, 0, A, X, 1 ); + API_SUFFIX(cblas_ztpmv)(CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, A, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_ztpmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztpmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, A, X, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_ztpmv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztpmv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, X, 0 ); chkxer(); } else if (strncmp( sf,"cblas_ztrsv",11)==0) { cblas_rout = "cblas_ztrsv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_ztrsv(INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrsv)(INVALID_LAYOUT, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_ztrsv(CblasColMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_ztrsv)(CblasColMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_ztrsv(CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_ztrsv)(CblasColMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_ztrsv(CblasColMajor, CblasUpper, CblasNoTrans, - INVALID, 0, A, 1, X, 1 ); + API_SUFFIX(cblas_ztrsv)(CblasColMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, A, 1, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_ztrsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, A, 1, X, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ztrsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 2, A, 1, X, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_ztrsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_ztrsv(CblasRowMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_ztrsv)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_ztrsv(CblasRowMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_ztrsv)(CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, A, 1, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_ztrsv(CblasRowMajor, CblasUpper, CblasNoTrans, - INVALID, 0, A, 1, X, 1 ); + API_SUFFIX(cblas_ztrsv)(CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, A, 1, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_ztrsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, A, 1, X, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ztrsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 2, A, 1, X, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = TRUE; - cblas_ztrsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, 1, X, 0 ); chkxer(); } else if (strncmp( sf,"cblas_ztbsv",11)==0) { cblas_rout = "cblas_ztbsv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_ztbsv(INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztbsv)(INVALID_LAYOUT, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_ztbsv(CblasColMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_ztbsv)(CblasColMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_ztbsv(CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_ztbsv)(CblasColMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_ztbsv(CblasColMajor, CblasUpper, CblasNoTrans, - INVALID, 0, 0, A, 1, X, 1 ); + API_SUFFIX(cblas_ztbsv)(CblasColMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_ztbsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztbsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, A, 1, X, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ztbsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztbsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, A, 1, X, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_ztbsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztbsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 1, A, 1, X, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ztbsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztbsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_ztbsv(CblasRowMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_ztbsv)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_ztbsv(CblasRowMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_ztbsv)(CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_ztbsv(CblasRowMajor, CblasUpper, CblasNoTrans, - INVALID, 0, 0, A, 1, X, 1 ); + API_SUFFIX(cblas_ztbsv)(CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, A, 1, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_ztbsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztbsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, A, 1, X, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ztbsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztbsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, A, 1, X, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_ztbsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztbsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 1, A, 1, X, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ztbsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztbsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, A, 1, X, 0 ); chkxer(); } else if (strncmp( sf,"cblas_ztpsv",11)==0) { cblas_rout = "cblas_ztpsv"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_ztpsv(INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztpsv)(INVALID_LAYOUT, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_ztpsv(CblasColMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_ztpsv)(CblasColMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_ztpsv(CblasColMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_ztpsv)(CblasColMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_ztpsv(CblasColMajor, CblasUpper, CblasNoTrans, - INVALID, 0, A, X, 1 ); + API_SUFFIX(cblas_ztpsv)(CblasColMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, A, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_ztpsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztpsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, A, X, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_ztpsv(CblasColMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztpsv)(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, X, 0 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_ztpsv(CblasRowMajor, INVALID, CblasNoTrans, + API_SUFFIX(cblas_ztpsv)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_ztpsv(CblasRowMajor, CblasUpper, INVALID, + API_SUFFIX(cblas_ztpsv)(CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, A, X, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_ztpsv(CblasRowMajor, CblasUpper, CblasNoTrans, - INVALID, 0, A, X, 1 ); + API_SUFFIX(cblas_ztpsv)(CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, A, X, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_ztpsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztpsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, A, X, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_ztpsv(CblasRowMajor, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztpsv)(CblasRowMajor, CblasUpper, CblasNoTrans, CblasNonUnit, 0, A, X, 0 ); chkxer(); } else if (strncmp( sf,"cblas_zgeru",10)==0) { cblas_rout = "cblas_zgeru"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_zgeru(INVALID, 0, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_zgeru)(INVALID_LAYOUT, 0, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_zgeru(CblasColMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_zgeru)(CblasColMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_zgeru(CblasColMajor, 0, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_zgeru)(CblasColMajor, 0, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_zgeru(CblasColMajor, 0, 0, ALPHA, X, 0, Y, 1, A, 1 ); + API_SUFFIX(cblas_zgeru)(CblasColMajor, 0, 0, ALPHA, X, 0, Y, 1, A, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_zgeru(CblasColMajor, 0, 0, ALPHA, X, 1, Y, 0, A, 1 ); + API_SUFFIX(cblas_zgeru)(CblasColMajor, 0, 0, ALPHA, X, 1, Y, 0, A, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_zgeru(CblasColMajor, 2, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_zgeru)(CblasColMajor, 2, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_zgeru(CblasRowMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_zgeru)(CblasRowMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_zgeru(CblasRowMajor, 0, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_zgeru)(CblasRowMajor, 0, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_zgeru(CblasRowMajor, 0, 0, ALPHA, X, 0, Y, 1, A, 1 ); + API_SUFFIX(cblas_zgeru)(CblasRowMajor, 0, 0, ALPHA, X, 0, Y, 1, A, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_zgeru(CblasRowMajor, 0, 0, ALPHA, X, 1, Y, 0, A, 1 ); + API_SUFFIX(cblas_zgeru)(CblasRowMajor, 0, 0, ALPHA, X, 1, Y, 0, A, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_zgeru(CblasRowMajor, 0, 2, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_zgeru)(CblasRowMajor, 0, 2, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); } else if (strncmp( sf,"cblas_zgerc",10)==0) { cblas_rout = "cblas_zgerc"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_zgerc(INVALID, 0, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_zgerc)(INVALID_LAYOUT, 0, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_zgerc(CblasColMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_zgerc)(CblasColMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_zgerc(CblasColMajor, 0, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_zgerc)(CblasColMajor, 0, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_zgerc(CblasColMajor, 0, 0, ALPHA, X, 0, Y, 1, A, 1 ); + API_SUFFIX(cblas_zgerc)(CblasColMajor, 0, 0, ALPHA, X, 0, Y, 1, A, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_zgerc(CblasColMajor, 0, 0, ALPHA, X, 1, Y, 0, A, 1 ); + API_SUFFIX(cblas_zgerc)(CblasColMajor, 0, 0, ALPHA, X, 1, Y, 0, A, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_zgerc(CblasColMajor, 2, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_zgerc)(CblasColMajor, 2, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_zgerc(CblasRowMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_zgerc)(CblasRowMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_zgerc(CblasRowMajor, 0, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_zgerc)(CblasRowMajor, 0, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_zgerc(CblasRowMajor, 0, 0, ALPHA, X, 0, Y, 1, A, 1 ); + API_SUFFIX(cblas_zgerc)(CblasRowMajor, 0, 0, ALPHA, X, 0, Y, 1, A, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_zgerc(CblasRowMajor, 0, 0, ALPHA, X, 1, Y, 0, A, 1 ); + API_SUFFIX(cblas_zgerc)(CblasRowMajor, 0, 0, ALPHA, X, 1, Y, 0, A, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_zgerc(CblasRowMajor, 0, 2, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_zgerc)(CblasRowMajor, 0, 2, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); } else if (strncmp( sf,"cblas_zher2",11)==0) { cblas_rout = "cblas_zher2"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_zher2(INVALID, CblasUpper, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_zher2)(INVALID_LAYOUT, CblasUpper, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_zher2(CblasColMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_zher2)(CblasColMajor, INVALID_UPLO, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_zher2(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_zher2)(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_zher2(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A, 1 ); + API_SUFFIX(cblas_zher2)(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_zher2(CblasColMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A, 1 ); + API_SUFFIX(cblas_zher2)(CblasColMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_zher2(CblasColMajor, CblasUpper, 2, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_zher2)(CblasColMajor, CblasUpper, 2, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_zher2(CblasRowMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_zher2)(CblasRowMajor, INVALID_UPLO, 0, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_zher2(CblasRowMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_zher2)(CblasRowMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_zher2(CblasRowMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A, 1 ); + API_SUFFIX(cblas_zher2)(CblasRowMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_zher2(CblasRowMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A, 1 ); + API_SUFFIX(cblas_zher2)(CblasRowMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_zher2(CblasRowMajor, CblasUpper, 2, ALPHA, X, 1, Y, 1, A, 1 ); + API_SUFFIX(cblas_zher2)(CblasRowMajor, CblasUpper, 2, ALPHA, X, 1, Y, 1, A, 1 ); chkxer(); } else if (strncmp( sf,"cblas_zhpr2",11)==0) { cblas_rout = "cblas_zhpr2"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_zhpr2(INVALID, CblasUpper, 0, ALPHA, X, 1, Y, 1, A ); + API_SUFFIX(cblas_zhpr2)(INVALID_LAYOUT, CblasUpper, 0, ALPHA, X, 1, Y, 1, A ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_zhpr2(CblasColMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A ); + API_SUFFIX(cblas_zhpr2)(CblasColMajor, INVALID_UPLO, 0, ALPHA, X, 1, Y, 1, A ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_zhpr2(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A ); + API_SUFFIX(cblas_zhpr2)(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_zhpr2(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A ); + API_SUFFIX(cblas_zhpr2)(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_zhpr2(CblasColMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A ); + API_SUFFIX(cblas_zhpr2)(CblasColMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_zhpr2(CblasRowMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A ); + API_SUFFIX(cblas_zhpr2)(CblasRowMajor, INVALID_UPLO, 0, ALPHA, X, 1, Y, 1, A ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_zhpr2(CblasRowMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A ); + API_SUFFIX(cblas_zhpr2)(CblasRowMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_zhpr2(CblasRowMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A ); + API_SUFFIX(cblas_zhpr2)(CblasRowMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_zhpr2(CblasRowMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A ); + API_SUFFIX(cblas_zhpr2)(CblasRowMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A ); chkxer(); } else if (strncmp( sf,"cblas_zher",10)==0) { cblas_rout = "cblas_zher"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_zher(INVALID, CblasUpper, 0, RALPHA, X, 1, A, 1 ); + API_SUFFIX(cblas_zher)(INVALID_LAYOUT, CblasUpper, 0, RALPHA, X, 1, A, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_zher(CblasColMajor, INVALID, 0, RALPHA, X, 1, A, 1 ); + API_SUFFIX(cblas_zher)(CblasColMajor, INVALID_UPLO, 0, RALPHA, X, 1, A, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_zher(CblasColMajor, CblasUpper, INVALID, RALPHA, X, 1, A, 1 ); + API_SUFFIX(cblas_zher)(CblasColMajor, CblasUpper, INVALID, RALPHA, X, 1, A, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_zher(CblasColMajor, CblasUpper, 0, RALPHA, X, 0, A, 1 ); + API_SUFFIX(cblas_zher)(CblasColMajor, CblasUpper, 0, RALPHA, X, 0, A, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_zher(CblasColMajor, CblasUpper, 2, RALPHA, X, 1, A, 1 ); + API_SUFFIX(cblas_zher)(CblasColMajor, CblasUpper, 2, RALPHA, X, 1, A, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = TRUE; - cblas_zher(CblasRowMajor, INVALID, 0, RALPHA, X, 1, A, 1 ); + API_SUFFIX(cblas_zher)(CblasRowMajor, INVALID_UPLO, 0, RALPHA, X, 1, A, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = TRUE; - cblas_zher(CblasRowMajor, CblasUpper, INVALID, RALPHA, X, 1, A, 1 ); + API_SUFFIX(cblas_zher)(CblasRowMajor, CblasUpper, INVALID, RALPHA, X, 1, A, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_zher(CblasRowMajor, CblasUpper, 0, RALPHA, X, 0, A, 1 ); + API_SUFFIX(cblas_zher)(CblasRowMajor, CblasUpper, 0, RALPHA, X, 0, A, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_zher(CblasRowMajor, CblasUpper, 2, RALPHA, X, 1, A, 1 ); + API_SUFFIX(cblas_zher)(CblasRowMajor, CblasUpper, 2, RALPHA, X, 1, A, 1 ); chkxer(); } else if (strncmp( sf,"cblas_zhpr",10)==0) { cblas_rout = "cblas_zhpr"; cblas_info = 1; RowMajorStrg = FALSE; - cblas_zhpr(INVALID, CblasUpper, 0, RALPHA, X, 1, A ); + API_SUFFIX(cblas_zhpr)(INVALID_LAYOUT, CblasUpper, 0, RALPHA, X, 1, A ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_zhpr(CblasColMajor, INVALID, 0, RALPHA, X, 1, A ); + API_SUFFIX(cblas_zhpr)(CblasColMajor, INVALID_UPLO, 0, RALPHA, X, 1, A ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_zhpr(CblasColMajor, CblasUpper, INVALID, RALPHA, X, 1, A ); + API_SUFFIX(cblas_zhpr)(CblasColMajor, CblasUpper, INVALID, RALPHA, X, 1, A ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_zhpr(CblasColMajor, CblasUpper, 0, RALPHA, X, 0, A ); + API_SUFFIX(cblas_zhpr)(CblasColMajor, CblasUpper, 0, RALPHA, X, 0, A ); chkxer(); - cblas_info = 2; RowMajorStrg = FALSE; - cblas_zhpr(CblasColMajor, INVALID, 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; - 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; - 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) printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout); else printf("******* %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout); + printf(" %-12s ERROR-EXIT TESTS:%9d RUN,%9d FAILED\n", + cblas_rout, (int) cblas_xtests, (int) cblas_xfails); } diff --git a/CBLAS/testing/c_z3chke.c b/CBLAS/testing/c_z3chke.c index 10078a103b..0a1037bbe7 100644 --- a/CBLAS/testing/c_z3chke.c +++ b/CBLAS/testing/c_z3chke.c @@ -3,28 +3,43 @@ #include "cblas.h" #include "cblas_test.h" -int cblas_ok, cblas_lerr, cblas_info; -int link_xerbla=TRUE; +CBLAS_INT cblas_ok, cblas_lerr, cblas_info; +CBLAS_INT link_xerbla=TRUE; +CBLAS_INT cblas_xtests, cblas_xfails, cblas_xbad; char *cblas_rout; #ifdef F77_Char -void F77_xerbla(F77_Char F77_srname, void *vinfo); +void F77_xerbla(F77_Char F77_srname, void *vinfo #else -void F77_xerbla(char *srname, void *vinfo); +void F77_xerbla(char *srname, void *vinfo #endif +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN srname_len +#endif +); void chkxer(void) { - extern int cblas_ok, cblas_lerr, cblas_info; - extern int link_xerbla; + extern CBLAS_INT cblas_ok, cblas_lerr, cblas_info; + extern CBLAS_INT link_xerbla; + extern CBLAS_INT cblas_xtests, cblas_xfails, cblas_xbad; extern char *cblas_rout; + cblas_xtests++; if (cblas_lerr == 1 ) { - printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", 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) { + cblas_xfails++; } + cblas_xbad = 0; cblas_lerr = 1 ; } -void F77_z3chke(char * rout) { +void F77_z3chke(char *rout +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN rout_len +#endif +) { char *sf = ( rout ) ; double A[4] = {0.0,0.0,0.0,0.0}, B[4] = {0.0,0.0,0.0,0.0}, @@ -32,244 +47,534 @@ void F77_z3chke(char * rout) { ALPHA[2] = {0.0,0.0}, BETA[2] = {0.0,0.0}, RALPHA = 0.0, RBETA = 0.0; - extern int cblas_info, cblas_lerr, cblas_ok; - extern int RowMajorStrg; + extern CBLAS_INT cblas_info, cblas_lerr, cblas_ok; extern char *cblas_rout; cblas_ok = TRUE ; cblas_lerr = PASSED ; + cblas_xtests = 0; + cblas_xfails = 0; + cblas_xbad = 0; + +#ifndef HAS_ATTRIBUTE_WEAK_SUPPORT + #ifdef CBLAS_DLL_IMPORTS + // Since Windows does not support weak symbols, and the trick below doesn't + // work for shared libraries on Windows, we skip the xerbla tests here. + printf("***** WARNING: Skipping xerbla tests since weak symbols are not supported on Windows *****\n"); + return; + #endif if (link_xerbla) /* call these first to link */ { - cblas_xerbla(cblas_info,cblas_rout,""); - F77_xerbla(cblas_rout,&cblas_info); + API_SUFFIX(cblas_xerbla)(cblas_info,cblas_rout,""); + F77_xerbla(cblas_rout,&cblas_info, 1); } +#endif + + link_xerbla = 0; + if (strncmp( sf,"cblas_zgemmtr" ,13)==0) { + cblas_rout = "cblas_zgemmtr" ; + + cblas_info = 1; + API_SUFFIX(cblas_zgemmtr)( INVALID_LAYOUT, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + API_SUFFIX(cblas_zgemmtr)( INVALID_LAYOUT, CblasUpper, CblasNoTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + API_SUFFIX(cblas_zgemmtr)( INVALID_LAYOUT, CblasUpper,CblasTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + API_SUFFIX(cblas_zgemmtr)( INVALID_LAYOUT, CblasUpper, CblasTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 1; + API_SUFFIX(cblas_zgemmtr)( INVALID_LAYOUT, CblasLower, CblasNoTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + API_SUFFIX(cblas_zgemmtr)( INVALID_LAYOUT, CblasLower, CblasNoTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + API_SUFFIX(cblas_zgemmtr)( INVALID_LAYOUT, CblasLower,CblasTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + API_SUFFIX(cblas_zgemmtr)( INVALID_LAYOUT, CblasLower, CblasTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 2; RowMajorStrg = FALSE; + API_SUFFIX(cblas_zgemmtr)( CblasColMajor, INVALID_UPLO, CblasNoTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = FALSE; + API_SUFFIX(cblas_zgemmtr)( CblasColMajor, INVALID_UPLO, CblasNoTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 3; RowMajorStrg = FALSE; + API_SUFFIX(cblas_zgemmtr)( CblasColMajor, CblasUpper, INVALID_TRANSPOSE, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = FALSE; + API_SUFFIX(cblas_zgemmtr)( CblasColMajor, CblasUpper, INVALID_TRANSPOSE, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 4; RowMajorStrg = FALSE; + API_SUFFIX(cblas_zgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, INVALID_TRANSPOSE, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = FALSE; + API_SUFFIX(cblas_zgemmtr)( CblasColMajor, CblasUpper, CblasTrans, INVALID_TRANSPOSE, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + + cblas_info = 5; RowMajorStrg = FALSE; + API_SUFFIX(cblas_zgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + API_SUFFIX(cblas_zgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + API_SUFFIX(cblas_zgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + API_SUFFIX(cblas_zgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 6; RowMajorStrg = FALSE; + API_SUFFIX(cblas_zgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = FALSE; + API_SUFFIX(cblas_zgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = FALSE; + API_SUFFIX(cblas_zgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = FALSE; + API_SUFFIX(cblas_zgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + + cblas_info = 9; RowMajorStrg = FALSE; + API_SUFFIX(cblas_zgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = FALSE; + API_SUFFIX(cblas_zgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = FALSE; + API_SUFFIX(cblas_zgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2, + ALPHA, A, 1, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 9; RowMajorStrg = FALSE; + API_SUFFIX(cblas_zgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 11; RowMajorStrg = FALSE; + API_SUFFIX(cblas_zgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = FALSE; + API_SUFFIX(cblas_zgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = FALSE; + API_SUFFIX(cblas_zgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 14; RowMajorStrg = FALSE; + API_SUFFIX(cblas_zgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = FALSE; + API_SUFFIX(cblas_zgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + + cblas_info = 14; RowMajorStrg = FALSE; + API_SUFFIX(cblas_zgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = FALSE; + API_SUFFIX(cblas_zgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + 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 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 6; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 9; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, 2, + ALPHA, A, 1, B, 2, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0, + ALPHA, A, 1, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); - if (strncmp( sf,"cblas_zgemm" ,11)==0) { + cblas_info = 11; RowMajorStrg = TRUE; + 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)( 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)( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 14; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + + } else if (strncmp( sf,"cblas_zgemm" ,11)==0) { cblas_rout = "cblas_zgemm" ; cblas_info = 1; - cblas_zgemm( INVALID, CblasNoTrans, CblasNoTrans, 0, 0, 0, + API_SUFFIX(cblas_zgemm)( INVALID_LAYOUT, CblasNoTrans, CblasNoTrans, 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 1; - cblas_zgemm( INVALID, CblasNoTrans, CblasTrans, 0, 0, 0, + API_SUFFIX(cblas_zgemm)( INVALID_LAYOUT, CblasNoTrans, CblasTrans, 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 1; - cblas_zgemm( INVALID, CblasTrans, CblasNoTrans, 0, 0, 0, + API_SUFFIX(cblas_zgemm)( INVALID_LAYOUT, CblasTrans, CblasNoTrans, 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 1; - cblas_zgemm( INVALID, CblasTrans, CblasTrans, 0, 0, 0, + API_SUFFIX(cblas_zgemm)( INVALID_LAYOUT, CblasTrans, CblasTrans, 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_zgemm( CblasColMajor, INVALID, CblasNoTrans, 0, 0, 0, + API_SUFFIX(cblas_zgemm)( CblasColMajor, INVALID_TRANSPOSE, CblasNoTrans, 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_zgemm( CblasColMajor, INVALID, CblasTrans, 0, 0, 0, + API_SUFFIX(cblas_zgemm)( CblasColMajor, INVALID_TRANSPOSE, CblasTrans, 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_zgemm( CblasColMajor, CblasNoTrans, INVALID, 0, 0, 0, + API_SUFFIX(cblas_zgemm)( CblasColMajor, CblasNoTrans, INVALID_TRANSPOSE, 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_zgemm( CblasColMajor, CblasTrans, INVALID, 0, 0, 0, + API_SUFFIX(cblas_zgemm)( CblasColMajor, CblasTrans, INVALID_TRANSPOSE, 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_zgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, INVALID, 0, 0, + API_SUFFIX(cblas_zgemm)( CblasColMajor, CblasNoTrans, CblasNoTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_zgemm( CblasColMajor, CblasNoTrans, CblasTrans, INVALID, 0, 0, + API_SUFFIX(cblas_zgemm)( CblasColMajor, CblasNoTrans, CblasTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_zgemm( CblasColMajor, CblasTrans, CblasNoTrans, INVALID, 0, 0, + API_SUFFIX(cblas_zgemm)( CblasColMajor, CblasTrans, CblasNoTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_zgemm( CblasColMajor, CblasTrans, CblasTrans, INVALID, 0, 0, + API_SUFFIX(cblas_zgemm)( CblasColMajor, CblasTrans, CblasTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_zgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, 0, INVALID, 0, + API_SUFFIX(cblas_zgemm)( CblasColMajor, CblasNoTrans, CblasNoTrans, 0, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_zgemm( CblasColMajor, CblasNoTrans, CblasTrans, 0, INVALID, 0, + API_SUFFIX(cblas_zgemm)( CblasColMajor, CblasNoTrans, CblasTrans, 0, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_zgemm( CblasColMajor, CblasTrans, CblasNoTrans, 0, INVALID, 0, + API_SUFFIX(cblas_zgemm)( CblasColMajor, CblasTrans, CblasNoTrans, 0, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_zgemm( CblasColMajor, CblasTrans, CblasTrans, 0, INVALID, 0, + API_SUFFIX(cblas_zgemm)( CblasColMajor, CblasTrans, CblasTrans, 0, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_zgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, 0, 0, INVALID, + API_SUFFIX(cblas_zgemm)( CblasColMajor, CblasNoTrans, CblasNoTrans, 0, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_zgemm( CblasColMajor, CblasNoTrans, CblasTrans, 0, 0, INVALID, + API_SUFFIX(cblas_zgemm)( CblasColMajor, CblasNoTrans, CblasTrans, 0, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_zgemm( CblasColMajor, CblasTrans, CblasNoTrans, 0, 0, INVALID, + API_SUFFIX(cblas_zgemm)( CblasColMajor, CblasTrans, CblasNoTrans, 0, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_zgemm( CblasColMajor, CblasTrans, CblasTrans, 0, 0, INVALID, + API_SUFFIX(cblas_zgemm)( CblasColMajor, CblasTrans, CblasTrans, 0, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_zgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, 2, 0, 0, + API_SUFFIX(cblas_zgemm)( CblasColMajor, CblasNoTrans, CblasNoTrans, 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_zgemm( CblasColMajor, CblasNoTrans, CblasTrans, 2, 0, 0, + API_SUFFIX(cblas_zgemm)( CblasColMajor, CblasNoTrans, CblasTrans, 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_zgemm( CblasColMajor, CblasTrans, CblasNoTrans, 0, 0, 2, + API_SUFFIX(cblas_zgemm)( CblasColMajor, CblasTrans, CblasNoTrans, 0, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_zgemm( CblasColMajor, CblasTrans, CblasTrans, 0, 0, 2, + API_SUFFIX(cblas_zgemm)( CblasColMajor, CblasTrans, CblasTrans, 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_zgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, 0, 0, 2, + API_SUFFIX(cblas_zgemm)( CblasColMajor, CblasNoTrans, CblasNoTrans, 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_zgemm( CblasColMajor, CblasTrans, CblasNoTrans, 0, 0, 2, + API_SUFFIX(cblas_zgemm)( CblasColMajor, CblasTrans, CblasNoTrans, 0, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_zgemm( CblasColMajor, CblasNoTrans, CblasTrans, 0, 2, 0, + API_SUFFIX(cblas_zgemm)( CblasColMajor, CblasNoTrans, CblasTrans, 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_zgemm( CblasColMajor, CblasTrans, CblasTrans, 0, 2, 0, + API_SUFFIX(cblas_zgemm)( CblasColMajor, CblasTrans, CblasTrans, 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = FALSE; - cblas_zgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, 2, 0, 0, + API_SUFFIX(cblas_zgemm)( CblasColMajor, CblasNoTrans, CblasNoTrans, 2, 0, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = FALSE; - cblas_zgemm( CblasColMajor, CblasNoTrans, CblasTrans, 2, 0, 0, + API_SUFFIX(cblas_zgemm)( CblasColMajor, CblasNoTrans, CblasTrans, 2, 0, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = FALSE; - cblas_zgemm( CblasColMajor, CblasTrans, CblasNoTrans, 2, 0, 0, + API_SUFFIX(cblas_zgemm)( CblasColMajor, CblasTrans, CblasNoTrans, 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = FALSE; - cblas_zgemm( CblasColMajor, CblasTrans, CblasTrans, 2, 0, 0, + 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; - cblas_zgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, INVALID, 0, 0, + API_SUFFIX(cblas_zgemm)( CblasRowMajor, CblasNoTrans, CblasNoTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_zgemm( CblasRowMajor, CblasNoTrans, CblasTrans, INVALID, 0, 0, + API_SUFFIX(cblas_zgemm)( CblasRowMajor, CblasNoTrans, CblasTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_zgemm( CblasRowMajor, CblasTrans, CblasNoTrans, INVALID, 0, 0, + API_SUFFIX(cblas_zgemm)( CblasRowMajor, CblasTrans, CblasNoTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_zgemm( CblasRowMajor, CblasTrans, CblasTrans, INVALID, 0, 0, + API_SUFFIX(cblas_zgemm)( CblasRowMajor, CblasTrans, CblasTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_zgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, INVALID, 0, + API_SUFFIX(cblas_zgemm)( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_zgemm( CblasRowMajor, CblasNoTrans, CblasTrans, 0, INVALID, 0, + API_SUFFIX(cblas_zgemm)( CblasRowMajor, CblasNoTrans, CblasTrans, 0, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_zgemm( CblasRowMajor, CblasTrans, CblasNoTrans, 0, INVALID, 0, + API_SUFFIX(cblas_zgemm)( CblasRowMajor, CblasTrans, CblasNoTrans, 0, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_zgemm( CblasRowMajor, CblasTrans, CblasTrans, 0, INVALID, 0, + API_SUFFIX(cblas_zgemm)( CblasRowMajor, CblasTrans, CblasTrans, 0, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_zgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 0, INVALID, + API_SUFFIX(cblas_zgemm)( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_zgemm( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 0, INVALID, + API_SUFFIX(cblas_zgemm)( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_zgemm( CblasRowMajor, CblasTrans, CblasNoTrans, 0, 0, INVALID, + API_SUFFIX(cblas_zgemm)( CblasRowMajor, CblasTrans, CblasNoTrans, 0, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_zgemm( CblasRowMajor, CblasTrans, CblasTrans, 0, 0, INVALID, + API_SUFFIX(cblas_zgemm)( CblasRowMajor, CblasTrans, CblasTrans, 0, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = TRUE; - cblas_zgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 0, 2, + API_SUFFIX(cblas_zgemm)( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 9; RowMajorStrg = TRUE; - cblas_zgemm( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 0, 2, + API_SUFFIX(cblas_zgemm)( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 9; RowMajorStrg = TRUE; - cblas_zgemm( CblasRowMajor, CblasTrans, CblasNoTrans, 2, 0, 0, + API_SUFFIX(cblas_zgemm)( CblasRowMajor, CblasTrans, CblasNoTrans, 2, 0, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = TRUE; - cblas_zgemm( CblasRowMajor, CblasTrans, CblasTrans, 2, 0, 0, + API_SUFFIX(cblas_zgemm)( CblasRowMajor, CblasTrans, CblasTrans, 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_zgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 2, 0, + API_SUFFIX(cblas_zgemm)( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_zgemm( CblasRowMajor, CblasTrans, CblasNoTrans, 0, 2, 0, + API_SUFFIX(cblas_zgemm)( CblasRowMajor, CblasTrans, CblasNoTrans, 0, 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_zgemm( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 0, 2, + API_SUFFIX(cblas_zgemm)( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_zgemm( CblasRowMajor, CblasTrans, CblasTrans, 0, 0, 2, + API_SUFFIX(cblas_zgemm)( CblasRowMajor, CblasTrans, CblasTrans, 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = TRUE; - cblas_zgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 2, 0, + API_SUFFIX(cblas_zgemm)( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = TRUE; - cblas_zgemm( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 2, 0, + API_SUFFIX(cblas_zgemm)( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = TRUE; - cblas_zgemm( CblasRowMajor, CblasTrans, CblasNoTrans, 0, 2, 0, + API_SUFFIX(cblas_zgemm)( CblasRowMajor, CblasTrans, CblasNoTrans, 0, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = TRUE; - cblas_zgemm( CblasRowMajor, CblasTrans, CblasTrans, 0, 2, 0, + API_SUFFIX(cblas_zgemm)( CblasRowMajor, CblasTrans, CblasTrans, 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); @@ -277,175 +582,184 @@ void F77_z3chke(char * rout) { cblas_rout = "cblas_zhemm" ; cblas_info = 1; - cblas_zhemm( INVALID, CblasRight, CblasLower, 0, 0, + API_SUFFIX(cblas_zhemm)( INVALID_LAYOUT, CblasRight, CblasLower, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_zhemm( CblasColMajor, INVALID, CblasUpper, 0, 0, + API_SUFFIX(cblas_zhemm)( CblasColMajor, INVALID_SIDE, CblasUpper, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_zhemm( CblasColMajor, CblasLeft, INVALID, 0, 0, + API_SUFFIX(cblas_zhemm)( CblasColMajor, CblasLeft, INVALID_UPLO, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_zhemm( CblasColMajor, CblasLeft, CblasUpper, INVALID, 0, + API_SUFFIX(cblas_zhemm)( CblasColMajor, CblasLeft, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_zhemm( CblasColMajor, CblasRight, CblasUpper, INVALID, 0, + API_SUFFIX(cblas_zhemm)( CblasColMajor, CblasRight, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_zhemm( CblasColMajor, CblasLeft, CblasLower, INVALID, 0, + API_SUFFIX(cblas_zhemm)( CblasColMajor, CblasLeft, CblasLower, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_zhemm( CblasColMajor, CblasRight, CblasLower, INVALID, 0, + API_SUFFIX(cblas_zhemm)( CblasColMajor, CblasRight, CblasLower, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_zhemm( CblasColMajor, CblasLeft, CblasUpper, 0, INVALID, + API_SUFFIX(cblas_zhemm)( CblasColMajor, CblasLeft, CblasUpper, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_zhemm( CblasColMajor, CblasRight, CblasUpper, 0, INVALID, + API_SUFFIX(cblas_zhemm)( CblasColMajor, CblasRight, CblasUpper, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_zhemm( CblasColMajor, CblasLeft, CblasLower, 0, INVALID, + API_SUFFIX(cblas_zhemm)( CblasColMajor, CblasLeft, CblasLower, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_zhemm( CblasColMajor, CblasRight, CblasLower, 0, INVALID, + API_SUFFIX(cblas_zhemm)( CblasColMajor, CblasRight, CblasLower, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_zhemm( CblasColMajor, CblasLeft, CblasUpper, 2, 0, + API_SUFFIX(cblas_zhemm)( CblasColMajor, CblasLeft, CblasUpper, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_zhemm( CblasColMajor, CblasRight, CblasUpper, 0, 2, + API_SUFFIX(cblas_zhemm)( CblasColMajor, CblasRight, CblasUpper, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_zhemm( CblasColMajor, CblasLeft, CblasLower, 2, 0, + API_SUFFIX(cblas_zhemm)( CblasColMajor, CblasLeft, CblasLower, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_zhemm( CblasColMajor, CblasRight, CblasLower, 0, 2, + API_SUFFIX(cblas_zhemm)( CblasColMajor, CblasRight, CblasLower, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_zhemm( CblasColMajor, CblasLeft, CblasUpper, 2, 0, + API_SUFFIX(cblas_zhemm)( CblasColMajor, CblasLeft, CblasUpper, 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_zhemm( CblasColMajor, CblasRight, CblasUpper, 2, 0, + API_SUFFIX(cblas_zhemm)( CblasColMajor, CblasRight, CblasUpper, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_zhemm( CblasColMajor, CblasLeft, CblasLower, 2, 0, + API_SUFFIX(cblas_zhemm)( CblasColMajor, CblasLeft, CblasLower, 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_zhemm( CblasColMajor, CblasRight, CblasLower, 2, 0, + API_SUFFIX(cblas_zhemm)( CblasColMajor, CblasRight, CblasLower, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_zhemm( CblasColMajor, CblasLeft, CblasUpper, 2, 0, + API_SUFFIX(cblas_zhemm)( CblasColMajor, CblasLeft, CblasUpper, 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_zhemm( CblasColMajor, CblasRight, CblasUpper, 2, 0, + API_SUFFIX(cblas_zhemm)( CblasColMajor, CblasRight, CblasUpper, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_zhemm( CblasColMajor, CblasLeft, CblasLower, 2, 0, + API_SUFFIX(cblas_zhemm)( CblasColMajor, CblasLeft, CblasLower, 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_zhemm( CblasColMajor, CblasRight, CblasLower, 2, 0, + 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; - cblas_zhemm( CblasRowMajor, CblasLeft, CblasUpper, INVALID, 0, + API_SUFFIX(cblas_zhemm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_zhemm( CblasRowMajor, CblasRight, CblasUpper, INVALID, 0, + API_SUFFIX(cblas_zhemm)( CblasRowMajor, CblasRight, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_zhemm( CblasRowMajor, CblasLeft, CblasLower, INVALID, 0, + API_SUFFIX(cblas_zhemm)( CblasRowMajor, CblasLeft, CblasLower, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_zhemm( CblasRowMajor, CblasRight, CblasLower, INVALID, 0, + API_SUFFIX(cblas_zhemm)( CblasRowMajor, CblasRight, CblasLower, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_zhemm( CblasRowMajor, CblasLeft, CblasUpper, 0, INVALID, + API_SUFFIX(cblas_zhemm)( CblasRowMajor, CblasLeft, CblasUpper, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_zhemm( CblasRowMajor, CblasRight, CblasUpper, 0, INVALID, + API_SUFFIX(cblas_zhemm)( CblasRowMajor, CblasRight, CblasUpper, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_zhemm( CblasRowMajor, CblasLeft, CblasLower, 0, INVALID, + API_SUFFIX(cblas_zhemm)( CblasRowMajor, CblasLeft, CblasLower, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_zhemm( CblasRowMajor, CblasRight, CblasLower, 0, INVALID, + API_SUFFIX(cblas_zhemm)( CblasRowMajor, CblasRight, CblasLower, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_zhemm( CblasRowMajor, CblasLeft, CblasUpper, 2, 0, + API_SUFFIX(cblas_zhemm)( CblasRowMajor, CblasLeft, CblasUpper, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_zhemm( CblasRowMajor, CblasRight, CblasUpper, 0, 2, + API_SUFFIX(cblas_zhemm)( CblasRowMajor, CblasRight, CblasUpper, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_zhemm( CblasRowMajor, CblasLeft, CblasLower, 2, 0, + API_SUFFIX(cblas_zhemm)( CblasRowMajor, CblasLeft, CblasLower, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_zhemm( CblasRowMajor, CblasRight, CblasLower, 0, 2, + API_SUFFIX(cblas_zhemm)( CblasRowMajor, CblasRight, CblasLower, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_zhemm( CblasRowMajor, CblasLeft, CblasUpper, 0, 2, + API_SUFFIX(cblas_zhemm)( CblasRowMajor, CblasLeft, CblasUpper, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_zhemm( CblasRowMajor, CblasRight, CblasUpper, 0, 2, + API_SUFFIX(cblas_zhemm)( CblasRowMajor, CblasRight, CblasUpper, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_zhemm( CblasRowMajor, CblasLeft, CblasLower, 0, 2, + API_SUFFIX(cblas_zhemm)( CblasRowMajor, CblasLeft, CblasLower, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_zhemm( CblasRowMajor, CblasRight, CblasLower, 0, 2, + API_SUFFIX(cblas_zhemm)( CblasRowMajor, CblasRight, CblasLower, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_zhemm( CblasRowMajor, CblasLeft, CblasUpper, 0, 2, + API_SUFFIX(cblas_zhemm)( CblasRowMajor, CblasLeft, CblasUpper, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_zhemm( CblasRowMajor, CblasRight, CblasUpper, 0, 2, + API_SUFFIX(cblas_zhemm)( CblasRowMajor, CblasRight, CblasUpper, 0, 2, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_zhemm( CblasRowMajor, CblasLeft, CblasLower, 0, 2, + API_SUFFIX(cblas_zhemm)( CblasRowMajor, CblasLeft, CblasLower, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_zhemm( CblasRowMajor, CblasRight, CblasLower, 0, 2, + API_SUFFIX(cblas_zhemm)( CblasRowMajor, CblasRight, CblasLower, 0, 2, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); @@ -453,175 +767,184 @@ void F77_z3chke(char * rout) { cblas_rout = "cblas_zsymm" ; cblas_info = 1; - cblas_zsymm( INVALID, CblasRight, CblasLower, 0, 0, + API_SUFFIX(cblas_zsymm)( INVALID_LAYOUT, CblasRight, CblasLower, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_zsymm( CblasColMajor, INVALID, CblasUpper, 0, 0, + API_SUFFIX(cblas_zsymm)( CblasColMajor, INVALID_SIDE, CblasUpper, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_zsymm( CblasColMajor, CblasLeft, INVALID, 0, 0, + API_SUFFIX(cblas_zsymm)( CblasColMajor, CblasLeft, INVALID_UPLO, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_zsymm( CblasColMajor, CblasLeft, CblasUpper, INVALID, 0, + API_SUFFIX(cblas_zsymm)( CblasColMajor, CblasLeft, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_zsymm( CblasColMajor, CblasRight, CblasUpper, INVALID, 0, + API_SUFFIX(cblas_zsymm)( CblasColMajor, CblasRight, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_zsymm( CblasColMajor, CblasLeft, CblasLower, INVALID, 0, + API_SUFFIX(cblas_zsymm)( CblasColMajor, CblasLeft, CblasLower, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_zsymm( CblasColMajor, CblasRight, CblasLower, INVALID, 0, + API_SUFFIX(cblas_zsymm)( CblasColMajor, CblasRight, CblasLower, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_zsymm( CblasColMajor, CblasLeft, CblasUpper, 0, INVALID, + API_SUFFIX(cblas_zsymm)( CblasColMajor, CblasLeft, CblasUpper, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_zsymm( CblasColMajor, CblasRight, CblasUpper, 0, INVALID, + API_SUFFIX(cblas_zsymm)( CblasColMajor, CblasRight, CblasUpper, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_zsymm( CblasColMajor, CblasLeft, CblasLower, 0, INVALID, + API_SUFFIX(cblas_zsymm)( CblasColMajor, CblasLeft, CblasLower, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_zsymm( CblasColMajor, CblasRight, CblasLower, 0, INVALID, + API_SUFFIX(cblas_zsymm)( CblasColMajor, CblasRight, CblasLower, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_zsymm( CblasColMajor, CblasLeft, CblasUpper, 2, 0, + API_SUFFIX(cblas_zsymm)( CblasColMajor, CblasLeft, CblasUpper, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_zsymm( CblasColMajor, CblasRight, CblasUpper, 0, 2, + API_SUFFIX(cblas_zsymm)( CblasColMajor, CblasRight, CblasUpper, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_zsymm( CblasColMajor, CblasLeft, CblasLower, 2, 0, + API_SUFFIX(cblas_zsymm)( CblasColMajor, CblasLeft, CblasLower, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_zsymm( CblasColMajor, CblasRight, CblasLower, 0, 2, + API_SUFFIX(cblas_zsymm)( CblasColMajor, CblasRight, CblasLower, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_zsymm( CblasColMajor, CblasLeft, CblasUpper, 2, 0, + API_SUFFIX(cblas_zsymm)( CblasColMajor, CblasLeft, CblasUpper, 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_zsymm( CblasColMajor, CblasRight, CblasUpper, 2, 0, + API_SUFFIX(cblas_zsymm)( CblasColMajor, CblasRight, CblasUpper, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_zsymm( CblasColMajor, CblasLeft, CblasLower, 2, 0, + API_SUFFIX(cblas_zsymm)( CblasColMajor, CblasLeft, CblasLower, 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_zsymm( CblasColMajor, CblasRight, CblasLower, 2, 0, + API_SUFFIX(cblas_zsymm)( CblasColMajor, CblasRight, CblasLower, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_zsymm( CblasColMajor, CblasLeft, CblasUpper, 2, 0, + API_SUFFIX(cblas_zsymm)( CblasColMajor, CblasLeft, CblasUpper, 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_zsymm( CblasColMajor, CblasRight, CblasUpper, 2, 0, + API_SUFFIX(cblas_zsymm)( CblasColMajor, CblasRight, CblasUpper, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_zsymm( CblasColMajor, CblasLeft, CblasLower, 2, 0, + API_SUFFIX(cblas_zsymm)( CblasColMajor, CblasLeft, CblasLower, 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_zsymm( CblasColMajor, CblasRight, CblasLower, 2, 0, + 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; - cblas_zsymm( CblasRowMajor, CblasLeft, CblasUpper, INVALID, 0, + API_SUFFIX(cblas_zsymm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_zsymm( CblasRowMajor, CblasRight, CblasUpper, INVALID, 0, + API_SUFFIX(cblas_zsymm)( CblasRowMajor, CblasRight, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_zsymm( CblasRowMajor, CblasLeft, CblasLower, INVALID, 0, + API_SUFFIX(cblas_zsymm)( CblasRowMajor, CblasLeft, CblasLower, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = TRUE; - cblas_zsymm( CblasRowMajor, CblasRight, CblasLower, INVALID, 0, + API_SUFFIX(cblas_zsymm)( CblasRowMajor, CblasRight, CblasLower, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_zsymm( CblasRowMajor, CblasLeft, CblasUpper, 0, INVALID, + API_SUFFIX(cblas_zsymm)( CblasRowMajor, CblasLeft, CblasUpper, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_zsymm( CblasRowMajor, CblasRight, CblasUpper, 0, INVALID, + API_SUFFIX(cblas_zsymm)( CblasRowMajor, CblasRight, CblasUpper, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_zsymm( CblasRowMajor, CblasLeft, CblasLower, 0, INVALID, + API_SUFFIX(cblas_zsymm)( CblasRowMajor, CblasLeft, CblasLower, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_zsymm( CblasRowMajor, CblasRight, CblasLower, 0, INVALID, + API_SUFFIX(cblas_zsymm)( CblasRowMajor, CblasRight, CblasLower, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_zsymm( CblasRowMajor, CblasLeft, CblasUpper, 2, 0, + API_SUFFIX(cblas_zsymm)( CblasRowMajor, CblasLeft, CblasUpper, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_zsymm( CblasRowMajor, CblasRight, CblasUpper, 0, 2, + API_SUFFIX(cblas_zsymm)( CblasRowMajor, CblasRight, CblasUpper, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_zsymm( CblasRowMajor, CblasLeft, CblasLower, 2, 0, + API_SUFFIX(cblas_zsymm)( CblasRowMajor, CblasLeft, CblasLower, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_zsymm( CblasRowMajor, CblasRight, CblasLower, 0, 2, + API_SUFFIX(cblas_zsymm)( CblasRowMajor, CblasRight, CblasLower, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_zsymm( CblasRowMajor, CblasLeft, CblasUpper, 0, 2, + API_SUFFIX(cblas_zsymm)( CblasRowMajor, CblasLeft, CblasUpper, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_zsymm( CblasRowMajor, CblasRight, CblasUpper, 0, 2, + API_SUFFIX(cblas_zsymm)( CblasRowMajor, CblasRight, CblasUpper, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_zsymm( CblasRowMajor, CblasLeft, CblasLower, 0, 2, + API_SUFFIX(cblas_zsymm)( CblasRowMajor, CblasLeft, CblasLower, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_zsymm( CblasRowMajor, CblasRight, CblasLower, 0, 2, + API_SUFFIX(cblas_zsymm)( CblasRowMajor, CblasRight, CblasLower, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_zsymm( CblasRowMajor, CblasLeft, CblasUpper, 0, 2, + API_SUFFIX(cblas_zsymm)( CblasRowMajor, CblasLeft, CblasUpper, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_zsymm( CblasRowMajor, CblasRight, CblasUpper, 0, 2, + API_SUFFIX(cblas_zsymm)( CblasRowMajor, CblasRight, CblasUpper, 0, 2, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_zsymm( CblasRowMajor, CblasLeft, CblasLower, 0, 2, + API_SUFFIX(cblas_zsymm)( CblasRowMajor, CblasLeft, CblasLower, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_zsymm( CblasRowMajor, CblasRight, CblasLower, 0, 2, + API_SUFFIX(cblas_zsymm)( CblasRowMajor, CblasRight, CblasLower, 0, 2, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); @@ -629,279 +952,296 @@ void F77_z3chke(char * rout) { cblas_rout = "cblas_ztrmm" ; cblas_info = 1; - cblas_ztrmm( INVALID, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( INVALID_LAYOUT, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, INVALID_SIDE, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasLeft, INVALID, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasLeft, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasLeft, CblasUpper, INVALID, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasLeft, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, - INVALID, 0, 0, ALPHA, A, 1, B, 1 ); + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ztrmm( CblasColMajor, CblasRight, CblasLower, CblasTrans, + 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; - cblas_ztrmm( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ztrmm( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ztrmm( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ztrmm( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ztrmm( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ztrmm( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ztrmm( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ztrmm( CblasRowMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ztrmm( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ztrmm( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ztrmm( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ztrmm( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ztrmm( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ztrmm( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ztrmm( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ztrmm( CblasRowMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ztrmm( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ztrmm( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ztrmm( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ztrmm( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ztrmm( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ztrmm( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ztrmm( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ztrmm( CblasRowMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ztrmm( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ztrmm( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ztrmm( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ztrmm( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ztrmm( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ztrmm( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ztrmm( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ztrmm( CblasRowMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 2, B, 1 ); chkxer(); @@ -909,279 +1249,296 @@ void F77_z3chke(char * rout) { cblas_rout = "cblas_ztrsm" ; cblas_info = 1; - cblas_ztrsm( INVALID, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( INVALID_LAYOUT, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, INVALID, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, INVALID_SIDE, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasLeft, INVALID, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasLeft, INVALID_UPLO, CblasNoTrans, CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasLeft, CblasUpper, INVALID, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasLeft, CblasUpper, INVALID_TRANSPOSE, CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, - INVALID, 0, 0, ALPHA, A, 1, B, 1 ); + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = FALSE; - cblas_ztrsm( CblasColMajor, CblasRight, CblasLower, CblasTrans, + 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; - cblas_ztrsm( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ztrsm( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ztrsm( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ztrsm( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ztrsm( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ztrsm( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ztrsm( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_ztrsm( CblasRowMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ztrsm( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ztrsm( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ztrsm( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ztrsm( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ztrsm( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ztrsm( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ztrsm( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 7; RowMajorStrg = TRUE; - cblas_ztrsm( CblasRowMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, INVALID, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ztrsm( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ztrsm( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ztrsm( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ztrsm( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ztrsm( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ztrsm( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ztrsm( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_ztrsm( CblasRowMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 2 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ztrsm( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ztrsm( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ztrsm( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ztrsm( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ztrsm( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ztrsm( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 1, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ztrsm( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 0, 2, ALPHA, A, 2, B, 1 ); chkxer(); cblas_info = 12; RowMajorStrg = TRUE; - cblas_ztrsm( CblasRowMajor, CblasRight, CblasLower, CblasTrans, + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 0, 2, ALPHA, A, 2, B, 1 ); chkxer(); @@ -1189,111 +1546,152 @@ void F77_z3chke(char * rout) { cblas_rout = "cblas_zherk" ; cblas_info = 1; - cblas_zherk(INVALID, CblasUpper, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_zherk)(INVALID_LAYOUT, CblasUpper, CblasNoTrans, 0, 0, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_zherk(CblasColMajor, INVALID, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_zherk)(CblasColMajor, INVALID_UPLO, CblasNoTrans, 0, 0, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_zherk(CblasColMajor, CblasUpper, CblasTrans, 0, 0, + API_SUFFIX(cblas_zherk)(CblasColMajor, CblasUpper, CblasTrans, 0, 0, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_zherk(CblasColMajor, CblasUpper, CblasNoTrans, INVALID, 0, + API_SUFFIX(cblas_zherk)(CblasColMajor, CblasUpper, CblasNoTrans, INVALID, 0, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_zherk(CblasColMajor, CblasUpper, CblasConjTrans, INVALID, 0, + API_SUFFIX(cblas_zherk)(CblasColMajor, CblasUpper, CblasConjTrans, INVALID, 0, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_zherk(CblasColMajor, CblasLower, CblasNoTrans, INVALID, 0, + API_SUFFIX(cblas_zherk)(CblasColMajor, CblasLower, CblasNoTrans, INVALID, 0, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_zherk(CblasColMajor, CblasLower, CblasConjTrans, INVALID, 0, + API_SUFFIX(cblas_zherk)(CblasColMajor, CblasLower, CblasConjTrans, INVALID, 0, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_zherk(CblasColMajor, CblasUpper, CblasNoTrans, 0, INVALID, + API_SUFFIX(cblas_zherk)(CblasColMajor, CblasUpper, CblasNoTrans, 0, INVALID, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_zherk(CblasColMajor, CblasUpper, CblasConjTrans, 0, INVALID, + API_SUFFIX(cblas_zherk)(CblasColMajor, CblasUpper, CblasConjTrans, 0, INVALID, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_zherk(CblasColMajor, CblasLower, CblasNoTrans, 0, INVALID, + API_SUFFIX(cblas_zherk)(CblasColMajor, CblasLower, CblasNoTrans, 0, INVALID, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_zherk(CblasColMajor, CblasLower, CblasConjTrans, 0, INVALID, + 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; - cblas_zherk(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_zherk)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, RALPHA, A, 1, RBETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_zherk(CblasRowMajor, CblasUpper, CblasConjTrans, 2, 0, + API_SUFFIX(cblas_zherk)(CblasRowMajor, CblasUpper, CblasConjTrans, 2, 0, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_zherk(CblasRowMajor, CblasLower, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_zherk)(CblasRowMajor, CblasLower, CblasNoTrans, 0, 2, RALPHA, A, 1, RBETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_zherk(CblasRowMajor, CblasLower, CblasConjTrans, 2, 0, + API_SUFFIX(cblas_zherk)(CblasRowMajor, CblasLower, CblasConjTrans, 2, 0, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_zherk(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_zherk)(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, RALPHA, A, 1, RBETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_zherk(CblasColMajor, CblasUpper, CblasConjTrans, 0, 2, + API_SUFFIX(cblas_zherk)(CblasColMajor, CblasUpper, CblasConjTrans, 0, 2, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_zherk(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_zherk)(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, RALPHA, A, 1, RBETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_zherk(CblasColMajor, CblasLower, CblasConjTrans, 0, 2, + API_SUFFIX(cblas_zherk)(CblasColMajor, CblasLower, CblasConjTrans, 0, 2, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_zherk(CblasRowMajor, CblasUpper, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_zherk)(CblasRowMajor, CblasUpper, CblasNoTrans, 2, 0, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_zherk(CblasRowMajor, CblasUpper, CblasConjTrans, 2, 0, + API_SUFFIX(cblas_zherk)(CblasRowMajor, CblasUpper, CblasConjTrans, 2, 0, RALPHA, A, 2, RBETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_zherk(CblasRowMajor, CblasLower, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_zherk)(CblasRowMajor, CblasLower, CblasNoTrans, 2, 0, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_zherk(CblasRowMajor, CblasLower, CblasConjTrans, 2, 0, + API_SUFFIX(cblas_zherk)(CblasRowMajor, CblasLower, CblasConjTrans, 2, 0, RALPHA, A, 2, RBETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_zherk(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_zherk)(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, RALPHA, A, 2, RBETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_zherk(CblasColMajor, CblasUpper, CblasConjTrans, 2, 0, + API_SUFFIX(cblas_zherk)(CblasColMajor, CblasUpper, CblasConjTrans, 2, 0, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_zherk(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_zherk)(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, RALPHA, A, 2, RBETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_zherk(CblasColMajor, CblasLower, CblasConjTrans, 2, 0, + API_SUFFIX(cblas_zherk)(CblasColMajor, CblasLower, CblasConjTrans, 2, 0, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); @@ -1301,111 +1699,152 @@ void F77_z3chke(char * rout) { cblas_rout = "cblas_zsyrk" ; cblas_info = 1; - cblas_zsyrk(INVALID, CblasUpper, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_zsyrk)(INVALID_LAYOUT, CblasUpper, CblasNoTrans, 0, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_zsyrk(CblasColMajor, INVALID, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_zsyrk)(CblasColMajor, INVALID_UPLO, CblasNoTrans, 0, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_zsyrk(CblasColMajor, CblasUpper, CblasConjTrans, 0, 0, + API_SUFFIX(cblas_zsyrk)(CblasColMajor, CblasUpper, CblasConjTrans, 0, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_zsyrk(CblasColMajor, CblasUpper, CblasNoTrans, INVALID, 0, + API_SUFFIX(cblas_zsyrk)(CblasColMajor, CblasUpper, CblasNoTrans, INVALID, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_zsyrk(CblasColMajor, CblasUpper, CblasTrans, INVALID, 0, + API_SUFFIX(cblas_zsyrk)(CblasColMajor, CblasUpper, CblasTrans, INVALID, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_zsyrk(CblasColMajor, CblasLower, CblasNoTrans, INVALID, 0, + API_SUFFIX(cblas_zsyrk)(CblasColMajor, CblasLower, CblasNoTrans, INVALID, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_zsyrk(CblasColMajor, CblasLower, CblasTrans, INVALID, 0, + API_SUFFIX(cblas_zsyrk)(CblasColMajor, CblasLower, CblasTrans, INVALID, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_zsyrk(CblasColMajor, CblasUpper, CblasNoTrans, 0, INVALID, + API_SUFFIX(cblas_zsyrk)(CblasColMajor, CblasUpper, CblasNoTrans, 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_zsyrk(CblasColMajor, CblasUpper, CblasTrans, 0, INVALID, + API_SUFFIX(cblas_zsyrk)(CblasColMajor, CblasUpper, CblasTrans, 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_zsyrk(CblasColMajor, CblasLower, CblasNoTrans, 0, INVALID, + API_SUFFIX(cblas_zsyrk)(CblasColMajor, CblasLower, CblasNoTrans, 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_zsyrk(CblasColMajor, CblasLower, CblasTrans, 0, INVALID, + 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; - cblas_zsyrk(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_zsyrk)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_zsyrk(CblasRowMajor, CblasUpper, CblasTrans, 2, 0, + API_SUFFIX(cblas_zsyrk)(CblasRowMajor, CblasUpper, CblasTrans, 2, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_zsyrk(CblasRowMajor, CblasLower, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_zsyrk)(CblasRowMajor, CblasLower, CblasNoTrans, 0, 2, ALPHA, A, 1, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_zsyrk(CblasRowMajor, CblasLower, CblasTrans, 2, 0, + API_SUFFIX(cblas_zsyrk)(CblasRowMajor, CblasLower, CblasTrans, 2, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_zsyrk(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_zsyrk)(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 1, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_zsyrk(CblasColMajor, CblasUpper, CblasTrans, 0, 2, + API_SUFFIX(cblas_zsyrk)(CblasColMajor, CblasUpper, CblasTrans, 0, 2, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_zsyrk(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_zsyrk)(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 1, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_zsyrk(CblasColMajor, CblasLower, CblasTrans, 0, 2, + API_SUFFIX(cblas_zsyrk)(CblasColMajor, CblasLower, CblasTrans, 0, 2, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_zsyrk(CblasRowMajor, CblasUpper, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_zsyrk)(CblasRowMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_zsyrk(CblasRowMajor, CblasUpper, CblasTrans, 2, 0, + API_SUFFIX(cblas_zsyrk)(CblasRowMajor, CblasUpper, CblasTrans, 2, 0, ALPHA, A, 2, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_zsyrk(CblasRowMajor, CblasLower, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_zsyrk)(CblasRowMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_zsyrk(CblasRowMajor, CblasLower, CblasTrans, 2, 0, + API_SUFFIX(cblas_zsyrk)(CblasRowMajor, CblasLower, CblasTrans, 2, 0, ALPHA, A, 2, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_zsyrk(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_zsyrk)(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 2, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_zsyrk(CblasColMajor, CblasUpper, CblasTrans, 2, 0, + API_SUFFIX(cblas_zsyrk)(CblasColMajor, CblasUpper, CblasTrans, 2, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_zsyrk(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_zsyrk)(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 2, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_zsyrk(CblasColMajor, CblasLower, CblasTrans, 2, 0, + API_SUFFIX(cblas_zsyrk)(CblasColMajor, CblasLower, CblasTrans, 2, 0, ALPHA, A, 1, BETA, C, 1 ); chkxer(); @@ -1413,143 +1852,184 @@ void F77_z3chke(char * rout) { cblas_rout = "cblas_zher2k" ; cblas_info = 1; - cblas_zher2k(INVALID, CblasUpper, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_zher2k)(INVALID_LAYOUT, CblasUpper, CblasNoTrans, 0, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_zher2k(CblasColMajor, INVALID, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_zher2k)(CblasColMajor, INVALID_UPLO, CblasNoTrans, 0, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_zher2k(CblasColMajor, CblasUpper, CblasTrans, 0, 0, + API_SUFFIX(cblas_zher2k)(CblasColMajor, CblasUpper, CblasTrans, 0, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_zher2k(CblasColMajor, CblasUpper, CblasNoTrans, INVALID, 0, + API_SUFFIX(cblas_zher2k)(CblasColMajor, CblasUpper, CblasNoTrans, INVALID, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_zher2k(CblasColMajor, CblasUpper, CblasConjTrans, INVALID, 0, + API_SUFFIX(cblas_zher2k)(CblasColMajor, CblasUpper, CblasConjTrans, INVALID, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_zher2k(CblasColMajor, CblasLower, CblasNoTrans, INVALID, 0, + API_SUFFIX(cblas_zher2k)(CblasColMajor, CblasLower, CblasNoTrans, INVALID, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_zher2k(CblasColMajor, CblasLower, CblasConjTrans, INVALID, 0, + API_SUFFIX(cblas_zher2k)(CblasColMajor, CblasLower, CblasConjTrans, INVALID, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_zher2k(CblasColMajor, CblasUpper, CblasNoTrans, 0, INVALID, + API_SUFFIX(cblas_zher2k)(CblasColMajor, CblasUpper, CblasNoTrans, 0, INVALID, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_zher2k(CblasColMajor, CblasUpper, CblasConjTrans, 0, INVALID, + API_SUFFIX(cblas_zher2k)(CblasColMajor, CblasUpper, CblasConjTrans, 0, INVALID, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_zher2k(CblasColMajor, CblasLower, CblasNoTrans, 0, INVALID, + API_SUFFIX(cblas_zher2k)(CblasColMajor, CblasLower, CblasNoTrans, 0, INVALID, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_zher2k(CblasColMajor, CblasLower, CblasConjTrans, 0, INVALID, + 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; - cblas_zher2k(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_zher2k)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, B, 2, RBETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_zher2k(CblasRowMajor, CblasUpper, CblasConjTrans, 2, 0, + API_SUFFIX(cblas_zher2k)(CblasRowMajor, CblasUpper, CblasConjTrans, 2, 0, ALPHA, A, 1, B, 2, RBETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_zher2k(CblasRowMajor, CblasLower, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_zher2k)(CblasRowMajor, CblasLower, CblasNoTrans, 0, 2, ALPHA, A, 1, B, 2, RBETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_zher2k(CblasRowMajor, CblasLower, CblasConjTrans, 2, 0, + API_SUFFIX(cblas_zher2k)(CblasRowMajor, CblasLower, CblasConjTrans, 2, 0, ALPHA, A, 1, B, 2, RBETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_zher2k(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_zher2k)(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_zher2k(CblasColMajor, CblasUpper, CblasConjTrans, 0, 2, + API_SUFFIX(cblas_zher2k)(CblasColMajor, CblasUpper, CblasConjTrans, 0, 2, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_zher2k(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_zher2k)(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_zher2k(CblasColMajor, CblasLower, CblasConjTrans, 0, 2, + API_SUFFIX(cblas_zher2k)(CblasColMajor, CblasLower, CblasConjTrans, 0, 2, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_zher2k(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_zher2k)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 2, B, 1, RBETA, C, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_zher2k(CblasRowMajor, CblasUpper, CblasConjTrans, 2, 0, + API_SUFFIX(cblas_zher2k)(CblasRowMajor, CblasUpper, CblasConjTrans, 2, 0, ALPHA, A, 2, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_zher2k(CblasRowMajor, CblasLower, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_zher2k)(CblasRowMajor, CblasLower, CblasNoTrans, 0, 2, ALPHA, A, 2, B, 1, RBETA, C, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_zher2k(CblasRowMajor, CblasLower, CblasConjTrans, 2, 0, + API_SUFFIX(cblas_zher2k)(CblasRowMajor, CblasLower, CblasConjTrans, 2, 0, ALPHA, A, 2, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_zher2k(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_zher2k)(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 2, B, 1, RBETA, C, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_zher2k(CblasColMajor, CblasUpper, CblasConjTrans, 0, 2, + API_SUFFIX(cblas_zher2k)(CblasColMajor, CblasUpper, CblasConjTrans, 0, 2, ALPHA, A, 2, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_zher2k(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_zher2k)(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 2, B, 1, RBETA, C, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_zher2k(CblasColMajor, CblasLower, CblasConjTrans, 0, 2, + API_SUFFIX(cblas_zher2k)(CblasColMajor, CblasLower, CblasConjTrans, 0, 2, ALPHA, A, 2, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_zher2k(CblasRowMajor, CblasUpper, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_zher2k)(CblasRowMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_zher2k(CblasRowMajor, CblasUpper, CblasConjTrans, 2, 0, + API_SUFFIX(cblas_zher2k)(CblasRowMajor, CblasUpper, CblasConjTrans, 2, 0, ALPHA, A, 2, B, 2, RBETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_zher2k(CblasRowMajor, CblasLower, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_zher2k)(CblasRowMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_zher2k(CblasRowMajor, CblasLower, CblasConjTrans, 2, 0, + API_SUFFIX(cblas_zher2k)(CblasRowMajor, CblasLower, CblasConjTrans, 2, 0, ALPHA, A, 2, B, 2, RBETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_zher2k(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_zher2k)(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 2, B, 2, RBETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_zher2k(CblasColMajor, CblasUpper, CblasConjTrans, 2, 0, + API_SUFFIX(cblas_zher2k)(CblasColMajor, CblasUpper, CblasConjTrans, 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_zher2k(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_zher2k)(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 2, B, 2, RBETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_zher2k(CblasColMajor, CblasLower, CblasConjTrans, 2, 0, + API_SUFFIX(cblas_zher2k)(CblasColMajor, CblasLower, CblasConjTrans, 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); @@ -1557,150 +2037,193 @@ void F77_z3chke(char * rout) { cblas_rout = "cblas_zsyr2k" ; cblas_info = 1; - cblas_zsyr2k(INVALID, CblasUpper, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_zsyr2k)(INVALID_LAYOUT, CblasUpper, CblasNoTrans, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 2; RowMajorStrg = FALSE; - cblas_zsyr2k(CblasColMajor, INVALID, CblasNoTrans, 0, 0, + API_SUFFIX(cblas_zsyr2k)(CblasColMajor, INVALID_UPLO, CblasNoTrans, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 3; RowMajorStrg = FALSE; - cblas_zsyr2k(CblasColMajor, CblasUpper, CblasConjTrans, 0, 0, + API_SUFFIX(cblas_zsyr2k)(CblasColMajor, CblasUpper, CblasConjTrans, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_zsyr2k(CblasColMajor, CblasUpper, CblasNoTrans, INVALID, 0, + API_SUFFIX(cblas_zsyr2k)(CblasColMajor, CblasUpper, CblasNoTrans, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_zsyr2k(CblasColMajor, CblasUpper, CblasTrans, INVALID, 0, + API_SUFFIX(cblas_zsyr2k)(CblasColMajor, CblasUpper, CblasTrans, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_zsyr2k(CblasColMajor, CblasLower, CblasNoTrans, INVALID, 0, + API_SUFFIX(cblas_zsyr2k)(CblasColMajor, CblasLower, CblasNoTrans, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_zsyr2k(CblasColMajor, CblasLower, CblasTrans, INVALID, 0, + API_SUFFIX(cblas_zsyr2k)(CblasColMajor, CblasLower, CblasTrans, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_zsyr2k(CblasColMajor, CblasUpper, CblasNoTrans, 0, INVALID, + API_SUFFIX(cblas_zsyr2k)(CblasColMajor, CblasUpper, CblasNoTrans, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_zsyr2k(CblasColMajor, CblasUpper, CblasTrans, 0, INVALID, + API_SUFFIX(cblas_zsyr2k)(CblasColMajor, CblasUpper, CblasTrans, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_zsyr2k(CblasColMajor, CblasLower, CblasNoTrans, 0, INVALID, + API_SUFFIX(cblas_zsyr2k)(CblasColMajor, CblasLower, CblasNoTrans, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_zsyr2k(CblasColMajor, CblasLower, CblasTrans, 0, INVALID, + 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; - cblas_zsyr2k(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_zsyr2k(CblasRowMajor, CblasUpper, CblasTrans, 2, 0, + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, CblasUpper, CblasTrans, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_zsyr2k(CblasRowMajor, CblasLower, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, CblasLower, CblasNoTrans, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = TRUE; - cblas_zsyr2k(CblasRowMajor, CblasLower, CblasTrans, 2, 0, + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, CblasLower, CblasTrans, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_zsyr2k(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_zsyr2k)(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_zsyr2k(CblasColMajor, CblasUpper, CblasTrans, 0, 2, + API_SUFFIX(cblas_zsyr2k)(CblasColMajor, CblasUpper, CblasTrans, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_zsyr2k(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_zsyr2k)(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 8; RowMajorStrg = FALSE; - cblas_zsyr2k(CblasColMajor, CblasLower, CblasTrans, 0, 2, + API_SUFFIX(cblas_zsyr2k)(CblasColMajor, CblasLower, CblasTrans, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_zsyr2k(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_zsyr2k(CblasRowMajor, CblasUpper, CblasTrans, 2, 0, + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, CblasUpper, CblasTrans, 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_zsyr2k(CblasRowMajor, CblasLower, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, CblasLower, CblasNoTrans, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = TRUE; - cblas_zsyr2k(CblasRowMajor, CblasLower, CblasTrans, 2, 0, + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, CblasLower, CblasTrans, 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_zsyr2k(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_zsyr2k)(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_zsyr2k(CblasColMajor, CblasUpper, CblasTrans, 0, 2, + API_SUFFIX(cblas_zsyr2k)(CblasColMajor, CblasUpper, CblasTrans, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_zsyr2k(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_zsyr2k)(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 10; RowMajorStrg = FALSE; - cblas_zsyr2k(CblasColMajor, CblasLower, CblasTrans, 0, 2, + API_SUFFIX(cblas_zsyr2k)(CblasColMajor, CblasLower, CblasTrans, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_zsyr2k(CblasRowMajor, CblasUpper, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_zsyr2k(CblasRowMajor, CblasUpper, CblasTrans, 2, 0, + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, CblasUpper, CblasTrans, 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_zsyr2k(CblasRowMajor, CblasLower, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = TRUE; - cblas_zsyr2k(CblasRowMajor, CblasLower, CblasTrans, 2, 0, + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, CblasLower, CblasTrans, 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_zsyr2k(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_zsyr2k)(CblasColMajor, CblasUpper, CblasNoTrans, 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_zsyr2k(CblasColMajor, CblasUpper, CblasTrans, 2, 0, + API_SUFFIX(cblas_zsyr2k)(CblasColMajor, CblasUpper, CblasTrans, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_zsyr2k(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, + API_SUFFIX(cblas_zsyr2k)(CblasColMajor, CblasLower, CblasNoTrans, 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 13; RowMajorStrg = FALSE; - cblas_zsyr2k(CblasColMajor, CblasLower, CblasTrans, 2, 0, + API_SUFFIX(cblas_zsyr2k)(CblasColMajor, CblasLower, CblasTrans, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); } if (cblas_ok == 1 ) - printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout); + printf(" %-13s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout); else printf("***** %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout); + printf(" %-13s ERROR-EXIT TESTS:%9d RUN,%9d FAILED\n", + cblas_rout, (int) cblas_xtests, (int) cblas_xfails); } diff --git a/CBLAS/testing/c_zblas1.c b/CBLAS/testing/c_zblas1.c index 2b21d8f187..3d7c64fcc5 100644 --- a/CBLAS/testing/c_zblas1.c +++ b/CBLAS/testing/c_zblas1.c @@ -8,67 +8,75 @@ */ #include "cblas_test.h" #include "cblas.h" -void F77_zaxpy(const int *N, const void *alpha, void *X, - const int *incX, void *Y, const int *incY) +void F77_zaxpy(const CBLAS_INT *N, const void *alpha, void *X, + const CBLAS_INT *incX, void *Y, const CBLAS_INT *incY) { - cblas_zaxpy(*N, alpha, X, *incX, Y, *incY); + API_SUFFIX(cblas_zaxpy)(*N, alpha, X, *incX, Y, *incY); return; } -void F77_zcopy(const int *N, void *X, const int *incX, - void *Y, const int *incY) + +void F77_zaxpby(const CBLAS_INT *N, const void *alpha, void *X, + const CBLAS_INT *incX, const void *beta, void *Y, const CBLAS_INT *incY) +{ + API_SUFFIX(cblas_zaxpby)(*N, alpha, X, *incX, beta, Y, *incY); + return; +} + +void F77_zcopy(const CBLAS_INT *N, void *X, const CBLAS_INT *incX, + void *Y, const CBLAS_INT *incY) { - cblas_zcopy(*N, X, *incX, Y, *incY); + API_SUFFIX(cblas_zcopy)(*N, X, *incX, Y, *incY); return; } -void F77_zdotc(const int *N, const void *X, const int *incX, - const void *Y, const int *incY,void *dotc) +void F77_zdotc(const CBLAS_INT *N, const void *X, const CBLAS_INT *incX, + const void *Y, const CBLAS_INT *incY,void *dotc) { - cblas_zdotc_sub(*N, X, *incX, Y, *incY, dotc); + API_SUFFIX(cblas_zdotc_sub)(*N, X, *incX, Y, *incY, dotc); return; } -void F77_zdotu(const int *N, void *X, const int *incX, - void *Y, const int *incY,void *dotu) +void F77_zdotu(const CBLAS_INT *N, void *X, const CBLAS_INT *incX, + void *Y, const CBLAS_INT *incY,void *dotu) { - cblas_zdotu_sub(*N, X, *incX, Y, *incY, dotu); + API_SUFFIX(cblas_zdotu_sub)(*N, X, *incX, Y, *incY, dotu); return; } -void F77_zdscal(const int *N, const double *alpha, void *X, - const int *incX) +void F77_zdscal(const CBLAS_INT *N, const double *alpha, void *X, + const CBLAS_INT *incX) { - cblas_zdscal(*N, *alpha, X, *incX); + API_SUFFIX(cblas_zdscal)(*N, *alpha, X, *incX); return; } -void F77_zscal(const int *N, const void * *alpha, void *X, - const int *incX) +void F77_zscal(const CBLAS_INT *N, const void * *alpha, void *X, + const CBLAS_INT *incX) { - cblas_zscal(*N, alpha, X, *incX); + API_SUFFIX(cblas_zscal)(*N, alpha, X, *incX); return; } -void F77_zswap( const int *N, void *X, const int *incX, - void *Y, const int *incY) +void F77_zswap( const CBLAS_INT *N, void *X, const CBLAS_INT *incX, + void *Y, const CBLAS_INT *incY) { - cblas_zswap(*N,X,*incX,Y,*incY); + API_SUFFIX(cblas_zswap)(*N,X,*incX,Y,*incY); return; } -int F77_izamax(const int *N, const void *X, const int *incX) +CBLAS_INT F77_izamax(const CBLAS_INT *N, const void *X, const CBLAS_INT *incX) { if (*N < 1 || *incX < 1) return(0); - return(cblas_izamax(*N, X, *incX)+1); + return(API_SUFFIX(cblas_izamax)(*N, X, *incX)+1); } -double F77_dznrm2(const int *N, const void *X, const int *incX) +double F77_dznrm2(const CBLAS_INT *N, const void *X, const CBLAS_INT *incX) { - return cblas_dznrm2(*N, X, *incX); + return API_SUFFIX(cblas_dznrm2)(*N, X, *incX); } -double F77_dzasum(const int *N, void *X, const int *incX) +double F77_dzasum(const CBLAS_INT *N, void *X, const CBLAS_INT *incX) { - return cblas_dzasum(*N, X, *incX); + return API_SUFFIX(cblas_dzasum)(*N, X, *incX); } diff --git a/CBLAS/testing/c_zblas2.c b/CBLAS/testing/c_zblas2.c index b6fbdd628d..fb34c8622b 100644 --- a/CBLAS/testing/c_zblas2.c +++ b/CBLAS/testing/c_zblas2.c @@ -8,13 +8,17 @@ #include "cblas.h" #include "cblas_test.h" -void F77_zgemv(int *layout, char *transp, int *m, int *n, +void F77_zgemv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, const void *alpha, - CBLAS_TEST_ZOMPLEX *a, int *lda, const void *x, int *incx, - const void *beta, void *y, int *incy) { + CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, const void *x, CBLAS_INT *incx, + const void *beta, void *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN transp_len +#endif +) { CBLAS_TEST_ZOMPLEX *A; - int i,j,LDA; + CBLAS_INT i,j,LDA; CBLAS_TRANSPOSE trans; get_transpose_type(transp, &trans); @@ -26,25 +30,29 @@ void F77_zgemv(int *layout, char *transp, int *m, int *n, A[ LDA*i+j ].real=a[ (*lda)*j+i ].real; A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag; } - cblas_zgemv( CblasRowMajor, trans, *m, *n, alpha, A, LDA, x, *incx, + API_SUFFIX(cblas_zgemv)( CblasRowMajor, trans, *m, *n, alpha, A, LDA, x, *incx, beta, y, *incy ); free(A); } else if (*layout == TEST_COL_MJR) - cblas_zgemv( CblasColMajor, trans, + API_SUFFIX(cblas_zgemv)( CblasColMajor, trans, *m, *n, alpha, a, *lda, x, *incx, beta, y, *incy ); else - cblas_zgemv( UNDEFINED, trans, + API_SUFFIX(cblas_zgemv)( INVALID_LAYOUT, trans, *m, *n, alpha, a, *lda, x, *incx, beta, y, *incy ); } -void F77_zgbmv(int *layout, char *transp, int *m, int *n, int *kl, int *ku, - CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, int *lda, - CBLAS_TEST_ZOMPLEX *x, int *incx, - CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *y, int *incy) { +void F77_zgbmv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, CBLAS_INT *kl, CBLAS_INT *ku, + CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, + CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, + CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN transp_len +#endif +) { CBLAS_TEST_ZOMPLEX *A; - int i,j,irow,jcol,LDA; + CBLAS_INT i,j,irow,jcol,LDA; CBLAS_TRANSPOSE trans; get_transpose_type(transp, &trans); @@ -73,24 +81,24 @@ void F77_zgbmv(int *layout, char *transp, int *m, int *n, int *kl, int *ku, A[ LDA*j+irow ].imag=a[ (*lda)*(j-jcol)+i ].imag; } } - cblas_zgbmv( CblasRowMajor, trans, *m, *n, *kl, *ku, alpha, A, LDA, x, + API_SUFFIX(cblas_zgbmv)( CblasRowMajor, trans, *m, *n, *kl, *ku, alpha, A, LDA, x, *incx, beta, y, *incy ); free(A); } else if (*layout == TEST_COL_MJR) - cblas_zgbmv( CblasColMajor, trans, *m, *n, *kl, *ku, alpha, a, *lda, x, + API_SUFFIX(cblas_zgbmv)( CblasColMajor, trans, *m, *n, *kl, *ku, alpha, a, *lda, x, *incx, beta, y, *incy ); else - cblas_zgbmv( UNDEFINED, trans, *m, *n, *kl, *ku, alpha, a, *lda, x, + API_SUFFIX(cblas_zgbmv)( INVALID_LAYOUT, trans, *m, *n, *kl, *ku, alpha, a, *lda, x, *incx, beta, y, *incy ); } -void F77_zgeru(int *layout, int *m, int *n, CBLAS_TEST_ZOMPLEX *alpha, - CBLAS_TEST_ZOMPLEX *x, int *incx, CBLAS_TEST_ZOMPLEX *y, int *incy, - CBLAS_TEST_ZOMPLEX *a, int *lda){ +void F77_zgeru(CBLAS_INT *layout, CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *alpha, + CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy, + CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda){ CBLAS_TEST_ZOMPLEX *A; - int i,j,LDA; + CBLAS_INT i,j,LDA; if (*layout == TEST_ROW_MJR) { LDA = *n+1; @@ -100,7 +108,7 @@ void F77_zgeru(int *layout, int *m, int *n, CBLAS_TEST_ZOMPLEX *alpha, A[ LDA*i+j ].real=a[ (*lda)*j+i ].real; A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag; } - cblas_zgeru( CblasRowMajor, *m, *n, alpha, x, *incx, y, *incy, A, LDA ); + API_SUFFIX(cblas_zgeru)( CblasRowMajor, *m, *n, alpha, x, *incx, y, *incy, A, LDA ); for( i=0; i<*m; i++ ) for( j=0; j<*n; j++ ){ a[ (*lda)*j+i ].real=A[ LDA*i+j ].real; @@ -109,16 +117,16 @@ void F77_zgeru(int *layout, int *m, int *n, CBLAS_TEST_ZOMPLEX *alpha, free(A); } else if (*layout == TEST_COL_MJR) - cblas_zgeru( CblasColMajor, *m, *n, alpha, x, *incx, y, *incy, a, *lda ); + API_SUFFIX(cblas_zgeru)( CblasColMajor, *m, *n, alpha, x, *incx, y, *incy, a, *lda ); else - cblas_zgeru( UNDEFINED, *m, *n, alpha, x, *incx, y, *incy, a, *lda ); + API_SUFFIX(cblas_zgeru)( INVALID_LAYOUT, *m, *n, alpha, x, *incx, y, *incy, a, *lda ); } -void F77_zgerc(int *layout, int *m, int *n, CBLAS_TEST_ZOMPLEX *alpha, - CBLAS_TEST_ZOMPLEX *x, int *incx, CBLAS_TEST_ZOMPLEX *y, int *incy, - CBLAS_TEST_ZOMPLEX *a, int *lda) { +void F77_zgerc(CBLAS_INT *layout, CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *alpha, + CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy, + CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda) { CBLAS_TEST_ZOMPLEX *A; - int i,j,LDA; + CBLAS_INT i,j,LDA; if (*layout == TEST_ROW_MJR) { LDA = *n+1; @@ -128,7 +136,7 @@ void F77_zgerc(int *layout, int *m, int *n, CBLAS_TEST_ZOMPLEX *alpha, A[ LDA*i+j ].real=a[ (*lda)*j+i ].real; A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag; } - cblas_zgerc( CblasRowMajor, *m, *n, alpha, x, *incx, y, *incy, A, LDA ); + API_SUFFIX(cblas_zgerc)( CblasRowMajor, *m, *n, alpha, x, *incx, y, *incy, A, LDA ); for( i=0; i<*m; i++ ) for( j=0; j<*n; j++ ){ a[ (*lda)*j+i ].real=A[ LDA*i+j ].real; @@ -137,17 +145,21 @@ void F77_zgerc(int *layout, int *m, int *n, CBLAS_TEST_ZOMPLEX *alpha, free(A); } else if (*layout == TEST_COL_MJR) - cblas_zgerc( CblasColMajor, *m, *n, alpha, x, *incx, y, *incy, a, *lda ); + API_SUFFIX(cblas_zgerc)( CblasColMajor, *m, *n, alpha, x, *incx, y, *incy, a, *lda ); else - cblas_zgerc( UNDEFINED, *m, *n, alpha, x, *incx, y, *incy, a, *lda ); + API_SUFFIX(cblas_zgerc)( INVALID_LAYOUT, *m, *n, alpha, x, *incx, y, *incy, a, *lda ); } -void F77_zhemv(int *layout, char *uplow, int *n, CBLAS_TEST_ZOMPLEX *alpha, - CBLAS_TEST_ZOMPLEX *a, int *lda, CBLAS_TEST_ZOMPLEX *x, - int *incx, CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *y, int *incy){ +void F77_zhemv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *alpha, + CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *x, + CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len +#endif +){ CBLAS_TEST_ZOMPLEX *A; - int i,j,LDA; + CBLAS_INT i,j,LDA; CBLAS_UPLO uplo; get_uplo_type(uplow,&uplo); @@ -160,25 +172,29 @@ void F77_zhemv(int *layout, char *uplow, int *n, CBLAS_TEST_ZOMPLEX *alpha, A[ LDA*i+j ].real=a[ (*lda)*j+i ].real; A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag; } - cblas_zhemv( CblasRowMajor, uplo, *n, alpha, A, LDA, x, *incx, + API_SUFFIX(cblas_zhemv)( CblasRowMajor, uplo, *n, alpha, A, LDA, x, *incx, beta, y, *incy ); free(A); } else if (*layout == TEST_COL_MJR) - cblas_zhemv( CblasColMajor, uplo, *n, alpha, a, *lda, x, *incx, + API_SUFFIX(cblas_zhemv)( CblasColMajor, uplo, *n, alpha, a, *lda, x, *incx, beta, y, *incy ); else - cblas_zhemv( UNDEFINED, uplo, *n, alpha, a, *lda, x, *incx, + API_SUFFIX(cblas_zhemv)( INVALID_LAYOUT, uplo, *n, alpha, a, *lda, x, *incx, beta, y, *incy ); } -void F77_zhbmv(int *layout, char *uplow, int *n, int *k, - CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, int *lda, - CBLAS_TEST_ZOMPLEX *x, int *incx, CBLAS_TEST_ZOMPLEX *beta, - CBLAS_TEST_ZOMPLEX *y, int *incy){ +void F77_zhbmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_INT *k, + CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, + CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *beta, + CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len +#endif +){ CBLAS_TEST_ZOMPLEX *A; -int i,irow,j,jcol,LDA; +CBLAS_INT i,irow,j,jcol,LDA; CBLAS_UPLO uplo; @@ -186,7 +202,7 @@ int i,irow,j,jcol,LDA; if (*layout == TEST_ROW_MJR) { if (uplo != CblasUpper && uplo != CblasLower ) - cblas_zhbmv(CblasRowMajor, UNDEFINED, *n, *k, alpha, a, *lda, x, + API_SUFFIX(cblas_zhbmv)(CblasRowMajor, INVALID_UPLO, *n, *k, alpha, a, *lda, x, *incx, beta, y, *incy ); else { LDA = *k+2; @@ -223,31 +239,35 @@ int i,irow,j,jcol,LDA; } } } - cblas_zhbmv( CblasRowMajor, uplo, *n, *k, alpha, A, LDA, x, *incx, + API_SUFFIX(cblas_zhbmv)( CblasRowMajor, uplo, *n, *k, alpha, A, LDA, x, *incx, beta, y, *incy ); free(A); } } else if (*layout == TEST_COL_MJR) - cblas_zhbmv(CblasColMajor, uplo, *n, *k, alpha, a, *lda, x, *incx, + API_SUFFIX(cblas_zhbmv)(CblasColMajor, uplo, *n, *k, alpha, a, *lda, x, *incx, beta, y, *incy ); else - cblas_zhbmv(UNDEFINED, uplo, *n, *k, alpha, a, *lda, x, *incx, + API_SUFFIX(cblas_zhbmv)(INVALID_LAYOUT, uplo, *n, *k, alpha, a, *lda, x, *incx, beta, y, *incy ); } -void F77_zhpmv(int *layout, char *uplow, int *n, CBLAS_TEST_ZOMPLEX *alpha, - CBLAS_TEST_ZOMPLEX *ap, CBLAS_TEST_ZOMPLEX *x, int *incx, - CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *y, int *incy){ +void F77_zhpmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *alpha, + CBLAS_TEST_ZOMPLEX *ap, CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, + CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len +#endif +){ CBLAS_TEST_ZOMPLEX *A, *AP; - int i,j,k,LDA; + CBLAS_INT i,j,k,LDA; CBLAS_UPLO uplo; get_uplo_type(uplow,&uplo); if (*layout == TEST_ROW_MJR) { if (uplo != CblasUpper && uplo != CblasLower ) - cblas_zhpmv(CblasRowMajor, UNDEFINED, *n, alpha, ap, x, *incx, + API_SUFFIX(cblas_zhpmv)(CblasRowMajor, INVALID_UPLO, *n, alpha, ap, x, *incx, beta, y, *incy); else { LDA = *n; @@ -278,25 +298,29 @@ void F77_zhpmv(int *layout, char *uplow, int *n, CBLAS_TEST_ZOMPLEX *alpha, AP[ k ].imag=A[ LDA*i+j ].imag; } } - cblas_zhpmv( CblasRowMajor, uplo, *n, alpha, AP, x, *incx, beta, y, + API_SUFFIX(cblas_zhpmv)( CblasRowMajor, uplo, *n, alpha, AP, x, *incx, beta, y, *incy ); free(A); free(AP); } } else if (*layout == TEST_COL_MJR) - cblas_zhpmv( CblasColMajor, uplo, *n, alpha, ap, x, *incx, beta, y, + API_SUFFIX(cblas_zhpmv)( CblasColMajor, uplo, *n, alpha, ap, x, *incx, beta, y, *incy ); else - cblas_zhpmv( UNDEFINED, uplo, *n, alpha, ap, x, *incx, beta, y, + API_SUFFIX(cblas_zhpmv)( INVALID_LAYOUT, uplo, *n, alpha, ap, x, *incx, beta, y, *incy ); } -void F77_ztbmv(int *layout, char *uplow, char *transp, char *diagn, - int *n, int *k, CBLAS_TEST_ZOMPLEX *a, int *lda, CBLAS_TEST_ZOMPLEX *x, - int *incx) { +void F77_ztbmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, + CBLAS_INT *n, CBLAS_INT *k, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *x, + CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len +#endif +) { CBLAS_TEST_ZOMPLEX *A; - int irow, jcol, i, j, LDA; + CBLAS_INT irow, jcol, i, j, LDA; CBLAS_TRANSPOSE trans; CBLAS_UPLO uplo; CBLAS_DIAG diag; @@ -307,7 +331,7 @@ void F77_ztbmv(int *layout, char *uplow, char *transp, char *diagn, if (*layout == TEST_ROW_MJR) { if (uplo != CblasUpper && uplo != CblasLower ) - cblas_ztbmv(CblasRowMajor, UNDEFINED, trans, diag, *n, *k, a, *lda, + API_SUFFIX(cblas_ztbmv)(CblasRowMajor, INVALID_UPLO, trans, diag, *n, *k, a, *lda, x, *incx); else { LDA = *k+2; @@ -344,23 +368,27 @@ void F77_ztbmv(int *layout, char *uplow, char *transp, char *diagn, } } } - cblas_ztbmv(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, x, + API_SUFFIX(cblas_ztbmv)(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, x, *incx); free(A); } } else if (*layout == TEST_COL_MJR) - cblas_ztbmv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx); + API_SUFFIX(cblas_ztbmv)(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx); else - cblas_ztbmv(UNDEFINED, uplo, trans, diag, *n, *k, a, *lda, x, *incx); + API_SUFFIX(cblas_ztbmv)(INVALID_LAYOUT, uplo, trans, diag, *n, *k, a, *lda, x, *incx); } -void F77_ztbsv(int *layout, char *uplow, char *transp, char *diagn, - int *n, int *k, CBLAS_TEST_ZOMPLEX *a, int *lda, CBLAS_TEST_ZOMPLEX *x, - int *incx) { +void F77_ztbsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, + CBLAS_INT *n, CBLAS_INT *k, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *x, + CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len +#endif +) { CBLAS_TEST_ZOMPLEX *A; - int irow, jcol, i, j, LDA; + CBLAS_INT irow, jcol, i, j, LDA; CBLAS_TRANSPOSE trans; CBLAS_UPLO uplo; CBLAS_DIAG diag; @@ -371,7 +399,7 @@ void F77_ztbsv(int *layout, char *uplow, char *transp, char *diagn, if (*layout == TEST_ROW_MJR) { if (uplo != CblasUpper && uplo != CblasLower ) - cblas_ztbsv(CblasRowMajor, UNDEFINED, trans, diag, *n, *k, a, *lda, x, + API_SUFFIX(cblas_ztbsv)(CblasRowMajor, INVALID_UPLO, trans, diag, *n, *k, a, *lda, x, *incx); else { LDA = *k+2; @@ -408,21 +436,25 @@ void F77_ztbsv(int *layout, char *uplow, char *transp, char *diagn, } } } - cblas_ztbsv(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, + API_SUFFIX(cblas_ztbsv)(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, x, *incx); free(A); } } else if (*layout == TEST_COL_MJR) - cblas_ztbsv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx); + API_SUFFIX(cblas_ztbsv)(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx); else - cblas_ztbsv(UNDEFINED, uplo, trans, diag, *n, *k, a, *lda, x, *incx); + API_SUFFIX(cblas_ztbsv)(INVALID_LAYOUT, uplo, trans, diag, *n, *k, a, *lda, x, *incx); } -void F77_ztpmv(int *layout, char *uplow, char *transp, char *diagn, - int *n, CBLAS_TEST_ZOMPLEX *ap, CBLAS_TEST_ZOMPLEX *x, int *incx) { +void F77_ztpmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, + CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *ap, CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len +#endif +) { CBLAS_TEST_ZOMPLEX *A, *AP; - int i, j, k, LDA; + CBLAS_INT i, j, k, LDA; CBLAS_TRANSPOSE trans; CBLAS_UPLO uplo; CBLAS_DIAG diag; @@ -433,7 +465,7 @@ void F77_ztpmv(int *layout, char *uplow, char *transp, char *diagn, if (*layout == TEST_ROW_MJR) { if (uplo != CblasUpper && uplo != CblasLower ) - cblas_ztpmv( CblasRowMajor, UNDEFINED, trans, diag, *n, ap, x, *incx ); + API_SUFFIX(cblas_ztpmv)( CblasRowMajor, INVALID_UPLO, trans, diag, *n, ap, x, *incx ); else { LDA = *n; A=(CBLAS_TEST_ZOMPLEX*)malloc(LDA*LDA*sizeof(CBLAS_TEST_ZOMPLEX)); @@ -463,21 +495,25 @@ void F77_ztpmv(int *layout, char *uplow, char *transp, char *diagn, AP[ k ].imag=A[ LDA*i+j ].imag; } } - cblas_ztpmv( CblasRowMajor, uplo, trans, diag, *n, AP, x, *incx ); + API_SUFFIX(cblas_ztpmv)( CblasRowMajor, uplo, trans, diag, *n, AP, x, *incx ); free(A); free(AP); } } else if (*layout == TEST_COL_MJR) - cblas_ztpmv( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx ); + API_SUFFIX(cblas_ztpmv)( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx ); else - cblas_ztpmv( UNDEFINED, uplo, trans, diag, *n, ap, x, *incx ); + API_SUFFIX(cblas_ztpmv)( INVALID_LAYOUT, uplo, trans, diag, *n, ap, x, *incx ); } -void F77_ztpsv(int *layout, char *uplow, char *transp, char *diagn, - int *n, CBLAS_TEST_ZOMPLEX *ap, CBLAS_TEST_ZOMPLEX *x, int *incx) { +void F77_ztpsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, + CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *ap, CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len +#endif +) { CBLAS_TEST_ZOMPLEX *A, *AP; - int i, j, k, LDA; + CBLAS_INT i, j, k, LDA; CBLAS_TRANSPOSE trans; CBLAS_UPLO uplo; CBLAS_DIAG diag; @@ -488,7 +524,7 @@ void F77_ztpsv(int *layout, char *uplow, char *transp, char *diagn, if (*layout == TEST_ROW_MJR) { if (uplo != CblasUpper && uplo != CblasLower ) - cblas_ztpsv( CblasRowMajor, UNDEFINED, trans, diag, *n, ap, x, *incx ); + API_SUFFIX(cblas_ztpsv)( CblasRowMajor, INVALID_UPLO, trans, diag, *n, ap, x, *incx ); else { LDA = *n; A=(CBLAS_TEST_ZOMPLEX*)malloc(LDA*LDA*sizeof(CBLAS_TEST_ZOMPLEX)); @@ -518,22 +554,26 @@ void F77_ztpsv(int *layout, char *uplow, char *transp, char *diagn, AP[ k ].imag=A[ LDA*i+j ].imag; } } - cblas_ztpsv( CblasRowMajor, uplo, trans, diag, *n, AP, x, *incx ); + API_SUFFIX(cblas_ztpsv)( CblasRowMajor, uplo, trans, diag, *n, AP, x, *incx ); free(A); free(AP); } } else if (*layout == TEST_COL_MJR) - cblas_ztpsv( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx ); + API_SUFFIX(cblas_ztpsv)( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx ); else - cblas_ztpsv( UNDEFINED, uplo, trans, diag, *n, ap, x, *incx ); + API_SUFFIX(cblas_ztpsv)( INVALID_LAYOUT, uplo, trans, diag, *n, ap, x, *incx ); } -void F77_ztrmv(int *layout, char *uplow, char *transp, char *diagn, - int *n, CBLAS_TEST_ZOMPLEX *a, int *lda, CBLAS_TEST_ZOMPLEX *x, - int *incx) { +void F77_ztrmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, + CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *x, + CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len +#endif +) { CBLAS_TEST_ZOMPLEX *A; - int i,j,LDA; + CBLAS_INT i,j,LDA; CBLAS_TRANSPOSE trans; CBLAS_UPLO uplo; CBLAS_DIAG diag; @@ -550,19 +590,23 @@ void F77_ztrmv(int *layout, char *uplow, char *transp, char *diagn, A[ LDA*i+j ].real=a[ (*lda)*j+i ].real; A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag; } - cblas_ztrmv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx); + API_SUFFIX(cblas_ztrmv)(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx); free(A); } else if (*layout == TEST_COL_MJR) - cblas_ztrmv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx); + API_SUFFIX(cblas_ztrmv)(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx); else - cblas_ztrmv(UNDEFINED, uplo, trans, diag, *n, a, *lda, x, *incx); + API_SUFFIX(cblas_ztrmv)(INVALID_LAYOUT, uplo, trans, diag, *n, a, *lda, x, *incx); } -void F77_ztrsv(int *layout, char *uplow, char *transp, char *diagn, - int *n, CBLAS_TEST_ZOMPLEX *a, int *lda, CBLAS_TEST_ZOMPLEX *x, - int *incx) { +void F77_ztrsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, + CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *x, + CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len +#endif +) { CBLAS_TEST_ZOMPLEX *A; - int i,j,LDA; + CBLAS_INT i,j,LDA; CBLAS_TRANSPOSE trans; CBLAS_UPLO uplo; CBLAS_DIAG diag; @@ -579,26 +623,30 @@ void F77_ztrsv(int *layout, char *uplow, char *transp, char *diagn, A[ LDA*i+j ].real=a[ (*lda)*j+i ].real; A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag; } - cblas_ztrsv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx ); + API_SUFFIX(cblas_ztrsv)(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx ); free(A); } else if (*layout == TEST_COL_MJR) - cblas_ztrsv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx ); + API_SUFFIX(cblas_ztrsv)(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx ); else - cblas_ztrsv(UNDEFINED, uplo, trans, diag, *n, a, *lda, x, *incx ); + API_SUFFIX(cblas_ztrsv)(INVALID_LAYOUT, uplo, trans, diag, *n, a, *lda, x, *incx ); } -void F77_zhpr(int *layout, char *uplow, int *n, double *alpha, - CBLAS_TEST_ZOMPLEX *x, int *incx, CBLAS_TEST_ZOMPLEX *ap) { +void F77_zhpr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, + CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *ap +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len +#endif +) { CBLAS_TEST_ZOMPLEX *A, *AP; - int i,j,k,LDA; + CBLAS_INT i,j,k,LDA; CBLAS_UPLO uplo; get_uplo_type(uplow,&uplo); if (*layout == TEST_ROW_MJR) { if (uplo != CblasUpper && uplo != CblasLower ) - cblas_zhpr(CblasRowMajor, UNDEFINED, *n, *alpha, x, *incx, ap ); + API_SUFFIX(cblas_zhpr)(CblasRowMajor, INVALID_UPLO, *n, *alpha, x, *incx, ap ); else { LDA = *n; A = (CBLAS_TEST_ZOMPLEX* )malloc(LDA*LDA*sizeof(CBLAS_TEST_ZOMPLEX ) ); @@ -628,7 +676,7 @@ void F77_zhpr(int *layout, char *uplow, int *n, double *alpha, AP[ k ].imag=A[ LDA*i+j ].imag; } } - cblas_zhpr(CblasRowMajor, uplo, *n, *alpha, x, *incx, AP ); + API_SUFFIX(cblas_zhpr)(CblasRowMajor, uplo, *n, *alpha, x, *incx, AP ); if (uplo == CblasUpper) { for( i=0, k=0; i<*n; i++ ) for( j=i; j<*n; j++, k++ ){ @@ -658,23 +706,27 @@ void F77_zhpr(int *layout, char *uplow, int *n, double *alpha, } } else if (*layout == TEST_COL_MJR) - cblas_zhpr(CblasColMajor, uplo, *n, *alpha, x, *incx, ap ); + API_SUFFIX(cblas_zhpr)(CblasColMajor, uplo, *n, *alpha, x, *incx, ap ); else - cblas_zhpr(UNDEFINED, uplo, *n, *alpha, x, *incx, ap ); + API_SUFFIX(cblas_zhpr)(INVALID_LAYOUT, uplo, *n, *alpha, x, *incx, ap ); } -void F77_zhpr2(int *layout, char *uplow, int *n, CBLAS_TEST_ZOMPLEX *alpha, - CBLAS_TEST_ZOMPLEX *x, int *incx, CBLAS_TEST_ZOMPLEX *y, int *incy, - CBLAS_TEST_ZOMPLEX *ap) { +void F77_zhpr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *alpha, + CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy, + CBLAS_TEST_ZOMPLEX *ap +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len +#endif +) { CBLAS_TEST_ZOMPLEX *A, *AP; - int i,j,k,LDA; + CBLAS_INT i,j,k,LDA; CBLAS_UPLO uplo; get_uplo_type(uplow,&uplo); if (*layout == TEST_ROW_MJR) { if (uplo != CblasUpper && uplo != CblasLower ) - cblas_zhpr2( CblasRowMajor, UNDEFINED, *n, alpha, x, *incx, y, + API_SUFFIX(cblas_zhpr2)( CblasRowMajor, INVALID_UPLO, *n, alpha, x, *incx, y, *incy, ap ); else { LDA = *n; @@ -705,7 +757,7 @@ void F77_zhpr2(int *layout, char *uplow, int *n, CBLAS_TEST_ZOMPLEX *alpha, AP[ k ].imag=A[ LDA*i+j ].imag; } } - cblas_zhpr2( CblasRowMajor, uplo, *n, alpha, x, *incx, y, *incy, AP ); + API_SUFFIX(cblas_zhpr2)( CblasRowMajor, uplo, *n, alpha, x, *incx, y, *incy, AP ); if (uplo == CblasUpper) { for( i=0, k=0; i<*n; i++ ) for( j=i; j<*n; j++, k++ ) { @@ -735,15 +787,19 @@ void F77_zhpr2(int *layout, char *uplow, int *n, CBLAS_TEST_ZOMPLEX *alpha, } } else if (*layout == TEST_COL_MJR) - cblas_zhpr2( CblasColMajor, uplo, *n, alpha, x, *incx, y, *incy, ap ); + API_SUFFIX(cblas_zhpr2)( CblasColMajor, uplo, *n, alpha, x, *incx, y, *incy, ap ); else - cblas_zhpr2( UNDEFINED, uplo, *n, alpha, x, *incx, y, *incy, ap ); + API_SUFFIX(cblas_zhpr2)( INVALID_LAYOUT, uplo, *n, alpha, x, *incx, y, *incy, ap ); } -void F77_zher(int *layout, char *uplow, int *n, double *alpha, - CBLAS_TEST_ZOMPLEX *x, int *incx, CBLAS_TEST_ZOMPLEX *a, int *lda) { +void F77_zher(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, + CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len +#endif +) { CBLAS_TEST_ZOMPLEX *A; - int i,j,LDA; + CBLAS_INT i,j,LDA; CBLAS_UPLO uplo; get_uplo_type(uplow,&uplo); @@ -758,7 +814,7 @@ void F77_zher(int *layout, char *uplow, int *n, double *alpha, A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag; } - cblas_zher(CblasRowMajor, uplo, *n, *alpha, x, *incx, A, LDA ); + API_SUFFIX(cblas_zher)(CblasRowMajor, uplo, *n, *alpha, x, *incx, A, LDA ); for( i=0; i<*n; i++ ) for( j=0; j<*n; j++ ) { a[ (*lda)*j+i ].real=A[ LDA*i+j ].real; @@ -767,17 +823,21 @@ void F77_zher(int *layout, char *uplow, int *n, double *alpha, free(A); } else if (*layout == TEST_COL_MJR) - cblas_zher( CblasColMajor, uplo, *n, *alpha, x, *incx, a, *lda ); + API_SUFFIX(cblas_zher)( CblasColMajor, uplo, *n, *alpha, x, *incx, a, *lda ); else - cblas_zher( UNDEFINED, uplo, *n, *alpha, x, *incx, a, *lda ); + API_SUFFIX(cblas_zher)( INVALID_LAYOUT, uplo, *n, *alpha, x, *incx, a, *lda ); } -void F77_zher2(int *layout, char *uplow, int *n, CBLAS_TEST_ZOMPLEX *alpha, - CBLAS_TEST_ZOMPLEX *x, int *incx, CBLAS_TEST_ZOMPLEX *y, int *incy, - CBLAS_TEST_ZOMPLEX *a, int *lda) { +void F77_zher2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *alpha, + CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy, + CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len +#endif +) { CBLAS_TEST_ZOMPLEX *A; - int i,j,LDA; + CBLAS_INT i,j,LDA; CBLAS_UPLO uplo; get_uplo_type(uplow,&uplo); @@ -792,7 +852,7 @@ void F77_zher2(int *layout, char *uplow, int *n, CBLAS_TEST_ZOMPLEX *alpha, A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag; } - cblas_zher2(CblasRowMajor, uplo, *n, alpha, x, *incx, y, *incy, A, LDA ); + API_SUFFIX(cblas_zher2)(CblasRowMajor, uplo, *n, alpha, x, *incx, y, *incy, A, LDA ); for( i=0; i<*n; i++ ) for( j=0; j<*n; j++ ) { a[ (*lda)*j+i ].real=A[ LDA*i+j ].real; @@ -801,7 +861,7 @@ void F77_zher2(int *layout, char *uplow, int *n, CBLAS_TEST_ZOMPLEX *alpha, free(A); } else if (*layout == TEST_COL_MJR) - cblas_zher2( CblasColMajor, uplo, *n, alpha, x, *incx, y, *incy, a, *lda); + API_SUFFIX(cblas_zher2)( CblasColMajor, uplo, *n, alpha, x, *incx, y, *incy, a, *lda); else - cblas_zher2( UNDEFINED, uplo, *n, alpha, x, *incx, y, *incy, a, *lda); + API_SUFFIX(cblas_zher2)( INVALID_LAYOUT, uplo, *n, alpha, x, *incx, y, *incy, a, *lda); } diff --git a/CBLAS/testing/c_zblas3.c b/CBLAS/testing/c_zblas3.c index 65a821359c..3bfaae07d8 100644 --- a/CBLAS/testing/c_zblas3.c +++ b/CBLAS/testing/c_zblas3.c @@ -5,19 +5,21 @@ * Modified by T. H. Do, 4/15/98, SGI/CRAY Research. */ #include +#include #include "cblas.h" #include "cblas_test.h" -#define TEST_COL_MJR 0 -#define TEST_ROW_MJR 1 -#define UNDEFINED -1 -void F77_zgemm(int *layout, char *transpa, char *transpb, int *m, int *n, - int *k, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, int *lda, - CBLAS_TEST_ZOMPLEX *b, int *ldb, CBLAS_TEST_ZOMPLEX *beta, - CBLAS_TEST_ZOMPLEX *c, int *ldc ) { +void F77_zgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CBLAS_INT *n, + CBLAS_INT *k, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, + CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_ZOMPLEX *beta, + CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN transpa_len, FORTRAN_STRLEN transpb_len +#endif +) { CBLAS_TEST_ZOMPLEX *A, *B, *C; - int i,j,LDA, LDB, LDC; + CBLAS_INT i,j,LDA, LDB, LDC; CBLAS_TRANSPOSE transa, transb; get_transpose_type(transpa, &transa); @@ -69,7 +71,7 @@ void F77_zgemm(int *layout, char *transpa, char *transpb, int *m, int *n, C[i*LDC+j].real=c[j*(*ldc)+i].real; C[i*LDC+j].imag=c[j*(*ldc)+i].imag; } - cblas_zgemm( CblasRowMajor, transa, transb, *m, *n, *k, alpha, A, LDA, + API_SUFFIX(cblas_zgemm)( CblasRowMajor, transa, transb, *m, *n, *k, alpha, A, LDA, B, LDB, beta, C, LDC ); for( j=0; j<*n; j++ ) for( i=0; i<*m; i++ ) { @@ -81,19 +83,105 @@ void F77_zgemm(int *layout, char *transpa, char *transpb, int *m, int *n, free(C); } else if (*layout == TEST_COL_MJR) - cblas_zgemm( CblasColMajor, transa, transb, *m, *n, *k, alpha, a, *lda, + API_SUFFIX(cblas_zgemm)( CblasColMajor, transa, transb, *m, *n, *k, alpha, a, *lda, b, *ldb, beta, c, *ldc ); else - cblas_zgemm( UNDEFINED, transa, transb, *m, *n, *k, alpha, a, *lda, + API_SUFFIX(cblas_zgemm)( INVALID_LAYOUT, transa, transb, *m, *n, *k, alpha, a, *lda, b, *ldb, beta, c, *ldc ); } -void F77_zhemm(int *layout, char *rtlf, char *uplow, int *m, int *n, - CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, int *lda, - CBLAS_TEST_ZOMPLEX *b, int *ldb, CBLAS_TEST_ZOMPLEX *beta, - CBLAS_TEST_ZOMPLEX *c, int *ldc ) { + + +void F77_zgemmtr(CBLAS_INT *layout, char *uplop, char *transpa, char *transpb, CBLAS_INT *n, + CBLAS_INT *k, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, + CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_ZOMPLEX *beta, + CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc ) { + + CBLAS_TEST_ZOMPLEX *A, *B, *C; + CBLAS_INT i,j,LDA, LDB, LDC; + CBLAS_TRANSPOSE transa, transb; + CBLAS_UPLO uplo; + + get_transpose_type(transpa, &transa); + get_transpose_type(transpb, &transb); + get_uplo_type(uplop, &uplo); + + if (*layout == TEST_ROW_MJR) { + if (transa == CblasNoTrans) { + LDA = *k+1; + A=(CBLAS_TEST_ZOMPLEX*)malloc((*n)*LDA*sizeof(CBLAS_TEST_ZOMPLEX)); + for( i=0; i<*n; i++ ) + for( j=0; j<*k; j++ ) { + A[i*LDA+j].real=a[j*(*lda)+i].real; + A[i*LDA+j].imag=a[j*(*lda)+i].imag; + } + } + else { + LDA = *n+1; + A=(CBLAS_TEST_ZOMPLEX* )malloc(LDA*(*k)*sizeof(CBLAS_TEST_ZOMPLEX)); + for( i=0; i<*k; i++ ) + for( j=0; j<*n; j++ ) { + A[i*LDA+j].real=a[j*(*lda)+i].real; + A[i*LDA+j].imag=a[j*(*lda)+i].imag; + } + } + + if (transb == CblasNoTrans) { + LDB = *n+1; + B=(CBLAS_TEST_ZOMPLEX* )malloc((*k)*LDB*sizeof(CBLAS_TEST_ZOMPLEX) ); + for( i=0; i<*k; i++ ) + for( j=0; j<*n; j++ ) { + B[i*LDB+j].real=b[j*(*ldb)+i].real; + B[i*LDB+j].imag=b[j*(*ldb)+i].imag; + } + } + else { + LDB = *k+1; + B=(CBLAS_TEST_ZOMPLEX* )malloc(LDB*(*n)*sizeof(CBLAS_TEST_ZOMPLEX)); + for( i=0; i<*n; i++ ) + for( j=0; j<*k; j++ ) { + B[i*LDB+j].real=b[j*(*ldb)+i].real; + B[i*LDB+j].imag=b[j*(*ldb)+i].imag; + } + } + + LDC = *n+1; + C=(CBLAS_TEST_ZOMPLEX* )malloc((*n)*LDC*sizeof(CBLAS_TEST_ZOMPLEX)); + for( j=0; j<*n; j++ ) + for( i=0; i<*n; i++ ) { + C[i*LDC+j].real=c[j*(*ldc)+i].real; + C[i*LDC+j].imag=c[j*(*ldc)+i].imag; + } + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, uplo, transa, transb, *n, *k, alpha, A, LDA, + B, LDB, beta, C, LDC ); + for( j=0; j<*n; j++ ) + for( i=0; i<*n; i++ ) { + c[j*(*ldc)+i].real=C[i*LDC+j].real; + c[j*(*ldc)+i].imag=C[i*LDC+j].imag; + } + free(A); + free(B); + free(C); + } + else if (*layout == TEST_COL_MJR) + API_SUFFIX(cblas_zgemmtr)( CblasColMajor, uplo, transa, transb, *n, *k, alpha, a, *lda, + b, *ldb, beta, c, *ldc ); + else + API_SUFFIX(cblas_zgemmtr)( INVALID_LAYOUT, uplo, transa, transb, *n, *k, alpha, a, *lda, + b, *ldb, beta, c, *ldc ); +} + + +void F77_zhemm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_INT *n, + CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, + CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_ZOMPLEX *beta, + CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len +#endif +) { CBLAS_TEST_ZOMPLEX *A, *B, *C; - int i,j,LDA, LDB, LDC; + CBLAS_INT i,j,LDA, LDB, LDC; CBLAS_UPLO uplo; CBLAS_SIDE side; @@ -133,7 +221,7 @@ void F77_zhemm(int *layout, char *rtlf, char *uplow, int *m, int *n, C[i*LDC+j].real=c[j*(*ldc)+i].real; C[i*LDC+j].imag=c[j*(*ldc)+i].imag; } - cblas_zhemm( CblasRowMajor, side, uplo, *m, *n, alpha, A, LDA, B, LDB, + API_SUFFIX(cblas_zhemm)( CblasRowMajor, side, uplo, *m, *n, alpha, A, LDA, B, LDB, beta, C, LDC ); for( j=0; j<*n; j++ ) for( i=0; i<*m; i++ ) { @@ -145,19 +233,23 @@ void F77_zhemm(int *layout, char *rtlf, char *uplow, int *m, int *n, free(C); } else if (*layout == TEST_COL_MJR) - cblas_zhemm( CblasColMajor, side, uplo, *m, *n, alpha, a, *lda, b, *ldb, + API_SUFFIX(cblas_zhemm)( CblasColMajor, side, uplo, *m, *n, alpha, a, *lda, b, *ldb, beta, c, *ldc ); else - cblas_zhemm( UNDEFINED, side, uplo, *m, *n, alpha, a, *lda, b, *ldb, + API_SUFFIX(cblas_zhemm)( INVALID_LAYOUT, side, uplo, *m, *n, alpha, a, *lda, b, *ldb, beta, c, *ldc ); } -void F77_zsymm(int *layout, char *rtlf, char *uplow, int *m, int *n, - CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, int *lda, - CBLAS_TEST_ZOMPLEX *b, int *ldb, CBLAS_TEST_ZOMPLEX *beta, - CBLAS_TEST_ZOMPLEX *c, int *ldc ) { +void F77_zsymm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_INT *n, + CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, + CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_ZOMPLEX *beta, + CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len +#endif +) { CBLAS_TEST_ZOMPLEX *A, *B, *C; - int i,j,LDA, LDB, LDC; + CBLAS_INT i,j,LDA, LDB, LDC; CBLAS_UPLO uplo; CBLAS_SIDE side; @@ -189,7 +281,7 @@ void F77_zsymm(int *layout, char *rtlf, char *uplow, int *m, int *n, for( j=0; j<*n; j++ ) for( i=0; i<*m; i++ ) C[i*LDC+j]=c[j*(*ldc)+i]; - cblas_zsymm( CblasRowMajor, side, uplo, *m, *n, alpha, A, LDA, B, LDB, + API_SUFFIX(cblas_zsymm)( CblasRowMajor, side, uplo, *m, *n, alpha, A, LDA, B, LDB, beta, C, LDC ); for( j=0; j<*n; j++ ) for( i=0; i<*m; i++ ) @@ -199,18 +291,22 @@ void F77_zsymm(int *layout, char *rtlf, char *uplow, int *m, int *n, free(C); } else if (*layout == TEST_COL_MJR) - cblas_zsymm( CblasColMajor, side, uplo, *m, *n, alpha, a, *lda, b, *ldb, + API_SUFFIX(cblas_zsymm)( CblasColMajor, side, uplo, *m, *n, alpha, a, *lda, b, *ldb, beta, c, *ldc ); else - cblas_zsymm( UNDEFINED, side, uplo, *m, *n, alpha, a, *lda, b, *ldb, + API_SUFFIX(cblas_zsymm)( INVALID_LAYOUT, side, uplo, *m, *n, alpha, a, *lda, b, *ldb, beta, c, *ldc ); } -void F77_zherk(int *layout, char *uplow, char *transp, int *n, int *k, - double *alpha, CBLAS_TEST_ZOMPLEX *a, int *lda, - double *beta, CBLAS_TEST_ZOMPLEX *c, int *ldc ) { +void F77_zherk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k, + double *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, + double *beta, CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len +#endif +) { - int i,j,LDA,LDC; + CBLAS_INT i,j,LDA,LDC; CBLAS_TEST_ZOMPLEX *A, *C; CBLAS_UPLO uplo; CBLAS_TRANSPOSE trans; @@ -244,7 +340,7 @@ void F77_zherk(int *layout, char *uplow, char *transp, int *n, int *k, C[i*LDC+j].real=c[j*(*ldc)+i].real; C[i*LDC+j].imag=c[j*(*ldc)+i].imag; } - cblas_zherk(CblasRowMajor, uplo, trans, *n, *k, *alpha, A, LDA, *beta, + API_SUFFIX(cblas_zherk)(CblasRowMajor, uplo, trans, *n, *k, *alpha, A, LDA, *beta, C, LDC ); for( j=0; j<*n; j++ ) for( i=0; i<*n; i++ ) { @@ -255,18 +351,22 @@ void F77_zherk(int *layout, char *uplow, char *transp, int *n, int *k, free(C); } else if (*layout == TEST_COL_MJR) - cblas_zherk(CblasColMajor, uplo, trans, *n, *k, *alpha, a, *lda, *beta, + API_SUFFIX(cblas_zherk)(CblasColMajor, uplo, trans, *n, *k, *alpha, a, *lda, *beta, c, *ldc ); else - cblas_zherk(UNDEFINED, uplo, trans, *n, *k, *alpha, a, *lda, *beta, + API_SUFFIX(cblas_zherk)(INVALID_LAYOUT, uplo, trans, *n, *k, *alpha, a, *lda, *beta, c, *ldc ); } -void F77_zsyrk(int *layout, char *uplow, char *transp, int *n, int *k, - CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, int *lda, - CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *c, int *ldc ) { +void F77_zsyrk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k, + CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, + CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len +#endif +) { - int i,j,LDA,LDC; + CBLAS_INT i,j,LDA,LDC; CBLAS_TEST_ZOMPLEX *A, *C; CBLAS_UPLO uplo; CBLAS_TRANSPOSE trans; @@ -300,7 +400,7 @@ void F77_zsyrk(int *layout, char *uplow, char *transp, int *n, int *k, C[i*LDC+j].real=c[j*(*ldc)+i].real; C[i*LDC+j].imag=c[j*(*ldc)+i].imag; } - cblas_zsyrk(CblasRowMajor, uplo, trans, *n, *k, alpha, A, LDA, beta, + API_SUFFIX(cblas_zsyrk)(CblasRowMajor, uplo, trans, *n, *k, alpha, A, LDA, beta, C, LDC ); for( j=0; j<*n; j++ ) for( i=0; i<*n; i++ ) { @@ -311,17 +411,21 @@ void F77_zsyrk(int *layout, char *uplow, char *transp, int *n, int *k, free(C); } else if (*layout == TEST_COL_MJR) - cblas_zsyrk(CblasColMajor, uplo, trans, *n, *k, alpha, a, *lda, beta, + API_SUFFIX(cblas_zsyrk)(CblasColMajor, uplo, trans, *n, *k, alpha, a, *lda, beta, c, *ldc ); else - cblas_zsyrk(UNDEFINED, uplo, trans, *n, *k, alpha, a, *lda, beta, + API_SUFFIX(cblas_zsyrk)(INVALID_LAYOUT, uplo, trans, *n, *k, alpha, a, *lda, beta, c, *ldc ); } -void F77_zher2k(int *layout, char *uplow, char *transp, int *n, int *k, - CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, int *lda, - CBLAS_TEST_ZOMPLEX *b, int *ldb, double *beta, - CBLAS_TEST_ZOMPLEX *c, int *ldc ) { - int i,j,LDA,LDB,LDC; +void F77_zher2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k, + CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, + CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb, double *beta, + CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len +#endif +) { + CBLAS_INT i,j,LDA,LDB,LDC; CBLAS_TEST_ZOMPLEX *A, *B, *C; CBLAS_UPLO uplo; CBLAS_TRANSPOSE trans; @@ -363,7 +467,7 @@ void F77_zher2k(int *layout, char *uplow, char *transp, int *n, int *k, C[i*LDC+j].real=c[j*(*ldc)+i].real; C[i*LDC+j].imag=c[j*(*ldc)+i].imag; } - cblas_zher2k(CblasRowMajor, uplo, trans, *n, *k, alpha, A, LDA, + API_SUFFIX(cblas_zher2k)(CblasRowMajor, uplo, trans, *n, *k, alpha, A, LDA, B, LDB, *beta, C, LDC ); for( j=0; j<*n; j++ ) for( i=0; i<*n; i++ ) { @@ -375,17 +479,21 @@ void F77_zher2k(int *layout, char *uplow, char *transp, int *n, int *k, free(C); } else if (*layout == TEST_COL_MJR) - cblas_zher2k(CblasColMajor, uplo, trans, *n, *k, alpha, a, *lda, + API_SUFFIX(cblas_zher2k)(CblasColMajor, uplo, trans, *n, *k, alpha, a, *lda, b, *ldb, *beta, c, *ldc ); else - cblas_zher2k(UNDEFINED, uplo, trans, *n, *k, alpha, a, *lda, + API_SUFFIX(cblas_zher2k)(INVALID_LAYOUT, uplo, trans, *n, *k, alpha, a, *lda, b, *ldb, *beta, c, *ldc ); } -void F77_zsyr2k(int *layout, char *uplow, char *transp, int *n, int *k, - CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, int *lda, - CBLAS_TEST_ZOMPLEX *b, int *ldb, CBLAS_TEST_ZOMPLEX *beta, - CBLAS_TEST_ZOMPLEX *c, int *ldc ) { - int i,j,LDA,LDB,LDC; +void F77_zsyr2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k, + CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, + CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_ZOMPLEX *beta, + CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len +#endif +) { + CBLAS_INT i,j,LDA,LDB,LDC; CBLAS_TEST_ZOMPLEX *A, *B, *C; CBLAS_UPLO uplo; CBLAS_TRANSPOSE trans; @@ -427,7 +535,7 @@ void F77_zsyr2k(int *layout, char *uplow, char *transp, int *n, int *k, C[i*LDC+j].real=c[j*(*ldc)+i].real; C[i*LDC+j].imag=c[j*(*ldc)+i].imag; } - cblas_zsyr2k(CblasRowMajor, uplo, trans, *n, *k, alpha, A, LDA, + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, uplo, trans, *n, *k, alpha, A, LDA, B, LDB, beta, C, LDC ); for( j=0; j<*n; j++ ) for( i=0; i<*n; i++ ) { @@ -439,16 +547,20 @@ void F77_zsyr2k(int *layout, char *uplow, char *transp, int *n, int *k, free(C); } else if (*layout == TEST_COL_MJR) - cblas_zsyr2k(CblasColMajor, uplo, trans, *n, *k, alpha, a, *lda, + API_SUFFIX(cblas_zsyr2k)(CblasColMajor, uplo, trans, *n, *k, alpha, a, *lda, b, *ldb, beta, c, *ldc ); else - cblas_zsyr2k(UNDEFINED, uplo, trans, *n, *k, alpha, a, *lda, + API_SUFFIX(cblas_zsyr2k)(INVALID_LAYOUT, uplo, trans, *n, *k, alpha, a, *lda, b, *ldb, beta, c, *ldc ); } -void F77_ztrmm(int *layout, char *rtlf, char *uplow, char *transp, char *diagn, - int *m, int *n, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, - int *lda, CBLAS_TEST_ZOMPLEX *b, int *ldb) { - int i,j,LDA,LDB; +void F77_ztrmm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *diagn, + CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, + CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len +#endif +) { + CBLAS_INT i,j,LDA,LDB; CBLAS_TEST_ZOMPLEX *A, *B; CBLAS_SIDE side; CBLAS_DIAG diag; @@ -486,7 +598,7 @@ void F77_ztrmm(int *layout, char *rtlf, char *uplow, char *transp, char *diagn, B[i*LDB+j].real=b[j*(*ldb)+i].real; B[i*LDB+j].imag=b[j*(*ldb)+i].imag; } - cblas_ztrmm(CblasRowMajor, side, uplo, trans, diag, *m, *n, alpha, + API_SUFFIX(cblas_ztrmm)(CblasRowMajor, side, uplo, trans, diag, *m, *n, alpha, A, LDA, B, LDB ); for( j=0; j<*n; j++ ) for( i=0; i<*m; i++ ) { @@ -497,17 +609,21 @@ void F77_ztrmm(int *layout, char *rtlf, char *uplow, char *transp, char *diagn, free(B); } else if (*layout == TEST_COL_MJR) - cblas_ztrmm(CblasColMajor, side, uplo, trans, diag, *m, *n, alpha, + API_SUFFIX(cblas_ztrmm)(CblasColMajor, side, uplo, trans, diag, *m, *n, alpha, a, *lda, b, *ldb); else - cblas_ztrmm(UNDEFINED, side, uplo, trans, diag, *m, *n, alpha, + API_SUFFIX(cblas_ztrmm)(INVALID_LAYOUT, side, uplo, trans, diag, *m, *n, alpha, a, *lda, b, *ldb); } -void F77_ztrsm(int *layout, char *rtlf, char *uplow, char *transp, char *diagn, - int *m, int *n, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, - int *lda, CBLAS_TEST_ZOMPLEX *b, int *ldb) { - int i,j,LDA,LDB; +void F77_ztrsm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *diagn, + CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, + CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len +#endif +) { + CBLAS_INT i,j,LDA,LDB; CBLAS_TEST_ZOMPLEX *A, *B; CBLAS_SIDE side; CBLAS_DIAG diag; @@ -545,7 +661,7 @@ void F77_ztrsm(int *layout, char *rtlf, char *uplow, char *transp, char *diagn, B[i*LDB+j].real=b[j*(*ldb)+i].real; B[i*LDB+j].imag=b[j*(*ldb)+i].imag; } - cblas_ztrsm(CblasRowMajor, side, uplo, trans, diag, *m, *n, alpha, + API_SUFFIX(cblas_ztrsm)(CblasRowMajor, side, uplo, trans, diag, *m, *n, alpha, A, LDA, B, LDB ); for( j=0; j<*n; j++ ) for( i=0; i<*m; i++ ) { @@ -556,9 +672,9 @@ void F77_ztrsm(int *layout, char *rtlf, char *uplow, char *transp, char *diagn, free(B); } else if (*layout == TEST_COL_MJR) - cblas_ztrsm(CblasColMajor, side, uplo, trans, diag, *m, *n, alpha, + API_SUFFIX(cblas_ztrsm)(CblasColMajor, side, uplo, trans, diag, *m, *n, alpha, a, *lda, b, *ldb); else - cblas_ztrsm(UNDEFINED, side, uplo, trans, diag, *m, *n, alpha, + API_SUFFIX(cblas_ztrsm)(INVALID_LAYOUT, side, uplo, trans, diag, *m, *n, alpha, a, *lda, b, *ldb); } diff --git a/CBLAS/testing/c_zblat1.f b/CBLAS/testing/c_zblat1.f index 03753e782c..a4f6a0a67f 100644 --- a/CBLAS/testing/c_zblat1.f +++ b/CBLAS/testing/c_zblat1.f @@ -1,4 +1,6 @@ +* ===================================================================== PROGRAM ZCBLAT1 + IMPLICIT NONE * Test program for the COMPLEX*16 Level 1 CBLAS. * Based upon the original CBLAS test routine together with: * F06GAF Example Program Text @@ -6,20 +8,26 @@ PROGRAM ZCBLAT1 INTEGER NOUT PARAMETER (NOUT=6) * .. Scalars in Common .. + INTEGER NTESTS, NFAILS + CHARACTER*15 SUBNAM INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Scalars .. + DOUBLE PRECISION S1, S2 DOUBLE PRECISION SFAC INTEGER IC * .. External Subroutines .. EXTERNAL CHECK1, CHECK2, HEADER * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS + COMMON /CNTBLA/NTESTS, NFAILS + COMMON /NAMBLA/SUBNAM * .. Data statements .. DATA SFAC/9.765625D-4/ * .. Executable Statements .. + CALL CPU_TIME( S1 ) WRITE (NOUT,99999) - DO 20 IC = 1, 10 + DO 20 IC = 1, 11 ICASE = IC CALL HEADER * @@ -29,33 +37,46 @@ PROGRAM ZCBLAT1 * these parameters. * PASS = .TRUE. + NTESTS = 0 + NFAILS = 0 INCX = 9999 INCY = 9999 MODE = 9999 - IF (ICASE.LE.5) THEN + IF (ICASE.LE.5 .OR. ICASE .EQ. 11) THEN CALL CHECK2(SFAC) ELSE IF (ICASE.GE.6) THEN CALL CHECK1(SFAC) END IF * -- Print IF (PASS) WRITE (NOUT,99998) + WRITE (NOUT,99997) SUBNAM, NTESTS, NFAILS 20 CONTINUE + CALL CPU_TIME( S2 ) + WRITE (NOUT,99996) S2 - S1 STOP * 99999 FORMAT (' Complex CBLAS Test Program Results',/1X) 99998 FORMAT (' ----- PASS -----') +99997 FORMAT (1X,A15,' COMPUTATIONAL TESTS:',I9,' RUN,',I9, + + ' FAILED') +99996 FORMAT (' Total time used = ',F12.2,' seconds',/) END + +* ===================================================================== SUBROUTINE HEADER + IMPLICIT NONE * .. Parameters .. INTEGER NOUT PARAMETER (NOUT=6) * .. Scalars in Common .. + CHARACTER*15 SUBNAM INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Arrays .. - CHARACTER*15 L(10) + CHARACTER*15 L(11) * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS + COMMON /NAMBLA/SUBNAM * .. Data statements .. DATA L(1)/'CBLAS_ZDOTC'/ DATA L(2)/'CBLAS_ZDOTU'/ @@ -67,13 +88,19 @@ SUBROUTINE HEADER DATA L(8)/'CBLAS_ZSCAL'/ DATA L(9)/'CBLAS_ZDSCAL'/ DATA L(10)/'CBLAS_IZAMAX'/ + DATA L(11)/'CBLAS_ZAXPBY'/ + * .. Executable Statements .. + SUBNAM = L(ICASE) WRITE (NOUT,99999) ICASE, L(ICASE) RETURN * 99999 FORMAT (/' Test of subprogram number',I3,9X,A15) END + +* ===================================================================== SUBROUTINE CHECK1(SFAC) + IMPLICIT NONE * .. Parameters .. INTEGER NOUT PARAMETER (NOUT=6) @@ -274,7 +301,10 @@ SUBROUTINE CHECK1(SFAC) END IF RETURN END + +* ===================================================================== SUBROUTINE CHECK2(SFAC) + IMPLICIT NONE * .. Parameters .. INTEGER NOUT PARAMETER (NOUT=6) @@ -284,23 +314,26 @@ SUBROUTINE CHECK2(SFAC) INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Scalars .. - COMPLEX*16 CA,ZTEMP + COMPLEX*16 CA,CB,ZTEMP INTEGER I, J, KI, KN, KSIZE, LENX, LENY, MX, MY * .. Local Arrays .. COMPLEX*16 CDOT(1), CSIZE1(4), CSIZE2(7,2), CSIZE3(14), + CT10X(7,4,4), CT10Y(7,4,4), CT6(4,4), CT7(4,4), - + CT8(7,4,4), CX(7), CX1(7), CY(7), CY1(7) + + CT8(7,4,4), CX(7), CX1(7), CY(7), CY1(7), + + CT11(7,4,4) INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4) * .. External Functions .. EXTERNAL ZDOTCTEST, ZDOTUTEST * .. External Subroutines .. - EXTERNAL ZAXPYTEST, ZCOPYTEST, ZSWAPTEST, CTEST + EXTERNAL ZAXPYTEST, ZCOPYTEST, ZSWAPTEST, CTEST, + + ZAXPBYTEST * .. Intrinsic Functions .. INTRINSIC ABS, MIN * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS * .. Data statements .. DATA CA/(0.4D0,-0.7D0)/ + DATA CB/(0.7D0,-0.4D0)/ DATA INCXS/1, 2, -2, -1/ DATA INCYS/1, -2, 1, -2/ DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/ @@ -470,6 +503,53 @@ SUBROUTINE CHECK2(SFAC) + (1.54D0,1.54D0), (1.54D0,1.54D0), + (1.54D0,1.54D0), (1.54D0,1.54D0), + (1.54D0,1.54D0), (1.54D0,1.54D0)/ + DATA ((CT11(I,J,1),I=1,7),J=1,4)/(0.6D0,-0.6D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (-0.1D0,-1.47D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (-0.1D0,-1.47D0), + + (-1.08D0,0.71D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (-0.1D0,-1.47D0), (-1.08D0,0.71D0), + + (-0.42D0,-0.99D0), (-0.61D0,-0.85D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/ + DATA ((CT11(I,J,2),I=1,7),J=1,4)/(0.6D0,-0.6D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (-0.1D0,-1.47D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (-0.49D0,-0.95D0), + + (-0.9D0,0.5D0),(-0.03D0,-1.51D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.36D0,0.00D0), (-0.9D0,0.5D0), + + (-0.39D0,-0.23D0), (0.1D0,-0.5D0), + + (-0.82D0,-0.39D0), (-0.5D0,-0.3D0), + + (0.0D0,-1.62D0)/ + DATA ((CT11(I,J,3),I=1,7),J=1,4)/(0.6D0,-0.6D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (-0.1D0,-1.47D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (-0.49D0,-0.95D0), + + (-0.71D0,-0.1D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.36D0,0.00D0), (-1.07D0,1.18D0), + + (-0.42D0,-0.99D0), (-0.41D0,-1.2D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/ + DATA ((CT11(I,J,4),I=1,7),J=1,4)/(0.6D0,-0.6D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (-0.1D0,-1.47D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (-0.1D0,-1.47D0), (-0.9D0,0.5D0), + + (-0.4D0,-0.7D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (-0.1D0,-1.47D0), + + (-0.9D0,0.5D0),(-0.4D0,-0.7D0), (0.1D0,-0.5D0), + + (-0.82D0,-0.39D0), (-0.5D0,-0.3D0), + + (-0.2D0,-1.27D0)/ + + * .. Executable Statements .. DO 60 KI = 1, 4 INCX = INCXS(KI) @@ -501,6 +581,10 @@ SUBROUTINE CHECK2(SFAC) * .. ZAXPYTEST .. CALL ZAXPYTEST(N,CA,CX,INCX,CY,INCY) CALL CTEST(LENY,CY,CT8(1,KN,KI),CSIZE2(1,KSIZE),SFAC) + ELSE IF (ICASE.EQ.11) THEN +* .. ZAXPBYTEST .. + CALL ZAXPBYTEST(N,CA,CX,INCX,CB,CY,INCY) + CALL CTEST(LENY,CY,CT11(1,KN,KI),CSIZE2(1,KSIZE),SFAC) ELSE IF (ICASE.EQ.4) THEN * .. ZCOPYTEST .. CALL ZCOPYTEST(N,CX,INCX,CY,INCY) @@ -519,7 +603,10 @@ SUBROUTINE CHECK2(SFAC) 60 CONTINUE RETURN END + +* ===================================================================== SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC) + IMPLICIT NONE * ********************************* STEST ************************** * * THIS SUBR COMPARES ARRAYS SCOMP() AND STRUE() OF LENGTH LEN TO @@ -537,6 +624,7 @@ SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC) * .. Array Arguments .. DOUBLE PRECISION SCOMP(LEN), SSIZE(LEN), STRUE(LEN) * .. Scalars in Common .. + INTEGER NTESTS, NFAILS INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Scalars .. @@ -549,12 +637,15 @@ SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC) INTRINSIC ABS * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS + COMMON /CNTBLA/NTESTS, NFAILS * .. Executable Statements .. * DO 40 I = 1, LEN + NTESTS = NTESTS + 1 SD = SCOMP(I) - STRUE(I) IF (SDIFF(ABS(SSIZE(I))+ABS(SFAC*SD),ABS(SSIZE(I))).EQ.0.0D0) + GO TO 40 + NFAILS = NFAILS + 1 * * HERE SCOMP(I) IS NOT CLOSE TO STRUE(I). * @@ -574,10 +665,13 @@ SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC) + ' SIZE(I)',/1X) 99997 FORMAT (1X,I4,I3,3I5,I3,2D36.8,2D12.4) END + +* ===================================================================== SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC) + IMPLICIT NONE * ************************* STEST1 ***************************** * -* THIS IS AN INTERFACE SUBROUTINE TO ACCOMODATE THE FORTRAN +* THIS IS AN INTERFACE SUBROUTINE TO ACCOMMODATE THE FORTRAN * REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE * ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT. * @@ -599,7 +693,10 @@ SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC) * RETURN END + +* ===================================================================== DOUBLE PRECISION FUNCTION SDIFF(SA,SB) + IMPLICIT NONE * ********************************* SDIFF ************************** * COMPUTES DIFFERENCE OF TWO NUMBERS. C. L. LAWSON, JPL 1974 FEB 15 * @@ -609,7 +706,10 @@ DOUBLE PRECISION FUNCTION SDIFF(SA,SB) SDIFF = SA - SB RETURN END + +* ===================================================================== SUBROUTINE CTEST(LEN,CCOMP,CTRUE,CSIZE,SFAC) + IMPLICIT NONE * **************************** CTEST ***************************** * * C.L. LAWSON, JPL, 1978 DEC 6 @@ -640,7 +740,10 @@ SUBROUTINE CTEST(LEN,CCOMP,CTRUE,CSIZE,SFAC) CALL STEST(2*LEN,SCOMP,STRUE,SSIZE,SFAC) RETURN END + +* ===================================================================== SUBROUTINE ITEST1(ICOMP,ITRUE) + IMPLICIT NONE * ********************************* ITEST1 ************************* * * THIS SUBROUTINE COMPARES THE VARIABLES ICOMP AND ITRUE FOR @@ -653,14 +756,18 @@ SUBROUTINE ITEST1(ICOMP,ITRUE) * .. Scalar Arguments .. INTEGER ICOMP, ITRUE * .. Scalars in Common .. + INTEGER NTESTS, NFAILS INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Scalars .. INTEGER ID * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS + COMMON /CNTBLA/NTESTS, NFAILS * .. Executable Statements .. + NTESTS = NTESTS + 1 IF (ICOMP.EQ.ITRUE) GO TO 40 + NFAILS = NFAILS + 1 * * HERE ICOMP IS NOT EQUAL TO ITRUE. * diff --git a/CBLAS/testing/c_zblat2.f b/CBLAS/testing/c_zblat2.f index 4392602302..cda64d6add 100644 --- a/CBLAS/testing/c_zblat2.f +++ b/CBLAS/testing/c_zblat2.f @@ -1,4 +1,6 @@ +* ===================================================================== PROGRAM ZBLAT2 + IMPLICIT NONE * * Test program for the COMPLEX*16 Level 2 Blas. * @@ -79,6 +81,7 @@ PROGRAM ZBLAT2 PARAMETER ( NINMAX = 7, NIDMAX = 9, NKBMAX = 7, $ NALMAX = 7, NBEMAX = 7 ) * .. Local Scalars .. + DOUBLE PRECISION S1, S2 DOUBLE PRECISION EPS, ERR, THRESH INTEGER I, ISNUM, J, N, NALF, NBET, NIDIM, NINC, NKB, $ NTRA, LAYOUT @@ -122,6 +125,7 @@ PROGRAM ZBLAT2 $ 'cblas_zgerc ','cblas_zgeru ','cblas_zher ', $ 'cblas_zhpr ','cblas_zher2 ','cblas_zhpr2 '/ * .. Executable Statements .. + CALL CPU_TIME( S1 ) * NOUTC = NOUT * @@ -349,13 +353,13 @@ PROGRAM ZBLAT2 CALL ZCHK3( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NKB, KB, NINC, INC, $ NMAX, INCMAX, A, AA, AS, Y, YY, YS, YT, G, Z, - $ 0 ) + $ 0 ) END IF IF (RORDER) THEN CALL ZCHK3( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NKB, KB, NINC, INC, $ NMAX, INCMAX, A, AA, AS, Y, YY, YS, YT, G, Z, - $ 1 ) + $ 1 ) END IF GO TO 200 * Test ZGERC, 12, ZGERU, 13. @@ -417,6 +421,8 @@ PROGRAM ZBLAT2 240 CONTINUE IF( TRACE ) $ CLOSE ( NTRA ) + CALL CPU_TIME( S2 ) + WRITE( NOUT, FMT = 9979 )S2 - S1 CLOSE ( NOUT ) STOP * @@ -455,14 +461,18 @@ PROGRAM ZBLAT2 9982 FORMAT( /' END OF TESTS' ) 9981 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' ) 9980 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' ) + 9979 FORMAT( ' Total time used = ', F12.2, ' seconds', / ) * * End of ZBLAT2. * END + +* ===================================================================== SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, NBET, $ BET, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX, $ XS, Y, YY, YS, YT, G, IORDER ) + IMPLICIT NONE * * Tests CGEMV and CGBMV. * @@ -495,6 +505,7 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX*16 ALPHA, ALS, BETA, BLS, TRANSL DOUBLE PRECISION ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, IC, IKU, IM, IN, INCX, INCXS, INCY, $ INCYS, IX, IY, KL, KLS, KU, KUS, LAA, LDA, $ LDAS, LX, LY, M, ML, MS, N, NARGS, NC, ND, NK, @@ -532,6 +543,8 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 120 IN = 1, NIDIM N = IDIM( IN ) @@ -680,6 +693,8 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9993 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 130 END IF * @@ -734,6 +749,8 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 130 END IF * @@ -746,6 +763,9 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ INCY, YT, G, YY, EPS, ERR, $ FATAL, NOUT, .TRUE. ) ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -776,9 +796,11 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * Report result. * IF( ERRMAX.LT.THRESH )THEN - WRITE( NOUT, FMT = 9999 )SNAME, NC + IF( IORDER.EQ.0 )WRITE( NOUT, FMT = 10000 )SNAME, NC + IF( IORDER.EQ.1 )WRITE( NOUT, FMT = 10001 )SNAME, NC ELSE - WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX + IF( IORDER.EQ.0 )WRITE( NOUT, FMT = 10002 )SNAME, NC, ERRMAX + IF( IORDER.EQ.1 )WRITE( NOUT, FMT = 10003 )SNAME, NC, ERRMAX END IF GO TO 140 * @@ -793,8 +815,22 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 140 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * +10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) +10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) +10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) +10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) 9999 FORMAT(' ',A12, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', $ 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', @@ -811,14 +847,21 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ F4.1, ',', F4.1, '), Y,', I2, ') .' ) 9993 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A12,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A12,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of ZCHK1. * END + +* ===================================================================== SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, NBET, $ BET, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX, $ XS, Y, YY, YS, YT, G, IORDER ) + IMPLICIT NONE * * Tests CHEMV, CHBMV and CHPMV. * @@ -851,6 +894,7 @@ SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX*16 ALPHA, ALS, BETA, BLS, TRANSL DOUBLE PRECISION ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, IC, IK, IN, INCX, INCXS, INCY, $ INCYS, IX, IY, K, KS, LAA, LDA, LDAS, LX, LY, $ N, NARGS, NC, NK, NS @@ -890,6 +934,8 @@ SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 110 IN = 1, NIDIM N = IDIM( IN ) @@ -1027,6 +1073,8 @@ SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1089,6 +1137,8 @@ SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1101,6 +1151,9 @@ SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ YY, EPS, ERR, FATAL, NOUT, $ .TRUE. ) ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -1127,9 +1180,11 @@ SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * Report result. * IF( ERRMAX.LT.THRESH )THEN - WRITE( NOUT, FMT = 9999 )SNAME, NC + IF( IORDER.EQ.0 )WRITE( NOUT, FMT = 10000 )SNAME, NC + IF( IORDER.EQ.1 )WRITE( NOUT, FMT = 10001 )SNAME, NC ELSE - WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX + IF( IORDER.EQ.0 )WRITE( NOUT, FMT = 10002 )SNAME, NC, ERRMAX + IF( IORDER.EQ.1 )WRITE( NOUT, FMT = 10003 )SNAME, NC, ERRMAX END IF GO TO 130 * @@ -1147,8 +1202,22 @@ SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 130 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * +10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) +10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) +10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) +10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) 9999 FORMAT(' ',A12, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', $ 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', @@ -1168,13 +1237,20 @@ SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ F4.1, '), ', 'Y,', I2, ') .' ) 9992 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A12,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A12,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of CZHK2. * END + +* ===================================================================== SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NKB, KB, NINC, INC, NMAX, $ INCMAX, A, AA, AS, X, XX, XS, XT, G, Z, IORDER ) + IMPLICIT NONE * * Tests ZTRMV, ZTBMV, ZTPMV, ZTRSV, ZTBSV and ZTPSV. * @@ -1206,6 +1282,7 @@ SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX*16 TRANSL DOUBLE PRECISION ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, ICD, ICT, ICU, IK, IN, INCX, INCXS, IX, K, $ KS, LAA, LDA, LDAS, LX, N, NARGS, NC, NK, NS LOGICAL BANDED, FULL, NULL, PACKED, RESET, SAME @@ -1246,6 +1323,8 @@ SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * Set up zero vector for ZMVCH. DO 10 I = 1, NMAX Z( I ) = ZERO @@ -1409,6 +1488,8 @@ SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1461,6 +1542,8 @@ SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1489,6 +1572,9 @@ SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ .FALSE. ) END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and return. IF( FATAL ) $ GO TO 120 @@ -1512,9 +1598,11 @@ SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * Report result. * IF( ERRMAX.LT.THRESH )THEN - WRITE( NOUT, FMT = 9999 )SNAME, NC + IF( IORDER.EQ.0 )WRITE( NOUT, FMT = 10000 )SNAME, NC + IF( IORDER.EQ.1 )WRITE( NOUT, FMT = 10001 )SNAME, NC ELSE - WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX + IF( IORDER.EQ.0 )WRITE( NOUT, FMT = 10002 )SNAME, NC, ERRMAX + IF( IORDER.EQ.1 )WRITE( NOUT, FMT = 10003 )SNAME, NC, ERRMAX END IF GO TO 130 * @@ -1532,8 +1620,22 @@ SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 130 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * +10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) +10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) +10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) +10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) 9999 FORMAT(' ',A12, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', $ 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', @@ -1550,14 +1652,21 @@ SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ I3, ', X,', I2, ') .' ) 9992 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A12,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A12,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of ZCHK3. * END + +* ===================================================================== SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX, $ INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G, $ Z, IORDER ) + IMPLICIT NONE * * Tests ZGERC and ZGERU. * @@ -1591,6 +1700,7 @@ SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX*16 ALPHA, ALS, TRANSL DOUBLE PRECISION ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IM, IN, INCX, INCXS, INCY, INCYS, IX, $ IY, J, LAA, LDA, LDAS, LX, LY, M, MS, N, NARGS, $ NC, ND, NS @@ -1618,6 +1728,8 @@ SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 120 IN = 1, NIDIM N = IDIM( IN ) @@ -1718,6 +1830,8 @@ SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9993 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 140 END IF * @@ -1748,6 +1862,8 @@ SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 140 END IF * @@ -1777,6 +1893,9 @@ SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ AA( 1 + ( J - 1 )*LDA ), EPS, $ ERR, FATAL, NOUT, .TRUE. ) ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and return. IF( FATAL ) $ GO TO 130 @@ -1799,9 +1918,11 @@ SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * Report result. * IF( ERRMAX.LT.THRESH )THEN - WRITE( NOUT, FMT = 9999 )SNAME, NC + IF( IORDER.EQ.0 )WRITE( NOUT, FMT = 10000 )SNAME, NC + IF( IORDER.EQ.1 )WRITE( NOUT, FMT = 10001 )SNAME, NC ELSE - WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX + IF( IORDER.EQ.0 )WRITE( NOUT, FMT = 10002 )SNAME, NC, ERRMAX + IF( IORDER.EQ.1 )WRITE( NOUT, FMT = 10003 )SNAME, NC, ERRMAX END IF GO TO 150 * @@ -1813,8 +1934,22 @@ SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, WRITE( NOUT, FMT = 9994 )NC, SNAME, M, N, ALPHA, INCX, INCY, LDA * 150 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * +10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) +10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) +10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) +10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) 9999 FORMAT(' ',A12, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', $ 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', @@ -1828,14 +1963,21 @@ SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ '), X,', I2, ', Y,', I2, ', A,', I3, ') .' ) 9993 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A12,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A12,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of ZCHK4. * END + +* ===================================================================== SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX, $ INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G, $ Z, IORDER ) + IMPLICIT NONE * * Tests ZHER and ZHPR. * @@ -1869,6 +2011,7 @@ SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX*16 ALPHA, TRANSL DOUBLE PRECISION ERR, ERRMAX, RALPHA, RALS + INTEGER NTESTS, NFAILS INTEGER I, IA, IC, IN, INCX, INCXS, IX, J, JA, JJ, LAA, $ LDA, LDAS, LJ, LX, N, NARGS, NC, NS LOGICAL FULL, NULL, PACKED, RESET, SAME, UPPER @@ -1905,6 +2048,8 @@ SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 100 IN = 1, NIDIM N = IDIM( IN ) @@ -1996,6 +2141,8 @@ SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -2026,6 +2173,8 @@ SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 30 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -2066,6 +2215,9 @@ SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, JA = JA + LJ END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and return. IF( FATAL ) $ GO TO 110 @@ -2087,9 +2239,11 @@ SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * Report result. * IF( ERRMAX.LT.THRESH )THEN - WRITE( NOUT, FMT = 9999 )SNAME, NC + IF( IORDER.EQ.0 )WRITE( NOUT, FMT = 10000 )SNAME, NC + IF( IORDER.EQ.1 )WRITE( NOUT, FMT = 10001 )SNAME, NC ELSE - WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX + IF( IORDER.EQ.0 )WRITE( NOUT, FMT = 10002 )SNAME, NC, ERRMAX + IF( IORDER.EQ.1 )WRITE( NOUT, FMT = 10003 )SNAME, NC, ERRMAX END IF GO TO 130 * @@ -2105,8 +2259,22 @@ SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 130 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * +10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) +10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) +10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) +10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) 9999 FORMAT(' ',A12, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', $ 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', @@ -2122,14 +2290,21 @@ SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ I2, ', A,', I3, ') .' ) 9992 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A12,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A12,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of CZHK5. * END + +* ===================================================================== SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX, $ INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G, $ Z, IORDER ) + IMPLICIT NONE * * Tests ZHER2 and ZHPR2. * @@ -2163,6 +2338,7 @@ SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX*16 ALPHA, ALS, TRANSL DOUBLE PRECISION ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IC, IN, INCX, INCXS, INCY, INCYS, IX, $ IY, J, JA, JJ, LAA, LDA, LDAS, LJ, LX, LY, N, $ NARGS, NC, NS @@ -2200,6 +2376,8 @@ SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 140 IN = 1, NIDIM N = IDIM( IN ) @@ -2309,6 +2487,8 @@ SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 160 END IF * @@ -2341,6 +2521,8 @@ SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 160 END IF * @@ -2391,6 +2573,9 @@ SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, JA = JA + LJ END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and return. IF( FATAL ) $ GO TO 150 @@ -2414,9 +2599,11 @@ SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * Report result. * IF( ERRMAX.LT.THRESH )THEN - WRITE( NOUT, FMT = 9999 )SNAME, NC + IF( IORDER.EQ.0 )WRITE( NOUT, FMT = 10000 )SNAME, NC + IF( IORDER.EQ.1 )WRITE( NOUT, FMT = 10001 )SNAME, NC ELSE - WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX + IF( IORDER.EQ.0 )WRITE( NOUT, FMT = 10002 )SNAME, NC, ERRMAX + IF( IORDER.EQ.1 )WRITE( NOUT, FMT = 10003 )SNAME, NC, ERRMAX END IF GO TO 170 * @@ -2433,8 +2620,22 @@ SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 170 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * +10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) +10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) +10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) +10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) 9999 FORMAT(' ',A12, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', $ 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', @@ -2450,12 +2651,19 @@ SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ F4.1, '), X,', I2, ', Y,', I2, ', A,', I3, ') .' ) 9992 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A12,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A12,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of ZCHK6. * END + +* ===================================================================== SUBROUTINE ZMVCH( TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y, $ INCY, YT, G, YY, EPS, ERR, FATAL, NOUT, MV ) + IMPLICIT NONE * * Checks the results of the computational tests. * @@ -2487,9 +2695,9 @@ SUBROUTINE ZMVCH( TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y, * .. Intrinsic Functions .. INTRINSIC ABS, DIMAG, DCONJG, MAX, DBLE, SQRT * .. Statement Functions .. - DOUBLE PRECISION ABS1 + DOUBLE PRECISION CABS1 * .. Statement Function definitions .. - ABS1( C ) = ABS( DBLE( C ) ) + ABS( DIMAG( C ) ) + CABS1( C ) = ABS( DBLE( C ) ) + ABS( DIMAG( C ) ) * .. Executable Statements .. TRAN = TRANS.EQ.'T' CTRAN = TRANS.EQ.'C' @@ -2526,24 +2734,25 @@ SUBROUTINE ZMVCH( TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y, IF( TRAN )THEN DO 10 J = 1, NL YT( IY ) = YT( IY ) + A( J, I )*X( JX ) - G( IY ) = G( IY ) + ABS1( A( J, I ) )*ABS1( X( JX ) ) + G( IY ) = G( IY ) + CABS1( A( J, I ) )*CABS1( X( JX ) ) JX = JX + INCXL 10 CONTINUE ELSE IF( CTRAN )THEN DO 20 J = 1, NL YT( IY ) = YT( IY ) + DCONJG( A( J, I ) )*X( JX ) - G( IY ) = G( IY ) + ABS1( A( J, I ) )*ABS1( X( JX ) ) + G( IY ) = G( IY ) + CABS1( A( J, I ) )*CABS1( X( JX ) ) JX = JX + INCXL 20 CONTINUE ELSE DO 30 J = 1, NL YT( IY ) = YT( IY ) + A( I, J )*X( JX ) - G( IY ) = G( IY ) + ABS1( A( I, J ) )*ABS1( X( JX ) ) + G( IY ) = G( IY ) + CABS1( A( I, J ) )*CABS1( X( JX ) ) JX = JX + INCXL 30 CONTINUE END IF YT( IY ) = ALPHA*YT( IY ) + BETA*Y( IY ) - G( IY ) = ABS1( ALPHA )*G( IY ) + ABS1( BETA )*ABS1( Y( IY ) ) + G( IY ) = CABS1( ALPHA )*G( IY ) + $ + CABS1( BETA )*CABS1( Y( IY ) ) IY = IY + INCYL 40 CONTINUE * @@ -2586,7 +2795,10 @@ SUBROUTINE ZMVCH( TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y, * End of ZMVCH. * END + +* ===================================================================== LOGICAL FUNCTION LZE( RI, RJ, LR ) + IMPLICIT NONE * * Tests if two arrays are identical. * @@ -2616,7 +2828,10 @@ LOGICAL FUNCTION LZE( RI, RJ, LR ) * End of LZE. * END + +* ===================================================================== LOGICAL FUNCTION LZERES( TYPE, UPLO, M, N, AA, AS, LDA ) + IMPLICIT NONE * * Tests if selected elements in two arrays are equal. * @@ -2676,7 +2891,10 @@ LOGICAL FUNCTION LZERES( TYPE, UPLO, M, N, AA, AS, LDA ) * End of LZERES. * END + +* ===================================================================== COMPLEX*16 FUNCTION ZBEG( RESET ) + IMPLICIT NONE * * Generates complex numbers as pairs of random numbers uniformly * distributed between -0.5 and 0.5. @@ -2722,13 +2940,16 @@ COMPLEX*16 FUNCTION ZBEG( RESET ) IC = 0 GO TO 10 END IF - ZBEG = DCMPLX( ( I - 500 )/1001.0, ( J - 500 )/1001.0 ) + ZBEG = DCMPLX( ( I - 500 )/1001.0D0, ( J - 500 )/1001.0D0 ) RETURN * * End of ZBEG. * END + +* ===================================================================== DOUBLE PRECISION FUNCTION DDIFF( X, Y ) + IMPLICIT NONE * * Auxiliary routine for test program for Level 2 Blas. * @@ -2744,8 +2965,11 @@ DOUBLE PRECISION FUNCTION DDIFF( X, Y ) * End of DDIFF. * END + +* ===================================================================== SUBROUTINE ZMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, $ KU, RESET, TRANSL ) + IMPLICIT NONE * * Generates values for an M by N matrix A within the bandwidth * defined by KL and KU. diff --git a/CBLAS/testing/c_zblat3.f b/CBLAS/testing/c_zblat3.f index 21e743d171..6a94941a97 100644 --- a/CBLAS/testing/c_zblat3.f +++ b/CBLAS/testing/c_zblat3.f @@ -1,10 +1,12 @@ +* ===================================================================== PROGRAM ZBLAT3 + IMPLICIT NONE * * Test program for the COMPLEX*16 Level 3 Blas. * * The program must be driven by a short data file. The first 13 records * of the file are read using list-directed input, the last 9 records -* are read using the format ( A12,L2 ). An annotated example of a data +* are read using the format ( A13,L2 ). An annotated example of a data * file can be obtained by deleting the first 3 characters from the * following 22 lines: * 'CBLAT3.SNAP' NAME OF SNAPSHOT OUTPUT FILE @@ -20,16 +22,17 @@ PROGRAM ZBLAT3 * (0.0,0.0) (1.0,0.0) (0.7,-0.9) VALUES OF ALPHA * 3 NUMBER OF VALUES OF BETA * (0.0,0.0) (1.0,0.0) (1.3,-1.1) VALUES OF BETA -* ZGEMM T PUT F FOR NO TEST. SAME COLUMNS. -* ZHEMM T PUT F FOR NO TEST. SAME COLUMNS. -* ZSYMM T PUT F FOR NO TEST. SAME COLUMNS. -* ZTRMM T PUT F FOR NO TEST. SAME COLUMNS. -* ZTRSM T PUT F FOR NO TEST. SAME COLUMNS. -* ZHERK T PUT F FOR NO TEST. SAME COLUMNS. -* ZSYRK T PUT F FOR NO TEST. SAME COLUMNS. -* ZHER2K T PUT F FOR NO TEST. SAME COLUMNS. -* ZSYR2K T PUT F FOR NO TEST. SAME COLUMNS. -* +* cblas_zgemm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_zhemm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_zsymm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_ztrmm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_ztrsm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_zherk T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_zsyrk T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_zher2k T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_zsyr2k T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_zgemmtr T PUT F FOR NO TEST. SAME COLUMNS. + * See: * * Dongarra J. J., Du Croz J. J., Duff I. S. and Hammarling S. @@ -49,7 +52,7 @@ PROGRAM ZBLAT3 INTEGER NIN, NOUT PARAMETER ( NIN = 5, NOUT = 6 ) INTEGER NSUBS - PARAMETER ( NSUBS = 9 ) + PARAMETER ( NSUBS = 10 ) COMPLEX*16 ZERO, ONE PARAMETER ( ZERO = ( 0.0D0, 0.0D0 ), $ ONE = ( 1.0D0, 0.0D0 ) ) @@ -60,13 +63,14 @@ PROGRAM ZBLAT3 INTEGER NIDMAX, NALMAX, NBEMAX PARAMETER ( NIDMAX = 9, NALMAX = 7, NBEMAX = 7 ) * .. Local Scalars .. + DOUBLE PRECISION S1, S2 DOUBLE PRECISION EPS, ERR, THRESH INTEGER I, ISNUM, J, N, NALF, NBET, NIDIM, NTRA, $ LAYOUT LOGICAL FATAL, LTESTT, REWI, SAME, SFATAL, TRACE, $ TSTERR, CORDER, RORDER CHARACTER*1 TRANSA, TRANSB - CHARACTER*12 SNAMET + CHARACTER*13 SNAMET CHARACTER*32 SNAPS * .. Local Arrays .. COMPLEX*16 AA( NMAX*NMAX ), AB( NMAX, 2*NMAX ), @@ -78,19 +82,20 @@ PROGRAM ZBLAT3 DOUBLE PRECISION G( NMAX ) INTEGER IDIM( NIDMAX ) LOGICAL LTEST( NSUBS ) - CHARACTER*12 SNAMES( NSUBS ) + CHARACTER*13 SNAMES( NSUBS ) * .. External Functions .. DOUBLE PRECISION DDIFF LOGICAL LZE EXTERNAL DDIFF, LZE * .. External Subroutines .. - EXTERNAL ZCHK1, ZCHK2, ZCHK3, ZCHK4, ZCHK5,ZMMCH + EXTERNAL ZCHK1, ZCHK2, ZCHK3, ZCHK4, + $ ZCHK5, ZCHK6, CZ3CHKE, ZMMCH * .. Intrinsic Functions .. INTRINSIC MAX, MIN * .. Scalars in Common .. INTEGER INFOT, NOUTC LOGICAL LERR, OK - CHARACTER*12 SRNAMT + CHARACTER*13 SRNAMT * .. Common blocks .. COMMON /INFOC/INFOT, NOUTC, OK, LERR COMMON /SRNAMC/SRNAMT @@ -98,8 +103,9 @@ PROGRAM ZBLAT3 DATA SNAMES/'cblas_zgemm ', 'cblas_zhemm ', $ 'cblas_zsymm ', 'cblas_ztrmm ', 'cblas_ztrsm ', $ 'cblas_zherk ', 'cblas_zsyrk ', 'cblas_zher2k', - $ 'cblas_zsyr2k'/ + $ 'cblas_zsyr2k', 'cblas_zgemmtr'/ * .. Executable Statements .. + CALL CPU_TIME( S1 ) * NOUTC = NOUT * @@ -296,7 +302,7 @@ PROGRAM ZBLAT3 OK = .TRUE. FATAL = .FALSE. GO TO ( 140, 150, 150, 160, 160, 170, 170, - $ 180, 180 )ISNUM + $ 180, 180, 185) ISNUM * Test ZGEMM, 01. 140 IF (CORDER) THEN CALL ZCHK1(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, @@ -330,13 +336,13 @@ PROGRAM ZBLAT3 CALL ZCHK3(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NMAX, AB, $ AA, AS, AB( 1, NMAX + 1 ), BB, BS, CT, G, C, - $ 0 ) + $ 0 ) END IF IF (RORDER) THEN CALL ZCHK3(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NMAX, AB, $ AA, AS, AB( 1, NMAX + 1 ), BB, BS, CT, G, C, - $ 1 ) + $ 1 ) END IF GO TO 190 * Test ZHERK, 06, ZSYRK, 07. @@ -358,13 +364,27 @@ PROGRAM ZBLAT3 CALL ZCHK5(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W, - $ 0 ) + $ 0 ) END IF IF (RORDER) THEN CALL ZCHK5(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W, - $ 1 ) + $ 1 ) + END IF + GO TO 190 +* Test ZGEMMTR, 10 + 185 IF (CORDER) THEN + CALL ZCHK6(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, + $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, + $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, + $ CC, CS, CT, G, 0 ) + END IF + IF (RORDER) THEN + CALL ZCHK6(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, + $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, + $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, + $ CC, CS, CT, G, 1 ) END IF GO TO 190 * @@ -385,6 +405,8 @@ PROGRAM ZBLAT3 230 CONTINUE IF( TRACE ) $ CLOSE ( NTRA ) + CALL CPU_TIME( S2 ) + WRITE( NOUT, FMT = 9983 )S2 - S1 CLOSE ( NOUT ) STOP * @@ -406,7 +428,7 @@ PROGRAM ZBLAT3 $ 7( '(', F4.1, ',', F4.1, ') ', : ) ) 9991 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM', $ /' ******* TESTS ABANDONED *******' ) - 9990 FORMAT(' SUBPROGRAM NAME ', A12,' NOT RECOGNIZED', /' ******* T', + 9990 FORMAT(' SUBPROGRAM NAME ', A13,' NOT RECOGNIZED', /' ******* T', $ 'ESTS ABANDONED *******' ) 9989 FORMAT(' ERROR IN ZMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALU', $ 'ATED WRONGLY.', /' ZMMCH WAS CALLED WITH TRANSA = ', A1, @@ -414,19 +436,23 @@ PROGRAM ZBLAT3 $ ' ERR = ', F12.3, '.', /' THIS MAY BE DUE TO FAULTS IN THE ', $ 'ARITHMETIC OR THE COMPILER.', /' ******* TESTS ABANDONED ', $ '*******' ) - 9988 FORMAT( A12,L2 ) - 9987 FORMAT( 1X, A12,' WAS NOT TESTED' ) + 9988 FORMAT( A13,L2 ) + 9987 FORMAT( 1X, A13,' WAS NOT TESTED' ) 9986 FORMAT( /' END OF TESTS' ) 9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' ) 9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' ) + 9983 FORMAT( ' Total time used = ', F12.2, ' seconds', / ) * * End of ZBLAT3. * END + +* ===================================================================== SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G, $ IORDER ) + IMPLICIT NONE * * Tests ZGEMM. * @@ -447,7 +473,7 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*13 SNAME * .. Array Arguments .. COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -459,6 +485,7 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX*16 ALPHA, ALS, BETA, BLS DOUBLE PRECISION ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, ICA, ICB, IK, IM, IN, K, KS, LAA, $ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, M, $ MA, MB, MS, N, NA, NARGS, NB, NC, NS @@ -487,6 +514,8 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 110 IM = 1, NIDIM M = IDIM( IM ) @@ -609,6 +638,8 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9994 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -644,6 +675,8 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -656,6 +689,9 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ C, NMAX, CT, G, CC, LDC, EPS, $ ERR, FATAL, NOUT, .TRUE. ) ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -693,37 +729,47 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ M, N, K, ALPHA, LDA, LDB, BETA, LDC) * 130 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A12,'(''', A1, ''',''', A1, ''',', + 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A13,'(''', A1, ''',''', A1, ''',', $ 3( I3, ',' ), '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, $ ',(', F4.1, ',', F4.1, '), C,', I3, ').' ) 9994 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A13,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A13,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of ZCHK1. * END -* + +* ===================================================================== SUBROUTINE ZPRCN1(NOUT, NC, SNAME, IORDER, TRANSA, TRANSB, M, N, $ K, ALPHA, LDA, LDB, BETA, LDC) + IMPLICIT NONE INTEGER NOUT, NC, IORDER, M, N, K, LDA, LDB, LDC DOUBLE COMPLEX ALPHA, BETA CHARACTER*1 TRANSA, TRANSB - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CTA,CTB IF (TRANSA.EQ.'N')THEN @@ -748,15 +794,17 @@ SUBROUTINE ZPRCN1(NOUT, NC, SNAME, IORDER, TRANSA, TRANSB, M, N, WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CTA,CTB WRITE(NOUT, FMT = 9994)M, N, K, ALPHA, LDA, LDB, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',') + 9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',') 9994 FORMAT( 10X, 3( I3, ',' ) ,' (', F4.1,',',F4.1,') , A,', $ I3, ', B,', I3, ', (', F4.1,',',F4.1,') , C,', I3, ').' ) END -* + +* ===================================================================== SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G, $ IORDER ) + IMPLICIT NONE * * Tests ZHEMM and ZSYMM. * @@ -777,7 +825,7 @@ SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*13 SNAME * .. Array Arguments .. COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -789,6 +837,7 @@ SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX*16 ALPHA, ALS, BETA, BLS DOUBLE PRECISION ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, ICS, ICU, IM, IN, LAA, LBB, LCC, $ LDA, LDAS, LDB, LDBS, LDC, LDCS, M, MS, N, NA, $ NARGS, NC, NS @@ -818,6 +867,8 @@ SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 100 IM = 1, NIDIM M = IDIM( IM ) @@ -931,6 +982,8 @@ SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9994 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 110 END IF * @@ -965,6 +1018,8 @@ SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 110 END IF * @@ -984,6 +1039,9 @@ SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NOUT, .TRUE. ) END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -1019,37 +1077,48 @@ SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ LDB, BETA, LDC) * 120 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) - 9995 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' ) + 9995 FORMAT(1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1, $ ',', F4.1, '), C,', I3, ') .' ) 9994 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A13,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A13,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of ZCHK2. * END -* + +* ===================================================================== SUBROUTINE ZPRCN2(NOUT, NC, SNAME, IORDER, SIDE, UPLO, M, N, $ ALPHA, LDA, LDB, BETA, LDC) + IMPLICIT NONE + INTEGER NOUT, NC, IORDER, M, N, LDA, LDB, LDC DOUBLE COMPLEX ALPHA, BETA CHARACTER*1 SIDE, UPLO - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CS,CU IF (SIDE.EQ.'L')THEN @@ -1070,14 +1139,16 @@ SUBROUTINE ZPRCN2(NOUT, NC, SNAME, IORDER, SIDE, UPLO, M, N, WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CS,CU WRITE(NOUT, FMT = 9994)M, N, ALPHA, LDA, LDB, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',') + 9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',') 9994 FORMAT( 10X, 2( I3, ',' ),' (',F4.1,',',F4.1, '), A,', I3, $ ', B,', I3, ', (',F4.1,',',F4.1, '), ', 'C,', I3, ').' ) END -* + +* ===================================================================== SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NMAX, A, AA, AS, $ B, BB, BS, CT, G, C, IORDER ) + IMPLICIT NONE * * Tests ZTRMM and ZTRSM. * @@ -1098,7 +1169,7 @@ SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*13 SNAME * .. Array Arguments .. COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -1109,6 +1180,7 @@ SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX*16 ALPHA, ALS DOUBLE PRECISION ERR, ERRMAX + INTEGER NTESTS, NFAILS INTEGER I, IA, ICD, ICS, ICT, ICU, IM, IN, J, LAA, LBB, $ LDA, LDAS, LDB, LDBS, M, MS, N, NA, NARGS, NC, $ NS @@ -1139,6 +1211,8 @@ SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * Set up zero matrix for ZMMCH. DO 20 J = 1, NMAX DO 10 I = 1, NMAX @@ -1250,6 +1324,8 @@ SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9994 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 150 END IF * @@ -1283,6 +1359,8 @@ SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 50 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 150 END IF * @@ -1333,6 +1411,9 @@ SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -1371,37 +1452,48 @@ SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ M, N, ALPHA, LDA, LDB) * 160 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT(' ******* ', A12,' FAILED ON CALL NUMBER:' ) - 9995 FORMAT(1X, I6, ': ', A12,'(', 4( '''', A1, ''',' ), 2( I3, ',' ), + 9996 FORMAT(' ******* ', A13,' FAILED ON CALL NUMBER:' ) + 9995 FORMAT(1X, I6, ': ', A13,'(', 4( '''', A1, ''',' ), 2( I3, ',' ), $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ') ', $ ' .' ) 9994 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A13,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A13,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of ZCHK3. * END -* + +* ===================================================================== SUBROUTINE ZPRCN3(NOUT, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, $ DIAG, M, N, ALPHA, LDA, LDB) + IMPLICIT NONE + INTEGER NOUT, NC, IORDER, M, N, LDA, LDB DOUBLE COMPLEX ALPHA CHARACTER*1 SIDE, UPLO, TRANSA, DIAG - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CS, CU, CA, CD IF (SIDE.EQ.'L')THEN @@ -1434,15 +1526,17 @@ SUBROUTINE ZPRCN3(NOUT, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CS,CU WRITE(NOUT, FMT = 9994)CA, CD, M, N, ALPHA, LDA, LDB - 9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',') + 9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',') 9994 FORMAT( 10X, 2( A14, ',') , 2( I3, ',' ), ' (', F4.1, ',', $ F4.1, '), A,', I3, ', B,', I3, ').' ) END -* + +* ===================================================================== SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G, $ IORDER ) + IMPLICIT NONE * * Tests ZHERK and ZSYRK. * @@ -1463,7 +1557,7 @@ SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*13 SNAME * .. Array Arguments .. COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -1475,6 +1569,7 @@ SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX*16 ALPHA, ALS, BETA, BETS DOUBLE PRECISION ERR, ERRMAX, RALPHA, RALS, RBETA, RBETS + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, K, KS, $ LAA, LCC, LDA, LDAS, LDC, LDCS, LJ, MA, N, NA, $ NARGS, NC, NS @@ -1504,6 +1599,8 @@ SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 100 IN = 1, NIDIM N = IDIM( IN ) @@ -1626,6 +1723,8 @@ SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1666,6 +1765,8 @@ SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 30 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 120 END IF * @@ -1708,6 +1809,9 @@ SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, JC = JC + LDC + 1 END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -1753,41 +1857,51 @@ SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 130 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9994 FORMAT(1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ') ', $ ' .' ) - 9993 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9993 FORMAT(1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ '(', F4.1, ',', F4.1, ') , A,', I3, ',(', F4.1, ',', F4.1, $ '), C,', I3, ') .' ) 9992 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A13,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A13,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of CCHK4. * END -* + +* ===================================================================== SUBROUTINE ZPRCN4(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, $ N, K, ALPHA, LDA, BETA, LDC) + IMPLICIT NONE INTEGER NOUT, NC, IORDER, N, K, LDA, LDC DOUBLE COMPLEX ALPHA, BETA CHARACTER*1 UPLO, TRANSA - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CU, CA IF (UPLO.EQ.'U')THEN @@ -1810,18 +1924,20 @@ SUBROUTINE ZPRCN4(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') ) + 9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') ) 9994 FORMAT( 10X, 2( I3, ',' ), ' (', F4.1, ',', F4.1 ,'), A,', $ I3, ', (', F4.1,',', F4.1, '), C,', I3, ').' ) END -* -* + +* ===================================================================== SUBROUTINE ZPRCN6(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, $ N, K, ALPHA, LDA, BETA, LDC) + IMPLICIT NONE + INTEGER NOUT, NC, IORDER, N, K, LDA, LDC DOUBLE PRECISION ALPHA, BETA CHARACTER*1 UPLO, TRANSA - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CU, CA IF (UPLO.EQ.'U')THEN @@ -1844,15 +1960,17 @@ SUBROUTINE ZPRCN6(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') ) + 9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') ) 9994 FORMAT( 10X, 2( I3, ',' ), $ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ').' ) END -* + +* ===================================================================== SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, $ AB, AA, AS, BB, BS, C, CC, CS, CT, G, W, $ IORDER ) + IMPLICIT NONE * * Tests ZHER2K and ZSYR2K. * @@ -1873,7 +1991,7 @@ SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*13 SNAME * .. Array Arguments .. COMPLEX*16 AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ), $ ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ), @@ -1885,6 +2003,7 @@ SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * .. Local Scalars .. COMPLEX*16 ALPHA, ALS, BETA, BETS DOUBLE PRECISION ERR, ERRMAX, RBETA, RBETS + INTEGER NTESTS, NFAILS INTEGER I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, JJAB, $ K, KS, LAA, LBB, LCC, LDA, LDAS, LDB, LDBS, $ LDC, LDCS, LJ, MA, N, NA, NARGS, NC, NS @@ -1914,6 +2033,8 @@ SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, NC = 0 RESET = .TRUE. ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 * DO 130 IN = 1, NIDIM N = IDIM( IN ) @@ -2051,6 +2172,8 @@ SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( .NOT.OK )THEN WRITE( NOUT, FMT = 9992 ) FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 150 END IF * @@ -2089,6 +2212,8 @@ SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 40 CONTINUE IF( .NOT.SAME )THEN FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 GO TO 150 END IF * @@ -2161,6 +2286,9 @@ SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ JJAB = JJAB + 2*NMAX END IF ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 * If got really bad answer, report and * return. IF( FATAL ) @@ -2206,41 +2334,52 @@ SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, END IF * 160 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9994 FORMAT(1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',', F4.1, $ ', C,', I3, ') .' ) - 9993 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9993 FORMAT(1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1, $ ',', F4.1, '), C,', I3, ') .' ) 9992 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) + 9979 FORMAT( ' ', A13,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A13,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) * * End of ZCHK5. * END -* + +* ===================================================================== SUBROUTINE ZPRCN5(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, $ N, K, ALPHA, LDA, LDB, BETA, LDC) + IMPLICIT NONE + INTEGER NOUT, NC, IORDER, N, K, LDA, LDB, LDC DOUBLE COMPLEX ALPHA, BETA CHARACTER*1 UPLO, TRANSA - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CU, CA IF (UPLO.EQ.'U')THEN @@ -2263,19 +2402,21 @@ SUBROUTINE ZPRCN5(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, LDB, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') ) + 9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') ) 9994 FORMAT( 10X, 2( I3, ',' ), ' (', F4.1, ',', F4.1, '), A,', $ I3, ', B', I3, ', (', F4.1, ',', F4.1, '), C,', I3, ').' ) END -* -* + +* ===================================================================== SUBROUTINE ZPRCN7(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, $ N, K, ALPHA, LDA, LDB, BETA, LDC) + IMPLICIT NONE + INTEGER NOUT, NC, IORDER, N, K, LDA, LDB, LDC DOUBLE COMPLEX ALPHA DOUBLE PRECISION BETA CHARACTER*1 UPLO, TRANSA - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CU, CA IF (UPLO.EQ.'U')THEN @@ -2298,13 +2439,15 @@ SUBROUTINE ZPRCN7(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, LDB, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') ) + 9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') ) 9994 FORMAT( 10X, 2( I3, ',' ), ' (', F4.1, ',', F4.1, '), A,', $ I3, ', B', I3, ',', F4.1, ', C,', I3, ').' ) END -* + +* ===================================================================== SUBROUTINE ZMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET, $ TRANSL ) + IMPLICIT NONE * * Generates values for an M by N matrix A. * Stores the values in the array AA in the data structure required @@ -2432,9 +2575,12 @@ SUBROUTINE ZMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET, * End of ZMAKE. * END + +* ===================================================================== SUBROUTINE ZMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, $ BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, FATAL, $ NOUT, MV ) + IMPLICIT NONE * * Checks the results of the computational tests. * @@ -2469,9 +2615,9 @@ SUBROUTINE ZMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, * .. Intrinsic Functions .. INTRINSIC ABS, DIMAG, DCONJG, MAX, DBLE, SQRT * .. Statement Functions .. - DOUBLE PRECISION ABS1 + DOUBLE PRECISION CABS1 * .. Statement Function definitions .. - ABS1( CL ) = ABS( DBLE( CL ) ) + ABS( DIMAG( CL ) ) + CABS1( CL ) = ABS( DBLE( CL ) ) + ABS( DIMAG( CL ) ) * .. Executable Statements .. TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' @@ -2492,7 +2638,8 @@ SUBROUTINE ZMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, DO 30 K = 1, KK DO 20 I = 1, M CT( I ) = CT( I ) + A( I, K )*B( K, J ) - G( I ) = G( I ) + ABS1( A( I, K ) )*ABS1( B( K, J ) ) + G( I ) = G( I ) + $ + CABS1( A( I, K ) )*CABS1( B( K, J ) ) 20 CONTINUE 30 CONTINUE ELSE IF( TRANA.AND..NOT.TRANB )THEN @@ -2500,16 +2647,16 @@ SUBROUTINE ZMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, DO 50 K = 1, KK DO 40 I = 1, M CT( I ) = CT( I ) + DCONJG( A( K, I ) )*B( K, J ) - G( I ) = G( I ) + ABS1( A( K, I ) )* - $ ABS1( B( K, J ) ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( K, J ) ) 40 CONTINUE 50 CONTINUE ELSE DO 70 K = 1, KK DO 60 I = 1, M CT( I ) = CT( I ) + A( K, I )*B( K, J ) - G( I ) = G( I ) + ABS1( A( K, I ) )* - $ ABS1( B( K, J ) ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( K, J ) ) 60 CONTINUE 70 CONTINUE END IF @@ -2518,16 +2665,16 @@ SUBROUTINE ZMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, DO 90 K = 1, KK DO 80 I = 1, M CT( I ) = CT( I ) + A( I, K )*DCONJG( B( J, K ) ) - G( I ) = G( I ) + ABS1( A( I, K ) )* - $ ABS1( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( I, K ) )* + $ CABS1( B( J, K ) ) 80 CONTINUE 90 CONTINUE ELSE DO 110 K = 1, KK DO 100 I = 1, M CT( I ) = CT( I ) + A( I, K )*B( J, K ) - G( I ) = G( I ) + ABS1( A( I, K ) )* - $ ABS1( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( I, K ) )* + $ CABS1( B( J, K ) ) 100 CONTINUE 110 CONTINUE END IF @@ -2538,8 +2685,8 @@ SUBROUTINE ZMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, DO 120 I = 1, M CT( I ) = CT( I ) + DCONJG( A( K, I ) )* $ DCONJG( B( J, K ) ) - G( I ) = G( I ) + ABS1( A( K, I ) )* - $ ABS1( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( J, K ) ) 120 CONTINUE 130 CONTINUE ELSE @@ -2547,8 +2694,8 @@ SUBROUTINE ZMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, DO 140 I = 1, M CT( I ) = CT( I ) + DCONJG( A( K, I ) )* $ B( J, K ) - G( I ) = G( I ) + ABS1( A( K, I ) )* - $ ABS1( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( J, K ) ) 140 CONTINUE 150 CONTINUE END IF @@ -2558,16 +2705,16 @@ SUBROUTINE ZMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, DO 160 I = 1, M CT( I ) = CT( I ) + A( K, I )* $ DCONJG( B( J, K ) ) - G( I ) = G( I ) + ABS1( A( K, I ) )* - $ ABS1( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( J, K ) ) 160 CONTINUE 170 CONTINUE ELSE DO 190 K = 1, KK DO 180 I = 1, M CT( I ) = CT( I ) + A( K, I )*B( J, K ) - G( I ) = G( I ) + ABS1( A( K, I ) )* - $ ABS1( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( J, K ) ) 180 CONTINUE 190 CONTINUE END IF @@ -2575,15 +2722,15 @@ SUBROUTINE ZMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, END IF DO 200 I = 1, M CT( I ) = ALPHA*CT( I ) + BETA*C( I, J ) - G( I ) = ABS1( ALPHA )*G( I ) + - $ ABS1( BETA )*ABS1( C( I, J ) ) + G( I ) = CABS1( ALPHA )*G( I ) + + $ CABS1( BETA )*CABS1( C( I, J ) ) 200 CONTINUE * * Compute the error ratio for this result. * ERR = ZERO DO 210 I = 1, M - ERRI = ABS1( CT( I ) - CC( I, J ) )/EPS + ERRI = CABS1( CT( I ) - CC( I, J ) )/EPS IF( G( I ).NE.RZERO ) $ ERRI = ERRI/G( I ) ERR = MAX( ERR, ERRI ) @@ -2622,7 +2769,10 @@ SUBROUTINE ZMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, * End of ZMMCH. * END + +* ===================================================================== LOGICAL FUNCTION LZE( RI, RJ, LR ) + IMPLICIT NONE * * Tests if two arrays are identical. * @@ -2654,7 +2804,10 @@ LOGICAL FUNCTION LZE( RI, RJ, LR ) * End of LZE. * END + +* ===================================================================== LOGICAL FUNCTION LZERES( TYPE, UPLO, M, N, AA, AS, LDA ) + IMPLICIT NONE * * Tests if selected elements in two arrays are equal. * @@ -2716,7 +2869,10 @@ LOGICAL FUNCTION LZERES( TYPE, UPLO, M, N, AA, AS, LDA ) * End of LZERES. * END + +* ===================================================================== COMPLEX*16 FUNCTION ZBEG( RESET ) + IMPLICIT NONE * * Generates complex numbers as pairs of random numbers uniformly * distributed between -0.5 and 0.5. @@ -2770,7 +2926,10 @@ COMPLEX*16 FUNCTION ZBEG( RESET ) * End of ZBEG. * END + +* ===================================================================== DOUBLE PRECISION FUNCTION DDIFF( X, Y ) + IMPLICIT NONE * * Auxiliary routine for test program for Level 3 Blas. * @@ -2790,3 +2949,564 @@ DOUBLE PRECISION FUNCTION DDIFF( X, Y ) * END +* ===================================================================== + SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, + $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, + $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G, + $ IORDER ) + IMPLICIT NONE +* +* Tests CGEMMTR. +* +* Auxiliary routine for test program for Level 3 Blas. +* +* -- Written on 24-June-2024. +* Martin Koehler, Max Planck Institute Magdeburg +* +* .. Parameters .. + COMPLEX*16 ZERO + PARAMETER ( ZERO = ( 0.0, 0.0 ) ) + DOUBLE PRECISION RZERO + PARAMETER ( RZERO = 0.0 ) +* .. Scalar Arguments .. + DOUBLE PRECISION EPS, THRESH + INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER + LOGICAL FATAL, REWI, TRACE + CHARACTER*13 SNAME +* .. Array Arguments .. + COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), + $ AS( NMAX*NMAX ), B( NMAX, NMAX ), + $ BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ), + $ C( NMAX, NMAX ), CC( NMAX*NMAX ), + $ CS( NMAX*NMAX ), CT( NMAX ) + DOUBLE PRECISION G( NMAX ) + INTEGER IDIM( NIDIM ) +* .. Local Scalars .. + COMPLEX*16 ALPHA, ALS, BETA, BLS + DOUBLE PRECISION ERR, ERRMAX + INTEGER NTESTS, NFAILS + INTEGER I, IA, IB, ICA, ICB, IK, IM, IN, K, KS, LAA, + $ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, + $ MA, MB, N, NA, NARGS, NB, NC, NS, IS + LOGICAL NULL, RESET, SAME, TRANA, TRANB + CHARACTER*1 TRANAS, TRANBS, TRANSA, TRANSB, UPLO, UPLOS + CHARACTER*3 ICH + CHARACTER*2 ISHAPE +* .. Local Arrays .. + LOGICAL ISAME( 13 ) +* .. External Functions .. + LOGICAL LZE, LZERES + EXTERNAL LZE, LZERES +* .. External Subroutines .. + EXTERNAL CZGEMMTR, ZMAKE, ZMMTCH, ZPRCN8 +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. Scalars in Common .. + INTEGER INFOT, NOUTC + LOGICAL LERR, OK +* .. Common blocks .. + COMMON /INFOC/INFOT, NOUTC, OK, LERR +* .. Data statements .. + DATA ICH/'NTC'/ + DATA ISHAPE/'UL'/ +* .. Executable Statements .. +* + NARGS = 13 + NC = 0 + RESET = .TRUE. + ERRMAX = RZERO + NTESTS = 0 + NFAILS = 0 +* + DO 100 IN = 1, NIDIM + N = IDIM( IN ) +* Set LDC to 1 more than minimum value if room. + LDC = N + IF( LDC.LT.NMAX ) + $ LDC = LDC + 1 +* Skip tests if not enough room. + IF( LDC.GT.NMAX ) + $ GO TO 100 + LCC = LDC*N + NULL = N.LE.0 +* + DO 90 IK = 1, NIDIM + K = IDIM( IK ) +* + DO 80 ICA = 1, 3 + TRANSA = ICH( ICA: ICA ) + TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' +* + IF( TRANA )THEN + MA = K + NA = N + ELSE + MA = N + NA = K + END IF +* Set LDA to 1 more than minimum value if room. + LDA = MA + IF( LDA.LT.NMAX ) + $ LDA = LDA + 1 +* Skip tests if not enough room. + IF( LDA.GT.NMAX ) + $ GO TO 80 + LAA = LDA*NA +* +* Generate the matrix A. +* + CALL ZMAKE( 'ge', ' ', ' ', MA, NA, A, NMAX, AA, LDA, + $ RESET, ZERO ) +* + DO 70 ICB = 1, 3 + TRANSB = ICH( ICB: ICB ) + TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' +* + IF( TRANB )THEN + MB = N + NB = K + ELSE + MB = K + NB = N + END IF +* Set LDB to 1 more than minimum value if room. + LDB = MB + IF( LDB.LT.NMAX ) + $ LDB = LDB + 1 +* Skip tests if not enough room. + IF( LDB.GT.NMAX ) + $ GO TO 70 + LBB = LDB*NB +* +* Generate the matrix B. +* + CALL ZMAKE( 'ge', ' ', ' ', MB, NB, B, NMAX, BB, + $ LDB, RESET, ZERO ) +* + DO 60 IA = 1, NALF + ALPHA = ALF( IA ) +* + DO 50 IB = 1, NBET + BETA = BET( IB ) + DO 45 IS = 1, 2 + UPLO = ISHAPE(IS:IS) +* +* Generate the matrix C. +* + CALL ZMAKE( 'ge', UPLO, ' ', N, N, C, NMAX, + $ CC, LDC, RESET, ZERO ) +* + NC = NC + 1 +* +* Save every datum before calling the +* subroutine. +* + UPLOS = UPLO + TRANAS = TRANSA + TRANBS = TRANSB + NS = N + KS = K + ALS = ALPHA + DO 10 I = 1, LAA + AS( I ) = AA( I ) + 10 CONTINUE + LDAS = LDA + DO 20 I = 1, LBB + BS( I ) = BB( I ) + 20 CONTINUE + LDBS = LDB + BLS = BETA + DO 30 I = 1, LCC + CS( I ) = CC( I ) + 30 CONTINUE + LDCS = LDC +* +* Call the subroutine. +* + IF( TRACE ) + $ CALL ZPRCN8(NTRA, NC, SNAME, IORDER, UPLO, + $ TRANSA, TRANSB, N, K, ALPHA, LDA, + $ LDB, BETA, LDC) + IF( REWI ) + $ REWIND NTRA + CALL CZGEMMTR(IORDER, UPLO, TRANSA, TRANSB, + $ N, K, ALPHA, AA, LDA, BB, LDB, + $ BETA, CC, LDC ) +* +* Check if error-exit was taken incorrectly. +* + IF( .NOT.OK )THEN + WRITE( NOUT, FMT = 9994 ) + FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 + GO TO 120 + END IF +* +* See what data changed inside subroutines. +* + ISAME( 1 ) = UPLO .EQ. UPLOS + ISAME( 2 ) = TRANSA.EQ.TRANAS + ISAME( 3 ) = TRANSB.EQ.TRANBS + ISAME( 4 ) = NS.EQ.N + ISAME( 5 ) = KS.EQ.K + ISAME( 6 ) = ALS.EQ.ALPHA + ISAME( 7 ) = LZE( AS, AA, LAA ) + ISAME( 8 ) = LDAS.EQ.LDA + ISAME( 9 ) = LZE( BS, BB, LBB ) + ISAME( 10 ) = LDBS.EQ.LDB + ISAME( 11 ) = BLS.EQ.BETA + IF( NULL )THEN + ISAME( 12 ) = LZE( CS, CC, LCC ) + ELSE + ISAME( 12 ) = LZERES( 'ge', ' ', N, N, CS, + $ CC, LDC ) + END IF + ISAME( 13 ) = LDCS.EQ.LDC +* +* If data was incorrectly changed, report +* and return. +* + SAME = .TRUE. + DO 40 I = 1, NARGS + SAME = SAME.AND.ISAME( I ) + IF( .NOT.ISAME( I ) ) + $ WRITE( NOUT, FMT = 9998 )I + 40 CONTINUE + IF( .NOT.SAME )THEN + FATAL = .TRUE. + NTESTS = NTESTS + 1 + NFAILS = NFAILS + 1 + GO TO 120 + END IF +* + IF( .NOT.NULL )THEN +* +* Check the result. +* + CALL ZMMTCH( UPLO, TRANSA, TRANSB, N, K, + $ ALPHA, A, NMAX, B, NMAX, BETA, + $ C, NMAX, CT, G, CC, LDC, EPS, + $ ERR, FATAL, NOUT, .TRUE. ) + ERRMAX = MAX( ERRMAX, ERR ) + NTESTS = NTESTS + 1 + IF( ERR.GE.THRESH ) + $ NFAILS = NFAILS + 1 +* If got really bad answer, report and +* return. + IF( FATAL ) + $ GO TO 120 + END IF +* + 45 CONTINUE +* + 50 CONTINUE +* + 60 CONTINUE +* + 70 CONTINUE +* + 80 CONTINUE +* + 90 CONTINUE +* + 100 CONTINUE +* +* +* Report result. +* + IF( ERRMAX.LT.THRESH )THEN + IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10000 )SNAME, NC + IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10001 )SNAME, NC + ELSE + IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10002 )SNAME, NC, ERRMAX + IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10003 )SNAME, NC, ERRMAX + END IF + GO TO 130 +* + 120 CONTINUE + WRITE( NOUT, FMT = 9996 )SNAME + CALL ZPRCN8(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, TRANSB, + $ N, K, ALPHA, LDA, LDB, BETA, LDC) +* + 130 CONTINUE + IF( IORDER.EQ.0 ) + $ WRITE( NOUT, FMT = 9979 )SNAME, NTESTS, NFAILS + IF( IORDER.EQ.1 ) + $ WRITE( NOUT, FMT = 9978 )SNAME, NTESTS, NFAILS + RETURN +* +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) + 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', + $ 'ANGED INCORRECTLY *******' ) + 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A13,'(''', A1, ''',''', A1, ''',', + $ 3( I3, ',' ), '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, + $ ',(', F4.1, ',', F4.1, '), C,', I3, ').' ) + 9994 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', + $ '******' ) + 9979 FORMAT( ' ', A13,' COLUMN-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) + 9978 FORMAT( ' ', A13,' ROW-MAJOR COMPUTATIONAL TESTS:', I9, + $ ' RUN,', I9, ' FAILED' ) +* +* End of ZCHK6. +* + END + +* ===================================================================== + SUBROUTINE ZPRCN8(NOUT, NC, SNAME, IORDER, UPLO, + $ TRANSA, TRANSB, N, + $ K, ALPHA, LDA, LDB, BETA, LDC) + IMPLICIT NONE + + INTEGER NOUT, NC, IORDER, N, K, LDA, LDB, LDC + COMPLEX*16 ALPHA, BETA + CHARACTER*1 TRANSA, TRANSB, UPLO + CHARACTER*13 SNAME + CHARACTER*14 CRC, CTA,CTB,CUPLO + + IF (UPLO.EQ.'U') THEN + CUPLO = 'CblasUpper' + ELSE + CUPLO = 'CblasLower' + END IF + IF (TRANSA.EQ.'N')THEN + CTA = ' CblasNoTrans' + ELSE IF (TRANSA.EQ.'T')THEN + CTA = ' CblasTrans' + ELSE + CTA = 'CblasConjTrans' + END IF + IF (TRANSB.EQ.'N')THEN + CTB = ' CblasNoTrans' + ELSE IF (TRANSB.EQ.'T')THEN + CTB = ' CblasTrans' + ELSE + CTB = 'CblasConjTrans' + END IF + IF (IORDER.EQ.1)THEN + CRC = ' CblasRowMajor' + ELSE + CRC = ' CblasColMajor' + END IF + WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CUPLO, CTA,CTB + WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, LDB, BETA, LDC + + 9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',', + $ A14, ',') + 9994 FORMAT( 10X, 2( I3, ',' ) ,' (', F4.1,',',F4.1,') , A,', + $ I3, ', B,', I3, ', (', F4.1,',',F4.1,') , C,', I3, ').' ) + END + +* ===================================================================== + SUBROUTINE ZMMTCH(UPLO, TRANSA, TRANSB, N, KK, ALPHA, A, LDA, + $ B, LDB, + $ BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, FATAL, + $ NOUT, MV ) + IMPLICIT NONE +* +* Checks the results of the computational tests for GEMMTR. +* +* Auxiliary routine for test program for Level 3 Blas. +* +* -- Written on 24-June-2024. +* Martin Koehler, Max Planck Institute, Magdeburg +* +* .. Parameters .. + COMPLEX*16 ZERO + PARAMETER ( ZERO = ( 0.0, 0.0 ) ) + DOUBLE PRECISION RZERO, RONE + PARAMETER ( RZERO = 0.0, RONE = 1.0 ) +* .. Scalar Arguments .. + COMPLEX*16 ALPHA, BETA + DOUBLE PRECISION EPS, ERR + INTEGER KK, LDA, LDB, LDC, LDCC, N, NOUT + LOGICAL FATAL, MV + CHARACTER*1 TRANSA, TRANSB, UPLO +* .. Array Arguments .. + COMPLEX*16 A( LDA, * ), B( LDB, * ), C( LDC, * ), + $ CC( LDCC, * ), CT( * ) + DOUBLE PRECISION G( * ) +* .. Local Scalars .. + COMPLEX*16 CL + DOUBLE PRECISION ERRI + INTEGER I, J, K, ISTART, ISTOP + LOGICAL CTRANA, CTRANB, TRANA, TRANB, UPPER +* .. Intrinsic Functions .. + INTRINSIC DABS, DIMAG, DCONJG, MAX, DBLE, DSQRT +* .. Statement Functions .. + DOUBLE PRECISION CABS1 +* .. Statement Function definitions .. + CABS1( CL ) = DABS( DBLE( CL ) ) + DABS( DIMAG( CL ) ) +* .. Executable Statements .. + + UPPER = UPLO.EQ.'U' + TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' + TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' + CTRANA = TRANSA.EQ.'C' + CTRANB = TRANSB.EQ.'C' + + ISTART = 1 + ISTOP = N +* +* Compute expected result, one column at a time, in CT using data +* in A, B and C. +* Compute gauges in G. +* + DO 220 J = 1, N +* + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + DO 10 I = ISTART, ISTOP + CT( I ) = ZERO + G( I ) = RZERO + 10 CONTINUE + IF( .NOT.TRANA.AND..NOT.TRANB )THEN + DO 30 K = 1, KK + DO 20 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*B( K, J ) + G( I ) = G( I ) + $ + CABS1( A( I, K ) )*CABS1( B( K, J ) ) + 20 CONTINUE + 30 CONTINUE + ELSE IF( TRANA.AND..NOT.TRANB )THEN + IF( CTRANA )THEN + DO 50 K = 1, KK + DO 40 I = ISTART, ISTOP + CT( I ) = CT( I ) + DCONJG( A( K, I ) )*B( K, J ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( K, J ) ) + 40 CONTINUE + 50 CONTINUE + ELSE + DO 70 K = 1, KK + DO 60 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*B( K, J ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( K, J ) ) + 60 CONTINUE + 70 CONTINUE + END IF + ELSE IF( .NOT.TRANA.AND.TRANB )THEN + IF( CTRANB )THEN + DO 90 K = 1, KK + DO 80 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*DCONJG( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( I, K ) )* + $ CABS1( B( J, K ) ) + 80 CONTINUE + 90 CONTINUE + ELSE + DO 110 K = 1, KK + DO 100 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*B( J, K ) + G( I ) = G( I ) + CABS1( A( I, K ) )* + $ CABS1( B( J, K ) ) + 100 CONTINUE + 110 CONTINUE + END IF + ELSE IF( TRANA.AND.TRANB )THEN + IF( CTRANA )THEN + IF( CTRANB )THEN + DO 130 K = 1, KK + DO 120 I = ISTART, ISTOP + CT( I ) = CT( I ) + DCONJG( A( K, I ) )* + $ DCONJG( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( J, K ) ) + 120 CONTINUE + 130 CONTINUE + ELSE + DO 150 K = 1, KK + DO 140 I = ISTART, ISTOP + CT( I ) = CT( I ) + DCONJG( A( K, I ) )*B( J, K ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( J, K ) ) + 140 CONTINUE + 150 CONTINUE + END IF + ELSE + IF( CTRANB )THEN + DO 170 K = 1, KK + DO 160 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*DCONJG( B( J, K ) ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( J, K ) ) + 160 CONTINUE + 170 CONTINUE + ELSE + DO 190 K = 1, KK + DO 180 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*B( J, K ) + G( I ) = G( I ) + CABS1( A( K, I ) )* + $ CABS1( B( J, K ) ) + 180 CONTINUE + 190 CONTINUE + END IF + END IF + END IF + DO 200 I = ISTART, ISTOP + CT( I ) = ALPHA*CT( I ) + BETA*C( I, J ) + G( I ) = CABS1( ALPHA )*G( I ) + + $ CABS1( BETA )*CABS1( C( I, J ) ) + 200 CONTINUE +* +* Compute the error ratio for this result. +* + ERR = ZERO + DO 210 I = ISTART, ISTOP + ERRI = CABS1( CT( I ) - CC( I, J ) )/EPS + IF( G( I ).NE.RZERO ) + $ ERRI = ERRI/G( I ) + ERR = MAX( ERR, ERRI ) + IF( ERR*DSQRT( EPS ).GE.RONE ) + $ GO TO 230 + 210 CONTINUE +* + 220 CONTINUE +* +* If the loop completes, all results are at least half accurate. + GO TO 250 +* +* Report fatal error. +* + 230 FATAL = .TRUE. + WRITE( NOUT, FMT = 9999 ) + DO 240 I = ISTART, ISTOP + IF( MV )THEN + WRITE( NOUT, FMT = 9998 )I, CT( I ), CC( I, J ) + ELSE + WRITE( NOUT, FMT = 9998 )I, CC( I, J ), CT( I ) + END IF + 240 CONTINUE + IF( N.GT.1 ) + $ WRITE( NOUT, FMT = 9997 )J +* + 250 CONTINUE + RETURN +* + 9999 FORMAT(' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL', + $ 'F ACCURATE *******', /' EXPECTED RE', + $ 'SULT COMPUTED RESULT' ) + 9998 FORMAT( 1X, I7, 2( ' (', G15.6, ',', G15.6, ')' ) ) + 9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) +* +* End of ZMMTCH. +* + END + diff --git a/CBLAS/testing/cin3 b/CBLAS/testing/cin3 index 7b34f267bb..093bf8e26a 100644 --- a/CBLAS/testing/cin3 +++ b/CBLAS/testing/cin3 @@ -20,3 +20,4 @@ cblas_cherk T PUT F FOR NO TEST. SAME COLUMNS. cblas_csyrk T PUT F FOR NO TEST. SAME COLUMNS. cblas_cher2k T PUT F FOR NO TEST. SAME COLUMNS. cblas_csyr2k T PUT F FOR NO TEST. SAME COLUMNS. +cblas_cgemmtr T PUT F FOR NO TEST. SAME COLUMNS. diff --git a/CBLAS/testing/din2 b/CBLAS/testing/din2 index 000351c777..a9e6faa097 100644 --- a/CBLAS/testing/din2 +++ b/CBLAS/testing/din2 @@ -15,19 +15,21 @@ T LOGICAL FLAG, T TO TEST ERROR EXITS. 0.0 1.0 0.7 VALUES OF ALPHA 3 NUMBER OF VALUES OF BETA 0.0 1.0 0.9 VALUES OF BETA -cblas_dgemv T PUT F FOR NO TEST. SAME COLUMNS. -cblas_dgbmv T PUT F FOR NO TEST. SAME COLUMNS. -cblas_dsymv T PUT F FOR NO TEST. SAME COLUMNS. -cblas_dsbmv T PUT F FOR NO TEST. SAME COLUMNS. -cblas_dspmv T PUT F FOR NO TEST. SAME COLUMNS. -cblas_dtrmv T PUT F FOR NO TEST. SAME COLUMNS. -cblas_dtbmv T PUT F FOR NO TEST. SAME COLUMNS. -cblas_dtpmv T PUT F FOR NO TEST. SAME COLUMNS. -cblas_dtrsv T PUT F FOR NO TEST. SAME COLUMNS. -cblas_dtbsv T PUT F FOR NO TEST. SAME COLUMNS. -cblas_dtpsv T PUT F FOR NO TEST. SAME COLUMNS. -cblas_dger T PUT F FOR NO TEST. SAME COLUMNS. -cblas_dsyr T PUT F FOR NO TEST. SAME COLUMNS. -cblas_dspr T PUT F FOR NO TEST. SAME COLUMNS. -cblas_dsyr2 T PUT F FOR NO TEST. SAME COLUMNS. -cblas_dspr2 T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dgemv T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dgbmv T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dsymv T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dsbmv T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dspmv T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dskewsymv T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dtrmv T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dtbmv T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dtpmv T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dtrsv T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dtbsv T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dtpsv T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dger T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dsyr T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dspr T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dsyr2 T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dspr2 T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dskewsyr2 T PUT F FOR NO TEST. SAME COLUMNS. diff --git a/CBLAS/testing/din3 b/CBLAS/testing/din3 index 1f777156f0..aa07a22dfe 100644 --- a/CBLAS/testing/din3 +++ b/CBLAS/testing/din3 @@ -11,9 +11,12 @@ T LOGICAL FLAG, T TO TEST ERROR EXITS. 0.0 1.0 0.7 VALUES OF ALPHA 3 NUMBER OF VALUES OF BETA 0.0 1.0 1.3 VALUES OF BETA -cblas_dgemm T PUT F FOR NO TEST. SAME COLUMNS. -cblas_dsymm T PUT F FOR NO TEST. SAME COLUMNS. -cblas_dtrmm T PUT F FOR NO TEST. SAME COLUMNS. -cblas_dtrsm T PUT F FOR NO TEST. SAME COLUMNS. -cblas_dsyrk T PUT F FOR NO TEST. SAME COLUMNS. -cblas_dsyr2k T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dgemm T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dsymm T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dskewsymm T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dtrmm T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dtrsm T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dsyrk T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dsyr2k T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dskewsyr2k T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dgemmtr T PUT F FOR NO TEST. SAME COLUMNS. diff --git a/CBLAS/testing/sin2 b/CBLAS/testing/sin2 index b5bb12d0e1..c8bfed20dd 100644 --- a/CBLAS/testing/sin2 +++ b/CBLAS/testing/sin2 @@ -15,19 +15,21 @@ T LOGICAL FLAG, T TO TEST ERROR EXITS. 0.0 1.0 0.7 VALUES OF ALPHA 3 NUMBER OF VALUES OF BETA 0.0 1.0 0.9 VALUES OF BETA -cblas_sgemv T PUT F FOR NO TEST. SAME COLUMNS. -cblas_sgbmv T PUT F FOR NO TEST. SAME COLUMNS. -cblas_ssymv T PUT F FOR NO TEST. SAME COLUMNS. -cblas_ssbmv T PUT F FOR NO TEST. SAME COLUMNS. -cblas_sspmv T PUT F FOR NO TEST. SAME COLUMNS. -cblas_strmv T PUT F FOR NO TEST. SAME COLUMNS. -cblas_stbmv T PUT F FOR NO TEST. SAME COLUMNS. -cblas_stpmv T PUT F FOR NO TEST. SAME COLUMNS. -cblas_strsv T PUT F FOR NO TEST. SAME COLUMNS. -cblas_stbsv T PUT F FOR NO TEST. SAME COLUMNS. -cblas_stpsv T PUT F FOR NO TEST. SAME COLUMNS. -cblas_sger T PUT F FOR NO TEST. SAME COLUMNS. -cblas_ssyr T PUT F FOR NO TEST. SAME COLUMNS. -cblas_sspr T PUT F FOR NO TEST. SAME COLUMNS. -cblas_ssyr2 T PUT F FOR NO TEST. SAME COLUMNS. -cblas_sspr2 T PUT F FOR NO TEST. SAME COLUMNS. +cblas_sgemv T PUT F FOR NO TEST. SAME COLUMNS. +cblas_sgbmv T PUT F FOR NO TEST. SAME COLUMNS. +cblas_ssymv T PUT F FOR NO TEST. SAME COLUMNS. +cblas_ssbmv T PUT F FOR NO TEST. SAME COLUMNS. +cblas_sspmv T PUT F FOR NO TEST. SAME COLUMNS. +cblas_sskewsymv T PUT F FOR NO TEST. SAME COLUMNS. +cblas_strmv T PUT F FOR NO TEST. SAME COLUMNS. +cblas_stbmv T PUT F FOR NO TEST. SAME COLUMNS. +cblas_stpmv T PUT F FOR NO TEST. SAME COLUMNS. +cblas_strsv T PUT F FOR NO TEST. SAME COLUMNS. +cblas_stbsv T PUT F FOR NO TEST. SAME COLUMNS. +cblas_stpsv T PUT F FOR NO TEST. SAME COLUMNS. +cblas_sger T PUT F FOR NO TEST. SAME COLUMNS. +cblas_ssyr T PUT F FOR NO TEST. SAME COLUMNS. +cblas_sspr T PUT F FOR NO TEST. SAME COLUMNS. +cblas_ssyr2 T PUT F FOR NO TEST. SAME COLUMNS. +cblas_sspr2 T PUT F FOR NO TEST. SAME COLUMNS. +cblas_sskewsyr2 T PUT F FOR NO TEST. SAME COLUMNS. diff --git a/CBLAS/testing/sin3 b/CBLAS/testing/sin3 index aa18530cb4..2311b2fa8f 100644 --- a/CBLAS/testing/sin3 +++ b/CBLAS/testing/sin3 @@ -11,9 +11,12 @@ T LOGICAL FLAG, T TO TEST ERROR EXITS. 0.0 1.0 0.7 VALUES OF ALPHA 3 NUMBER OF VALUES OF BETA 0.0 1.0 1.3 VALUES OF BETA -cblas_sgemm T PUT F FOR NO TEST. SAME COLUMNS. -cblas_ssymm T PUT F FOR NO TEST. SAME COLUMNS. -cblas_strmm T PUT F FOR NO TEST. SAME COLUMNS. -cblas_strsm T PUT F FOR NO TEST. SAME COLUMNS. -cblas_ssyrk T PUT F FOR NO TEST. SAME COLUMNS. -cblas_ssyr2k T PUT F FOR NO TEST. SAME COLUMNS. +cblas_sgemm T PUT F FOR NO TEST. SAME COLUMNS. +cblas_ssymm T PUT F FOR NO TEST. SAME COLUMNS. +cblas_sskewsymm T PUT F FOR NO TEST. SAME COLUMNS. +cblas_strmm T PUT F FOR NO TEST. SAME COLUMNS. +cblas_strsm T PUT F FOR NO TEST. SAME COLUMNS. +cblas_ssyrk T PUT F FOR NO TEST. SAME COLUMNS. +cblas_ssyr2k T PUT F FOR NO TEST. SAME COLUMNS. +cblas_sskewsyr2k T PUT F FOR NO TEST. SAME COLUMNS. +cblas_sgemmtr T PUT F FOR NO TEST. SAME COLUMNS. diff --git a/CBLAS/testing/zin3 b/CBLAS/testing/zin3 index 90a657592c..7e00e13ced 100644 --- a/CBLAS/testing/zin3 +++ b/CBLAS/testing/zin3 @@ -11,12 +11,13 @@ T LOGICAL FLAG, T TO TEST ERROR EXITS. (0.0,0.0) (1.0,0.0) (0.7,-0.9) VALUES OF ALPHA 3 NUMBER OF VALUES OF BETA (0.0,0.0) (1.0,0.0) (1.3,-1.1) VALUES OF BETA -cblas_zgemm T PUT F FOR NO TEST. SAME COLUMNS. -cblas_zhemm T PUT F FOR NO TEST. SAME COLUMNS. -cblas_zsymm T PUT F FOR NO TEST. SAME COLUMNS. -cblas_ztrmm T PUT F FOR NO TEST. SAME COLUMNS. -cblas_ztrsm T PUT F FOR NO TEST. SAME COLUMNS. -cblas_zherk T PUT F FOR NO TEST. SAME COLUMNS. -cblas_zsyrk T PUT F FOR NO TEST. SAME COLUMNS. -cblas_zher2k T PUT F FOR NO TEST. SAME COLUMNS. -cblas_zsyr2k T PUT F FOR NO TEST. SAME COLUMNS. +cblas_zgemm T PUT F FOR NO TEST. SAME COLUMNS. +cblas_zhemm T PUT F FOR NO TEST. SAME COLUMNS. +cblas_zsymm T PUT F FOR NO TEST. SAME COLUMNS. +cblas_ztrmm T PUT F FOR NO TEST. SAME COLUMNS. +cblas_ztrsm T PUT F FOR NO TEST. SAME COLUMNS. +cblas_zherk T PUT F FOR NO TEST. SAME COLUMNS. +cblas_zsyrk T PUT F FOR NO TEST. SAME COLUMNS. +cblas_zher2k T PUT F FOR NO TEST. SAME COLUMNS. +cblas_zsyr2k T PUT F FOR NO TEST. SAME COLUMNS. +cblas_zgemmtr T PUT F FOR NO TEST. SAME COLUMNS. diff --git a/CMAKE/CheckFortranTypeSizes.cmake b/CMAKE/CheckFortranTypeSizes.cmake index 585ca26e72..17c0df80e8 100644 --- a/CMAKE/CheckFortranTypeSizes.cmake +++ b/CMAKE/CheckFortranTypeSizes.cmake @@ -1,4 +1,4 @@ -# This module perdorms several try-compiles to determine the default integer +# This module performs several try-compiles to determine the default integer # size being used by the fortran compiler # # After execution, the following variables are set. If they are un set then diff --git a/CMAKE/CheckLAPACKCompilerFlags.cmake b/CMAKE/CheckLAPACKCompilerFlags.cmake index acc51629e9..70e52fd452 100644 --- a/CMAKE/CheckLAPACKCompilerFlags.cmake +++ b/CMAKE/CheckLAPACKCompilerFlags.cmake @@ -1,4 +1,4 @@ -# This module checks against various known compilers and thier respective +# This module checks against various known compilers and their respective # flags to determine any specific flags needing to be set. # # 1. If FPE traps are enabled either abort or disable them @@ -10,81 +10,255 @@ # Copyright 2011 #============================================================================= -macro( CheckLAPACKCompilerFlags ) +macro(CheckLAPACKCompilerFlags) -set( FPE_EXIT FALSE ) - -# GNU Fortran -if( CMAKE_Fortran_COMPILER_ID STREQUAL "GNU" ) - if( "${CMAKE_Fortran_FLAGS}" MATCHES "-ffpe-trap=[izoupd]") - set( FPE_EXIT TRUE ) + # FORTRAN ILP default + set(FOPT_ILP64) + if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") + if(WIN32) + set(FOPT_ILP64 /integer-size:64) + else() + set(FOPT_ILP64 "SHELL:-integer-size 64") + endif() + elseif((CMAKE_Fortran_COMPILER_ID STREQUAL "VisualAge") OR # CMake 2.6 + (CMAKE_Fortran_COMPILER_ID STREQUAL "XL")) # CMake 2.8 + set(FOPT_ILP64 -qintsize=8) + elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "NAG") + set(FOPT_ILP64 -i8) + elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "NVHPC") + if(WIN32) + set(FOPT_ILP64 /i8) + else() + set(FOPT_ILP64 -i8) + endif() + else() + set(CPE_ENV $ENV{PE_ENV}) + if(CPE_ENV STREQUAL "CRAY" AND NOT CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") + set(FOPT_ILP64 -sinteger64) + elseif(CPE_ENV STREQUAL "NVIDIA" AND NOT CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") + set(FOPT_ILP64 -i8) + else() + set(FOPT_ILP64 -fdefault-integer-8) + endif() endif() - -# Intel Fortran -elseif( CMAKE_Fortran_COMPILER_ID STREQUAL "Intel" ) - if( "${CMAKE_Fortran_FLAGS}" MATCHES "[-/]fpe(-all=|)0" ) - set( FPE_EXIT TRUE ) + if(FORTRAN_ILP) + add_compile_options("$<$:${FOPT_ILP64}>") endif() -# SunPro F95 -elseif( CMAKE_Fortran_COMPILER_ID STREQUAL "SunPro" ) - if( ("${CMAKE_Fortran_FLAGS}" MATCHES "-ftrap=") AND - NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "-ftrap=(%|)none") ) - set( FPE_EXIT TRUE ) - elseif( NOT (CMAKE_Fortran_FLAGS MATCHES "-ftrap=") ) - message( STATUS "Disabling FPE trap handlers with -ftrap=%none" ) - set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ftrap=%none" - CACHE STRING "Flags for Fortran compiler." FORCE ) - endif() + # GNU Fortran + if(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") + set(FPE_EXIT_FLAG "-ffpe-trap=[izoupd]") -# IBM XL Fortran -elseif( (CMAKE_Fortran_COMPILER_ID STREQUAL "VisualAge" ) OR # CMake 2.6 - (CMAKE_Fortran_COMPILER_ID STREQUAL "XL" ) ) # CMake 2.8 - if( "${CMAKE_Fortran_FLAGS}" MATCHES "-qflttrap=[a-zA-Z:]:enable" ) - set( FPE_EXIT TRUE ) - endif() + add_compile_options("$<$:-frecursive>") + + if(CMAKE_Fortran_COMPILER_VERSION VERSION_LESS "8") + add_compile_definitions("$<$:FORTRAN_STRLEN=int>") + set(FORTRAN_STRLEN_TYPE "int" CACHE INTERNAL "" FORCE) + endif() + + # Disabling loop vectorization for GNU Fortran versions affected by + # https://gcc.gnu.org/bugzilla/show_bug.cgi?id=122408. See issue + # https://github.com/Reference-LAPACK/lapack/issues/1160 as well. + if(CMAKE_HOST_SYSTEM_PROCESSOR MATCHES "arm|arm64|aarch64") + if((CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL "14.0" AND + CMAKE_Fortran_COMPILER_VERSION VERSION_LESS_EQUAL "14.4") OR + (CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL "15.0" AND + CMAKE_Fortran_COMPILER_VERSION VERSION_LESS_EQUAL "15.2")) + message(WARNING + "Disabling loop vectorization for GNU Fortran (14.0-14.4, 15.0-15.2) on ARM " + "due to a compiler bug (https://gcc.gnu.org/bugzilla/show_bug.cgi?id=122408). " + "For full performance, consider changing to a different compiler or compiler version.") + add_compile_options("$<$:-fno-tree-loop-vectorize>") + endif() + endif() + + # Intel Fortran + elseif(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") + set(FPE_EXIT_FLAG "[-/]fpe(-all=|)0") + + add_compile_options("$<$:-recursive>") + if(WIN32) + add_compile_options("$<$:/fp:strict>") + else() + add_compile_options("$<$:-fp-model=strict>") + endif() + + # disable: The Intel(R) Fortran Compiler Classic (ifort) is deprecated + if(CMAKE_Fortran_COMPILER_ID STREQUAL "Intel") + if(WIN32) + add_compile_options("$<$:/Qdiag-disable:10448>") + add_link_options("$<$:/Qdiag-disable:10448>") + + # Bad preprocessor line bogus warning + add_compile_options("$<$:/Qdiag-disable:5117>") + else() + add_compile_options("$<$:-diag-disable:10448>") + add_link_options("$<$:-diag-disable:10448>") + endif() + endif() + + # SunPro F95 + elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "SunPro") + set(FPE_EXIT_FLAG "-ftrap=") + set(FPE_DISABLE_FLAG "-ftrap=(%|)none") + + message(STATUS "Disabling FPE trap handlers with -ftrap=%none") + add_compile_options("$<$:-ftrap=%none>") + + if(UNIX) + # Delete libmtsk in linking sequence for Sun/Oracle Fortran Compiler. + # This library is not present in the Sun package SolarisStudio12.3-linux-x86-bin + string(REPLACE \;mtsk\; \; CMAKE_Fortran_IMPLICIT_LINK_LIBRARIES + "${CMAKE_Fortran_IMPLICIT_LINK_LIBRARIES}") + endif() + + # IBM XL Fortran + elseif((CMAKE_Fortran_COMPILER_ID STREQUAL "VisualAge") OR # CMake 2.6 + (CMAKE_Fortran_COMPILER_ID STREQUAL "XL")) # CMake 2.8 + set(FPE_EXIT_FLAG "-qflttrap=[a-zA-Z:]:enable") + + add_compile_options("$<$:-qrecur>") + if(UNIX) + add_compile_options("$<$:-qnosave>") + add_compile_options("$<$:-qstrict>") + endif() + + # HP Fortran + elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "HP") + set(FPE_EXIT_FLAG "\\+fp_exception") - if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "-qfixed") ) - message( STATUS "Enabling fixed format F90/F95 with -qfixed" ) - set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -qfixed" - CACHE STRING "Flags for Fortran compiler." FORCE ) + message(STATUS "Enabling strict float conversion with +fltconst_strict") + add_compile_options("$<$:+fltconst_strict>") + + # Most versions of cmake don't have good default options for the HP compiler + add_compile_options("$<$,$>:-g>") + add_compile_options("$<$,$>:+Osize>") + add_compile_options("$<$,$>:+O2>") + add_compile_options("$<$,$>:+O2 -g>") + + # NAG Fortran + elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "NAG") + set(FPE_EXIT_FLAG "[-/]ieee=(stop|nonstd)") + + add_compile_options("$<$:-ieee=full>") + add_compile_options("$<$:-dcfuns>") + add_compile_options("$<$:-thread_safe>") + add_link_options("$<$:-thread_safe>") + add_compile_options("$<$:-recursive>") + + # By default NAG Fortran uses 32bit integers as hidden STRLEN arguments + if(UNIX) + if(APPLE) + add_compile_definitions("$<$:FORTRAN_STRLEN=int>") + set(FORTRAN_STRLEN_TYPE "int" CACHE INTERNAL "" FORCE) + else() + # Get all flags added via `add_compile_options(...)` + get_directory_property(COMP_OPTIONS COMPILE_OPTIONS) + + if(NOT("${CMAKE_Fortran_FLAGS};${COMP_OPTIONS}" MATCHES "-abi=64c")) + add_compile_definitions("$<$:FORTRAN_STRLEN=int>") + set(FORTRAN_STRLEN_TYPE "int" CACHE INTERNAL "" FORCE) + endif() + endif() + endif() + + # Disable warnings + add_compile_options("$<$:-w=obs>") + add_compile_options("$<$:-w=x77>") + add_compile_options("$<$:-w=ques>") + add_compile_options("$<$:-w=unused>") + + # Suppress compiler banner and summary + include(CheckFortranCompilerFlag) + check_fortran_compiler_flag("-quiet" _quiet) + add_compile_options("$<$,$>:-quiet>") + add_link_options("$<$,$>:-quiet>") + + # NVIDIA HPC SDK + elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "NVHPC") + set(FPE_EXIT_FLAG "-Ktrap=") + set(FPE_DISABLE_FLAG "-Ktrap=none") + + add_compile_options("$<$:-Kieee>") + add_compile_options("$<$:-Mrecursive>") + + # Flang Fortran + elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "Flang") + add_compile_options("$<$:-Mrecursive>") + + # LLVM Flang + elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "LLVMFlang") + # Nothing to do here for now, but this is a placeholder for future + # LLVM Flang specific flags + + # Compaq Fortran + elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "Compaq") + if(WIN32) + if(CMAKE_GENERATOR STREQUAL "NMake Makefiles") + get_filename_component(CMAKE_Fortran_COMPILER_CMDNAM ${CMAKE_Fortran_COMPILER} NAME_WE) + message(STATUS "Using Compaq Fortran compiler with command name ${CMAKE_Fortran_COMPILER_CMDNAM}") + set(cmd ${CMAKE_Fortran_COMPILER_CMDNAM}) + string(TOLOWER "${cmd}" cmdlc) + if(cmdlc STREQUAL "df") + message(STATUS "Assume the Compaq Visual Fortran Compiler is being used") + set(CMAKE_Fortran_USE_RESPONSE_FILE_FOR_OBJECTS 1) + set(CMAKE_Fortran_USE_RESPONSE_FILE_FOR_INCLUDES 1) + #This is a workaround that is needed to avoid forward-slashes in the + #filenames listed in response files from incorrectly being interpreted as + #introducing compiler command options + if(${BUILD_SHARED_LIBS}) + message(FATAL_ERROR "Making of shared libraries with CVF has not been tested.") + endif() + set(str "NMake version 9 or later should be used. NMake version 6.0 which is\n") + set(str "${str} included with the CVF distribution fails to build Lapack because\n") + set(str "${str} the number of source files exceeds the limit for NMake v6.0\n") + message(STATUS ${str}) + set(CMAKE_Fortran_LINK_EXECUTABLE "LINK /out: ") + endif() + endif() + endif() + + else() + message(WARNING "Fortran local arrays should be allocated on the stack." + " Please use a compiler which guarantees that feature." + " See https://github.com/Reference-LAPACK/lapack/pull/188 and references therein.") endif() -# HP Fortran -elseif( CMAKE_Fortran_COMPILER_ID STREQUAL "HP" ) - if( "${CMAKE_Fortran_FLAGS}" MATCHES "\\+fp_exception" ) - set( FPE_EXIT TRUE ) + if(CMAKE_C_COMPILER_ID MATCHES "Intel") + if(WIN32) + add_compile_options("$<$:/fp:strict>") + else() + add_compile_options("$<$:-fp-model=strict>") + endif() + + # disable: The Intel(R) C++ Compiler Classic (ICC) is deprecated + if(CMAKE_C_COMPILER_ID STREQUAL "Intel") + if(WIN32) + add_compile_options("$<$:/Qdiag-disable:10441>") + add_link_options("$<$:/Qdiag-disable:10441>") + else() + add_compile_options("$<$:-diag-disable:10441>") + add_link_options("$<$:-diag-disable:10441>") + endif() + endif() endif() - if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "\\+fltconst_strict") ) - message( STATUS "Enabling strict float conversion with +fltconst_strict" ) - set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} +fltconst_strict" - CACHE STRING "Flags for Fortran compiler." FORCE ) + if("${CMAKE_Fortran_FLAGS_RELEASE}" MATCHES "O[3-9]") + message(STATUS "Reducing RELEASE optimization level to O2") + string(REGEX REPLACE "O[3-9]" "O2" CMAKE_Fortran_FLAGS_RELEASE + "${CMAKE_Fortran_FLAGS_RELEASE}") endif() - # Most versions of cmake don't have good default options for the HP compiler - set( CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -g" - CACHE STRING "Flags used by the compiler during debug builds" FORCE ) - set( CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_MINSIZEREL} +Osize" - CACHE STRING "Flags used by the compiler during release minsize builds" FORCE ) - set( CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_RELEASE} +O2" - CACHE STRING "Flags used by the compiler during release builds" FORCE ) - set( CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_RELWITHDEBINFO} +O2 -g" - CACHE STRING "Flags used by the compiler during release with debug info builds" FORCE ) -else() -endif() - -if( "${CMAKE_Fortran_FLAGS_RELEASE}" MATCHES "O[3-9]" ) - message( STATUS "Reducing RELEASE optimization level to O2" ) - string( REGEX REPLACE "O[3-9]" "O2" CMAKE_Fortran_FLAGS_RELEASE - "${CMAKE_Fortran_FLAGS_RELEASE}" ) - set( CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE}" - CACHE STRING "Flags used by the compiler during release builds" FORCE ) -endif() - - -if( FPE_EXIT ) - message( FATAL_ERROR "Floating Point Exception (FPE) trap handlers are currently explicitly enabled in the compiler flags. LAPACK is designed to check for and handle these cases internally and enabling these traps will likely cause LAPACK to crash. Please re-configure with floating point exception trapping disabled." ) -endif() + # Get all flags added via `add_compile_options(...)` + get_directory_property(COMP_OPTIONS COMPILE_OPTIONS) + + if(("${CMAKE_Fortran_FLAGS};${COMP_OPTIONS}" MATCHES "${FPE_EXIT_FLAG}") AND NOT + ("${CMAKE_Fortran_FLAGS};${COMP_OPTIONS}" MATCHES "${FPE_DISABLE_FLAG}")) + message( FATAL_ERROR "Floating Point Exception (FPE) trap handlers are" + " currently explicitly enabled in the compiler flags. LAPACK is designed" + " to check for and handle these cases internally and enabling these traps" + " will likely cause LAPACK to crash. Please re-configure with floating" + " point exception trapping disabled.") + endif() endmacro() diff --git a/CMAKE/CheckTimeFunction.cmake b/CMAKE/CheckTimeFunction.cmake index b57394887c..2399684fc1 100644 --- a/CMAKE/CheckTimeFunction.cmake +++ b/CMAKE/CheckTimeFunction.cmake @@ -7,22 +7,25 @@ macro(CHECK_TIME_FUNCTION FUNCTION VARIABLE) - try_compile(RES + try_compile(RES ${PROJECT_BINARY_DIR}/INSTALL ${PROJECT_SOURCE_DIR}/INSTALL TIMING secondtst_${FUNCTION} + CMAKE_FLAGS + -DCMAKE_OSX_DEPLOYMENT_TARGET:STRING=${CMAKE_OSX_DEPLOYMENT_TARGET} + -DCMAKE_Fortran_FLAGS:STRING=${CMAKE_Fortran_FLAGS} + -DCMAKE_EXE_LINKER_FLAGS:STRING=${CMAKE_EXE_LINKER_FLAGS} + -DCMAKE_VERBOSE_MAKEFILE=ON OUTPUT_VARIABLE OUTPUT) - if(RES) - set(${VARIABLE} ${FUNCTION} CACHE INTERNAL "Have Fortran function ${FUNCTION}") - message(STATUS "Looking for Fortran ${FUNCTION} - found") - file(APPEND ${CMAKE_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeOutput.log - "Fortran ${FUNCTION} exists. ${OUTPUT} \n\n") - else() - message(STATUS "Looking for Fortran ${FUNCTION} - not found") - file(APPEND ${CMAKE_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeError.log - "Fortran ${FUNCTION} does not exist. \n ${OUTPUT} \n") - endif() + if(RES) + set(${VARIABLE} ${FUNCTION} CACHE INTERNAL "Have Fortran function ${FUNCTION}") + message(STATUS "Looking for Fortran ${FUNCTION} - found") + file(APPEND ${CMAKE_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeOutput.log + "Fortran ${FUNCTION} exists. ${OUTPUT} \n\n") + else() + message(STATUS "Looking for Fortran ${FUNCTION} - not found") + file(APPEND ${CMAKE_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeError.log + "Fortran ${FUNCTION} does not exist. \n ${OUTPUT} \n") + endif() endmacro() - - diff --git a/CMAKE/ExtendedAPIHelpers.cmake b/CMAKE/ExtendedAPIHelpers.cmake new file mode 100644 index 0000000000..8ddb98d8dc --- /dev/null +++ b/CMAKE/ExtendedAPIHelpers.cmake @@ -0,0 +1,113 @@ +include_guard(GLOBAL) + +set(EXTENDED_API_GENERATOR + "${CMAKE_CURRENT_LIST_DIR}/GenerateSuffixedSource.cmake" CACHE INTERNAL + "Script that generates suffixed sources for extended APIs") + +if(BUILD_INDEX64_EXT_API) + add_custom_target(64bit_codegen ALL + COMMENT "Generating 64-bit suffixed sources for extended API") +endif() + +# Generate suffixed sources for an extended API. The generation happens at +# build time in the GenerateSuffixedSource.cmake script. Arguments: +# SUFFIX -- suffix appended to symbols and file names +# (required) +# SYMBOL_ALLOWLIST ... -- only rename the listed symbols +# (case-insensitive); by default every symbol +# defined in the sources is renamed +# NO_STRING_REPLACEMENTS -- do not rename symbols inside string literals +function(generate_suffixed_sources target source_list generated_sources) + set(options NO_STRING_REPLACEMENTS) + set(oneValueArgs SUFFIX) + set(multiValueArgs SYMBOL_ALLOWLIST) + cmake_parse_arguments(PARSE_ARGV 3 extended_api "${options}" "${oneValueArgs}" "${multiValueArgs}") + + if(NOT DEFINED extended_api_SUFFIX) + message(FATAL_ERROR "generate_suffixed_sources: SUFFIX is required") + endif() + + get_filename_component(destination "${target}${extended_api_SUFFIX}_sources" ABSOLUTE BASE_DIR "${CMAKE_CURRENT_BINARY_DIR}") + get_property(_generated_suffixed_source_files GLOBAL PROPERTY EXTENDED_API_GENERATED_SOURCE_FILES) + set(new_generated_source_files) + set(generated_source_files) + + foreach(_source IN LISTS ${source_list}) + get_filename_component(source_abs "${_source}" ABSOLUTE BASE_DIR "${CMAKE_CURRENT_SOURCE_DIR}") + get_filename_component(source_name "${_source}" NAME_WLE) + get_filename_component(source_ext "${_source}" EXT) + set(output_file "${destination}/${source_name}${extended_api_SUFFIX}${source_ext}") + + set(_fortran_extensions ".f" ".F" ".f90" ".F90") + if(NOT source_ext IN_LIST _fortran_extensions) + message(WARNING "Skipping non-Fortran source '${_source}' for target '${target}'") + continue() + endif() + + # Make sure we only have one custom command generating a given output file + if(NOT "${output_file}" IN_LIST _generated_suffixed_source_files) + set(generator_args + "-DINPUT_FILE=${source_abs}" + "-DOUTPUT_FILE=${output_file}" + "-DSUFFIX=${extended_api_SUFFIX}") + if(extended_api_NO_STRING_REPLACEMENTS) + list(APPEND generator_args "-DREPLACE_IN_STRINGS=OFF") + endif() + if(DEFINED extended_api_SYMBOL_ALLOWLIST) + # Join with $ so that the allowlist stays one -D argument + # on the command line but still reaches the script as a CMake list. + # An allowlist change re-runs the generation (the command changes). + list(JOIN extended_api_SYMBOL_ALLOWLIST "$" _symbol_allowlist) + list(APPEND generator_args "-DSYMBOL_ALLOWLIST=${_symbol_allowlist}") + endif() + + add_custom_command( + OUTPUT "${output_file}" + COMMAND + "${CMAKE_COMMAND}" + ${generator_args} + -P "${EXTENDED_API_GENERATOR}" + DEPENDS + "${source_abs}" + "${EXTENDED_API_GENERATOR}" + COMMENT "Generating ${extended_api_SUFFIX} extended API source for ${_source}" + VERBATIM) + + list(APPEND new_generated_source_files "${output_file}") + endif() + + list(APPEND generated_source_files "${output_file}") + endforeach() + + # Make sure each generated source file is only part of one target to + # avoid multiple targets trying to generate the same file + if(new_generated_source_files) + add_custom_target("${target}${extended_api_SUFFIX}_codegen" ALL + DEPENDS ${new_generated_source_files} + COMMENT "Generating ${extended_api_SUFFIX} suffixed sources for target ${target}") + if(extended_api_SUFFIX STREQUAL "_64" AND TARGET 64bit_codegen) + add_dependencies(64bit_codegen "${target}${extended_api_SUFFIX}_codegen") + endif() + + set_property(GLOBAL APPEND PROPERTY EXTENDED_API_GENERATED_SOURCE_FILES ${new_generated_source_files}) + endif() + + set(${generated_sources} ${generated_source_files} PARENT_SCOPE) +endfunction() + +# Generate 64-bit suffixed sources for the extended API. Kept as a thin +# wrapper around generate_suffixed_sources for the Index-64 extended API. +function(generate_64bit_suffixed_sources target source_list generated_sources) + set(options NO_STRING_REPLACEMENTS) + cmake_parse_arguments(PARSE_ARGV 3 extended_api "${options}" "" "") + + set(_forwarded_options) + if(extended_api_NO_STRING_REPLACEMENTS) + list(APPEND _forwarded_options NO_STRING_REPLACEMENTS) + endif() + + generate_suffixed_sources("${target}" "${source_list}" _generated_source_files + SUFFIX "_64" ${_forwarded_options}) + + set(${generated_sources} ${_generated_source_files} PARENT_SCOPE) +endfunction() diff --git a/CMAKE/FindGcov.cmake b/CMAKE/FindGcov.cmake index 4807f903ec..725c5d1947 100644 --- a/CMAKE/FindGcov.cmake +++ b/CMAKE/FindGcov.cmake @@ -20,7 +20,7 @@ set(CMAKE_REQUIRED_QUIET ${codecov_FIND_QUIETLY}) get_property(ENABLED_LANGUAGES GLOBAL PROPERTY ENABLED_LANGUAGES) foreach (LANG ${ENABLED_LANGUAGES}) - # Gcov evaluation is dependend on the used compiler. Check gcov support for + # Gcov evaluation is dependent on the used compiler. Check gcov support for # each compiler that is used. If gcov binary was already found for this # compiler, do not try to find it again. if(NOT GCOV_${CMAKE_${LANG}_COMPILER_ID}_BIN) @@ -107,38 +107,40 @@ function (add_gcov_target TNAME) # We don't have to check, if the target has support for coverage, thus this # will be checked by add_coverage_target in Findcoverage.cmake. Instead we - # have to determine which gcov binary to use. + # have to determine which gcov binary to use. A target may mix languages + # built by different compilers, so this is decided per source file. get_target_property(TSOURCES ${TNAME} SOURCES) - set(SOURCES "") - set(TCOMPILER "") - foreach (FILE ${TSOURCES}) - codecov_path_of_source(${FILE} FILE) - if(NOT "${FILE}" STREQUAL "") - codecov_lang_of_source(${FILE} LANG) - if(NOT "${LANG}" STREQUAL "") - list(APPEND SOURCES "${FILE}") - set(TCOMPILER ${CMAKE_${LANG}_COMPILER_ID}) - endif() + set(BUFFER "") + foreach(FILE IN LISTS TSOURCES) + codecov_path_of_source("${FILE}" FILE) + if(FILE STREQUAL "") + continue() endif() - endforeach() - # If no gcov binary was found, coverage data can't be evaluated. - if(NOT GCOV_${TCOMPILER}_BIN) - message(WARNING "No coverage evaluation binary found for ${TCOMPILER}.") - return() - endif() + codecov_lang_of_source("${FILE}" LANG) + if(LANG STREQUAL "") + continue() + endif() - set(GCOV_BIN "${GCOV_${TCOMPILER}_BIN}") - set(GCOV_ENV "${GCOV_${TCOMPILER}_ENV}") + # If no gcov binary was found, coverage data can't be evaluated. + set(TCOMPILER ${CMAKE_${LANG}_COMPILER_ID}) + if(NOT GCOV_${TCOMPILER}_BIN) + message(WARNING "No coverage evaluation binary found for ${TCOMPILER}.") + return() + endif() + set(GCOV_BIN "${GCOV_${TCOMPILER}_BIN}") + set(GCOV_ENV "${GCOV_${TCOMPILER}_ENV}") - set(BUFFER "") - foreach(FILE ${SOURCES}) get_filename_component(FILE_PATH "${TDIR}/${FILE}" PATH) # call gcov + # + # -b records branch frequencies, -c reports them as counts rather than + # percentages. Without -b the report carries line counts only, and both + # the summary below and Codecov have no branch coverage to work with. add_custom_command(OUTPUT ${TDIR}/${FILE}.gcov - COMMAND ${GCOV_ENV} ${GCOV_BIN} ${TDIR}/${FILE}.gcno > /dev/null + COMMAND ${GCOV_ENV} ${GCOV_BIN} -b -c ${TDIR}/${FILE}.gcno > /dev/null DEPENDS ${TNAME} ${TDIR}/${FILE}.gcno WORKING_DIRECTORY ${FILE_PATH} ) @@ -146,6 +148,11 @@ function (add_gcov_target TNAME) list(APPEND BUFFER ${TDIR}/${FILE}.gcov) endforeach() + # Targets assembled purely from $ compile nothing of + # their own; their coverage data is evaluated with the object libraries. + if(NOT BUFFER) + return() + endif() # add target for gcov evaluation of add_custom_target(${TNAME}-gcov DEPENDS ${BUFFER}) diff --git a/CMAKE/Findcodecov.cmake b/CMAKE/Findcodecov.cmake index 1f33b2c093..1992b9a632 100644 --- a/CMAKE/Findcodecov.cmake +++ b/CMAKE/Findcodecov.cmake @@ -10,6 +10,10 @@ # Written by Alexander Haase, alexander.haase@rwth-aachen.de # Updated by Guillaume Jacquenot, guillaume.jacquenot@gmail.com +include(CheckCCompilerFlag) +include(CheckCXXCompilerFlag) +include(CheckFortranCompilerFlag) + set(COVERAGE_FLAG_CANDIDATES # gcc and clang "-O0 -g -fprofile-arcs -ftest-coverage" @@ -18,90 +22,81 @@ set(COVERAGE_FLAG_CANDIDATES "-O0 -g --coverage" ) +# The languages this module knows how to probe for coverage flags. +set(COVERAGE_LANGUAGES C CXX Fortran) -# To avoid error messages about CMP0051, this policy will be set to new. There -# will be no problem, as TARGET_OBJECTS generator expressions will be filtered -# with a regular expression from the sources. -if(POLICY CMP0051) - cmake_policy(SET CMP0051 NEW) -endif() +# Find the coverage flags for language ${LANG} and cache them in +# COVERAGE__FLAGS. Coverage flags are not dependent on the +# language, but on the compiler, so languages sharing a compiler are probed +# only once. A language may be enabled after this module has been found, so +# this is called again from add_coverage_target() rather than only here. +function(codecov_find_flags LANG) + set(COMPILER ${CMAKE_${LANG}_COMPILER_ID}) + if(NOT COMPILER OR DEFINED CACHE{COVERAGE_${COMPILER}_FLAGS}) + return() + endif() -# Add coverage support for target ${TNAME} and register target for coverage -# evaluation. -function(add_coverage TNAME) - foreach (TNAME ${ARGV}) - add_coverage_target(${TNAME}) + set(CMAKE_REQUIRED_QUIET ${codecov_FIND_QUIETLY}) + + foreach(FLAG IN LISTS COVERAGE_FLAG_CANDIDATES) + if(NOT CMAKE_REQUIRED_QUIET) + message(STATUS "Try ${COMPILER} code coverage flag = [${FLAG}]") + endif() + + set(CMAKE_REQUIRED_FLAGS "${FLAG}") + unset(COVERAGE_FLAG_DETECTED CACHE) + + if(LANG STREQUAL "C") + check_c_compiler_flag("${FLAG}" COVERAGE_FLAG_DETECTED) + elseif(LANG STREQUAL "CXX") + check_cxx_compiler_flag("${FLAG}" COVERAGE_FLAG_DETECTED) + elseif(LANG STREQUAL "Fortran") + check_fortran_compiler_flag("${FLAG}" COVERAGE_FLAG_DETECTED) + endif() + + if(COVERAGE_FLAG_DETECTED) + # Cache the flags as a list, so they can be handed to + # target_compile_options() and target_link_options() unmodified. + string(REPLACE " " ";" FLAG_LIST "${FLAG}") + set(COVERAGE_${COMPILER}_FLAGS "${FLAG_LIST}" + CACHE STRING "${COMPILER} flags for code coverage.") + mark_as_advanced(COVERAGE_${COMPILER}_FLAGS) + return() + endif() endforeach() -endfunction() + # Remember that this compiler has no usable coverage flags, so that it is not + # probed again for every target. + set(COVERAGE_${COMPILER}_FLAGS "COVERAGE_${COMPILER}_FLAGS-NOTFOUND" + CACHE STRING "${COMPILER} flags for code coverage.") + mark_as_advanced(COVERAGE_${COMPILER}_FLAGS) +endfunction() -# Find the reuired flags foreach language. -set(CMAKE_REQUIRED_QUIET_SAVE ${CMAKE_REQUIRED_QUIET}) -set(CMAKE_REQUIRED_QUIET ${codecov_FIND_QUIETLY}) +# Probe the languages that are already enabled, so that the check appears in +# the configure output next to the other compiler checks. get_property(ENABLED_LANGUAGES GLOBAL PROPERTY ENABLED_LANGUAGES) -foreach (LANG ${ENABLED_LANGUAGES}) - # Coverage flags are not dependend on language, but the used compiler. So - # instead of searching flags foreach language, search flags foreach compiler - # used. - set(COMPILER ${CMAKE_${LANG}_COMPILER_ID}) - if(NOT COVERAGE_${COMPILER}_FLAGS) - foreach (FLAG ${COVERAGE_FLAG_CANDIDATES}) - if(NOT CMAKE_REQUIRED_QUIET) - message(STATUS "Try ${COMPILER} code coverage flag = [${FLAG}]") - endif() - - set(CMAKE_REQUIRED_FLAGS "${FLAG}") - unset(COVERAGE_FLAG_DETECTED CACHE) - - if(${LANG} STREQUAL "C") - include(CheckCCompilerFlag) - check_c_compiler_flag("${FLAG}" COVERAGE_FLAG_DETECTED) - - elseif(${LANG} STREQUAL "CXX") - include(CheckCXXCompilerFlag) - check_cxx_compiler_flag("${FLAG}" COVERAGE_FLAG_DETECTED) - - elseif(${LANG} STREQUAL "Fortran") - # CheckFortranCompilerFlag was introduced in CMake 3.x. To be - # compatible with older Cmake versions, we will check if this - # module is present before we use it. Otherwise we will define - # Fortran coverage support as not available. - include(CheckFortranCompilerFlag OPTIONAL - RESULT_VARIABLE INCLUDED) - if(INCLUDED) - check_fortran_compiler_flag("${FLAG}" - COVERAGE_FLAG_DETECTED) - elseif(NOT CMAKE_REQUIRED_QUIET) - message("-- Performing Test COVERAGE_FLAG_DETECTED") - message("-- Performing Test COVERAGE_FLAG_DETECTED - Failed" - " (Check not supported)") - endif() - endif() - - if(COVERAGE_FLAG_DETECTED) - set(COVERAGE_${COMPILER}_FLAGS "${FLAG}" - CACHE STRING "${COMPILER} flags for code coverage.") - mark_as_advanced(COVERAGE_${COMPILER}_FLAGS) - break() - endif() - endforeach() +foreach(LANG IN LISTS ENABLED_LANGUAGES) + if(LANG IN_LIST COVERAGE_LANGUAGES) + codecov_find_flags(${LANG}) endif() endforeach() -set(CMAKE_REQUIRED_QUIET ${CMAKE_REQUIRED_QUIET_SAVE}) # Helper function to get the language of a source file. -function (codecov_lang_of_source FILE RETURN_VAR) +function(codecov_lang_of_source FILE RETURN_VAR) get_filename_component(FILE_EXT "${FILE}" EXT) string(TOLOWER "${FILE_EXT}" FILE_EXT) + if(FILE_EXT STREQUAL "") + set(${RETURN_VAR} "" PARENT_SCOPE) + return() + endif() string(SUBSTRING "${FILE_EXT}" 1 -1 FILE_EXT) get_property(ENABLED_LANGUAGES GLOBAL PROPERTY ENABLED_LANGUAGES) - foreach (LANG ${ENABLED_LANGUAGES}) - list(FIND CMAKE_${LANG}_SOURCE_FILE_EXTENSIONS "${FILE_EXT}" TEMP) - if(NOT ${TEMP} EQUAL -1) + foreach(LANG IN LISTS ENABLED_LANGUAGES) + if(FILE_EXT IN_LIST CMAKE_${LANG}_SOURCE_FILE_EXTENSIONS) set(${RETURN_VAR} "${LANG}" PARENT_SCOPE) return() endif() @@ -110,17 +105,19 @@ function (codecov_lang_of_source FILE RETURN_VAR) set(${RETURN_VAR} "" PARENT_SCOPE) endfunction() + # Helper function to get the relative path of the source file destination path. # This path is needed by FindGcov and FindLcov cmake files to locate the # captured data. -function (codecov_path_of_source FILE RETURN_VAR) - string(REGEX MATCH "TARGET_OBJECTS:([^ >]+)" _source ${FILE}) - - # If expression was found, SOURCEFILE is a generator-expression for an - # object library. Currently we found no way to call this function automatic - # for the referenced target, so it must be called in the directoryso of the - # object library definition. - if(NOT "${_source}" STREQUAL "") +function(codecov_path_of_source FILE RETURN_VAR) + # Generator expressions cannot be resolved to a path here, so they have no + # coverage data of their own. In particular a $ source + # belongs to an object library and is evaluated together with that library. + # Note that a conditional such as + # $<$: $> + # reaches us split at the whitespace, so only one of its fragments mentions + # TARGET_OBJECTS; skip anything that looks like a generator expression. + if(FILE MATCHES "\\$<") set(${RETURN_VAR} "" PARENT_SCOPE) return() endif() @@ -139,64 +136,65 @@ endfunction() # Add coverage support for target ${TNAME} and register target for coverage # evaluation. function(add_coverage_target TNAME) - # Check if all sources for target use the same compiler. If a target uses - # e.g. C and Fortran mixed and uses different compilers (e.g. clang and - # gfortran) this can trigger huge problems, because different compilers may - # use different implementations for code coverage. - get_target_property(TSOURCES ${TNAME} SOURCES) - set(TARGET_COMPILER "") - set(ADDITIONAL_FILES "") - foreach (FILE ${TSOURCES}) - # If expression was found, FILE is a generator-expression for an object - # library. Object libraries will be ignored. - string(REGEX MATCH "TARGET_OBJECTS:([^ >]+)" _file ${FILE}) - if("${_file}" STREQUAL "") - codecov_lang_of_source(${FILE} LANG) - if(LANG) - list(APPEND TARGET_COMPILER ${CMAKE_${LANG}_COMPILER_ID}) - - list(APPEND ADDITIONAL_FILES "${FILE}.gcno") - list(APPEND ADDITIONAL_FILES "${FILE}.gcda") - endif() + # A target may mix languages that are built by different compilers, which may + # use incompatible coverage implementations. Guard each compiler's flags with + # the language they were detected for, so that every source is compiled with + # the flags of the compiler that actually builds it. + set(COMPILE_OPTIONS "") + set(LINK_OPTIONS "") + foreach(LANG IN LISTS COVERAGE_LANGUAGES) + codecov_find_flags(${LANG}) + + set(FLAGS "${COVERAGE_${CMAKE_${LANG}_COMPILER_ID}_FLAGS}") + if(FLAGS) + list(APPEND COMPILE_OPTIONS "$<$:${FLAGS}>") + list(APPEND LINK_OPTIONS "$<$:${FLAGS}>") endif() - endforeach () - - list(REMOVE_DUPLICATES TARGET_COMPILER) - list(LENGTH TARGET_COMPILER NUM_COMPILERS) - - if(NUM_COMPILERS GREATER 1) - message(AUTHOR_WARNING "Coverage disabled for target ${TNAME} because " - "it will be compiled by different compilers.") - return() + endforeach() - elseif((NUM_COMPILERS EQUAL 0) OR - (NOT DEFINED "COVERAGE_${TARGET_COMPILER}_FLAGS")) - message(AUTHOR_WARNING "Coverage disabled for target ${TNAME} " - "because there is no sanitizer available for target sources.") + if(NOT COMPILE_OPTIONS) + message(AUTHOR_WARNING "Coverage disabled for target ${TNAME} because no " + "coverage flags are available for any enabled language.") return() endif() - # enable coverage for target - set_property(TARGET ${TNAME} APPEND_STRING - PROPERTY COMPILE_FLAGS " ${COVERAGE_${TARGET_COMPILER}_FLAGS}") - set_property(TARGET ${TNAME} APPEND_STRING - PROPERTY LINK_FLAGS " ${COVERAGE_${TARGET_COMPILER}_FLAGS}") + target_compile_options(${TNAME} PRIVATE ${COMPILE_OPTIONS}) + target_link_options(${TNAME} PRIVATE ${LINK_OPTIONS}) # Add gcov files generated by compiler to clean target. + get_target_property(TSOURCES ${TNAME} SOURCES) set(CLEAN_FILES "") - foreach (FILE ${ADDITIONAL_FILES}) - codecov_path_of_source(${FILE} FILE) - list(APPEND CLEAN_FILES "CMakeFiles/${TNAME}.dir/${FILE}") + foreach(FILE IN LISTS TSOURCES) + codecov_path_of_source("${FILE}" FILE) + if(FILE STREQUAL "") + continue() + endif() + + codecov_lang_of_source("${FILE}" LANG) + if(LANG) + list(APPEND CLEAN_FILES + "CMakeFiles/${TNAME}.dir/${FILE}.gcno" + "CMakeFiles/${TNAME}.dir/${FILE}.gcda") + endif() endforeach() - set_directory_properties(PROPERTIES ADDITIONAL_MAKE_CLEAN_FILES - "${CLEAN_FILES}") + set_property(DIRECTORY APPEND PROPERTY ADDITIONAL_CLEAN_FILES ${CLEAN_FILES}) add_gcov_target(${TNAME}) endfunction() + +# Add coverage support for target ${TNAME} and register target for coverage +# evaluation. +function(add_coverage TNAME) + foreach(T IN LISTS ARGV) + add_coverage_target(${T}) + endforeach() +endfunction() + + # Include modules for parsing the collected data and output it in a readable # format (like gcov). find_package(Gcov) diff --git a/CMAKE/FortranMangling.cmake b/CMAKE/FortranMangling.cmake index d772dc9bba..734ab6f4cf 100644 --- a/CMAKE/FortranMangling.cmake +++ b/CMAKE/FortranMangling.cmake @@ -24,7 +24,7 @@ message(STATUS "=========") set(F77_OUTPUT_EXE "/Fe" CACHE INTERNAL "Fortran compiler option for setting executable file name.") else() - # in other case, let user specify their fortran configrations. + # in other case, let user specify their fortran configurations. set(F77_OPTION_COMPILE "-c" CACHE STRING "Fortran compiler option for compiling without linking.") set(F77_OUTPUT_OBJ "-o" CACHE STRING diff --git a/CMAKE/GenerateSuffixedSource.cmake b/CMAKE/GenerateSuffixedSource.cmake new file mode 100644 index 0000000000..c343244fb9 --- /dev/null +++ b/CMAKE/GenerateSuffixedSource.cmake @@ -0,0 +1,447 @@ +if(NOT DEFINED INPUT_FILE) + message(FATAL_ERROR "INPUT_FILE must be set") +endif() + +if(NOT DEFINED OUTPUT_FILE) + message(FATAL_ERROR "OUTPUT_FILE must be set") +endif() + +if(NOT DEFINED REPLACE_IN_STRINGS) + set(REPLACE_IN_STRINGS ON) +endif() + +if(NOT DEFINED SUFFIX) + message(FATAL_ERROR "SUFFIX must be set") +endif() + +# Optional allowlist: if given, only the listed symbols (case-insensitive) +# are suffixed. Used to route a subset of the routines to alternative +# implementations (e.g. LAPACKE test wrappers) while all other references +# keep resolving to their default implementation. +if(DEFINED SYMBOL_ALLOWLIST) + set(_symbol_allowlist) + foreach(_allowlist_entry IN LISTS SYMBOL_ALLOWLIST) + string(TOLOWER "${_allowlist_entry}" _allowlist_entry) + list(APPEND _symbol_allowlist "${_allowlist_entry}") + endforeach() +endif() + +# Check whether the input file is fixed or free form based on its extension. +get_filename_component(input_extension "${INPUT_FILE}" LAST_EXT) +string(TOLOWER "${input_extension}" input_extension_lower) +if(input_extension_lower MATCHES "^\\.f(90|95|03|08)$") + set(_source_is_free_form TRUE) +else() + set(_source_is_free_form FALSE) +endif() + +# Check if line is a comment line based on the form of the Fortran source. +function(_is_fortran_comment_line line result) + if(_source_is_free_form) + if("${line}" MATCHES "^[ \t]*!") + set(${result} TRUE PARENT_SCOPE) + else() + set(${result} FALSE PARENT_SCOPE) + endif() + elseif("${line}" MATCHES "^[cC\\*!]" OR "${line}" MATCHES "^[ \t]*!") + set(${result} TRUE PARENT_SCOPE) + else() + set(${result} FALSE PARENT_SCOPE) + endif() +endfunction() + +# Check if the line is a fixed-form continuation line. +function(_is_fixed_form_continuation_line line result) + if(_source_is_free_form) + set(${result} FALSE PARENT_SCOPE) + return() + endif() + + string(LENGTH "${line}" line_length) + if(line_length GREATER 5) + string(SUBSTRING "${line}" 5 1 continuation_char) + if(NOT continuation_char STREQUAL " " AND NOT continuation_char STREQUAL "0") + set(${result} TRUE PARENT_SCOPE) + return() + endif() + endif() + + set(${result} FALSE PARENT_SCOPE) +endfunction() + +# Check if the line ends with a free-form continuation character. +function(_has_trailing_free_form_continuation line result) + if("${line}" MATCHES "&[ \t]*$") + set(${result} TRUE PARENT_SCOPE) + else() + set(${result} FALSE PARENT_SCOPE) + endif() +endfunction() + +# Remove leading and trailing continuation characters and whitespace +function(_normalize_fortran_statement_fragment line result) + if(_source_is_free_form) + string(REGEX REPLACE "^[ \t]*&[ \t]*" "" fragment "${line}") + string(REGEX REPLACE "[ \t]*&[ \t]*$" "" fragment "${fragment}") + else() + string(LENGTH "${line}" line_length) + if(line_length GREATER 5) + string(SUBSTRING "${line}" 6 -1 fragment) + endif() + endif() + + set(${result} "${fragment}" PARENT_SCOPE) +endfunction() + +# Pop one physical source line from a newline-delimited string. Do not use a +# CMake list here: source comments may contain unmatched brackets, which changes +# how list semicolons are interpreted. +macro(_pop_source_line remaining_source line result) + if("${${remaining_source}}" STREQUAL "") + set(${line} "") + set(${result} FALSE) + else() + string(FIND "${${remaining_source}}" "\n" _source_line_newline_index) + if(_source_line_newline_index EQUAL -1) + set(${line} "${${remaining_source}}") + set(${remaining_source} "") + else() + string(SUBSTRING "${${remaining_source}}" 0 + ${_source_line_newline_index} ${line}) + math(EXPR _source_line_next_index + "${_source_line_newline_index} + 1") + string(SUBSTRING "${${remaining_source}}" + ${_source_line_next_index} -1 ${remaining_source}) + endif() + set(${result} TRUE) + endif() +endmacro() + +# Peek at the next physical line without consuming it. +macro(_peek_source_line remaining_source line result) + if("${${remaining_source}}" STREQUAL "") + set(${line} "") + set(${result} FALSE) + else() + string(FIND "${${remaining_source}}" "\n" _source_line_newline_index) + if(_source_line_newline_index EQUAL -1) + set(${line} "${${remaining_source}}") + else() + string(SUBSTRING "${${remaining_source}}" 0 + ${_source_line_newline_index} ${line}) + endif() + set(${result} TRUE) + endif() +endmacro() + +# Extract function/subroutine names from one logical Fortran statement. +function(_extract_symbols statement_text result) + set(symbols) + + if("${statement_text}" MATCHES "(external|EXTERNAL)") + string(REGEX REPLACE + "^.*(external|EXTERNAL)[ \t]*(::)?[ \t]*" "" + external_names "${statement_text}") + string(REGEX REPLACE "^[ \t]*::[ \t]*" "" external_names "${external_names}") + string(REPLACE "," ";" external_names "${external_names}") + foreach(external_name IN LISTS external_names) + string(STRIP "${external_name}" external_name) + if(NOT external_name STREQUAL "") + list(APPEND symbols "${external_name}") + endif() + endforeach() + elseif("${statement_text}" MATCHES "(subroutine|SUBROUTINE|function|FUNCTION)") + string(REGEX REPLACE + "^[a-zA-Z0-9_ *]*(subroutine|SUBROUTINE|function|FUNCTION)[ ]*" "" + symbol_name "${statement_text}") + string(REGEX REPLACE "[(].*$" "" symbol_name "${symbol_name}") + string(STRIP "${symbol_name}" symbol_name) + if(NOT symbol_name STREQUAL "") + list(APPEND symbols "${symbol_name}") + endif() + endif() + + set(${result} ${symbols} PARENT_SCOPE) +endfunction() + +# Find a safe fixed-form split point at or before the 72-column limit. +function(_find_fixed_form_split line result) + set(split_pos -1) + set(space_pos -1) + set(index 71) + + while(index GREATER 6) + string(SUBSTRING "${line}" ${index} 1 current_char) + if(current_char STREQUAL ",") + math(EXPR split_pos "${index} + 1") + break() + elseif(space_pos LESS 0 AND current_char MATCHES "[ \t]") + set(space_pos ${index}) + endif() + math(EXPR index "${index} - 1") + endwhile() + + if(split_pos LESS 0 AND NOT space_pos LESS 0) + set(split_pos ${space_pos}) + endif() + + set(${result} ${split_pos} PARENT_SCOPE) +endfunction() + +# Wrap one fixed-form physical line so generated sources remain valid with the +# standard 72-column statement field. +function(_wrap_fixed_form_line line result) + _is_fortran_comment_line("${line}" is_comment_line) + if(is_comment_line OR "${line}" MATCHES "^#") + set(${result} "${line}" PARENT_SCOPE) + return() + endif() + + set(wrapped_line "") + set(current_line "${line}") + + while(1) + string(LENGTH "${current_line}" line_length) + if(NOT line_length GREATER 72) + if(wrapped_line STREQUAL "") + set(wrapped_line "${current_line}") + else() + string(APPEND wrapped_line "\n${current_line}") + endif() + break() + endif() + + _find_fixed_form_split("${current_line}" split_pos) + if(NOT split_pos GREATER 6) + if(wrapped_line STREQUAL "") + set(wrapped_line "${current_line}") + else() + string(APPEND wrapped_line "\n${current_line}") + endif() + break() + endif() + + string(SUBSTRING "${current_line}" 0 ${split_pos} line_head) + string(SUBSTRING "${current_line}" ${split_pos} -1 line_tail) + string(STRIP "${line_tail}" line_tail) + + if(wrapped_line STREQUAL "") + set(wrapped_line "${line_head}") + else() + string(APPEND wrapped_line "\n${line_head}") + endif() + + set(current_line " $ ${line_tail}") + endwhile() + + set(${result} "${wrapped_line}" PARENT_SCOPE) +endfunction() + +# Wrap fixed-form Fortran source code to ensure it remains valid with +# the standard 72-column statement field. +function(_wrap_fixed_form_source source_text result) + if(_source_is_free_form) + set(${result} "${source_text}" PARENT_SCOPE) + return() + endif() + + string(REPLACE "\r\n" "\n" remaining_source "${source_text}") + string(REPLACE "\r" "\n" remaining_source "${remaining_source}") + set(wrapped_source "") + + while(1) + string(FIND "${remaining_source}" "\n" newline_index) + if(newline_index EQUAL -1) + if(NOT remaining_source STREQUAL "") + _wrap_fixed_form_line("${remaining_source}" wrapped_line) + string(APPEND wrapped_source "${wrapped_line}") + endif() + break() + endif() + + string(SUBSTRING "${remaining_source}" 0 ${newline_index} source_line) + math(EXPR next_index "${newline_index} + 1") + string(SUBSTRING "${remaining_source}" ${next_index} -1 remaining_source) + + _wrap_fixed_form_line("${source_line}" wrapped_line) + string(APPEND wrapped_source "${wrapped_line}\n") + endwhile() + + set(${result} "${wrapped_source}" PARENT_SCOPE) +endfunction() + +# Protect string literals in the source content by replacing them with +# placeholders, and save the original literals in variables for later restoration. +function(_protect_fortran_string_literals input_text result count_result) + set(output_text "") + set(remaining_source "${input_text}") + set(literal_count 0) + set(string_literal_regex "'([^']|'')*'|\"([^\"]|\"\")*\"") + + while(NOT remaining_source STREQUAL "") + string(FIND "${remaining_source}" "\n" newline_index) + if(newline_index EQUAL -1) + set(current_line "${remaining_source}") + set(remaining_source "") + set(has_newline FALSE) + else() + string(SUBSTRING "${remaining_source}" 0 ${newline_index} current_line) + math(EXPR next_index "${newline_index} + 1") + string(SUBSTRING "${remaining_source}" ${next_index} -1 + remaining_source) + set(has_newline TRUE) + endif() + + string(REGEX MATCHALL "${string_literal_regex}" string_literals + "${current_line}") + foreach(string_literal IN LISTS string_literals) + set(placeholder "@@LAPACK_SUFFIX_STRING_LITERAL_${literal_count}@@") + string(REPLACE "${string_literal}" "${placeholder}" current_line + "${current_line}") + set(protected_string_literal_${literal_count} "${string_literal}" + PARENT_SCOPE) + math(EXPR literal_count "${literal_count} + 1") + endforeach() + + string(APPEND output_text "${current_line}") + if(has_newline) + string(APPEND output_text "\n") + endif() + endwhile() + + set(${result} "${output_text}" PARENT_SCOPE) + set(${count_result} "${literal_count}" PARENT_SCOPE) +endfunction() + +# Restore string literals in the rewritten source content by replacing the +# placeholders with the original literals saved from the input content. +function(_restore_fortran_string_literals input_text literal_count result) + set(output_text "${input_text}") + if(literal_count GREATER 0) + math(EXPR last_literal_index "${literal_count} - 1") + foreach(index RANGE 0 ${last_literal_index}) + set(placeholder "@@LAPACK_SUFFIX_STRING_LITERAL_${index}@@") + string(REPLACE "${placeholder}" "${protected_string_literal_${index}}" + output_text "${output_text}") + endforeach() + endif() + + set(${result} "${output_text}" PARENT_SCOPE) +endfunction() + +get_filename_component(output_dir "${OUTPUT_FILE}" DIRECTORY) +file(MAKE_DIRECTORY "${output_dir}") + +file(READ "${INPUT_FILE}" source_content) +set(rewritten_content "${source_content}") + +# Extract symbol names from the source file +string(REPLACE "\r\n" "\n" symbol_scan_source "${source_content}") +string(REPLACE "\r" "\n" symbol_scan_source "${symbol_scan_source}") +set(symbol_names) + +while(1) + _pop_source_line(symbol_scan_source current_line has_line) + if(NOT has_line) + break() + endif() + + _is_fortran_comment_line("${current_line}" is_comment_line) + if(is_comment_line) + continue() + endif() + + _normalize_fortran_statement_fragment("${current_line}" logical_line) + set(last_line "${current_line}") + + while(1) + _peek_source_line(symbol_scan_source continuation_line has_line) + if(NOT has_line) + break() + endif() + + _is_fortran_comment_line("${continuation_line}" continuation_is_comment) + if(continuation_is_comment) + break() + endif() + + set(consume_continuation FALSE) + if(_source_is_free_form) + if("${last_line}" MATCHES "&[ \t]*$" OR + "${continuation_line}" MATCHES "^[ \t]*&") + set(consume_continuation TRUE) + endif() + else() + _is_fixed_form_continuation_line("${continuation_line}" + is_fixed_form_continuation) + if(is_fixed_form_continuation) + set(consume_continuation TRUE) + endif() + endif() + + if(NOT consume_continuation) + break() + endif() + + _pop_source_line(symbol_scan_source continuation_line has_line) + _normalize_fortran_statement_fragment("${continuation_line}" + continuation_fragment) + string(APPEND logical_line " ${continuation_fragment}") + set(last_line "${continuation_line}") + endwhile() + + _extract_symbols("${logical_line}" symbols) + if(symbols) + list(APPEND symbol_names ${symbols}) + endif() +endwhile() +list(REMOVE_DUPLICATES symbol_names) +list(REMOVE_ITEM symbol_names ETIME etime ETIME_ etime_) + +# Restrict the renaming to allowlisted symbols if an allowlist was given +if(DEFINED SYMBOL_ALLOWLIST) + set(_filtered_symbol_names) + foreach(symbol_name IN LISTS symbol_names) + string(TOLOWER "${symbol_name}" _symbol_name_lower) + list(FIND _symbol_allowlist "${_symbol_name_lower}" _symbol_allowlist_index) + if(NOT _symbol_allowlist_index EQUAL -1) + list(APPEND _filtered_symbol_names "${symbol_name}") + endif() + endforeach() + set(symbol_names ${_filtered_symbol_names}) +endif() + +# If string literals should not be modified, protect them before performing replacements +if(NOT REPLACE_IN_STRINGS) + _protect_fortran_string_literals( + "${rewritten_content}" rewritten_content protected_string_literal_count) +endif() + +# Replace symbol names with their suffixed versions in the source content +foreach(symbol_name IN LISTS symbol_names) + string(TOLOWER "${symbol_name}" symbol_lower) + string(TOUPPER "${symbol_name}" symbol_upper) + foreach(symbol_variant "${symbol_name}" "${symbol_lower}" "${symbol_upper}") + set(match_regex "(^|[^A-Za-z0-9_])${symbol_variant}([^A-Za-z0-9_]|$)") + set(replacement "\\1${symbol_variant}${SUFFIX}\\2") + string(REGEX REPLACE + "${match_regex}" "${replacement}" + rewritten_content "${rewritten_content}") + endforeach() +endforeach() + +# Restore string literals if they were protected +if(NOT REPLACE_IN_STRINGS) + _restore_fortran_string_literals( + "${rewritten_content}" "${protected_string_literal_count}" rewritten_content) +endif() + +_wrap_fixed_form_source("${rewritten_content}" rewritten_content) + +if(EXISTS "${OUTPUT_FILE}") + file(READ "${OUTPUT_FILE}" existing_output) +endif() + +if(NOT DEFINED existing_output OR NOT existing_output STREQUAL rewritten_content) + file(WRITE "${OUTPUT_FILE}" "${rewritten_content}") +endif() diff --git a/CMAKE/lapack-config-build.cmake.in b/CMAKE/lapack-config-build.cmake.in index 1d084fe132..da44a6ae46 100644 --- a/CMAKE/lapack-config-build.cmake.in +++ b/CMAKE/lapack-config-build.cmake.in @@ -1,10 +1,14 @@ # Load lapack targets from the build tree if necessary. set(_LAPACK_TARGET "@_lapack_config_build_guard_target@") if(_LAPACK_TARGET AND NOT TARGET "${_LAPACK_TARGET}") - include("@LAPACK_BINARY_DIR@/lapack-targets.cmake") + include("@LAPACK_BINARY_DIR@/@LAPACKLIB@-targets.cmake") endif() unset(_LAPACK_TARGET) +# Hint for project building against lapack +set(LAPACK_Fortran_COMPILER_ID "@CMAKE_Fortran_COMPILER_ID@") + # Report the blas and lapack raw or imported libraries. set(LAPACK_blas_LIBRARIES "@BLAS_LIBRARIES@") set(LAPACK_lapack_LIBRARIES "@LAPACK_LIBRARIES@") +set(LAPACK_LIBRARIES ${LAPACK_blas_LIBRARIES} ${LAPACK_lapack_LIBRARIES}) diff --git a/CMAKE/lapack-config-install.cmake.in b/CMAKE/lapack-config-install.cmake.in index 4e04f87115..77609609cd 100644 --- a/CMAKE/lapack-config-install.cmake.in +++ b/CMAKE/lapack-config-install.cmake.in @@ -4,12 +4,16 @@ get_filename_component(_LAPACK_SELF_DIR "${CMAKE_CURRENT_LIST_FILE}" PATH) # Load lapack targets from the install tree if necessary. set(_LAPACK_TARGET "@_lapack_config_install_guard_target@") if(_LAPACK_TARGET AND NOT TARGET "${_LAPACK_TARGET}") - include("${_LAPACK_SELF_DIR}/lapack-targets.cmake") + include("${_LAPACK_SELF_DIR}/@LAPACKLIB@-targets.cmake") endif() unset(_LAPACK_TARGET) +# Hint for project building against lapack +set(LAPACK_Fortran_COMPILER_ID "@CMAKE_Fortran_COMPILER_ID@") + # Report the blas and lapack raw or imported libraries. set(LAPACK_blas_LIBRARIES "@BLAS_LIBRARIES@") set(LAPACK_lapack_LIBRARIES "@LAPACK_LIBRARIES@") +set(LAPACK_LIBRARIES ${LAPACK_blas_LIBRARIES} ${LAPACK_lapack_LIBRARIES}) unset(_LAPACK_SELF_DIR) diff --git a/CMakeLists.txt b/CMakeLists.txt index edca61ff18..72fac4209c 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,4 +1,29 @@ -cmake_minimum_required(VERSION 2.8.12) +cmake_minimum_required(VERSION 3.18) + +project(LAPACK C) + +set(LAPACK_MAJOR_VERSION 3) +set(LAPACK_MINOR_VERSION 12) +set(LAPACK_PATCH_VERSION 1) +set( + LAPACK_VERSION + ${LAPACK_MAJOR_VERSION}.${LAPACK_MINOR_VERSION}.${LAPACK_PATCH_VERSION} + ) + +set(CMAKE_C_STANDARD 99) + +# Allow setting a prefix for the library names +set(CMAKE_STATIC_LIBRARY_PREFIX "lib${LIBRARY_PREFIX}") +set(CMAKE_SHARED_LIBRARY_PREFIX "lib${LIBRARY_PREFIX}") + +# Add the CMake directory for custom CMake modules +set(CMAKE_MODULE_PATH "${LAPACK_SOURCE_DIR}/CMAKE" ${CMAKE_MODULE_PATH}) + +# Export all symbols on Windows when building shared libraries +set(CMAKE_WINDOWS_EXPORT_ALL_SYMBOLS TRUE) + +# Enable position independent code for all targets by default +set(CMAKE_POSITION_INDEPENDENT_CODE TRUE) # Set a default build type if none was specified if(NOT CMAKE_BUILD_TYPE AND NOT CMAKE_CONFIGURATION_TYPES) @@ -8,102 +33,150 @@ if(NOT CMAKE_BUILD_TYPE AND NOT CMAKE_CONFIGURATION_TYPES) set_property(CACHE CMAKE_BUILD_TYPE PROPERTY STRINGS "Debug" "Release" "MinSizeRel" "RelWithDebInfo" "Coverage") endif() -project(LAPACK Fortran C) +# Coverage +set(_is_coverage_build 0) +set(_msg "Checking if build type is 'Coverage'") +message(STATUS "${_msg}") +if(NOT CMAKE_CONFIGURATION_TYPES) + string(TOLOWER ${CMAKE_BUILD_TYPE} _build_type_lc) + if(${_build_type_lc} STREQUAL "coverage") + set(_is_coverage_build 1) + endif() +endif() +message(STATUS "${_msg}: ${_is_coverage_build}") -set(LAPACK_MAJOR_VERSION 3) -set(LAPACK_MINOR_VERSION 7) -set(LAPACK_PATCH_VERSION 1) -set( - LAPACK_VERSION - ${LAPACK_MAJOR_VERSION}.${LAPACK_MINOR_VERSION}.${LAPACK_PATCH_VERSION} - ) +if(_is_coverage_build) + message(STATUS "Adding coverage") + find_package(codecov) +endif() + +# Instrument the library ${lib} for coverage. +function(lapack_add_coverage lib) + if(NOT _is_coverage_build) + return() + endif() + if(NOT TARGET ${lib}) + message(FATAL_ERROR "lapack_add_coverage: no such target '${lib}'") + endif() + add_coverage(${lib}) + target_link_libraries(${lib} PRIVATE gcov) +endfunction() + +# Use valgrind if it is found +option( LAPACK_TESTING_USE_PYTHON "Use Python for testing. Disable it on memory checks." ON ) +find_program( MEMORYCHECK_COMMAND valgrind ) +if( MEMORYCHECK_COMMAND ) + message( STATUS "Found valgrind: ${MEMORYCHECK_COMMAND}" ) + set( MEMORYCHECK_COMMAND_OPTIONS "--leak-check=full --show-leak-kinds=all --track-origins=yes" ) +endif() + +# By default test Fortran compiler complex abs and complex division +option(TEST_FORTRAN_COMPILER "Test Fortran compiler complex abs and complex division" OFF) +if( TEST_FORTRAN_COMPILER ) + + add_executable( test_zcomplexabs ${LAPACK_SOURCE_DIR}/INSTALL/test_zcomplexabs.f ) + add_custom_target( run_test_zcomplexabs + COMMAND test_zcomplexabs 2> test_zcomplexabs.err + WORKING_DIRECTORY ${LAPACK_BINARY_DIR}/INSTALL + COMMENT "Running test_zcomplexabs in ${LAPACK_BINARY_DIR}/INSTALL with stderr: test_zcomplexabs.err" + SOURCES ${LAPACK_SOURCE_DIR}/INSTALL/test_zcomplexabs.f ) + + add_executable( test_zcomplexdiv ${LAPACK_SOURCE_DIR}/INSTALL/test_zcomplexdiv.f ) + add_custom_target( run_test_zcomplexdiv + COMMAND test_zcomplexdiv 2> test_zcomplexdiv.err + WORKING_DIRECTORY ${LAPACK_BINARY_DIR}/INSTALL + COMMENT "Running test_zcomplexdiv in ${LAPACK_BINARY_DIR}/INSTALL with stderr: test_zcomplexdiv.err" + SOURCES ${LAPACK_SOURCE_DIR}/INSTALL/test_zcomplexdiv.f ) + + add_executable( test_zcomplexmult ${LAPACK_SOURCE_DIR}/INSTALL/test_zcomplexmult.f ) + add_custom_target( run_test_zcomplexmult + COMMAND test_zcomplexmult 2> test_zcomplexmult.err + WORKING_DIRECTORY ${LAPACK_BINARY_DIR}/INSTALL + COMMENT "Running test_zcomplexmult in ${LAPACK_BINARY_DIR}/INSTALL with stderr: test_zcomplexmult.err" + SOURCES ${LAPACK_SOURCE_DIR}/INSTALL/test_zcomplexmult.f ) + + add_executable( test_zminMax ${LAPACK_SOURCE_DIR}/INSTALL/test_zminMax.f ) + add_custom_target( run_test_zminMax + COMMAND test_zminMax 2> test_zminMax.err + WORKING_DIRECTORY ${LAPACK_BINARY_DIR}/INSTALL + COMMENT "Running test_zminMax in ${LAPACK_BINARY_DIR}/INSTALL with stderr: test_zminMax.err" + SOURCES ${LAPACK_SOURCE_DIR}/INSTALL/test_zminMax.f ) + +endif() + +# By default static library +option(BUILD_SHARED_LIBS "Build shared libraries" OFF) +message(STATUS "Build shared libraries: ${BUILD_SHARED_LIBS}") + +option(BUILD_DEFAULT_API "Build default API. Disable and combine with -DBUILD_INDEX64_EXT_API=ON to build only extended API" ON) +message(STATUS "Build default API: ${BUILD_DEFAULT_API}") + +# By default build index32 library +option(BUILD_INDEX64 "Build Index-64 API libraries" OFF) +if(BUILD_INDEX64) + set(BLASLIB "blas64") + set(CBLASLIB "cblas64") + set(LAPACKLIB "lapack64") + set(LAPACKELIB "lapacke64") + set(TMGLIB "tmglib64") + set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -DWeirdNEC -DLAPACK_ILP64 -DHAVE_LAPACK_CONFIG_H") + set(FORTRAN_ILP TRUE) +else() + set(BLASLIB "blas") + set(CBLASLIB "cblas") + set(LAPACKLIB "lapack") + set(LAPACKELIB "lapacke") + set(TMGLIB "tmglib") +endif() +message(STATUS "Build default API as Index-64: ${BUILD_INDEX64}") + +# By default build extended _64 API +option(BUILD_INDEX64_EXT_API "Build Index-64 API as extended API with _64 suffix" ON) +message(STATUS "Build Index-64 API as extended API with _64 suffix: ${BUILD_INDEX64_EXT_API}") + +if(BUILD_INDEX64_EXT_API AND BUILD_INDEX64) + message(WARNING + "Building Index-64 API redundantly as extended API and default API. " + "Consider disabling one of them (BUILD_INDEX64_EXT_API / BUILD_INDEX64).") +endif() include(GNUInstallDirs) -# Updated OSX RPATH settings -# In response to CMake 3.0 generating warnings regarding policy CMP0042, -# the OSX RPATH settings have been updated per recommendations found -# in the CMake Wiki: -# http://www.cmake.org/Wiki/CMake_RPATH_handling#Mac_OS_X_and_the_RPATH -set(CMAKE_MACOSX_RPATH ON) -set(CMAKE_SKIP_BUILD_RPATH FALSE) -set(CMAKE_BUILD_WITH_INSTALL_RPATH FALSE) -list(FIND CMAKE_PLATFORM_IMPLICIT_LINK_DIRECTORIES ${CMAKE_INSTALL_FULL_LIBDIR} isSystemDir) -if("${isSystemDir}" STREQUAL "-1") - set(CMAKE_INSTALL_RPATH ${CMAKE_INSTALL_FULL_LIBDIR}) - set(CMAKE_INSTALL_RPATH_USE_LINK_PATH TRUE) -endif() - - -# Configure the warning and code coverage suppression file -configure_file( - "${LAPACK_SOURCE_DIR}/CTestCustom.cmake.in" - "${LAPACK_BINARY_DIR}/CTestCustom.cmake" - @ONLY -) - -# Add the CMake directory for custon CMake modules -set(CMAKE_MODULE_PATH "${LAPACK_SOURCE_DIR}/CMAKE" ${CMAKE_MODULE_PATH}) include(PreventInSourceBuilds) include(PreventInBuildInstalls) -if(UNIX) - if("${CMAKE_Fortran_COMPILER}" MATCHES "ifort") - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fp-model strict") - endif() - if("${CMAKE_Fortran_COMPILER}" MATCHES "xlf") - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -qnosave -qstrict=none") - endif() -# Delete libmtsk in linking sequence for Sun/Oracle Fortran Compiler. -# This library is not present in the Sun package SolarisStudio12.3-linux-x86-bin - string(REPLACE \;mtsk\; \; CMAKE_Fortran_IMPLICIT_LINK_LIBRARIES "${CMAKE_Fortran_IMPLICIT_LINK_LIBRARIES}") -endif() - -if(CMAKE_Fortran_COMPILER_ID STREQUAL "Compaq") - if(WIN32) - if(CMAKE_GENERATOR STREQUAL "NMake Makefiles") - get_filename_component(CMAKE_Fortran_COMPILER_CMDNAM ${CMAKE_Fortran_COMPILER} NAME_WE) - message(STATUS "Using Compaq Fortran compiler with command name ${CMAKE_Fortran_COMPILER_CMDNAM}") - set(cmd ${CMAKE_Fortran_COMPILER_CMDNAM}) - string(TOLOWER "${cmd}" cmdlc) - if(cmdlc STREQUAL "df") - message(STATUS "Assume the Compaq Visual Fortran Compiler is being used") - set(CMAKE_Fortran_USE_RESPONSE_FILE_FOR_OBJECTS 1) - set(CMAKE_Fortran_USE_RESPONSE_FILE_FOR_INCLUDES 1) - #This is a workaround that is needed to avoid forward-slashes in the - #filenames listed in response files from incorrectly being interpreted as - #introducing compiler command options - if(${BUILD_SHARED_LIBS}) - message(FATAL_ERROR "Making of shared libraries with CVF has not been tested.") - endif() - set(str "NMake version 9 or later should be used. NMake version 6.0 which is\n") - set(str "${str} included with the CVF distribution fails to build Lapack because\n") - set(str "${str} the number of source files exceeds the limit for NMake v6.0\n") - message(STATUS ${str}) - set(CMAKE_Fortran_LINK_EXECUTABLE "LINK /out: ") - endif() +# Add option to enable flat namespace for symbol resolution on macOS +if(APPLE) + option(USE_FLAT_NAMESPACE "Use flat namespaces for symbol resolution during build and runtime." OFF) + + if(USE_FLAT_NAMESPACE) + set(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} -Wl,-flat_namespace") + set(CMAKE_MODULE_LINKER_FLAGS "${CMAKE_MODULE_LINKER_FLAGS} -Wl,-flat_namespace") + set(CMAKE_SHARED_LINKER_FLAGS "${CMAKE_SHARED_LINKER_FLAGS} -Wl,-flat_namespace") + else() + if(BUILD_SHARED_LIBS AND BUILD_TESTING) + message(WARNING + "LAPACK test suite might fail with shared libraries and the default two-level namespace. " + "Disable shared libraries or enable flat namespace for symbol resolution via -DUSE_FLAT_NAMESPACE=ON.") endif() endif() endif() -# Get Python -message(STATUS "Looking for Python greater than 2.6 - ${PYTHONINTERP_FOUND}") -find_package(PythonInterp 2.7) # lapack_testing.py uses features from python 2.7 and greater -if(PYTHONINTERP_FOUND) - message(STATUS "Using Python version ${PYTHON_VERSION_STRING}") -else() - message(STATUS "No suitable Python version found, so skipping summary tests.") -endif() # -------------------------------------------------- +set(LAPACK_INSTALL_EXPORT_NAME ${LAPACKLIB}-targets) + +set(LAPACK_BINARY_PATH_SUFFIX "" CACHE STRING "Path suffix appended to the install path of binaries") -set(LAPACK_INSTALL_EXPORT_NAME lapack-targets) +if(NOT "${LAPACK_BINARY_PATH_SUFFIX}" STREQUAL "" AND NOT "${LAPACK_BINARY_PATH_SUFFIX}" MATCHES "^/") + set(LAPACK_BINARY_PATH_SUFFIX "/${LAPACK_BINARY_PATH_SUFFIX}") +endif() macro(lapack_install_library lib) install(TARGETS ${lib} EXPORT ${LAPACK_INSTALL_EXPORT_NAME} - ARCHIVE DESTINATION ${CMAKE_INSTALL_LIBDIR} - LIBRARY DESTINATION ${CMAKE_INSTALL_LIBDIR} - RUNTIME DESTINATION ${CMAKE_INSTALL_BINDIR} + ARCHIVE DESTINATION "${CMAKE_INSTALL_LIBDIR}${LAPACK_BINARY_PATH_SUFFIX}" COMPONENT Development + LIBRARY DESTINATION "${CMAKE_INSTALL_LIBDIR}${LAPACK_BINARY_PATH_SUFFIX}" COMPONENT RuntimeLibraries + RUNTIME DESTINATION "${CMAKE_INSTALL_BINDIR}${LAPACK_BINARY_PATH_SUFFIX}" COMPONENT RuntimeLibraries ) endmacro() @@ -111,50 +184,36 @@ set(PKG_CONFIG_DIR ${CMAKE_INSTALL_LIBDIR}/pkgconfig) # -------------------------------------------------- # Testing - -enable_testing() +option(BUILD_TESTING "Build tests" ${_is_coverage_build}) include(CTest) -enable_testing() -# -------------------------------------------------- +message(STATUS "Build tests: ${BUILD_TESTING}") +if(BUILD_TESTING) + set(_msg "Looking for Python3 needed for summary tests") + message(STATUS "${_msg}") + set(Python3_FIND_STRATEGY LOCATION) + find_package(Python3 COMPONENTS Interpreter) + if(Python3_Interpreter_FOUND ) + message(STATUS "${_msg} - found: ${Python3_VERSION}") + else() + message(STATUS "${_msg} - not found (skipping summary tests)") + endif() + + # Configure the warning and code coverage suppression file + configure_file( + "${LAPACK_SOURCE_DIR}/CTestCustom.cmake.in" + "${LAPACK_BINARY_DIR}/CTestCustom.cmake" + @ONLY + ) +endif() + +# -------------------------------------------------- # Organize output files. On Windows this also keeps .dll files next # to the .exe files that need them, making tests easy to run. set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${LAPACK_BINARY_DIR}/bin) set(CMAKE_ARCHIVE_OUTPUT_DIRECTORY ${LAPACK_BINARY_DIR}/lib) set(CMAKE_LIBRARY_OUTPUT_DIRECTORY ${LAPACK_BINARY_DIR}/lib) -# -------------------------------------------------- -# Check for any necessary platform specific compiler flags -include(CheckLAPACKCompilerFlags) -CheckLAPACKCompilerFlags() - -string(TOUPPER ${CMAKE_BUILD_TYPE} CMAKE_BUILD_TYPE_UPPER) -if(${CMAKE_BUILD_TYPE_UPPER} STREQUAL "COVERAGE") - message(STATUS "Adding coverage") - find_package(codecov) -endif() - -# -------------------------------------------------- -# Check second function - -include(CheckTimeFunction) -set(TIME_FUNC NONE ${TIME_FUNC}) -CHECK_TIME_FUNCTION(NONE TIME_FUNC) -CHECK_TIME_FUNCTION(INT_CPU_TIME TIME_FUNC) -CHECK_TIME_FUNCTION(EXT_ETIME TIME_FUNC) -CHECK_TIME_FUNCTION(EXT_ETIME_ TIME_FUNC) -CHECK_TIME_FUNCTION(INT_ETIME TIME_FUNC) -message(STATUS "--> Will use second_${TIME_FUNC}.f and dsecnd_${TIME_FUNC}.f as timing function.") - -set(SECOND_SRC ${LAPACK_SOURCE_DIR}/INSTALL/second_${TIME_FUNC}.f) -set(DSECOND_SRC ${LAPACK_SOURCE_DIR}/INSTALL/dsecnd_${TIME_FUNC}.f) - -# By default static library -option(BUILD_SHARED_LIBS "Build shared libraries" OFF) - -option(BUILD_TESTING "Build tests" OFF) -message(STATUS "Build tests: ${BUILD_TESTING}") - # deprecated LAPACK and LAPACKE routines option(BUILD_DEPRECATED "Build deprecated routines" OFF) message(STATUS "Build deprecated routines: ${BUILD_DEPRECATED}") @@ -177,12 +236,14 @@ if(NOT (BUILD_SINGLE OR BUILD_DOUBLE OR BUILD_COMPLEX OR BUILD_COMPLEX16)) BUILD_SINGLE, BUILD_DOUBLE, BUILD_COMPLEX, BUILD_COMPLEX16.") endif() + # -------------------------------------------------- # Subdirectories that need to be processed option(USE_OPTIMIZED_BLAS "Whether or not to use an optimized BLAS library instead of included netlib BLAS" OFF) # Check the usage of the user provided BLAS libraries if(BLAS_LIBRARIES) + enable_language(Fortran) include(CheckFortranFunctionExists) set(CMAKE_REQUIRED_LIBRARIES ${BLAS_LIBRARIES}) CHECK_FORTRAN_FUNCTION_EXISTS("dgemm" BLAS_FOUND) @@ -205,17 +266,9 @@ endif() if(NOT BLAS_FOUND) message(STATUS "Using supplied NETLIB BLAS implementation") add_subdirectory(BLAS) - set(BLAS_LIBRARIES blas) + set(BLAS_LIBRARIES ${BLASLIB}) else() - set(CMAKE_EXE_LINKER_FLAGS - "${CMAKE_EXE_LINKER_FLAGS} ${BLAS_LINKER_FLAGS}" - CACHE STRING "Linker flags for executables" FORCE) - set(CMAKE_MODULE_LINKER_FLAGS - "${CMAKE_MODULE_LINKER_FLAGS} ${BLAS_LINKER_FLAGS}" - CACHE STRING "Linker flags for modules" FORCE) - set(CMAKE_SHARED_LINKER_FLAGS - "${CMAKE_SHARED_LINKER_FLAGS} ${BLAS_LINKER_FLAGS}" - CACHE STRING "Linker flags for shared libs" FORCE) + add_link_options(${BLAS_LINKER_FLAGS}) endif() @@ -223,6 +276,11 @@ endif() # CBLAS option(CBLAS "Build CBLAS" OFF) +# Include cblas_f77.h and cblas_mangling.h even if CBLAS is not built +if(CBLAS OR NOT BLAS_FOUND) + add_subdirectory(CBLAS/include) +endif() + if(CBLAS) add_subdirectory(CBLAS) endif() @@ -232,7 +290,8 @@ endif() option(USE_XBLAS "Build extended precision (needs XBLAS)" OFF) if(USE_XBLAS) - find_library(XBLAS_LIBRARY NAMES xblas) + find_library(XBLAS_LIBRARY NAMES xblas REQUIRED) + message(STATUS "Looking for XBLAS library: ${XBLAS_LIBRARY}") endif() option(USE_OPTIMIZED_LAPACK "Whether or not to use an optimized LAPACK library instead of included netlib LAPACK" OFF) @@ -246,36 +305,58 @@ endif() # Check the usage of the user provided or automatically found LAPACK libraries if(LAPACK_LIBRARIES) - include(CheckFortranFunctionExists) - set(CMAKE_REQUIRED_LIBRARIES ${LAPACK_LIBRARIES}) - # Check if new routine of 3.4.0 is in LAPACK_LIBRARIES - CHECK_FORTRAN_FUNCTION_EXISTS("dgeqrt" LATESTLAPACK_FOUND) - unset(CMAKE_REQUIRED_LIBRARIES) - if(LATESTLAPACK_FOUND) - message(STATUS "--> LAPACK supplied by user is WORKING, will use ${LAPACK_LIBRARIES}.") + include(CheckLanguage) + check_language(Fortran) + if(CMAKE_Fortran_COMPILER) + enable_language(Fortran) + include(CheckFortranFunctionExists) + set(CMAKE_REQUIRED_LIBRARIES ${LAPACK_LIBRARIES}) + # Check if new routine of 3.4.0 is in LAPACK_LIBRARIES + CHECK_FORTRAN_FUNCTION_EXISTS("dgeqrt" LATESTLAPACK_FOUND) + unset(CMAKE_REQUIRED_LIBRARIES) + if(LATESTLAPACK_FOUND) + message(STATUS "--> LAPACK supplied by user is WORKING, will use ${LAPACK_LIBRARIES}.") + else() + message(ERROR "--> LAPACK supplied by user is not WORKING or is older than LAPACK 3.4.0, CANNOT USE ${LAPACK_LIBRARIES}.") + message(ERROR "--> Will use REFERENCE LAPACK (by default)") + message(ERROR "--> Or Correct your LAPACK_LIBRARIES entry ") + message(ERROR "--> Or Consider checking USE_OPTIMIZED_LAPACK") + endif() else() - message(ERROR "--> LAPACK supplied by user is not WORKING or is older than LAPACK 3.4.0, CANNOT USE ${LAPACK_LIBRARIES}.") - message(ERROR "--> Will use REFERENCE LAPACK (by default)") - message(ERROR "--> Or Correct your LAPACK_LIBRARIES entry ") - message(ERROR "--> Or Consider checking USE_OPTIMIZED_LAPACK") + message(STATUS "--> LAPACK supplied by user is ${LAPACK_LIBRARIES}.") + message(STATUS "--> CMake couldn't find a Fortran compiler, so it cannot check if the provided LAPACK library works.") + set(LATESTLAPACK_FOUND TRUE) endif() endif() # Neither user specified or optimized LAPACK libraries can be used if(NOT LATESTLAPACK_FOUND) message(STATUS "Using supplied NETLIB LAPACK implementation") - set(LAPACK_LIBRARIES lapack) + set(LAPACK_LIBRARIES ${LAPACKLIB}) + + enable_language(Fortran) + + # Check for any necessary platform specific compiler flags + include(CheckLAPACKCompilerFlags) + CheckLAPACKCompilerFlags() + + # Check second function + include(CheckTimeFunction) + set(TIME_FUNC NONE) + CHECK_TIME_FUNCTION(NONE TIME_FUNC) + CHECK_TIME_FUNCTION(INT_CPU_TIME TIME_FUNC) + CHECK_TIME_FUNCTION(EXT_ETIME TIME_FUNC) + CHECK_TIME_FUNCTION(EXT_ETIME_ TIME_FUNC) + CHECK_TIME_FUNCTION(INT_ETIME TIME_FUNC) + + # Set second function + message(STATUS "--> Will use second_${TIME_FUNC}.f and dsecnd_${TIME_FUNC}.f as timing function.") + set(SECOND_SRC ${LAPACK_SOURCE_DIR}/INSTALL/second_${TIME_FUNC}.f) + set(DSECOND_SRC ${LAPACK_SOURCE_DIR}/INSTALL/dsecnd_${TIME_FUNC}.f) + add_subdirectory(SRC) else() - set(CMAKE_EXE_LINKER_FLAGS - "${CMAKE_EXE_LINKER_FLAGS} ${LAPACK_LINKER_FLAGS}" - CACHE STRING "Linker flags for executables" FORCE) - set(CMAKE_MODULE_LINKER_FLAGS - "${CMAKE_MODULE_LINKER_FLAGS} ${LAPACK_LINKER_FLAGS}" - CACHE STRING "Linker flags for modules" FORCE) - set(CMAKE_SHARED_LINKER_FLAGS - "${CMAKE_SHARED_LINKER_FLAGS} ${LAPACK_LINKER_FLAGS}" - CACHE STRING "Linker flags for shared libs" FORCE) + add_link_options(${LAPACK_LINKER_FLAGS}) endif() if(BUILD_TESTING) @@ -292,28 +373,105 @@ option(LAPACKE_WITH_TMG "Build LAPACKE with tmglib routines" OFF) if(LAPACKE_WITH_TMG) set(LAPACKE ON) endif() -if(BUILD_TESTING OR LAPACKE_WITH_TMG) #already included, avoid double inclusion + +# TMGLIB +# Cache export target +set(LAPACK_INSTALL_EXPORT_NAME_CACHE ${LAPACK_INSTALL_EXPORT_NAME}) +if(BUILD_TESTING OR LAPACKE_WITH_TMG) + enable_language(Fortran) + if(LATESTLAPACK_FOUND AND LAPACKE_WITH_TMG) + set(CMAKE_REQUIRED_LIBRARIES ${LAPACK_LIBRARIES}) + # Check if dlatms (part of tmg) is found + include(CheckFortranFunctionExists) + CHECK_FORTRAN_FUNCTION_EXISTS("dlatms" LAPACK_WITH_TMGLIB_FOUND) + unset(CMAKE_REQUIRED_LIBRARIES) + if(NOT LAPACK_WITH_TMGLIB_FOUND) + # Build and install TMG as part of LAPACKE targets (as opposed to LAPACK + # targets) + set(LAPACK_INSTALL_EXPORT_NAME ${LAPACKELIB}-targets) + endif() + endif() add_subdirectory(TESTING/MATGEN) endif() +# Reset export target +set(LAPACK_INSTALL_EXPORT_NAME ${LAPACK_INSTALL_EXPORT_NAME_CACHE}) +unset(LAPACK_INSTALL_EXPORT_NAME_CACHE) + + +#------------------------------------- +# LAPACKE +# Include lapack.h and lapacke_mangling.h even if LAPACKE is not built +add_subdirectory(LAPACKE/include) if(LAPACKE) add_subdirectory(LAPACKE) endif() + +#------------------------------------- +# BLAS++ / LAPACK++ +option(BLAS++ "Build BLAS++" OFF) +option(LAPACK++ "Build LAPACK++" OFF) + + +function(_display_cpp_implementation_msg name) + string(TOLOWER ${name} name_lc) + message(STATUS "${name}++ enable") + message(STATUS "----------------") + message(STATUS "Thank you for your interest in ${name}++, a newly developed C++ API for ${name} library") + message(STATUS "The objective of ${name}++ is to provide a convenient, performance oriented API for development in the C++ language, that, for the most part, preserves established conventions, while, at the same time, takes advantages of modern C++ features, such as: namespaces, templates, exceptions, etc.") + message(STATUS "For support ${name}++ related question, please email: slate-user@icl.utk.edu") + message(STATUS "----------------") +endfunction() +if (BLAS++) + _display_cpp_implementation_msg("BLAS") + include(ExternalProject) + ExternalProject_Add(blaspp + URL https://bitbucket.org/icl/blaspp/downloads/blaspp-2020.10.02.tar.gz + CONFIGURE_COMMAND ${CMAKE_COMMAND} -E env LIBRARY_PATH=$ENV{LIBRARY_PATH}:${CMAKE_BINARY_DIR}/lib LD_LIBRARY_PATH=$ENV{LD_LIBRARY_PATH}:${PROJECT_BINARY_DIR}/lib ${CMAKE_COMMAND} -DCMAKE_INSTALL_PREFIX=${PROJECT_BINARY_DIR} -DCMAKE_INSTALL_LIBDIR=lib -DBUILD_SHARED_LIBS=${BUILD_SHARED_LIBS} ${PROJECT_BINARY_DIR}/blaspp-prefix/src/blaspp + BUILD_COMMAND ${CMAKE_COMMAND} -E env LIBRARY_PATH=$ENV{LIBRARY_PATH}:${PROJECT_BINARY_DIR}/lib LIB_SUFFIX="" ${CMAKE_COMMAND} --build . + INSTALL_COMMAND ${CMAKE_COMMAND} -E env PREFIX=${PROJECT_BINARY_DIR} LIB_SUFFIX="" ${CMAKE_COMMAND} --install . + ) + ExternalProject_Add_StepDependencies(blaspp build ${BLAS_LIBRARIES}) +endif() +if (LAPACK++) + message (STATUS "linking lapack++ against ${LAPACK_LIBRARIES}") + _display_cpp_implementation_msg("LAPACK") + include(ExternalProject) + if (BUILD_SHARED_LIBS) + ExternalProject_Add(lapackpp + URL https://bitbucket.org/icl/lapackpp/downloads/lapackpp-2020.10.02.tar.gz + CONFIGURE_COMMAND ${CMAKE_COMMAND} -E env LIBRARY_PATH=$ENV{LIBRARY_PATH}:${CMAKE_BINARY_DIR}/lib LD_LIBRARY_PATH=$ENV{LD_LIBRARY_PATH}:${PROJECT_BINARY_DIR}/lib ${CMAKE_COMMAND} -DCMAKE_INSTALL_PREFIX=${PROJECT_BINARY_DIR} -DCMAKE_INSTALL_LIBDIR=lib -DLAPACK_LIBRARIES=${LAPACK_LIBRARIES} -DBUILD_SHARED_LIBS=${BUILD_SHARED_LIBS} ${PROJECT_BINARY_DIR}/lapackpp-prefix/src/lapackpp + BUILD_COMMAND ${CMAKE_COMMAND} -E env LIBRARY_PATH=$ENV{LIBRARY_PATH}:${PROJECT_BINARY_DIR}/lib LIB_SUFFIX="" ${CMAKE_COMMAND} --build . + INSTALL_COMMAND ${CMAKE_COMMAND} -E env PREFIX=${PROJECT_BINARY_DIR} LIB_SUFFIX="" ${CMAKE_COMMAND} --install . + ) + else () +# FIXME this does not really work as the libraries list gets converted to a semicolon-separated list somewhere in the lapack++ build files + ExternalProject_Add(lapackpp + URL https://bitbucket.org/icl/lapackpp/downloads/lapackpp-2020.10.02.tar.gz + CONFIGURE_COMMAND env LIBRARY_PATH=$ENV{LIBRARY_PATH}:${CMAKE_BINARY_DIR}/lib LD_LIBRARY_PATH=$ENV{LD_LIBRARY_PATH}:${PROJECT_BINARY_DIR}/lib ${CMAKE_COMMAND} -DCMAKE_INSTALL_PREFIX=${PROJECT_BINARY_DIR} -DCMAKE_INSTALL_LIBDIR=lib -DLAPACK_LIBRARIES="${PROJECT_BINARY_DIR}/lib/liblapack.a -lgfortran" -DBUILD_SHARED_LIBS=${BUILD_SHARED_LIBS} ${PROJECT_BINARY_DIR}/lapackpp-prefix/src/lapackpp + BUILD_COMMAND env LIBRARY_PATH=$ENV{LIBRARY_PATH}:${PROJECT_BINARY_DIR}/lib LIB_SUFFIX="" ${CMAKE_COMMAND} --build . + INSTALL_COMMAND ${CMAKE_COMMAND} -E env PREFIX=${PROJECT_BINARY_DIR} LIB_SUFFIX="" ${CMAKE_COMMAND} --install . + ) + endif() + ExternalProject_Add_StepDependencies(lapackpp build blaspp ${BLAS_LIBRARIES} ${LAPACK_LIBRARIES}) +endif() + # -------------------------------------------------- # CPACK Packaging set(CPACK_PACKAGE_NAME "LAPACK") set(CPACK_PACKAGE_VENDOR "University of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd") set(CPACK_PACKAGE_DESCRIPTION_SUMMARY "LAPACK- Linear Algebra Package") -set(CPACK_PACKAGE_VERSION_MAJOR 3) -set(CPACK_PACKAGE_VERSION_MINOR 5) -set(CPACK_PACKAGE_VERSION_PATCH 0) +set(CPACK_PACKAGE_VERSION_MAJOR ${LAPACK_MAJOR_VERSION}) +set(CPACK_PACKAGE_VERSION_MINOR ${LAPACK_MINOR_VERSION}) +set(CPACK_PACKAGE_VERSION_PATCH ${LAPACK_PATCH_VERSION}) set(CPACK_RESOURCE_FILE_LICENSE "${CMAKE_CURRENT_SOURCE_DIR}/LICENSE") +set(CPACK_MONOLITHIC_INSTALL ON) set(CPACK_PACKAGE_INSTALL_DIRECTORY "LAPACK") if(WIN32 AND NOT UNIX) # There is a bug in NSI that does not handle full unix paths properly. Make - # sure there is at least one set of four (4) backlasshes. + # sure there is at least one set of four (4) backslashes. set(CPACK_NSIS_HELP_LINK "http:\\\\\\\\http://icl.cs.utk.edu/lapack-forum") set(CPACK_NSIS_URL_INFO_ABOUT "http:\\\\\\\\www.netlib.org/lapack") set(CPACK_NSIS_CONTACT "lapack@eecs.utk.edu") @@ -332,23 +490,24 @@ include(CPack) # -------------------------------------------------- if(NOT BLAS_FOUND) - set(ALL_TARGETS ${ALL_TARGETS} blas) + set(ALL_TARGETS ${ALL_TARGETS} ${BLASLIB}) endif() if(NOT LATESTLAPACK_FOUND) - set(ALL_TARGETS ${ALL_TARGETS} lapack) -endif() - -if(BUILD_TESTING OR LAPACKE_WITH_TMG) - set(ALL_TARGETS ${ALL_TARGETS} tmglib) + set(ALL_TARGETS ${ALL_TARGETS} ${LAPACKLIB}) endif() # Export lapack targets, not including lapacke, from the # install tree, if any. set(_lapack_config_install_guard_target "") if(ALL_TARGETS) - install(EXPORT lapack-targets - DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/lapack-${LAPACK_VERSION}) + add_library(LAPACK::LAPACK ALIAS ${LAPACKLIB}) + install(EXPORT ${LAPACKLIB}-targets + FILE ${LAPACKLIB}-targets.cmake + NAMESPACE LAPACK:: + DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/${LAPACKLIB}-${LAPACK_VERSION} + COMPONENT Development + ) # Choose one of the lapack targets to use as a guard for # lapack-config.cmake to load targets from the install tree. @@ -357,18 +516,22 @@ endif() # Include cblas in targets exported from the build tree. if(CBLAS) - set(ALL_TARGETS ${ALL_TARGETS} cblas) + set(ALL_TARGETS ${ALL_TARGETS} ${CBLASLIB}) endif() # Include lapacke in targets exported from the build tree. if(LAPACKE) - set(ALL_TARGETS ${ALL_TARGETS} lapacke) + set(ALL_TARGETS ${ALL_TARGETS} ${LAPACKELIB}) +endif() + +if(NOT LAPACK_WITH_TMGLIB_FOUND AND LAPACKE_WITH_TMG) + set(ALL_TARGETS ${ALL_TARGETS} ${TMGLIB}) endif() # Export lapack and lapacke targets from the build tree, if any. set(_lapack_config_build_guard_target "") if(ALL_TARGETS) - export(TARGETS ${ALL_TARGETS} FILE lapack-targets.cmake) + export(TARGETS ${ALL_TARGETS} FILE ${LAPACKLIB}-targets.cmake) # Choose one of the lapack or lapacke targets to use as a guard # for lapack-config.cmake to load targets from the build tree. @@ -376,27 +539,171 @@ if(ALL_TARGETS) endif() configure_file(${LAPACK_SOURCE_DIR}/CMAKE/lapack-config-build.cmake.in - ${LAPACK_BINARY_DIR}/lapack-config.cmake @ONLY) + ${LAPACK_BINARY_DIR}/${LAPACKLIB}-config.cmake @ONLY) -configure_file(${CMAKE_CURRENT_SOURCE_DIR}/lapack.pc.in ${CMAKE_CURRENT_BINARY_DIR}/lapack.pc @ONLY) +configure_file(${CMAKE_CURRENT_SOURCE_DIR}/lapack.pc.in ${CMAKE_CURRENT_BINARY_DIR}/${LAPACKLIB}.pc @ONLY) install(FILES - ${CMAKE_CURRENT_BINARY_DIR}/lapack.pc + ${CMAKE_CURRENT_BINARY_DIR}/${LAPACKLIB}.pc DESTINATION ${PKG_CONFIG_DIR} + COMPONENT Development ) configure_file(${LAPACK_SOURCE_DIR}/CMAKE/lapack-config-install.cmake.in - ${LAPACK_BINARY_DIR}/CMakeFiles/lapack-config.cmake @ONLY) + ${LAPACK_BINARY_DIR}/CMakeFiles/${LAPACKLIB}-config.cmake @ONLY) include(CMakePackageConfigHelpers) write_basic_package_version_file( - ${LAPACK_BINARY_DIR}/lapack-config-version.cmake + ${LAPACK_BINARY_DIR}/${LAPACKLIB}-config-version.cmake VERSION ${LAPACK_VERSION} COMPATIBILITY SameMajorVersion ) install(FILES - ${LAPACK_BINARY_DIR}/CMakeFiles/lapack-config.cmake - ${LAPACK_BINARY_DIR}/lapack-config-version.cmake - DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/lapack-${LAPACK_VERSION} + ${LAPACK_BINARY_DIR}/CMakeFiles/${LAPACKLIB}-config.cmake + ${LAPACK_BINARY_DIR}/${LAPACKLIB}-config-version.cmake + DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/${LAPACKLIB}-${LAPACK_VERSION} + COMPONENT Development + ) +if (LAPACK++) + install( + DIRECTORY "${LAPACK_BINARY_DIR}/lib/" + DESTINATION "${CMAKE_INSTALL_LIBDIR}${LAPACK_BINARY_PATH_SUFFIX}" + FILES_MATCHING REGEX "liblapackpp.(a|so)$" + ) + install( + DIRECTORY "${PROJECT_BINARY_DIR}/lapackpp-prefix/src/lapackpp/include/" + DESTINATION "${CMAKE_INSTALL_INCLUDEDIR}" + FILES_MATCHING REGEX "\\.(h|hh)$" + ) + write_basic_package_version_file( + "lapackppConfigVersion.cmake" + VERSION 2020.10.02 + COMPATIBILITY AnyNewerVersion ) + install( + FILES "${CMAKE_CURRENT_BINARY_DIR}/lib/lapackpp/lapackppConfig.cmake" + "${CMAKE_CURRENT_BINARY_DIR}/lib/lapackpp/lapackppConfigVersion.cmake" + DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/" + ) + +endif() +if (BLAS++) + write_basic_package_version_file( + "blasppConfigVersion.cmake" + VERSION 2020.10.02 + COMPATIBILITY AnyNewerVersion + ) + install( + FILES "${CMAKE_CURRENT_BINARY_DIR}/lib/blaspp/blasppConfig.cmake" + "${CMAKE_CURRENT_BINARY_DIR}/lib/blaspp/blasppConfigVersion.cmake" + DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/" + ) + install( + DIRECTORY "${LAPACK_BINARY_DIR}/lib/" + DESTINATION "${CMAKE_INSTALL_LIBDIR}${LAPACK_BINARY_PATH_SUFFIX}" + FILES_MATCHING REGEX "libblaspp.(a|so)$" + ) + install( + DIRECTORY "${PROJECT_BINARY_DIR}/blaspp-prefix/src/blaspp/include/" + DESTINATION "${CMAKE_INSTALL_INCLUDEDIR}" + FILES_MATCHING REGEX "\\.(h|hh)$" + ) +endif() + +# -------------------------------------------------- +# Generate MAN and/or HTML Documentation +option(BUILD_HTML_DOCUMENTATION "Create and install the HTML based API +documentation (requires Doxygen) - command: make html" OFF) +option(BUILD_MAN_DOCUMENTATION "Create and install the MAN based documentation (requires Doxygen) - command: make man" OFF) +message(STATUS "Build html documentation: ${BUILD_HTML_DOCUMENTATION}") +message(STATUS "Build man documentation: ${BUILD_MAN_DOCUMENTATION}") + +if(BUILD_HTML_DOCUMENTATION OR BUILD_MAN_DOCUMENTATION) + find_package(Doxygen) + if(NOT DOXYGEN_FOUND) + message(WARNING "Doxygen is needed to build the documentation.") + + else() + + set(DOXYGEN_PROJECT_BRIEF "LAPACK: Linear Algebra PACKage") + set(DOXYGEN_PROJECT_NUMBER ${LAPACK_VERSION}) + set(DOXYGEN_OUTPUT_DIRECTORY DOCS) + set(DOXYGEN_PROJECT_LOGO DOCS/lapack.png) + set(DOXYGEN_OPTIMIZE_FOR_FORTRAN YES) + set(DOXYGEN_SOURCE_BROWSER YES) + set(DOXYGEN_CREATE_SUBDIRS YES) + set(DOXYGEN_SEPARATE_MEMBER_PAGES YES) + set(DOXYGEN_TAB_SIZE 8) + set(DOXYGEN_EXTRACT_ALL YES) + set(DOXYGEN_FILE_PATTERNS *.f *.f90 *.c *.h ) + set(DOXYGEN_RECURSIVE YES) + set(DOXYGEN_GENERATE_TREEVIEW YES) + set(DOXYGEN_DOT_IMAGE_FORMAT svg) + set(DOXYGEN_INTERACTIVE_SVG YES) + set(DOXYGEN_WARN_NO_PARAMDOC YES) + set(DOXYGEN_WARN_LOGFILE doxygen_error) + set(DOXYGEN_LAYOUT_FILE "DOCS/DoxygenLayout.xml") + + # Exclude functions that are duplicated, creating conflicts. + set(DOXYGEN_EXCLUDE .git + .github + SRC/VARIANTS + BLAS/SRC/lsame.f + BLAS/SRC/xerbla.f + BLAS/SRC/xerbla_array.f + INSTALL/slamchf77.f + INSTALL/dlamchf77.f ) + + if (BUILD_HTML_DOCUMENTATION) + set(DOXYGEN_GENERATE_HTML YES) + set(DOXYGEN_GENERATE_MAN NO) + set(DOXYGEN_INLINE_SOURCES YES) + set(DOXYGEN_CALL_GRAPH YES) + set(DOXYGEN_CALLER_GRAPH YES) + + set(DOXYGEN_HTML_OUTPUT explore-html) + set(DOXYGEN_HTML_TIMESTAMP YES) + doxygen_add_docs( + html + + # Doxygen INPUT = + BLAS + CBLAS + SRC + INSTALL + TESTING + DOCS/groups-usr.dox + README.md + + COMMENT "Generating html LAPACK documentation (it will take some time... time to grab a coffee)" + ) + unset(DOXYGEN_HTML_OUTPUT) + unset(DOXYGEN_HTML_TIMESTAMP) + endif() + if (BUILD_MAN_DOCUMENTATION) + set(DOXYGEN_GENERATE_HTML NO) + set(DOXYGEN_GENERATE_MAN YES) + set(DOXYGEN_INLINE_SOURCES NO) + set(DOXYGEN_CALL_GRAPH NO) + set(DOXYGEN_CALLER_GRAPH NO) + + set(DOXYGEN_MAN_LINKS YES) + doxygen_add_docs( + man + + # Doxygen INPUT = + BLAS + CBLAS + SRC + INSTALL + TESTING + DOCS/groups-usr.dox + + COMMENT "Generating man LAPACK documentation" + ) + unset(DOXYGEN_MAN_LINKS) + endif() + + endif() +endif() diff --git a/CTestCustom.cmake.in b/CTestCustom.cmake.in index 45fb1ccda7..b05ff3c207 100644 --- a/CTestCustom.cmake.in +++ b/CTestCustom.cmake.in @@ -46,10 +46,10 @@ set(CTEST_CUSTOM_WARNING_EXCEPTION "Warning: File .* has modification time .* in the future" ) -# Only rung post test if suitable python interpreter was found -set(PYTHONINTERP_FOUND @PYTHONINTERP_FOUND@) -set(PYTHON_EXECUTABLE @PYTHON_EXECUTABLE@) -if(PYTHONINTERP_FOUND) - set(CTEST_CUSTOM_POST_TEST "${PYTHON_EXECUTABLE} ./lapack_testing.py -s -d TESTING") +# Only run post test if suitable python interpreter was found +set(Python3_EXECUTABLE "@Python3_EXECUTABLE@") +set(LAPACK_TESTING_USE_PYTHON @LAPACK_TESTING_USE_PYTHON@) +if(Python3_EXECUTABLE AND LAPACK_TESTING_USE_PYTHON) + set(CTEST_CUSTOM_POST_TEST "\"${Python3_EXECUTABLE}\" ./lapack_testing.py -s -d TESTING --merge-apis") endif() diff --git a/DOCS/CBLAS.md b/DOCS/CBLAS.md new file mode 100644 index 0000000000..cdbb72b508 --- /dev/null +++ b/DOCS/CBLAS.md @@ -0,0 +1,147 @@ +# THE CBLAS C INTERFACE TO BLAS + +## Contents +[1. Introduction](#1-introduction) + +[1.1 Naming Schemes](#11-naming-schemes) + +[1.2 Integers](#12-integers) + +[2. Function List](#2-function-list) + +[2.1 BLAS Level 1](#21-blas-level-1) + +[2.2 BLAS Level 2](#22-blas-level-2) + +[2.3 BLAS Level 3](#23-blas-level-3) + +[3. Examples](#3-examples) + +[3.1 Calling DGEMV](#31-calling-dgemv) + +[3.2 Calling DGEMV_64](#32-calling-dgemv_64) + +## 1. Introduction +This document describes CBLAS, the C language interface to the Basic Linear Algebra Subprograms (BLAS). +In comparison to BLAS Fortran interfaces CBLAS interfaces support both row-major and column-major matrix +ordering with the `layout` parameter. +The prototypes for CBLAS interfaces, associated macros and type definitions are contained in the header +file [cblas.h](../CBLAS/include/cblas.h) + +### 1.1 Naming Schemes +The naming scheme for the CBLAS interface is to take the Fortran BLAS routine name, make it lower case, +and add the prefix `cblas_`. For example, the BLAS routine `DGEMM` becomes `cblas_dgemm`. + +CBLAS routines also support `_64` suffix that enables large data arrays support in the LP64 interface library +(default build configuration). This suffix allows mixing LP64 and ILP64 programming models in one application. +For example, `cblas_dgemm` with 32-bit integer type support can be mixed with `cblas_dgemm_64` +that supports 64-bit integer type. + +### 1.2 Integers +Variables with the Fortran type integer are converted to `CBLAS_INT` in CBLAS. By default +the CBLAS interface is built with 32-bit integer type, but it can be re-defined to 64-bit integer type. + +## 2. Function List +This section contains the list of the currently available CBLAS interfaces. + +### 2.1 BLAS Level 1 +* Single Precision Real: + ``` + SROTG SROTMG SROT SROTM SSWAP SSCAL + SCOPY SAXPY SDOT SDSDOT SNRM2 SASUM + ISAMAX + ``` +* Double Precision Real: + ``` + DROTG DROTMG DROT DROTM DSWAP DSCAL + DCOPY DAXPY DDOT DSDOT DNRM2 DASUM + IDAMAX + ``` +* Single Precision Complex: + ``` + CROTG CSROT CSWAP CSCAL CSSCAL CCOPY + CAXPY CDOTU_SUB CDOTC_SUB ICAMAX SCABS1 + ``` +* Double Precision Complex: + ``` + ZROTG ZDROT ZSWAP ZSCAL ZDSCAL ZCOPY + ZAXPY ZDOTU_SUB ZDOTC_SUB IZAMAX DCABS1 + DZNRM2 DZASUM + ``` +### 2.2 BLAS Level 2 +* Single Precision Real: + ``` + SGEMV SGBMV SGER SSBMV SSPMV SSPR + SSPR2 SSYMV SSYR SSYR2 STBMV STBSV + STPMV STPSV STRMV STRSV SSKEWSYMV + SSKEWSYR2 + ``` +* Double Precision Real: + ``` + DGEMV DGBMV DGER DSBMV DSPMV DSPR + DSPR2 DSYMV DSYR DSYR2 DTBMV DTBSV + DTPMV DTPSV DTRMV DTRSV DSKEWSYMV + DSKEWSYR2 + ``` +* Single Precision Complex: + ``` + CGEMV CGBMV CHEMV CHBMV CHPMV CTRMV + CTBMV CTPMV CTRSV CTBSV CTPSV CGERU + CGERC CHER CHER2 CHPR CHPR2 + ``` +* Double Precision Complex: + ``` + ZGEMV ZGBMV ZHEMV ZHBMV ZHPMV ZTRMV + ZTBMV ZTPMV ZTRSV ZTBSV ZTPSV ZGERU + ZGERC ZHER ZHER2 ZHPR ZHPR2 + ``` +### 2.3 BLAS Level 3 +* Single Precision Real: + ``` + SGEMM SSYMM SSYRK SSERK2K STRMM STRSM + SSKEWSYMM SSKEWSYR2K + ``` +* Double Precision Real: + ``` + DGEMM DSYMM DSYRK DSERK2K DTRMM DTRSM + DSKEWSYMM DSKEWSYR2K + ``` +* Single Precision Complex: + ``` + CGEMM CSYMM CHEMM CHERK CHER2K CTRMM + CTRSM CSYRK CSYR2K + ``` +* Double Precision Complex: + ``` + ZGEMM ZSYMM ZHEMM ZHERK ZHER2K ZTRMM + ZTRSM ZSYRK ZSYR2K + ``` + +## 3. Examples +This section contains examples of calling CBLAS functions from a C program. + +### 3.1 Calling DGEMV +The variable declarations should be as follows: +``` + double *a, *x, *y; + double alpha, beta; + CBLAS_INT m, n, lda, incx, incy; +``` +The CBLAS function call is then: +``` +cblas_dgemv( CblasColMajor, CblasNoTrans, m, n, alpha, a, lda, x, incx, beta, + y, incy ); +``` + +### 3.2 Calling DGEMV_64 +The variable declarations should be as follows: +``` + double *a, *x, *y; + double alpha, beta; + int64_t m, n, lda, incx, incy; +``` +The CBLAS function call is then: +``` +cblas_dgemv_64( CblasColMajor, CblasNoTrans, m, n, alpha, a, lda, x, incx, beta, + y, incy ); +``` diff --git a/DOCS/Doxyfile b/DOCS/Doxyfile index a35df78b9c..efb4ddaf16 100644 --- a/DOCS/Doxyfile +++ b/DOCS/Doxyfile @@ -1,7 +1,7 @@ -# Doxyfile 1.8.10 +# Doxyfile 1.12.0 # This file describes the settings to be used by the documentation system -# doxygen (www.doxygen.org) for a project. +# Doxygen (www.doxygen.org) for a project. # # All text after a double hash (##) is considered a comment and is placed in # front of the TAG it is preceding. @@ -12,16 +12,26 @@ # For lists, items can also be appended using: # TAG += value [value, ...] # Values that contain spaces should be placed between quotes (\" \"). +# +# Note: +# +# Use Doxygen to compare the used configuration file with the template +# configuration file: +# doxygen -x [configFile] +# Use Doxygen to compare the used configuration file with the template +# configuration file without replacing the environment variables or CMake type +# replacement variables: +# doxygen -x_noenv [configFile] #--------------------------------------------------------------------------- # Project related configuration options #--------------------------------------------------------------------------- -# This tag specifies the encoding used for all characters in the config file -# that follow. The default is UTF-8 which is also the encoding used for all text -# before the first occurrence of this tag. Doxygen uses libiconv (or the iconv -# built into libc) for the transcoding. See http://www.gnu.org/software/libiconv -# for the list of possible encodings. +# This tag specifies the encoding used for all characters in the configuration +# file that follow. The default is UTF-8 which is also the encoding used for all +# text before the first occurrence of this tag. Doxygen uses libiconv (or the +# iconv built into libc) for the transcoding. See +# https://www.gnu.org/software/libiconv/ for the list of possible encodings. # The default value is: UTF-8. DOXYFILE_ENCODING = UTF-8 @@ -38,7 +48,7 @@ PROJECT_NAME = LAPACK # could be handy for archiving the generated documentation or if some version # control system is used. -PROJECT_NUMBER = 3.7.1 +PROJECT_NUMBER = 3.12.1 # Using the PROJECT_BRIEF tag one can provide an optional one line description # for a project that appears at the top of each page and should give viewer a @@ -53,24 +63,42 @@ PROJECT_BRIEF = "LAPACK: Linear Algebra PACKage" PROJECT_LOGO = DOCS/lapack.png +# With the PROJECT_ICON tag one can specify an icon that is included in the tabs +# when the HTML document is shown. Doxygen will copy the logo to the output +# directory. + +PROJECT_ICON = + # The OUTPUT_DIRECTORY tag is used to specify the (relative or absolute) path # into which the generated documentation will be written. If a relative path is -# entered, it will be relative to the location where doxygen was started. If +# entered, it will be relative to the location where Doxygen was started. If # left blank the current directory will be used. OUTPUT_DIRECTORY = DOCS -# If the CREATE_SUBDIRS tag is set to YES then doxygen will create 4096 sub- -# directories (in 2 levels) under the output directory of each output format and -# will distribute the generated files over these directories. Enabling this -# option can be useful when feeding doxygen a huge amount of source files, where +# If the CREATE_SUBDIRS tag is set to YES then Doxygen will create up to 4096 +# sub-directories (in 2 levels) under the output directory of each output format +# and will distribute the generated files over these directories. Enabling this +# option can be useful when feeding Doxygen a huge amount of source files, where # putting all generated files in the same directory would otherwise causes -# performance problems for the file system. +# performance problems for the file system. Adapt CREATE_SUBDIRS_LEVEL to +# control the number of sub-directories. # The default value is: NO. CREATE_SUBDIRS = YES -# If the ALLOW_UNICODE_NAMES tag is set to YES, doxygen will allow non-ASCII +# Controls the number of sub-directories that will be created when +# CREATE_SUBDIRS tag is set to YES. Level 0 represents 16 directories, and every +# level increment doubles the number of directories, resulting in 4096 +# directories at level 8 which is the default and also the maximum value. The +# sub-directories are organized in 2 levels, the first level always has a fixed +# number of 16 directories. +# Minimum value: 0, maximum value: 8, default value: 8. +# This tag requires that the tag CREATE_SUBDIRS is set to YES. + +CREATE_SUBDIRS_LEVEL = 8 + +# If the ALLOW_UNICODE_NAMES tag is set to YES, Doxygen will allow non-ASCII # characters to appear in the names of generated files. If set to NO, non-ASCII # characters will be escaped, for example _xE3_x81_x84 will be used for Unicode # U+3044. @@ -79,28 +107,28 @@ CREATE_SUBDIRS = YES ALLOW_UNICODE_NAMES = NO # The OUTPUT_LANGUAGE tag is used to specify the language in which all -# documentation generated by doxygen is written. Doxygen will use this +# documentation generated by Doxygen is written. Doxygen will use this # information to generate all constant output in the proper language. -# Possible values are: Afrikaans, Arabic, Armenian, Brazilian, Catalan, Chinese, -# Chinese-Traditional, Croatian, Czech, Danish, Dutch, English (United States), -# Esperanto, Farsi (Persian), Finnish, French, German, Greek, Hungarian, -# Indonesian, Italian, Japanese, Japanese-en (Japanese with English messages), -# Korean, Korean-en (Korean with English messages), Latvian, Lithuanian, -# Macedonian, Norwegian, Persian (Farsi), Polish, Portuguese, Romanian, Russian, -# Serbian, Serbian-Cyrillic, Slovak, Slovene, Spanish, Swedish, Turkish, -# Ukrainian and Vietnamese. +# Possible values are: Afrikaans, Arabic, Armenian, Brazilian, Bulgarian, +# Catalan, Chinese, Chinese-Traditional, Croatian, Czech, Danish, Dutch, English +# (United States), Esperanto, Farsi (Persian), Finnish, French, German, Greek, +# Hindi, Hungarian, Indonesian, Italian, Japanese, Japanese-en (Japanese with +# English messages), Korean, Korean-en (Korean with English messages), Latvian, +# Lithuanian, Macedonian, Norwegian, Persian (Farsi), Polish, Portuguese, +# Romanian, Russian, Serbian, Serbian-Cyrillic, Slovak, Slovene, Spanish, +# Swedish, Turkish, Ukrainian and Vietnamese. # The default value is: English. OUTPUT_LANGUAGE = English -# If the BRIEF_MEMBER_DESC tag is set to YES, doxygen will include brief member +# If the BRIEF_MEMBER_DESC tag is set to YES, Doxygen will include brief member # descriptions after the members that are listed in the file and class # documentation (similar to Javadoc). Set to NO to disable this. # The default value is: YES. BRIEF_MEMBER_DESC = YES -# If the REPEAT_BRIEF tag is set to YES, doxygen will prepend the brief +# If the REPEAT_BRIEF tag is set to YES, Doxygen will prepend the brief # description of a member or function before the detailed description # # Note: If both HIDE_UNDOC_MEMBERS and BRIEF_MEMBER_DESC are set to NO, the @@ -118,16 +146,26 @@ REPEAT_BRIEF = YES # the entity):The $name class, The $name widget, The $name file, is, provides, # specifies, contains, represents, a, an and the. -ABBREVIATE_BRIEF = +ABBREVIATE_BRIEF = "The $name class" \ + "The $name widget" \ + "The $name file" \ + is \ + provides \ + specifies \ + contains \ + represents \ + a \ + an \ + the # If the ALWAYS_DETAILED_SEC and REPEAT_BRIEF tags are both set to YES then -# doxygen will generate a detailed section even if there is only a brief +# Doxygen will generate a detailed section even if there is only a brief # description. # The default value is: NO. ALWAYS_DETAILED_SEC = NO -# If the INLINE_INHERITED_MEMB tag is set to YES, doxygen will show all +# If the INLINE_INHERITED_MEMB tag is set to YES, Doxygen will show all # inherited members of a class in the documentation of that class as if those # members were ordinary class members. Constructors, destructors and assignment # operators of the base classes will not be shown. @@ -135,7 +173,7 @@ ALWAYS_DETAILED_SEC = NO INLINE_INHERITED_MEMB = NO -# If the FULL_PATH_NAMES tag is set to YES, doxygen will prepend the full path +# If the FULL_PATH_NAMES tag is set to YES, Doxygen will prepend the full path # before files name in the file list and in the header files. If set to NO the # shortest path that makes the file name unique will be used # The default value is: YES. @@ -145,11 +183,11 @@ FULL_PATH_NAMES = YES # The STRIP_FROM_PATH tag can be used to strip a user-defined part of the path. # Stripping is only done if one of the specified strings matches the left-hand # part of the path. The tag can be used to show relative paths in the file list. -# If left blank the directory from which doxygen is run is used as the path to +# If left blank the directory from which Doxygen is run is used as the path to # strip. # # Note that you can specify absolute paths here, but also relative paths, which -# will be relative from the directory where doxygen is started. +# will be relative from the directory where Doxygen is started. # This tag requires that the tag FULL_PATH_NAMES is set to YES. STRIP_FROM_PATH = @@ -163,14 +201,14 @@ STRIP_FROM_PATH = STRIP_FROM_INC_PATH = -# If the SHORT_NAMES tag is set to YES, doxygen will generate much shorter (but +# If the SHORT_NAMES tag is set to YES, Doxygen will generate much shorter (but # less readable) file names. This can be useful is your file systems doesn't # support long names like on DOS, Mac, or CD-ROM. # The default value is: NO. SHORT_NAMES = NO -# If the JAVADOC_AUTOBRIEF tag is set to YES then doxygen will interpret the +# If the JAVADOC_AUTOBRIEF tag is set to YES then Doxygen will interpret the # first line (until the first dot) of a Javadoc-style comment as the brief # description. If set to NO, the Javadoc-style will behave just like regular Qt- # style comments (thus requiring an explicit @brief command for a brief @@ -179,7 +217,17 @@ SHORT_NAMES = NO JAVADOC_AUTOBRIEF = NO -# If the QT_AUTOBRIEF tag is set to YES then doxygen will interpret the first +# If the JAVADOC_BANNER tag is set to YES then Doxygen will interpret a line +# such as +# /*************** +# as being the beginning of a Javadoc-style comment "banner". If set to NO, the +# Javadoc-style will behave just like regular comments and it will not be +# interpreted by Doxygen. +# The default value is: NO. + +JAVADOC_BANNER = NO + +# If the QT_AUTOBRIEF tag is set to YES then Doxygen will interpret the first # line (until the first dot) of a Qt-style comment as the brief description. If # set to NO, the Qt-style will behave just like regular Qt-style comments (thus # requiring an explicit \brief command for a brief description.) @@ -187,7 +235,7 @@ JAVADOC_AUTOBRIEF = NO QT_AUTOBRIEF = NO -# The MULTILINE_CPP_IS_BRIEF tag can be set to YES to make doxygen treat a +# The MULTILINE_CPP_IS_BRIEF tag can be set to YES to make Doxygen treat a # multi-line C++ special comment block (i.e. a block of //! or /// comments) as # a brief description. This used to be the default behavior. The new default is # to treat a multi-line C++ comment block as a detailed description. Set this @@ -199,13 +247,21 @@ QT_AUTOBRIEF = NO MULTILINE_CPP_IS_BRIEF = NO +# By default Python docstrings are displayed as preformatted text and Doxygen's +# special commands cannot be used. By setting PYTHON_DOCSTRING to NO the +# Doxygen's special commands can be used and the contents of the docstring +# documentation blocks is shown as Doxygen documentation. +# The default value is: YES. + +PYTHON_DOCSTRING = YES + # If the INHERIT_DOCS tag is set to YES then an undocumented member inherits the # documentation from any documented member that it re-implements. # The default value is: YES. INHERIT_DOCS = YES -# If the SEPARATE_MEMBER_PAGES tag is set to YES then doxygen will produce a new +# If the SEPARATE_MEMBER_PAGES tag is set to YES then Doxygen will produce a new # page for each member. If set to NO, the documentation of a member will be part # of the file/class/namespace that contains it. # The default value is: NO. @@ -222,20 +278,19 @@ TAB_SIZE = 8 # the documentation. An alias has the form: # name=value # For example adding -# "sideeffect=@par Side Effects:\n" +# "sideeffect=@par Side Effects:^^" # will allow you to put the command \sideeffect (or @sideeffect) in the # documentation, which will result in a user-defined paragraph with heading -# "Side Effects:". You can put \n's in the value part of an alias to insert -# newlines. +# "Side Effects:". Note that you cannot put \n's in the value part of an alias +# to insert newlines (in the resulting output). You can put ^^ in the value part +# of an alias to insert a newline as if a physical newline was in the original +# file. When you need a literal { or } or , in the value part of an alias you +# have to escape them by means of a backslash (\), this can lead to conflicts +# with the commands \{ and \} for these it is advised to use the version @{ and +# @} or use a double escape (\\{ and \\}) ALIASES = -# This tag can be used to specify a number of word-keyword mappings (TCL only). -# A mapping has the form "name=value". For example adding "class=itcl::class" -# will allow you to use the command class in the itcl::class meaning. - -TCL_SUBST = - # Set the OPTIMIZE_OUTPUT_FOR_C tag to YES if your project consists of C sources # only. Doxygen will then generate output that is more tailored for C. For # instance, some of the names that are used will be different. The list of all @@ -264,36 +319,68 @@ OPTIMIZE_FOR_FORTRAN = YES OPTIMIZE_OUTPUT_VHDL = NO +# Set the OPTIMIZE_OUTPUT_SLICE tag to YES if your project consists of Slice +# sources only. Doxygen will then generate output that is more tailored for that +# language. For instance, namespaces will be presented as modules, types will be +# separated into more groups, etc. +# The default value is: NO. + +OPTIMIZE_OUTPUT_SLICE = NO + # Doxygen selects the parser to use depending on the extension of the files it # parses. With this tag you can assign which parser to use for a given # extension. Doxygen has a built-in mapping, but you can override or extend it # using this tag. The format is ext=language, where ext is a file extension, and -# language is one of the parsers supported by doxygen: IDL, Java, Javascript, -# C#, C, C++, D, PHP, Objective-C, Python, Fortran (fixed format Fortran: -# FortranFixed, free formatted Fortran: FortranFree, unknown formatted Fortran: -# Fortran. In the later case the parser tries to guess whether the code is fixed -# or free formatted code, this is the default for Fortran type files), VHDL. For -# instance to make doxygen treat .inc files as Fortran files (default is PHP), -# and .f files as C (default is Fortran), use: inc=Fortran f=C. +# language is one of the parsers supported by Doxygen: IDL, Java, JavaScript, +# Csharp (C#), C, C++, Lex, D, PHP, md (Markdown), Objective-C, Python, Slice, +# VHDL, Fortran (fixed format Fortran: FortranFixed, free formatted Fortran: +# FortranFree, unknown formatted Fortran: Fortran. In the later case the parser +# tries to guess whether the code is fixed or free formatted code, this is the +# default for Fortran type files). For instance to make Doxygen treat .inc files +# as Fortran files (default is PHP), and .f files as C (default is Fortran), +# use: inc=Fortran f=C. # # Note: For files without extension you can use no_extension as a placeholder. # # Note that for custom extensions you also need to set FILE_PATTERNS otherwise -# the files are not read by doxygen. +# the files are not read by Doxygen. When specifying no_extension you should add +# * to the FILE_PATTERNS. +# +# Note see also the list of default file extension mappings. EXTENSION_MAPPING = -# If the MARKDOWN_SUPPORT tag is enabled then doxygen pre-processes all comments +# If the MARKDOWN_SUPPORT tag is enabled then Doxygen pre-processes all comments # according to the Markdown format, which allows for more readable -# documentation. See http://daringfireball.net/projects/markdown/ for details. -# The output of markdown processing is further processed by doxygen, so you can -# mix doxygen, HTML, and XML commands with Markdown formatting. Disable only in +# documentation. See https://daringfireball.net/projects/markdown/ for details. +# The output of markdown processing is further processed by Doxygen, so you can +# mix Doxygen, HTML, and XML commands with Markdown formatting. Disable only in # case of backward compatibilities issues. # The default value is: YES. MARKDOWN_SUPPORT = YES -# When enabled doxygen tries to link words that correspond to documented +# When the TOC_INCLUDE_HEADINGS tag is set to a non-zero value, all headings up +# to that level are automatically included in the table of contents, even if +# they do not have an id attribute. +# Note: This feature currently applies only to Markdown headings. +# Minimum value: 0, maximum value: 99, default value: 6. +# This tag requires that the tag MARKDOWN_SUPPORT is set to YES. + +TOC_INCLUDE_HEADINGS = 5 + +# The MARKDOWN_ID_STYLE tag can be used to specify the algorithm used to +# generate identifiers for the Markdown headings. Note: Every identifier is +# unique. +# Possible values are: DOXYGEN use a fixed 'autotoc_md' string followed by a +# sequence number starting at 0 and GITHUB use the lower case version of title +# with any whitespace replaced by '-' and punctuation characters removed. +# The default value is: DOXYGEN. +# This tag requires that the tag MARKDOWN_SUPPORT is set to YES. + +MARKDOWN_ID_STYLE = DOXYGEN + +# When enabled Doxygen tries to link words that correspond to documented # classes, or namespaces to their corresponding documentation. Such a link can # be prevented in individual cases by putting a % sign in front of the word or # globally by setting AUTOLINK_SUPPORT to NO. @@ -303,10 +390,10 @@ AUTOLINK_SUPPORT = YES # If you use STL classes (i.e. std::string, std::vector, etc.) but do not want # to include (a tag file for) the STL sources as input, then you should set this -# tag to YES in order to let doxygen match functions declarations and +# tag to YES in order to let Doxygen match functions declarations and # definitions whose arguments contain STL classes (e.g. func(std::string); -# versus func(std::string) {}). This also make the inheritance and collaboration -# diagrams that involve STL classes more complete and accurate. +# versus func(std::string) {}). This also makes the inheritance and +# collaboration diagrams that involve STL classes more complete and accurate. # The default value is: NO. BUILTIN_STL_SUPPORT = NO @@ -318,16 +405,16 @@ BUILTIN_STL_SUPPORT = NO CPP_CLI_SUPPORT = NO # Set the SIP_SUPPORT tag to YES if your project consists of sip (see: -# http://www.riverbankcomputing.co.uk/software/sip/intro) sources only. Doxygen -# will parse them like normal C++ but will assume all classes use public instead -# of private inheritance when no explicit protection keyword is present. +# https://www.riverbankcomputing.com/software) sources only. Doxygen will parse +# them like normal C++ but will assume all classes use public instead of private +# inheritance when no explicit protection keyword is present. # The default value is: NO. SIP_SUPPORT = NO # For Microsoft's IDL there are propget and propput attributes to indicate # getter and setter methods for a property. Setting this option to YES will make -# doxygen to replace the get and set methods by a property in the documentation. +# Doxygen to replace the get and set methods by a property in the documentation. # This will only work if the methods are indeed getting or setting a simple # type. If this is not the case, or you want to show the methods anyway, you # should set this option to NO. @@ -336,12 +423,12 @@ SIP_SUPPORT = NO IDL_PROPERTY_SUPPORT = YES # If member grouping is used in the documentation and the DISTRIBUTE_GROUP_DOC -# tag is set to YES then doxygen will reuse the documentation of the first +# tag is set to YES then Doxygen will reuse the documentation of the first # member in the group (if any) for the other members of the group. By default # all members of a group must be documented explicitly. # The default value is: NO. -DISTRIBUTE_GROUP_DOC = YES +DISTRIBUTE_GROUP_DOC = NO # If one adds a struct or class to a group and this option is enabled, then also # any nested class or struct is added to the same group. By default this option @@ -394,21 +481,42 @@ TYPEDEF_HIDES_STRUCT = NO # The size of the symbol lookup cache can be set using LOOKUP_CACHE_SIZE. This # cache is used to resolve symbols given their name and scope. Since this can be # an expensive process and often the same symbol appears multiple times in the -# code, doxygen keeps a cache of pre-resolved symbols. If the cache is too small -# doxygen will become slower. If the cache is too large, memory is wasted. The +# code, Doxygen keeps a cache of pre-resolved symbols. If the cache is too small +# Doxygen will become slower. If the cache is too large, memory is wasted. The # cache size is given by this formula: 2^(16+LOOKUP_CACHE_SIZE). The valid range # is 0..9, the default is 0, corresponding to a cache size of 2^16=65536 -# symbols. At the end of a run doxygen will report the cache usage and suggest +# symbols. At the end of a run Doxygen will report the cache usage and suggest # the optimal cache size from a speed point of view. # Minimum value: 0, maximum value: 9, default value: 0. LOOKUP_CACHE_SIZE = 0 +# The NUM_PROC_THREADS specifies the number of threads Doxygen is allowed to use +# during processing. When set to 0 Doxygen will based this on the number of +# cores available in the system. You can set it explicitly to a value larger +# than 0 to get more control over the balance between CPU load and processing +# speed. At this moment only the input processing can be done using multiple +# threads. Since this is still an experimental feature the default is set to 1, +# which effectively disables parallel processing. Please report any issues you +# encounter. Generating dot graphs in parallel is controlled by the +# DOT_NUM_THREADS setting. +# Minimum value: 0, maximum value: 32, default value: 1. + +NUM_PROC_THREADS = 1 + +# If the TIMESTAMP tag is set different from NO then each generated page will +# contain the date or date and time when the page was generated. Setting this to +# NO can help when comparing the output of multiple runs. +# Possible values are: YES, NO, DATETIME and DATE. +# The default value is: NO. + +TIMESTAMP = YES + #--------------------------------------------------------------------------- # Build related configuration options #--------------------------------------------------------------------------- -# If the EXTRACT_ALL tag is set to YES, doxygen will assume all entities in +# If the EXTRACT_ALL tag is set to YES, Doxygen will assume all entities in # documentation are documented, even if no documentation was available. Private # class members and static file members will be hidden unless the # EXTRACT_PRIVATE respectively EXTRACT_STATIC tags are set to YES. @@ -424,6 +532,12 @@ EXTRACT_ALL = YES EXTRACT_PRIVATE = NO +# If the EXTRACT_PRIV_VIRTUAL tag is set to YES, documented private virtual +# methods of a class will be included in the documentation. +# The default value is: NO. + +EXTRACT_PRIV_VIRTUAL = NO + # If the EXTRACT_PACKAGE tag is set to YES, all members with package or internal # scope will be included in the documentation. # The default value is: NO. @@ -461,7 +575,14 @@ EXTRACT_LOCAL_METHODS = NO EXTRACT_ANON_NSPACES = NO -# If the HIDE_UNDOC_MEMBERS tag is set to YES, doxygen will hide all +# If this flag is set to YES, the name of an unnamed parameter in a declaration +# will be determined by the corresponding definition. By default unnamed +# parameters remain unnamed in the output. +# The default value is: YES. + +RESOLVE_UNNAMED_PARAMS = YES + +# If the HIDE_UNDOC_MEMBERS tag is set to YES, Doxygen will hide all # undocumented members inside documented classes or files. If set to NO these # members will be included in the various overviews, but no documentation # section is generated. This option has no effect if EXTRACT_ALL is enabled. @@ -469,22 +590,23 @@ EXTRACT_ANON_NSPACES = NO HIDE_UNDOC_MEMBERS = NO -# If the HIDE_UNDOC_CLASSES tag is set to YES, doxygen will hide all +# If the HIDE_UNDOC_CLASSES tag is set to YES, Doxygen will hide all # undocumented classes that are normally visible in the class hierarchy. If set # to NO, these classes will be included in the various overviews. This option -# has no effect if EXTRACT_ALL is enabled. +# will also hide undocumented C++ concepts if enabled. This option has no effect +# if EXTRACT_ALL is enabled. # The default value is: NO. HIDE_UNDOC_CLASSES = NO -# If the HIDE_FRIEND_COMPOUNDS tag is set to YES, doxygen will hide all friend -# (class|struct|union) declarations. If set to NO, these declarations will be -# included in the documentation. +# If the HIDE_FRIEND_COMPOUNDS tag is set to YES, Doxygen will hide all friend +# declarations. If set to NO, these declarations will be included in the +# documentation. # The default value is: NO. HIDE_FRIEND_COMPOUNDS = NO -# If the HIDE_IN_BODY_DOCS tag is set to YES, doxygen will hide any +# If the HIDE_IN_BODY_DOCS tag is set to YES, Doxygen will hide any # documentation blocks found inside the body of a function. If set to NO, these # blocks will be appended to the function's detailed documentation block. # The default value is: NO. @@ -498,30 +620,44 @@ HIDE_IN_BODY_DOCS = NO INTERNAL_DOCS = NO -# If the CASE_SENSE_NAMES tag is set to NO then doxygen will only generate file -# names in lower-case letters. If set to YES, upper-case letters are also -# allowed. This is useful if you have classes or files whose names only differ -# in case and if your file system supports case sensitive file names. Windows -# and Mac users are advised to set this option to NO. -# The default value is: system dependent. +# With the correct setting of option CASE_SENSE_NAMES Doxygen will better be +# able to match the capabilities of the underlying filesystem. In case the +# filesystem is case sensitive (i.e. it supports files in the same directory +# whose names only differ in casing), the option must be set to YES to properly +# deal with such files in case they appear in the input. For filesystems that +# are not case sensitive the option should be set to NO to properly deal with +# output files written for symbols that only differ in casing, such as for two +# classes, one named CLASS and the other named Class, and to also support +# references to files without having to specify the exact matching casing. On +# Windows (including Cygwin) and macOS, users should typically set this option +# to NO, whereas on Linux or other Unix flavors it should typically be set to +# YES. +# Possible values are: SYSTEM, NO and YES. +# The default value is: SYSTEM. CASE_SENSE_NAMES = NO -# If the HIDE_SCOPE_NAMES tag is set to NO then doxygen will show members with +# If the HIDE_SCOPE_NAMES tag is set to NO then Doxygen will show members with # their full class and namespace scopes in the documentation. If set to YES, the # scope will be hidden. # The default value is: NO. HIDE_SCOPE_NAMES = NO -# If the HIDE_COMPOUND_REFERENCE tag is set to NO (default) then doxygen will +# If the HIDE_COMPOUND_REFERENCE tag is set to NO (default) then Doxygen will # append additional text to a page's title, such as Class Reference. If set to # YES the compound reference will be hidden. # The default value is: NO. HIDE_COMPOUND_REFERENCE= NO -# If the SHOW_INCLUDE_FILES tag is set to YES then doxygen will put a list of +# If the SHOW_HEADERFILE tag is set to YES then the documentation for a class +# will show which file needs to be included to use the class. +# The default value is: YES. + +SHOW_HEADERFILE = YES + +# If the SHOW_INCLUDE_FILES tag is set to YES then Doxygen will put a list of # the files that are included by a file in the documentation of that file. # The default value is: YES. @@ -534,7 +670,7 @@ SHOW_INCLUDE_FILES = YES SHOW_GROUPED_MEMB_INC = NO -# If the FORCE_LOCAL_INCLUDES tag is set to YES then doxygen will list include +# If the FORCE_LOCAL_INCLUDES tag is set to YES then Doxygen will list include # files with double quotes in the documentation rather than with sharp brackets. # The default value is: NO. @@ -546,14 +682,14 @@ FORCE_LOCAL_INCLUDES = NO INLINE_INFO = YES -# If the SORT_MEMBER_DOCS tag is set to YES then doxygen will sort the +# If the SORT_MEMBER_DOCS tag is set to YES then Doxygen will sort the # (detailed) documentation of file and class members alphabetically by member # name. If set to NO, the members will appear in declaration order. # The default value is: YES. SORT_MEMBER_DOCS = YES -# If the SORT_BRIEF_DOCS tag is set to YES then doxygen will sort the brief +# If the SORT_BRIEF_DOCS tag is set to YES then Doxygen will sort the brief # descriptions of file, namespace and class members alphabetically by member # name. If set to NO, the members will appear in declaration order. Note that # this will also influence the order of the classes in the class list. @@ -561,7 +697,7 @@ SORT_MEMBER_DOCS = YES SORT_BRIEF_DOCS = NO -# If the SORT_MEMBERS_CTORS_1ST tag is set to YES then doxygen will sort the +# If the SORT_MEMBERS_CTORS_1ST tag is set to YES then Doxygen will sort the # (brief and detailed) documentation of class members so that constructors and # destructors are listed first. If set to NO the constructors will appear in the # respective orders defined by SORT_BRIEF_DOCS and SORT_MEMBER_DOCS. @@ -573,7 +709,7 @@ SORT_BRIEF_DOCS = NO SORT_MEMBERS_CTORS_1ST = NO -# If the SORT_GROUP_NAMES tag is set to YES then doxygen will sort the hierarchy +# If the SORT_GROUP_NAMES tag is set to YES then Doxygen will sort the hierarchy # of group names into alphabetical order. If set to NO the group names will # appear in their defined order. # The default value is: NO. @@ -590,11 +726,11 @@ SORT_GROUP_NAMES = NO SORT_BY_SCOPE_NAME = NO -# If the STRICT_PROTO_MATCHING option is enabled and doxygen fails to do proper +# If the STRICT_PROTO_MATCHING option is enabled and Doxygen fails to do proper # type resolution of all parameters of a function it will reject a match between # the prototype and the implementation of a member function even if there is # only one candidate or it is obvious which candidate to choose by doing a -# simple string match. By disabling STRICT_PROTO_MATCHING doxygen will still +# simple string match. By disabling STRICT_PROTO_MATCHING Doxygen will still # accept a match between prototype and implementation in such cases. # The default value is: NO. @@ -664,51 +800,68 @@ SHOW_FILES = YES SHOW_NAMESPACES = YES # The FILE_VERSION_FILTER tag can be used to specify a program or script that -# doxygen should invoke to get the current version for each file (typically from +# Doxygen should invoke to get the current version for each file (typically from # the version control system). Doxygen will invoke the program by executing (via # popen()) the command command input-file, where command is the value of the # FILE_VERSION_FILTER tag, and input-file is the name of an input file provided -# by doxygen. Whatever the program writes to standard output is used as the file +# by Doxygen. Whatever the program writes to standard output is used as the file # version. For an example see the documentation. FILE_VERSION_FILTER = # The LAYOUT_FILE tag can be used to specify a layout file which will be parsed -# by doxygen. The layout file controls the global structure of the generated +# by Doxygen. The layout file controls the global structure of the generated # output files in an output format independent way. To create the layout file -# that represents doxygen's defaults, run doxygen with the -l option. You can +# that represents Doxygen's defaults, run Doxygen with the -l option. You can # optionally specify a file name after the option, if omitted DoxygenLayout.xml -# will be used as the name of the layout file. +# will be used as the name of the layout file. See also section "Changing the +# layout of pages" for information. # -# Note that if you run doxygen from a directory containing a file called -# DoxygenLayout.xml, doxygen will parse it automatically even if the LAYOUT_FILE +# Note that if you run Doxygen from a directory containing a file called +# DoxygenLayout.xml, Doxygen will parse it automatically even if the LAYOUT_FILE # tag is left empty. -LAYOUT_FILE = +LAYOUT_FILE = DOCS/DoxygenLayout.xml # The CITE_BIB_FILES tag can be used to specify one or more bib files containing # the reference definitions. This must be a list of .bib files. The .bib # extension is automatically appended if omitted. This requires the bibtex tool -# to be installed. See also http://en.wikipedia.org/wiki/BibTeX for more info. +# to be installed. See also https://en.wikipedia.org/wiki/BibTeX for more info. # For LaTeX the style of the bibliography can be controlled using # LATEX_BIB_STYLE. To use this feature you need bibtex and perl available in the # search path. See also \cite for info how to create references. CITE_BIB_FILES = +# The EXTERNAL_TOOL_PATH tag can be used to extend the search path (PATH +# environment variable) so that external tools such as latex and gs can be +# found. +# Note: Directories specified with EXTERNAL_TOOL_PATH are added in front of the +# path already specified by the PATH variable, and are added in the order +# specified. +# Note: This option is particularly useful for macOS version 14 (Sonoma) and +# higher, when running Doxygen from Doxywizard, because in this case any user- +# defined changes to the PATH are ignored. A typical example on macOS is to set +# EXTERNAL_TOOL_PATH = /Library/TeX/texbin /usr/local/bin +# together with the standard path, the full search path used by doxygen when +# launching external tools will then become +# PATH=/Library/TeX/texbin:/usr/local/bin:/usr/bin:/bin:/usr/sbin:/sbin + +EXTERNAL_TOOL_PATH = + #--------------------------------------------------------------------------- # Configuration options related to warning and progress messages #--------------------------------------------------------------------------- # The QUIET tag can be used to turn on/off the messages that are generated to -# standard output by doxygen. If QUIET is set to YES this implies that the +# standard output by Doxygen. If QUIET is set to YES this implies that the # messages are off. # The default value is: NO. -QUIET = YES +QUIET = NO # The WARNINGS tag can be used to turn on/off the warning messages that are -# generated to standard error (stderr) by doxygen. If WARNINGS is set to YES +# generated to standard error (stderr) by Doxygen. If WARNINGS is set to YES # this implies that the warnings are on. # # Tip: Turn warnings on while writing the documentation. @@ -716,44 +869,91 @@ QUIET = YES WARNINGS = YES -# If the WARN_IF_UNDOCUMENTED tag is set to YES then doxygen will generate +# If the WARN_IF_UNDOCUMENTED tag is set to YES then Doxygen will generate # warnings for undocumented members. If EXTRACT_ALL is set to YES then this flag # will automatically be disabled. # The default value is: YES. WARN_IF_UNDOCUMENTED = YES -# If the WARN_IF_DOC_ERROR tag is set to YES, doxygen will generate warnings for -# potential errors in the documentation, such as not documenting some parameters -# in a documented function, or documenting parameters that don't exist or using -# markup commands wrongly. +# If the WARN_IF_DOC_ERROR tag is set to YES, Doxygen will generate warnings for +# potential errors in the documentation, such as documenting some parameters in +# a documented function twice, or documenting parameters that don't exist or +# using markup commands wrongly. # The default value is: YES. WARN_IF_DOC_ERROR = YES +# If WARN_IF_INCOMPLETE_DOC is set to YES, Doxygen will warn about incomplete +# function parameter documentation. If set to NO, Doxygen will accept that some +# parameters have no documentation without warning. +# The default value is: YES. + +WARN_IF_INCOMPLETE_DOC = YES + # This WARN_NO_PARAMDOC option can be enabled to get warnings for functions that # are documented, but have no documentation for their parameters or return -# value. If set to NO, doxygen will only warn about wrong or incomplete -# parameter documentation, but not about the absence of documentation. +# value. If set to NO, Doxygen will only warn about wrong parameter +# documentation, but not about the absence of documentation. If EXTRACT_ALL is +# set to YES then this flag will automatically be disabled. See also +# WARN_IF_INCOMPLETE_DOC # The default value is: NO. -WARN_NO_PARAMDOC = NO +WARN_NO_PARAMDOC = YES -# The WARN_FORMAT tag determines the format of the warning messages that doxygen +# If WARN_IF_UNDOC_ENUM_VAL option is set to YES, Doxygen will warn about +# undocumented enumeration values. If set to NO, Doxygen will accept +# undocumented enumeration values. If EXTRACT_ALL is set to YES then this flag +# will automatically be disabled. +# The default value is: NO. + +WARN_IF_UNDOC_ENUM_VAL = NO + +# If the WARN_AS_ERROR tag is set to YES then Doxygen will immediately stop when +# a warning is encountered. If the WARN_AS_ERROR tag is set to FAIL_ON_WARNINGS +# then Doxygen will continue running as if WARN_AS_ERROR tag is set to NO, but +# at the end of the Doxygen process Doxygen will return with a non-zero status. +# If the WARN_AS_ERROR tag is set to FAIL_ON_WARNINGS_PRINT then Doxygen behaves +# like FAIL_ON_WARNINGS but in case no WARN_LOGFILE is defined Doxygen will not +# write the warning messages in between other messages but write them at the end +# of a run, in case a WARN_LOGFILE is defined the warning messages will be +# besides being in the defined file also be shown at the end of a run, unless +# the WARN_LOGFILE is defined as - i.e. standard output (stdout) in that case +# the behavior will remain as with the setting FAIL_ON_WARNINGS. +# Possible values are: NO, YES, FAIL_ON_WARNINGS and FAIL_ON_WARNINGS_PRINT. +# The default value is: NO. + +WARN_AS_ERROR = NO + +# The WARN_FORMAT tag determines the format of the warning messages that Doxygen # can produce. The string should contain the $file, $line, and $text tags, which # will be replaced by the file and line number from which the warning originated # and the warning text. Optionally the format may contain $version, which will # be replaced by the version of the file (if it could be obtained via # FILE_VERSION_FILTER) +# See also: WARN_LINE_FORMAT # The default value is: $file:$line: $text. WARN_FORMAT = "$file:$line: $text" +# In the $text part of the WARN_FORMAT command it is possible that a reference +# to a more specific place is given. To make it easier to jump to this place +# (outside of Doxygen) the user can define a custom "cut" / "paste" string. +# Example: +# WARN_LINE_FORMAT = "'vi $file +$line'" +# See also: WARN_FORMAT +# The default value is: at line $line of file $file. + +WARN_LINE_FORMAT = "at line $line of file $file" + # The WARN_LOGFILE tag can be used to specify a file to which warning and error # messages should be written. If left blank the output is written to standard -# error (stderr). +# error (stderr). In case the file specified cannot be opened for writing the +# warning and error messages are written to standard error. When as file - is +# specified the warning and error messages are written to standard output +# (stdout). -WARN_LOGFILE = output_err +WARN_LOGFILE = doxygen_error #--------------------------------------------------------------------------- # Configuration options related to the input files @@ -762,37 +962,58 @@ WARN_LOGFILE = output_err # The INPUT tag is used to specify the files and/or directories that contain # documented source files. You may enter file names like myfile.cpp or # directories like /usr/src/myproject. Separate the files or directories with -# spaces. +# spaces. See also FILE_PATTERNS and EXTENSION_MAPPING # Note: If this tag is empty the current directory is searched. -INPUT = . \ - DOCS/groups-usr.dox +INPUT = BLAS \ + CBLAS \ + SRC \ + INSTALL \ + TESTING \ + DOCS/groups-usr.dox \ + README.md # This tag can be used to specify the character encoding of the source files -# that doxygen parses. Internally doxygen uses the UTF-8 encoding. Doxygen uses +# that Doxygen parses. Internally Doxygen uses the UTF-8 encoding. Doxygen uses # libiconv (or the iconv built into libc) for the transcoding. See the libiconv -# documentation (see: http://www.gnu.org/software/libiconv) for the list of -# possible encodings. +# documentation (see: +# https://www.gnu.org/software/libiconv/) for the list of possible encodings. +# See also: INPUT_FILE_ENCODING # The default value is: UTF-8. INPUT_ENCODING = UTF-8 +# This tag can be used to specify the character encoding of the source files +# that Doxygen parses The INPUT_FILE_ENCODING tag can be used to specify +# character encoding on a per file pattern basis. Doxygen will compare the file +# name with each pattern and apply the encoding instead of the default +# INPUT_ENCODING) if there is a match. The character encodings are a list of the +# form: pattern=encoding (like *.php=ISO-8859-1). +# See also: INPUT_ENCODING for further information on supported encodings. + +INPUT_FILE_ENCODING = + # If the value of the INPUT tag contains directories, you can use the # FILE_PATTERNS tag to specify one or more wildcard patterns (like *.cpp and # *.h) to filter out the source-files in the directories. # # Note that for custom extensions or not directly supported extensions you also # need to set EXTENSION_MAPPING for the extension otherwise the files are not -# read by doxygen. +# read by Doxygen. +# +# Note the list of default checked file patterns might differ from the list of +# default file extension mappings. # -# If left blank the following patterns are tested:*.c, *.cc, *.cxx, *.cpp, -# *.c++, *.java, *.ii, *.ixx, *.ipp, *.i++, *.inl, *.idl, *.ddl, *.odl, *.h, -# *.hh, *.hxx, *.hpp, *.h++, *.cs, *.d, *.php, *.php4, *.php5, *.phtml, *.inc, -# *.m, *.markdown, *.md, *.mm, *.dox, *.py, *.f90, *.f, *.for, *.tcl, *.vhd, -# *.vhdl, *.ucf, *.qsf, *.as and *.js. - -FILE_PATTERNS = *.c \ - *.f \ +# If left blank the following patterns are tested:*.c, *.cc, *.cxx, *.cxxm, +# *.cpp, *.cppm, *.ccm, *.c++, *.c++m, *.java, *.ii, *.ixx, *.ipp, *.i++, *.inl, +# *.idl, *.ddl, *.odl, *.h, *.hh, *.hxx, *.hpp, *.h++, *.ixx, *.l, *.cs, *.d, +# *.php, *.php4, *.php5, *.phtml, *.inc, *.m, *.markdown, *.md, *.mm, *.dox (to +# be provided as Doxygen C comment), *.py, *.pyw, *.f90, *.f95, *.f03, *.f08, +# *.f18, *.f, *.for, *.vhd, *.vhdl, *.ucf, *.qsf and *.ice. + +FILE_PATTERNS = *.f \ + *.f90 \ + *.c \ *.h # The RECURSIVE tag can be used to specify whether or not subdirectories should @@ -805,37 +1026,17 @@ RECURSIVE = YES # excluded from the INPUT source files. This way you can easily exclude a # subdirectory from a directory tree whose root is specified with the INPUT tag. # -# Note that relative paths are relative to the directory from which doxygen is +# Note that relative paths are relative to the directory from which Doxygen is # run. -EXCLUDE = CMAKE \ - DOCS \ - .svn \ - CBLAS/.svn \ - CBLAS/src/.svn \ - CBLAS/testing/.svn \ - CBLAS/example/.svn \ - CBLAS/include/.svn \ - BLAS/.svn \ - BLAS/SRC/.svn \ - BLAS/TESTING/.svn \ - SRC/.svn \ - SRC/VARIANTS/.svn \ - SRC/VARIANTS/LIB/.svn \ - SRC/VARIANTS/cholesky/.svn \ - SRC/VARIANTS/cholesky/RL/.svn \ - SRC/VARIANTS/cholesky/TOP/.svn \ - SRC/VARIANTS/lu/.svn \ - SRC/VARIANTS/lu/CR/.svn \ - SRC/VARIANTS/lu/LL/.svn \ - SRC/VARIANTS/lu/REC/.svn \ - SRC/VARIANTS/qr/.svn \ - SRC/VARIANTS/qr/LL/.svn \ - INSTALL/.svn \ - TESTING/.svn \ - TESTING/EIG/.svn \ - TESTING/MATGEN/.svn \ - TESTING/LIN/.svn +EXCLUDE = .git \ + .github \ + SRC/VARIANTS \ + BLAS/SRC/lsame.f \ + BLAS/SRC/xerbla.f \ + BLAS/SRC/xerbla_array.f \ + INSTALL/slamchf77.f \ + INSTALL/dlamchf77.f # The EXCLUDE_SYMLINKS tag can be used to select whether or not files or # directories that are symbolic links (a Unix file system feature) are excluded @@ -851,20 +1052,13 @@ EXCLUDE_SYMLINKS = NO # Note that the wildcards are matched against the file with absolute path, so to # exclude all test directories for example use the pattern */test/* -EXCLUDE_PATTERNS = *.py \ - *.txt \ - *.in \ - *.inc \ - Makefile +EXCLUDE_PATTERNS = # The EXCLUDE_SYMBOLS tag can be used to specify one or more symbol names # (namespaces, classes, functions, etc.) that should be excluded from the # output. The symbol name can be a fully qualified name, a word, or if the # wildcard * is used, a substring. Examples: ANamespace, AClass, -# AClass::ANamespace, ANamespace::*Test -# -# Note that the wildcards are matched against the file with absolute path, so to -# exclude all test directories use the pattern */test/* +# ANamespace::AClass, ANamespace::*Test EXCLUDE_SYMBOLS = @@ -879,7 +1073,7 @@ EXAMPLE_PATH = # *.h) to filter out the source-files in the directories. If left blank all # files are included. -EXAMPLE_PATTERNS = +EXAMPLE_PATTERNS = * # If the EXAMPLE_RECURSIVE tag is set to YES then subdirectories will be # searched for input files to be used with the \include or \dontinclude commands @@ -894,7 +1088,7 @@ EXAMPLE_RECURSIVE = NO IMAGE_PATH = -# The INPUT_FILTER tag can be used to specify a program that doxygen should +# The INPUT_FILTER tag can be used to specify a program that Doxygen should # invoke to filter for each input file. Doxygen will invoke the filter program # by executing (via popen()) the command: # @@ -908,6 +1102,15 @@ IMAGE_PATH = # Note that the filter must not add or remove lines; it is applied before the # code is scanned, but not when the output code is generated. If lines are added # or removed, the anchors will not be placed correctly. +# +# Note that Doxygen will use the data processed and written to standard output +# for further processing, therefore nothing else, like debug statements or used +# commands (so in case of a Windows batch file always use @echo OFF), should be +# written to standard output. +# +# Note that for custom extensions or not directly supported extensions you also +# need to set EXTENSION_MAPPING for the extension otherwise the files are not +# properly processed by Doxygen. INPUT_FILTER = @@ -917,6 +1120,10 @@ INPUT_FILTER = # (like *.cpp=my_cpp_filter). See INPUT_FILTER for further information on how # filters are used. If the FILTER_PATTERNS tag is empty or if none of the # patterns match the file name, INPUT_FILTER is applied. +# +# Note that for custom extensions or not directly supported extensions you also +# need to set EXTENSION_MAPPING for the extension otherwise the files are not +# properly processed by Doxygen. FILTER_PATTERNS = @@ -938,10 +1145,19 @@ FILTER_SOURCE_PATTERNS = # If the USE_MDFILE_AS_MAINPAGE tag refers to the name of a markdown file that # is part of the input, its contents will be placed on the main page # (index.html). This can be useful if you have a project on for instance GitHub -# and want to reuse the introduction page also for the doxygen output. +# and want to reuse the introduction page also for the Doxygen output. USE_MDFILE_AS_MAINPAGE = +# The Fortran standard specifies that for fixed formatted Fortran code all +# characters from position 72 are to be considered as comment. A common +# extension is to allow longer lines before the automatic comment starts. The +# setting FORTRAN_COMMENT_AFTER will also make it possible that longer lines can +# be processed before the automatic comment starts. +# Minimum value: 7, maximum value: 10000, default value: 72. + +FORTRAN_COMMENT_AFTER = 72 + #--------------------------------------------------------------------------- # Configuration options related to source browsing #--------------------------------------------------------------------------- @@ -956,12 +1172,13 @@ USE_MDFILE_AS_MAINPAGE = SOURCE_BROWSER = YES # Setting the INLINE_SOURCES tag to YES will include the body of functions, -# classes and enums directly into the documentation. +# multi-line macros, enums or list initialized variables directly into the +# documentation. # The default value is: NO. INLINE_SOURCES = YES -# Setting the STRIP_CODE_COMMENTS tag to YES will instruct doxygen to hide any +# Setting the STRIP_CODE_COMMENTS tag to YES will instruct Doxygen to hide any # special comment blocks from generated source code fragments. Normal C, C++ and # Fortran comments will always remain visible. # The default value is: YES. @@ -969,7 +1186,7 @@ INLINE_SOURCES = YES STRIP_CODE_COMMENTS = YES # If the REFERENCED_BY_RELATION tag is set to YES then for each documented -# function all documented functions referencing it will be listed. +# entity all documented functions referencing it will be listed. # The default value is: NO. REFERENCED_BY_RELATION = NO @@ -999,28 +1216,28 @@ REFERENCES_LINK_SOURCE = YES SOURCE_TOOLTIPS = YES # If the USE_HTAGS tag is set to YES then the references to source code will -# point to the HTML generated by the htags(1) tool instead of doxygen built-in +# point to the HTML generated by the htags(1) tool instead of Doxygen built-in # source browser. The htags tool is part of GNU's global source tagging system -# (see http://www.gnu.org/software/global/global.html). You will need version +# (see https://www.gnu.org/software/global/global.html). You will need version # 4.8.6 or higher. # # To use it do the following: # - Install the latest version of global -# - Enable SOURCE_BROWSER and USE_HTAGS in the config file +# - Enable SOURCE_BROWSER and USE_HTAGS in the configuration file # - Make sure the INPUT points to the root of the source tree # - Run doxygen as normal # # Doxygen will invoke htags (and that will in turn invoke gtags), so these # tools must be available from the command line (i.e. in the search path). # -# The result: instead of the source browser generated by doxygen, the links to +# The result: instead of the source browser generated by Doxygen, the links to # source code will now point to the output of htags. # The default value is: NO. # This tag requires that the tag SOURCE_BROWSER is set to YES. USE_HTAGS = NO -# If the VERBATIM_HEADERS tag is set the YES then doxygen will generate a +# If the VERBATIM_HEADERS tag is set the YES then Doxygen will generate a # verbatim copy of the header file for each class for which an include is # specified. Set to NO to disable this. # See also: Section \class. @@ -1028,25 +1245,46 @@ USE_HTAGS = NO VERBATIM_HEADERS = YES -# If the CLANG_ASSISTED_PARSING tag is set to YES then doxygen will use the -# clang parser (see: http://clang.llvm.org/) for more accurate parsing at the -# cost of reduced performance. This can be particularly helpful with template -# rich C++ code for which doxygen's built-in parser lacks the necessary type -# information. -# Note: The availability of this option depends on whether or not doxygen was -# compiled with the --with-libclang option. +# If the CLANG_ASSISTED_PARSING tag is set to YES then Doxygen will use the +# clang parser (see: +# http://clang.llvm.org/) for more accurate parsing at the cost of reduced +# performance. This can be particularly helpful with template rich C++ code for +# which Doxygen's built-in parser lacks the necessary type information. +# Note: The availability of this option depends on whether or not Doxygen was +# generated with the -Duse_libclang=ON option for CMake. # The default value is: NO. CLANG_ASSISTED_PARSING = NO +# If the CLANG_ASSISTED_PARSING tag is set to YES and the CLANG_ADD_INC_PATHS +# tag is set to YES then Doxygen will add the directory of each input to the +# include path. +# The default value is: YES. +# This tag requires that the tag CLANG_ASSISTED_PARSING is set to YES. + +CLANG_ADD_INC_PATHS = YES + # If clang assisted parsing is enabled you can provide the compiler with command # line options that you would normally use when invoking the compiler. Note that -# the include paths will already be set by doxygen for the files and directories +# the include paths will already be set by Doxygen for the files and directories # specified with INPUT and INCLUDE_PATH. # This tag requires that the tag CLANG_ASSISTED_PARSING is set to YES. CLANG_OPTIONS = +# If clang assisted parsing is enabled you can provide the clang parser with the +# path to the directory containing a file called compile_commands.json. This +# file is the compilation database (see: +# http://clang.llvm.org/docs/HowToSetupToolingForLLVM.html) containing the +# options used when the source files were built. This is equivalent to +# specifying the -p option to a clang tool, such as clang-check. These options +# will then be passed to the parser. Any options specified with CLANG_OPTIONS +# will be added as well. +# Note: The availability of this option depends on whether or not Doxygen was +# generated with the -Duse_libclang=ON option for CMake. + +CLANG_DATABASE_PATH = + #--------------------------------------------------------------------------- # Configuration options related to the alphabetical class index #--------------------------------------------------------------------------- @@ -1058,17 +1296,11 @@ CLANG_OPTIONS = ALPHABETICAL_INDEX = YES -# The COLS_IN_ALPHA_INDEX tag can be used to specify the number of columns in -# which the alphabetical index list will be split. -# Minimum value: 1, maximum value: 20, default value: 5. -# This tag requires that the tag ALPHABETICAL_INDEX is set to YES. - -COLS_IN_ALPHA_INDEX = 5 - -# In case all classes in a project start with a common prefix, all classes will -# be put under the same header in the alphabetical index. The IGNORE_PREFIX tag -# can be used to specify a prefix (or a list of prefixes) that should be ignored -# while generating the index headers. +# The IGNORE_PREFIX tag can be used to specify a prefix (or a list of prefixes) +# that should be ignored while generating the index headers. The IGNORE_PREFIX +# tag works for classes, function and member names. The entity will be placed in +# the alphabetical list under the first letter of the entity name that remains +# after removing the prefix. # This tag requires that the tag ALPHABETICAL_INDEX is set to YES. IGNORE_PREFIX = @@ -1077,7 +1309,7 @@ IGNORE_PREFIX = # Configuration options related to the HTML output #--------------------------------------------------------------------------- -# If the GENERATE_HTML tag is set to YES, doxygen will generate HTML output +# If the GENERATE_HTML tag is set to YES, Doxygen will generate HTML output # The default value is: YES. GENERATE_HTML = YES @@ -1098,40 +1330,40 @@ HTML_OUTPUT = explore-html HTML_FILE_EXTENSION = .html # The HTML_HEADER tag can be used to specify a user-defined HTML header file for -# each generated HTML page. If the tag is left blank doxygen will generate a +# each generated HTML page. If the tag is left blank Doxygen will generate a # standard header. # # To get valid HTML the header file that includes any scripts and style sheets -# that doxygen needs, which is dependent on the configuration options used (e.g. +# that Doxygen needs, which is dependent on the configuration options used (e.g. # the setting GENERATE_TREEVIEW). It is highly recommended to start with a # default header using # doxygen -w html new_header.html new_footer.html new_stylesheet.css # YourConfigFile # and then modify the file new_header.html. See also section "Doxygen usage" -# for information on how to generate the default header that doxygen normally +# for information on how to generate the default header that Doxygen normally # uses. # Note: The header is subject to change so you typically have to regenerate the -# default header when upgrading to a newer version of doxygen. For a description +# default header when upgrading to a newer version of Doxygen. For a description # of the possible markers and block names see the documentation. # This tag requires that the tag GENERATE_HTML is set to YES. HTML_HEADER = # The HTML_FOOTER tag can be used to specify a user-defined HTML footer for each -# generated HTML page. If the tag is left blank doxygen will generate a standard +# generated HTML page. If the tag is left blank Doxygen will generate a standard # footer. See HTML_HEADER for more information on how to generate a default # footer and what special commands can be used inside the footer. See also # section "Doxygen usage" for information on how to generate the default footer -# that doxygen normally uses. +# that Doxygen normally uses. # This tag requires that the tag GENERATE_HTML is set to YES. HTML_FOOTER = # The HTML_STYLESHEET tag can be used to specify a user-defined cascading style # sheet that is used by each HTML page. It can be used to fine-tune the look of -# the HTML output. If left blank doxygen will generate a default style sheet. +# the HTML output. If left blank Doxygen will generate a default style sheet. # See also section "Doxygen usage" for information on how to generate the style -# sheet that doxygen normally uses. +# sheet that Doxygen normally uses. # Note: It is recommended to use HTML_EXTRA_STYLESHEET instead of this tag, as # it is more robust and this tag (HTML_STYLESHEET) will in the future become # obsolete. @@ -1141,13 +1373,18 @@ HTML_STYLESHEET = # The HTML_EXTRA_STYLESHEET tag can be used to specify additional user-defined # cascading style sheets that are included after the standard style sheets -# created by doxygen. Using this option one can overrule certain style aspects. +# created by Doxygen. Using this option one can overrule certain style aspects. # This is preferred over using HTML_STYLESHEET since it does not replace the # standard style sheet and is therefore more robust against future updates. # Doxygen will copy the style sheet files to the output directory. # Note: The order of the extra style sheet files is of importance (e.g. the last # style sheet in the list overrules the setting of the previous ones in the -# list). For an example see the documentation. +# list). +# Note: Since the styling of scrollbars can currently not be overruled in +# Webkit/Chromium, the styling will be left out of the default doxygen.css if +# one or more extra stylesheets have been specified. So if scrollbar +# customization is desired it has to be added explicitly. For an example see the +# documentation. # This tag requires that the tag GENERATE_HTML is set to YES. HTML_EXTRA_STYLESHEET = @@ -1162,10 +1399,23 @@ HTML_EXTRA_STYLESHEET = HTML_EXTRA_FILES = +# The HTML_COLORSTYLE tag can be used to specify if the generated HTML output +# should be rendered with a dark or light theme. +# Possible values are: LIGHT always generates light mode output, DARK always +# generates dark mode output, AUTO_LIGHT automatically sets the mode according +# to the user preference, uses light mode if no preference is set (the default), +# AUTO_DARK automatically sets the mode according to the user preference, uses +# dark mode if no preference is set and TOGGLE allows a user to switch between +# light and dark mode via a button. +# The default value is: AUTO_LIGHT. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_COLORSTYLE = AUTO_LIGHT + # The HTML_COLORSTYLE_HUE tag controls the color of the HTML output. Doxygen # will adjust the colors in the style sheet and background images according to -# this color. Hue is specified as an angle on a colorwheel, see -# http://en.wikipedia.org/wiki/Hue for more information. For instance the value +# this color. Hue is specified as an angle on a color-wheel, see +# https://en.wikipedia.org/wiki/Hue for more information. For instance the value # 0 represents red, 60 is yellow, 120 is green, 180 is cyan, 240 is blue, 300 # purple, and 360 is red again. # Minimum value: 0, maximum value: 359, default value: 220. @@ -1174,7 +1424,7 @@ HTML_EXTRA_FILES = HTML_COLORSTYLE_HUE = 220 # The HTML_COLORSTYLE_SAT tag controls the purity (or saturation) of the colors -# in the HTML output. For a value of 0 the output will use grayscales only. A +# in the HTML output. For a value of 0 the output will use gray-scales only. A # value of 255 will produce the most vivid colors. # Minimum value: 0, maximum value: 255, default value: 100. # This tag requires that the tag GENERATE_HTML is set to YES. @@ -1192,14 +1442,16 @@ HTML_COLORSTYLE_SAT = 100 HTML_COLORSTYLE_GAMMA = 80 -# If the HTML_TIMESTAMP tag is set to YES then the footer of each generated HTML -# page will contain the date and time when the page was generated. Setting this -# to YES can help to show when doxygen was last run and thus if the -# documentation is up to date. -# The default value is: NO. +# If the HTML_DYNAMIC_MENUS tag is set to YES then the generated HTML +# documentation will contain a main index with vertical navigation menus that +# are dynamically created via JavaScript. If disabled, the navigation index will +# consists of multiple levels of tabs that are statically embedded in every HTML +# page. Disable this option to support browsers that do not have JavaScript, +# like the Qt help browser. +# The default value is: YES. # This tag requires that the tag GENERATE_HTML is set to YES. -HTML_TIMESTAMP = YES +HTML_DYNAMIC_MENUS = YES # If the HTML_DYNAMIC_SECTIONS tag is set to YES then the generated HTML # documentation will contain sections that can be hidden and shown after the @@ -1209,6 +1461,33 @@ HTML_TIMESTAMP = YES HTML_DYNAMIC_SECTIONS = NO +# If the HTML_CODE_FOLDING tag is set to YES then classes and functions can be +# dynamically folded and expanded in the generated HTML source code. +# The default value is: YES. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_CODE_FOLDING = YES + +# If the HTML_COPY_CLIPBOARD tag is set to YES then Doxygen will show an icon in +# the top right corner of code and text fragments that allows the user to copy +# its content to the clipboard. Note this only works if supported by the browser +# and the web page is served via a secure context (see: +# https://www.w3.org/TR/secure-contexts/), i.e. using the https: or file: +# protocol. +# The default value is: YES. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_COPY_CLIPBOARD = YES + +# Doxygen stores a couple of settings persistently in the browser (via e.g. +# cookies). By default these settings apply to all HTML pages generated by +# Doxygen across all projects. The HTML_PROJECT_COOKIE tag can be used to store +# the settings under a project specific key, such that the user preferences will +# be stored separately. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_PROJECT_COOKIE = + # With HTML_INDEX_NUM_ENTRIES one can control the preferred number of entries # shown in the various tree structured indices initially; the user can expand # and collapse entries dynamically later on. Doxygen will expand the tree to @@ -1224,13 +1503,14 @@ HTML_INDEX_NUM_ENTRIES = 100 # If the GENERATE_DOCSET tag is set to YES, additional index files will be # generated that can be used as input for Apple's Xcode 3 integrated development -# environment (see: http://developer.apple.com/tools/xcode/), introduced with -# OSX 10.5 (Leopard). To create a documentation set, doxygen will generate a -# Makefile in the HTML output directory. Running make will produce the docset in -# that directory and running make install will install the docset in +# environment (see: +# https://developer.apple.com/xcode/), introduced with OSX 10.5 (Leopard). To +# create a documentation set, Doxygen will generate a Makefile in the HTML +# output directory. Running make will produce the docset in that directory and +# running make install will install the docset in # ~/Library/Developer/Shared/Documentation/DocSets so that Xcode will find it at -# startup. See http://developer.apple.com/tools/creatingdocsetswithdoxygen.html -# for more information. +# startup. See https://developer.apple.com/library/archive/featuredarticles/Doxy +# genXcode/_index.html for more information. # The default value is: NO. # This tag requires that the tag GENERATE_HTML is set to YES. @@ -1244,6 +1524,13 @@ GENERATE_DOCSET = NO DOCSET_FEEDNAME = "Doxygen generated docs" +# This tag determines the URL of the docset feed. A documentation feed provides +# an umbrella under which multiple documentation sets from a single provider +# (such as a company or product suite) can be grouped. +# This tag requires that the tag GENERATE_DOCSET is set to YES. + +DOCSET_FEEDURL = + # This tag specifies a string that should uniquely identify the documentation # set bundle. This should be a reverse domain-name style string, e.g. # com.mycompany.MyDocSet. Doxygen will append .docset to the name. @@ -1266,14 +1553,18 @@ DOCSET_PUBLISHER_ID = org.doxygen.Publisher DOCSET_PUBLISHER_NAME = Publisher -# If the GENERATE_HTMLHELP tag is set to YES then doxygen generates three +# If the GENERATE_HTMLHELP tag is set to YES then Doxygen generates three # additional HTML index files: index.hhp, index.hhc, and index.hhk. The # index.hhp is a project file that can be read by Microsoft's HTML Help Workshop -# (see: http://www.microsoft.com/en-us/download/details.aspx?id=21138) on -# Windows. +# on Windows. In the beginning of 2021 Microsoft took the original page, with +# a.o. the download links, offline the HTML help workshop was already many years +# in maintenance mode). You can download the HTML help workshop from the web +# archives at Installation executable (see: +# http://web.archive.org/web/20160201063255/http://download.microsoft.com/downlo +# ad/0/A/9/0A939EF6-E31C-430F-A3DF-DFAE7960D564/htmlhelp.exe). # # The HTML Help Workshop contains a compiler that can convert all HTML output -# generated by doxygen into a single compiled HTML file (.chm). Compiled HTML +# generated by Doxygen into a single compiled HTML file (.chm). Compiled HTML # files are now used as the Windows 98 help format, and will replace the old # Windows help format (.hlp) on all Windows platforms in the future. Compressed # HTML files also contain an index, a table of contents, and you can search for @@ -1293,14 +1584,14 @@ CHM_FILE = # The HHC_LOCATION tag can be used to specify the location (absolute path # including file name) of the HTML help compiler (hhc.exe). If non-empty, -# doxygen will try to run the HTML help compiler on the generated index.hhp. +# Doxygen will try to run the HTML help compiler on the generated index.hhp. # The file has to be specified with full path. # This tag requires that the tag GENERATE_HTMLHELP is set to YES. HHC_LOCATION = # The GENERATE_CHI flag controls if a separate .chi index file is generated -# (YES) or that it should be included in the master .chm file (NO). +# (YES) or that it should be included in the main .chm file (NO). # The default value is: NO. # This tag requires that the tag GENERATE_HTMLHELP is set to YES. @@ -1327,6 +1618,16 @@ BINARY_TOC = NO TOC_EXPAND = NO +# The SITEMAP_URL tag is used to specify the full URL of the place where the +# generated documentation will be placed on the server by the user during the +# deployment of the documentation. The generated sitemap is called sitemap.xml +# and placed on the directory specified by HTML_OUTPUT. In case no SITEMAP_URL +# is specified no sitemap is generated. For information about the sitemap +# protocol see https://www.sitemaps.org +# This tag requires that the tag GENERATE_HTML is set to YES. + +SITEMAP_URL = + # If the GENERATE_QHP tag is set to YES and both QHP_NAMESPACE and # QHP_VIRTUAL_FOLDER are set, an additional index file will be generated that # can be used as input for Qt's qhelpgenerator to generate a Qt Compressed Help @@ -1345,7 +1646,8 @@ QCH_FILE = # The QHP_NAMESPACE tag specifies the namespace to use when generating Qt Help # Project output. For more information please see Qt Help Project / Namespace -# (see: http://qt-project.org/doc/qt-4.8/qthelpproject.html#namespace). +# (see: +# https://doc.qt.io/archives/qt-4.8/qthelpproject.html#namespace). # The default value is: org.doxygen.Project. # This tag requires that the tag GENERATE_QHP is set to YES. @@ -1353,8 +1655,8 @@ QHP_NAMESPACE = org.doxygen.Project # The QHP_VIRTUAL_FOLDER tag specifies the namespace to use when generating Qt # Help Project output. For more information please see Qt Help Project / Virtual -# Folders (see: http://qt-project.org/doc/qt-4.8/qthelpproject.html#virtual- -# folders). +# Folders (see: +# https://doc.qt.io/archives/qt-4.8/qthelpproject.html#virtual-folders). # The default value is: doc. # This tag requires that the tag GENERATE_QHP is set to YES. @@ -1362,30 +1664,30 @@ QHP_VIRTUAL_FOLDER = doc # If the QHP_CUST_FILTER_NAME tag is set, it specifies the name of a custom # filter to add. For more information please see Qt Help Project / Custom -# Filters (see: http://qt-project.org/doc/qt-4.8/qthelpproject.html#custom- -# filters). +# Filters (see: +# https://doc.qt.io/archives/qt-4.8/qthelpproject.html#custom-filters). # This tag requires that the tag GENERATE_QHP is set to YES. QHP_CUST_FILTER_NAME = # The QHP_CUST_FILTER_ATTRS tag specifies the list of the attributes of the # custom filter to add. For more information please see Qt Help Project / Custom -# Filters (see: http://qt-project.org/doc/qt-4.8/qthelpproject.html#custom- -# filters). +# Filters (see: +# https://doc.qt.io/archives/qt-4.8/qthelpproject.html#custom-filters). # This tag requires that the tag GENERATE_QHP is set to YES. QHP_CUST_FILTER_ATTRS = # The QHP_SECT_FILTER_ATTRS tag specifies the list of the attributes this # project's filter section matches. Qt Help Project / Filter Attributes (see: -# http://qt-project.org/doc/qt-4.8/qthelpproject.html#filter-attributes). +# https://doc.qt.io/archives/qt-4.8/qthelpproject.html#filter-attributes). # This tag requires that the tag GENERATE_QHP is set to YES. QHP_SECT_FILTER_ATTRS = -# The QHG_LOCATION tag can be used to specify the location of Qt's -# qhelpgenerator. If non-empty doxygen will try to run qhelpgenerator on the -# generated .qhp file. +# The QHG_LOCATION tag can be used to specify the location (absolute path +# including file name) of Qt's qhelpgenerator. If non-empty Doxygen will try to +# run qhelpgenerator on the generated .qhp file. # This tag requires that the tag GENERATE_QHP is set to YES. QHG_LOCATION = @@ -1428,18 +1730,30 @@ DISABLE_INDEX = NO # to work a browser that supports JavaScript, DHTML, CSS and frames is required # (i.e. any modern browser). Windows users are probably better off using the # HTML help feature. Via custom style sheets (see HTML_EXTRA_STYLESHEET) one can -# further fine-tune the look of the index. As an example, the default style -# sheet generated by doxygen has an example that shows how to put an image at -# the root of the tree instead of the PROJECT_NAME. Since the tree basically has -# the same information as the tab index, you could consider setting -# DISABLE_INDEX to YES when enabling this option. +# further fine tune the look of the index (see "Fine-tuning the output"). As an +# example, the default style sheet generated by Doxygen has an example that +# shows how to put an image at the root of the tree instead of the PROJECT_NAME. +# Since the tree basically has the same information as the tab index, you could +# consider setting DISABLE_INDEX to YES when enabling this option. # The default value is: NO. # This tag requires that the tag GENERATE_HTML is set to YES. GENERATE_TREEVIEW = YES +# When both GENERATE_TREEVIEW and DISABLE_INDEX are set to YES, then the +# FULL_SIDEBAR option determines if the side bar is limited to only the treeview +# area (value NO) or if it should extend to the full height of the window (value +# YES). Setting this to YES gives a layout similar to +# https://docs.readthedocs.io with more room for contents, but less room for the +# project logo, title, and description. If either GENERATE_TREEVIEW or +# DISABLE_INDEX is set to NO, this option has no effect. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +FULL_SIDEBAR = NO + # The ENUM_VALUES_PER_LINE tag can be used to set the number of enum values that -# doxygen will group on one line in the generated HTML documentation. +# Doxygen will group on one line in the generated HTML documentation. # # Note that a value of 0 will completely suppress the enum values from appearing # in the overview section. @@ -1448,6 +1762,12 @@ GENERATE_TREEVIEW = YES ENUM_VALUES_PER_LINE = 4 +# When the SHOW_ENUM_VALUES tag is set doxygen will show the specified +# enumeration values besides the enumeration mnemonics. +# The default value is: NO. + +SHOW_ENUM_VALUES = NO + # If the treeview is enabled (see GENERATE_TREEVIEW) then this tag can be used # to set the initial width (in pixels) of the frame in which the tree is shown. # Minimum value: 0, maximum value: 1500, default value: 250. @@ -1455,35 +1775,48 @@ ENUM_VALUES_PER_LINE = 4 TREEVIEW_WIDTH = 250 -# If the EXT_LINKS_IN_WINDOW option is set to YES, doxygen will open links to +# If the EXT_LINKS_IN_WINDOW option is set to YES, Doxygen will open links to # external symbols imported via tag files in a separate window. # The default value is: NO. # This tag requires that the tag GENERATE_HTML is set to YES. EXT_LINKS_IN_WINDOW = NO +# If the OBFUSCATE_EMAILS tag is set to YES, Doxygen will obfuscate email +# addresses. +# The default value is: YES. +# This tag requires that the tag GENERATE_HTML is set to YES. + +OBFUSCATE_EMAILS = YES + +# If the HTML_FORMULA_FORMAT option is set to svg, Doxygen will use the pdf2svg +# tool (see https://github.com/dawbarton/pdf2svg) or inkscape (see +# https://inkscape.org) to generate formulas as SVG images instead of PNGs for +# the HTML output. These images will generally look nicer at scaled resolutions. +# Possible values are: png (the default) and svg (looks nicer but requires the +# pdf2svg or inkscape tool). +# The default value is: png. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_FORMULA_FORMAT = png + # Use this tag to change the font size of LaTeX formulas included as images in # the HTML documentation. When you change the font size after a successful -# doxygen run you need to manually remove any form_*.png images from the HTML +# Doxygen run you need to manually remove any form_*.png images from the HTML # output directory to force them to be regenerated. # Minimum value: 8, maximum value: 50, default value: 10. # This tag requires that the tag GENERATE_HTML is set to YES. FORMULA_FONTSIZE = 10 -# Use the FORMULA_TRANPARENT tag to determine whether or not the images -# generated for formulas are transparent PNGs. Transparent PNGs are not -# supported properly for IE 6.0, but are supported on all modern browsers. -# -# Note that when changing this option you need to delete any form_*.png files in -# the HTML output directory before the changes have effect. -# The default value is: YES. -# This tag requires that the tag GENERATE_HTML is set to YES. +# The FORMULA_MACROFILE can contain LaTeX \newcommand and \renewcommand commands +# to create new LaTeX commands to be used in formulas as building blocks. See +# the section "Including formulas" for details. -FORMULA_TRANSPARENT = YES +FORMULA_MACROFILE = # Enable the USE_MATHJAX option to render LaTeX formulas using MathJax (see -# http://www.mathjax.org) which uses client side Javascript for the rendering +# https://www.mathjax.org) which uses client side JavaScript for the rendering # instead of using pre-rendered bitmaps. Use this if you do not have LaTeX # installed or if you want to formulas look prettier in the HTML output. When # enabled you may also need to install MathJax separately and configure the path @@ -1493,11 +1826,29 @@ FORMULA_TRANSPARENT = YES USE_MATHJAX = NO +# With MATHJAX_VERSION it is possible to specify the MathJax version to be used. +# Note that the different versions of MathJax have different requirements with +# regards to the different settings, so it is possible that also other MathJax +# settings have to be changed when switching between the different MathJax +# versions. +# Possible values are: MathJax_2 and MathJax_3. +# The default value is: MathJax_2. +# This tag requires that the tag USE_MATHJAX is set to YES. + +MATHJAX_VERSION = MathJax_2 + # When MathJax is enabled you can set the default output format to be used for -# the MathJax output. See the MathJax site (see: -# http://docs.mathjax.org/en/latest/output.html) for more details. +# the MathJax output. For more details about the output format see MathJax +# version 2 (see: +# http://docs.mathjax.org/en/v2.7-latest/output.html) and MathJax version 3 +# (see: +# http://docs.mathjax.org/en/latest/web/components/output.html). # Possible values are: HTML-CSS (which is slower, but has the best -# compatibility), NativeMML (i.e. MathML) and SVG. +# compatibility. This is the name for Mathjax version 2, for MathJax version 3 +# this will be translated into chtml), NativeMML (i.e. MathML. Only supported +# for MathJax 2. For MathJax version 3 chtml will be used instead.), chtml (This +# is the name for Mathjax version 3, for MathJax version 2 this will be +# translated into HTML-CSS) and SVG. # The default value is: HTML-CSS. # This tag requires that the tag USE_MATHJAX is set to YES. @@ -1510,33 +1861,40 @@ MATHJAX_FORMAT = HTML-CSS # MATHJAX_RELPATH should be ../mathjax. The default value points to the MathJax # Content Delivery Network so you can quickly see the result without installing # MathJax. However, it is strongly recommended to install a local copy of -# MathJax from http://www.mathjax.org before deployment. -# The default value is: http://cdn.mathjax.org/mathjax/latest. +# MathJax from https://www.mathjax.org before deployment. The default value is: +# - in case of MathJax version 2: https://cdn.jsdelivr.net/npm/mathjax@2 +# - in case of MathJax version 3: https://cdn.jsdelivr.net/npm/mathjax@3 # This tag requires that the tag USE_MATHJAX is set to YES. -MATHJAX_RELPATH = http://www.mathjax.org/mathjax +MATHJAX_RELPATH = https://cdn.jsdelivr.net/npm/mathjax@2 # The MATHJAX_EXTENSIONS tag can be used to specify one or more MathJax # extension names that should be enabled during MathJax rendering. For example +# for MathJax version 2 (see +# https://docs.mathjax.org/en/v2.7-latest/tex.html#tex-and-latex-extensions): # MATHJAX_EXTENSIONS = TeX/AMSmath TeX/AMSsymbols +# For example for MathJax version 3 (see +# http://docs.mathjax.org/en/latest/input/tex/extensions/index.html): +# MATHJAX_EXTENSIONS = ams # This tag requires that the tag USE_MATHJAX is set to YES. MATHJAX_EXTENSIONS = -# The MATHJAX_CODEFILE tag can be used to specify a file with javascript pieces +# The MATHJAX_CODEFILE tag can be used to specify a file with JavaScript pieces # of code that will be used on startup of the MathJax code. See the MathJax site -# (see: http://docs.mathjax.org/en/latest/output.html) for more details. For an +# (see: +# http://docs.mathjax.org/en/v2.7-latest/output.html) for more details. For an # example see the documentation. # This tag requires that the tag USE_MATHJAX is set to YES. MATHJAX_CODEFILE = -# When the SEARCHENGINE tag is enabled doxygen will generate a search box for -# the HTML output. The underlying search engine uses javascript and DHTML and +# When the SEARCHENGINE tag is enabled Doxygen will generate a search box for +# the HTML output. The underlying search engine uses JavaScript and DHTML and # should work on any modern browser. Note that when using HTML help # (GENERATE_HTMLHELP), Qt help (GENERATE_QHP), or docsets (GENERATE_DOCSET) # there is already a search function so this one should typically be disabled. -# For large projects the javascript based search engine can be slow, then +# For large projects the JavaScript based search engine can be slow, then # enabling SERVER_BASED_SEARCH may provide a better solution. It is possible to # search using the keyboard; to jump to the search box use + S # (what the is depends on the OS and browser, but it is typically @@ -1553,9 +1911,9 @@ MATHJAX_CODEFILE = SEARCHENGINE = YES # When the SERVER_BASED_SEARCH tag is enabled the search engine will be -# implemented using a web server instead of a web client using Javascript. There +# implemented using a web server instead of a web client using JavaScript. There # are two flavors of web server based searching depending on the EXTERNAL_SEARCH -# setting. When disabled, doxygen will generate a PHP script for searching and +# setting. When disabled, Doxygen will generate a PHP script for searching and # an index file used by the script. When EXTERNAL_SEARCH is enabled the indexing # and searching needs to be provided by external tools. See the section # "External Indexing and Searching" for details. @@ -1564,7 +1922,7 @@ SEARCHENGINE = YES SERVER_BASED_SEARCH = NO -# When EXTERNAL_SEARCH tag is enabled doxygen will no longer generate the PHP +# When EXTERNAL_SEARCH tag is enabled Doxygen will no longer generate the PHP # script for searching. Instead the search results are written to an XML file # which needs to be processed by an external indexer. Doxygen will invoke an # external search engine pointed to by the SEARCHENGINE_URL option to obtain the @@ -1572,7 +1930,8 @@ SERVER_BASED_SEARCH = NO # # Doxygen ships with an example indexer (doxyindexer) and search engine # (doxysearch.cgi) which are based on the open source search engine library -# Xapian (see: http://xapian.org/). +# Xapian (see: +# https://xapian.org/). # # See the section "External Indexing and Searching" for details. # The default value is: NO. @@ -1585,8 +1944,9 @@ EXTERNAL_SEARCH = NO # # Doxygen ships with an example indexer (doxyindexer) and search engine # (doxysearch.cgi) which are based on the open source search engine library -# Xapian (see: http://xapian.org/). See the section "External Indexing and -# Searching" for details. +# Xapian (see: +# https://xapian.org/). See the section "External Indexing and Searching" for +# details. # This tag requires that the tag SEARCHENGINE is set to YES. SEARCHENGINE_URL = @@ -1607,7 +1967,7 @@ SEARCHDATA_FILE = searchdata.xml EXTERNAL_SEARCH_ID = -# The EXTRA_SEARCH_MAPPINGS tag can be used to enable searching through doxygen +# The EXTRA_SEARCH_MAPPINGS tag can be used to enable searching through Doxygen # projects other than the one defined by this configuration file, but that are # all added to the same external search index. Each project needs to have a # unique id set via EXTERNAL_SEARCH_ID. The search mapping then maps the id of @@ -1621,7 +1981,7 @@ EXTRA_SEARCH_MAPPINGS = # Configuration options related to the LaTeX output #--------------------------------------------------------------------------- -# If the GENERATE_LATEX tag is set to YES, doxygen will generate LaTeX output. +# If the GENERATE_LATEX tag is set to YES, Doxygen will generate LaTeX output. # The default value is: YES. GENERATE_LATEX = NO @@ -1637,22 +1997,36 @@ LATEX_OUTPUT = latex # The LATEX_CMD_NAME tag can be used to specify the LaTeX command name to be # invoked. # -# Note that when enabling USE_PDFLATEX this option is only used for generating -# bitmaps for formulas in the HTML output, but not in the Makefile that is -# written to the output directory. -# The default file is: latex. +# Note that when not enabling USE_PDFLATEX the default is latex when enabling +# USE_PDFLATEX the default is pdflatex and when in the later case latex is +# chosen this is overwritten by pdflatex. For specific output languages the +# default can have been set differently, this depends on the implementation of +# the output language. # This tag requires that the tag GENERATE_LATEX is set to YES. -LATEX_CMD_NAME = latex +LATEX_CMD_NAME = # The MAKEINDEX_CMD_NAME tag can be used to specify the command name to generate # index for LaTeX. +# Note: This tag is used in the Makefile / make.bat. +# See also: LATEX_MAKEINDEX_CMD for the part in the generated output file +# (.tex). # The default file is: makeindex. # This tag requires that the tag GENERATE_LATEX is set to YES. MAKEINDEX_CMD_NAME = makeindex -# If the COMPACT_LATEX tag is set to YES, doxygen generates more compact LaTeX +# The LATEX_MAKEINDEX_CMD tag can be used to specify the command name to +# generate index for LaTeX. In case there is no backslash (\) as first character +# it will be automatically added in the LaTeX code. +# Note: This tag is used in the generated output file (.tex). +# See also: MAKEINDEX_CMD_NAME for the part in the Makefile / make.bat. +# The default value is: makeindex. +# This tag requires that the tag GENERATE_LATEX is set to YES. + +LATEX_MAKEINDEX_CMD = makeindex + +# If the COMPACT_LATEX tag is set to YES, Doxygen generates more compact LaTeX # documents. This may be useful for small projects and may help to save some # trees in general. # The default value is: NO. @@ -1681,36 +2055,38 @@ PAPER_TYPE = a4 EXTRA_PACKAGES = -# The LATEX_HEADER tag can be used to specify a personal LaTeX header for the -# generated LaTeX document. The header should contain everything until the first -# chapter. If it is left blank doxygen will generate a standard header. See -# section "Doxygen usage" for information on how to let doxygen write the -# default header to a separate file. +# The LATEX_HEADER tag can be used to specify a user-defined LaTeX header for +# the generated LaTeX document. The header should contain everything until the +# first chapter. If it is left blank Doxygen will generate a standard header. It +# is highly recommended to start with a default header using +# doxygen -w latex new_header.tex new_footer.tex new_stylesheet.sty +# and then modify the file new_header.tex. See also section "Doxygen usage" for +# information on how to generate the default header that Doxygen normally uses. # -# Note: Only use a user-defined header if you know what you are doing! The -# following commands have a special meaning inside the header: $title, -# $datetime, $date, $doxygenversion, $projectname, $projectnumber, -# $projectbrief, $projectlogo. Doxygen will replace $title with the empty -# string, for the replacement values of the other commands the user is referred -# to HTML_HEADER. +# Note: Only use a user-defined header if you know what you are doing! +# Note: The header is subject to change so you typically have to regenerate the +# default header when upgrading to a newer version of Doxygen. The following +# commands have a special meaning inside the header (and footer): For a +# description of the possible markers and block names see the documentation. # This tag requires that the tag GENERATE_LATEX is set to YES. LATEX_HEADER = -# The LATEX_FOOTER tag can be used to specify a personal LaTeX footer for the -# generated LaTeX document. The footer should contain everything after the last -# chapter. If it is left blank doxygen will generate a standard footer. See +# The LATEX_FOOTER tag can be used to specify a user-defined LaTeX footer for +# the generated LaTeX document. The footer should contain everything after the +# last chapter. If it is left blank Doxygen will generate a standard footer. See # LATEX_HEADER for more information on how to generate a default footer and what -# special commands can be used inside the footer. -# -# Note: Only use a user-defined footer if you know what you are doing! +# special commands can be used inside the footer. See also section "Doxygen +# usage" for information on how to generate the default footer that Doxygen +# normally uses. Note: Only use a user-defined footer if you know what you are +# doing! # This tag requires that the tag GENERATE_LATEX is set to YES. LATEX_FOOTER = # The LATEX_EXTRA_STYLESHEET tag can be used to specify additional user-defined # LaTeX style sheets that are included after the standard style sheets created -# by doxygen. Using this option one can overrule certain style aspects. Doxygen +# by Doxygen. Using this option one can overrule certain style aspects. Doxygen # will copy the style sheet files to the output directory. # Note: The order of the extra style sheet files is of importance (e.g. the last # style sheet in the list overrules the setting of the previous ones in the @@ -1736,53 +2112,59 @@ LATEX_EXTRA_FILES = PDF_HYPERLINKS = YES -# If the USE_PDFLATEX tag is set to YES, doxygen will use pdflatex to generate -# the PDF file directly from the LaTeX files. Set this option to YES, to get a -# higher quality PDF documentation. +# If the USE_PDFLATEX tag is set to YES, Doxygen will use the engine as +# specified with LATEX_CMD_NAME to generate the PDF file directly from the LaTeX +# files. Set this option to YES, to get a higher quality PDF documentation. +# +# See also section LATEX_CMD_NAME for selecting the engine. # The default value is: YES. # This tag requires that the tag GENERATE_LATEX is set to YES. USE_PDFLATEX = YES -# If the LATEX_BATCHMODE tag is set to YES, doxygen will add the \batchmode -# command to the generated LaTeX files. This will instruct LaTeX to keep running -# if errors occur, instead of asking the user for help. This option is also used -# when generating formulas in HTML. +# The LATEX_BATCHMODE tag signals the behavior of LaTeX in case of an error. +# Possible values are: NO same as ERROR_STOP, YES same as BATCH, BATCH In batch +# mode nothing is printed on the terminal, errors are scrolled as if is +# hit at every error; missing files that TeX tries to input or request from +# keyboard input (\read on a not open input stream) cause the job to abort, +# NON_STOP In nonstop mode the diagnostic message will appear on the terminal, +# but there is no possibility of user interaction just like in batch mode, +# SCROLL In scroll mode, TeX will stop only for missing files to input or if +# keyboard input is necessary and ERROR_STOP In errorstop mode, TeX will stop at +# each error, asking for user intervention. # The default value is: NO. # This tag requires that the tag GENERATE_LATEX is set to YES. LATEX_BATCHMODE = NO -# If the LATEX_HIDE_INDICES tag is set to YES then doxygen will not include the +# If the LATEX_HIDE_INDICES tag is set to YES then Doxygen will not include the # index chapters (such as File Index, Compound Index, etc.) in the output. # The default value is: NO. # This tag requires that the tag GENERATE_LATEX is set to YES. LATEX_HIDE_INDICES = NO -# If the LATEX_SOURCE_CODE tag is set to YES then doxygen will include source -# code with syntax highlighting in the LaTeX output. -# -# Note that which sources are shown also depends on other settings such as -# SOURCE_BROWSER. -# The default value is: NO. -# This tag requires that the tag GENERATE_LATEX is set to YES. - -LATEX_SOURCE_CODE = NO - # The LATEX_BIB_STYLE tag can be used to specify the style to use for the # bibliography, e.g. plainnat, or ieeetr. See -# http://en.wikipedia.org/wiki/BibTeX and \cite for more info. +# https://en.wikipedia.org/wiki/BibTeX and \cite for more info. # The default value is: plain. # This tag requires that the tag GENERATE_LATEX is set to YES. LATEX_BIB_STYLE = plain +# The LATEX_EMOJI_DIRECTORY tag is used to specify the (relative or absolute) +# path from which the emoji images will be read. If a relative path is entered, +# it will be relative to the LATEX_OUTPUT directory. If left blank the +# LATEX_OUTPUT directory will be used. +# This tag requires that the tag GENERATE_LATEX is set to YES. + +LATEX_EMOJI_DIRECTORY = + #--------------------------------------------------------------------------- # Configuration options related to the RTF output #--------------------------------------------------------------------------- -# If the GENERATE_RTF tag is set to YES, doxygen will generate RTF output. The +# If the GENERATE_RTF tag is set to YES, Doxygen will generate RTF output. The # RTF output is optimized for Word 97 and may not look too pretty with other RTF # readers/editors. # The default value is: NO. @@ -1797,7 +2179,7 @@ GENERATE_RTF = NO RTF_OUTPUT = rtf -# If the COMPACT_RTF tag is set to YES, doxygen generates more compact RTF +# If the COMPACT_RTF tag is set to YES, Doxygen generates more compact RTF # documents. This may be useful for small projects and may help to save some # trees in general. # The default value is: NO. @@ -1815,40 +2197,38 @@ COMPACT_RTF = NO # The default value is: NO. # This tag requires that the tag GENERATE_RTF is set to YES. -RTF_HYPERLINKS = YES +RTF_HYPERLINKS = NO -# Load stylesheet definitions from file. Syntax is similar to doxygen's config -# file, i.e. a series of assignments. You only have to provide replacements, -# missing definitions are set to their default value. +# Load stylesheet definitions from file. Syntax is similar to Doxygen's +# configuration file, i.e. a series of assignments. You only have to provide +# replacements, missing definitions are set to their default value. # # See also section "Doxygen usage" for information on how to generate the -# default style sheet that doxygen normally uses. +# default style sheet that Doxygen normally uses. # This tag requires that the tag GENERATE_RTF is set to YES. RTF_STYLESHEET_FILE = # Set optional variables used in the generation of an RTF document. Syntax is -# similar to doxygen's config file. A template extensions file can be generated -# using doxygen -e rtf extensionFile. +# similar to Doxygen's configuration file. A template extensions file can be +# generated using doxygen -e rtf extensionFile. # This tag requires that the tag GENERATE_RTF is set to YES. RTF_EXTENSIONS_FILE = -# If the RTF_SOURCE_CODE tag is set to YES then doxygen will include source code -# with syntax highlighting in the RTF output. -# -# Note that which sources are shown also depends on other settings such as -# SOURCE_BROWSER. -# The default value is: NO. +# The RTF_EXTRA_FILES tag can be used to specify one or more extra images or +# other source files which should be copied to the RTF_OUTPUT output directory. +# Note that the files will be copied as-is; there are no commands or markers +# available. # This tag requires that the tag GENERATE_RTF is set to YES. -RTF_SOURCE_CODE = NO +RTF_EXTRA_FILES = #--------------------------------------------------------------------------- # Configuration options related to the man page output #--------------------------------------------------------------------------- -# If the GENERATE_MAN tag is set to YES, doxygen will generate man pages for +# If the GENERATE_MAN tag is set to YES, Doxygen will generate man pages for # classes and files. # The default value is: NO. @@ -1879,20 +2259,20 @@ MAN_EXTENSION = .3 MAN_SUBDIR = -# If the MAN_LINKS tag is set to YES and doxygen generates man output, then it +# If the MAN_LINKS tag is set to YES and Doxygen generates man output, then it # will generate one additional man file for each entity documented in the real # man page(s). These additional files only source the real man page, but without # them the man command would be unable to find the correct page. # The default value is: NO. # This tag requires that the tag GENERATE_MAN is set to YES. -MAN_LINKS = YES +MAN_LINKS = NO #--------------------------------------------------------------------------- # Configuration options related to the XML output #--------------------------------------------------------------------------- -# If the GENERATE_XML tag is set to YES, doxygen will generate an XML file that +# If the GENERATE_XML tag is set to YES, Doxygen will generate an XML file that # captures the structure of the code including all documentation. # The default value is: NO. @@ -1906,7 +2286,7 @@ GENERATE_XML = NO XML_OUTPUT = xml -# If the XML_PROGRAMLISTING tag is set to YES, doxygen will dump the program +# If the XML_PROGRAMLISTING tag is set to YES, Doxygen will dump the program # listings (including syntax highlighting and cross-referencing information) to # the XML output. Note that enabling this will significantly increase the size # of the XML output. @@ -1915,11 +2295,18 @@ XML_OUTPUT = xml XML_PROGRAMLISTING = YES +# If the XML_NS_MEMB_FILE_SCOPE tag is set to YES, Doxygen will include +# namespace members in file scope as well, matching the HTML output. +# The default value is: NO. +# This tag requires that the tag GENERATE_XML is set to YES. + +XML_NS_MEMB_FILE_SCOPE = NO + #--------------------------------------------------------------------------- # Configuration options related to the DOCBOOK output #--------------------------------------------------------------------------- -# If the GENERATE_DOCBOOK tag is set to YES, doxygen will generate Docbook files +# If the GENERATE_DOCBOOK tag is set to YES, Doxygen will generate Docbook files # that can be used to generate PDF. # The default value is: NO. @@ -1933,32 +2320,49 @@ GENERATE_DOCBOOK = NO DOCBOOK_OUTPUT = docbook -# If the DOCBOOK_PROGRAMLISTING tag is set to YES, doxygen will include the -# program listings (including syntax highlighting and cross-referencing -# information) to the DOCBOOK output. Note that enabling this will significantly -# increase the size of the DOCBOOK output. +#--------------------------------------------------------------------------- +# Configuration options for the AutoGen Definitions output +#--------------------------------------------------------------------------- + +# If the GENERATE_AUTOGEN_DEF tag is set to YES, Doxygen will generate an +# AutoGen Definitions (see https://autogen.sourceforge.net/) file that captures +# the structure of the code including all documentation. Note that this feature +# is still experimental and incomplete at the moment. # The default value is: NO. -# This tag requires that the tag GENERATE_DOCBOOK is set to YES. -DOCBOOK_PROGRAMLISTING = NO +GENERATE_AUTOGEN_DEF = NO #--------------------------------------------------------------------------- -# Configuration options for the AutoGen Definitions output +# Configuration options related to Sqlite3 output #--------------------------------------------------------------------------- -# If the GENERATE_AUTOGEN_DEF tag is set to YES, doxygen will generate an -# AutoGen Definitions (see http://autogen.sf.net) file that captures the -# structure of the code including all documentation. Note that this feature is -# still experimental and incomplete at the moment. +# If the GENERATE_SQLITE3 tag is set to YES Doxygen will generate a Sqlite3 +# database with symbols found by Doxygen stored in tables. # The default value is: NO. -GENERATE_AUTOGEN_DEF = NO +GENERATE_SQLITE3 = NO + +# The SQLITE3_OUTPUT tag is used to specify where the Sqlite3 database will be +# put. If a relative path is entered the value of OUTPUT_DIRECTORY will be put +# in front of it. +# The default directory is: sqlite3. +# This tag requires that the tag GENERATE_SQLITE3 is set to YES. + +SQLITE3_OUTPUT = sqlite3 + +# The SQLITE3_RECREATE_DB tag is set to YES, the existing doxygen_sqlite3.db +# database file will be recreated with each Doxygen run. If set to NO, Doxygen +# will warn if a database file is already found and not modify it. +# The default value is: YES. +# This tag requires that the tag GENERATE_SQLITE3 is set to YES. + +SQLITE3_RECREATE_DB = YES #--------------------------------------------------------------------------- # Configuration options related to the Perl module output #--------------------------------------------------------------------------- -# If the GENERATE_PERLMOD tag is set to YES, doxygen will generate a Perl module +# If the GENERATE_PERLMOD tag is set to YES, Doxygen will generate a Perl module # file that captures the structure of the code including all documentation. # # Note that this feature is still experimental and incomplete at the moment. @@ -1966,7 +2370,7 @@ GENERATE_AUTOGEN_DEF = NO GENERATE_PERLMOD = NO -# If the PERLMOD_LATEX tag is set to YES, doxygen will generate the necessary +# If the PERLMOD_LATEX tag is set to YES, Doxygen will generate the necessary # Makefile rules, Perl scripts and LaTeX code to be able to generate PDF and DVI # output from the Perl module output. # The default value is: NO. @@ -1996,13 +2400,13 @@ PERLMOD_MAKEVAR_PREFIX = # Configuration options related to the preprocessor #--------------------------------------------------------------------------- -# If the ENABLE_PREPROCESSING tag is set to YES, doxygen will evaluate all +# If the ENABLE_PREPROCESSING tag is set to YES, Doxygen will evaluate all # C-preprocessor directives found in the sources and include files. # The default value is: YES. ENABLE_PREPROCESSING = YES -# If the MACRO_EXPANSION tag is set to YES, doxygen will expand all macro names +# If the MACRO_EXPANSION tag is set to YES, Doxygen will expand all macro names # in the source code. If set to NO, only conditional compilation will be # performed. Macro expansion can be done in a controlled way by setting # EXPAND_ONLY_PREDEF to YES. @@ -2028,7 +2432,8 @@ SEARCH_INCLUDES = YES # The INCLUDE_PATH tag can be used to specify one or more directories that # contain include files that are not input files but should be processed by the -# preprocessor. +# preprocessor. Note that the INCLUDE_PATH is not recursive, so the setting of +# RECURSIVE has no effect here. # This tag requires that the tag SEARCH_INCLUDES is set to YES. INCLUDE_PATH = @@ -2060,7 +2465,7 @@ PREDEFINED = EXPAND_AS_DEFINED = -# If the SKIP_FUNCTION_MACROS tag is set to YES then doxygen's preprocessor will +# If the SKIP_FUNCTION_MACROS tag is set to YES then Doxygen's preprocessor will # remove all references to function-like macros that are alone on a line, have # an all uppercase name, and do not end with a semicolon. Such function macros # are typically used for boiler-plate code, and will confuse the parser if not @@ -2084,26 +2489,26 @@ SKIP_FUNCTION_MACROS = YES # section "Linking to external documentation" for more information about the use # of tag files. # Note: Each tag file must have a unique name (where the name does NOT include -# the path). If a tag file is not located in the directory in which doxygen is +# the path). If a tag file is not located in the directory in which Doxygen is # run, you must also specify the path to the tagfile here. TAGFILES = -# When a file name is specified after GENERATE_TAGFILE, doxygen will create a +# When a file name is specified after GENERATE_TAGFILE, Doxygen will create a # tag file that is based on the input files it reads. See section "Linking to # external documentation" for more information about the usage of tag files. GENERATE_TAGFILE = -# If the ALLEXTERNALS tag is set to YES, all external class will be listed in -# the class index. If set to NO, only the inherited external classes will be -# listed. +# If the ALLEXTERNALS tag is set to YES, all external classes and namespaces +# will be listed in the class and namespace index. If set to NO, only the +# inherited external classes will be listed. # The default value is: NO. ALLEXTERNALS = NO # If the EXTERNAL_GROUPS tag is set to YES, all external groups will be listed -# in the modules index. If set to NO, only the current project's groups will be +# in the topic index. If set to NO, only the current project's groups will be # listed. # The default value is: YES. @@ -2116,58 +2521,27 @@ EXTERNAL_GROUPS = YES EXTERNAL_PAGES = YES -# The PERL_PATH should be the absolute path and name of the perl script -# interpreter (i.e. the result of 'which perl'). -# The default file (with absolute path) is: /usr/bin/perl. - -PERL_PATH = /sw/bin/perl - #--------------------------------------------------------------------------- -# Configuration options related to the dot tool +# Configuration options related to diagram generator tools #--------------------------------------------------------------------------- -# If the CLASS_DIAGRAMS tag is set to YES, doxygen will generate a class diagram -# (in HTML and LaTeX) for classes with base or super classes. Setting the tag to -# NO turns the diagrams off. Note that this option also works with HAVE_DOT -# disabled, but it is recommended to install and use dot, since it yields more -# powerful graphs. -# The default value is: YES. - -CLASS_DIAGRAMS = YES - -# You can define message sequence charts within doxygen comments using the \msc -# command. Doxygen will then run the mscgen tool (see: -# http://www.mcternan.me.uk/mscgen/)) to produce the chart and insert it in the -# documentation. The MSCGEN_PATH tag allows you to specify the directory where -# the mscgen tool resides. If left empty the tool is assumed to be found in the -# default search path. - -MSCGEN_PATH = - -# You can include diagrams made with dia in doxygen documentation. Doxygen will -# then run dia to produce the diagram and insert it in the documentation. The -# DIA_PATH tag allows you to specify the directory where the dia binary resides. -# If left empty dia is assumed to be found in the default search path. - -DIA_PATH = - # If set to YES the inheritance and collaboration graphs will hide inheritance # and usage relations if the target is undocumented or is not a class. # The default value is: YES. HIDE_UNDOC_RELATIONS = YES -# If you set the HAVE_DOT tag to YES then doxygen will assume the dot tool is +# If you set the HAVE_DOT tag to YES then Doxygen will assume the dot tool is # available from the path. This tool is part of Graphviz (see: -# http://www.graphviz.org/), a graph visualization toolkit from AT&T and Lucent +# https://www.graphviz.org/), a graph visualization toolkit from AT&T and Lucent # Bell Labs. The other options in this section have no effect if this option is # set to NO # The default value is: NO. HAVE_DOT = YES -# The DOT_NUM_THREADS specifies the number of dot invocations doxygen is allowed -# to run in parallel. When set to 0 doxygen will base this on the number of +# The DOT_NUM_THREADS specifies the number of dot invocations Doxygen is allowed +# to run in parallel. When set to 0 Doxygen will base this on the number of # processors available in the system. You can set it explicitly to a value # larger than 0 to get control over the balance between CPU load and processing # speed. @@ -2176,55 +2550,83 @@ HAVE_DOT = YES DOT_NUM_THREADS = 0 -# When you want a differently looking font in the dot files that doxygen -# generates you can specify the font name using DOT_FONTNAME. You need to make -# sure dot is able to find the font, which can be done by putting it in a -# standard location or by setting the DOTFONTPATH environment variable or by -# setting DOT_FONTPATH to the directory containing the font. -# The default value is: Helvetica. +# DOT_COMMON_ATTR is common attributes for nodes, edges and labels of +# subgraphs. When you want a differently looking font in the dot files that +# Doxygen generates you can specify fontname, fontcolor and fontsize attributes. +# For details please see Node, +# Edge and Graph Attributes specification You need to make sure dot is able +# to find the font, which can be done by putting it in a standard location or by +# setting the DOTFONTPATH environment variable or by setting DOT_FONTPATH to the +# directory containing the font. Default graphviz fontsize is 14. +# The default value is: fontname=Helvetica,fontsize=10. +# This tag requires that the tag HAVE_DOT is set to YES. + +DOT_COMMON_ATTR = "fontname=Helvetica,fontsize=10" + +# DOT_EDGE_ATTR is concatenated with DOT_COMMON_ATTR. For elegant style you can +# add 'arrowhead=open, arrowtail=open, arrowsize=0.5'. Complete documentation about +# arrows shapes. +# The default value is: labelfontname=Helvetica,labelfontsize=10. # This tag requires that the tag HAVE_DOT is set to YES. -DOT_FONTNAME = Helvetica +DOT_EDGE_ATTR = "labelfontname=Helvetica,labelfontsize=10" -# The DOT_FONTSIZE tag can be used to set the size (in points) of the font of -# dot graphs. -# Minimum value: 4, maximum value: 24, default value: 10. +# DOT_NODE_ATTR is concatenated with DOT_COMMON_ATTR. For view without boxes +# around nodes set 'shape=plain' or 'shape=plaintext' Shapes specification +# The default value is: shape=box,height=0.2,width=0.4. # This tag requires that the tag HAVE_DOT is set to YES. -DOT_FONTSIZE = 10 +DOT_NODE_ATTR = "shape=box,height=0.2,width=0.4" -# By default doxygen will tell dot to use the default font as specified with -# DOT_FONTNAME. If you specify a different font using DOT_FONTNAME you can set -# the path where dot can find it using this tag. +# You can set the path where dot can find font specified with fontname in +# DOT_COMMON_ATTR and others dot attributes. # This tag requires that the tag HAVE_DOT is set to YES. DOT_FONTPATH = -# If the CLASS_GRAPH tag is set to YES then doxygen will generate a graph for -# each documented class showing the direct and indirect inheritance relations. -# Setting this tag to YES will force the CLASS_DIAGRAMS tag to NO. +# If the CLASS_GRAPH tag is set to YES or GRAPH or BUILTIN then Doxygen will +# generate a graph for each documented class showing the direct and indirect +# inheritance relations. In case the CLASS_GRAPH tag is set to YES or GRAPH and +# HAVE_DOT is enabled as well, then dot will be used to draw the graph. In case +# the CLASS_GRAPH tag is set to YES and HAVE_DOT is disabled or if the +# CLASS_GRAPH tag is set to BUILTIN, then the built-in generator will be used. +# If the CLASS_GRAPH tag is set to TEXT the direct and indirect inheritance +# relations will be shown as texts / links. Explicit enabling an inheritance +# graph or choosing a different representation for an inheritance graph of a +# specific class, can be accomplished by means of the command \inheritancegraph. +# Disabling an inheritance graph can be accomplished by means of the command +# \hideinheritancegraph. +# Possible values are: NO, YES, TEXT, GRAPH and BUILTIN. # The default value is: YES. -# This tag requires that the tag HAVE_DOT is set to YES. CLASS_GRAPH = YES -# If the COLLABORATION_GRAPH tag is set to YES then doxygen will generate a +# If the COLLABORATION_GRAPH tag is set to YES then Doxygen will generate a # graph for each documented class showing the direct and indirect implementation # dependencies (inheritance, containment, and class references variables) of the -# class with other documented classes. +# class with other documented classes. Explicit enabling a collaboration graph, +# when COLLABORATION_GRAPH is set to NO, can be accomplished by means of the +# command \collaborationgraph. Disabling a collaboration graph can be +# accomplished by means of the command \hidecollaborationgraph. # The default value is: YES. # This tag requires that the tag HAVE_DOT is set to YES. COLLABORATION_GRAPH = YES -# If the GROUP_GRAPHS tag is set to YES then doxygen will generate a graph for -# groups, showing the direct groups dependencies. +# If the GROUP_GRAPHS tag is set to YES then Doxygen will generate a graph for +# groups, showing the direct groups dependencies. Explicit enabling a group +# dependency graph, when GROUP_GRAPHS is set to NO, can be accomplished by means +# of the command \groupgraph. Disabling a directory graph can be accomplished by +# means of the command \hidegroupgraph. See also the chapter Grouping in the +# manual. # The default value is: YES. # This tag requires that the tag HAVE_DOT is set to YES. GROUP_GRAPHS = YES -# If the UML_LOOK tag is set to YES, doxygen will generate inheritance and +# If the UML_LOOK tag is set to YES, Doxygen will generate inheritance and # collaboration diagrams in a style similar to the OMG's Unified Modeling # Language. # The default value is: NO. @@ -2241,10 +2643,32 @@ UML_LOOK = NO # but if the number exceeds 15, the total amount of fields shown is limited to # 10. # Minimum value: 0, maximum value: 100, default value: 10. -# This tag requires that the tag HAVE_DOT is set to YES. +# This tag requires that the tag UML_LOOK is set to YES. UML_LIMIT_NUM_FIELDS = 10 +# If the DOT_UML_DETAILS tag is set to NO, Doxygen will show attributes and +# methods without types and arguments in the UML graphs. If the DOT_UML_DETAILS +# tag is set to YES, Doxygen will add type and arguments for attributes and +# methods in the UML graphs. If the DOT_UML_DETAILS tag is set to NONE, Doxygen +# will not generate fields with class member information in the UML graphs. The +# class diagrams will look similar to the default class diagrams but using UML +# notation for the relationships. +# Possible values are: NO, YES and NONE. +# The default value is: NO. +# This tag requires that the tag UML_LOOK is set to YES. + +DOT_UML_DETAILS = NO + +# The DOT_WRAP_THRESHOLD tag can be used to set the maximum number of characters +# to display on a single line. If the actual line length exceeds this threshold +# significantly it will be wrapped across multiple lines. Some heuristics are +# applied to avoid ugly line breaks. +# Minimum value: 0, maximum value: 1000, default value: 17. +# This tag requires that the tag HAVE_DOT is set to YES. + +DOT_WRAP_THRESHOLD = 17 + # If the TEMPLATE_RELATIONS tag is set to YES then the inheritance and # collaboration graphs will show the relations between templates and their # instances. @@ -2254,24 +2678,29 @@ UML_LIMIT_NUM_FIELDS = 10 TEMPLATE_RELATIONS = NO # If the INCLUDE_GRAPH, ENABLE_PREPROCESSING and SEARCH_INCLUDES tags are set to -# YES then doxygen will generate a graph for each documented file showing the +# YES then Doxygen will generate a graph for each documented file showing the # direct and indirect include dependencies of the file with other documented -# files. +# files. Explicit enabling an include graph, when INCLUDE_GRAPH is is set to NO, +# can be accomplished by means of the command \includegraph. Disabling an +# include graph can be accomplished by means of the command \hideincludegraph. # The default value is: YES. # This tag requires that the tag HAVE_DOT is set to YES. INCLUDE_GRAPH = YES # If the INCLUDED_BY_GRAPH, ENABLE_PREPROCESSING and SEARCH_INCLUDES tags are -# set to YES then doxygen will generate a graph for each documented file showing +# set to YES then Doxygen will generate a graph for each documented file showing # the direct and indirect include dependencies of the file with other documented -# files. +# files. Explicit enabling an included by graph, when INCLUDED_BY_GRAPH is set +# to NO, can be accomplished by means of the command \includedbygraph. Disabling +# an included by graph can be accomplished by means of the command +# \hideincludedbygraph. # The default value is: YES. # This tag requires that the tag HAVE_DOT is set to YES. INCLUDED_BY_GRAPH = YES -# If the CALL_GRAPH tag is set to YES then doxygen will generate a call +# If the CALL_GRAPH tag is set to YES then Doxygen will generate a call # dependency graph for every global function or class method. # # Note that enabling this option will significantly increase the time of a run. @@ -2283,7 +2712,7 @@ INCLUDED_BY_GRAPH = YES CALL_GRAPH = YES -# If the CALLER_GRAPH tag is set to YES then doxygen will generate a caller +# If the CALLER_GRAPH tag is set to YES then Doxygen will generate a caller # dependency graph for every global function or class method. # # Note that enabling this option will significantly increase the time of a run. @@ -2295,26 +2724,36 @@ CALL_GRAPH = YES CALLER_GRAPH = YES -# If the GRAPHICAL_HIERARCHY tag is set to YES then doxygen will graphical +# If the GRAPHICAL_HIERARCHY tag is set to YES then Doxygen will graphical # hierarchy of all classes instead of a textual one. # The default value is: YES. # This tag requires that the tag HAVE_DOT is set to YES. GRAPHICAL_HIERARCHY = YES -# If the DIRECTORY_GRAPH tag is set to YES then doxygen will show the +# If the DIRECTORY_GRAPH tag is set to YES then Doxygen will show the # dependencies a directory has on other directories in a graphical way. The # dependency relations are determined by the #include relations between the -# files in the directories. +# files in the directories. Explicit enabling a directory graph, when +# DIRECTORY_GRAPH is set to NO, can be accomplished by means of the command +# \directorygraph. Disabling a directory graph can be accomplished by means of +# the command \hidedirectorygraph. # The default value is: YES. # This tag requires that the tag HAVE_DOT is set to YES. DIRECTORY_GRAPH = YES +# The DIR_GRAPH_MAX_DEPTH tag can be used to limit the maximum number of levels +# of child directories generated in directory dependency graphs by dot. +# Minimum value: 1, maximum value: 25, default value: 1. +# This tag requires that the tag DIRECTORY_GRAPH is set to YES. + +DIR_GRAPH_MAX_DEPTH = 1 + # The DOT_IMAGE_FORMAT tag can be used to set the image format of the images # generated by dot. For an explanation of the image formats see the section # output formats in the documentation of the dot tool (Graphviz (see: -# http://www.graphviz.org/)). +# https://www.graphviz.org/)). # Note: If you choose svg you need to set HTML_FILE_EXTENSION to xhtml in order # to make the SVG files visible in IE 9+ (other browsers do not have this # requirement). @@ -2351,11 +2790,12 @@ DOT_PATH = DOTFILE_DIRS = -# The MSCFILE_DIRS tag can be used to specify one or more directories that -# contain msc files that are included in the documentation (see the \mscfile -# command). +# You can include diagrams made with dia in Doxygen documentation. Doxygen will +# then run dia to produce the diagram and insert it in the documentation. The +# DIA_PATH tag allows you to specify the directory where the dia binary resides. +# If left empty dia is assumed to be found in the default search path. -MSCFILE_DIRS = +DIA_PATH = # The DIAFILE_DIRS tag can be used to specify one or more directories that # contain dia files that are included in the documentation (see the \diafile @@ -2363,30 +2803,35 @@ MSCFILE_DIRS = DIAFILE_DIRS = -# When using plantuml, the PLANTUML_JAR_PATH tag should be used to specify the -# path where java can find the plantuml.jar file. If left blank, it is assumed -# PlantUML is not used or called during a preprocessing step. Doxygen will -# generate a warning when it encounters a \startuml command in this case and -# will not generate output for the diagram. +# When using PlantUML, the PLANTUML_JAR_PATH tag should be used to specify the +# path where java can find the plantuml.jar file or to the filename of jar file +# to be used. If left blank, it is assumed PlantUML is not used or called during +# a preprocessing step. Doxygen will generate a warning when it encounters a +# \startuml command in this case and will not generate output for the diagram. PLANTUML_JAR_PATH = -# When using plantuml, the specified paths are searched for files specified by -# the !include statement in a plantuml block. +# When using PlantUML, the PLANTUML_CFG_FILE tag can be used to specify a +# configuration file for PlantUML. + +PLANTUML_CFG_FILE = + +# When using PlantUML, the specified paths are searched for files specified by +# the !include statement in a PlantUML block. PLANTUML_INCLUDE_PATH = # The DOT_GRAPH_MAX_NODES tag can be used to set the maximum number of nodes # that will be shown in the graph. If the number of nodes in a graph becomes -# larger than this value, doxygen will truncate the graph, which is visualized -# by representing a node as a red box. Note that doxygen if the number of direct +# larger than this value, Doxygen will truncate the graph, which is visualized +# by representing a node as a red box. Note that if the number of direct # children of the root node in a graph is already larger than # DOT_GRAPH_MAX_NODES then the graph will not be shown at all. Also note that # the size of a graph can be further restricted by MAX_DOT_GRAPH_DEPTH. # Minimum value: 0, maximum value: 10000, default value: 50. # This tag requires that the tag HAVE_DOT is set to YES. -DOT_GRAPH_MAX_NODES = 50 +DOT_GRAPH_MAX_NODES = 200 # The MAX_DOT_GRAPH_DEPTH tag can be used to set the maximum depth of the graphs # generated by dot. A depth value of 3 means that only nodes reachable from the @@ -2400,18 +2845,6 @@ DOT_GRAPH_MAX_NODES = 50 MAX_DOT_GRAPH_DEPTH = 0 -# Set the DOT_TRANSPARENT tag to YES to generate images with a transparent -# background. This is disabled by default, because dot on Windows does not seem -# to support this out of the box. -# -# Warning: Depending on the platform used, enabling this option may lead to -# badly anti-aliased labels on the edges of a graph (i.e. they become hard to -# read). -# The default value is: NO. -# This tag requires that the tag HAVE_DOT is set to YES. - -DOT_TRANSPARENT = NO - # Set the DOT_MULTI_TARGETS tag to YES to allow dot to generate multiple output # files in one run (i.e. multiple -o and -T options on the command line). This # makes dot run faster, but since only newer versions of dot (>1.8.10) support @@ -2421,17 +2854,37 @@ DOT_TRANSPARENT = NO DOT_MULTI_TARGETS = NO -# If the GENERATE_LEGEND tag is set to YES doxygen will generate a legend page +# If the GENERATE_LEGEND tag is set to YES Doxygen will generate a legend page # explaining the meaning of the various boxes and arrows in the dot generated # graphs. +# Note: This tag requires that UML_LOOK isn't set, i.e. the Doxygen internal +# graphical representation for inheritance and collaboration diagrams is used. # The default value is: YES. # This tag requires that the tag HAVE_DOT is set to YES. GENERATE_LEGEND = YES -# If the DOT_CLEANUP tag is set to YES, doxygen will remove the intermediate dot +# If the DOT_CLEANUP tag is set to YES, Doxygen will remove the intermediate # files that are used to generate the various graphs. +# +# Note: This setting is not only used for dot files but also for msc temporary +# files. # The default value is: YES. -# This tag requires that the tag HAVE_DOT is set to YES. DOT_CLEANUP = YES + +# You can define message sequence charts within Doxygen comments using the \msc +# command. If the MSCGEN_TOOL tag is left empty (the default), then Doxygen will +# use a built-in version of mscgen tool to produce the charts. Alternatively, +# the MSCGEN_TOOL tag can also specify the name an external tool. For instance, +# specifying prog as the value, Doxygen will call the tool as prog -T +# -o . The external tool should support +# output file formats "png", "eps", "svg", and "ismap". + +MSCGEN_TOOL = + +# The MSCFILE_DIRS tag can be used to specify one or more directories that +# contain msc files that are included in the documentation (see the \mscfile +# command). + +MSCFILE_DIRS = diff --git a/DOCS/Doxyfile_man b/DOCS/Doxyfile_man deleted file mode 100644 index 426e08d73b..0000000000 --- a/DOCS/Doxyfile_man +++ /dev/null @@ -1,2417 +0,0 @@ -# Doxyfile 1.8.10 - -# This file describes the settings to be used by the documentation system -# doxygen (www.doxygen.org) for a project. -# -# All text after a double hash (##) is considered a comment and is placed in -# front of the TAG it is preceding. -# -# All text after a single hash (#) is considered a comment and will be ignored. -# The format is: -# TAG = value [value, ...] -# For lists, items can also be appended using: -# TAG += value [value, ...] -# Values that contain spaces should be placed between quotes (\" \"). - -#--------------------------------------------------------------------------- -# Project related configuration options -#--------------------------------------------------------------------------- - -# This tag specifies the encoding used for all characters in the config file -# that follow. The default is UTF-8 which is also the encoding used for all text -# before the first occurrence of this tag. Doxygen uses libiconv (or the iconv -# built into libc) for the transcoding. See http://www.gnu.org/software/libiconv -# for the list of possible encodings. -# The default value is: UTF-8. - -DOXYFILE_ENCODING = UTF-8 - -# The PROJECT_NAME tag is a single word (or a sequence of words surrounded by -# double-quotes, unless you are using Doxywizard) that should identify the -# project for which the documentation is generated. This name is used in the -# title of most generated pages and in a few other places. -# The default value is: My Project. - -PROJECT_NAME = LAPACK - -# The PROJECT_NUMBER tag can be used to enter a project or revision number. This -# could be handy for archiving the generated documentation or if some version -# control system is used. - -PROJECT_NUMBER = 3.7.1 - -# Using the PROJECT_BRIEF tag one can provide an optional one line description -# for a project that appears at the top of each page and should give viewer a -# quick idea about the purpose of the project. Keep the description short. - -PROJECT_BRIEF = "LAPACK: Linear Algebra PACKage" - -# With the PROJECT_LOGO tag one can specify a logo or an icon that is included -# in the documentation. The maximum height of the logo should not exceed 55 -# pixels and the maximum width should not exceed 200 pixels. Doxygen will copy -# the logo to the output directory. - -PROJECT_LOGO = DOCS/lapack.png - -# The OUTPUT_DIRECTORY tag is used to specify the (relative or absolute) path -# into which the generated documentation will be written. If a relative path is -# entered, it will be relative to the location where doxygen was started. If -# left blank the current directory will be used. - -OUTPUT_DIRECTORY = DOCS - -# If the CREATE_SUBDIRS tag is set to YES then doxygen will create 4096 sub- -# directories (in 2 levels) under the output directory of each output format and -# will distribute the generated files over these directories. Enabling this -# option can be useful when feeding doxygen a huge amount of source files, where -# putting all generated files in the same directory would otherwise causes -# performance problems for the file system. -# The default value is: NO. - -CREATE_SUBDIRS = NO - -# If the ALLOW_UNICODE_NAMES tag is set to YES, doxygen will allow non-ASCII -# characters to appear in the names of generated files. If set to NO, non-ASCII -# characters will be escaped, for example _xE3_x81_x84 will be used for Unicode -# U+3044. -# The default value is: NO. - -ALLOW_UNICODE_NAMES = NO - -# The OUTPUT_LANGUAGE tag is used to specify the language in which all -# documentation generated by doxygen is written. Doxygen will use this -# information to generate all constant output in the proper language. -# Possible values are: Afrikaans, Arabic, Armenian, Brazilian, Catalan, Chinese, -# Chinese-Traditional, Croatian, Czech, Danish, Dutch, English (United States), -# Esperanto, Farsi (Persian), Finnish, French, German, Greek, Hungarian, -# Indonesian, Italian, Japanese, Japanese-en (Japanese with English messages), -# Korean, Korean-en (Korean with English messages), Latvian, Lithuanian, -# Macedonian, Norwegian, Persian (Farsi), Polish, Portuguese, Romanian, Russian, -# Serbian, Serbian-Cyrillic, Slovak, Slovene, Spanish, Swedish, Turkish, -# Ukrainian and Vietnamese. -# The default value is: English. - -OUTPUT_LANGUAGE = English - -# If the BRIEF_MEMBER_DESC tag is set to YES, doxygen will include brief member -# descriptions after the members that are listed in the file and class -# documentation (similar to Javadoc). Set to NO to disable this. -# The default value is: YES. - -BRIEF_MEMBER_DESC = YES - -# If the REPEAT_BRIEF tag is set to YES, doxygen will prepend the brief -# description of a member or function before the detailed description -# -# Note: If both HIDE_UNDOC_MEMBERS and BRIEF_MEMBER_DESC are set to NO, the -# brief descriptions will be completely suppressed. -# The default value is: YES. - -REPEAT_BRIEF = YES - -# This tag implements a quasi-intelligent brief description abbreviator that is -# used to form the text in various listings. Each string in this list, if found -# as the leading text of the brief description, will be stripped from the text -# and the result, after processing the whole list, is used as the annotated -# text. Otherwise, the brief description is used as-is. If left blank, the -# following values are used ($name is automatically replaced with the name of -# the entity):The $name class, The $name widget, The $name file, is, provides, -# specifies, contains, represents, a, an and the. - -ABBREVIATE_BRIEF = - -# If the ALWAYS_DETAILED_SEC and REPEAT_BRIEF tags are both set to YES then -# doxygen will generate a detailed section even if there is only a brief -# description. -# The default value is: NO. - -ALWAYS_DETAILED_SEC = NO - -# If the INLINE_INHERITED_MEMB tag is set to YES, doxygen will show all -# inherited members of a class in the documentation of that class as if those -# members were ordinary class members. Constructors, destructors and assignment -# operators of the base classes will not be shown. -# The default value is: NO. - -INLINE_INHERITED_MEMB = NO - -# If the FULL_PATH_NAMES tag is set to YES, doxygen will prepend the full path -# before files name in the file list and in the header files. If set to NO the -# shortest path that makes the file name unique will be used -# The default value is: YES. - -FULL_PATH_NAMES = NO - -# The STRIP_FROM_PATH tag can be used to strip a user-defined part of the path. -# Stripping is only done if one of the specified strings matches the left-hand -# part of the path. The tag can be used to show relative paths in the file list. -# If left blank the directory from which doxygen is run is used as the path to -# strip. -# -# Note that you can specify absolute paths here, but also relative paths, which -# will be relative from the directory where doxygen is started. -# This tag requires that the tag FULL_PATH_NAMES is set to YES. - -STRIP_FROM_PATH = - -# The STRIP_FROM_INC_PATH tag can be used to strip a user-defined part of the -# path mentioned in the documentation of a class, which tells the reader which -# header file to include in order to use a class. If left blank only the name of -# the header file containing the class definition is used. Otherwise one should -# specify the list of include paths that are normally passed to the compiler -# using the -I flag. - -STRIP_FROM_INC_PATH = - -# If the SHORT_NAMES tag is set to YES, doxygen will generate much shorter (but -# less readable) file names. This can be useful is your file systems doesn't -# support long names like on DOS, Mac, or CD-ROM. -# The default value is: NO. - -SHORT_NAMES = NO - -# If the JAVADOC_AUTOBRIEF tag is set to YES then doxygen will interpret the -# first line (until the first dot) of a Javadoc-style comment as the brief -# description. If set to NO, the Javadoc-style will behave just like regular Qt- -# style comments (thus requiring an explicit @brief command for a brief -# description.) -# The default value is: NO. - -JAVADOC_AUTOBRIEF = NO - -# If the QT_AUTOBRIEF tag is set to YES then doxygen will interpret the first -# line (until the first dot) of a Qt-style comment as the brief description. If -# set to NO, the Qt-style will behave just like regular Qt-style comments (thus -# requiring an explicit \brief command for a brief description.) -# The default value is: NO. - -QT_AUTOBRIEF = NO - -# The MULTILINE_CPP_IS_BRIEF tag can be set to YES to make doxygen treat a -# multi-line C++ special comment block (i.e. a block of //! or /// comments) as -# a brief description. This used to be the default behavior. The new default is -# to treat a multi-line C++ comment block as a detailed description. Set this -# tag to YES if you prefer the old behavior instead. -# -# Note that setting this tag to YES also means that rational rose comments are -# not recognized any more. -# The default value is: NO. - -MULTILINE_CPP_IS_BRIEF = NO - -# If the INHERIT_DOCS tag is set to YES then an undocumented member inherits the -# documentation from any documented member that it re-implements. -# The default value is: YES. - -INHERIT_DOCS = YES - -# If the SEPARATE_MEMBER_PAGES tag is set to YES then doxygen will produce a new -# page for each member. If set to NO, the documentation of a member will be part -# of the file/class/namespace that contains it. -# The default value is: NO. - -SEPARATE_MEMBER_PAGES = NO - -# The TAB_SIZE tag can be used to set the number of spaces in a tab. Doxygen -# uses this value to replace tabs by spaces in code fragments. -# Minimum value: 1, maximum value: 16, default value: 4. - -TAB_SIZE = 8 - -# This tag can be used to specify a number of aliases that act as commands in -# the documentation. An alias has the form: -# name=value -# For example adding -# "sideeffect=@par Side Effects:\n" -# will allow you to put the command \sideeffect (or @sideeffect) in the -# documentation, which will result in a user-defined paragraph with heading -# "Side Effects:". You can put \n's in the value part of an alias to insert -# newlines. - -ALIASES = - -# This tag can be used to specify a number of word-keyword mappings (TCL only). -# A mapping has the form "name=value". For example adding "class=itcl::class" -# will allow you to use the command class in the itcl::class meaning. - -TCL_SUBST = - -# Set the OPTIMIZE_OUTPUT_FOR_C tag to YES if your project consists of C sources -# only. Doxygen will then generate output that is more tailored for C. For -# instance, some of the names that are used will be different. The list of all -# members will be omitted, etc. -# The default value is: NO. - -OPTIMIZE_OUTPUT_FOR_C = NO - -# Set the OPTIMIZE_OUTPUT_JAVA tag to YES if your project consists of Java or -# Python sources only. Doxygen will then generate output that is more tailored -# for that language. For instance, namespaces will be presented as packages, -# qualified scopes will look different, etc. -# The default value is: NO. - -OPTIMIZE_OUTPUT_JAVA = NO - -# Set the OPTIMIZE_FOR_FORTRAN tag to YES if your project consists of Fortran -# sources. Doxygen will then generate output that is tailored for Fortran. -# The default value is: NO. - -OPTIMIZE_FOR_FORTRAN = YES - -# Set the OPTIMIZE_OUTPUT_VHDL tag to YES if your project consists of VHDL -# sources. Doxygen will then generate output that is tailored for VHDL. -# The default value is: NO. - -OPTIMIZE_OUTPUT_VHDL = NO - -# Doxygen selects the parser to use depending on the extension of the files it -# parses. With this tag you can assign which parser to use for a given -# extension. Doxygen has a built-in mapping, but you can override or extend it -# using this tag. The format is ext=language, where ext is a file extension, and -# language is one of the parsers supported by doxygen: IDL, Java, Javascript, -# C#, C, C++, D, PHP, Objective-C, Python, Fortran (fixed format Fortran: -# FortranFixed, free formatted Fortran: FortranFree, unknown formatted Fortran: -# Fortran. In the later case the parser tries to guess whether the code is fixed -# or free formatted code, this is the default for Fortran type files), VHDL. For -# instance to make doxygen treat .inc files as Fortran files (default is PHP), -# and .f files as C (default is Fortran), use: inc=Fortran f=C. -# -# Note: For files without extension you can use no_extension as a placeholder. -# -# Note that for custom extensions you also need to set FILE_PATTERNS otherwise -# the files are not read by doxygen. - -EXTENSION_MAPPING = - -# If the MARKDOWN_SUPPORT tag is enabled then doxygen pre-processes all comments -# according to the Markdown format, which allows for more readable -# documentation. See http://daringfireball.net/projects/markdown/ for details. -# The output of markdown processing is further processed by doxygen, so you can -# mix doxygen, HTML, and XML commands with Markdown formatting. Disable only in -# case of backward compatibilities issues. -# The default value is: YES. - -MARKDOWN_SUPPORT = YES - -# When enabled doxygen tries to link words that correspond to documented -# classes, or namespaces to their corresponding documentation. Such a link can -# be prevented in individual cases by putting a % sign in front of the word or -# globally by setting AUTOLINK_SUPPORT to NO. -# The default value is: YES. - -AUTOLINK_SUPPORT = YES - -# If you use STL classes (i.e. std::string, std::vector, etc.) but do not want -# to include (a tag file for) the STL sources as input, then you should set this -# tag to YES in order to let doxygen match functions declarations and -# definitions whose arguments contain STL classes (e.g. func(std::string); -# versus func(std::string) {}). This also make the inheritance and collaboration -# diagrams that involve STL classes more complete and accurate. -# The default value is: NO. - -BUILTIN_STL_SUPPORT = NO - -# If you use Microsoft's C++/CLI language, you should set this option to YES to -# enable parsing support. -# The default value is: NO. - -CPP_CLI_SUPPORT = NO - -# Set the SIP_SUPPORT tag to YES if your project consists of sip (see: -# http://www.riverbankcomputing.co.uk/software/sip/intro) sources only. Doxygen -# will parse them like normal C++ but will assume all classes use public instead -# of private inheritance when no explicit protection keyword is present. -# The default value is: NO. - -SIP_SUPPORT = NO - -# For Microsoft's IDL there are propget and propput attributes to indicate -# getter and setter methods for a property. Setting this option to YES will make -# doxygen to replace the get and set methods by a property in the documentation. -# This will only work if the methods are indeed getting or setting a simple -# type. If this is not the case, or you want to show the methods anyway, you -# should set this option to NO. -# The default value is: YES. - -IDL_PROPERTY_SUPPORT = YES - -# If member grouping is used in the documentation and the DISTRIBUTE_GROUP_DOC -# tag is set to YES then doxygen will reuse the documentation of the first -# member in the group (if any) for the other members of the group. By default -# all members of a group must be documented explicitly. -# The default value is: NO. - -DISTRIBUTE_GROUP_DOC = YES - -# If one adds a struct or class to a group and this option is enabled, then also -# any nested class or struct is added to the same group. By default this option -# is disabled and one has to add nested compounds explicitly via \ingroup. -# The default value is: NO. - -GROUP_NESTED_COMPOUNDS = NO - -# Set the SUBGROUPING tag to YES to allow class member groups of the same type -# (for instance a group of public functions) to be put as a subgroup of that -# type (e.g. under the Public Functions section). Set it to NO to prevent -# subgrouping. Alternatively, this can be done per class using the -# \nosubgrouping command. -# The default value is: YES. - -SUBGROUPING = YES - -# When the INLINE_GROUPED_CLASSES tag is set to YES, classes, structs and unions -# are shown inside the group in which they are included (e.g. using \ingroup) -# instead of on a separate page (for HTML and Man pages) or section (for LaTeX -# and RTF). -# -# Note that this feature does not work in combination with -# SEPARATE_MEMBER_PAGES. -# The default value is: NO. - -INLINE_GROUPED_CLASSES = NO - -# When the INLINE_SIMPLE_STRUCTS tag is set to YES, structs, classes, and unions -# with only public data fields or simple typedef fields will be shown inline in -# the documentation of the scope in which they are defined (i.e. file, -# namespace, or group documentation), provided this scope is documented. If set -# to NO, structs, classes, and unions are shown on a separate page (for HTML and -# Man pages) or section (for LaTeX and RTF). -# The default value is: NO. - -INLINE_SIMPLE_STRUCTS = NO - -# When TYPEDEF_HIDES_STRUCT tag is enabled, a typedef of a struct, union, or -# enum is documented as struct, union, or enum with the name of the typedef. So -# typedef struct TypeS {} TypeT, will appear in the documentation as a struct -# with name TypeT. When disabled the typedef will appear as a member of a file, -# namespace, or class. And the struct will be named TypeS. This can typically be -# useful for C code in case the coding convention dictates that all compound -# types are typedef'ed and only the typedef is referenced, never the tag name. -# The default value is: NO. - -TYPEDEF_HIDES_STRUCT = NO - -# The size of the symbol lookup cache can be set using LOOKUP_CACHE_SIZE. This -# cache is used to resolve symbols given their name and scope. Since this can be -# an expensive process and often the same symbol appears multiple times in the -# code, doxygen keeps a cache of pre-resolved symbols. If the cache is too small -# doxygen will become slower. If the cache is too large, memory is wasted. The -# cache size is given by this formula: 2^(16+LOOKUP_CACHE_SIZE). The valid range -# is 0..9, the default is 0, corresponding to a cache size of 2^16=65536 -# symbols. At the end of a run doxygen will report the cache usage and suggest -# the optimal cache size from a speed point of view. -# Minimum value: 0, maximum value: 9, default value: 0. - -LOOKUP_CACHE_SIZE = 0 - -#--------------------------------------------------------------------------- -# Build related configuration options -#--------------------------------------------------------------------------- - -# If the EXTRACT_ALL tag is set to YES, doxygen will assume all entities in -# documentation are documented, even if no documentation was available. Private -# class members and static file members will be hidden unless the -# EXTRACT_PRIVATE respectively EXTRACT_STATIC tags are set to YES. -# Note: This will also disable the warnings about undocumented members that are -# normally produced when WARNINGS is set to YES. -# The default value is: NO. - -EXTRACT_ALL = YES - -# If the EXTRACT_PRIVATE tag is set to YES, all private members of a class will -# be included in the documentation. -# The default value is: NO. - -EXTRACT_PRIVATE = NO - -# If the EXTRACT_PACKAGE tag is set to YES, all members with package or internal -# scope will be included in the documentation. -# The default value is: NO. - -EXTRACT_PACKAGE = NO - -# If the EXTRACT_STATIC tag is set to YES, all static members of a file will be -# included in the documentation. -# The default value is: NO. - -EXTRACT_STATIC = NO - -# If the EXTRACT_LOCAL_CLASSES tag is set to YES, classes (and structs) defined -# locally in source files will be included in the documentation. If set to NO, -# only classes defined in header files are included. Does not have any effect -# for Java sources. -# The default value is: YES. - -EXTRACT_LOCAL_CLASSES = YES - -# This flag is only useful for Objective-C code. If set to YES, local methods, -# which are defined in the implementation section but not in the interface are -# included in the documentation. If set to NO, only methods in the interface are -# included. -# The default value is: NO. - -EXTRACT_LOCAL_METHODS = NO - -# If this flag is set to YES, the members of anonymous namespaces will be -# extracted and appear in the documentation as a namespace called -# 'anonymous_namespace{file}', where file will be replaced with the base name of -# the file that contains the anonymous namespace. By default anonymous namespace -# are hidden. -# The default value is: NO. - -EXTRACT_ANON_NSPACES = NO - -# If the HIDE_UNDOC_MEMBERS tag is set to YES, doxygen will hide all -# undocumented members inside documented classes or files. If set to NO these -# members will be included in the various overviews, but no documentation -# section is generated. This option has no effect if EXTRACT_ALL is enabled. -# The default value is: NO. - -HIDE_UNDOC_MEMBERS = NO - -# If the HIDE_UNDOC_CLASSES tag is set to YES, doxygen will hide all -# undocumented classes that are normally visible in the class hierarchy. If set -# to NO, these classes will be included in the various overviews. This option -# has no effect if EXTRACT_ALL is enabled. -# The default value is: NO. - -HIDE_UNDOC_CLASSES = NO - -# If the HIDE_FRIEND_COMPOUNDS tag is set to YES, doxygen will hide all friend -# (class|struct|union) declarations. If set to NO, these declarations will be -# included in the documentation. -# The default value is: NO. - -HIDE_FRIEND_COMPOUNDS = NO - -# If the HIDE_IN_BODY_DOCS tag is set to YES, doxygen will hide any -# documentation blocks found inside the body of a function. If set to NO, these -# blocks will be appended to the function's detailed documentation block. -# The default value is: NO. - -HIDE_IN_BODY_DOCS = NO - -# The INTERNAL_DOCS tag determines if documentation that is typed after a -# \internal command is included. If the tag is set to NO then the documentation -# will be excluded. Set it to YES to include the internal documentation. -# The default value is: NO. - -INTERNAL_DOCS = NO - -# If the CASE_SENSE_NAMES tag is set to NO then doxygen will only generate file -# names in lower-case letters. If set to YES, upper-case letters are also -# allowed. This is useful if you have classes or files whose names only differ -# in case and if your file system supports case sensitive file names. Windows -# and Mac users are advised to set this option to NO. -# The default value is: system dependent. - -CASE_SENSE_NAMES = NO - -# If the HIDE_SCOPE_NAMES tag is set to NO then doxygen will show members with -# their full class and namespace scopes in the documentation. If set to YES, the -# scope will be hidden. -# The default value is: NO. - -HIDE_SCOPE_NAMES = NO - -# If the HIDE_COMPOUND_REFERENCE tag is set to NO (default) then doxygen will -# append additional text to a page's title, such as Class Reference. If set to -# YES the compound reference will be hidden. -# The default value is: NO. - -HIDE_COMPOUND_REFERENCE= NO - -# If the SHOW_INCLUDE_FILES tag is set to YES then doxygen will put a list of -# the files that are included by a file in the documentation of that file. -# The default value is: YES. - -SHOW_INCLUDE_FILES = YES - -# If the SHOW_GROUPED_MEMB_INC tag is set to YES then Doxygen will add for each -# grouped member an include statement to the documentation, telling the reader -# which file to include in order to use the member. -# The default value is: NO. - -SHOW_GROUPED_MEMB_INC = NO - -# If the FORCE_LOCAL_INCLUDES tag is set to YES then doxygen will list include -# files with double quotes in the documentation rather than with sharp brackets. -# The default value is: NO. - -FORCE_LOCAL_INCLUDES = NO - -# If the INLINE_INFO tag is set to YES then a tag [inline] is inserted in the -# documentation for inline members. -# The default value is: YES. - -INLINE_INFO = YES - -# If the SORT_MEMBER_DOCS tag is set to YES then doxygen will sort the -# (detailed) documentation of file and class members alphabetically by member -# name. If set to NO, the members will appear in declaration order. -# The default value is: YES. - -SORT_MEMBER_DOCS = YES - -# If the SORT_BRIEF_DOCS tag is set to YES then doxygen will sort the brief -# descriptions of file, namespace and class members alphabetically by member -# name. If set to NO, the members will appear in declaration order. Note that -# this will also influence the order of the classes in the class list. -# The default value is: NO. - -SORT_BRIEF_DOCS = NO - -# If the SORT_MEMBERS_CTORS_1ST tag is set to YES then doxygen will sort the -# (brief and detailed) documentation of class members so that constructors and -# destructors are listed first. If set to NO the constructors will appear in the -# respective orders defined by SORT_BRIEF_DOCS and SORT_MEMBER_DOCS. -# Note: If SORT_BRIEF_DOCS is set to NO this option is ignored for sorting brief -# member documentation. -# Note: If SORT_MEMBER_DOCS is set to NO this option is ignored for sorting -# detailed member documentation. -# The default value is: NO. - -SORT_MEMBERS_CTORS_1ST = NO - -# If the SORT_GROUP_NAMES tag is set to YES then doxygen will sort the hierarchy -# of group names into alphabetical order. If set to NO the group names will -# appear in their defined order. -# The default value is: NO. - -SORT_GROUP_NAMES = NO - -# If the SORT_BY_SCOPE_NAME tag is set to YES, the class list will be sorted by -# fully-qualified names, including namespaces. If set to NO, the class list will -# be sorted only by class name, not including the namespace part. -# Note: This option is not very useful if HIDE_SCOPE_NAMES is set to YES. -# Note: This option applies only to the class list, not to the alphabetical -# list. -# The default value is: NO. - -SORT_BY_SCOPE_NAME = NO - -# If the STRICT_PROTO_MATCHING option is enabled and doxygen fails to do proper -# type resolution of all parameters of a function it will reject a match between -# the prototype and the implementation of a member function even if there is -# only one candidate or it is obvious which candidate to choose by doing a -# simple string match. By disabling STRICT_PROTO_MATCHING doxygen will still -# accept a match between prototype and implementation in such cases. -# The default value is: NO. - -STRICT_PROTO_MATCHING = NO - -# The GENERATE_TODOLIST tag can be used to enable (YES) or disable (NO) the todo -# list. This list is created by putting \todo commands in the documentation. -# The default value is: YES. - -GENERATE_TODOLIST = YES - -# The GENERATE_TESTLIST tag can be used to enable (YES) or disable (NO) the test -# list. This list is created by putting \test commands in the documentation. -# The default value is: YES. - -GENERATE_TESTLIST = YES - -# The GENERATE_BUGLIST tag can be used to enable (YES) or disable (NO) the bug -# list. This list is created by putting \bug commands in the documentation. -# The default value is: YES. - -GENERATE_BUGLIST = YES - -# The GENERATE_DEPRECATEDLIST tag can be used to enable (YES) or disable (NO) -# the deprecated list. This list is created by putting \deprecated commands in -# the documentation. -# The default value is: YES. - -GENERATE_DEPRECATEDLIST= YES - -# The ENABLED_SECTIONS tag can be used to enable conditional documentation -# sections, marked by \if ... \endif and \cond -# ... \endcond blocks. - -ENABLED_SECTIONS = - -# The MAX_INITIALIZER_LINES tag determines the maximum number of lines that the -# initial value of a variable or macro / define can have for it to appear in the -# documentation. If the initializer consists of more lines than specified here -# it will be hidden. Use a value of 0 to hide initializers completely. The -# appearance of the value of individual variables and macros / defines can be -# controlled using \showinitializer or \hideinitializer command in the -# documentation regardless of this setting. -# Minimum value: 0, maximum value: 10000, default value: 30. - -MAX_INITIALIZER_LINES = 30 - -# Set the SHOW_USED_FILES tag to NO to disable the list of files generated at -# the bottom of the documentation of classes and structs. If set to YES, the -# list will mention the files that were used to generate the documentation. -# The default value is: YES. - -SHOW_USED_FILES = YES - -# Set the SHOW_FILES tag to NO to disable the generation of the Files page. This -# will remove the Files entry from the Quick Index and from the Folder Tree View -# (if specified). -# The default value is: YES. - -SHOW_FILES = YES - -# Set the SHOW_NAMESPACES tag to NO to disable the generation of the Namespaces -# page. This will remove the Namespaces entry from the Quick Index and from the -# Folder Tree View (if specified). -# The default value is: YES. - -SHOW_NAMESPACES = YES - -# The FILE_VERSION_FILTER tag can be used to specify a program or script that -# doxygen should invoke to get the current version for each file (typically from -# the version control system). Doxygen will invoke the program by executing (via -# popen()) the command command input-file, where command is the value of the -# FILE_VERSION_FILTER tag, and input-file is the name of an input file provided -# by doxygen. Whatever the program writes to standard output is used as the file -# version. For an example see the documentation. - -FILE_VERSION_FILTER = - -# The LAYOUT_FILE tag can be used to specify a layout file which will be parsed -# by doxygen. The layout file controls the global structure of the generated -# output files in an output format independent way. To create the layout file -# that represents doxygen's defaults, run doxygen with the -l option. You can -# optionally specify a file name after the option, if omitted DoxygenLayout.xml -# will be used as the name of the layout file. -# -# Note that if you run doxygen from a directory containing a file called -# DoxygenLayout.xml, doxygen will parse it automatically even if the LAYOUT_FILE -# tag is left empty. - -LAYOUT_FILE = - -# The CITE_BIB_FILES tag can be used to specify one or more bib files containing -# the reference definitions. This must be a list of .bib files. The .bib -# extension is automatically appended if omitted. This requires the bibtex tool -# to be installed. See also http://en.wikipedia.org/wiki/BibTeX for more info. -# For LaTeX the style of the bibliography can be controlled using -# LATEX_BIB_STYLE. To use this feature you need bibtex and perl available in the -# search path. See also \cite for info how to create references. - -CITE_BIB_FILES = - -#--------------------------------------------------------------------------- -# Configuration options related to warning and progress messages -#--------------------------------------------------------------------------- - -# The QUIET tag can be used to turn on/off the messages that are generated to -# standard output by doxygen. If QUIET is set to YES this implies that the -# messages are off. -# The default value is: NO. - -QUIET = NO - -# The WARNINGS tag can be used to turn on/off the warning messages that are -# generated to standard error (stderr) by doxygen. If WARNINGS is set to YES -# this implies that the warnings are on. -# -# Tip: Turn warnings on while writing the documentation. -# The default value is: YES. - -WARNINGS = YES - -# If the WARN_IF_UNDOCUMENTED tag is set to YES then doxygen will generate -# warnings for undocumented members. If EXTRACT_ALL is set to YES then this flag -# will automatically be disabled. -# The default value is: YES. - -WARN_IF_UNDOCUMENTED = YES - -# If the WARN_IF_DOC_ERROR tag is set to YES, doxygen will generate warnings for -# potential errors in the documentation, such as not documenting some parameters -# in a documented function, or documenting parameters that don't exist or using -# markup commands wrongly. -# The default value is: YES. - -WARN_IF_DOC_ERROR = YES - -# This WARN_NO_PARAMDOC option can be enabled to get warnings for functions that -# are documented, but have no documentation for their parameters or return -# value. If set to NO, doxygen will only warn about wrong or incomplete -# parameter documentation, but not about the absence of documentation. -# The default value is: NO. - -WARN_NO_PARAMDOC = NO - -# The WARN_FORMAT tag determines the format of the warning messages that doxygen -# can produce. The string should contain the $file, $line, and $text tags, which -# will be replaced by the file and line number from which the warning originated -# and the warning text. Optionally the format may contain $version, which will -# be replaced by the version of the file (if it could be obtained via -# FILE_VERSION_FILTER) -# The default value is: $file:$line: $text. - -WARN_FORMAT = "$file:$line: $text" - -# The WARN_LOGFILE tag can be used to specify a file to which warning and error -# messages should be written. If left blank the output is written to standard -# error (stderr). - -WARN_LOGFILE = output_err - -#--------------------------------------------------------------------------- -# Configuration options related to the input files -#--------------------------------------------------------------------------- - -# The INPUT tag is used to specify the files and/or directories that contain -# documented source files. You may enter file names like myfile.cpp or -# directories like /usr/src/myproject. Separate the files or directories with -# spaces. -# Note: If this tag is empty the current directory is searched. - -INPUT = . \ - DOCS/groups-usr.dox - -# This tag can be used to specify the character encoding of the source files -# that doxygen parses. Internally doxygen uses the UTF-8 encoding. Doxygen uses -# libiconv (or the iconv built into libc) for the transcoding. See the libiconv -# documentation (see: http://www.gnu.org/software/libiconv) for the list of -# possible encodings. -# The default value is: UTF-8. - -INPUT_ENCODING = UTF-8 - -# If the value of the INPUT tag contains directories, you can use the -# FILE_PATTERNS tag to specify one or more wildcard patterns (like *.cpp and -# *.h) to filter out the source-files in the directories. -# -# Note that for custom extensions or not directly supported extensions you also -# need to set EXTENSION_MAPPING for the extension otherwise the files are not -# read by doxygen. -# -# If left blank the following patterns are tested:*.c, *.cc, *.cxx, *.cpp, -# *.c++, *.java, *.ii, *.ixx, *.ipp, *.i++, *.inl, *.idl, *.ddl, *.odl, *.h, -# *.hh, *.hxx, *.hpp, *.h++, *.cs, *.d, *.php, *.php4, *.php5, *.phtml, *.inc, -# *.m, *.markdown, *.md, *.mm, *.dox, *.py, *.f90, *.f, *.for, *.tcl, *.vhd, -# *.vhdl, *.ucf, *.qsf, *.as and *.js. - -FILE_PATTERNS = *.c \ - *.f \ - *.h - -# The RECURSIVE tag can be used to specify whether or not subdirectories should -# be searched for input files as well. -# The default value is: NO. - -RECURSIVE = YES - -# The EXCLUDE tag can be used to specify files and/or directories that should be -# excluded from the INPUT source files. This way you can easily exclude a -# subdirectory from a directory tree whose root is specified with the INPUT tag. -# -# Note that relative paths are relative to the directory from which doxygen is -# run. - -EXCLUDE = CMAKE \ - DOCS \ - BLAS/TESTING \ - CBLAS \ - LAPACKE/mangling \ - INSTALL \ - SRC/DEPRECATED \ - TESTING - -# The EXCLUDE_SYMLINKS tag can be used to select whether or not files or -# directories that are symbolic links (a Unix file system feature) are excluded -# from the input. -# The default value is: NO. - -EXCLUDE_SYMLINKS = NO - -# If the value of the INPUT tag contains directories, you can use the -# EXCLUDE_PATTERNS tag to specify one or more wildcard patterns to exclude -# certain files from those directories. -# -# Note that the wildcards are matched against the file with absolute path, so to -# exclude all test directories for example use the pattern */test/* - -EXCLUDE_PATTERNS = *.py \ - *.txt \ - *.in \ - *.inc \ - Makefile - -# The EXCLUDE_SYMBOLS tag can be used to specify one or more symbol names -# (namespaces, classes, functions, etc.) that should be excluded from the -# output. The symbol name can be a fully qualified name, a word, or if the -# wildcard * is used, a substring. Examples: ANamespace, AClass, -# AClass::ANamespace, ANamespace::*Test -# -# Note that the wildcards are matched against the file with absolute path, so to -# exclude all test directories use the pattern */test/* - -EXCLUDE_SYMBOLS = - -# The EXAMPLE_PATH tag can be used to specify one or more files or directories -# that contain example code fragments that are included (see the \include -# command). - -EXAMPLE_PATH = - -# If the value of the EXAMPLE_PATH tag contains directories, you can use the -# EXAMPLE_PATTERNS tag to specify one or more wildcard pattern (like *.cpp and -# *.h) to filter out the source-files in the directories. If left blank all -# files are included. - -EXAMPLE_PATTERNS = - -# If the EXAMPLE_RECURSIVE tag is set to YES then subdirectories will be -# searched for input files to be used with the \include or \dontinclude commands -# irrespective of the value of the RECURSIVE tag. -# The default value is: NO. - -EXAMPLE_RECURSIVE = NO - -# The IMAGE_PATH tag can be used to specify one or more files or directories -# that contain images that are to be included in the documentation (see the -# \image command). - -IMAGE_PATH = - -# The INPUT_FILTER tag can be used to specify a program that doxygen should -# invoke to filter for each input file. Doxygen will invoke the filter program -# by executing (via popen()) the command: -# -# -# -# where is the value of the INPUT_FILTER tag, and is the -# name of an input file. Doxygen will then use the output that the filter -# program writes to standard output. If FILTER_PATTERNS is specified, this tag -# will be ignored. -# -# Note that the filter must not add or remove lines; it is applied before the -# code is scanned, but not when the output code is generated. If lines are added -# or removed, the anchors will not be placed correctly. - -INPUT_FILTER = - -# The FILTER_PATTERNS tag can be used to specify filters on a per file pattern -# basis. Doxygen will compare the file name with each pattern and apply the -# filter if there is a match. The filters are a list of the form: pattern=filter -# (like *.cpp=my_cpp_filter). See INPUT_FILTER for further information on how -# filters are used. If the FILTER_PATTERNS tag is empty or if none of the -# patterns match the file name, INPUT_FILTER is applied. - -FILTER_PATTERNS = - -# If the FILTER_SOURCE_FILES tag is set to YES, the input filter (if set using -# INPUT_FILTER) will also be used to filter the input files that are used for -# producing the source files to browse (i.e. when SOURCE_BROWSER is set to YES). -# The default value is: NO. - -FILTER_SOURCE_FILES = NO - -# The FILTER_SOURCE_PATTERNS tag can be used to specify source filters per file -# pattern. A pattern will override the setting for FILTER_PATTERN (if any) and -# it is also possible to disable source filtering for a specific pattern using -# *.ext= (so without naming a filter). -# This tag requires that the tag FILTER_SOURCE_FILES is set to YES. - -FILTER_SOURCE_PATTERNS = - -# If the USE_MDFILE_AS_MAINPAGE tag refers to the name of a markdown file that -# is part of the input, its contents will be placed on the main page -# (index.html). This can be useful if you have a project on for instance GitHub -# and want to reuse the introduction page also for the doxygen output. - -USE_MDFILE_AS_MAINPAGE = - -#--------------------------------------------------------------------------- -# Configuration options related to source browsing -#--------------------------------------------------------------------------- - -# If the SOURCE_BROWSER tag is set to YES then a list of source files will be -# generated. Documented entities will be cross-referenced with these sources. -# -# Note: To get rid of all source code in the generated output, make sure that -# also VERBATIM_HEADERS is set to NO. -# The default value is: NO. - -SOURCE_BROWSER = YES - -# Setting the INLINE_SOURCES tag to YES will include the body of functions, -# classes and enums directly into the documentation. -# The default value is: NO. - -INLINE_SOURCES = NO - -# Setting the STRIP_CODE_COMMENTS tag to YES will instruct doxygen to hide any -# special comment blocks from generated source code fragments. Normal C, C++ and -# Fortran comments will always remain visible. -# The default value is: YES. - -STRIP_CODE_COMMENTS = YES - -# If the REFERENCED_BY_RELATION tag is set to YES then for each documented -# function all documented functions referencing it will be listed. -# The default value is: NO. - -REFERENCED_BY_RELATION = NO - -# If the REFERENCES_RELATION tag is set to YES then for each documented function -# all documented entities called/used by that function will be listed. -# The default value is: NO. - -REFERENCES_RELATION = NO - -# If the REFERENCES_LINK_SOURCE tag is set to YES and SOURCE_BROWSER tag is set -# to YES then the hyperlinks from functions in REFERENCES_RELATION and -# REFERENCED_BY_RELATION lists will link to the source code. Otherwise they will -# link to the documentation. -# The default value is: YES. - -REFERENCES_LINK_SOURCE = YES - -# If SOURCE_TOOLTIPS is enabled (the default) then hovering a hyperlink in the -# source code will show a tooltip with additional information such as prototype, -# brief description and links to the definition and documentation. Since this -# will make the HTML file larger and loading of large files a bit slower, you -# can opt to disable this feature. -# The default value is: YES. -# This tag requires that the tag SOURCE_BROWSER is set to YES. - -SOURCE_TOOLTIPS = YES - -# If the USE_HTAGS tag is set to YES then the references to source code will -# point to the HTML generated by the htags(1) tool instead of doxygen built-in -# source browser. The htags tool is part of GNU's global source tagging system -# (see http://www.gnu.org/software/global/global.html). You will need version -# 4.8.6 or higher. -# -# To use it do the following: -# - Install the latest version of global -# - Enable SOURCE_BROWSER and USE_HTAGS in the config file -# - Make sure the INPUT points to the root of the source tree -# - Run doxygen as normal -# -# Doxygen will invoke htags (and that will in turn invoke gtags), so these -# tools must be available from the command line (i.e. in the search path). -# -# The result: instead of the source browser generated by doxygen, the links to -# source code will now point to the output of htags. -# The default value is: NO. -# This tag requires that the tag SOURCE_BROWSER is set to YES. - -USE_HTAGS = NO - -# If the VERBATIM_HEADERS tag is set the YES then doxygen will generate a -# verbatim copy of the header file for each class for which an include is -# specified. Set to NO to disable this. -# See also: Section \class. -# The default value is: YES. - -VERBATIM_HEADERS = YES - -# If the CLANG_ASSISTED_PARSING tag is set to YES then doxygen will use the -# clang parser (see: http://clang.llvm.org/) for more accurate parsing at the -# cost of reduced performance. This can be particularly helpful with template -# rich C++ code for which doxygen's built-in parser lacks the necessary type -# information. -# Note: The availability of this option depends on whether or not doxygen was -# compiled with the --with-libclang option. -# The default value is: NO. - -CLANG_ASSISTED_PARSING = NO - -# If clang assisted parsing is enabled you can provide the compiler with command -# line options that you would normally use when invoking the compiler. Note that -# the include paths will already be set by doxygen for the files and directories -# specified with INPUT and INCLUDE_PATH. -# This tag requires that the tag CLANG_ASSISTED_PARSING is set to YES. - -CLANG_OPTIONS = - -#--------------------------------------------------------------------------- -# Configuration options related to the alphabetical class index -#--------------------------------------------------------------------------- - -# If the ALPHABETICAL_INDEX tag is set to YES, an alphabetical index of all -# compounds will be generated. Enable this if the project contains a lot of -# classes, structs, unions or interfaces. -# The default value is: YES. - -ALPHABETICAL_INDEX = YES - -# The COLS_IN_ALPHA_INDEX tag can be used to specify the number of columns in -# which the alphabetical index list will be split. -# Minimum value: 1, maximum value: 20, default value: 5. -# This tag requires that the tag ALPHABETICAL_INDEX is set to YES. - -COLS_IN_ALPHA_INDEX = 5 - -# In case all classes in a project start with a common prefix, all classes will -# be put under the same header in the alphabetical index. The IGNORE_PREFIX tag -# can be used to specify a prefix (or a list of prefixes) that should be ignored -# while generating the index headers. -# This tag requires that the tag ALPHABETICAL_INDEX is set to YES. - -IGNORE_PREFIX = - -#--------------------------------------------------------------------------- -# Configuration options related to the HTML output -#--------------------------------------------------------------------------- - -# If the GENERATE_HTML tag is set to YES, doxygen will generate HTML output -# The default value is: YES. - -GENERATE_HTML = NO - -# The HTML_OUTPUT tag is used to specify where the HTML docs will be put. If a -# relative path is entered the value of OUTPUT_DIRECTORY will be put in front of -# it. -# The default directory is: html. -# This tag requires that the tag GENERATE_HTML is set to YES. - -HTML_OUTPUT = explore-html - -# The HTML_FILE_EXTENSION tag can be used to specify the file extension for each -# generated HTML page (for example: .htm, .php, .asp). -# The default value is: .html. -# This tag requires that the tag GENERATE_HTML is set to YES. - -HTML_FILE_EXTENSION = .html - -# The HTML_HEADER tag can be used to specify a user-defined HTML header file for -# each generated HTML page. If the tag is left blank doxygen will generate a -# standard header. -# -# To get valid HTML the header file that includes any scripts and style sheets -# that doxygen needs, which is dependent on the configuration options used (e.g. -# the setting GENERATE_TREEVIEW). It is highly recommended to start with a -# default header using -# doxygen -w html new_header.html new_footer.html new_stylesheet.css -# YourConfigFile -# and then modify the file new_header.html. See also section "Doxygen usage" -# for information on how to generate the default header that doxygen normally -# uses. -# Note: The header is subject to change so you typically have to regenerate the -# default header when upgrading to a newer version of doxygen. For a description -# of the possible markers and block names see the documentation. -# This tag requires that the tag GENERATE_HTML is set to YES. - -HTML_HEADER = - -# The HTML_FOOTER tag can be used to specify a user-defined HTML footer for each -# generated HTML page. If the tag is left blank doxygen will generate a standard -# footer. See HTML_HEADER for more information on how to generate a default -# footer and what special commands can be used inside the footer. See also -# section "Doxygen usage" for information on how to generate the default footer -# that doxygen normally uses. -# This tag requires that the tag GENERATE_HTML is set to YES. - -HTML_FOOTER = - -# The HTML_STYLESHEET tag can be used to specify a user-defined cascading style -# sheet that is used by each HTML page. It can be used to fine-tune the look of -# the HTML output. If left blank doxygen will generate a default style sheet. -# See also section "Doxygen usage" for information on how to generate the style -# sheet that doxygen normally uses. -# Note: It is recommended to use HTML_EXTRA_STYLESHEET instead of this tag, as -# it is more robust and this tag (HTML_STYLESHEET) will in the future become -# obsolete. -# This tag requires that the tag GENERATE_HTML is set to YES. - -HTML_STYLESHEET = - -# The HTML_EXTRA_STYLESHEET tag can be used to specify additional user-defined -# cascading style sheets that are included after the standard style sheets -# created by doxygen. Using this option one can overrule certain style aspects. -# This is preferred over using HTML_STYLESHEET since it does not replace the -# standard style sheet and is therefore more robust against future updates. -# Doxygen will copy the style sheet files to the output directory. -# Note: The order of the extra style sheet files is of importance (e.g. the last -# style sheet in the list overrules the setting of the previous ones in the -# list). For an example see the documentation. -# This tag requires that the tag GENERATE_HTML is set to YES. - -HTML_EXTRA_STYLESHEET = - -# The HTML_EXTRA_FILES tag can be used to specify one or more extra images or -# other source files which should be copied to the HTML output directory. Note -# that these files will be copied to the base HTML output directory. Use the -# $relpath^ marker in the HTML_HEADER and/or HTML_FOOTER files to load these -# files. In the HTML_STYLESHEET file, use the file name only. Also note that the -# files will be copied as-is; there are no commands or markers available. -# This tag requires that the tag GENERATE_HTML is set to YES. - -HTML_EXTRA_FILES = - -# The HTML_COLORSTYLE_HUE tag controls the color of the HTML output. Doxygen -# will adjust the colors in the style sheet and background images according to -# this color. Hue is specified as an angle on a colorwheel, see -# http://en.wikipedia.org/wiki/Hue for more information. For instance the value -# 0 represents red, 60 is yellow, 120 is green, 180 is cyan, 240 is blue, 300 -# purple, and 360 is red again. -# Minimum value: 0, maximum value: 359, default value: 220. -# This tag requires that the tag GENERATE_HTML is set to YES. - -HTML_COLORSTYLE_HUE = 220 - -# The HTML_COLORSTYLE_SAT tag controls the purity (or saturation) of the colors -# in the HTML output. For a value of 0 the output will use grayscales only. A -# value of 255 will produce the most vivid colors. -# Minimum value: 0, maximum value: 255, default value: 100. -# This tag requires that the tag GENERATE_HTML is set to YES. - -HTML_COLORSTYLE_SAT = 100 - -# The HTML_COLORSTYLE_GAMMA tag controls the gamma correction applied to the -# luminance component of the colors in the HTML output. Values below 100 -# gradually make the output lighter, whereas values above 100 make the output -# darker. The value divided by 100 is the actual gamma applied, so 80 represents -# a gamma of 0.8, The value 220 represents a gamma of 2.2, and 100 does not -# change the gamma. -# Minimum value: 40, maximum value: 240, default value: 80. -# This tag requires that the tag GENERATE_HTML is set to YES. - -HTML_COLORSTYLE_GAMMA = 80 - -# If the HTML_TIMESTAMP tag is set to YES then the footer of each generated HTML -# page will contain the date and time when the page was generated. Setting this -# to YES can help to show when doxygen was last run and thus if the -# documentation is up to date. -# The default value is: NO. -# This tag requires that the tag GENERATE_HTML is set to YES. - -HTML_TIMESTAMP = YES - -# If the HTML_DYNAMIC_SECTIONS tag is set to YES then the generated HTML -# documentation will contain sections that can be hidden and shown after the -# page has loaded. -# The default value is: NO. -# This tag requires that the tag GENERATE_HTML is set to YES. - -HTML_DYNAMIC_SECTIONS = NO - -# With HTML_INDEX_NUM_ENTRIES one can control the preferred number of entries -# shown in the various tree structured indices initially; the user can expand -# and collapse entries dynamically later on. Doxygen will expand the tree to -# such a level that at most the specified number of entries are visible (unless -# a fully collapsed tree already exceeds this amount). So setting the number of -# entries 1 will produce a full collapsed tree by default. 0 is a special value -# representing an infinite number of entries and will result in a full expanded -# tree by default. -# Minimum value: 0, maximum value: 9999, default value: 100. -# This tag requires that the tag GENERATE_HTML is set to YES. - -HTML_INDEX_NUM_ENTRIES = 100 - -# If the GENERATE_DOCSET tag is set to YES, additional index files will be -# generated that can be used as input for Apple's Xcode 3 integrated development -# environment (see: http://developer.apple.com/tools/xcode/), introduced with -# OSX 10.5 (Leopard). To create a documentation set, doxygen will generate a -# Makefile in the HTML output directory. Running make will produce the docset in -# that directory and running make install will install the docset in -# ~/Library/Developer/Shared/Documentation/DocSets so that Xcode will find it at -# startup. See http://developer.apple.com/tools/creatingdocsetswithdoxygen.html -# for more information. -# The default value is: NO. -# This tag requires that the tag GENERATE_HTML is set to YES. - -GENERATE_DOCSET = NO - -# This tag determines the name of the docset feed. A documentation feed provides -# an umbrella under which multiple documentation sets from a single provider -# (such as a company or product suite) can be grouped. -# The default value is: Doxygen generated docs. -# This tag requires that the tag GENERATE_DOCSET is set to YES. - -DOCSET_FEEDNAME = "Doxygen generated docs" - -# This tag specifies a string that should uniquely identify the documentation -# set bundle. This should be a reverse domain-name style string, e.g. -# com.mycompany.MyDocSet. Doxygen will append .docset to the name. -# The default value is: org.doxygen.Project. -# This tag requires that the tag GENERATE_DOCSET is set to YES. - -DOCSET_BUNDLE_ID = org.doxygen.Project - -# The DOCSET_PUBLISHER_ID tag specifies a string that should uniquely identify -# the documentation publisher. This should be a reverse domain-name style -# string, e.g. com.mycompany.MyDocSet.documentation. -# The default value is: org.doxygen.Publisher. -# This tag requires that the tag GENERATE_DOCSET is set to YES. - -DOCSET_PUBLISHER_ID = org.doxygen.Publisher - -# The DOCSET_PUBLISHER_NAME tag identifies the documentation publisher. -# The default value is: Publisher. -# This tag requires that the tag GENERATE_DOCSET is set to YES. - -DOCSET_PUBLISHER_NAME = Publisher - -# If the GENERATE_HTMLHELP tag is set to YES then doxygen generates three -# additional HTML index files: index.hhp, index.hhc, and index.hhk. The -# index.hhp is a project file that can be read by Microsoft's HTML Help Workshop -# (see: http://www.microsoft.com/en-us/download/details.aspx?id=21138) on -# Windows. -# -# The HTML Help Workshop contains a compiler that can convert all HTML output -# generated by doxygen into a single compiled HTML file (.chm). Compiled HTML -# files are now used as the Windows 98 help format, and will replace the old -# Windows help format (.hlp) on all Windows platforms in the future. Compressed -# HTML files also contain an index, a table of contents, and you can search for -# words in the documentation. The HTML workshop also contains a viewer for -# compressed HTML files. -# The default value is: NO. -# This tag requires that the tag GENERATE_HTML is set to YES. - -GENERATE_HTMLHELP = NO - -# The CHM_FILE tag can be used to specify the file name of the resulting .chm -# file. You can add a path in front of the file if the result should not be -# written to the html output directory. -# This tag requires that the tag GENERATE_HTMLHELP is set to YES. - -CHM_FILE = - -# The HHC_LOCATION tag can be used to specify the location (absolute path -# including file name) of the HTML help compiler (hhc.exe). If non-empty, -# doxygen will try to run the HTML help compiler on the generated index.hhp. -# The file has to be specified with full path. -# This tag requires that the tag GENERATE_HTMLHELP is set to YES. - -HHC_LOCATION = - -# The GENERATE_CHI flag controls if a separate .chi index file is generated -# (YES) or that it should be included in the master .chm file (NO). -# The default value is: NO. -# This tag requires that the tag GENERATE_HTMLHELP is set to YES. - -GENERATE_CHI = NO - -# The CHM_INDEX_ENCODING is used to encode HtmlHelp index (hhk), content (hhc) -# and project file content. -# This tag requires that the tag GENERATE_HTMLHELP is set to YES. - -CHM_INDEX_ENCODING = - -# The BINARY_TOC flag controls whether a binary table of contents is generated -# (YES) or a normal table of contents (NO) in the .chm file. Furthermore it -# enables the Previous and Next buttons. -# The default value is: NO. -# This tag requires that the tag GENERATE_HTMLHELP is set to YES. - -BINARY_TOC = NO - -# The TOC_EXPAND flag can be set to YES to add extra items for group members to -# the table of contents of the HTML help documentation and to the tree view. -# The default value is: NO. -# This tag requires that the tag GENERATE_HTMLHELP is set to YES. - -TOC_EXPAND = NO - -# If the GENERATE_QHP tag is set to YES and both QHP_NAMESPACE and -# QHP_VIRTUAL_FOLDER are set, an additional index file will be generated that -# can be used as input for Qt's qhelpgenerator to generate a Qt Compressed Help -# (.qch) of the generated HTML documentation. -# The default value is: NO. -# This tag requires that the tag GENERATE_HTML is set to YES. - -GENERATE_QHP = NO - -# If the QHG_LOCATION tag is specified, the QCH_FILE tag can be used to specify -# the file name of the resulting .qch file. The path specified is relative to -# the HTML output folder. -# This tag requires that the tag GENERATE_QHP is set to YES. - -QCH_FILE = - -# The QHP_NAMESPACE tag specifies the namespace to use when generating Qt Help -# Project output. For more information please see Qt Help Project / Namespace -# (see: http://qt-project.org/doc/qt-4.8/qthelpproject.html#namespace). -# The default value is: org.doxygen.Project. -# This tag requires that the tag GENERATE_QHP is set to YES. - -QHP_NAMESPACE = org.doxygen.Project - -# The QHP_VIRTUAL_FOLDER tag specifies the namespace to use when generating Qt -# Help Project output. For more information please see Qt Help Project / Virtual -# Folders (see: http://qt-project.org/doc/qt-4.8/qthelpproject.html#virtual- -# folders). -# The default value is: doc. -# This tag requires that the tag GENERATE_QHP is set to YES. - -QHP_VIRTUAL_FOLDER = doc - -# If the QHP_CUST_FILTER_NAME tag is set, it specifies the name of a custom -# filter to add. For more information please see Qt Help Project / Custom -# Filters (see: http://qt-project.org/doc/qt-4.8/qthelpproject.html#custom- -# filters). -# This tag requires that the tag GENERATE_QHP is set to YES. - -QHP_CUST_FILTER_NAME = - -# The QHP_CUST_FILTER_ATTRS tag specifies the list of the attributes of the -# custom filter to add. For more information please see Qt Help Project / Custom -# Filters (see: http://qt-project.org/doc/qt-4.8/qthelpproject.html#custom- -# filters). -# This tag requires that the tag GENERATE_QHP is set to YES. - -QHP_CUST_FILTER_ATTRS = - -# The QHP_SECT_FILTER_ATTRS tag specifies the list of the attributes this -# project's filter section matches. Qt Help Project / Filter Attributes (see: -# http://qt-project.org/doc/qt-4.8/qthelpproject.html#filter-attributes). -# This tag requires that the tag GENERATE_QHP is set to YES. - -QHP_SECT_FILTER_ATTRS = - -# The QHG_LOCATION tag can be used to specify the location of Qt's -# qhelpgenerator. If non-empty doxygen will try to run qhelpgenerator on the -# generated .qhp file. -# This tag requires that the tag GENERATE_QHP is set to YES. - -QHG_LOCATION = - -# If the GENERATE_ECLIPSEHELP tag is set to YES, additional index files will be -# generated, together with the HTML files, they form an Eclipse help plugin. To -# install this plugin and make it available under the help contents menu in -# Eclipse, the contents of the directory containing the HTML and XML files needs -# to be copied into the plugins directory of eclipse. The name of the directory -# within the plugins directory should be the same as the ECLIPSE_DOC_ID value. -# After copying Eclipse needs to be restarted before the help appears. -# The default value is: NO. -# This tag requires that the tag GENERATE_HTML is set to YES. - -GENERATE_ECLIPSEHELP = NO - -# A unique identifier for the Eclipse help plugin. When installing the plugin -# the directory name containing the HTML and XML files should also have this -# name. Each documentation set should have its own identifier. -# The default value is: org.doxygen.Project. -# This tag requires that the tag GENERATE_ECLIPSEHELP is set to YES. - -ECLIPSE_DOC_ID = org.doxygen.Project - -# If you want full control over the layout of the generated HTML pages it might -# be necessary to disable the index and replace it with your own. The -# DISABLE_INDEX tag can be used to turn on/off the condensed index (tabs) at top -# of each HTML page. A value of NO enables the index and the value YES disables -# it. Since the tabs in the index contain the same information as the navigation -# tree, you can set this option to YES if you also set GENERATE_TREEVIEW to YES. -# The default value is: NO. -# This tag requires that the tag GENERATE_HTML is set to YES. - -DISABLE_INDEX = NO - -# The GENERATE_TREEVIEW tag is used to specify whether a tree-like index -# structure should be generated to display hierarchical information. If the tag -# value is set to YES, a side panel will be generated containing a tree-like -# index structure (just like the one that is generated for HTML Help). For this -# to work a browser that supports JavaScript, DHTML, CSS and frames is required -# (i.e. any modern browser). Windows users are probably better off using the -# HTML help feature. Via custom style sheets (see HTML_EXTRA_STYLESHEET) one can -# further fine-tune the look of the index. As an example, the default style -# sheet generated by doxygen has an example that shows how to put an image at -# the root of the tree instead of the PROJECT_NAME. Since the tree basically has -# the same information as the tab index, you could consider setting -# DISABLE_INDEX to YES when enabling this option. -# The default value is: NO. -# This tag requires that the tag GENERATE_HTML is set to YES. - -GENERATE_TREEVIEW = YES - -# The ENUM_VALUES_PER_LINE tag can be used to set the number of enum values that -# doxygen will group on one line in the generated HTML documentation. -# -# Note that a value of 0 will completely suppress the enum values from appearing -# in the overview section. -# Minimum value: 0, maximum value: 20, default value: 4. -# This tag requires that the tag GENERATE_HTML is set to YES. - -ENUM_VALUES_PER_LINE = 4 - -# If the treeview is enabled (see GENERATE_TREEVIEW) then this tag can be used -# to set the initial width (in pixels) of the frame in which the tree is shown. -# Minimum value: 0, maximum value: 1500, default value: 250. -# This tag requires that the tag GENERATE_HTML is set to YES. - -TREEVIEW_WIDTH = 250 - -# If the EXT_LINKS_IN_WINDOW option is set to YES, doxygen will open links to -# external symbols imported via tag files in a separate window. -# The default value is: NO. -# This tag requires that the tag GENERATE_HTML is set to YES. - -EXT_LINKS_IN_WINDOW = NO - -# Use this tag to change the font size of LaTeX formulas included as images in -# the HTML documentation. When you change the font size after a successful -# doxygen run you need to manually remove any form_*.png images from the HTML -# output directory to force them to be regenerated. -# Minimum value: 8, maximum value: 50, default value: 10. -# This tag requires that the tag GENERATE_HTML is set to YES. - -FORMULA_FONTSIZE = 10 - -# Use the FORMULA_TRANPARENT tag to determine whether or not the images -# generated for formulas are transparent PNGs. Transparent PNGs are not -# supported properly for IE 6.0, but are supported on all modern browsers. -# -# Note that when changing this option you need to delete any form_*.png files in -# the HTML output directory before the changes have effect. -# The default value is: YES. -# This tag requires that the tag GENERATE_HTML is set to YES. - -FORMULA_TRANSPARENT = YES - -# Enable the USE_MATHJAX option to render LaTeX formulas using MathJax (see -# http://www.mathjax.org) which uses client side Javascript for the rendering -# instead of using pre-rendered bitmaps. Use this if you do not have LaTeX -# installed or if you want to formulas look prettier in the HTML output. When -# enabled you may also need to install MathJax separately and configure the path -# to it using the MATHJAX_RELPATH option. -# The default value is: NO. -# This tag requires that the tag GENERATE_HTML is set to YES. - -USE_MATHJAX = NO - -# When MathJax is enabled you can set the default output format to be used for -# the MathJax output. See the MathJax site (see: -# http://docs.mathjax.org/en/latest/output.html) for more details. -# Possible values are: HTML-CSS (which is slower, but has the best -# compatibility), NativeMML (i.e. MathML) and SVG. -# The default value is: HTML-CSS. -# This tag requires that the tag USE_MATHJAX is set to YES. - -MATHJAX_FORMAT = HTML-CSS - -# When MathJax is enabled you need to specify the location relative to the HTML -# output directory using the MATHJAX_RELPATH option. The destination directory -# should contain the MathJax.js script. For instance, if the mathjax directory -# is located at the same level as the HTML output directory, then -# MATHJAX_RELPATH should be ../mathjax. The default value points to the MathJax -# Content Delivery Network so you can quickly see the result without installing -# MathJax. However, it is strongly recommended to install a local copy of -# MathJax from http://www.mathjax.org before deployment. -# The default value is: http://cdn.mathjax.org/mathjax/latest. -# This tag requires that the tag USE_MATHJAX is set to YES. - -MATHJAX_RELPATH = http://www.mathjax.org/mathjax - -# The MATHJAX_EXTENSIONS tag can be used to specify one or more MathJax -# extension names that should be enabled during MathJax rendering. For example -# MATHJAX_EXTENSIONS = TeX/AMSmath TeX/AMSsymbols -# This tag requires that the tag USE_MATHJAX is set to YES. - -MATHJAX_EXTENSIONS = - -# The MATHJAX_CODEFILE tag can be used to specify a file with javascript pieces -# of code that will be used on startup of the MathJax code. See the MathJax site -# (see: http://docs.mathjax.org/en/latest/output.html) for more details. For an -# example see the documentation. -# This tag requires that the tag USE_MATHJAX is set to YES. - -MATHJAX_CODEFILE = - -# When the SEARCHENGINE tag is enabled doxygen will generate a search box for -# the HTML output. The underlying search engine uses javascript and DHTML and -# should work on any modern browser. Note that when using HTML help -# (GENERATE_HTMLHELP), Qt help (GENERATE_QHP), or docsets (GENERATE_DOCSET) -# there is already a search function so this one should typically be disabled. -# For large projects the javascript based search engine can be slow, then -# enabling SERVER_BASED_SEARCH may provide a better solution. It is possible to -# search using the keyboard; to jump to the search box use + S -# (what the is depends on the OS and browser, but it is typically -# , /